Released SD*5.3*544 SEQ #463 Extracted from mail message **KIDS**:SD*5.3*544^ **INSTALL NAME** SD*5.3*544 "BLD",8094,0) SD*5.3*544^SCHEDULING^0^3100318^y "BLD",8094,1,0) ^^7^7^3100318^ "BLD",8094,1,1,0) - Fixes the entry for the DATA ENTRY CLERK (#7) field in the HOSPITAL "BLD",8094,1,2,0) LOCATION FILE (#44). "BLD",8094,1,3,0) - Deletes the CATEGORY OF VISIT (#1.5) field of the ENROLLMENT CLINIC "BLD",8094,1,4,0) multiple (#2.001) in the PATIENT FILE (#2). "BLD",8094,1,5,0) - Fixes the entry for the DATA ENTRY CLERK (#19) field in the PATIENT FILE "BLD",8094,1,6,0) (#2). "BLD",8094,1,7,0) - Corrects a problem when passing service connected types through Quasar. "BLD",8094,4,0) ^9.64PA^^ "BLD",8094,6.3) 11 "BLD",8094,"INID") ^n "BLD",8094,"INIT") EN^SD53P544 "BLD",8094,"KRN",0) ^9.67PA^779.2^20 "BLD",8094,"KRN",.4,0) .4 "BLD",8094,"KRN",.401,0) .401 "BLD",8094,"KRN",.402,0) .402 "BLD",8094,"KRN",.403,0) .403 "BLD",8094,"KRN",.5,0) .5 "BLD",8094,"KRN",.84,0) .84 "BLD",8094,"KRN",3.6,0) 3.6 "BLD",8094,"KRN",3.8,0) 3.8 "BLD",8094,"KRN",9.2,0) 9.2 "BLD",8094,"KRN",9.8,0) 9.8 "BLD",8094,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",8094,"KRN",9.8,"NM",1,0) SDM1A^^0^B59959589 "BLD",8094,"KRN",9.8,"NM",2,0) SDCO22^^0^B10370372 "BLD",8094,"KRN",9.8,"NM",3,0) SDAMWI1^^0^B10737470 "BLD",8094,"KRN",9.8,"NM","B","SDAMWI1",3) "BLD",8094,"KRN",9.8,"NM","B","SDCO22",2) "BLD",8094,"KRN",9.8,"NM","B","SDM1A",1) "BLD",8094,"KRN",19,0) 19 "BLD",8094,"KRN",19.1,0) 19.1 "BLD",8094,"KRN",101,0) 101 "BLD",8094,"KRN",409.61,0) 409.61 "BLD",8094,"KRN",771,0) 771 "BLD",8094,"KRN",779.2,0) 779.2 "BLD",8094,"KRN",870,0) 870 "BLD",8094,"KRN",8989.51,0) 8989.51 "BLD",8094,"KRN",8989.52,0) 8989.52 "BLD",8094,"KRN",8994,0) 8994 "BLD",8094,"KRN","B",.4,.4) "BLD",8094,"KRN","B",.401,.401) "BLD",8094,"KRN","B",.402,.402) "BLD",8094,"KRN","B",.403,.403) "BLD",8094,"KRN","B",.5,.5) "BLD",8094,"KRN","B",.84,.84) "BLD",8094,"KRN","B",3.6,3.6) "BLD",8094,"KRN","B",3.8,3.8) "BLD",8094,"KRN","B",9.2,9.2) "BLD",8094,"KRN","B",9.8,9.8) "BLD",8094,"KRN","B",19,19) "BLD",8094,"KRN","B",19.1,19.1) "BLD",8094,"KRN","B",101,101) "BLD",8094,"KRN","B",409.61,409.61) "BLD",8094,"KRN","B",771,771) "BLD",8094,"KRN","B",779.2,779.2) "BLD",8094,"KRN","B",870,870) "BLD",8094,"KRN","B",8989.51,8989.51) "BLD",8094,"KRN","B",8989.52,8989.52) "BLD",8094,"KRN","B",8994,8994) "BLD",8094,"QDEF") ^^^^NO^^^^^^YES "BLD",8094,"QUES",0) ^9.62^^ "BLD",8094,"REQB",0) ^9.611^2^2 "BLD",8094,"REQB",1,0) SD*5.3*446^2 "BLD",8094,"REQB",2,0) SD*5.3*441^2 "BLD",8094,"REQB","B","SD*5.3*441",2) "BLD",8094,"REQB","B","SD*5.3*446",1) "INIT") EN^SD53P544 "MBREQ") 0 "PKG",16,-1) 1^1 "PKG",16,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",16,20,0) ^9.402P^^ "PKG",16,22,0) ^9.49I^1^1 "PKG",16,22,1,0) 5.3^2930813 "PKG",16,22,1,"PAH",1,0) 544^3100318 "PKG",16,22,1,"PAH",1,1,0) ^^7^7^3100318 "PKG",16,22,1,"PAH",1,1,1,0) - Fixes the entry for the DATA ENTRY CLERK (#7) field in the HOSPITAL "PKG",16,22,1,"PAH",1,1,2,0) LOCATION FILE (#44). "PKG",16,22,1,"PAH",1,1,3,0) - Deletes the CATEGORY OF VISIT (#1.5) field of the ENROLLMENT CLINIC "PKG",16,22,1,"PAH",1,1,4,0) multiple (#2.001) in the PATIENT FILE (#2). "PKG",16,22,1,"PAH",1,1,5,0) - Fixes the entry for the DATA ENTRY CLERK (#19) field in the PATIENT FILE "PKG",16,22,1,"PAH",1,1,6,0) (#2). "PKG",16,22,1,"PAH",1,1,7,0) - Corrects a problem when passing service connected types through Quasar. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 4 "RTN","SD53P544") 0^^B4525825^n/a "RTN","SD53P544",1,0) SD53P544 ;ALB/RC - POST-INSTALL SD*5.3*544 ; 8/3/09 11:13am "RTN","SD53P544",2,0) ;;5.3;Scheduling;**544**;Aug 13, 1993;Build 11 "RTN","SD53P544",3,0) Q "RTN","SD53P544",4,0) EN ;Post install entry point "RTN","SD53P544",5,0) N SDX,Y "RTN","SD53P544",6,0) F SDX="POST" D "RTN","SD53P544",7,0) .S Y=$$NEWCP^XPDUTL(SDX,SDX_"^SD53P544") "RTN","SD53P544",8,0) .I 'Y D BMES^XPDUTL("ERROR creating "_SDX_" checkpoint.") "RTN","SD53P544",9,0) Q "RTN","SD53P544",10,0) POST ;Post-Install "RTN","SD53P544",11,0) D CLERK "RTN","SD53P544",12,0) D DEL "RTN","SD53P544",13,0) Q "RTN","SD53P544",14,0) CLERK ;Find entries and match up the data entry clerk/time "RTN","SD53P544",15,0) N SDPT,SDAPPT,SDCLINIC,SDAPTNUM,SDCLK,SDAPDTM,SDIENS "RTN","SD53P544",16,0) N DA,DIE "RTN","SD53P544",17,0) I '$D(^XTMP("SD53P544-"_$J,0)) S ^XTMP("SD53P544-"_$J,0)=$$FMADD^XLFDT(""_DT_"",30)_U_DT_U_"Records updated by SD*5.3*544" "RTN","SD53P544",18,0) S (SDCLK,SDAPDTM)="" "RTN","SD53P544",19,0) S SDPT=0 "RTN","SD53P544",20,0) F S SDPT=$O(^DPT(SDPT)) Q:SDPT'>0 D "RTN","SD53P544",21,0) .S SDAPPT=3080930.999999 "RTN","SD53P544",22,0) .F S SDAPPT=$O(^DPT(SDPT,"S",SDAPPT)) Q:SDAPPT'>0 D "RTN","SD53P544",23,0) ..I $P(^DPT(SDPT,"S",SDAPPT,0),"^",18)="" D "RTN","SD53P544",24,0) ...S SDCLINIC=$P(^DPT(SDPT,"S",SDAPPT,0),"^",1),SDAPTNUM=0 Q:SDCLINIC'>0 "RTN","SD53P544",25,0) ...F S SDAPTNUM=$O(^SC(SDCLINIC,"S",SDAPPT,1,SDAPTNUM)) Q:SDAPTNUM'>0 D "RTN","SD53P544",26,0) ....I $P($G(^SC(SDCLINIC,"S",SDAPPT,1,SDAPTNUM,0)),"^",1)=SDPT D "RTN","SD53P544",27,0) .....S SDIENS=""_SDAPTNUM_","_SDAPPT_","_SDCLINIC_","_"" "RTN","SD53P544",28,0) .....S SDCLK=$$GET1^DIQ(44.003,SDIENS,7,"I") "RTN","SD53P544",29,0) .....S SDAPDTM=$$GET1^DIQ(44.003,SDIENS,8,"I") "RTN","SD53P544",30,0) .....I $G(SDCLK) S $P(^DPT(SDPT,"S",SDAPPT,0),"^",18)=SDCLK,$P(^XTMP("SD53P544-"_$J,SDPT,SDAPPT),U)=SDCLK "RTN","SD53P544",31,0) .....I $G(SDAPDTM) S $P(^DPT(SDPT,"S",SDAPPT,0),"^",19)=SDAPDTM,$P(^XTMP("SD53P544-"_$J,SDPT,SDAPPT),U,2)=SDAPDTM "RTN","SD53P544",32,0) Q "RTN","SD53P544",33,0) DEL ; "RTN","SD53P544",34,0) N DIK,DA "RTN","SD53P544",35,0) Q:'$D(^DD(2.011,1.5)) ;Quit if global doesn't exist. "RTN","SD53P544",36,0) S DIK="^DD(2.011,",DA=1.5,DA(1)=2 "RTN","SD53P544",37,0) D ^DIK "RTN","SD53P544",38,0) Q "RTN","SDAMWI1") 0^3^B10737470^B10638873 "RTN","SDAMWI1",1,0) SDAMWI1 ;ALB/MJK - Walk-Ins (cont.) ; 6/17/09 4:00pm "RTN","SDAMWI1",2,0) ;;5.3;Scheduling;**94,167,206,168,544**;Aug 13, 1993;Build 11 "RTN","SDAMWI1",3,0) ; "RTN","SDAMWI1",4,0) MAKE(DFN,SDCL,SDT) ; -- set globals for appt "RTN","SDAMWI1",5,0) ; input: DFN ; SDCL := clinic# ; SDT := appt d/t "RTN","SDAMWI1",6,0) ; returned: success := 1 "RTN","SDAMWI1",7,0) ; "RTN","SDAMWI1",8,0) N SD,SDINP,SC,DA,DIK "RTN","SDAMWI1",9,0) S SC=SDCL,X=SDT,SDINP=$$INP^SDAM2(DFN,SDT) "RTN","SDAMWI1",10,0) S SD=SDT D EN1^SDM3 "RTN","SDAMWI1",11,0) S:'$D(^DPT(DFN,"S",0)) ^(0)="^2.98P^^" "RTN","SDAMWI1",12,0) S ^DPT(DFN,"S",SDT,0)=SC_"^"_$$STATUS^SDM1A(SC,SDINP,SDT)_"^^^^^4^^^^^^^^^"_SDAPTYP_"^^"_$G(DUZ)_"^"_DT_"^^^^^"_$G(SDXSCAT)_"^W^0" "RTN","SDAMWI1",13,0) ;xref DATE APPT. MADE field "RTN","SDAMWI1",14,0) D "RTN","SDAMWI1",15,0) .N DIV "RTN","SDAMWI1",16,0) .S DA=SDT,DA(1)=DFN,DIK="^DPT(DA(1),""S"",",DIK(1)=20 D EN1^DIK "RTN","SDAMWI1",17,0) .Q "RTN","SDAMWI1",18,0) F I=1:1 I '$D(^SC(SC,"S",SDT,1,I)) S:'$D(^(0)) ^(0)="^44.003PA^^" S ^(I,0)=DFN_"^"_SDSL_"^^^^"_DUZ_"^"_DT,^SC(SC,"S",SDT,0)=SDT,SDDA=I D RT,EVT,DUAL,ROUT(DFN) Q "RTN","SDAMWI1",19,0) ;update availability grid "RTN","SDAMWI1",20,0) N HSI,SDDIF,SI,SL,STARTDAY,STR,SDNOT,X,SB,Y,S,I,ST,SS,SM "RTN","SDAMWI1",21,0) S SD=SDT,SC=SDCL "RTN","SDAMWI1",22,0) I '$D(^SC(SC,"ST",$P(SD,"."),1)) Q 1 "RTN","SDAMWI1",23,0) S SL=^SC(+SC,"SL"),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y "RTN","SDAMWI1",24,0) SC L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC S S=^SC(SC,"ST",$P(SD,"."),1) S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST G C:(I<1!'$F(S,"["))&(S'["CAN") "RTN","SDAMWI1",25,0) S SM=0 "RTN","SDAMWI1",26,0) I SM<7 S %=$F(S,"[",SS-1) S:'%!($P(SL,"^",6)<3) %=999 I $F(S,"]",SS)'<%!(SDDIF=2&$E(S,ST+ST+1,SS-1)["[") S SM=7 "RTN","SDAMWI1",27,0) SP I ST+ST>$L(S) S S=S_" " G SP "RTN","SDAMWI1",28,0) S SDNOT=1 F I=ST+ST:SDDIF:SS-SDDIF S ST=$E(S,I+1) S:ST="" ST=" " S Y=$E(STR,$F(STR,ST)-2) G C:S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))),C:Y="" S:Y'?1NL&(SM<6) SM=6 S ST=$E(S,I+2,999) S:ST="" ST=" " S S=$E(S,1,I)_Y_ST "RTN","SDAMWI1",29,0) S ^SC(+SC,"ST",$P(SD,"."),1)=S "RTN","SDAMWI1",30,0) C L -^SC(+SC,"ST",$P(SD,"."),1) "RTN","SDAMWI1",31,0) Q 1 "RTN","SDAMWI1",32,0) ; "RTN","SDAMWI1",33,0) RT ; -- request record "RTN","SDAMWI1",34,0) S SDRT="A",SDTTM=SDT,SDPL=I,SDSC=SC D RT^SDUTL "RTN","SDAMWI1",35,0) Q "RTN","SDAMWI1",36,0) ; "RTN","SDAMWI1",37,0) ROUT(DFN) ; -- print routing slip "RTN","SDAMWI1",38,0) S DIR("A")="DO YOU WANT TO PRINT A ROUTING SLIP NOW",DIR(0)="Y" "RTN","SDAMWI1",39,0) W ! D ^DIR K DIR G ROUTQ:$D(DIRUT)!(Y=0) "RTN","SDAMWI1",40,0) K IOP S (SDX,SDSTART,ORDER,SDREP)="" D EN^SDROUT1 "RTN","SDAMWI1",41,0) ROUTQ Q "RTN","SDAMWI1",42,0) ; "RTN","SDAMWI1",43,0) DUAL ; -- ask elig if pt has more than one "RTN","SDAMWI1",44,0) I $O(VAEL(1,0))>0 S SDEMP="" D ELIG^SDM4:"369"[SDAPTYP S SDEMP=$S(SDDECOD:SDDECOD,1:SDEMP) I +SDEMP S $P(^SC(SC,"S",SDT,1,I,0),"^",10)=+SDEMP K SDEMP "RTN","SDAMWI1",45,0) Q "RTN","SDAMWI1",46,0) ; "RTN","SDAMWI1",47,0) EVT ; -- separate if need to NEW vars "RTN","SDAMWI1",48,0) N I,DIV D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,0) "RTN","SDAMWI1",49,0) Q "RTN","SDCO22") 0^2^B10370372^B9108174 "RTN","SDCO22",1,0) SDCO22 ;ALB/RMO/MRY - Classification Cont. - Screen - Check Out;9 MAY 2005 11:15 PM ; 8/30/01 11:19am "RTN","SDCO22",2,0) ;;5.3;Scheduling;**150,222,244,325,394,441,544**;Aug 13, 1993;Build 11 "RTN","SDCO22",3,0) ; "RTN","SDCO22",4,0) AO(DFN,SDOE) ;Ask Agent Orange Exposure Classification "RTN","SDCO22",5,0) ; Input -- DFN Patient file IEN "RTN","SDCO22",6,0) ; SDOE Outpatient Encounter file IEN [Optional] "RTN","SDCO22",7,0) ; Output -- 1=Yes and 0=No "RTN","SDCO22",8,0) N SDELG0,Y "RTN","SDCO22",9,0) I $P($G(^DPT(DFN,.321)),"^",2)="Y",$P($G(^DPT(DFN,.321)),"^",13)="V" D ;SD/441 "RTN","SDCO22",10,0) . S SDELG0=$$EL(DFN,$G(SDOE)) "RTN","SDCO22",11,0) . I $P(SDELG0,"^",5)="Y","^1^2^3^4^5^"[("^"_$P(SDELG0,"^",4)_"^") S Y=1 "RTN","SDCO22",12,0) . I $G(Y),$G(SDOE) D "RTN","SDCO22",13,0) . . I '$$AP(SDOE,1) S Y=0 Q "RTN","SDCO22",14,0) . . I $P(SDELG0,"^",4)=3!($P(SDELG0,"^",4)=1),$P($G(^SDD(409.42,+$O(^SDD(409.42,"AO",+SDOE,3,0)),0)),"^",3) S Y=0 "RTN","SDCO22",15,0) AOQ Q +$G(Y) "RTN","SDCO22",16,0) ; "RTN","SDCO22",17,0) IR(DFN,SDOE) ;Ask Ionizing Radiation Exposure Classification "RTN","SDCO22",18,0) ; Input -- DFN Patient file IEN "RTN","SDCO22",19,0) ; SDOE Outpatient Encounter file IEN [Optional] "RTN","SDCO22",20,0) ; Output -- 1=Yes and 0=No "RTN","SDCO22",21,0) N SDELG0,Y "RTN","SDCO22",22,0) I $P($G(^DPT(DFN,.321)),"^",3)'="Y" G IRQ "RTN","SDCO22",23,0) S SDELG0=$$EL(DFN,$G(SDOE)) "RTN","SDCO22",24,0) I $P(SDELG0,"^",5)="Y","^1^2^3^4^5^"[("^"_$P(SDELG0,"^",4)_"^") S Y=1 "RTN","SDCO22",25,0) I $G(Y),$G(SDOE) D "RTN","SDCO22",26,0) .I '$$AP(SDOE,2) S Y=0 Q "RTN","SDCO22",27,0) .I $P(SDELG0,"^",4)=3!($P(SDELG0,"^",4)=1),$P($G(^SDD(409.42,+$O(^SDD(409.42,"AO",+SDOE,3,0)),0)),"^",3) S Y=0 "RTN","SDCO22",28,0) IRQ Q +$G(Y) "RTN","SDCO22",29,0) ; "RTN","SDCO22",30,0) SC(DFN,SDOE) ;Ask Service Connected Condition Classification "RTN","SDCO22",31,0) ; Input -- DFN Patient file IEN "RTN","SDCO22",32,0) ; SDOE Outpatient Encounter file IEN [Optional] "RTN","SDCO22",33,0) ; Output -- 1=Yes and 0=No "RTN","SDCO22",34,0) N SDELG0,Y "RTN","SDCO22",35,0) S SDELG0=$$EL(DFN,$G(SDOE)) "RTN","SDCO22",36,0) I $P(SDELG0,"^",5)="Y","^1^3^"[("^"_$P(SDELG0,"^",4)_"^") S Y=1 "RTN","SDCO22",37,0) I $G(Y),$G(SDOE) D "RTN","SDCO22",38,0) .I '$$AP(SDOE,3) S Y=0 Q "RTN","SDCO22",39,0) SCQ Q +$G(Y) "RTN","SDCO22",40,0) ; "RTN","SDCO22",41,0) EC(DFN,SDOE) ;Ask Environmental Contaminant Exposure Classification "RTN","SDCO22",42,0) ;sd/441 - renamed 'SW Asia Coditions' "RTN","SDCO22",43,0) ; Input -- DFN Patient file IEN "RTN","SDCO22",44,0) ; SDOE Outpatient Encounter file IEN [Optional] "RTN","SDCO22",45,0) ; Output -- 1=Yes and 0=No "RTN","SDCO22",46,0) N SDELG0,Y "RTN","SDCO22",47,0) S SDELG0=$$EL(DFN,$G(SDOE)) "RTN","SDCO22",48,0) I $P($G(^DPT(DFN,.322)),"^",13)'="Y" D G ECQ "RTN","SDCO22",49,0) .I $P(SDELG0,"^",5)="N","^4^"[("^"_$P(SDELG0,"^",4)_"^"),"^A^B^C^D^6^"[("^"_($P($G(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)),"^",3))_"^") S Y=1 "RTN","SDCO22",50,0) I $P(SDELG0,"^",5)="Y","^1^2^3^4^5^"[("^"_$P(SDELG0,"^",4)_"^") S Y=1 "RTN","SDCO22",51,0) I $G(Y),$G(SDOE) D "RTN","SDCO22",52,0) .I '$$AP(SDOE,4) S Y=0 Q "RTN","SDCO22",53,0) .I $P(SDELG0,"^",4)=3!($P(SDELG0,"^",4)=1),$P($G(^SDD(409.42,+$O(^SDD(409.42,"AO",+SDOE,3,0)),0)),"^",3) S Y=0 "RTN","SDCO22",54,0) ECQ Q +$G(Y) "RTN","SDCO22",55,0) ; "RTN","SDCO22",56,0) EL(DFN,SDOE) ;Eligibility "RTN","SDCO22",57,0) Q $G(^DIC(8.1,+$P($G(^DIC(8,+$S($P($G(^SCE(+$G(SDOE),0)),"^",13):+$P(^(0),"^",13),1:+$G(^DPT(DFN,.36))),0)),"^",9),0)) "RTN","SDCO22",58,0) ; "RTN","SDCO22",59,0) AP(SDOE,SDCTI) ;Classification Appointment Type Screen "RTN","SDCO22",60,0) N SDAPTY,Y,SDVSTIEN "RTN","SDCO22",61,0) S SDAPTY=+$P($G(^SCE(+SDOE,0)),"^",10) "RTN","SDCO22",62,0) I SDAPTY=9 S Y=1 "RTN","SDCO22",63,0) I SDAPTY=11 S Y=1 "RTN","SDCO22",64,0) I SDAPTY=2,SDCTI=3 S Y=1 "RTN","SDCO22",65,0) S SDVSTIEN=$P($G(^SCE(+SDOE,0)),U,5) "RTN","SDCO22",66,0) I $P($G(^AUPNVSIT(+SDVSTIEN,812)),U,3) D "RTN","SDCO22",67,0) .I $D(^PX(839.7,"B","QUASAR",$P($G(^AUPNVSIT(+SDVSTIEN,812)),U,3))) D "RTN","SDCO22",68,0) ..I $P($G(^AUPNVSIT(+SDVSTIEN,800)),U)'="" S Y=1 "RTN","SDCO22",69,0) APQ Q +$G(Y) "RTN","SDCO22",70,0) ; "RTN","SDCO22",71,0) MST(DFN,SDOE) ;Ask Military Sexual Trauma Classification "RTN","SDCO22",72,0) ;Input - DFN Patient file IEN "RTN","SDCO22",73,0) ; SDOE Outpatient Encounter file IEN "RTN","SDCO22",74,0) ;Output - 1=Yes, 0=No "RTN","SDCO22",75,0) N DGMST "RTN","SDCO22",76,0) S DGMST=$$GETSTAT^DGMSTAPI(DFN) "RTN","SDCO22",77,0) Q +($P(DGMST,U,2)="Y") "RTN","SDCO22",78,0) ; "RTN","SDCO22",79,0) HNC(DFN,SDOE) ;Ask Head & Neck Classification "RTN","SDCO22",80,0) ;Input - DFN Patient file IEN "RTN","SDCO22",81,0) ; SDOE Outpatient Encounter file IEN "RTN","SDCO22",82,0) ;Output - 1=Yes, 0=No "RTN","SDCO22",83,0) N DGARR,SDELG0,Y "RTN","SDCO22",84,0) S SDELG0=$$GETCUR^DGNTAPI(DFN,"DGARR") "RTN","SDCO22",85,0) S SDELG0=+$G(DGARR("STAT")) "RTN","SDCO22",86,0) ;Only a status of 3, 4 or 5 is accepted for the question to be asked "RTN","SDCO22",87,0) S Y=$S((".3.4.5."[("."_SDELG0_".")):1,1:0) "RTN","SDCO22",88,0) HNCQ Q +$G(Y) "RTN","SDCO22",89,0) ; "RTN","SDCO22",90,0) CV(DFN,SDOE,SDDT) ;Ask Combat Veteran Classification "RTN","SDCO22",91,0) ;Input : DFN - Pointer to PATIENT file (#2) "RTN","SDCO22",92,0) ; SDOE - Pointer to OUTPATIENT ENCOUNTER file (#409.68) "RTN","SDCO22",93,0) ; SDDT - Date (FileMan format) (optional - SDOE overrides) "RTN","SDCO22",94,0) ;Output: 1 = Yes / 0 = No "RTN","SDCO22",95,0) N SDCV "RTN","SDCO22",96,0) S SDDT=$G(SDDT) "RTN","SDCO22",97,0) S:$G(SDOE) SDDT=+$G(^SCE(+$G(SDOE),0)) "RTN","SDCO22",98,0) S:'SDDT SDDT=$$DT^XLFDT() "RTN","SDCO22",99,0) S SDCV=$$CVEDT^DGCV(DFN,SDDT) "RTN","SDCO22",100,0) Q $P(SDCV,"^",3) "RTN","SDCO22",101,0) ; "RTN","SDCO22",102,0) SHAD(DFN) ;Ask Project 112/SHAD Classification "RTN","SDCO22",103,0) ;Input : DFN - Pointer to PATIENT file (#2) "RTN","SDCO22",104,0) ;Output: 1 = Yes / 0 = No / "" = unanswered "RTN","SDCO22",105,0) Q $$GETSHAD^DGUTL3(DFN) "RTN","SDM1A") 0^1^B59959589^B58026958 "RTN","SDM1A",1,0) SDM1A ;SF/GFT,ALB/TMP - MAKE APPOINTMENT ; 8/18/05 12:57pm ; 6/22/09 6:16pm "RTN","SDM1A",2,0) ;;5.3;Scheduling;**26,94,155,206,168,223,241,263,327,478,446,544**;Aug 13, 1993;Build 11 "RTN","SDM1A",3,0) OK I $D(SDMLT) D ^SDM4 Q:X="^"!(SDMADE=2) "RTN","SDM1A",4,0) S ^SC(SC,"ST",$P(SD,"."),1)=S,^DPT(DFN,"S",SD,0)=SC,^SC(SC,"S",SD,0)=SD S:'$D(^DPT(DFN,"S",0)) ^(0)="^2.98P^^" S:'$D(^SC(SC,"S",0)) ^(0)="^44.001DA^^" L "RTN","SDM1A",5,0) S1 L +^SC(SC,"S",SD,1):$G(DILOCKTM,5) W:'$T "Another user is editing this record. Trying again.",! G:'$T S1 F SDY=1:1 I '$D(^SC(SC,"S",SD,1,SDY)) S:'$D(^(0)) ^(0)="^44.003PA^^" S ^(SDY,0)=DFN_U_(+SL)_"^^^^"_$G(DUZ)_U_DT L -^SC(SC,"S",SD,1) Q "RTN","SDM1A",6,0) I SM S ^("OB")="O" ;NAKED REFERENCE - ^SC(IFN,"S",Date,1,SDY,"OB") "RTN","SDM1A",7,0) I $D(^SC(SC,"RAD")),^("RAD")="Y"!(^("RAD")=1) S ^SC("ARAD",SC,SD,DFN)="" "RTN","SDM1A",8,0) S SDINP=$$INP^SDAM2(DFN,SD) "RTN","SDM1A",9,0) ;-- added sub-category "RTN","SDM1A",10,0) S COV=3,SDYC="",COV=$S(COLLAT=1:1,1:3),SDYC=$S(COLLAT=7:1,1:"") "RTN","SDM1A",11,0) S:SD