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
DT,$D(^DPT(DFN,.321)) D EN1^SDM3 "RTN","SDM1A",26,0) ;Wait List SD*5.3*263 "RTN","SDM1A",27,0) ;I '$D(SDWLLIST) D ^SDWLR ;replaced with sd/372, see below "RTN","SDM1A",28,0) EWLCHK ;check if patient has any open EWL entries (SD/372) "RTN","SDM1A",29,0) ;get appointment "RTN","SDM1A",30,0) K ^TMP($J,"SDAMA301"),^TMP($J,"APPT") "RTN","SDM1A",31,0) D APPT^SDWLEVAL(DFN,SD,SC) "RTN","SDM1A",32,0) Q:'$D(^TMP($J,"APPT")) "RTN","SDM1A",33,0) N SDEV D EN^SDWLEVAL(DFN,.SDEV) I SDEV,$L(SDEV(1))>0 D "RTN","SDM1A",34,0) .K ^TMP("SDWLPL",$J),^TMP($J,"SDWLPL") "RTN","SDM1A",35,0) .D INIT^SDWLPL(DFN,"M") "RTN","SDM1A",36,0) .Q:'$D(^TMP($J,"SDWLPL")) "RTN","SDM1A",37,0) .D LIST^SDWLPL("M",DFN) "RTN","SDM1A",38,0) .F Q:'$D(^TMP($J,"SDWLPL")) N SDR D ANSW^SDWLEVAL(1,.SDR) I 'SDR D LIST^SDWLPL("M",DFN) D "RTN","SDM1A",39,0) ..F N SDR D ANSW^SDWLEVAL(0,.SDR) Q:'$D(^TMP($J,"SDWLPL")) I 'SDR W !,"MUST ENTER A REASON NOT TO DISPOSITION MATCHED EWL ENTRY",! "RTN","SDM1A",40,0) ;CREATE 120 FLAG IF APPLICABLE; appt created "RTN","SDM1A",41,0) FLG N SDST S SDST=$G(^TMP($J,"APPT",1)) I +SDST>0 D "RTN","SDM1A",42,0) .Q ; sd/446 "RTN","SDM1A",43,0) .N SDT,SDDES,SDPAR,SDDES1,SDT1 S SDPAR=0 S SDT=+SDST,SDDES=$P(SDST,U,17) I SDDES="" S SDDES=DT ; today's date if no desired date "RTN","SDM1A",44,0) .S X=SDT D H^%DTC S SDT1=%H "RTN","SDM1A",45,0) .S X=SDDES D H^%DTC S SDDES1=%H "RTN","SDM1A",46,0) .I SDT1-SDDES1>120 N SD120,SD120A S SD120=1,SD120A=1 D "RTN","SDM1A",47,0) ..; CREATE ewl eN SDPR S SDPR=$S(SDDES=DT:"A",1:"F") entry with 120 flag "RTN","SDM1A",48,0) ..N SDPR S SDPR=$S(SDDES=DT:"A",1:"F") ;10 "RTN","SDM1A",49,0) ..N SDWLIN S SDWLIN=+$P(SDST,U,15) ;2 "RTN","SDM1A",50,0) ..N SDWLSCPR S SDWLSCPR=0 I +$P(SDST,U,10)=11 S SDWLSCPR=1 ;15 "RTN","SDM1A",51,0) ..N SC,SDWLSCL S SC=+$P(SDST,U,2) D "RTN","SDM1A",52,0) ...I $D(^SDWL(409.32,"B",SC)) S SDWLSCL=$O(^SDWL(409.32,"B",SC,"")) Q ;8 "RTN","SDM1A",53,0) ...;create 409.32 entry "RTN","SDM1A",54,0) ...N DA,DIC S DIC(0)="LX",X=SC,DIC="^SDWL(409.32," D FILE^DICN "RTN","SDM1A",55,0) ...S SDWLSCL=DA "RTN","SDM1A",56,0) ...S DIE="^SDWL(409.32," "RTN","SDM1A",57,0) ...S DR=".02////^S X=SDWLIN" D ^DIE "RTN","SDM1A",58,0) ...S DR="1////^S X=DT" "RTN","SDM1A",59,0) ...S DR=DR_";2////^S X=DUZ" "RTN","SDM1A",60,0) ...D ^DIE S SDPAR=1 "RTN","SDM1A",61,0) ..N DA S DIC(0)="LX",(X,SDWLDFN)=+$P(SDST,U,4),X=SDWLDFN,DIC="^SDWL(409.3," D FILE^DICN "RTN","SDM1A",62,0) ..F L +^SDWL(409.3,DA):5 Q:$T D "RTN","SDM1A",63,0) ...I '$T W !,"Unable to acquire a lock on the Wait List file" Q "RTN","SDM1A",64,0) ..; Update EWL variables. "RTN","SDM1A",65,0) ..S SDWLDA=DA D EN^SDWLE11 ; get enrollee both SDWLDA and SDWLDFN have to be "RTN","SDM1A",66,0) ..N SDWLCM S SDWLCM=" > 120 days; appt created" "RTN","SDM1A",67,0) ..N SDWLSCPG S SDWLSCPG=$S($P($G(^DPT(SDWLDFN,.3)),U,1)="Y":$P(^(.3),U,2),1:"") "RTN","SDM1A",68,0) ..S DR="1////^S X=DT" "RTN","SDM1A",69,0) ..S DR=DR_";2////^S X=SDWLIN" "RTN","SDM1A",70,0) ..S DR=DR_";4////^S X=4" "RTN","SDM1A",71,0) ..S DR=DR_";8////^S X=SDWLSCL" "RTN","SDM1A",72,0) ..S DR=DR_";9////^S X=DUZ" "RTN","SDM1A",73,0) ..S DR=DR_";10////^S X=SDPR" "RTN","SDM1A",74,0) ..S DR=DR_";11////^S X=2" ; by patient for this entry to avoid asking for provider "RTN","SDM1A",75,0) ..S DR=DR_";14////^S X=SDWLSCPG" "RTN","SDM1A",76,0) ..S DR=DR_";15////^S X=SDWLSCPR" "RTN","SDM1A",77,0) ..S DR=DR_";22////^S X=SDDES" "RTN","SDM1A",78,0) ..S DR=DR_";23////^S X=""O""" "RTN","SDM1A",79,0) ..S DR=DR_";25////^S X=SDWLCM" "RTN","SDM1A",80,0) ..S DR=DR_";36////^S X=SD120" "RTN","SDM1A",81,0) ..S DR=DR_";39////^S X=SD120A" "RTN","SDM1A",82,0) ..S DIE="^SDWL(409.3," "RTN","SDM1A",83,0) ..D ^DIE "RTN","SDM1A",84,0) ..L -^SDWL(409.3,DA) "RTN","SDM1A",85,0) ..D MESS^SDWL120(SDWLDFN,SC,SDT,SDPAR) "RTN","SDM1A",86,0) ;continue appointment entry process "RTN","SDM1A",87,0) ORD S %=2 W !,"WANT PATIENT NOTIFIED OF LAB,X-RAY, OR EKG STOPS" D YN^DICN I '% W !," Enter YES to notify patient on appt. letter of LAB, X-RAY, or EKG stops" G ORD "RTN","SDM1A",88,0) I '(%-1) D ORDY^SDM3 "RTN","SDM1A",89,0) OTHER R !," OTHER INFO: ",D:DTIME I D["^" W !,*7,"'^' not allowed - hit return if no 'OTHER INFO' is to be entered" G OTHER "RTN","SDM1A",90,0) S TMPD=D I $L(D)>150 D MSG^SDMM G OTHER ;SD/478 "RTN","SDM1A",91,0) I D]"",D?."?"!(D'?.ANP) W " ENTER LAB, SCAN, ETC." G OTHER "RTN","SDM1A",92,0) I $L($G(^SC(SC,"S",SD,1,SDY,0)))+$L(D)+$L(DT)+$S($D(DUZ):$L(DUZ),1:0)>250 D MSG^SDMM G OTHER ; sd/446 "RTN","SDM1A",93,0) ;S $P(^(0),"^",4)=D,$P(^(0),U,6,7)=$S($D(DUZ):DUZ,1:"")_U_DT ;NAKED REFERENCE - ^SC(IFN,"S",Date,1,SDY,0) "RTN","SDM1A",94,0) S $P(^(0),"^",4)=D ;NAKED REFERENCE - ^SC(IFN,"S",Date,1,SDY,0) 544 moved DUZ&DT to tag S1. "RTN","SDM1A",95,0) D:$D(TMP) LINK^SDCNSLT(SC,SDY,SD,CNSLTLNK) ;SD/478 "RTN","SDM1A",96,0) D:$D(TMP) EDITCS^SDCNSLT(SD,TMPD,TMPYCLNC,CNSLTLNK) ;SD/478 "RTN","SDM1A",97,0) K TMP ;SD/478 "RTN","SDM1A",98,0) XR I $S('$D(^SC(SC,"RAD")):1,^("RAD")="Y":0,^("RAD")=1:0,1:1) S %=2 W !,"WANT PREVIOUS X-RAY RESULTS SENT TO CLINIC" D YN^DICN G:'% HXR I '(%-1) S ^SC("ARAD",SC,SD,DFN)="" "RTN","SDM1A",99,0) SDMM S SDEMP=0 I COLLAT=7 S:SDEC'=SDCOL SDEMP=SDCOL G OV "RTN","SDM1A",100,0) D ELIG^VADPT I $O(VAEL(1,0))>0 D ELIG^SDM4:"369"[SDAPTYP S SDEMP=$S(SDDECOD:SDDECOD,1:SDEMP) "RTN","SDM1A",101,0) OV Q:$D(SDZM) K SDQ1,SDEC,SDCOL I +SDEMP S $P(^SC(SC,"S",SD,1,SDY,0),"^",10)=+SDEMP "RTN","SDM1A",102,0) S SDMADE=1 D EVT Q "RTN","SDM1A",103,0) HXR W !," Enter YES to have previous XRAY results sent to the clinic" G XR "RTN","SDM1A",104,0) Q "RTN","SDM1A",105,0) CS S SDCS=+$P(^SC(+SC,0),"^",7) I $S('$D(^DIC(40.7,SDCS,0)):1,'$P(^(0),"^",3):0,1:$P(^(0),"^",3)'>DT) W !!,*7,"** WARNING - CLINIC HAS AN INVALID OR INACTIVE STOP CODE!!!",!! "RTN","SDM1A",106,0) S SDCS=+$P(^SC(+SC,0),"^",18) I $S('SDCS:0,'$D(^DIC(40.7,SDCS,0)):1,'$P(^(0),"^",3):0,1:$P(^(0),"^",3)'>DT) W !!,*7,"** WARNING - CLINIC HAS AN INVALID OR INACTIVE CREDIT STOP CODE!!!",!! "RTN","SDM1A",107,0) K SDCS Q "RTN","SDM1A",108,0) STATUS(SDCL,SDINP,SDT) ; -- determine status for NEW appts "RTN","SDM1A",109,0) Q $S(SDINP]"":SDINP,$$CHK(.SDCL,.SDT):"NT",1:"") "RTN","SDM1A",110,0) CHK(SDCL,SDT) ; -- should appt be NT'ed "RTN","SDM1A",111,0) ; -- non-count clinic check := don't NT appt "RTN","SDM1A",112,0) ; -- appt update executed := need to NT appt "RTN","SDM1A",113,0) ; -- otherwise := don't NT appt "RTN","SDM1A",114,0) Q $S($P($G(^SC(SDCL,0)),U,17)="Y":0,$D(^SDD(409.65,"AUPD",$P(SDT,"."))):1,1:0) "RTN","SDM1A",115,0) EVT ; -- separate tag if need to NEW vars "RTN","SDM1A",116,0) D MAKE^SDAMEVT(DFN,SD,SC,SDY,0) "RTN","SDM1A",117,0) Q "RTN","SDM1A",118,0) REQ(SDT) ; -- which is required check in(CI) or out(CO) "RTN","SDM1A",119,0) Q $S($$REQDT()>SDT:"CI",1:"CO") "RTN","SDM1A",120,0) REQDT() ; -- co required date "RTN","SDM1A",121,0) Q $S($P(^DG(43,1,"SCLR"),U,23):$P(^("SCLR"),U,23),1:2931001) "RTN","SDM1A",122,0) COCMP(DFN,SDT) ; -- date CO completed "RTN","SDM1A",123,0) Q $P($G(^SCE(+$P($G(^DPT(DFN,"S",SDT,0)),U,20),0)),U,7) "RTN","SDM1A",124,0) CI(SDCL,SDT,SDDA,SDACT) ; -- ok to update DPT "RTN","SDM1A",125,0) N C "RTN","SDM1A",126,0) I '$$CHK(.SDCL,.SDT) G CIQ "RTN","SDM1A",127,0) I $$REQ(SDT)'="CI" G CIQ "RTN","SDM1A",128,0) I SDACT="SET",$D(^DPT(+^SC(SDCL,"S",SDT,1,SDDA,0),"S",SDT,0)),$P(^(0),U,2)="NT" S $P(^(0),U,2)="" "RTN","SDM1A",129,0) I SDACT="KILL" S C=$G(^SC(SDCL,"S",SDT,1,SDDA,"C")) I $D(^DPT(+$G(^(0)),"S",SDT,0)),$P(^(0),U,2)="",'$P(C,U,3) S $P(^(0),U,2)="NT" "RTN","SDM1A",130,0) CIQ Q "RTN","SDM1A",131,0) CO(SDCL,SDT,SDDA,SDACT) ; -- ok to update DPT "RTN","SDM1A",132,0) N DFN,C "RTN","SDM1A",133,0) I '$$CHK(.SDCL,.SDT) G COQ "RTN","SDM1A",134,0) I $$REQ(.SDT)'="CO" D G COQ "RTN","SDM1A",135,0) .I SDACT="SET",$D(^DPT(+^SC(SDCL,"S",SDT,1,SDDA,0),"S",SDT,0)),$P(^(0),U,2)="NT" S $P(^(0),U,2)="" "RTN","SDM1A",136,0) .I SDACT="KILL" S C=$G(^SC(SDCL,"S",SDT,1,SDDA,"C")) I $D(^DPT(+$G(^(0)),"S",SDT,0)),$P(^(0),U,2)="",'C S $P(^(0),U,2)="NT" "RTN","SDM1A",137,0) S DFN=+^SC(SDCL,"S",SDT,1,SDDA,0) "RTN","SDM1A",138,0) D UPD(.DFN,.SDT,$$COCMP(.DFN,.SDT),$S(SDACT="SET":X,1:"")) "RTN","SDM1A",139,0) COQ Q "RTN","SDM1A",140,0) UPD(DFN,SDT,SDCOCMP,SDCODT) ; -- update status "RTN","SDM1A",141,0) N Y "RTN","SDM1A",142,0) I $D(^DPT(DFN,"S",SDT,0)) S Y=$P(^(0),U,2) D "RTN","SDM1A",143,0) .I 'SDCOCMP!('SDCODT) S:Y="" $P(^DPT(DFN,"S",SDT,0),U,2)="NT" Q "RTN","SDM1A",144,0) .S:Y="NT" $P(^DPT(DFN,"S",SDT,0),U,2)="" "RTN","SDM1A",145,0) Q "RTN","SDM1A",146,0) OE(SDOE,SDACT) ; -- called by x-ref on co completed field(#.07) in ^SCE "RTN","SDM1A",147,0) N Y S Y=^SCE(SDOE,0) "RTN","SDM1A",148,0) I $P(Y,U,8)'=1 G OEQ "RTN","SDM1A",149,0) I $$REQ(+Y)'="CO" G OEQ "RTN","SDM1A",150,0) I '$$CANT(+$P(Y,U,2),+Y,SDOE),'$$CHK(+$P(Y,U,4),+Y) G OEQ "RTN","SDM1A",151,0) D UPD(+$P(Y,U,2),+Y,$S(SDACT="SET":X,1:""),$P($G(^SC(+$P(Y,U,4),"S",+Y,1,+$P(Y,U,9),"C")),U,3)) "RTN","SDM1A",152,0) OEQ Q "RTN","SDM1A",153,0) CONF(SDSRTY,SDSRFU,DFN,SDT,SC) ;Confirm scheduling request type "RTN","SDM1A",154,0) ;Input: SDSRTY=request type "RTN","SDM1A",155,0) ;Input: SDSRFU=follow-up indicator "RTN","SDM1A",156,0) ;Input: DFN=patient ien "RTN","SDM1A",157,0) ;Input: SDT=appointment date/time "RTN","SDM1A",158,0) ;Input: SC=clinic ifn "RTN","SDM1A",159,0) N DIR,DIE,DA,DR,SDX,SDY,X,Y "RTN","SDM1A",160,0) S DIR(0)="Y",DIR("B")="YES" "RTN","SDM1A",161,0) S DIR("A")="THIS APPOINTMENT IS MARKED AS '"_SDSRTY(0)_"', IS THIS CORRECT" "RTN","SDM1A",162,0) W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) "RTN","SDM1A",163,0) I 'Y S SDX='SDSRTY,SDX(0)=$$TXRT(.SDX) W !!,"THIS APPOINTMENT HAS NOW BEEN MARKED AS '"_$S('SDSRTY:"",1:"NOT ")_"NEXT AVAILABLE'." "RTN","SDM1A",164,0) ;S DIR("A")="THIS APPOINTMENT IS DEFINED AS '"_$S(SDSRFU:"FOLLOW-UP",1:"OTHER THAN FOLLOW-UP")_"', OK" "RTN","SDM1A",165,0) ;W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) "RTN","SDM1A",166,0) ;I 'Y S SDY='SDSRFU W " (changed)" "RTN","SDM1A",167,0) Q:'$D(SDX) S DR="" "RTN","SDM1A",168,0) I $D(SDX) S DR="25///^S X=$P(SDX,U,2);26///^S X=$$NAVA^SDMANA(SC,SDT,$P(SDX,U,2))" "RTN","SDM1A",169,0) ;I $D(SDY) S:$L(DR) DR=DR_";" S DR=DR_"26///^S X=SDY" "RTN","SDM1A",170,0) S DA=SDT,DA(1)=DFN "RTN","SDM1A",171,0) S DIE="^DPT(DA(1),""S""," D ^DIE "RTN","SDM1A",172,0) Q "RTN","SDM1A",173,0) TXRT(SDSRTY) ;Transform request type "RTN","SDM1A",174,0) ;Input: SDSRTY=variable to return request type (pass by reference) "RTN","SDM1A",175,0) ;Output: external text for SDSRTY(0) "RTN","SDM1A",176,0) I SDSRTY S SDSRTY=SDSRTY_U_"N" Q "NEXT AVAILABLE" "RTN","SDM1A",177,0) S SDSRTY=SDSRTY_U_"O" Q "NOT NEXT AVAILABLE" "RTN","SDM1A",178,0) CANT(DFN,SDT,SDOE) ;Determine if clinic appt. has been marked "NT" "RTN","SDM1A",179,0) ;Output: '1' if appt. points to encounter and is marked "NT", otherwise '0' "RTN","SDM1A",180,0) N SDAPP S SDAPP=$G(^DPT(DFN,"S",SDT,0)) "RTN","SDM1A",181,0) Q:$P(SDAPP,U,20)'=SDOE 0 "RTN","SDM1A",182,0) Q $P(SDAPP,U,2)="NT" "RTN","SDM1A",183,0) ; -- Variable doc for above tags "RTN","SDM1A",184,0) ; SDCL := file 44 ien "RTN","SDM1A",185,0) ; SDT := appt date/time "RTN","SDM1A",186,0) ; DFN := file 2 ien "RTN","SDM1A",187,0) ; SDDA := ^SC(SDCL,"S",SDT,1,SDDA,0) "RTN","SDM1A",188,0) ; SDACT := current x-ref action 'set' or 'kill' "RTN","SDM1A",189,0) ; SDCOCMP := check out completed date "RTN","SDM1A",190,0) ; SDCODT := check out date/time "RTN","SDM1A",191,0) ; SDOE := Outpatient Encounter ien "RTN","SDM1A",192,0) ; SDINP := inpatient status ('I' or null) "RTN","SDM1A",193,0) ; SDINP := inpatient status ('I' or null) "VER") 8.0^22.0 "BLD",8094,6) ^463 **END** **END**