Released SD*5.3*665 SEQ #549 Extracted from mail message **KIDS**:SD*5.3*665^ **INSTALL NAME** SD*5.3*665 "BLD",10315,0) SD*5.3*665^SCHEDULING^0^3170621^y "BLD",10315,4,0) ^9.64PA^^ "BLD",10315,6.3) 14 "BLD",10315,"INIT") POST^SDEC665 "BLD",10315,"KRN",0) ^9.67PA^779.2^20 "BLD",10315,"KRN",.4,0) .4 "BLD",10315,"KRN",.401,0) .401 "BLD",10315,"KRN",.402,0) .402 "BLD",10315,"KRN",.403,0) .403 "BLD",10315,"KRN",.5,0) .5 "BLD",10315,"KRN",.84,0) .84 "BLD",10315,"KRN",3.6,0) 3.6 "BLD",10315,"KRN",3.8,0) 3.8 "BLD",10315,"KRN",9.2,0) 9.2 "BLD",10315,"KRN",9.8,0) 9.8 "BLD",10315,"KRN",9.8,"NM",0) ^9.68A^26^26 "BLD",10315,"KRN",9.8,"NM",1,0) SDAMWI1^^0^B16671818 "BLD",10315,"KRN",9.8,"NM",2,0) SDEC^^0^B129056425 "BLD",10315,"KRN",9.8,"NM",3,0) SDEC01A^^0^B116433919 "BLD",10315,"KRN",9.8,"NM",4,0) SDEC07^^0^B185524828 "BLD",10315,"KRN",9.8,"NM",5,0) SDEC07B^^0^B54807714 "BLD",10315,"KRN",9.8,"NM",6,0) SDEC08^^0^B209647726 "BLD",10315,"KRN",9.8,"NM",7,0) SDEC32^^0^B103453639 "BLD",10315,"KRN",9.8,"NM",8,0) SDEC40^^0^B68854167 "BLD",10315,"KRN",9.8,"NM",9,0) SDEC56^^0^B59961693 "BLD",10315,"KRN",9.8,"NM",10,0) SDEC665^^0^B24153499 "BLD",10315,"KRN",9.8,"NM",11,0) SDECIDX^^0^B47077475 "BLD",10315,"KRN",9.8,"NM",12,0) SDECUTL^^0^B101052538 "BLD",10315,"KRN",9.8,"NM",13,0) SDECWL^^0^B99990256 "BLD",10315,"KRN",9.8,"NM",14,0) SDM1A^^0^B130744784 "BLD",10315,"KRN",9.8,"NM",15,0) SDM4^^0^B43938157 "BLD",10315,"KRN",9.8,"NM",16,0) SDMM1^^0^B21571193 "BLD",10315,"KRN",9.8,"NM",17,0) SDEC54^^0^B194101898 "BLD",10315,"KRN",9.8,"NM",18,0) SDEC54A^^0^B83794184 "BLD",10315,"KRN",9.8,"NM",19,0) SDECWL2^^0^B126043834 "BLD",10315,"KRN",9.8,"NM",20,0) SDEC25^^0^B108318139 "BLD",10315,"KRN",9.8,"NM",21,0) SDEC50^^0^B97773017 "BLD",10315,"KRN",9.8,"NM",22,0) SDEC57^^0^B110596286 "BLD",10315,"KRN",9.8,"NM",23,0) SDECDEV^^0^B81564531 "BLD",10315,"KRN",9.8,"NM",24,0) SDECU^^0^B23913880 "BLD",10315,"KRN",9.8,"NM",25,0) SDECUTL2^^0^B142335116 "BLD",10315,"KRN",9.8,"NM",26,0) SDECWL3^^0^B33768778 "BLD",10315,"KRN",9.8,"NM","B","SDAMWI1",1) "BLD",10315,"KRN",9.8,"NM","B","SDEC",2) "BLD",10315,"KRN",9.8,"NM","B","SDEC01A",3) "BLD",10315,"KRN",9.8,"NM","B","SDEC07",4) "BLD",10315,"KRN",9.8,"NM","B","SDEC07B",5) "BLD",10315,"KRN",9.8,"NM","B","SDEC08",6) "BLD",10315,"KRN",9.8,"NM","B","SDEC25",20) "BLD",10315,"KRN",9.8,"NM","B","SDEC32",7) "BLD",10315,"KRN",9.8,"NM","B","SDEC40",8) "BLD",10315,"KRN",9.8,"NM","B","SDEC50",21) "BLD",10315,"KRN",9.8,"NM","B","SDEC54",17) "BLD",10315,"KRN",9.8,"NM","B","SDEC54A",18) "BLD",10315,"KRN",9.8,"NM","B","SDEC56",9) "BLD",10315,"KRN",9.8,"NM","B","SDEC57",22) "BLD",10315,"KRN",9.8,"NM","B","SDEC665",10) "BLD",10315,"KRN",9.8,"NM","B","SDECDEV",23) "BLD",10315,"KRN",9.8,"NM","B","SDECIDX",11) "BLD",10315,"KRN",9.8,"NM","B","SDECU",24) "BLD",10315,"KRN",9.8,"NM","B","SDECUTL",12) "BLD",10315,"KRN",9.8,"NM","B","SDECUTL2",25) "BLD",10315,"KRN",9.8,"NM","B","SDECWL",13) "BLD",10315,"KRN",9.8,"NM","B","SDECWL2",19) "BLD",10315,"KRN",9.8,"NM","B","SDECWL3",26) "BLD",10315,"KRN",9.8,"NM","B","SDM1A",14) "BLD",10315,"KRN",9.8,"NM","B","SDM4",15) "BLD",10315,"KRN",9.8,"NM","B","SDMM1",16) "BLD",10315,"KRN",19,0) 19 "BLD",10315,"KRN",19.1,0) 19.1 "BLD",10315,"KRN",101,0) 101 "BLD",10315,"KRN",409.61,0) 409.61 "BLD",10315,"KRN",771,0) 771 "BLD",10315,"KRN",779.2,0) 779.2 "BLD",10315,"KRN",870,0) 870 "BLD",10315,"KRN",8989.51,0) 8989.51 "BLD",10315,"KRN",8989.52,0) 8989.52 "BLD",10315,"KRN",8994,0) 8994 "BLD",10315,"KRN","B",.4,.4) "BLD",10315,"KRN","B",.401,.401) "BLD",10315,"KRN","B",.402,.402) "BLD",10315,"KRN","B",.403,.403) "BLD",10315,"KRN","B",.5,.5) "BLD",10315,"KRN","B",.84,.84) "BLD",10315,"KRN","B",3.6,3.6) "BLD",10315,"KRN","B",3.8,3.8) "BLD",10315,"KRN","B",9.2,9.2) "BLD",10315,"KRN","B",9.8,9.8) "BLD",10315,"KRN","B",19,19) "BLD",10315,"KRN","B",19.1,19.1) "BLD",10315,"KRN","B",101,101) "BLD",10315,"KRN","B",409.61,409.61) "BLD",10315,"KRN","B",771,771) "BLD",10315,"KRN","B",779.2,779.2) "BLD",10315,"KRN","B",870,870) "BLD",10315,"KRN","B",8989.51,8989.51) "BLD",10315,"KRN","B",8989.52,8989.52) "BLD",10315,"KRN","B",8994,8994) "BLD",10315,"QUES",0) ^9.62^^ "BLD",10315,"REQB",0) ^9.611^2^2 "BLD",10315,"REQB",1,0) SD*5.3*658^1 "BLD",10315,"REQB",2,0) SD*5.3*585^1 "BLD",10315,"REQB","B","SD*5.3*585",2) "BLD",10315,"REQB","B","SD*5.3*658",1) "INIT") POST^SDEC665 "MBREQ") 0 "PKG",48,-1) 1^1 "PKG",48,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",48,20,0) ^9.402P^^ "PKG",48,22,0) ^9.49I^1^1 "PKG",48,22,1,0) 5.3^3051119^2960613 "PKG",48,22,1,"PAH",1,0) 665^3170621^104 "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") NO "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") 26 "RTN","SDAMWI1") 0^1^B16671818^B15911901 "RTN","SDAMWI1",1,0) SDAMWI1 ;ALB/MJK - Walk-Ins (cont.) ;JUN 21, 2017 "RTN","SDAMWI1",2,0) ;;5.3;Scheduling;**94,167,206,168,544,627,651,665**;Aug 13, 1993;Build 14 "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,SDAP,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) S SDAP=$$APPTGET^SDECUTL(DFN,SDT,SDCL) ;get SDEC APPOINTMENT ien alb/sat 627 "RTN","SDAMWI1",20,0) I SDAP="" D SDEC ;alb/sat 627 "RTN","SDAMWI1",21,0) ;update availability grid "RTN","SDAMWI1",22,0) N HSI,SDDIF,SI,SL,STARTDAY,STR,SDNOT,X,SB,Y,S,I,ST,SS,SM "RTN","SDAMWI1",23,0) S SD=SDT,SC=SDCL "RTN","SDAMWI1",24,0) I '$D(^SC(SC,"ST",$P(SD,"."),1)) Q 1 "RTN","SDAMWI1",25,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",26,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",27,0) S SM=0 "RTN","SDAMWI1",28,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",29,0) SP I ST+ST>$L(S) S S=S_" " G SP "RTN","SDAMWI1",30,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",31,0) S ^SC(+SC,"ST",$P(SD,"."),1)=S "RTN","SDAMWI1",32,0) C L -^SC(+SC,"ST",$P(SD,"."),1) "RTN","SDAMWI1",33,0) Q 1 "RTN","SDAMWI1",34,0) ; "RTN","SDAMWI1",35,0) SDEC ;update SDEC APPOINTMENT file 409.84 ;alb/sat 627 "RTN","SDAMWI1",36,0) N SDAPPT,SDECSL,SDRES ;alb/sat 627 - add SDAPPT ;alb/sat 651 add SDECSL "RTN","SDAMWI1",37,0) S SDAPTYP=$G(SDAPTYP) "RTN","SDAMWI1",38,0) S:SDAPTYP="" SDAPTYP=$$GET1^DIQ(44,SDCL_",",2507,"I") "RTN","SDAMWI1",39,0) S SDECANS=$G(SDECANS) ;alb/sat 665 "RTN","SDAMWI1",40,0) I $G(SDWL)="" N SDCLN S SDCLN=$$GET1^DIQ(44,SDCL_",",.01) S SDAPPT=$$SDWLA^SDM1A(DFN,SDT,SDCLN,$P(SDT,".",1),SDAPTYP,SDECANS) ;alb/sat 665 add SDECANS "RTN","SDAMWI1",41,0) K SDECANS ;alb/sat 665 "RTN","SDAMWI1",42,0) S SDRES=$$GETRES^SDECUTL(SDCL) "RTN","SDAMWI1",43,0) S SDECSL=$G(SL) ;alb/sat 651 "RTN","SDAMWI1",44,0) I '+SDECSL S SDECSL=$G(^SC(SDCL,"SL")) ;alb/sat 651 "RTN","SDAMWI1",45,0) D SDECADD^SDEC07(SDT,$S(+SDECSL:$$FMADD^XLFDT(SDT,,,+SDECSL),1:""),DFN,SDRES,"WALKIN",$P(SDT,".",1),"",$S($G(SDWL)'="":"E|"_SDWL,1:"A|"_SDAPPT),,SDCL,,,,SDAPTYP) ;ADD SDEC APPOINTMENT ENTRY ;alb/sat 651 use SDECSL "RTN","SDAMWI1",46,0) Q "RTN","SDAMWI1",47,0) ;end addition/modification ;alb/sat 627 "RTN","SDAMWI1",48,0) ; "RTN","SDAMWI1",49,0) RT ; -- request record "RTN","SDAMWI1",50,0) S SDRT="A",SDTTM=SDT,SDPL=I,SDSC=SC D RT^SDUTL "RTN","SDAMWI1",51,0) Q "RTN","SDAMWI1",52,0) ; "RTN","SDAMWI1",53,0) ROUT(DFN) ; -- print routing slip "RTN","SDAMWI1",54,0) S DIR("A")="DO YOU WANT TO PRINT A ROUTING SLIP NOW",DIR(0)="Y" "RTN","SDAMWI1",55,0) W ! D ^DIR K DIR G ROUTQ:$D(DIRUT)!(Y=0) "RTN","SDAMWI1",56,0) K IOP S (SDX,SDSTART,ORDER,SDREP)="" D EN^SDROUT1 "RTN","SDAMWI1",57,0) ROUTQ Q "RTN","SDAMWI1",58,0) ; "RTN","SDAMWI1",59,0) DUAL ; -- ask elig if pt has more than one "RTN","SDAMWI1",60,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",61,0) Q "RTN","SDAMWI1",62,0) ; "RTN","SDAMWI1",63,0) EVT ; -- separate if need to NEW vars "RTN","SDAMWI1",64,0) N I,DIV D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,0) "RTN","SDAMWI1",65,0) Q "RTN","SDEC") 0^2^B129056425^B128616683 "RTN","SDEC",1,0) SDEC ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDEC",2,0) ;;5.3;Scheduling;**627,643,642,651,658,665**;Aug 13, 1993;Build 14 "RTN","SDEC",3,0) ; "RTN","SDEC",4,0) Q "RTN","SDEC",5,0) ; "RTN","SDEC",6,0) ACCGROUP(SDECY) ;EP return active entries from the SDEC ACCESS GROUP file 409.822 "RTN","SDEC",7,0) D ACCGROUP^SDEC45(.SDECY) Q "RTN","SDEC",8,0) ACCGPTYG(SDECY) ;EP Get access group types "RTN","SDEC",9,0) D ACCGPTYG^SDEC15(.SDECY) Q "RTN","SDEC",10,0) ACCTYPE(SDECY) ;EP return active entries from the SDEC ACCESS TYPE file 409.823 "RTN","SDEC",11,0) D ACCTYPE^SDEC45(.SDECY) Q "RTN","SDEC",12,0) ADDACCG(SDECY,SDECVAL) ;EP ADD/EDIT ACCESS GROUP "RTN","SDEC",13,0) D ADDACCG^SDEC21(.SDECY,$G(SDECVAL)) Q "RTN","SDEC",14,0) ADDACCTY(SDECY,SDECVAL) ;EP ADD/EDIT ACCESS TYPE "RTN","SDEC",15,0) D ADDACCTY^SDEC14(.SDECY,$G(SDECVAL)) Q "RTN","SDEC",16,0) ADDAGI(SDECY,SDECIEN,SDECIEN1) ;EP Add access group item - Adds ACCESS GROUP TYPE file entry "RTN","SDEC",17,0) D ADDAGI^SDEC22(.SDECY,$G(SDECIEN),$G(SDECIEN1)) Q "RTN","SDEC",18,0) ADDRES(SDECY,SDECVAL) ;EP ADD/EDIT RESOURCE "RTN","SDEC",19,0) D ADDRES^SDEC16(.SDECY,$G(SDECVAL)) Q "RTN","SDEC",20,0) ADDRESU(SDECY,SDECVAL) ;EP ADD/EDIT RESOURCE USER "RTN","SDEC",21,0) D ADDRESU^SDEC18(.SDECY,$G(SDECVAL)) Q "RTN","SDEC",22,0) ADDRG(SDECY,SDECVAL) ;EP ADD/EDIT RESOURCE GROUP "RTN","SDEC",23,0) D ADDRG^SDEC19(.SDECY,$G(SDECVAL)) Q "RTN","SDEC",24,0) ADDRGI(SDECY,SDECIEN,SDECIEN1) ;EP Adds RESOURCEID SDECIEN1 to RESOURCE GROUP entry SDECIEN "RTN","SDEC",25,0) D ADDRGI^SDEC20(.SDECY,$G(SDECIEN),$G(SDECIEN1)) Q "RTN","SDEC",26,0) APBLKALL(SDECY,SDECSTART,SDECEND) ;EP List of all appointments for all resources "RTN","SDEC",27,0) D APBLKALL^SDEC05(.SDECY,$G(SDECSTART),$G(SDECEND)) Q "RTN","SDEC",28,0) APBLKOV(SDECY,SDECSTART,SDECEND,SDECRES,SDECWI) ;EP APPT BLOCKS OVERLAP "RTN","SDEC",29,0) D APBLKOV^SDEC05(.SDECY,$G(SDECSTART),$G(SDECEND),$G(SDECRES),$G(SDECWI)) Q "RTN","SDEC",30,0) APPADD ;EP ADD NEW APPOINTMENT "RTN","SDEC",31,0) Q ;rpc calls directly to APPADD^SDEC07 "RTN","SDEC",32,0) APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER) ;EP Cancels appointment "RTN","SDEC",33,0) D APPDEL^SDEC08(.SDECY,$G(SDECAPTID),$G(SDECTYP),$G(SDECCR),$G(SDECNOT),$G(SDECDATE),$G(SDUSER)) Q "RTN","SDEC",34,0) APPIDGET(SDECY,SDID) ;GET SDEC APPOINTMENT ien for given External ID "RTN","SDEC",35,0) D APPIDGET^SDEC55(.SDECY,$G(SDID)) Q "RTN","SDEC",36,0) APPSDGET(SDECY,MAXREC,LASTSUB,SDBEG,SDEND,NOTEFLG,SDRES,DFN,SDID,SDIEN) ;GET appointment data from SDEC APPOINTMENT file 409.84 "RTN","SDEC",37,0) D APPSDGET^SDEC55A(.SDECY,$G(MAXREC),$G(LASTSUB),$G(SDBEG),$G(SDEND),$G(NOTEFLG),$G(SDRES),$G(DFN),$G(SDID),$G(SDIEN)) Q "RTN","SDEC",38,0) APPSLOTS(SDECY,SDCL,SDBEG,SDEND) ;return array of appt slots and availability - RPC "RTN","SDEC",39,0) D APPSLOTS^SDEC57(.SDECY,$G(SDCL),$G(SDBEG),$G(SDEND)) Q "RTN","SDEC",40,0) APPTEVLG(SDECY,DFN) ;EP return appointment data for given patient - RPC "RTN","SDEC",41,0) D APPTEVLG^SDEC38(.SDECY,$G(DFN)) Q "RTN","SDEC",42,0) APPTLETR(SDECY,SDECAPID,LT) ;EP Print Appointment Letter "RTN","SDEC",43,0) D APPTLETR^SDEC40(.SDECY,$G(SDECAPID),$G(LT)) Q "RTN","SDEC",44,0) APPTYPES(RET,DFN) ; EP for SDEC APPTYPES - Return all active Appointment types from the APPOINTMENT TYPE file 409.1 "RTN","SDEC",45,0) D APPTYPES^SDECWL(.RET,$G(DFN)) Q "RTN","SDEC",46,0) ARCLOSE(RET,INP...) ; "RTN","SDEC",47,0) D ARCLOSE^SDECAR(.RET,.INP) Q "RTN","SDEC",48,0) ARCLOSE1(RET,INP) ; Appt Request CLOSE (without ... for VistA calls) "RTN","SDEC",49,0) D ARCLOSE^SDECAR(.RET,.INP) Q "RTN","SDEC",50,0) ARDGET(SDECY) ;get values for disposition field of SDEC APPT REQUEST file "RTN","SDEC",51,0) D ARDGET^SDECAR(.SDECY) Q "RTN","SDEC",52,0) ARGET(RET,ARIEN1,MAXREC,SDBEG,SDEND,DFN,LASTSUB,SDTOP,SVCL,DESDT,PRL,SVCR,SCVISIT,CLINIC,ORIGDT) ;EP Appt Request GET "RTN","SDEC",53,0) D ARGET^SDECAR1(.RET,$G(ARIEN1),$G(MAXREC),$G(SDBEG),$G(SDEND),$G(DFN),$G(LASTSUB),$G(SDTOP),$G(SVCL),$G(DESDT),$G(PRL),$G(SVCR),$G(SCVISIT),$G(CLINIC),$G(ORIGDT)) Q "RTN","SDEC",54,0) ARMRTGET(SDECY,ARIEN) ;GET number of entries and values in MRTC CALC PREF DATES "RTN","SDEC",55,0) D ARMRTGET^SDECAR(.SDECY,$G(ARIEN)) Q "RTN","SDEC",56,0) ARMRTSET(SDECY,ARIEN,MRTC) ;SET MRTC CALC PREF DATES dates - clears the multiple and sets the new ones that are passed in "RTN","SDEC",57,0) D ARMRTSET^SDECAR(.SDECY,$G(ARIEN),$G(MRTC)) Q "RTN","SDEC",58,0) AROPEN(RET,ARAPP,ARIEN,ARDDT) ;Appt Request Open/re-open "RTN","SDEC",59,0) D AROPEN^SDECAR(.RET,$G(ARAPP),$G(ARIEN),$G(ARDDT)) Q "RTN","SDEC",60,0) ARPCSET(SDECY,INP,ARIEN) ;SET update patient contacts in SDEC APPT REQUEST file "RTN","SDEC",61,0) D ARPCSET^SDECAR(.SDECY,$G(INP),$G(ARIEN)) Q "RTN","SDEC",62,0) ARSET(RET,INP...) ;EP Appt Request Set "RTN","SDEC",63,0) D ARSET^SDECAR2(.RET,.INP) Q "RTN","SDEC",64,0) ARSET1(RET,INP) ;EP Appt Request Set (without ... for VistA calls) "RTN","SDEC",65,0) D ARSET^SDECAR2(.RET,.INP) Q "RTN","SDEC",66,0) AVADD(SDECY,SDECSTART,SDECEND,SDECTYPID,SDECRES,SDECSLOTS,SDECNOTE) ;EP SET Create entry in SDEC ACCESS BLOCK "RTN","SDEC",67,0) D AVADD^SDEC12(.SDECY,$G(SDECSTART),$G(SDECEND),$G(SDECTYPID),$G(SDECRES),$G(SDECSLOTS),$G(SDECNOTE)) Q "RTN","SDEC",68,0) AVDEL(SDECY,SDECAVID) ;EP Cancel Availability - Deletes Access Block "RTN","SDEC",69,0) D AVDEL^SDEC13(.SDECY,$G(SDECAVID)) Q "RTN","SDEC",70,0) AVDELDT(SDECY,SDECRESD,SDECSTART,SDECEND) ;EP Cancel availability in a date range "RTN","SDEC",71,0) D AVDELDT^SDEC13(.SDECY,$G(SDECRESD),$G(SDECSTART),$G(SDECEND)) Q "RTN","SDEC",72,0) CANCKOUT(SDECY,SDECAPTID) ;EP Cancel Check Out appointment "RTN","SDEC",73,0) D CANCKOUT^SDEC25(.SDECY,$G(SDECAPTID)) Q "RTN","SDEC",74,0) CANREAS(SDECY,SDECIN) ;EP return active/inactive entries from the CANCELLATION REASONS table 409.2 "RTN","SDEC",75,0) D CANREAS^SDEC45(.SDECY,$G(SDECIN)) Q "RTN","SDEC",76,0) CAP(SDECY,DFN,SDAMEVT,SDT,DVBADA,SDAUTORB,SDCANVET) ; "RTN","SDEC",77,0) D CAP^SDEC58(.SDECY,$G(DFN),$G(SDAMEVT),$G(SDT),$G(DVBADA),$G(SDAUTORB),$G(SDCANVET)) Q "RTN","SDEC",78,0) CGET(SDECY) ;GET active Countries from the COUNTRY CODE file 779.004 "RTN","SDEC",79,0) D CGET^SDEC55(.SDECY) Q "RTN","SDEC",80,0) CHECKIN(SDECY,SDECAPTID,SDECCDT,SDECCC,SDECPRV,SDECROU,SDECVCL,SDECVFM,SDECOG,SDECCR,SDECPCC,SDECWHF) ;EP Check in appointment "RTN","SDEC",81,0) D CHECKIN^SDEC25(.SDECY,$G(SDECAPTID),$G(SDECCDT),$G(SDECCC),$G(SDECPRV),$G(SDECROU),$G(SDECVCL),$G(SDECVFM),$G(SDECOG),$G(SDECCR),$G(SDECPCC),$G(SDECWHF)) Q "RTN","SDEC",82,0) CHECKOUT(SDECY,DFN,SDT,SDCODT,SDECAPTID,VPRV) ;EP Check Out appointment "RTN","SDEC",83,0) D CHECKOUT^SDEC25(.SDECY,$G(DFN),$G(SDT),$G(SDCODT),$G(SDECAPTID),$G(VPRV)) Q "RTN","SDEC",84,0) CLINALL(RET,MAXREC,SDECP) ; EP Return the IEN and NAME for all entries in the SD WL CLINIC LOCATION file "RTN","SDEC",85,0) D CLINALL^SDECWL(.RET,$G(MAXREC),$G(SDECP)) Q "RTN","SDEC",86,0) CLINCAN(SDECY,SDECCLST,SDECBEG,SDECEND) ;EP Return recordset of CANCELLED patient appointments "RTN","SDEC",87,0) D CLINCAN^SDEC34(.SDECY,$G(SDECCLST),$G(SDECBEG),$G(SDECEND)) Q "RTN","SDEC",88,0) CLINDIS(SDECY,SDECCLST,SDECBEG,SDECEND,SDECWI) ;EP Return formatted text output of the Clinic Schedules Report "RTN","SDEC",89,0) D CLINDIS^SDEC47(.SDECY,$G(SDECCLST),$G(SDECBEG),$G(SDECEND),$G(SDECWI)) Q "RTN","SDEC",90,0) CLINDISW(SDECY,SDECCLST,SDECBEG,SDECEND) ;EP Return formatted text output of the Clinic Schedules Report for Walkins "RTN","SDEC",91,0) D CLINDISW^SDEC47(.SDECY,$G(SDECCLST),$G(SDECBEG),$G(SDECEND)) Q "RTN","SDEC",92,0) CLINLET(SDECY,SDECCLST,SDECBEG,SDECEND,SDECWI) ;EP CLINIC LETTERS Appointment data "RTN","SDEC",93,0) D CLINLET^SDEC27(.SDECY,$G(SDECCLST),$G(SDECBEG),$G(SDECEND),$G(SDECWI)) Q "RTN","SDEC",94,0) CLINLETW(SDECY,SDECCLST,SDECBEG,SDECEND) ;EP CLINIC LETTERS WALK-IN Appointment data for Walk-in Appointments only "RTN","SDEC",95,0) D CLINLETW^SDEC27(.SDECY,$G(SDECCLST),$G(SDECBEG),$G(SDECEND)) Q "RTN","SDEC",96,0) CLINPROV(SDECY,SDECCL) ;EP return all providers for a given clinic from the HOSPITAL LOCATION file 44 "RTN","SDEC",97,0) D CLINPROV^SDEC45(.SDECY,$G(SDECCL)) Q "RTN","SDEC",98,0) CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET,MAXREC) ;EP Returns CLINIC SETUP PARAMETERS for clinics that are active in the HOSPITAL LOCATION file "RTN","SDEC",99,0) D CLINSET^SDEC32(.SDECY,$G(SDNOSLOT),$G(SDIENS),$G(SDECP),$G(SDNOLET),$G(MAXREC)) Q "RTN","SDEC",100,0) CLINSTOP(SDECY,SDP) ;EP CLINIC STOP remote procedure "RTN","SDEC",101,0) D CLINSTOP^SDEC45(.SDECY,$G(SDP)) Q "RTN","SDEC",102,0) COPYAPPT(SDECY,SDECRES,SDEC44,SDECBEG,SDECEND) ;EP Copy appointments from HOSPITAL LOCATION to SDEC RESOURCE "RTN","SDEC",103,0) D COPYAPPT^SDEC29(.SDECY,$G(SDECRES),$G(SDEC44),$G(SDECBEG),$G(SDECEND)) Q "RTN","SDEC",104,0) CPCANC(SDECY,SDECTSK) ;EP Copy Appointment Cancel "RTN","SDEC",105,0) D CPCANC^SDEC29(.SDECY,$G(SDECTSK)) Q "RTN","SDEC",106,0) CPSTAT(SDECY,SDECTSK) ;EP Copy Appointment Status "RTN","SDEC",107,0) D CPSTAT^SDEC29(.SDECY,$G(SDECTSK)) Q "RTN","SDEC",108,0) CRSCHED(SDECY,SDECRES,SDECSTART,SDECEND,SDECWKIN) ;EP Create Resource Appointment Schedule "RTN","SDEC",109,0) D CRSCHED^SDEC02(.SDECY,$G(SDECRES),$G(SDECSTART),$G(SDECEND),$G(SDECWKIN)) Q "RTN","SDEC",110,0) CSLOTSCH(SDECY,SDECRES,SDECSTART,SDECEND,SDECTYPES,SDECSRCH) ;GET Create Assigned Slot Schedule "RTN","SDEC",111,0) D CSLOTSCH^SDEC04(.SDECY,$G(SDECRES),$G(SDECSTART),$G(SDECEND),$G(SDECTYPES),$G(SDECSRCH)) Q "RTN","SDEC",112,0) CURFACG(SDECY,SDECDUZ) ;EP get current division/facility for given user "RTN","SDEC",113,0) D CURFACG^SDEC46(.SDECY,$G(SDECDUZ)) Q "RTN","SDEC",114,0) CVARAPPT(SDECY,SDCL) ;EP IS Clinic Variable Appointment Length "RTN","SDEC",115,0) D CVARAPPT^SDEC37(.SDECY,$G(SDCL)) Q "RTN","SDEC",116,0) DELAG(SDECY,SDECGRP) ;EP Deletes entry having IEN SDECGRP from SDEC ACCESS GROUP file "RTN","SDEC",117,0) D DELAG^SDEC21(.SDECY,$G(SDECGRP)) Q "RTN","SDEC",118,0) DELAGI(SDECY,SDECIEN,SDECIEN1) ;EP Deletes entry having Access Group SDECIEN and Access Type SDECIEN1 the SDEC ACCESS GROUP TYPE file "RTN","SDEC",119,0) D DELAGI^SDEC22(.SDECY,$G(SDECIEN),$G(SDECIEN1)) Q "RTN","SDEC",120,0) DELRESGP(SDECY,SDECGRP) ;EP Deletes entry name SDECGRP from SDEC RESOURCE GROUP file "RTN","SDEC",121,0) D DELRESGP^SDEC19(.SDECY,$G(SDECGRP)) Q "RTN","SDEC",122,0) DELRGI(SDECY,SDECIEN,SDECIEN1) ;EP Deletes entry SDECIEN1 from entry SDECIEN in the SDEC RESOURCE GROUP file "RTN","SDEC",123,0) D DELRGI^SDEC20(.SDECY,$G(SDECIEN),$G(SDECIEN1)) Q "RTN","SDEC",124,0) DELRU(SDECY,SDECIEN) ;EP Delete Resource User from SDEC RESOURCE USER file "RTN","SDEC",125,0) D DELRU^SDEC18(.SDECY,$G(SDECIEN)) Q "RTN","SDEC",126,0) EDITAPPT(SDECY,SDECAPTID,SDECNOTE,SDECLEN) ;EP Edit appointment (only 'note text' and appointment length can be edited) "RTN","SDEC",127,0) D EDITAPPT^SDEC26(.SDECY,$G(SDECAPTID),$G(SDECNOTE),$G(SDECLEN)) Q "RTN","SDEC",128,0) EHRPT(SDECY,SDECWID,SDECDFN) ;EP Raise patient selection event to EHR "RTN","SDEC",129,0) D EHRPT^SDEC30(.SDECY,$G(SDECWID),$G(SDECDFN)) Q "RTN","SDEC",130,0) ETHGET(SDECY) ;GET active Ethnicities from the ETHNICITY file 10.2 "RTN","SDEC",131,0) D ETHGET^SDEC55(.SDECY) Q "RTN","SDEC",132,0) ETHCMGET(SDECY) ;GET values from the RACE AND ETHNICITY COLLECTION METHOD file 10.3 "RTN","SDEC",133,0) D ETHCMGET^SDEC55(.SDECY) Q "RTN","SDEC",134,0) FACLIST(SDECY,DFN) ; Return list of remote facilities for patient "RTN","SDEC",135,0) D PTINQ^SDECPT(.SDECY,$G(DFN)) Q "RTN","SDEC",136,0) FAPPTGET(SDECY,DFN,SDBEG,SDEND,SDANC) ;GET Future appointments for given patient and date range "RTN","SDEC",137,0) D FAPPTGET^SDEC50(.SDECY,$G(DFN),$G(SDBEG),$G(SDEND),$G(SDANC)) Q "RTN","SDEC",138,0) GETFAC(SDECY,SDECDUZ) ;EP Gets all facilities for a user "RTN","SDEC",139,0) D GETFAC^SDEC46(.SDECY,$G(SDECDUZ)) Q "RTN","SDEC",140,0) GETONE(SDECY,SDGMR) ;EP Return data on one consult "RTN","SDEC",141,0) D GETONE^SDEC51(.SDECY,$G(SDGMR)) Q "RTN","SDEC",142,0) GETREGA(SDECRET,DFN) ;EP return basic reg info/demographics for given patient "RTN","SDEC",143,0) D GETREGA^SDEC09(.SDECRET,$G(DFN)) Q "RTN","SDEC",144,0) GETSITES(SDECY) ;return active National VA site names and station numbers "RTN","SDEC",145,0) D GETSITES^SDEC59(.SDECY) Q "RTN","SDEC",146,0) GETVPRV(BGOY,VPRV) ;EP return data from the V PROVIDER file "RTN","SDEC",147,0) D GETVPRV^SDEC44(.BGOY,$G(VPRV)) Q "RTN","SDEC",148,0) HIDE(SDECY) ;Return clinics hidden from display "RTN","SDEC",149,0) D HIDE^SDEC45(.SDECY) Q "RTN","SDEC",150,0) HOLIDAY(SDECY,SDECBD) ;EP return all entries from the HOLIDAY file 40.5 "RTN","SDEC",151,0) D HOLIDAY^SDEC45(.SDECY,$G(SDECBD)) Q "RTN","SDEC",152,0) HOSPLOC(SDECY,SDECP,MAXREC,LSUB) ;EP return HOSPITAL LOCATIONs "RTN","SDEC",153,0) D HOSPLOC^SDEC32(.SDECY,$G(SDECP),$G(MAXREC),$G(LSUB)) Q "RTN","SDEC",154,0) IMHERE(SDECRES) ;EP I'm Here "RTN","SDEC",155,0) D IMHERE^SDEC31(.SDECRES) Q "RTN","SDEC",156,0) NETLOC(SDECY,LOCATION) ;GET data from the NETWORK LOCATION file 2005.2 "RTN","SDEC",157,0) D NETLOC^SDEC59(.SDECY,$G(LOCATION)) Q "RTN","SDEC",158,0) NEWPERS(SDECY,SDCLASS,SDPART,MAXREC,LSUB,INACT) ;return entries from the USR CLASS MEMBERSHIP file that have the given USR CLASS (default is PROVIDER) "RTN","SDEC",159,0) D NEWPERS^SDEC45(.SDECY,$G(SDCLASS),$G(SDPART),$G(MAXREC),$G(LSUB),$G(INACT)) Q "RTN","SDEC",160,0) NOSHOPAT(SDECY,DFN,SDCL) ;EP COLLECT NO-SHOW DATA for Patient "RTN","SDEC",161,0) D NOSHOPAT^SDEC37(.SDECY,$G(DFN),$G(SDCL)) Q "RTN","SDEC",162,0) NOSHOW(SDECY,SDECAPTID,SDECNS,USERIEN,SDECDATE) ;EP Sets appointment noshow flag in SDEC APPOINTMENT file "RTN","SDEC",163,0) D NOSHOW^SDEC31(.SDECY,$G(SDECAPTID),$G(SDECNS),$G(USERIEN),$G(SDECDATE)) Q "RTN","SDEC",164,0) OVBOOK(SDECY,SDCL,SDBEG,SDECRES) ;EP RPC - OVERBOOK - CHECK FOR OVERBOOK FOR GIVEN CLINIC, DATE, AND RESOURCE "RTN","SDEC",165,0) D OVBOOK^SDEC07A(.SDECY,$G(SDCL),$G(SDBEG),$G(SDECRES)) Q "RTN","SDEC",166,0) PATAPPTD(SDECY,DFN) ;EP Return the Patient appointment display "RTN","SDEC",167,0) D PATAPPTD^SDEC27(.SDECY,$G(DFN)) Q "RTN","SDEC",168,0) PATAPPTH(SDECY,DFN) ;EP return patient's appointment history for given patient - RPC "RTN","SDEC",169,0) D PATAPPTH^SDEC48(.SDECY,$G(DFN)) Q "RTN","SDEC",170,0) PCSGET(SDECY,SDSVSP) ;GET clinics for a service/specialty (clinic stop) "RTN","SDEC",171,0) D PCSGET^SDEC50(.SDECY,$G(SDSVSP)) Q "RTN","SDEC",172,0) PCSTGET(SDECY,DFN,SDCL,SDBEG,SDEND) ;GET patient clinic status for a clinic for a given time frame - has the patient been seen by the given Clinic in the past 24 months "RTN","SDEC",173,0) D PCSTGET^SDEC50(.SDECY,$G(DFN),$G(SDCL),$G(SDBEG),$G(SDEND)) Q "RTN","SDEC",174,0) PCST2GET(SDECY,DFN,STOP,SDBEG,SDEND) ;GET patient clinic status for a service/specialty (clinic stop) for a given time frame - has the patient been seen any clinics with the given service/specialty (clinic stop) in the past 24 months "RTN","SDEC",175,0) D PCST2GET^SDEC50(.SDECY,$G(DFN),$G(STOP),$G(SDBEG),$G(SDEND)) Q "RTN","SDEC",176,0) PREFGET(SDECY,DFN,INAC) ;EP Get values from SDEC PREFERENCES AND SPECIAL NEEDS file for given patient "RTN","SDEC",177,0) D PREFGET^SDEC49(.SDECY,$G(DFN),$G(INAC)) Q "RTN","SDEC",178,0) PREFGETV(SDECY) ;EP Get all valid PREFERENCE text from SDEC PREFERENCES AND SPECIAL NEEDS file "RTN","SDEC",179,0) D PREFGETV^SDEC49(.SDECY) Q "RTN","SDEC",180,0) PREFSET(SDECY,DFN,PREF,REMARK) ;EP Set values to SDEC PREFERENCES AND SPECIAL NEEDS file ;alb/sat 658 add REMARK "RTN","SDEC",181,0) D PREFSET^SDEC49(.SDECY,$G(DFN),$G(PREF),$G(REMARK)) Q "RTN","SDEC",182,0) PRIV(SDECY,CLINIEN,USER) ;IS this USER in the PRIVILEGED USER multiple for the clinic "RTN","SDEC",183,0) D PRIV^SDEC32(.SDECY,$G(CLINIEN),$G(USER)) Q "RTN","SDEC",184,0) PROVALL(SDECY,SDECCL) ;EP return all providers for a given clinic from the HOSPITAL LOCATION file 44 "RTN","SDEC",185,0) D PROVALL^SDEC45(.SDECY,$G(SDECCL)) Q "RTN","SDEC",186,0) PROVCLIN(SDECY,SDECPRV) ;EP PROVIDER CLINICS remote procedure "RTN","SDEC",187,0) D PROVCLIN^SDEC45(.SDECY,$G(SDECPRV)) Q "RTN","SDEC",188,0) PTINQ(SDECY,DFN) ;GET output from ORWPT PTINQ in DataTable format "RTN","SDEC",189,0) D PTINQ^SDECPT(.SDECY,$G(DFN)) Q "RTN","SDEC",190,0) PTLOOKRS(SDECY,SDECP,SDECC,LASTSUB) ;EP Patient Lookup "RTN","SDEC",191,0) D PTLOOKRS^SDEC28(.SDECY,$G(SDECP),$G(SDECC),$G(LASTSUB)) Q "RTN","SDEC",192,0) PTSET(SDECY,INP...) ;SET patient demographics "RTN","SDEC",193,0) D PTSET^SDEC53(.SDECY,.INP) Q "RTN","SDEC",194,0) PTSET1(SDECY,INP) ;SET patient demographics (call from debug) "RTN","SDEC",195,0) D PTSET^SDEC53(.SDECY,.INP) Q "RTN","SDEC",196,0) RACEGET(SDECY) ;GET active Race entries from the RACE file 10 "RTN","SDEC",197,0) D RACEGET^SDEC55(.SDECY) Q "RTN","SDEC",198,0) RAISEVNT(SDECY,SDECEVENT,SDECPARAM,SDECSIP,SDECSPT) ;EP RAISE EVENT "RTN","SDEC",199,0) D RAISEVNT^SDEC23(.SDECY,$G(SDECEVENT),$G(SDECPARAM),$G(SDECSIP),$G(SDECSPT)) Q "RTN","SDEC",200,0) REBKCLIN(SDECY,SDECCLST,SDECBEG,SDECEND) ;EP Return recordset of rebooked patient appointments between given dates "RTN","SDEC",201,0) D REBKCLIN^SDEC34(.SDECY,$G(SDECCLST),$G(SDECBEG),$G(SDECEND)) Q "RTN","SDEC",202,0) REBKLIST(SDECY,SDECLIST) ;EP patient appointments used in listing REBOOKED appointments for a list of appointmentIDs. "RTN","SDEC",203,0) D REBKLIST^SDEC34(.SDECY,$G(SDECLIST)) Q "RTN","SDEC",204,0) REBKNEXT(SDECY,SDECDATE,SDECRES,SDECTPID) ;EP find the next ACCESS BLOCK in resource SDECRES after SDECSTART "RTN","SDEC",205,0) D REBKNEXT^SDEC33(.SDECY,$G(SDECDATE),$G(SDECRES),$G(SDECTPID)) Q "RTN","SDEC",206,0) RECIEN(SDECY,RECIEN) ;GET RECALL REMINDERS for given ID "RTN","SDEC",207,0) D RECIEN^SDEC52(.SDECY,$G(RECIEN)) Q "RTN","SDEC",208,0) RECGET(SDECY,DFN,SDBEG,SDEND,MAXREC,LASTSUB,RECIEN,SDSTOP,SDFLAGS,SDCLL) ; GET entries from the RECALL REMINDERS file 403.5 for a given Patient and Recall Date range. ;alb/sat 658 add SDCLL "RTN","SDEC",209,0) D RECGET^SDEC52(.SDECY,$G(DFN),$G(SDBEG),$G(SDEND),$G(MAXREC),$G(LASTSUB),$G(RECIEN),$G(SDSTOP),$G(SDFLAGS),$G(SDCLL)) Q "RTN","SDEC",210,0) RECSET(SDECY,INP...) ; SET/EDIT/CANCEL/DELETE an entry to the RECALL REMINDERS file 403.5 "RTN","SDEC",211,0) D RECSET^SDEC52A(.SDECY,.INP) Q "RTN","SDEC",212,0) RECSET1(SDECY,INP) ; SET/EDIT/CANCEL/DELETE an entry to the RECALL REMINDERS file 403.5 "RTN","SDEC",213,0) D RECSET^SDEC52A(.SDECY,.INP) Q "RTN","SDEC",214,0) RECDSET(SDECY,RECALLIEN,SDRRFTR,SDCOMM) ; DELETE an entry to the RECALL REMINDERS file 403.5 "RTN","SDEC",215,0) D RECDSET^SDEC52A(.SDECY,$G(RECALLIEN),$G(SDRRFTR),$G(SDCOMM)) Q "RTN","SDEC",216,0) RECAPGET(SDECY) ; GET entries from the RECALL REMINDERS APPT TYPE file 403.51 "RTN","SDEC",217,0) D RECAPGET^SDEC52B(.SDECY) Q "RTN","SDEC",218,0) RECPRGET(SDECY,RECINACT,SDECP,MAXREC,LASTSUB) ;GET entries from the RECALL REMINDERS PROVIDERS file 403.54 "RTN","SDEC",219,0) D RECPRGET^SDEC52B(.SDECY,$G(RECINACT),$G(SDECP),$G(MAXREC),$G(LASTSUB)) Q "RTN","SDEC",220,0) REGEVENT(SDECY,SDECEVENT,SDECIP,SDECPORT) ;EP Called by client to inform server of client's interest in SDECEVENT "RTN","SDEC",221,0) D REGEVENT^SDEC23(.SDECY,$G(SDECEVENT),$G(SDECIP),$G(SDECPORT)) Q "RTN","SDEC",222,0) REP1GET(SDECY,MAXREC,LASTSUB,PNAME) ;GET clinic data for report "RTN","SDEC",223,0) D REP1GET^SDEC56(.SDECY,$G(MAXREC),$G(LASTSUB),$G(PNAME)) Q "RTN","SDEC",224,0) REQGET(SDECY,SDBEG,SDEND,MAXREC,LASTSUB,SDGMR) ; GET entries with an ACTIVITY of RECEIVED, but do not have an ACTIVITY of SCHEDULED from the REQUEST/CONSULTATING file 123 "RTN","SDEC",225,0) D REQGET^SDEC51(.SDECY,$G(SDBEG),$G(SDEND),$G(MAXREC),$G(LASTSUB),$G(SDGMR)) Q "RTN","SDEC",226,0) RESGPUSR(SDECY,SDECDUZ) ;EP GROUP RESOURCE "RTN","SDEC",227,0) D RESGPUSR^SDEC01(.SDECY,$G(SDECDUZ)) Q "RTN","SDEC",228,0) RESGRPUS(SDECY,SDECDUZ) ;EP return ACTIVE resource group names for the given user "RTN","SDEC",229,0) D RESGRPUS^SDEC01(.SDECY,$G(SDECDUZ)) Q "RTN","SDEC",230,0) RESLETRF(SDECY,SDECRES,SDECLT) ;EP Return formatted text output of the Resource's Letter - either "LETTER TEXT" (also used as Reminder Letter), NO SHOW LETTER, or CLINIC CANCELLATION LETTER. "RTN","SDEC",231,0) D RESLETRF^SDEC47(.SDECY,$G(SDECRES),$G(SDECLT)) Q "RTN","SDEC",232,0) RESLETRS(SDECY,SDECLIST,SDLTR,SDNOS,SDCAN) ;EP GET recordset of RESOURCES and associated LETTERS "RTN","SDEC",233,0) D RESLETRS^SDEC35(.SDECY,$G(SDECLIST),$G(SDLTR),$G(SDNOS),$G(SDCAN)) Q "RTN","SDEC",234,0) RESUSER(SDECY,SDRES) ;EP SDEC RESOURCE USER remote procedure returns all entries from the SDEC RESOURCE USER table 409.833 "RTN","SDEC",235,0) D RESUSER^SDEC45(.SDECY,$G(SDRES)) Q "RTN","SDEC",236,0) RESOURCE(SDECY,SDECDUZ,SDACT,SDTYPE,MAXREC,LASTSUBI,SDIEN,SDECP) ;EP Returns ADO Recordset with ALL RESOURCE names "RTN","SDEC",237,0) D RESOURCE^SDEC01A(.SDECY,$G(SDECDUZ),$G(SDACT),$G(SDTYPE),$G(MAXREC),$G(LASTSUBI),$G(SDIEN),$G(SDECP)) Q "RTN","SDEC",238,0) SCHUSR(SDECY) ;EP Return recordset of all users in NEW PERSON having SDECZMENU key "RTN","SDEC",239,0) D SCHUSR^SDEC17(.SDECY) Q "RTN","SDEC",240,0) SEARCHAV(SDECY,SDECRES,SDECSTRT,SDECEND,SDECTYPES,SDECAMPM,SDECWKDY) ;EP Searches availability database "RTN","SDEC",241,0) D SEARCHAV^SDEC24(.SDECY,$G(SDECRES),$G(SDECSTRT),$G(SDECEND),$G(SDECTYPES),$G(SDECAMPM),$G(SDECWKDY)) Q "RTN","SDEC",242,0) SETFAC(SDECY,SDECDUZ,SDECFAC) ;EP SET FACILITY "RTN","SDEC",243,0) D SETFAC^SDEC46(.SDECY,$G(SDECDUZ),$G(SDECFAC)) Q "RTN","SDEC",244,0) SETRBOOK(SDECY,SDECAPPT,SDECDATE) ;EP Sets rebook date into appointment "RTN","SDEC",245,0) D SETRBOOK^SDEC33(.SDECY,$G(SDECAPPT),$G(SDECDATE)) Q "RTN","SDEC",246,0) SPACEBAR(SDECY,SDECDIC,SDECVAL) ;EP Update ^DISV with most recent lookup value SDECVAL from file SDECDIC "RTN","SDEC",247,0) D SPACEBAR^SDEC30(.SDECY,$G(SDECDIC),$G(SDECVAL)) Q "RTN","SDEC",248,0) SUMMGET(SDECRET,SDBEG,SDEND,USER,LSUB,MAXREC) ;GET Audit Summary for given date range "RTN","SDEC",249,0) D SUMMGET^SDEC54(.SDECRET,$G(SDBEG),$G(SDEND),$G(USER),$G(LSUB),$G(MAXREC)) Q "RTN","SDEC",250,0) SUMMAGET(SDECY,SDBEG,SDEND,USER,LSUB,MAXREC) ;get ALL appointments with a cancel status from SDEC APPOINTMENT for given date range and user "RTN","SDEC",251,0) D SUMMAGET^SDEC54A(.SDECY,$G(SDBEG),$G(SDEND),$G(USER),$G(LSUB),$G(MAXREC)) Q "RTN","SDEC",252,0) SUSRINFO(SDECY,SDECDUZ) ;EP SCHEDULING USER INFO "RTN","SDEC",253,0) D SUSRINFO^SDEC01(.SDECY,$G(SDECDUZ)) Q "RTN","SDEC",254,0) SVSPALL(RET) ; EP return IEN and NAME for all entries in the SD WL SERVICE/SPECIALTY file "RTN","SDEC",255,0) D SVSPALL^SDECWL(.RET) Q "RTN","SDEC",256,0) SYSSTAT(SDECY) ; EP SYSTEM STATUS "RTN","SDEC",257,0) D SYSSTAT^SDECUTL(.SDECY) Q "RTN","SDEC",258,0) TPBLKOV(SDECY,SDECSTART,SDECEND,SDECRES) ;EP TYPE BLOCKS OVERLAP "RTN","SDEC",259,0) D TPBLKOV^SDEC06(.SDECY,$G(SDECSTART),$G(SDECEND),$G(SDECRES)) Q "RTN","SDEC",260,0) UNDOCANA(SDECY,SDECAPTID) ;EP Undo Cancel Appointment "RTN","SDEC",261,0) D UNDOCANA^SDEC08(.SDECY,$G(SDECAPTID)) Q "RTN","SDEC",262,0) UNREGEV(SDECY,SDECEVENT,SDECIP,SDECPORT) ;EP rpc SDE UNREGEV Called by client to Unregister client's interest in SDECEVENT "RTN","SDEC",263,0) D UNREGEV^SDEC23(.SDECY,$G(SDECEVENT),$G(SDECIP),$G(SDECPORT)) Q "RTN","SDEC",264,0) WAITLIST(SDECY,SDECRES) ;EP COLLECT WAITLIST DATA "RTN","SDEC",265,0) D WAITLIST^SDEC36(.SDECY,$G(SDECRES)) Q "RTN","SDEC",266,0) WLCLOSE(RET,INP...) ; Waitlist CLOSE "RTN","SDEC",267,0) D WLCLOSE^SDECWL(.RET,.INP) Q "RTN","SDEC",268,0) WLCLOSE1(RET,INP) ; Waitlist CLOSE (without ... for VistA calls) "RTN","SDEC",269,0) D WLCLOSE^SDECWL(.RET,.INP) Q "RTN","SDEC",270,0) WLGET(RET,WLIEN1,MAXREC,SDBEG,SDEND,DFN,LASTSUB,SDTOP,SVCL,DESDT,PRI,SVCR,SCVISIT,CLINIC,ORIGDT) ;EP Waitlist GET ;alb/sat 658 add SVCL-SCVISIT "RTN","SDEC",271,0) D WLGET^SDECWL1(.RET,$G(WLIEN1),$G(MAXREC),$G(SDBEG),$G(SDEND),$G(DFN),$G(LASTSUB),$G(SDTOP),$G(SVCL),$G(DESDT),$G(PRI),$G(SVCR),$G(SCVISIT),$G(CLINIC),$G(ORIGDT)) Q "RTN","SDEC",272,0) WLHIDE(SDECY,DFN,WLCL) ;GET wait list entries in which the associated clinic's 'HIDE FROM DISPLAY?' field is 'YES' "RTN","SDEC",273,0) D WLHIDE^SDECWL3(.SDECY,$G(DFN),$G(WLCL)) Q "RTN","SDEC",274,0) WLOPEN(RET,WLAPP,WLIEN,WLDDT) ;SET Waitlist Open/re-open "RTN","SDEC",275,0) D WLOPEN^SDECWL(.RET,$G(WLAPP),$G(WLIEN),$G(WLDDT)) Q "RTN","SDEC",276,0) WLPCSET(SDECY,INP,WLIEN) ;SET update patient contacts in SD WAIT LIST file "RTN","SDEC",277,0) D WLPCSET^SDECWL(.SDECY,$G(INP),$G(WLIEN)) Q "RTN","SDEC",278,0) WLSET(RET,INP...) ;EP Waitlist Set "RTN","SDEC",279,0) D WLSET^SDECWL2(.RET,.INP) Q "RTN","SDEC",280,0) WLSET1(RET,INP) ;EP Waitlist Set (without ... for VistA calls) "RTN","SDEC",281,0) D WLSET^SDECWL2(.RET,.INP) Q "RTN","SDEC01A") 0^3^B116433919^B106852334 "RTN","SDEC01A",1,0) SDEC01A ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDEC01A",2,0) ;;5.3;Scheduling;**627,642,658,665**;Aug 13, 1993;Build 14 "RTN","SDEC01A",3,0) ; "RTN","SDEC01A",4,0) Q "RTN","SDEC01A",5,0) ; "RTN","SDEC01A",6,0) RESOURCE(SDECY,SDECDUZ,SDACT,SDTYPE,MAXREC,LASTSUBI,SDIEN,SDECP) ;Returns ADO Recordset with ALL RESOURCE names "RTN","SDEC01A",7,0) ; SDECDUZ = (optional) pointer to NEW PERSON file "RTN","SDEC01A",8,0) ; Defaults to current user "RTN","SDEC01A",9,0) ; checks that overbook is allowed "RTN","SDEC01A",10,0) ; SDACT = (optional) 1 or YES will return only active resources "RTN","SDEC01A",11,0) ; 0, NO, or null will include inactive "RTN","SDEC01A",12,0) ; SDTYPE = (optional) null will return all resource types "RTN","SDEC01A",13,0) ; H will only return HOSPITAL LOCATION (clinic) resources "RTN","SDEC01A",14,0) ; P will only return NEW PERSON (Provider) resources "RTN","SDEC01A",15,0) ; A will only return SDEC ADDITIONAL RESOURCE resources "RTN","SDEC01A",16,0) ; PH will only return prohibited clinics "RTN","SDEC01A",17,0) ; MAXREC - (optional) Max records returned "RTN","SDEC01A",18,0) ; LASTSUBI - (optional) last subscripts from previous call "RTN","SDEC01A",19,0) ; SDIEN - (optional) pointer to SDEC RESOURCE file "RTN","SDEC01A",20,0) ; only 1 record will be returned if SDIEN is present "RTN","SDEC01A",21,0) ; SDECP - (optional) Partial name text "RTN","SDEC01A",22,0) ;RETURN: "RTN","SDEC01A",23,0) ; Successful Return: "RTN","SDEC01A",24,0) ; a global array in which each array entry contains data from the "RTN","SDEC01A",25,0) ; SDEC RESOURCE file "RTN","SDEC01A",26,0) ; 1. RESOURCEID - Pointer to the SDEC RESOURCE file "RTN","SDEC01A",27,0) ; 2. RESOURCE_NAME - NAME from SDEC RESOURCE file "RTN","SDEC01A",28,0) ; 3. INACTIVE - inactive Clinic - Returned values will be NO YES "RTN","SDEC01A",29,0) ; 4. TIMESCALE - Valid Values: "RTN","SDEC01A",30,0) ; 5, 10, 15, 20, 30, 60 "RTN","SDEC01A",31,0) ; 5. HOSPITAL_LOCATION_ID "RTN","SDEC01A",32,0) ; 6. LETTER_TEXT "RTN","SDEC01A",33,0) ; 7. NO_SHOW_LETTER "RTN","SDEC01A",34,0) ; 8. CLINIC_CANCELLATION_LETTER "RTN","SDEC01A",35,0) ; 9. VIEW - User can VIEW 1=YES; 0=NO "RTN","SDEC01A",36,0) ; 10. OVERBOOK - User can OVERBOOK 1=YES; 0=NO "RTN","SDEC01A",37,0) ; 11. MODIFY_SCHEDULE - User can Modify Schedule 1=YES; 0=NO "RTN","SDEC01A",38,0) ; 12. MODIFY_APPOINTMENTS User can modify appointments 1=YES; 0=NO "RTN","SDEC01A",39,0) ; 13. RESOURCETYPE - 3 pipe pieces: "RTN","SDEC01A",40,0) ; 1. type H, P, or A "RTN","SDEC01A",41,0) ; 2. IEN - pointer to [H] HOSPITAL LOCATION, [P] NEW PERSON, "RTN","SDEC01A",42,0) ; or [A] SDEC ADDITIONAL RESOURCE file "RTN","SDEC01A",43,0) ; 3. Name - name from the appropriate type file "RTN","SDEC01A",44,0) ; 14. DATE - Date/Time entered in external format "RTN","SDEC01A",45,0) ; 15. USERIEN - Entered By User ID pointer to NEW PERSON file 200 "RTN","SDEC01A",46,0) ; 16. USERNAME - Entered By User name from NEW PERSON file "RTN","SDEC01A",47,0) ; 17. DATE1 - Inactive Date/Time in external format "RTN","SDEC01A",48,0) ; 18. USERIEN1 - Inactivating User ID pointer to NEW PERSON file "RTN","SDEC01A",49,0) ; 19. USERNAME1 - Inactivating User Name from NEW PERSON file "RTN","SDEC01A",50,0) ; 20. DATE2 - Reactivated Date/Time in external format "RTN","SDEC01A",51,0) ; 21. USERIEN2 - Reactivating User ID pointer to NEW PERSON file "RTN","SDEC01A",52,0) ; 22. USERNAME2 - Reactivating User Name from NEW PERSON file "RTN","SDEC01A",53,0) ; 23. CLINNAME - Clinic Name from HOSPITAL LOCATION file 44 "RTN","SDEC01A",54,0) ; 24. PROVCLIN - Boolean indicating 'this' P type resource is a provider for a clinic "RTN","SDEC01A",55,0) ; 0 = not a provider (not found in the AVADPR index for file 44) "RTN","SDEC01A",56,0) ; 1 = is a provider "RTN","SDEC01A",57,0) ; 25. PRIVLOC - Boolean indicating presence of privileged users for hospital location "RTN","SDEC01A",58,0) ; 26. PRHBLOC - Boolean indicating if location is a Prohibit Access clinic "RTN","SDEC01A",59,0) ; 27. LASTSUB - Last subscript in return data. Used in next call to "RTN","SDEC01A",60,0) ; SDEC RESOURCE to get additional records "RTN","SDEC01A",61,0) ; 28. ABBR - Abbreviation "RTN","SDEC01A",62,0) ; "RTN","SDEC01A",63,0) ; "RTN","SDEC01A",64,0) N SDA,SDCL,SDDATA,SDMSG,SDECERR,SDECRET,SDECIEN,SDECRES,SDECDEP,SDECDDR,SDECDEPN,SDECRDAT,SDECRNOD,SDECI,SDEC,SDECLTR "RTN","SDEC01A",65,0) N ABBR,SDECNOS,SDECCAN,SDF,SDTYPR,SDX,SDPRO,PRO,SDH,SDK,SDRT,SDT,SDXT "RTN","SDEC01A",66,0) N SDARR,SDCNT,SDMORE,SDNAM ;alb/sat 665 "RTN","SDEC01A",67,0) S (SDRT,SDT,SDX)="",SDPRO=0 "RTN","SDEC01A",68,0) S (SDCNT,SDF,SDMORE)=0 "RTN","SDEC01A",69,0) S SDECY="^TMP(""SDEC01A"","_$J_",""RESOURCE"")" "RTN","SDEC01A",70,0) K @SDECY "RTN","SDEC01A",71,0) S SDECI=0 "RTN","SDEC01A",72,0) S (SDECERR,SDTYPR)="" "RTN","SDEC01A",73,0) ; 1 2 3 4 5 6 7 "RTN","SDEC01A",74,0) S @SDECY@(SDECI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00010INACTIVE^I00010TIMESCALE^I00010HOSPITAL_LOCATION_ID^T00030LETTER_TEXT^T00030NO_SHOW_LETTER" "RTN","SDEC01A",75,0) ; 8 9 10 11 12 "RTN","SDEC01A",76,0) S @SDECY@(SDECI)=^(SDECI)_"^T00030CLINIC_CANCELLATION_LETTER^I00010VIEW^I00010OVERBOOK^I00010MODIFY_SCHEDULE^I00010MODIFY_APPOINTMENTS" "RTN","SDEC01A",77,0) ; 13 14 15 16 "RTN","SDEC01A",78,0) S @SDECY@(SDECI)=^(SDECI)_"^T00030RESOURCETYPE^T00030DATE^T00030USERIEN^T00030USERNAME" "RTN","SDEC01A",79,0) ; 17 18 19 20 21 22 "RTN","SDEC01A",80,0) S @SDECY@(SDECI)=^(SDECI)_"^T00030DATE1^T00030USERIEN1^T00030USERNAME1^T00030DATE2^T00030USERIEN2^T00030USERNAME2" "RTN","SDEC01A",81,0) ; 23 24 25 26 27 "RTN","SDEC01A",82,0) S @SDECY@(SDECI)=^(SDECI)_"^T00030CLINNAME^T00030PROVCLIN^T00030PRIVLOC^T00030PRHBLOC^T00030LASTSUB^T00030ABBR"_$C(30) "RTN","SDEC01A",83,0) ;validate user "RTN","SDEC01A",84,0) S SDECDUZ=$G(SDECDUZ) "RTN","SDEC01A",85,0) I '+SDECDUZ S SDECDUZ=DUZ "RTN","SDEC01A",86,0) ;validate active "RTN","SDEC01A",87,0) S SDACT=$G(SDACT) "RTN","SDEC01A",88,0) S SDACT=$S(SDACT=1:1,SDACT="YES":1,1:0) "RTN","SDEC01A",89,0) ;validate type "RTN","SDEC01A",90,0) S SDTYPE=$G(SDTYPE) "RTN","SDEC01A",91,0) ;MGH added new type "RTN","SDEC01A",92,0) I SDTYPE="PH" S SDPRO=1 "RTN","SDEC01A",93,0) S SDTYPE=$S(SDTYPE="H":"SC(",SDTYPE="P":"VA(200",SDTYPE="A":"SDEC",1:"") "RTN","SDEC01A",94,0) ;validate MAXREC "RTN","SDEC01A",95,0) S MAXREC=$G(MAXREC,9999999) "RTN","SDEC01A",96,0) ;validate LASTSUBI "RTN","SDEC01A",97,0) S LASTSUBI=$G(LASTSUBI) "RTN","SDEC01A",98,0) ;validate SDIEN "RTN","SDEC01A",99,0) ;MGH changed to allow multiple IENS "RTN","SDEC01A",100,0) ;S SDIEN=$G(SDIEN) "RTN","SDEC01A",101,0) ;I SDIEN'="",'$D(^SDEC(409.831,+SDIEN,0)) S SDIEN="" "RTN","SDEC01A",102,0) I $G(SDIEN) D G RESX "RTN","SDEC01A",103,0) .F SDK=1:1:$L(SDIEN,"|") D "RTN","SDEC01A",104,0) ..S SDECIEN=$P(SDIEN,"|",SDK) "RTN","SDEC01A",105,0) ..Q:'$D(^SDEC(409.831,+SDECIEN,0)) "RTN","SDEC01A",106,0) ..S SDECRES=SDECIEN "RTN","SDEC01A",107,0) ..D RES1 "RTN","SDEC01A",108,0) ;ien lookup "RTN","SDEC01A",109,0) ;I +SDIEN S SDECRES=+SDIEN D RES1 G RESX "RTN","SDEC01A",110,0) ;validate SDECP "RTN","SDEC01A",111,0) S SDECP=$G(SDECP) "RTN","SDEC01A",112,0) ;partial name lookup "RTN","SDEC01A",113,0) I SDECP'="" D "RTN","SDEC01A",114,0) .S SDF=$S($P(LASTSUBI,"|",1)'="":$P(LASTSUBI,"|",1),1:"") "RTN","SDEC01A",115,0) .S (SDX,SDXT)=$S($P(LASTSUBI,"|",2)'="":$$GETSUB^SDECU($P(LASTSUBI,"|",2)),1:$$GETSUB^SDECU(SDECP)) "RTN","SDEC01A",116,0) .I ($P(LASTSUBI,"|",1)="")!($P(LASTSUBI,"|",1)="ABBR") S SDF="ABBR" F S SDX=$O(^SDEC(409.831,"C",SDX)) Q:SDX="" Q:SDX'[SDECP D I (+MAXREC)&(SDCNT'0,'+SDMORE S $P(@SDECY@(SDECI),U,27)="" "RTN","SDEC01A",130,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC01A",131,0) Q "RTN","SDEC01A",132,0) RES1 ; get data for 1 resource "RTN","SDEC01A",133,0) N FND "RTN","SDEC01A",134,0) S FND=0 "RTN","SDEC01A",135,0) Q:'$D(^SDEC(409.831,SDECRES,0)) "RTN","SDEC01A",136,0) I SDF="FULL",SDECP'="" S FND=$$CHK(SDECP,SDECRES) Q:+FND ;alb/sat 658 - stop if 'this' record found in abbreviations "RTN","SDEC01A",137,0) I SDECP'="" S SDH=0 F S SDH=$O(^SDEC(409.831,"C",SDECP,SDH)) Q:SDH="" S FND=SDH=SDECRES Q:FND "RTN","SDEC01A",138,0) S SDECRNOD=^SDEC(409.831,SDECRES,0) "RTN","SDEC01A",139,0) I SDTYPE'="" Q:$P(SDECRNOD,U,11)'[SDTYPE "RTN","SDEC01A",140,0) S SDTYPR=$P(SDECRNOD,U,11) "RTN","SDEC01A",141,0) S $P(SDTYPR,"|",1)=$S($P(SDTYPR,";",2)="SC(":"H",$P(SDTYPR,";",2)="VA(200,":"P",$P(SDTYPR,";",2)="SDEC(409.834,":"A",1:"") "RTN","SDEC01A",142,0) S $P(SDTYPR,"|",2)=$P($P(SDECRNOD,U,11),";",1) "RTN","SDEC01A",143,0) S $P(SDTYPR,"|",3)=$$GET1^DIQ(409.831,SDECRES_",",.012) "RTN","SDEC01A",144,0) I $P(SDTYPR,"|",1)="P" D RESPRV1^SDEC01B($P(SDTYPR,"|",2),$P(SDECRNOD,U,4)) ;do not include provider resource if NEW PERSON is not active "RTN","SDEC01A",145,0) I $P(SDTYPR,"|",1)="H" D CHKC^SDEC01B($P(SDTYPR,"|",2),SDECRES) "RTN","SDEC01A",146,0) I +SDACT,$$GET1^DIQ(409.831,SDECRES_",",.02)="YES" Q ;do not include inactive entries "RTN","SDEC01A",147,0) D GETACC(.SDECACC,SDECDUZ,SDECRES) "RTN","SDEC01A",148,0) ;I SDACT Q:$$GET1^DIQ(409.831,SDECRES_",",.02)'="YES" ;do not include inactive entries "RTN","SDEC01A",149,0) K SDECRDAT "RTN","SDEC01A",150,0) ;alb/sat 658 - begin mod "RTN","SDEC01A",151,0) S $P(SDECRDAT,U,1)=$P(SDECRNOD,U,1) "RTN","SDEC01A",152,0) S $P(SDECRDAT,U,2)=$P(SDECRNOD,U,2) "RTN","SDEC01A",153,0) S $P(SDECRDAT,U,3)=$P(SDECRNOD,U,3) "RTN","SDEC01A",154,0) S $P(SDECRDAT,U,4)=$P(SDECRNOD,U,4) "RTN","SDEC01A",155,0) ;F SDEC=1:1:4 S $P(SDECRDAT,U,SDEC)=$P(SDECRNOD,U,SDEC) "RTN","SDEC01A",156,0) ;alb/sat 658 - end mod "RTN","SDEC01A",157,0) S SDECRDAT=SDECRES_U_SDECRDAT ;1,2-5 "RTN","SDEC01A",158,0) S SDCL=$P(SDECRDAT,U,5) "RTN","SDEC01A",159,0) Q:+$$GET1^DIQ(44,SDCL_",",50.01,"I")=1 ;OOS? "RTN","SDEC01A",160,0) S PRO=0 "RTN","SDEC01A",161,0) ;MGH code for new type to only contain prohibited clinics "RTN","SDEC01A",162,0) Q:$G(SDCL)=""&(SDPRO=1) "RTN","SDEC01A",163,0) Q:$G(SDCL)&(SDPRO=1)&($$GET1^DIQ(44,SDCL_",",2500)'="YES") "RTN","SDEC01A",164,0) S $P(SDECRDAT,U,3)=$$GET1^DIQ(409.831,SDECRES_",",.02) "RTN","SDEC01A",165,0) ;Get letter text from wp field "RTN","SDEC01A",166,0) S SDECLTR="" "RTN","SDEC01A",167,0) I 0,$D(^SDEC(409.831,SDECRES,1)) D "RTN","SDEC01A",168,0) . S SDECIEN=0 "RTN","SDEC01A",169,0) . F S SDECIEN=$O(^SDEC(409.831,SDECRES,1,SDECIEN)) Q:'+SDECIEN D "RTN","SDEC01A",170,0) . . S SDECLTR=SDECLTR_$G(^SDEC(409.831,SDECRES,1,SDECIEN,0)) "RTN","SDEC01A",171,0) . . S SDECLTR=SDECLTR_$C(13)_$C(10) "RTN","SDEC01A",172,0) S SDECNOS="" "RTN","SDEC01A",173,0) I 0,$D(^SDEC(409.831,SDECRES,12)) D "RTN","SDEC01A",174,0) . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.831,SDECRES,12,SDECIEN)) Q:'+SDECIEN D "RTN","SDEC01A",175,0) . . S SDECNOS=SDECNOS_$G(^SDEC(409.831,SDECRES,12,SDECIEN,0)) "RTN","SDEC01A",176,0) . . S SDECNOS=SDECNOS_$C(13)_$C(10) "RTN","SDEC01A",177,0) S SDECCAN="" "RTN","SDEC01A",178,0) I 0,$D(^SDEC(409.831,SDECRES,13)) D "RTN","SDEC01A",179,0) . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.831,SDECRES,13,SDECIEN)) Q:'+SDECIEN D "RTN","SDEC01A",180,0) . . S SDECCAN=SDECCAN_$G(^SDEC(409.831,SDECRES,13,SDECIEN,0)) "RTN","SDEC01A",181,0) . . S SDECCAN=SDECCAN_$C(13)_$C(10) "RTN","SDEC01A",182,0) N SDECACC,SDECMGR "RTN","SDEC01A",183,0) S SDECACC="0^0^0^0" "RTN","SDEC01A",184,0) S SDECMGR=$O(^DIC(19.1,"B","SDECZMGR",0)) "RTN","SDEC01A",185,0) I +SDECMGR,$D(^VA(200,SDECDUZ,51,SDECMGR)) S SDECACC="1^1^1^1" "RTN","SDEC01A",186,0) I SDECACC="0^0^0^0" D "RTN","SDEC01A",187,0) . N SDECNOD,SDECRUID "RTN","SDEC01A",188,0) . S SDECRUID=0 "RTN","SDEC01A",189,0) . ;Get entry for this user and resource "RTN","SDEC01A",190,0) . F S SDECRUID=$O(^SDEC(409.833,"AC",SDECDUZ,SDECRUID)) Q:'+SDECRUID I $D(^SDEC(409.833,SDECRUID,0)),$P(^(0),U)=SDECRES Q "RTN","SDEC01A",191,0) . Q:'+SDECRUID "RTN","SDEC01A",192,0) . S $P(SDECACC,U)=1 "RTN","SDEC01A",193,0) . S SDECNOD=$G(^SDEC(409.833,SDECRUID,0)) "RTN","SDEC01A",194,0) . S $P(SDECACC,U,2)=+$P(SDECNOD,U,3) "RTN","SDEC01A",195,0) . S $P(SDECACC,U,3)=+$P(SDECNOD,U,4) "RTN","SDEC01A",196,0) . S $P(SDECACC,U,4)=+$P(SDECNOD,U,5) "RTN","SDEC01A",197,0) ; 6 7 8 9-12 "RTN","SDEC01A",198,0) S SDECRDAT=SDECRDAT_U_SDECLTR_U_SDECNOS_U_SDECCAN_U_SDECACC_U_SDTYPR "RTN","SDEC01A",199,0) ;D GETS^DIQ(409.831,SDECRES_",","**","IE","SDDATA","SDMSG") "RTN","SDEC01A",200,0) K SDDATA D GETS^DIQ(409.831,SDECRES_",",".01:.04","IE","SDDATA","SDMSG") "RTN","SDEC01A",201,0) S SDA="SDDATA(409.831,"""_SDECRES_","")" "RTN","SDEC01A",202,0) S $P(SDECRDAT,U,14)=@SDA@(.015,"E") ;date/time entered "RTN","SDEC01A",203,0) S $P(SDECRDAT,U,15)=@SDA@(.016,"I") ;entered by user id "RTN","SDEC01A",204,0) S $P(SDECRDAT,U,16)=@SDA@(.016,"E") ;entered by user name "RTN","SDEC01A",205,0) S $P(SDECRDAT,U,17)=@SDA@(.021,"E") ;inactive date/time "RTN","SDEC01A",206,0) S $P(SDECRDAT,U,18)=@SDA@(.022,"I") ;inactivated by user ID "RTN","SDEC01A",207,0) S $P(SDECRDAT,U,19)=@SDA@(.022,"E") ;inactivated by user name "RTN","SDEC01A",208,0) S $P(SDECRDAT,U,20)=@SDA@(.025,"E") ;reactivated date/time "RTN","SDEC01A",209,0) S $P(SDECRDAT,U,21)=@SDA@(.026,"I") ;reactivating user ID "RTN","SDEC01A",210,0) S $P(SDECRDAT,U,22)=@SDA@(.026,"E") ;reactivating user name "RTN","SDEC01A",211,0) S $P(SDECRDAT,U,23)=$$GET1^DIQ(44,SDCL_",",.01) ;clinic name "RTN","SDEC01A",212,0) S $P(SDECRDAT,U,24)=$S($P(SDTYPR,"|",1)="P":''$O(^SC("AVADPR",+$P(SDTYPR,"|",2),0)),1:0) "RTN","SDEC01A",213,0) S:$G(SDCL) $P(SDECRDAT,U,25)=$S($G(SDCL):$P($G(^SC(SDCL,"SDPRIV",0)),U,4)>0,1:0) ;contains privileged users "RTN","SDEC01A",214,0) S:$G(SDCL) $P(SDECRDAT,U,26)=$$GET1^DIQ(44,SDCL_",",2500)["Y" ;prohibited clinic "RTN","SDEC01A",215,0) S $P(SDECRDAT,U,27)=SDF_"|"_SDX_"|"_SDECRES ;LASTSUB "RTN","SDEC01A",216,0) S $P(SDECRDAT,U,28)=@SDA@(.011,"E") ;abbreviation "RTN","SDEC01A",217,0) S $P(SDECRDAT,U,2)=$S(($G(SDF)="ABBR")&(@SDA@(.011,"E")'=""):@SDA@(.011,"E")_" ",1:"")_$P(SDECRDAT,U,2) ;alb/sat 658 - include abbr in name if found by C xref "RTN","SDEC01A",218,0) S SDARR(SDF="FULL",$P(SDECRDAT,U,2))=SDECRDAT,SDCNT=SDCNT+1 "RTN","SDEC01A",219,0) Q "RTN","SDEC01A",220,0) ; "RTN","SDEC01A",221,0) GETACC(SDECACC,SDECDUZ,SDECRES) ;get view, overbook, modify appt, and modify schedule abilities "RTN","SDEC01A",222,0) ;INPUT: "RTN","SDEC01A",223,0) ; SDECDUZ = user ID pointer to NEW PERSON file "RTN","SDEC01A",224,0) ; SDECRES = resource ID pointer to SDEC RESOURCE file "RTN","SDEC01A",225,0) ;RETURN: "RTN","SDEC01A",226,0) ; .SDECACC = access separated by ^: "RTN","SDEC01A",227,0) ; 1. VIEW - User can VIEW 1=YES; 0=NO "RTN","SDEC01A",228,0) ; 2. OVERBOOK - User can OVERBOOK 1=YES; 0=NO "RTN","SDEC01A",229,0) ; 3. MODIFY SCHEDULE - User can Modify Schedule 1=YES; 0=NO "RTN","SDEC01A",230,0) ; 4. MODIFY APPOINTMENTS User can modify appointments 1=YES; 0=NO "RTN","SDEC01A",231,0) N SDECMGR "RTN","SDEC01A",232,0) S SDECACC="0^0^0^0" "RTN","SDEC01A",233,0) S SDECMGR=$O(^DIC(19.1,"B","SDECZMGR",0)) "RTN","SDEC01A",234,0) I +SDECMGR,$D(^VA(200,SDECDUZ,51,SDECMGR)) S SDECACC="1^1^1^1" "RTN","SDEC01A",235,0) I SDECACC="0^0^0^0" D "RTN","SDEC01A",236,0) . N SDECNOD,SDECRUID "RTN","SDEC01A",237,0) . S SDECRUID=0 "RTN","SDEC01A",238,0) . ;Get entry for this user and resource "RTN","SDEC01A",239,0) . F S SDECRUID=$O(^SDEC(409.833,"AC",SDECDUZ,SDECRUID)) Q:'+SDECRUID I $D(^SDEC(409.833,SDECRUID,0)),$P(^(0),U)=SDECRES Q "RTN","SDEC01A",240,0) . Q:'+SDECRUID "RTN","SDEC01A",241,0) . S $P(SDECACC,U)=1 "RTN","SDEC01A",242,0) . S SDECNOD=$G(^SDEC(409.833,SDECRUID,0)) "RTN","SDEC01A",243,0) . S $P(SDECACC,U,2)=+$P(SDECNOD,U,3) "RTN","SDEC01A",244,0) . S $P(SDECACC,U,3)=+$P(SDECNOD,U,4) "RTN","SDEC01A",245,0) . S $P(SDECACC,U,4)=+$P(SDECNOD,U,5) "RTN","SDEC01A",246,0) Q "RTN","SDEC01A",247,0) ; "RTN","SDEC01A",248,0) GETLTRS(SDECLTR,SDECNOS,SDECCAN,SDECRES,SDCL) ;get resource letters "RTN","SDEC01A",249,0) ;INPUT: "RTN","SDEC01A",250,0) ; SDECRES = resource ID pointer to SDEC RESOURCE file "RTN","SDEC01A",251,0) ; SDCL = clinic ID pointer to HOSPITAL LOCATION file "RTN","SDEC01A",252,0) ;RETURN: "RTN","SDEC01A",253,0) ; .SDECLTR = LETTER TEXT "RTN","SDEC01A",254,0) ; .SDECNOS = NO SHOW LETTER "RTN","SDEC01A",255,0) ; .SDECCAN = CLINIC CANCELLATION LETTER "RTN","SDEC01A",256,0) ; .Get letter text from wp field "RTN","SDEC01A",257,0) N SDECIEN "RTN","SDEC01A",258,0) S SDECLTR="" "RTN","SDEC01A",259,0) I $D(^SDEC(409.831,SDECRES,2,SDCL,1)) D "RTN","SDEC01A",260,0) . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.831,SDECRES,2,SDCL,1,SDECIEN)) Q:'+SDECIEN D "RTN","SDEC01A",261,0) . . S SDECLTR=SDECLTR_$G(^SDEC(409.831,SDECRES,2,SDCL,1,SDECIEN,0)) "RTN","SDEC01A",262,0) . . S SDECLTR=SDECLTR_$C(13)_$C(10) "RTN","SDEC01A",263,0) S SDECNOS="" "RTN","SDEC01A",264,0) I $D(^SDEC(409.831,SDECRES,2,SDCL,12)) D "RTN","SDEC01A",265,0) . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.831,SDECRES,2,SDCL,12,SDECIEN)) Q:'+SDECIEN D "RTN","SDEC01A",266,0) . . S SDECNOS=SDECNOS_$G(^SDEC(409.831,SDECRES,2,SDCL,12,SDECIEN,0)) "RTN","SDEC01A",267,0) . . S SDECNOS=SDECNOS_$C(13)_$C(10) "RTN","SDEC01A",268,0) S SDECCAN="" "RTN","SDEC01A",269,0) I $D(^SDEC(409.831,SDECRES,13)) D "RTN","SDEC01A",270,0) . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.831,SDECRES,2,SDCL,13,SDECIEN)) Q:'+SDECIEN D "RTN","SDEC01A",271,0) . . S SDECCAN=SDECCAN_$G(^SDEC(409.831,SDECRES,2,SDCL,13,SDECIEN,0)) "RTN","SDEC01A",272,0) . . S SDECCAN=SDECCAN_$C(13)_$C(10) "RTN","SDEC01A",273,0) Q "RTN","SDEC01A",274,0) ; "RTN","SDEC01A",275,0) CHK(SDECP,SDECRES) ;alb/sat 658 - stop if 'this' record found in abbreviations "RTN","SDEC01A",276,0) N FND,SDR,SDX "RTN","SDEC01A",277,0) S FND=0 "RTN","SDEC01A",278,0) S SDX=$$GETSUB^SDECU(SDECP) "RTN","SDEC01A",279,0) F S SDX=$O(^SDEC(409.831,"C",SDX)) Q:SDX="" Q:SDX'[SDECP D Q:+FND "RTN","SDEC01A",280,0) .S SDR=0 F S SDR=$O(^SDEC(409.831,"C",SDX,SDR)) Q:'+SDR S FND=SDR=SDECRES Q:+FND "RTN","SDEC01A",281,0) Q FND "RTN","SDEC07") 0^4^B185524828^B199096003 "RTN","SDEC07",1,0) SDEC07 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDEC07",2,0) ;;5.3;Scheduling;**627,642,651,658,665**;Aug 13, 1993;Build 14 "RTN","SDEC07",3,0) ; "RTN","SDEC07",4,0) ;Reference is made to ICR #4837 "RTN","SDEC07",5,0) Q "RTN","SDEC07",6,0) ; "RTN","SDEC07",7,0) APPADD(SDECY,SDECSTART,SDECEND,DFN,SDECRES,SDECLEN,SDECNOTE,SDECATID,SDECCR,SDMRTC,SDDDT,SDREQBY,SDLAB,PROVIEN,SDID,SDAPTYP,SDSVCP,SDSVCPR,SDCL,SDEKG,SDXRAY,APPTYPE,EESTAT,OVB,SDPARENT) ;ADD NEW APPOINTMENT "RTN","SDEC07",8,0) ; "RTN","SDEC07",9,0) N SDAPPTYP "RTN","SDEC07",10,0) N SDECERR,SDECIEN,SDECDEP,SDECI,SDECJ,SDECAPPTI,SDECDJ,SDECRESD,SDECRNOD,SDECC,SDECERR,SDECWKIN "RTN","SDEC07",11,0) N SDECNOEV,SDECDEV,SDECDERR,SDECTMP,SAVESTRT "RTN","SDEC07",12,0) N %DT,X,Y,DGQUIET,OBM,RET "RTN","SDEC07",13,0) S SDECNOEV=1 ;Don't execute SDEC ADD APPOINTMENT protocol "RTN","SDEC07",14,0) K ^TMP("SDEC07",$J) "RTN","SDEC07",15,0) S SDECERR=0 "RTN","SDEC07",16,0) S SDECI=0 "RTN","SDEC07",17,0) S SDECY="^TMP(""SDEC07"","_$J_")" "RTN","SDEC07",18,0) S ^TMP("SDEC07",$J,SDECI)="I00020APPOINTMENTID^T00020ERRORID"_$C(30) "RTN","SDEC07",19,0) S SDECI=SDECI+1 "RTN","SDEC07",20,0) ;Check input data for errors "RTN","SDEC07",21,0) S SAVESTRT=SDECSTART ;MGH save date/time for consult request "RTN","SDEC07",22,0) S:SDECSTART["@0000" SDECSTART=$P(SDECSTART,"@") "RTN","SDEC07",23,0) S:SDECEND["@0000" SDECEND=$P(SDECEND,"@") "RTN","SDEC07",24,0) S %DT="RXT",X=SDECSTART D ^%DT S SDECSTART=Y "RTN","SDEC07",25,0) I SDECSTART=-1 D ERR(SDECI+1,"SDEC07 Error: Invalid Start Time") Q "RTN","SDEC07",26,0) S %DT="RXT",X=SDECEND D ^%DT S SDECEND=Y "RTN","SDEC07",27,0) I SDECEND=-1 D ERR(SDECI+1,"SDEC07 Error: Invalid End Time") Q "RTN","SDEC07",28,0) I $L(SDECEND,".")=1 D ERR(SDECI+1,"SDEC07 Error: Invalid End Time") Q "RTN","SDEC07",29,0) I SDECSTART>SDECEND S SDECTMP=SDECEND,SDECEND=SDECSTART,SDECSTART=SDECTMP "RTN","SDEC07",30,0) S DFN=$G(DFN) "RTN","SDEC07",31,0) I DFN="" D ERR(SDECI+1,"SDEC07: Patient ID required.") Q "RTN","SDEC07",32,0) I '$D(^DPT(DFN,0)) D ERR(SDECI+1,"SDEC07 Error: Invalid Patient ID") Q "RTN","SDEC07",33,0) L +^DPT(DFN):3 I '$T D ERR(SDECI+1,"Patient is being edited. Try again later.") Q ;alb/sat 665 "RTN","SDEC07",34,0) ;Validate Resource "RTN","SDEC07",35,0) S SDECERR=0 K SDECRESD "RTN","SDEC07",36,0) S SDECRES=$G(SDECRES) "RTN","SDEC07",37,0) I +SDECRES,'$D(^SDEC(409.831,SDECRES,0)) D ERR(SDECI+1,"SDEC07 Error: Invalid Resource ID") Q "RTN","SDEC07",38,0) I '+SDECRES,'$D(^SDEC(409.831,"B",SDECRES)) D ERR(SDECI+1,"SDEC07 Error: Invalid Resource ID") Q "RTN","SDEC07",39,0) S SDECRESD=$S(+SDECRES:+SDECRES,1:$O(^SDEC(409.831,"B",SDECRES,0))) "RTN","SDEC07",40,0) S SDECRNOD=$G(^SDEC(409.831,SDECRESD,0)) "RTN","SDEC07",41,0) I SDECRNOD="" D ERR(SDECI+1,"SDEC07 Error: Unable to add appointment -- invalid Resource entry.") Q "RTN","SDEC07",42,0) S SDECWKIN=0 "RTN","SDEC07",43,0) S SDECATID=$G(SDECATID) "RTN","SDEC07",44,0) I SDECATID="WALKIN" S SDECWKIN=1 "RTN","SDEC07",45,0) I SDECATID'?.N&(SDECATID'="WALKIN") S SDECATID="" "RTN","SDEC07",46,0) ;validate appointment length - if passed in, must be 5-120 "RTN","SDEC07",47,0) S SDECLEN=$G(SDECLEN) "RTN","SDEC07",48,0) ;I SDECLEN'="",(+SDECLEN<5)!(SDECLEN>120) D ERR(SDECI+1,"SDEC07 Error: Appointment length must be between 5 - 120.") Q "RTN","SDEC07",49,0) ;validate MTRC flag (optional) "RTN","SDEC07",50,0) S SDMRTC=$$UP^XLFSTR($G(SDMRTC)) "RTN","SDEC07",51,0) S SDMRTC=$S(SDMRTC="TRUE":1,1:0) "RTN","SDEC07",52,0) ;validate desired date of appt (optional) "RTN","SDEC07",53,0) S SDDDT=$G(SDDDT) "RTN","SDEC07",54,0) I SDDDT'="" S %DT="" S X=$P(SDDDT,"@",1) D ^%DT S SDDDT=Y I Y=-1 S SDDDT="" "RTN","SDEC07",55,0) I SDDDT="",SDECATID'="WALKIN" S SDDDT=$P(SDECSTART,".",1) "RTN","SDEC07",56,0) ;validate requested by "RTN","SDEC07",57,0) S SDREQBY=$$UP^XLFSTR($G(SDREQBY)) "RTN","SDEC07",58,0) I SDREQBY'="" S SDREQBY=$S(SDREQBY="PROVIDER":1,SDREQBY="PATIENT":2,1:0) "RTN","SDEC07",59,0) ;validate lab date/time (optional) "RTN","SDEC07",60,0) S SDLAB=$G(SDLAB) "RTN","SDEC07",61,0) I SDLAB'="" S %DT="T" S X=SDLAB D ^%DT S SDLAB=Y I Y=-1 S SDLAB="" "RTN","SDEC07",62,0) ;validate EKG date/time (optional) "RTN","SDEC07",63,0) S SDEKG=$G(SDEKG) "RTN","SDEC07",64,0) I SDEKG'="" S %DT="T" S X=SDEKG D ^%DT S SDEKG=Y I Y=-1 S SDEKG="" "RTN","SDEC07",65,0) ;validate XRAY date/time (optional) "RTN","SDEC07",66,0) S SDXRAY=$G(SDXRAY) "RTN","SDEC07",67,0) I SDXRAY'="" S %DT="T" S X=SDXRAY D ^%DT S SDXRAY=Y I Y=-1 S SDXRAY="" "RTN","SDEC07",68,0) ;validate provider "RTN","SDEC07",69,0) I '$D(^VA(200,+$G(PROVIEN),0)) S PROVIEN="" "RTN","SDEC07",70,0) S SDID=$G(SDID) "RTN","SDEC07",71,0) ;validate clinic "RTN","SDEC07",72,0) S SDCL=$G(SDCL) "RTN","SDEC07",73,0) I SDCL'="" I '$D(^SC(SDCL,0)) S SDCL="" "RTN","SDEC07",74,0) I SDCL="" S SDCL=$$GET1^DIQ(409.831,SDECRESD_",",.04,"I") ;clinic ID ;support for single HOSPITAL LOCATION in SDEC RESOURCE "RTN","SDEC07",75,0) S OVB=+$G(OVB) ;alb/sat 665 "RTN","SDEC07",76,0) I 'OVB S OBM=$$OBM1^SDEC57(SDCL,SDECSTART,SDMRTC,,+SDECWKIN) I OBM'="",+OBM'=1 S SDECAPPTID=0 D ERR(SDECI+1,"OBM"_OBM) Q ;alb/sat 658 check if overbook ;alb/sat 665 clear SDECAPPTID "RTN","SDEC07",77,0) ;validate appt request type (required) "RTN","SDEC07",78,0) S SDAPTYP=$G(SDAPTYP) "RTN","SDEC07",79,0) I SDAPTYP'="" D "RTN","SDEC07",80,0) .I $P(SDAPTYP,"|",1)="E" I '$D(^SDWL(409.3,+$P(SDAPTYP,"|",2),0)) S SDAPTYP="" "RTN","SDEC07",81,0) .I $P(SDAPTYP,"|",1)="R" I '$D(^SD(403.5,+$P(SDAPTYP,"|",2),0)) S SDAPTYP="" "RTN","SDEC07",82,0) .I $P(SDAPTYP,"|",1)="C" I '$D(^GMR(123,+$P(SDAPTYP,"|",2),0)) S SDAPTYP="" ;ICR 4837 "RTN","SDEC07",83,0) .I $P(SDAPTYP,"|",1)="A" I '$D(^SDEC(409.85,+$P(SDAPTYP,"|",2),0)) S SDAPTYP="" "RTN","SDEC07",84,0) .;I SDAPTYP="" D ERR(SDECI+1,"SDEC07 Error: Invalid appointment request type.") Q ;support for multiple HOSPITAL LOCATIONs are implemented in SDEC RESOURCE "RTN","SDEC07",85,0) I SDCL="" D "RTN","SDEC07",86,0) .S:$P(SDAPTYP,"|",1)="E" SDCL=$$GET1^DIQ(409.3,$P(SDAPTYP,"|",2)_",",13.2,"I") "RTN","SDEC07",87,0) .S:$P(SDAPTYP,"|",1)="R" SDCL=$$GET1^DIQ(403.5,$P(SDAPTYP,"|",2)_",",4.5,"I") "RTN","SDEC07",88,0) .S:$P(SDAPTYP,"|",1)="C" SDCL=$P($G(^GMR(123,+$P(SDAPTYP,"|",2),0)),U,4) ;ICR 4837 ICR states 'Zero node read into variable' "RTN","SDEC07",89,0) .S:$P(SDAPTYP,"|",1)="A" SDCL=$$GET1^DIQ(409.85,$P(SDAPTYP,"|",2)_",",8,"I") "RTN","SDEC07",90,0) I SDCL="" D ERR(SDECI+1,"SDEC07 Error: Invalid clinic ID.") Q "RTN","SDEC07",91,0) I $$INACTIVE^SDEC32(SDCL) D ERR(SDECI+1,"SDEC07 Error: "_$$GET1^DIQ(44,SDCL_",",.01)_" is an inactive clinic.") Q "RTN","SDEC07",92,0) ;validate service connected "RTN","SDEC07",93,0) S SDSVCPR=$G(SDSVCPR) "RTN","SDEC07",94,0) I SDSVCPR'="" S:(+SDSVCPR<0)!(+SDSVCPR>100) SDSVCPR="" "RTN","SDEC07",95,0) S SDSVCP=$G(SDSVCP) "RTN","SDEC07",96,0) S SDSVCP=$S(SDSVCP=0:0,SDSVCP="NO":0,SDSVCP=1:1,SDSVCP="YES":1,1:"") "RTN","SDEC07",97,0) ;validate note "RTN","SDEC07",98,0) S SDECNOTE=$G(SDECNOTE) S:SDECNOTE'="" SDECNOTE=$TR($E(SDECNOTE,1,150),"^"," ") ;alb/sat 658 - only use 1st 150 characters "RTN","SDEC07",99,0) ;validate APPTYPE "RTN","SDEC07",100,0) S APPTYPE=$G(APPTYPE) I APPTYPE'="",'$D(^SD(409.1,+APPTYPE,0)) S APPTYPE="" "RTN","SDEC07",101,0) ;validate Patient Status (EESTAT) "RTN","SDEC07",102,0) S EESTAT=$G(EESTAT) "RTN","SDEC07",103,0) I EESTAT="" D "RTN","SDEC07",104,0) .I $P(SDAPTYP,"|",1)="E" S EESTAT=$$GET1^DIQ(409.3,$P(SDAPTYP,"|",2)_",",27,"I") "RTN","SDEC07",105,0) .I $P(SDAPTYP,"|",1)="A" S EESTAT=$$GET1^DIQ(409.3,$P(SDAPTYP,"|",2)_",",.02,"I") "RTN","SDEC07",106,0) S EESTAT=$S(EESTAT="N":"N",EESTAT="NEW":"N",EESTAT="E":"E",EESTAT="ESTABLISHED":"E",1:"") "RTN","SDEC07",107,0) ;validate OVB (overbook) "RTN","SDEC07",108,0) S OVB=+$G(OVB) "RTN","SDEC07",109,0) I 'OVB D "RTN","SDEC07",110,0) .D OVBOOK^SDEC(.RET,SDCL,SDECSTART,SDECRES) "RTN","SDEC07",111,0) D "RTN","SDEC07",112,0) .S SDAPPTYP=+APPTYPE "RTN","SDEC07",113,0) .I 'SDAPPTYP D "RTN","SDEC07",114,0) ..I $P(SDAPTYP,"|",1)="E" S SDAPPTYP=$$GET1^DIQ(409.3,+$P(SDAPTYP,"|",2)_",",8.7,"I") "RTN","SDEC07",115,0) ..I $P(SDAPTYP,"|",1)="A" S SDAPPTYP=$$GET1^DIQ(409.85,+$P(SDAPTYP,"|",2)_",",8.7,"I") "RTN","SDEC07",116,0) ..I $P(SDAPTYP,"|",1)="C",+APPTYPE S SDAPPTYP=+APPTYPE "RTN","SDEC07",117,0) .S:'SDAPPTYP SDAPPTYP=$O(^SD(409.1,"B","REGULAR",0)) "RTN","SDEC07",118,0) ;Lock SDEC node "RTN","SDEC07",119,0) L +^SDEC(409.84,DFN):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") Q "RTN","SDEC07",120,0) ; "RTN","SDEC07",121,0) ;TSTART "RTN","SDEC07",122,0) S SDECAPPTID=$$SDECADD(SDECSTART,SDECEND,DFN,SDECRESD,SDECATID,SDDDT,SDID,SDAPTYP,PROVIEN,SDCL,SDECNOTE,SAVESTRT,SDECRES,SDAPPTYP,EESTAT,1,+SDECLEN) ;alb/sat 665 add SDECLEN "RTN","SDEC07",123,0) I 'SDECAPPTID D ERR(SDECI+1,"SDEC07 Error: Unable to add appointment to SDEC APPOINTMENT file.") Q "RTN","SDEC07",124,0) ;Save the Appointment and start a new transaction that will get rolled back if there's an error "RTN","SDEC07",125,0) ;TCOMMIT "RTN","SDEC07",126,0) ;TSTART "RTN","SDEC07",127,0) ; call chart request "RTN","SDEC07",128,0) S SDECDEV="" ;$$GET1^DIQ(9009020.2,$$DIV^SDECU,.05) I SDECDEV="" S SDECDERR="SDEC07 Error: No file room printer is defined for the chart request." "RTN","SDEC07",129,0) I SDECATID="WALKIN",$G(SDECCR),$G(SDECDEV)'="" S DGQUIET=1 D WISD^SDECRT(DFN,$P(SDECSTART,"."),"",SDECDEV) "RTN","SDEC07",130,0) I SDECNOTE]"" D SDECWP(SDECAPPTID,SDECNOTE) "RTN","SDEC07",131,0) ; "RTN","SDEC07",132,0) ;Create Appointment in VistA ;TODO: have this call APPVISTA^SDEC07B "RTN","SDEC07",133,0) I +SDCL,$D(^SC(SDCL,0)) D I +SDECERR D ERR(SDECI+1,$P(SDECERR,U,2)) "RTN","SDEC07",134,0) . S SDECC("PAT")=DFN "RTN","SDEC07",135,0) . S SDECC("CLN")=SDCL "RTN","SDEC07",136,0) . S SDECC("TYP")=$S(+SDECWKIN:4,SDAPPTYP=1:1,1:3) ;3 for scheduled appts, 4 for walkins "RTN","SDEC07",137,0) . S SDECC("COL")=$S(SDAPPTYP=7:1,1:"") ;collateral visit if appointment type is COLLATERAL OF VET. "RTN","SDEC07",138,0) . S SDECC("APT")=SDAPPTYP "RTN","SDEC07",139,0) . S SDECC("ADT")=SDECSTART "RTN","SDEC07",140,0) . S SDECC("LEN")=SDECLEN "RTN","SDEC07",141,0) . S SDECC("OI")=$E($G(SDECNOTE),1,150) ;File 44 has 150 character limit on OTHER field "RTN","SDEC07",142,0) . S SDECC("OI")=$TR(SDECC("OI"),";"," ") ;No semicolons allowed "RTN","SDEC07",143,0) . S SDECC("OI")=$$STRIP(SDECC("OI")) ;Strip control characters from note "RTN","SDEC07",144,0) . S SDECC("RES")=SDECRESD "RTN","SDEC07",145,0) . S SDECC("USR")=DUZ "RTN","SDEC07",146,0) . S SDECC("MTR")=$G(SDMRTC) "RTN","SDEC07",147,0) . S SDECC("DDT")=SDDDT "RTN","SDEC07",148,0) . S SDECC("REQ")=SDREQBY "RTN","SDEC07",149,0) . S SDECC("LAB")=SDLAB "RTN","SDEC07",150,0) . S SDECC("XRA")=SDXRAY "RTN","SDEC07",151,0) . S SDECC("EKG")=SDEKG "RTN","SDEC07",152,0) . S SDECC("OVB")=+OVB "RTN","SDEC07",153,0) . S:$P(SDAPTYP,"|",1)="C" SDECC("CON")=$P(SDAPTYP,"|",2) "RTN","SDEC07",154,0) . S SDECERR=$$MAKE^SDEC07B(.SDECC) "RTN","SDEC07",155,0) . Q:SDECERR "RTN","SDEC07",156,0) . ;Update Clinic availability "RTN","SDEC07",157,0) . D AVUPDT(SDCL,SDECSTART,SDECLEN) "RTN","SDEC07",158,0) . ;L "RTN","SDEC07",159,0) . Q "RTN","SDEC07",160,0) ;update wait list "RTN","SDEC07",161,0) I $P(SDAPTYP,"|",1)="E" D EWL^SDEC07A($P(SDAPTYP,"|",2),SDECSTART,SDCL,SDSVCPR,SDSVCP,,SDAPPTYP) ;alb/sat 658 do not pass note "RTN","SDEC07",162,0) ;update appt request "RTN","SDEC07",163,0) I $P(SDAPTYP,"|",1)="A" D "RTN","SDEC07",164,0) .D UPDATE^SDECAR2($P(SDAPTYP,"|",2),SDECSTART,SDCL,SDSVCPR,SDSVCP,,SDAPPTYP) ;alb/sat 658 do not pass note "RTN","SDEC07",165,0) .I $G(SDMRTC),$G(SDPARENT) D AR433^SDECAR2(SDPARENT,SDECAPPTID_"~"_$P(SDAPTYP,"|",2)) "RTN","SDEC07",166,0) .D:$G(SDPARENT) AR438^SDECAR2($P(SDAPTYP,"|",2),SDPARENT) "RTN","SDEC07",167,0) ; "RTN","SDEC07",168,0) ;Return Recordset "RTN","SDEC07",169,0) ;TCOMMIT "RTN","SDEC07",170,0) L -^SDEC(409.84,DFN) "RTN","SDEC07",171,0) L -^DPT(DFN) "RTN","SDEC07",172,0) S SDECI=SDECI+1 "RTN","SDEC07",173,0) S ^TMP("SDEC07",$J,SDECI)=SDECAPPTID_"^"_$G(SDECDERR)_$C(30) "RTN","SDEC07",174,0) S SDECI=SDECI+1 "RTN","SDEC07",175,0) S ^TMP("SDEC07",$J,SDECI)=$C(31) "RTN","SDEC07",176,0) Q "RTN","SDEC07",177,0) ; "RTN","SDEC07",178,0) STRIP(SDECZ) ;Replace control characters with spaces "RTN","SDEC07",179,0) N SDECI "RTN","SDEC07",180,0) F SDECI=1:1:$L(SDECZ) I (32>$A($E(SDECZ,SDECI))) S SDECZ=$E(SDECZ,1,SDECI-1)_" "_$E(SDECZ,SDECI+1,999) "RTN","SDEC07",181,0) Q SDECZ "RTN","SDEC07",182,0) ; "RTN","SDEC07",183,0) ;ADD SDEC APPOINTMENT ENTRY "RTN","SDEC07",184,0) SDECADD(SDECSTART,SDECEND,DFN,SDECRESD,SDECATID,SDDDT,SDID,SDAPTYP,PROVIEN,SDCL,SDECNOTE,SAVESTRT,SDECRES,SDAPPTYP,EESTAT,SDF,SDECLEN) ;alb/sat 665 add SDECLEN "RTN","SDEC07",185,0) ;SDF - (optional) flags "RTN","SDEC07",186,0) ; 1. called from GUI (update consult only if called from GUI) "RTN","SDEC07",187,0) ;Returns ien in SDECAPPT or 0 if failed "RTN","SDEC07",188,0) ;called from SDEC APPADD rpc and from VistA via SDM1A "RTN","SDEC07",189,0) ;Create entry in SDEC APPOINTMENT "RTN","SDEC07",190,0) N SDIEN,SDECAPPTID,SDECFDA,SDECIEN,SDECMSG,SL,X "RTN","SDEC07",191,0) S SDECSTART=$G(SDECSTART) "RTN","SDEC07",192,0) S SAVESTRT=$G(SAVESTRT),SDECRES=$G(SDECRES) ;MGH save date/time for consult request "RTN","SDEC07",193,0) S DFN=$G(DFN) "RTN","SDEC07",194,0) S SDECRESD=$G(SDECRESD) "RTN","SDEC07",195,0) S SDECATID=$G(SDECATID) "RTN","SDEC07",196,0) S SDDDT=$G(SDDDT) "RTN","SDEC07",197,0) S SDID=$G(SDID) "RTN","SDEC07",198,0) S SDAPTYP=$G(SDAPTYP) "RTN","SDEC07",199,0) S SDAPPTYP=$G(SDAPPTYP) "RTN","SDEC07",200,0) S PROVIEN=$G(PROVIEN) "RTN","SDEC07",201,0) S SDCL=$G(SDCL) "RTN","SDEC07",202,0) S SDECEND=$G(SDECEND) "RTN","SDEC07",203,0) ;alb/sat 665 begin modification "RTN","SDEC07",204,0) S SDECLEN=$G(SDECLEN) "RTN","SDEC07",205,0) I SDECLEN="",SDECEND="" S SDECLEN=+$G(^SC(SDCL,"SL")) S:'+SDECLEN SDECLEN=30 S SDECEND=$$FMADD^XLFDT(SDECSTART,,,+SDECLEN) ;no length or end date/time "RTN","SDEC07",206,0) I SDECLEN="",SDECEND'="" S SDECLEN=$$FMDIFF^XLFDT(SDECEND,SDECSTART,2)\60 ;no length "RTN","SDEC07",207,0) I SDECLEN'="",SDECEND="" S SDECEND=$$FMADD^XLFDT(SDECSTART,,,+SDECLEN) ;no end date/time "RTN","SDEC07",208,0) ;alb/sat 665 end modification "RTN","SDEC07",209,0) S SDECNOTE=$G(SDECNOTE) "RTN","SDEC07",210,0) S SDF=$G(SDF,0) "RTN","SDEC07",211,0) I PROVIEN="" D "RTN","SDEC07",212,0) .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I") "RTN","SDEC07",213,0) S SDIEN=$$APPTGET^SDECUTL(DFN,SDECSTART,SDCL) "RTN","SDEC07",214,0) S SDIEN=$S(SDIEN'="":SDIEN_",",1:"+1,") "RTN","SDEC07",215,0) S SDECFDA(409.84,SDIEN,.01)=SDECSTART "RTN","SDEC07",216,0) S SDECFDA(409.84,SDIEN,.02)=SDECEND "RTN","SDEC07",217,0) S SDECFDA(409.84,SDIEN,.05)=DFN "RTN","SDEC07",218,0) S:+SDAPPTYP SDECFDA(409.84,SDIEN,.06)=SDAPPTYP "RTN","SDEC07",219,0) ;S:SDECATID?.N SDECFDA(409.84,SDIEN,.06)=SDECATID "RTN","SDEC07",220,0) S SDECFDA(409.84,SDIEN,.07)=SDECRESD "RTN","SDEC07",221,0) S SDECFDA(409.84,SDIEN,.08)=$G(DUZ) "RTN","SDEC07",222,0) S SDECFDA(409.84,SDIEN,.09)=$P($$NOW^XLFDT,".",1) "RTN","SDEC07",223,0) S SDECFDA(409.84,SDIEN,.1)="" "RTN","SDEC07",224,0) S SDECFDA(409.84,SDIEN,.101)="" "RTN","SDEC07",225,0) S SDECFDA(409.84,SDIEN,.102)="" "RTN","SDEC07",226,0) S SDECFDA(409.84,SDIEN,.11)="" "RTN","SDEC07",227,0) S SDECFDA(409.84,SDIEN,.12)="" "RTN","SDEC07",228,0) S SDECFDA(409.84,SDIEN,.121)="" "RTN","SDEC07",229,0) S SDECFDA(409.84,SDIEN,.122)="" "RTN","SDEC07",230,0) S:SDECATID="WALKIN" SDECFDA(409.84,SDIEN,.13)="y" "RTN","SDEC07",231,0) S:PROVIEN'="" SDECFDA(409.84,SDIEN,.16)=PROVIEN "RTN","SDEC07",232,0) S SDECFDA(409.84,SDIEN,.17)="" "RTN","SDEC07",233,0) S:$G(SDECLEN)'="" SDECFDA(409.84,SDIEN,.18)=SDECLEN "RTN","SDEC07",234,0) S SDECFDA(409.84,SDIEN,.2)=SDDDT "RTN","SDEC07",235,0) S:$G(SDID)'="" SDECFDA(409.84,SDIEN,.21)=SDID "RTN","SDEC07",236,0) S:SDAPTYP'="" SDECFDA(409.84,SDIEN,.22)=$P(SDAPTYP,"|",2)_";"_$S($P(SDAPTYP,"|",1)="E":"SDWL(409.3,",$P(SDAPTYP,"|",1)="C":"GMR(123,",$P(SDAPTYP,"|",1)="R":"SD(403.5,",$P(SDAPTYP,"|",1)="A":"SDEC(409.85,",1:"") "RTN","SDEC07",237,0) S:$G(EESTAT)'="" SDECFDA(409.84,SDIEN,.23)=EESTAT "RTN","SDEC07",238,0) K SDECIEN,SDECMSG "RTN","SDEC07",239,0) D UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG") "RTN","SDEC07",240,0) S SDECAPPTID=$S(SDIEN'="+1,":+SDIEN,1:+$G(SDECIEN(1))) "RTN","SDEC07",241,0) K SDECMSG "RTN","SDEC07",242,0) I SDECNOTE="" D WP^DIE(409.84,$S(+$G(SDECAPPTID):SDECAPPTID_",",1:SDIEN_","),1,"","@","SDECMSG") "RTN","SDEC07",243,0) I SDECNOTE'="" N ARR D WP^SDECUTL(.ARR,SDECNOTE) D WP^DIE(409.84,$S(+$G(SDECAPPTID):SDECAPPTID_",",1:SDIEN_","),1,"","ARR","SDECMSG") "RTN","SDEC07",244,0) I SDECAPPTID'="" D "RTN","SDEC07",245,0) .I $P(SDAPTYP,"|",1)="C",SDF D "RTN","SDEC07",246,0) ..D REQSET^SDEC07A($P(SDAPTYP,"|",2),PROVIEN,"",1,"",SDECNOTE,SAVESTRT,SDECRES) ;MGH added 3 parameters to this call "RTN","SDEC07",247,0) Q SDECAPPTID "RTN","SDEC07",248,0) ; "RTN","SDEC07",249,0) SDECWP(SDECAPPTID,SDECNOTE) ; "RTN","SDEC07",250,0) ;Add WP field "RTN","SDEC07",251,0) I SDECNOTE]"" S SDECNOTE(.5)=SDECNOTE,SDECNOTE="" "RTN","SDEC07",252,0) I $D(SDECNOTE(0)) S SDECNOTE(.5)=SDECNOTE(0) K SDECNOTE(0) "RTN","SDEC07",253,0) I $D(SDECNOTE(.5)) D "RTN","SDEC07",254,0) . D WP^DIE(409.84,SDECAPPTID_",",1,"","SDECNOTE","SDECMSG") "RTN","SDEC07",255,0) Q "RTN","SDEC07",256,0) ; "RTN","SDEC07",257,0) ADDEVT(DFN,SDECSTART,SDECSC,SDCLA) ;EP "RTN","SDEC07",258,0) ;Called by SDEC ADD APPOINTMENT protocol "RTN","SDEC07",259,0) ;SDECSC=IEN of clinic in ^SC "RTN","SDEC07",260,0) ;SDCLA=IEN for ^SC(SDECSC,"S",SDECSTART,1,SDCLA). Use to get Length & Note "RTN","SDEC07",261,0) ; "RTN","SDEC07",262,0) N SDECNOD,SDECLEN,SDECAPPTID,SDECNODP,SDECWKIN,SDECRES "RTN","SDEC07",263,0) Q:+$G(SDECNOEV) "RTN","SDEC07",264,0) I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) "RTN","SDEC07",265,0) Q:'+$G(SDECRES) "RTN","SDEC07",266,0) S SDECNOD=$G(^SC(SDECSC,"S",SDECSTART,1,SDCLA,0)) "RTN","SDEC07",267,0) Q:SDECNOD="" "RTN","SDEC07",268,0) S SDECNODP=$G(^DPT(DFN,"S",SDECSTART,0)) "RTN","SDEC07",269,0) S SDECWKIN="" "RTN","SDEC07",270,0) S:$P(SDECNODP,U,7)=4 SDECWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile "RTN","SDEC07",271,0) S SDECLEN=$P(SDECNOD,U,2) "RTN","SDEC07",272,0) Q:'+SDECLEN "RTN","SDEC07",273,0) S SDECEND=$$FMADD^XLFDT(SDECSTART,0,0,SDECLEN,0) "RTN","SDEC07",274,0) S SDECAPPTID=$$SDECADD(SDECSTART,SDECEND,DFN,SDECRES,SDECWKIN,,,,,SDECSC,,,,,,1,+SDECLEN) ;alb/sat 665 add SDECLEN "RTN","SDEC07",275,0) Q:'+SDECAPPTID "RTN","SDEC07",276,0) S SDECNOTE=$P(SDECNOD,U,4) "RTN","SDEC07",277,0) I SDECNOTE]"" D SDECWP(SDECAPPTID,SDECNOTE) "RTN","SDEC07",278,0) D ADDEVT3(SDECRES) "RTN","SDEC07",279,0) Q "RTN","SDEC07",280,0) ; "RTN","SDEC07",281,0) ADDEVT3(SDECRES) ; "RTN","SDEC07",282,0) ;Call RaiseEvent to notify GUI clients "RTN","SDEC07",283,0) Q "RTN","SDEC07",284,0) ; "RTN","SDEC07",285,0) ERR(SDECI,SDECERR) ;Error processing "RTN","SDEC07",286,0) S SDECI=SDECI+1 "RTN","SDEC07",287,0) S SDECERR=$TR(SDECERR,"^","~") "RTN","SDEC07",288,0) S ^TMP("SDEC07",$J,SDECI)=$G(SDECAPPTID,0)_"^"_SDECERR_$C(30) "RTN","SDEC07",289,0) S SDECI=SDECI+1 "RTN","SDEC07",290,0) S ^TMP("SDEC07",$J,SDECI)=$C(31) "RTN","SDEC07",291,0) L "RTN","SDEC07",292,0) Q "RTN","SDEC07",293,0) ; "RTN","SDEC07",294,0) ETRAP ;EP Error trap entry "RTN","SDEC07",295,0) D ^%ZTER "RTN","SDEC07",296,0) I '$D(SDECI) N SDECI S SDECI=999999 "RTN","SDEC07",297,0) S SDECI=SDECI+1 "RTN","SDEC07",298,0) D ERR(SDECI,"SDEC07 Error") "RTN","SDEC07",299,0) Q "RTN","SDEC07",300,0) ; "RTN","SDEC07",301,0) DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR "RTN","SDEC07",302,0) ; "RTN","SDEC07",303,0) DOW N SDTMP S SDTMP=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(SDTMP#4)+$E("144025036146",Y) "RTN","SDEC07",304,0) F SDTMP=SDTMP:-1:281 S Y=SDTMP#4=1+1+Y "RTN","SDEC07",305,0) S Y=$E(X,6,7)+Y#7 "RTN","SDEC07",306,0) Q "RTN","SDEC07",307,0) ; "RTN","SDEC07",308,0) AVUPDT(SDCL,SDECSTART,SDECLEN) ;Update Clinic availability "RTN","SDEC07",309,0) ;SEE SDM1 "RTN","SDEC07",310,0) N %,ABORT,SDNOT,Y,DFN,SDVAL "RTN","SDEC07",311,0) N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG "RTN","SDEC07",312,0) N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I,SDECINC "RTN","SDEC07",313,0) S Y=SDCL ;,DFN=DFN ;renamed SDECPATID to DFN "RTN","SDEC07",314,0) S SL=$G(^SC(+Y,"SL")),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SC=Y,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","SDEC07",315,0) ;Determine maximum days for scheduling "RTN","SDEC07",316,0) S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365 "RTN","SDEC07",317,0) S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1)) "RTN","SDEC07",318,0) S SDDATE=SDECSTART "RTN","SDEC07",319,0) S SDSDATE=SDDATE,SDDATE=SDDATE\1 "RTN","SDEC07",320,0) 1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC "RTN","SDEC07",321,0) ;Q:$D(SDXXX) "RTN","SDEC07",322,0) S CCXN=0 K MXOK,COV,SDPROT Q:$G(DFN)<0 S SC=+SC "RTN","SDEC07",323,0) S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2) "RTN","SDEC07",324,0) S X2=SDEDT D C^%DTC S SDEDT=X "RTN","SDEC07",325,0) S Y=SDECSTART "RTN","SDEC07",326,0) EN1 S (X,SD)=Y,SM=0 D DOW "RTN","SDEC07",327,0) S I '$D(^SC(SC,"ST",$P(SD,"."),1)) S SS=+$O(^SC(+SC,"T"_Y,SD)) Q:SS'>0 Q:^(SS,1)="" S ^SC(+SC,"ST",$P(SD,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(SD,".") "RTN","SDEC07",328,0) S S=SDECLEN "RTN","SDEC07",329,0) ;Check if SDECLEN evenly divisible by appointment length "RTN","SDEC07",330,0) S SDVAL=$P(SL,U) "RTN","SDEC07",331,0) I SDECLEN9 "RTN","SDEC07",338,0) L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC "RTN","SDEC07",339,0) S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1) "RTN","SDEC07",340,0) S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST "RTN","SDEC07",341,0) I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q "RTN","SDEC07",342,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","SDEC07",343,0) ; "RTN","SDEC07",344,0) SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP "RTN","SDEC07",345,0) S SDNOT=1 "RTN","SDEC07",346,0) S ABORT=0 "RTN","SDEC07",347,0) F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT "RTN","SDEC07",348,0) . S ST=$E(S,I+1) S:ST="" ST=" " "RTN","SDEC07",349,0) . S Y=$E(STR,$F(STR,ST)-2) "RTN","SDEC07",350,0) . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q "RTN","SDEC07",351,0) . I Y="" S ABORT=1 Q "RTN","SDEC07",352,0) . 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","SDEC07",353,0) . Q "RTN","SDEC07",354,0) S ^SC(SC,"ST",$P(SD,"."),1)=S "RTN","SDEC07",355,0) L -^SC(SC,"ST",$P(SD,"."),1) "RTN","SDEC07",356,0) Q "RTN","SDEC07",357,0) ; "RTN","SDEC07",358,0) ERROR ; "RTN","SDEC07",359,0) D ERR1("Error") "RTN","SDEC07",360,0) Q "RTN","SDEC07",361,0) ; "RTN","SDEC07",362,0) ERR1(SDECERR) ;Error processing "RTN","SDEC07",363,0) S SDECI=SDECI+1 "RTN","SDEC07",364,0) S ^TMP("SDEC07",$J,SDECI)=SDECERR_$C(30) "RTN","SDEC07",365,0) S SDECI=SDECI+1 "RTN","SDEC07",366,0) S ^TMP("SDEC07",$J,SDECI)=$C(31) "RTN","SDEC07",367,0) Q "RTN","SDEC07B") 0^5^B54807714^B40384018 "RTN","SDEC07B",1,0) SDEC07B ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDEC07B",2,0) ;;5.3;Scheduling;**627,658,665**;Aug 13, 1993;Build 14 "RTN","SDEC07B",3,0) ; "RTN","SDEC07B",4,0) Q "RTN","SDEC07B",5,0) ; "RTN","SDEC07B",6,0) MAKE(BSDR) ;PEP; call to store appt made "RTN","SDEC07B",7,0) ; "RTN","SDEC07B",8,0) ; Make call using: S ERR=$$MAKE^SDEC07B(.ARRAY) "RTN","SDEC07B",9,0) ; "RTN","SDEC07B",10,0) ; Input Array - "RTN","SDEC07B",11,0) ; BSDR("PAT") = ien of patient in file 2 "RTN","SDEC07B",12,0) ; BSDR("CLN") = ien of clinic in file 44 "RTN","SDEC07B",13,0) ; BSDR("TYP") = C&P if appointment type is C&P, 3 for scheduled appts, 4 for walkins "RTN","SDEC07B",14,0) ; BSDR("COL") = collateral if appointment type is COLLATERAL OF VET. "RTN","SDEC07B",15,0) ; BSDR("APT") = Appointment type pointer to APPOINTMENT TYPE file 409.1 "RTN","SDEC07B",16,0) ; BSDR("ADT") = appointment date and time "RTN","SDEC07B",17,0) ; BSDR("LEN") = appointment length in minutes (5-120) "RTN","SDEC07B",18,0) ; BSDR("OI") = reason for appt - up to 150 characters "RTN","SDEC07B",19,0) ; BSDR("USR") = user who made appt "RTN","SDEC07B",20,0) ; BSDR("RES") = resource pointer to SDEC RESOURCE ^SDEC(409.831, "RTN","SDEC07B",21,0) ; BSDR("MTR") = MTRC flag (multiple appointments) 0=False (default) 1=True "RTN","SDEC07B",22,0) ; BSDR("DDT") = Desired Date of Appt in fm format "RTN","SDEC07B",23,0) ; BSDR("REQ") = Requested By - valid values are 1=PROVIDER 2=PATIENT or "" "RTN","SDEC07B",24,0) ; BSDR("LAB") = LAB date/time in fm format "RTN","SDEC07B",25,0) ; BSDR("EKG") = EKG date/time in fm format "RTN","SDEC07B",26,0) ; BSDR("XRA") = XRAY date/time in fm format "RTN","SDEC07B",27,0) ; BSDR("CON") = Consult link - pointer to file 123 "RTN","SDEC07B",28,0) ; BSDR("OVB") = overbook flag - 1=yes, this is an overbook "RTN","SDEC07B",29,0) ; "RTN","SDEC07B",30,0) ;Output: error status and message "RTN","SDEC07B",31,0) ; = 0 or null: everything okay "RTN","SDEC07B",32,0) ; = 1^message: error and reason "RTN","SDEC07B",33,0) ; "RTN","SDEC07B",34,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","SDEC07B",35,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","SDEC07B",36,0) I "1234"'[$G(BSDR("TYP")) Q 1_U_"Appt Type error: "_$G(BSDR("TYP")) "RTN","SDEC07B",37,0) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds "RTN","SDEC07B",38,0) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) "RTN","SDEC07B",39,0) ; "RTN","SDEC07B",40,0) I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) "RTN","SDEC07B",41,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) "RTN","SDEC07B",42,0) I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)'="C",$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)'="PC" Q 1_U_"Patient "_$$GET1^DIQ(2,BSDR("PAT")_",",.01)_" already has appt at "_$$FMTE^XLFDT(BSDR("ADT")) "RTN","SDEC07B",43,0) ; "RTN","SDEC07B",44,0) N DIC,DA,Y,X,DD,DO,DLAYGO "RTN","SDEC07B",45,0) N SDECERR "RTN","SDEC07B",46,0) N SDFU,SDNA,SDRET,SDSRT "RTN","SDEC07B",47,0) ; "RTN","SDEC07B",48,0) S BSDR("APT")=+$G(BSDR("APT")) "RTN","SDEC07B",49,0) S BSDR("COL")=+$G(BSDR("COL")) "RTN","SDEC07B",50,0) ;get scheduling request type AND next ava. appt. indicator "RTN","SDEC07B",51,0) S SDSRT=$$SDSRT(BSDR("TYP"),BSDR("MTR"),BSDR("DDT"),BSDR("REQ")) "RTN","SDEC07B",52,0) ; next ava.appt. indicator field 26 "RTN","SDEC07B",53,0) S SDNA=$P(SDSRT,U,2) "RTN","SDEC07B",54,0) ; scheduling request type field 25 "RTN","SDEC07B",55,0) S SDSRT=$P(SDSRT,U,1) "RTN","SDEC07B",56,0) ;determine if Follow-up visit field 28 "RTN","SDEC07B",57,0) S SDRET="" "RTN","SDEC07B",58,0) D PCSTGET^SDEC(.SDRET,BSDR("PAT"),BSDR("CLN")) "RTN","SDEC07B",59,0) S SDFU=$P($P(@SDRET@(1),U,2),$C(30,31),1) "RTN","SDEC07B",60,0) S SDFU=$S(SDFU="YES":1,1:0) "RTN","SDEC07B",61,0) K @SDRET "RTN","SDEC07B",62,0) ;store "RTN","SDEC07B",63,0) I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),(($P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)="C")!($P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)="PC")) D "RTN","SDEC07B",64,0) . ; "un-cancel" existing appt in file 2 "RTN","SDEC07B",65,0) . N SDECFDA,SDECIENS,SDECMSG "RTN","SDEC07B",66,0) . S SDECIENS=BSDR("ADT")_","_BSDR("PAT")_"," "RTN","SDEC07B",67,0) . S SDECFDA(2.98,SDECIENS,".01")=BSDR("CLN") "RTN","SDEC07B",68,0) . S SDECFDA(2.98,SDECIENS,"3")=$S($G(^DPT(+$G(BSDR("PAT")),.1))'="":"I",1:"") "RTN","SDEC07B",69,0) . S SDECFDA(2.98,SDECIENS,"5")=BSDR("LAB") ;lab date/time "RTN","SDEC07B",70,0) . S SDECFDA(2.98,SDECIENS,"6")=BSDR("XRA") ;xray date/time "RTN","SDEC07B",71,0) . S SDECFDA(2.98,SDECIENS,"7")=BSDR("EKG") ;ekg date/time "RTN","SDEC07B",72,0) . S SDECFDA(2.98,SDECIENS,"9")=BSDR("TYP") "RTN","SDEC07B",73,0) . S:+BSDR("APT") SDECFDA(2.98,SDECIENS,"9.5")=BSDR("APT") "RTN","SDEC07B",74,0) . S:+BSDR("COL") SDECFDA(2.98,SDECIENS,"13")=BSDR("COL") "RTN","SDEC07B",75,0) . S SDECFDA(2.98,SDECIENS,"14")="" "RTN","SDEC07B",76,0) . S SDECFDA(2.98,SDECIENS,"15")="" "RTN","SDEC07B",77,0) . S SDECFDA(2.98,SDECIENS,"16")="" "RTN","SDEC07B",78,0) . S SDECFDA(2.98,SDECIENS,"17")="" ;alb/sat 658 "RTN","SDEC07B",79,0) . S SDECFDA(2.98,SDECIENS,"19")=DUZ ;data entry clerk "RTN","SDEC07B",80,0) . S SDECFDA(2.98,SDECIENS,"20")=$$NOW^XLFDT "RTN","SDEC07B",81,0) . S SDECFDA(2.98,SDECIENS,"25")=SDSRT ;scheduling request type "RTN","SDEC07B",82,0) . S SDECFDA(2.98,SDECIENS,"26")=SDNA ;next ava. appt. indicator "RTN","SDEC07B",83,0) . S SDECFDA(2.98,SDECIENS,"27")=BSDR("DDT") ;desired date of appt "RTN","SDEC07B",84,0) . S SDECFDA(2.98,SDECIENS,"28")=SDFU ;follow-up visit yes/no "RTN","SDEC07B",85,0) . D FILE^DIE("","SDECFDA","SDECMSG") "RTN","SDEC07B",86,0) . N SDECTEMP S SDECTEMP=$G(SDECMSG) "RTN","SDEC07B",87,0) E D I $G(SDECERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") "RTN","SDEC07B",88,0) . ; add appt to file 2 "RTN","SDEC07B",89,0) . N SDECFDA,SDECIENS,SDECMSG "RTN","SDEC07B",90,0) . S SDECIENS="?+2,"_BSDR("PAT")_"," "RTN","SDEC07B",91,0) . S SDECIENS(2)=BSDR("ADT") "RTN","SDEC07B",92,0) . S SDECFDA(2.98,SDECIENS,.01)=BSDR("CLN") "RTN","SDEC07B",93,0) . S SDECFDA(2.98,SDECIENS,"3")=$S($G(^DPT(+$G(BSDR("PAT")),.1))'="":"I",1:"") "RTN","SDEC07B",94,0) . S SDECFDA(2.98,SDECIENS,"5")=BSDR("LAB") ;lab date/time "RTN","SDEC07B",95,0) . S SDECFDA(2.98,SDECIENS,"6")=BSDR("XRA") ;xray date/time "RTN","SDEC07B",96,0) . S SDECFDA(2.98,SDECIENS,"7")=BSDR("EKG") ;ekg date/time "RTN","SDEC07B",97,0) . S SDECFDA(2.98,SDECIENS,"9")=BSDR("TYP") "RTN","SDEC07B",98,0) . S:+BSDR("APT") SDECFDA(2.98,SDECIENS,"9.5")=BSDR("APT") "RTN","SDEC07B",99,0) . S:+BSDR("COL") SDECFDA(2.98,SDECIENS,"13")=BSDR("COL") "RTN","SDEC07B",100,0) . S SDECFDA(2.98,SDECIENS,"14")="" "RTN","SDEC07B",101,0) . S SDECFDA(2.98,SDECIENS,"15")="" "RTN","SDEC07B",102,0) . S SDECFDA(2.98,SDECIENS,"16")="" "RTN","SDEC07B",103,0) . S SDECFDA(2.98,SDECIENS,"17")="" ;alb/sat 658 "RTN","SDEC07B",104,0) . S SDECFDA(2.98,SDECIENS,"19")=DUZ ;data entry clerk "RTN","SDEC07B",105,0) . S SDECFDA(2.98,SDECIENS,"20")=$$NOW^XLFDT "RTN","SDEC07B",106,0) . S SDECFDA(2.98,SDECIENS,"25")=SDSRT ;scheduling request type "RTN","SDEC07B",107,0) . S SDECFDA(2.98,SDECIENS,"26")=SDNA ;next ava. appt. indicator "RTN","SDEC07B",108,0) . S SDECFDA(2.98,SDECIENS,"27")=BSDR("DDT") ;desired date of appt "RTN","SDEC07B",109,0) . S SDECFDA(2.98,SDECIENS,"28")=SDFU ;follow-up visit yes/no "RTN","SDEC07B",110,0) . D UPDATE^DIE("","SDECFDA","SDECIENS","SDECERR(1)") "RTN","SDEC07B",111,0) ; "RTN","SDEC07B",112,0) ; add appt to file 44 "RTN","SDEC07B",113,0) K DIC,DA,X,Y,DLAYGO,DD,DO "RTN","SDEC07B",114,0) I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^" "RTN","SDEC07B",115,0) I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT") "RTN","SDEC07B",116,0) . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT") "RTN","SDEC07B",117,0) . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 "RTN","SDEC07B",118,0) . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN "RTN","SDEC07B",119,0) ; "RTN","SDEC07B",120,0) K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM "RTN","SDEC07B",121,0) S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," "RTN","SDEC07B",122,0) S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT") "RTN","SDEC07B",123,0) S DIC("DR")="1////"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7////"_BSDR("USR")_";8////"_$$NOW^XLFDT_$S(+$G(BSDR("OVB")):";9////O",1:"") "RTN","SDEC07B",124,0) S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003 "RTN","SDEC07B",125,0) D FILE^DICN "RTN","SDEC07B",126,0) ;add consult link "RTN","SDEC07B",127,0) I $G(BSDR("CON")) D "RTN","SDEC07B",128,0) .N SDFDA,SDIEN "RTN","SDEC07B",129,0) .S SDIEN=+Y "RTN","SDEC07B",130,0) .Q:SDIEN=-1 "RTN","SDEC07B",131,0) .S SDFDA(44.003,SDIEN_","_BSDR("ADT")_","_BSDR("CLN")_",",688)=BSDR("CON") "RTN","SDEC07B",132,0) .D UPDATE^DIE("","SDFDA") "RTN","SDEC07B",133,0) ; "RTN","SDEC07B",134,0) Q 0 "RTN","SDEC07B",135,0) ; call event driver "RTN","SDEC07B",136,0) NEW DFN,SDT,SDCL,SDDA,SDMODE "RTN","SDEC07B",137,0) S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2 "RTN","SDEC07B",138,0) S SDDA=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) "RTN","SDEC07B",139,0) D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE) "RTN","SDEC07B",140,0) Q 0 "RTN","SDEC07B",141,0) ; "RTN","SDEC07B",142,0) SDSRT(TYP,MTR,DDT,REQ) ;get SCHEDULING REQUEST TYPE and NEXT AVA.APPT. INDICATOR "RTN","SDEC07B",143,0) ;INPUT: "RTN","SDEC07B",144,0) ; TYP = 3 for scheduled appts, 4 for walkins "RTN","SDEC07B",145,0) ; MTR = MTRC flag (multiple appointments) 0=False (default) 1=True "RTN","SDEC07B",146,0) ; DDT = Desired Date of Appt in fm format "RTN","SDEC07B",147,0) ; REQ = Requested By - valid values are 1=PROVIDER 2=PATIENT or "" "RTN","SDEC07B",148,0) ;RETURN: 2 ^ pieces: "RTN","SDEC07B",149,0) ; 1 - SCHEDULING REQUEST TYPE internal format - valid values: "RTN","SDEC07B",150,0) ; N:'NEXT AVAILABLE' APPT. "RTN","SDEC07B",151,0) ; C:OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.) "RTN","SDEC07B",152,0) ; P:OTHER THAN 'NEXT AVA.' (PATIENT REQ.) "RTN","SDEC07B",153,0) ; W:WALKIN APPT. "RTN","SDEC07B",154,0) ; M:MULTIPLE APPT. BOOKING "RTN","SDEC07B",155,0) ; A:AUTO REBOOK "RTN","SDEC07B",156,0) ; O:OTHER THAN 'NEXT AVA.' APPT. "RTN","SDEC07B",157,0) ; 2 - NEXT AVA. APPT. INDICATOR internal format - valid values: "RTN","SDEC07B",158,0) ; N:'NEXT AVAILABLE' APPT. "RTN","SDEC07B",159,0) ; C:OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.) "RTN","SDEC07B",160,0) ; P:OTHER THAN 'NEXT AVA.' (PATIENT REQ.) "RTN","SDEC07B",161,0) ; W:WALKIN APPT. "RTN","SDEC07B",162,0) ; M:MULTIPLE APPT. BOOKING "RTN","SDEC07B",163,0) ; A:AUTO REBOOK "RTN","SDEC07B",164,0) ; O:OTHER THAN 'NEXT AVA.' APPT. "RTN","SDEC07B",165,0) ; "RTN","SDEC07B",166,0) N RET "RTN","SDEC07B",167,0) S RET="" "RTN","SDEC07B",168,0) ;1. If user creates a walkin appointment would be W:WALKIN APPT, 0:NOT INDICATED TO BE A 'NEXT AVA.' APPT "RTN","SDEC07B",169,0) I TYP=4 Q "W^0" "RTN","SDEC07B",170,0) ;2. If user creates an rm request with MTRC flagged "RTN","SDEC07B",171,0) ; AND desired date is 'today' "RTN","SDEC07B",172,0) ; would be M:MULTIPLE APPT. BOOKING, 3:'NEXT AVA.' APPT. INDICATED BY USER & CALCULATION "RTN","SDEC07B",173,0) I +MTR,$P($$NOW^XLFDT,".",1)=DDT Q "M^3" "RTN","SDEC07B",174,0) ;3. If user creates an rm request with MTRC flagged "RTN","SDEC07B",175,0) ; AND desired date is not 'today' "RTN","SDEC07B",176,0) ; would be M:MULTIPLE APPT. BOOKING, 0:'NOT INDICATED TO BE A 'NEXT AVA.' APPT "RTN","SDEC07B",177,0) I +MTR,$P($$NOW^XLFDT,".",1)'=DDT Q "M^0" "RTN","SDEC07B",178,0) ;4. If the user enters a desired date for the clinic stop that is today "RTN","SDEC07B",179,0) ; then N:'NEXT AVAILABLE' APPT., 1:'NEXT AVA.' APPT. INDICATED BY USER "RTN","SDEC07B",180,0) I $P($$NOW^XLFDT(),".",1)=DDT Q "N^1" "RTN","SDEC07B",181,0) ;5. If the user enters a desired date not today "RTN","SDEC07B",182,0) ; AND the request is by patient "RTN","SDEC07B",183,0) ; then P:OTHER THAN 'NEXT AVA.' (PATIENT REQ.); 0:NOT INDICATED TO BE A 'NEXT AVA.' APPT. "RTN","SDEC07B",184,0) I $P($$NOW^XLFDT(),".",1)'=DDT,REQ=2 Q "P^0" "RTN","SDEC07B",185,0) ;6. If the user enters a desired date not today "RTN","SDEC07B",186,0) ; AND the request is by provider "RTN","SDEC07B",187,0) ; then C:OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.); 0:NOT INDICATED TO BE A 'NEXT AVA.' APPT. "RTN","SDEC07B",188,0) I $P($$NOW^XLFDT(),".",1)'=DDT,REQ=1 Q "C^0" "RTN","SDEC07B",189,0) Q RET "RTN","SDEC07B",190,0) ; "RTN","SDEC07B",191,0) ;Create Appointment ;alb/sat 665 moved from SDEC07 "RTN","SDEC07B",192,0) APPVISTA(SDECLEN,SDECNOTE,DFN,SDECRESD,SDECSTART,SDECWKIN,SDCL,SDECI) ; "RTN","SDEC07B",193,0) N SDECC,SDECERR,SDECRNOD "RTN","SDEC07B",194,0) S SDECRNOD=$G(^SDEC(409.831,SDECRESD,0)) "RTN","SDEC07B",195,0) I SDECRNOD="" D ERR^SDEC07(SDECI+1,"SDEC07 Error: Unable to add appointment -- invalid Resource entry.") Q 1 "RTN","SDEC07B",196,0) S SDECERR="" "RTN","SDEC07B",197,0) I +SDCL,$D(^SC(SDCL,0)) D I +SDECERR D ERR^SDEC07(SDECI+1,SDECERR) Q SDECERR "RTN","SDEC07B",198,0) . S SDECC("PAT")=DFN "RTN","SDEC07B",199,0) . S SDECC("CLN")=SDCL "RTN","SDEC07B",200,0) . S SDECC("TYP")=3 ;3 for scheduled appts, 4 for walkins "RTN","SDEC07B",201,0) . S:SDECWKIN SDECC("TYP")=4 "RTN","SDEC07B",202,0) . S SDECC("ADT")=SDECSTART "RTN","SDEC07B",203,0) . S SDECC("LEN")=SDECLEN "RTN","SDEC07B",204,0) . S SDECC("OI")=$E($G(SDECNOTE),1,150) ;File 44 has 150 character limit on OTHER field "RTN","SDEC07B",205,0) . S SDECC("OI")=$TR(SDECC("OI"),";"," ") ;No semicolons allowed "RTN","SDEC07B",206,0) . S SDECC("OI")=$$STRIP^SDEC07(SDECC("OI")) ;Strip control characters from note "RTN","SDEC07B",207,0) . S SDECC("RES")=SDECRESD "RTN","SDEC07B",208,0) . S SDECC("USR")=DUZ "RTN","SDEC07B",209,0) . S SDECERR=$$MAKE^SDEC07B(.SDECC) "RTN","SDEC07B",210,0) . Q:SDECERR "RTN","SDEC07B",211,0) . D AVUPDT^SDEC07(SDCL,SDECSTART,SDECLEN) "RTN","SDEC07B",212,0) . ;L "RTN","SDEC07B",213,0) . Q "RTN","SDEC07B",214,0) Q +SDECERR "RTN","SDEC08") 0^6^B209647726^B207687482 "RTN","SDEC08",1,0) SDEC08 ;ALB/SAT/JSM - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDEC08",2,0) ;;5.3;Scheduling;**627,651,658,665**;Aug 13, 1993;Build 14 "RTN","SDEC08",3,0) ; "RTN","SDEC08",4,0) Q "RTN","SDEC08",5,0) ; "RTN","SDEC08",6,0) APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER) ;Cancels appointment "RTN","SDEC08",7,0) ;APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER) external parameter tag is in SDEC "RTN","SDEC08",8,0) ;SDECAPTID - (required) pointer to SDEC APPOINTMENT file "RTN","SDEC08",9,0) ;SDECTYP - (required) appointment Status valid values: "RTN","SDEC08",10,0) ; C=CANCELLED BY CLINIC "RTN","SDEC08",11,0) ; PC=CANCELLED BY PATIENT "RTN","SDEC08",12,0) ;SDECCR - (optional) pointer to CANCELLATION REASON File (409.2) "RTN","SDEC08",13,0) ;SDECNOT - (optional) text representing user note "RTN","SDEC08",14,0) ;SDECDATE - (optional) Cancel Date/Time in external format; defaults to NOW "RTN","SDEC08",15,0) ;SDUSER - (optional) User that cancelled appt; defaults to current user "RTN","SDEC08",16,0) ;Returns error code in recordset field ERRORID "RTN","SDEC08",17,0) ; "RTN","SDEC08",18,0) N SDECNOD,SDECPATID,SDECSTART,DIK,DA,SDECID,SDECI,SDECZ,SDECERR "RTN","SDEC08",19,0) N SDECLOC,SDECLEN,SDECSCIEN,SDECSCIEN1 "RTN","SDEC08",20,0) N SDECNOEV,SDECSC1,SDRET "RTN","SDEC08",21,0) N %DT,X,Y "RTN","SDEC08",22,0) S SDECNOEV=1 ;Don't execute SDEC CANCEL APPOINTMENT protocol "RTN","SDEC08",23,0) S SDECSCIEN1=0 "RTN","SDEC08",24,0) ; "RTN","SDEC08",25,0) S SDECI=0 "RTN","SDEC08",26,0) S SDECY="^TMP(""SDEC08"","_$J_",""APPDEL"")" "RTN","SDEC08",27,0) K @SDECY "RTN","SDEC08",28,0) S @SDECY@(SDECI)="T00020ERRORID"_$C(30) "RTN","SDEC08",29,0) S SDECI=SDECI+1 "RTN","SDEC08",30,0) ;validate SDEC APPOINTMENT pointer (required) "RTN","SDEC08",31,0) I '$D(^SDEC(409.84,+$G(SDECAPTID),0)) D ERR(SDECI,"SDEC08: Invalid Appointment ID") Q "RTN","SDEC08",32,0) ;validate appointment status type (required) "RTN","SDEC08",33,0) S SDECTYP=$G(SDECTYP) "RTN","SDEC08",34,0) S SDECTYP=$S(SDECTYP="C":"C",SDECTYP="CANCELLED BY CLINIC":"C",SDECTYP="PC":"PC",SDECTYP="CANCELLED BY PATIENT":"PC",1:"") "RTN","SDEC08",35,0) I SDECTYP="" D ERR(SDECI,"SDEC08: Invalid status type") Q "RTN","SDEC08",36,0) ;validate CANCELLATION REASON pointer (optional) "RTN","SDEC08",37,0) S SDECCR=$G(SDECCR) "RTN","SDEC08",38,0) I SDECCR'="" I '$D(^SD(409.2,+SDECCR,0)) S SDECCR=$O(^SD(409.2,"B","SDECCR",0)) "RTN","SDEC08",39,0) ;validate SDECNOT "RTN","SDEC08",40,0) S SDECNOT=$TR(SDECNOT,"^"," ") ;alb/sat 658 - strip out ^ "RTN","SDEC08",41,0) ;validate cancel date/time "RTN","SDEC08",42,0) S SDECDATE=$G(SDECDATE) "RTN","SDEC08",43,0) I SDECDATE'="" S %DT="T" S X=SDECDATE D ^%DT S SDECDATE=Y I Y=-1 S SDECDATE="" "RTN","SDEC08",44,0) I $G(SDECDATE)="" S SDECDATE=$$NOW^XLFDT "RTN","SDEC08",45,0) ;validate user "RTN","SDEC08",46,0) S SDUSER=$G(SDUSER) "RTN","SDEC08",47,0) I SDUSER'="" I '$D(^VA(200,+SDUSER,0)) S SDUSER="" "RTN","SDEC08",48,0) I SDUSER="" S SDUSER=DUZ "RTN","SDEC08",49,0) ; "RTN","SDEC08",50,0) TSTART "RTN","SDEC08",51,0) ; "RTN","SDEC08",52,0) ;Delete APPOINTMENT entries "RTN","SDEC08",53,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC08",54,0) S SDECPATID=$P(SDECNOD,U,5) "RTN","SDEC08",55,0) S SDECSTART=$P(SDECNOD,U) "RTN","SDEC08",56,0) ; "RTN","SDEC08",57,0) ;Lock SDEC node "RTN","SDEC08",58,0) L +^SDEC(409.84,SDECPATID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") TROLLBACK Q "RTN","SDEC08",59,0) ;cancel check-in if walk-in "RTN","SDEC08",60,0) I $P(SDECNOD,U,13)="y" D "RTN","SDEC08",61,0) .S SDRET="" "RTN","SDEC08",62,0) .D CHECKIN^SDEC25(.SDRET,SDECAPTID,"@") "RTN","SDEC08",63,0) ;cancel SDEC APPOINTMENT record "RTN","SDEC08",64,0) D SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,1) "RTN","SDEC08",65,0) ; "RTN","SDEC08",66,0) S SDECSC1=$P(SDECNOD,U,7) ;RESOURCEID "RTN","SDEC08",67,0) I SDECSC1]"",$D(^SDEC(409.831,SDECSC1,0)) D I +$G(SDECZ) S SDECERR=+SDECZ D ERR(SDECI,$P(SDECZ,U,2)) Q "RTN","SDEC08",68,0) . S SDECNOD=^SDEC(409.831,SDECSC1,0) "RTN","SDEC08",69,0) . S SDECLOC=$P(SDECNOD,U,4) ;HOSPITAL LOCATION "RTN","SDEC08",70,0) . Q:'+SDECLOC "RTN","SDEC08",71,0) . S SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART) I SDECSCIEN="" D I 'SDECZ Q ;Q:SDECZ "RTN","SDEC08",72,0) . . S SDECERR="SDEC08: Unable to find associated appointment for this patient. " "RTN","SDEC08",73,0) . . S SDECZ=1 "RTN","SDEC08",74,0) . . I '$D(^SDEC(409.831,SDECSC1,20)) S SDECZ=0 Q "RTN","SDEC08",75,0) . . N SDEC1 "RTN","SDEC08",76,0) . . S SDEC1=0 "RTN","SDEC08",77,0) . . F S SDEC1=$O(^SDEC(409.831,SDECSC1,20,SDEC1)) Q:'+SDEC1 Q:SDECZ=0 D "RTN","SDEC08",78,0) . . . Q:'$D(^SDEC(409.831,SDECSC1,20,SDEC1,0)) "RTN","SDEC08",79,0) . . . S SDECLOC=$P(^SDEC(409.831,SDECSC1,20,SDEC1,0),U) "RTN","SDEC08",80,0) . . . S SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART) I +SDECSCIEN S SDECZ=0 Q "RTN","SDEC08",81,0) . S SDECERR="SDEC08: CANCEL^SDEC08 Returned " "RTN","SDEC08",82,0) . I SDECLOC']"" S SDECZ="0^Unable to find associated appointment for this patient." Q "RTN","SDEC08",83,0) . I '$D(^SC(SDECLOC,0)) S SDECZ="0^Unable to find associated appointment for this patient." Q "RTN","SDEC08",84,0) . S SDECNOD=$G(^SC(SDECLOC,"S",SDECSTART,1,+SDECSCIEN,0)) "RTN","SDEC08",85,0) . I SDECNOD="" S SDECZ="0^Unable to find associated appointment for this patient." Q "RTN","SDEC08",86,0) . S SDECLEN=$P(SDECNOD,U,2) "RTN","SDEC08",87,0) . D APCAN(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECAPTID,SDECLEN) "RTN","SDEC08",88,0) . Q:+$G(SDECZ) "RTN","SDEC08",89,0) . D AVUPDT(SDECLOC,SDECSTART,SDECLEN) "RTN","SDEC08",90,0) . D AR433D^SDECAR2(SDECAPTID) "RTN","SDEC08",91,0) . ;L "RTN","SDEC08",92,0) ; "RTN","SDEC08",93,0) TCOMMIT "RTN","SDEC08",94,0) L -^SDEC(409.84,SDECPATID) "RTN","SDEC08",95,0) S SDECI=SDECI+1 "RTN","SDEC08",96,0) S @SDECY@(SDECI)=""_$C(30) "RTN","SDEC08",97,0) S SDECI=SDECI+1 "RTN","SDEC08",98,0) S @SDECY@(SDECI)=$C(31) "RTN","SDEC08",99,0) Q "RTN","SDEC08",100,0) ; "RTN","SDEC08",101,0) AVUPDT(SDECSCD,SDECSTART,SDECLEN) ;Update Clinic availability "RTN","SDEC08",102,0) ;See SDCNP0 "RTN","SDEC08",103,0) N HSI,I,S,SB,SD,SDDIF,SI,SL,SS,ST,STARTDAY,STR,X,Y "RTN","SDEC08",104,0) S (SD,S)=SDECSTART "RTN","SDEC08",105,0) S I=SDECSCD "RTN","SDEC08",106,0) Q:'$D(^SC(I,"ST",SD\1,1)) "RTN","SDEC08",107,0) S SL=^SC(I,"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:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) "RTN","SDEC08",108,0) S SL=SDECLEN "RTN","SDEC08",109,0) S S=^SC(I,"ST",SD\1,1),Y=SD#1-SB*100,ST=Y#1*SI\.6+(Y\1*SI),SS=SL*HSI/60 "RTN","SDEC08",110,0) I Y'<1 F I=ST+ST:SDDIF S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" S S=$E(S,1,I)_Y_$E(S,I+2,999),SS=SS-1 Q:SS'>0 "RTN","SDEC08",111,0) S ^SC(SDECSCD,"ST",SD\1,1)=S "RTN","SDEC08",112,0) Q "RTN","SDEC08",113,0) ; "RTN","SDEC08",114,0) APCAN(SDECZ,SDECLOC,SDECDFN,SDECSD,SDECAPTID,SDECLEN) ; "RTN","SDEC08",115,0) ;Cancel appointment for patient SDECDFN in clinic SDECSC1 "RTN","SDEC08",116,0) ;at time SDECSD "RTN","SDEC08",117,0) N SDECPNOD,SDECC,DA,DIE,DPTST,DR,%H "RTN","SDEC08",118,0) ;save data into SDEC APPOINTMENT in case of un-cancel (status & appt length) "RTN","SDEC08",119,0) S SDECPNOD=^DPT(SDECPATID,"S",SDECSD,0) "RTN","SDEC08",120,0) S DPTST=$P(SDECPNOD,U,2) "RTN","SDEC08",121,0) S DIE=409.84 "RTN","SDEC08",122,0) S DA=SDECAPTID "RTN","SDEC08",123,0) S DR=".17///"_DPTST_";"_".18///"_SDECLEN "RTN","SDEC08",124,0) D ^DIE "RTN","SDEC08",125,0) S SDECC("PAT")=SDECDFN "RTN","SDEC08",126,0) S SDECC("CLN")=SDECLOC "RTN","SDEC08",127,0) S SDECC("TYP")=SDECTYP "RTN","SDEC08",128,0) S SDECC("ADT")=SDECSD "RTN","SDEC08",129,0) S %H=$H D YMD^%DTC "RTN","SDEC08",130,0) S SDECC("CDT")=SDECDATE ;X+% "RTN","SDEC08",131,0) S SDECC("NOT")=SDECNOT "RTN","SDEC08",132,0) S:+SDECCR SDECC("CR")=SDECCR "RTN","SDEC08",133,0) S SDECC("USR")=SDUSER "RTN","SDEC08",134,0) ; "RTN","SDEC08",135,0) S SDECZ=$$CANCEL(.SDECC) "RTN","SDEC08",136,0) Q "RTN","SDEC08",137,0) ; "RTN","SDEC08",138,0) SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,SDF) ;cancel SDEC APPOINTMENT entry "RTN","SDEC08",139,0) ;SDECAPTID - (required) pointer to SDEC APPOINTMENT file "RTN","SDEC08",140,0) ;SDECTYP - (required) appointment Status valid values: "RTN","SDEC08",141,0) ; C=CANCELLED BY CLINIC "RTN","SDEC08",142,0) ; PC=CANCELLED BY PATIENT "RTN","SDEC08",143,0) ;SDECCR - (optional) pointer to CANCELLATION REASON File (409.2) "RTN","SDEC08",144,0) ;SDECNOT - (optional) text representing user note "RTN","SDEC08",145,0) ;SDECDATE - (optional) Cancel Date/Time in fm format; defaults to NOW) ; "RTN","SDEC08",146,0) ;SDF - (optional) flags "RTN","SDEC08",147,0) ; 1. called from GUI (update consult only if called from GUI) "RTN","SDEC08",148,0) ; 2. called from cancel in SDAM (CAN^SDCNP0) (do not reopen appt) "RTN","SDEC08",149,0) ;Cancel SDEC APPOINTMENT entry "RTN","SDEC08",150,0) N DFN,PROVIEN,Y "RTN","SDEC08",151,0) N SAVESTRT,SDAPTYP,SDCL,SDI,SDIEN,SDECIENS,SDECFDA,SDECMSG,SDECWP,SDRES,SDT ;alb/sat 651 add SAVESTRT and SDRES "RTN","SDEC08",152,0) S SDF=$G(SDF,0) "RTN","SDEC08",153,0) S DFN=$$GET1^DIQ(409.84,SDECAPTID_",",.05) ;alb/sat 658 "RTN","SDEC08",154,0) S SDT=$$GET1^DIQ(409.84,SDECAPTID_",",.01,"I") "RTN","SDEC08",155,0) S SAVESTRT=$$GET1^DIQ(409.84,SDECAPTID_",",.01) ;alb/sat 651 "RTN","SDEC08",156,0) S SDRES=$$GET1^DIQ(409.84,SDECAPTID_",",.07,"I") ;alb/sat 651 "RTN","SDEC08",157,0) S SDECIENS=SDECAPTID_"," "RTN","SDEC08",158,0) S SDECFDA(409.84,SDECIENS,.12)=$S($G(SDECDATE)'="":SDECDATE,1:$$NOW^XLFDT) "RTN","SDEC08",159,0) S SDECFDA(409.84,SDECIENS,.121)=$S($G(SDUSER)'="":SDUSER,1:DUZ) "RTN","SDEC08",160,0) S:$G(SDECCR)'="" SDECFDA(409.84,SDECIENS,.122)=SDECCR "RTN","SDEC08",161,0) S SDECFDA(409.84,SDECIENS,.17)=SDECTYP "RTN","SDEC08",162,0) K SDECMSG "RTN","SDEC08",163,0) D FILE^DIE("","SDECFDA","SDECMSG") "RTN","SDEC08",164,0) S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I") "RTN","SDEC08",165,0) ;alb/sat 658 modification begin "RTN","SDEC08",166,0) S SDECNOT=$G(SDECNOT),SDECNOT=$E(SDECNOT,1,160) "RTN","SDEC08",167,0) I $L(SDECNOT)>2,'$E(SDF,2) K SDECFDA S SDECFDA(2.98,SDT_","_DFN_",",17)=SDECNOT D UPDATE^DIE("","SDECFDA") "RTN","SDEC08",168,0) ;alb/sat 658 modification end "RTN","SDEC08",169,0) I $P(SDAPTYP,";",2)="GMR(123,",$E(SDF,1) D "RTN","SDEC08",170,0) .S SDCL=$$SDCL^SDECUTL(SDECAPTID) "RTN","SDEC08",171,0) .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I") "RTN","SDEC08",172,0) .D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",2,SDECTYP,SDECNOT,SAVESTRT,SDRES) ;alb/sat 651 added SAVESTRT "RTN","SDEC08",173,0) I $P(SDAPTYP,";",2)="SDWL(409.3," D ;update EWL "RTN","SDEC08",174,0) .S DFN=$$GET1^DIQ(409.3,$P(SDAPTYP,";",1)_",",.01,"I") "RTN","SDEC08",175,0) .Q:DFN="" "RTN","SDEC08",176,0) .S SDIEN=0 F S SDIEN=$O(^SDWL(409.3,"B",DFN,SDIEN)) Q:SDIEN="" D "RTN","SDEC08",177,0) ..I $$GET1^DIQ(409.3,SDIEN_",",13,"I")=SDT D "RTN","SDEC08",178,0) ...K SDECFDA,SDECMSG,SDECWP "RTN","SDEC08",179,0) ...;S SDIEN=$P(SDAPTYP,";",1) "RTN","SDEC08",180,0) ...S SDECFDA(409.3,SDIEN_",",13)="@" "RTN","SDEC08",181,0) ...S SDECFDA(409.3,SDIEN_",",13.1)="@" "RTN","SDEC08",182,0) ...S SDECFDA(409.3,SDIEN_",",13.2)="@" "RTN","SDEC08",183,0) ...S SDECFDA(409.3,SDIEN_",",13.3)="@" "RTN","SDEC08",184,0) ...S SDECFDA(409.3,SDIEN_",",13.4)="@" "RTN","SDEC08",185,0) ...S SDECFDA(409.3,SDIEN_",",13.5)="@" "RTN","SDEC08",186,0) ...S SDECFDA(409.3,SDIEN_",",13.6)="@" "RTN","SDEC08",187,0) ...S SDECFDA(409.3,SDIEN_",",13.7)="@" "RTN","SDEC08",188,0) ...S SDECFDA(409.3,SDIEN_",",13.8)="@" "RTN","SDEC08",189,0) ...D UPDATE^DIE("","SDECFDA") "RTN","SDEC08",190,0) ...D:'$E(SDF,2) WLOPEN^SDECWL("","",SDIEN) ;alb/jsm 658 do not reopen if called from SDEC^SDCNP0 "RTN","SDEC08",191,0) I $P(SDAPTYP,";",2)="SDEC(409.85," D ;update APPT "RTN","SDEC08",192,0) .K SDECFDA,SDECMSG,SDECWP "RTN","SDEC08",193,0) .D:'$E(SDF,2) AROPEN^SDECAR("",SDECAPTID) ;alb/jsm 658 do not reopen if called from SDEC^SDCNP0 "RTN","SDEC08",194,0) .S SDIEN=$P(SDAPTYP,";",1) "RTN","SDEC08",195,0) .S SDECFDA(409.85,SDIEN_",",13)="@" "RTN","SDEC08",196,0) .S SDECFDA(409.85,SDIEN_",",13.1)="@" "RTN","SDEC08",197,0) .S SDECFDA(409.85,SDIEN_",",13.2)="@" "RTN","SDEC08",198,0) .S SDECFDA(409.85,SDIEN_",",13.3)="@" "RTN","SDEC08",199,0) .S SDECFDA(409.85,SDIEN_",",13.4)="@" "RTN","SDEC08",200,0) .S SDECFDA(409.85,SDIEN_",",13.5)="@" "RTN","SDEC08",201,0) .S SDECFDA(409.85,SDIEN_",",13.6)="@" "RTN","SDEC08",202,0) .S SDECFDA(409.85,SDIEN_",",13.7)="@" "RTN","SDEC08",203,0) .S SDECFDA(409.85,SDIEN_",",13.8)="@" "RTN","SDEC08",204,0) .D UPDATE^DIE("","SDECFDA") "RTN","SDEC08",205,0) Q "RTN","SDEC08",206,0) ; "RTN","SDEC08",207,0) CANEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CANCEL APPOINTMENT event "RTN","SDEC08",208,0) ;when appointments cancelled via PIMS interface. "RTN","SDEC08",209,0) ;Propagates cancellation to SDECAPPT and raises refresh event to running GUI clients "RTN","SDEC08",210,0) N SDECFOUND,SDECRES "RTN","SDEC08",211,0) Q:+$G(SDECNOEV) "RTN","SDEC08",212,0) Q:'+$G(SDECSC) "RTN","SDEC08",213,0) S SDECFOUND=0 "RTN","SDEC08",214,0) I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$CANEVT1(SDECRES,SDECSTART,SDECPAT) "RTN","SDEC08",215,0) I SDECFOUND D CANEVT3(SDECRES) Q "RTN","SDEC08",216,0) Q "RTN","SDEC08",217,0) ; "RTN","SDEC08",218,0) CANEVT1(SDECRES,SDECSTART,SDECPAT) ; "RTN","SDEC08",219,0) ;Get appointment id in SDECAPT "RTN","SDEC08",220,0) ;If found, call SDECCAN(SDECAPPT) and return 1 "RTN","SDEC08",221,0) ;else return 0 "RTN","SDEC08",222,0) N SDECFOUND,SDECAPPT "RTN","SDEC08",223,0) S SDECFOUND=0 "RTN","SDEC08",224,0) Q:'+SDECRES SDECFOUND "RTN","SDEC08",225,0) Q:'$D(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART)) SDECFOUND "RTN","SDEC08",226,0) S SDECAPPT=0 F S SDECAPPT=$O(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART,SDECAPPT)) Q:'+SDECAPPT D Q:SDECFOUND "RTN","SDEC08",227,0) . S SDECNOD=$G(^SDEC(409.84,SDECAPPT,0)) Q:SDECNOD="" "RTN","SDEC08",228,0) . I $P(SDECNOD,U,5)=SDECPAT,$P(SDECNOD,U,12)="" S SDECFOUND=1 Q "RTN","SDEC08",229,0) I SDECFOUND,+$G(SDECAPPT) D SDECCAN(SDECAPPT,,,,,,1) "RTN","SDEC08",230,0) Q SDECFOUND "RTN","SDEC08",231,0) ; "RTN","SDEC08",232,0) CANEVT3(SDECRES) ; "RTN","SDEC08",233,0) ;Call RaiseEvent to notify GUI clients "RTN","SDEC08",234,0) ; "RTN","SDEC08",235,0) Q "RTN","SDEC08",236,0) N SDECRESN "RTN","SDEC08",237,0) S SDECRESN=$G(^SDEC(409.831,SDECRES,0)) "RTN","SDEC08",238,0) Q:SDECRESN="" "RTN","SDEC08",239,0) S SDECRESN=$P(SDECRESN,"^") "RTN","SDEC08",240,0) ;D EVENT^SDEC23("SCHEDULE-"_SDECRESN,"","","") "RTN","SDEC08",241,0) ;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN) "RTN","SDEC08",242,0) Q "RTN","SDEC08",243,0) ; "RTN","SDEC08",244,0) CANCEL(BSDR) ;EP; called to cancel appt "RTN","SDEC08",245,0) ; "RTN","SDEC08",246,0) ; Make call using: S ERR=$$CANCEL^SDEC08(.ARRAY) "RTN","SDEC08",247,0) ; "RTN","SDEC08",248,0) ; Input Array - "RTN","SDEC08",249,0) ; BSDR("PAT") = ien of patient in file 2 "RTN","SDEC08",250,0) ; BSDR("CLN") = ien of clinic in file 44 "RTN","SDEC08",251,0) ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled "RTN","SDEC08",252,0) ; BSDR("ADT") = appointment date and time "RTN","SDEC08",253,0) ; BSDR("CDT") = cancel date and time "RTN","SDEC08",254,0) ; BSDR("USR") = user who canceled appt "RTN","SDEC08",255,0) ; BSDR("CR") = cancel reason - pointer to file 409.2 "RTN","SDEC08",256,0) ; BSDR("NOT") = cancel remarks - optional notes to 160 characters "RTN","SDEC08",257,0) ; "RTN","SDEC08",258,0) ;Output: error status and message "RTN","SDEC08",259,0) ; = 0 or null: everything okay "RTN","SDEC08",260,0) ; = 1^message: error and reason "RTN","SDEC08",261,0) ; "RTN","SDEC08",262,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","SDEC08",263,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","SDEC08",264,0) I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP")) "RTN","SDEC08",265,0) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds "RTN","SDEC08",266,0) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) "RTN","SDEC08",267,0) I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds "RTN","SDEC08",268,0) I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT")) "RTN","SDEC08",269,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) "RTN","SDEC08",270,0) I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) "RTN","SDEC08",271,0) ; "RTN","SDEC08",272,0) NEW IEN,DIE,DA,DR,SDMODE "RTN","SDEC08",273,0) S IEN=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) "RTN","SDEC08",274,0) I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") "RTN","SDEC08",275,0) ; "RTN","SDEC08",276,0) I $$CI^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until check-in deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") "RTN","SDEC08",277,0) ; "RTN","SDEC08",278,0) ; remember before status "RTN","SDEC08",279,0) NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL "RTN","SDEC08",280,0) S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN "RTN","SDEC08",281,0) S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL "RTN","SDEC08",282,0) D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) "RTN","SDEC08",283,0) ; "RTN","SDEC08",284,0) ; get user who made appt and date appt made from ^SC "RTN","SDEC08",285,0) ; because data in ^SC will be deleted "RTN","SDEC08",286,0) NEW USER,DATE "RTN","SDEC08",287,0) S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) "RTN","SDEC08",288,0) S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) "RTN","SDEC08",289,0) ; "RTN","SDEC08",290,0) ; update file 2 info "RTN","SDEC08",291,0) NEW DIE,DA,DR "RTN","SDEC08",292,0) N SDFDA,SDIEN,SDMSG "RTN","SDEC08",293,0) S SDFDA="SDFDA(2.98,SDT_"",""_DFN_"","")" "RTN","SDEC08",294,0) S @SDFDA@(3)=BSDR("TYP") "RTN","SDEC08",295,0) S @SDFDA@(14)=BSDR("USR") "RTN","SDEC08",296,0) S @SDFDA@(15)=BSDR("CDT") "RTN","SDEC08",297,0) S:+$G(BSDR("CR")) @SDFDA@(16)=BSDR("CR") "RTN","SDEC08",298,0) S:$G(BSDR("NOT"))]"" @SDFDA@(17)=$E(BSDR("NOT"),1,160) "RTN","SDEC08",299,0) S @SDFDA@(19)=USER "RTN","SDEC08",300,0) S @SDFDA@(20)=DATE "RTN","SDEC08",301,0) D UPDATE^DIE("","SDFDA") "RTN","SDEC08",302,0) N SDPCE "RTN","SDEC08",303,0) S SDPCE=$P($G(^DPT(DFN,"S",SDT,0)),U,20) "RTN","SDEC08",304,0) D:+SDPCE EN^SDCODEL(SDPCE,0) ;remove OUTPATIENT ENCOUNTER link "RTN","SDEC08",305,0) ; "RTN","SDEC08",306,0) ; delete data in ^SC "RTN","SDEC08",307,0) NEW DIK,DA "RTN","SDEC08",308,0) S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," "RTN","SDEC08",309,0) S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN "RTN","SDEC08",310,0) D ^DIK "RTN","SDEC08",311,0) ; call event driver "RTN","SDEC08",312,0) S SDATA=SDDA_U_DFN_U_SDT_U_SDCL "RTN","SDEC08",313,0) ;D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) "RTN","SDEC08",314,0) Q 0 "RTN","SDEC08",315,0) ; "RTN","SDEC08",316,0) UNDOCANA(SDECY,SDECAPTID) ;Undo Cancel Appointment "RTN","SDEC08",317,0) ;UNDOCANA(SDECY,SDECAPTID) external parameter tag in SDEC "RTN","SDEC08",318,0) ;called by SDEC UNCANCEL APPT "RTN","SDEC08",319,0) ; SDECAPTID = ien of appointment in SDEC APPOINTMENT (^SDECAPPT) file 409.84 "RTN","SDEC08",320,0) N SDECDAM,SDECDEC,SDECI,SDECNOD,SDECPATID,SDECSTART "RTN","SDEC08",321,0) S SDECNOEV=1 ;Don't execute SDEC CANCEL APPOINTMENT protocol ;is this used? "RTN","SDEC08",322,0) ; "RTN","SDEC08",323,0) S SDECI=0 "RTN","SDEC08",324,0) K ^TMP("SDEC",$J) "RTN","SDEC08",325,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC08",326,0) S ^TMP("SDEC",$J,SDECI)="T00020ERRORID"_$C(30) "RTN","SDEC08",327,0) TSTART "RTN","SDEC08",328,0) I '+SDECAPTID TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID.") Q "RTN","SDEC08",329,0) I '$D(^SDEC(409.84,SDECAPTID,0)) TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID") Q "RTN","SDEC08",330,0) ;Make sure appointment is cancelled "RTN","SDEC08",331,0) I $$GET1^DIQ(409.84,SDECAPTID_",",.12)="" TROLLBACK D ERR(SDECI+1,"Appointment is not Cancelled.") Q "RTN","SDEC08",332,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC08",333,0) ;appts cancelled by patient cannot be un-cancelled. /* removed 9/17/2010 */ "RTN","SDEC08",334,0) ;I $P(^DPT($P(SDECNOD,U,5),"S",$P(SDECNOD,U,1),0),U,2)="PC" TROLLBACK D ERR(SDECI+1,"Cancelled by patient appointment cannot be uncancelled.") Q "RTN","SDEC08",335,0) ;get appointment data "RTN","SDEC08",336,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC08",337,0) S SDECDAM=$P(SDECNOD,U,9) ;date appt made "RTN","SDEC08",338,0) S SDECDEC=$P(SDECNOD,U,8) ;data entry clerk "RTN","SDEC08",339,0) S SDECLEN=$P(SDECNOD,U,18) ;length of appt in minutes "RTN","SDEC08",340,0) S SDECNOTE=$G(^SDEC(409.84,SDECAPTID,1,1,0)) ;note from SDEC APPOINTMENT "RTN","SDEC08",341,0) S SDECPATID=$P(SDECNOD,U,5) ;pointer to VA PATIENT file 2 "RTN","SDEC08",342,0) S SDECSC1=$P($G(SDECNOD),U,7) ;resource "RTN","SDEC08",343,0) S SDECSTART=$P(SDECNOD,U) ;appt start time "RTN","SDEC08",344,0) S SDECWKIN=$P($G(SDECNOD),U,13) ;walk-in "RTN","SDEC08",345,0) ;lock SDEC node "RTN","SDEC08",346,0) L +^SDEC(409.84,SDECPATID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") TROLLBACK Q "RTN","SDEC08",347,0) ;un-cancel SDEC APPOINTMENT "RTN","SDEC08",348,0) D SDECUCAN(SDECAPTID) "RTN","SDEC08",349,0) I SDECSC1]"",$D(^SDEC(409.831,SDECSC1,0)) D I +$G(SDECZ) S SDECERR=SDECERR_$P(SDECZ,U,2) D ERR(SDECI,SDECERR) Q "RTN","SDEC08",350,0) . S SDECLOC="" "RTN","SDEC08",351,0) . S SDECNOD=^SDEC(409.831,SDECSC1,0) "RTN","SDEC08",352,0) . S SDECLOC=$P(SDECNOD,U,4) ;HOSPITAL LOCATION ;support for single HOSPITAL LOCATION in SDEC RESOURCE "RTN","SDEC08",353,0) . I SDECLOC="" S SDECLOC=$$SDCL^SDECUTL(SDECAPTID) ;HOSPITAL LOCATION "RTN","SDEC08",354,0) . Q:'+SDECLOC "RTN","SDEC08",355,0) . ;un-cancel patient appointment and re-instate clinic appointment "RTN","SDEC08",356,0) . S SDECZ="" "RTN","SDEC08",357,0) . D APUCAN(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECSC1,SDECWKIN) "RTN","SDEC08",358,0) TCOMMIT "RTN","SDEC08",359,0) L -^SDEC(409.84,SDECPATID) "RTN","SDEC08",360,0) S SDECI=SDECI+1 "RTN","SDEC08",361,0) S ^TMP("SDEC",$J,SDECI)=""_$C(30) "RTN","SDEC08",362,0) S SDECI=SDECI+1 "RTN","SDEC08",363,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC08",364,0) Q "RTN","SDEC08",365,0) ; "RTN","SDEC08",366,0) SDECUCAN(SDECAPTID) ;called internally to update SDEC APPOINTMENT by clearing cancel date/time "RTN","SDEC08",367,0) N PROVIEN,SDAPTYP,SDCL,SDRES "RTN","SDEC08",368,0) S SDECIENS=SDECAPTID_"," "RTN","SDEC08",369,0) S SDECFDA(409.84,SDECIENS,.12)="" "RTN","SDEC08",370,0) K SDECMSG "RTN","SDEC08",371,0) D FILE^DIE("","SDECFDA","SDECMSG") "RTN","SDEC08",372,0) S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I") "RTN","SDEC08",373,0) I $P(SDAPTYP,";",2)="GMR(123," D "RTN","SDEC08",374,0) .S SDCL=$$SDCL^SDECUTL(SDECAPTID) "RTN","SDEC08",375,0) .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I") "RTN","SDEC08",376,0) .D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",1) "RTN","SDEC08",377,0) Q "RTN","SDEC08",378,0) ; "RTN","SDEC08",379,0) APUCAN(SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECRES,SDECWKIN) ; "RTN","SDEC08",380,0) ;un-Cancel appointment for patient SDECDFN in clinic SDECSC1 "RTN","SDEC08",381,0) ; SDECLOC = pointer to hospital location ^SC file 44 "RTN","SDEC08",382,0) ; SDECPATID = pointer to VA Patient ^DPT file 2 "RTN","SDEC08",383,0) ; SDECSTART = Appointment time "RTN","SDEC08",384,0) ; SDECDAM = Date appointment made in FM format "RTN","SDEC08",385,0) ; SDECDEC = Data entry clerk - pointer to NEW PERSON file 200 "RTN","SDEC08",386,0) N SDECC,%H "RTN","SDEC08",387,0) S SDECC("PAT")=SDECPATID "RTN","SDEC08",388,0) S SDECC("CLN")=SDECLOC "RTN","SDEC08",389,0) S SDECC("ADT")=SDECSTART "RTN","SDEC08",390,0) S SDECC("NOTE")=SDECNOTE ;user note "RTN","SDEC08",391,0) S SDECC("RES")=SDECRES "RTN","SDEC08",392,0) S SDECC("USR")=DUZ "RTN","SDEC08",393,0) S SDECC("LEN")=SDECLEN "RTN","SDEC08",394,0) S SDECC("WKIN")=SDECWKIN "RTN","SDEC08",395,0) ; "RTN","SDEC08",396,0) S SDECZ=$$UNCANCEL(.SDECC) "RTN","SDEC08",397,0) Q "RTN","SDEC08",398,0) ; "RTN","SDEC08",399,0) UNCANCEL(BSDR) ;PEP; called to un-cancel appt "RTN","SDEC08",400,0) ; "RTN","SDEC08",401,0) ; Make call using: S ERR=$$UNCANCEL(.ARRAY) "RTN","SDEC08",402,0) ; "RTN","SDEC08",403,0) ; Input Array - "RTN","SDEC08",404,0) ; BSDR("PAT") = ien of patient in file 2 "RTN","SDEC08",405,0) ; BSDR("CLN") = ien of clinic in file 44 "RTN","SDEC08",406,0) ; BSDR("ADT") = appointment date and time "RTN","SDEC08",407,0) ; BSDR("USR") = user who un-canceled appt "RTN","SDEC08",408,0) ; BSDR("NOTE") = appointment note from SDEC APPOINTMENT "RTN","SDEC08",409,0) ; BSDR("LEN") = appt length in minutes (numeric) "RTN","SDEC08",410,0) ; BSDR("RES") = resource "RTN","SDEC08",411,0) ; BSDR("WKIN")= walk-in "RTN","SDEC08",412,0) ; "RTN","SDEC08",413,0) ;Output: error status and message "RTN","SDEC08",414,0) ; = 0 or null: everything okay "RTN","SDEC08",415,0) ; = 1^message: error and reason "RTN","SDEC08",416,0) ; "RTN","SDEC08",417,0) N DPTNOD,DPTNODR "RTN","SDEC08",418,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","SDEC08",419,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","SDEC08",420,0) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds "RTN","SDEC08",421,0) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) "RTN","SDEC08",422,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) "RTN","SDEC08",423,0) ; "RTN","SDEC08",424,0) S SDECERR=$$APPVISTA^SDEC07B(BSDR("LEN"),BSDR("NOTE"),BSDR("PAT"),BSDR("RES"),BSDR("ADT"),BSDR("WKIN"),BSDR("CLN"),.SDECI) ;alb/sat 665 APPVISTA moved to SDEC07B "RTN","SDEC08",425,0) Q SDECERR "RTN","SDEC08",426,0) ; "RTN","SDEC08",427,0) ERR(SDECI,SDECERR) ;Error processing "RTN","SDEC08",428,0) S SDECI=SDECI+1 "RTN","SDEC08",429,0) S SDECERR=$TR(SDECERR,"^","~") "RTN","SDEC08",430,0) TROLLBACK "RTN","SDEC08",431,0) S ^TMP("SDEC",$J,SDECI)=SDECERR_$C(30) "RTN","SDEC08",432,0) S SDECI=SDECI+1 "RTN","SDEC08",433,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC08",434,0) Q "RTN","SDEC08",435,0) ; "RTN","SDEC08",436,0) ETRAP ;EP Error trap entry "RTN","SDEC08",437,0) D ^%ZTER "RTN","SDEC08",438,0) I '$D(SDECI) N SDECI S SDECI=999999 "RTN","SDEC08",439,0) S SDECI=SDECI+1 "RTN","SDEC08",440,0) D ERR(SDECI,"SDEC08 Error") "RTN","SDEC08",441,0) Q "RTN","SDEC25") 0^20^B108318139^B107893271 "RTN","SDEC25",1,0) SDEC25 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDEC25",2,0) ;;5.3;Scheduling;**627,665**;Aug 13, 1993;Build 14 "RTN","SDEC25",3,0) ; "RTN","SDEC25",4,0) Q "RTN","SDEC25",5,0) ; "RTN","SDEC25",6,0) CHECKIN(SDECY,SDECAPTID,SDECCDT,SDECCC,SDECPRV,SDECROU,SDECVCL,SDECVFM,SDECOG,SDECCR,SDECPCC,SDECWHF) ;Check in appointment "RTN","SDEC25",7,0) ;CHECKIN(SDECY,SDECAPTID,SDECCDT,SDECCC,SDECPRV,SDECROU,SDECVCL,SDECVFM,SDECOG,SDECCR,SDECPCC,SDECWHF) "RTN","SDEC25",8,0) ; external parameter tag is in SDEC "RTN","SDEC25",9,0) ; "RTN","SDEC25",10,0) ; INPUT: SDECAPTID - (required) Appointment ID "RTN","SDEC25",11,0) ; SDECCDT - (optional) Check-in date/time "RTN","SDEC25",12,0) ; "@" - indicates delete check-in "RTN","SDEC25",13,0) ; SDECCC - (????????) Clinic Stop pointer to CLINIC STOP file "RTN","SDEC25",14,0) ; SDECPRV - (optional) Provider pointer to NEW PERSON file "RTN","SDEC25",15,0) ; default to current user "RTN","SDEC25",16,0) ; SDECROU - (optional) Print Routing Slip flag, valid values: "RTN","SDEC25",17,0) ; 0=false 1=true "RTN","SDEC25",18,0) ; SDECVCL - (????????) Clinic pointer to HOSPITAL LOCATION "RTN","SDEC25",19,0) ; SDECVFM - FORM "RTN","SDEC25",20,0) ; SDECOG - OUTGUIDE FLAG "RTN","SDEC25",21,0) ; SDECCR - Generate Chart request upon check-in? (1-Yes, otherwise no) "RTN","SDEC25",22,0) ; SDECPCC - ien of PWH Type in HEALTH SUMMARY PWH TYPE file ^APCHPWHT "RTN","SDEC25",23,0) ; SDECWHF - Print Patient Wellness Handout flag "RTN","SDEC25",24,0) ; "RTN","SDEC25",25,0) ENDBG ; "RTN","SDEC25",26,0) N BSDVSTN,EMSG "RTN","SDEC25",27,0) N SDECNOD,SDECPATID,SDECSTART,DIK,DA,SDECID,SDECI,SDECZ,SDECIENS,SDECVEN "RTN","SDEC25",28,0) N SDECNOEV,SDECCAN,SDECR1,%DT,X,Y "RTN","SDEC25",29,0) S SDECNOEV=1 ;Don't execute protocol "RTN","SDEC25",30,0) S SDECCAN=0 "RTN","SDEC25",31,0) ; "RTN","SDEC25",32,0) S SDECI=0 "RTN","SDEC25",33,0) K ^TMP("SDEC",$J) "RTN","SDEC25",34,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC25",35,0) S ^TMP("SDEC",$J,0)="T00020ERRORID^T00150MESSAGE"_$C(30) "RTN","SDEC25",36,0) ;validate SDEC appointment ID "RTN","SDEC25",37,0) I '+$G(SDECAPTID) D ERR("SDEC25: Invalid Appointment ID") Q "RTN","SDEC25",38,0) I '$D(^SDEC(409.84,+SDECAPTID,0)) D ERR("SDEC25: Invalid Appointment ID") Q "RTN","SDEC25",39,0) ;validate checkin date/time (required) "RTN","SDEC25",40,0) S SDECCDT=$G(SDECCDT) "RTN","SDEC25",41,0) S:SDECCDT="@" SDECCAN=1 "RTN","SDEC25",42,0) I 'SDECCAN,SDECCDT'="" S %DT="T" S X=SDECCDT D ^%DT S SDECCDT=Y I Y=-1 S SDECCDT="" "RTN","SDEC25",43,0) I SDECCDT="" D ERR("SDEC25: Invalid Check-In Time") Q "RTN","SDEC25",44,0) ;validate clinic stop code "RTN","SDEC25",45,0) S SDECCC=$G(SDECCC) "RTN","SDEC25",46,0) I SDECCC'="" I '$D(^DIC(40.7,SDECCC,0)) S SDECCC="" "RTN","SDEC25",47,0) ;validate provider (optional) "RTN","SDEC25",48,0) S SDECPRV=$G(SDECPRV) "RTN","SDEC25",49,0) I SDECPRV'="" I '$D(^VA(200,+SDECPRV,0)) S SDECPRV="" "RTN","SDEC25",50,0) ;I SDECPRV="" S SDECPRV=DUZ "RTN","SDEC25",51,0) ;I SDECPRV="" S SDECPRV="" "RTN","SDEC25",52,0) ;validate routine slip flag (optional) "RTN","SDEC25",53,0) S SDECROU=$$UP^XLFSTR($G(SDECROU)) "RTN","SDEC25",54,0) S SDECROU=$S(SDECROU=1:"true",SDECROU="TRUE":"true",1:0) "RTN","SDEC25",55,0) ;validate clinic "RTN","SDEC25",56,0) S SDECVCL=$G(SDECVCL) "RTN","SDEC25",57,0) I SDECVCL'="" I '$D(^SC(SDECVCL,0)) S SDECVCL="" "RTN","SDEC25",58,0) I SDECCC="",SDECVCL'="" S SDECCC=$P($G(^SC(SDECVCL,0)),U,7) ;get clinic stop from 44 "RTN","SDEC25",59,0) ; "RTN","SDEC25",60,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC25",61,0) S DFN=$P(SDECNOD,U,5) "RTN","SDEC25",62,0) S SDECPATID=$P(SDECNOD,U,5) "RTN","SDEC25",63,0) S SDECSTART=$P(SDECNOD,U) "RTN","SDEC25",64,0) ; "RTN","SDEC25",65,0) S SDECR1=$P(SDECNOD,U,7) ;RESOURCEID "RTN","SDEC25",66,0) ;if resourceId is not null AND there is a valid resource record "RTN","SDEC25",67,0) I SDECR1]"",$D(^SDEC(409.831,SDECR1,0)) D I +$G(SDECZ) D ERR($P(SDECZ,U,2)) Q "RTN","SDEC25",68,0) . S SDECNOD=^SDEC(409.831,SDECR1,0) "RTN","SDEC25",69,0) . S SDECSC1=$P(SDECNOD,U,4) ;HOSPITAL LOCATION "RTN","SDEC25",70,0) . ;Hospital Location is required for CHECKIN "RTN","SDEC25",71,0) . ;I 'SDECSC1]"",'$D(^SC(+SDECSC1,0)) D ERR("SDEC25: Clinic not defined for this Resource: "_$P(SDECNOD,U,1)_" ("_SDECSC1_")") Q "RTN","SDEC25",72,0) . I 'SDECSC1]"",'$D(^SC(+SDECSC1,0)) D ERR("Clinic not defined for this Resource: "_$P(SDECNOD,U,1)_" ("_SDECSC1_")") Q "RTN","SDEC25",73,0) . ;Checkin SDEC APPOINTMENT entry "RTN","SDEC25",74,0) . D SDECCHK(SDECAPTID,$S(SDECCAN:"",1:SDECCDT)) ; sets field .03 (Checkin), in file 409.84 "RTN","SDEC25",75,0) . ;Process cancel checkin "RTN","SDEC25",76,0) . I $G(SDECCAN) D CANCHKIN(SDECPATID,SDECSC1,SDECSTART) Q "RTN","SDEC25",77,0) . D APCHK(.SDECZ,SDECSC1,SDECPATID,SDECCDT,SDECSTART) "RTN","SDEC25",78,0) . I $G(SDECPRV) S DIE="^SDEC(409.84,",DA=SDECAPTID,DR=".16///"_SDECPRV D ^DIE "RTN","SDEC25",79,0) ; "RTN","SDEC25",80,0) S SDECI=SDECI+1 "RTN","SDEC25",81,0) S ^TMP("SDEC",$J,SDECI)="0^"_$S($G(EMSG)'="":EMSG,1:"")_$C(30) "RTN","SDEC25",82,0) S SDECI=SDECI+1 "RTN","SDEC25",83,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC25",84,0) Q "RTN","SDEC25",85,0) ; "RTN","SDEC25",86,0) SDECCHK(SDECAPTID,SDECCDT) ; "RTN","SDEC25",87,0) N SDECFDA,SDECMSG "RTN","SDEC25",88,0) S SDECIENS=SDECAPTID_"," "RTN","SDEC25",89,0) S SDECFDA(409.84,SDECIENS,.03)=SDECCDT "RTN","SDEC25",90,0) S SDECFDA(409.84,SDECIENS,.04)=$S(SDECCDT'="":$$NOW^XLFDT,1:"") "RTN","SDEC25",91,0) D FILE^DIE("","SDECFDA","SDECMSG") "RTN","SDEC25",92,0) Q "RTN","SDEC25",93,0) ; "RTN","SDEC25",94,0) APCHK(SDECZ,SDECSC1,SDECDFN,SDECCDT,SDECSTART) ; "RTN","SDEC25",95,0) ;Checkin appointment for patient SDECDFN in clinic SDECSC1 "RTN","SDEC25",96,0) ;at time SDECSD "RTN","SDEC25",97,0) N APTN,BSDMSG,SDECC "RTN","SDEC25",98,0) S SDECC("PAT")=SDECPATID "RTN","SDEC25",99,0) S SDECC("HOS LOC")=SDECSC1 "RTN","SDEC25",100,0) S SDECC("CLINIC CODE")=SDECCC "RTN","SDEC25",101,0) S SDECC("PROVIDER")=SDECPRV "RTN","SDEC25",102,0) S SDECC("APPT DATE")=SDECSTART "RTN","SDEC25",103,0) S SDECC("CDT")=SDECCDT "RTN","SDEC25",104,0) S SDECC("USR")=DUZ "RTN","SDEC25",105,0) ;find IEN in ^SC multiple or null "RTN","SDEC25",106,0) S APTN=$$FIND^SDAM2(SDECC("PAT"),SDECC("APPT DATE"),SDECC("HOS LOC")) "RTN","SDEC25",107,0) ; "RTN","SDEC25",108,0) ;Required by NEW API: "RTN","SDEC25",109,0) S SDECC("SRV CAT")="A" "RTN","SDEC25",110,0) S SDECC("TIME RANGE")=-1 "RTN","SDEC25",111,0) S SDECC("VISIT DATE")=SDECCDT "RTN","SDEC25",112,0) S SDECC("SITE")=$G(DUZ(2)) "RTN","SDEC25",113,0) S SDECC("VISIT TYPE")="V" "RTN","SDEC25",114,0) S SDECC("CLN")=SDECC("HOS LOC") "RTN","SDEC25",115,0) S SDECC("ADT")=SDECC("APPT DATE") "RTN","SDEC25",116,0) ; "RTN","SDEC25",117,0) ;Set up SDECVEN array containing VEN EHP CLINIC, VEN EHP FORM, OUTGUIDE FLAG "RTN","SDEC25",118,0) ;These values come from input param "RTN","SDEC25",119,0) S SDECVEN("CLINIC")=SDECVCL "RTN","SDEC25",120,0) S SDECVEN("FORM")=SDECVFM "RTN","SDEC25",121,0) S SDECVEN("OUTGUIDE")=SDECOG "RTN","SDEC25",122,0) ; "RTN","SDEC25",123,0) N SDECOUT "RTN","SDEC25",124,0) D GETVISIT^SDECAPI4(.SDECC,.SDECOUT) "RTN","SDEC25",125,0) ;K SDECC "RTN","SDEC25",126,0) ;I SDECOUT(0)=1 S BSDVSTN=$O(SDECOUT(0)) ;if match found, set visit IEN "RTN","SDEC25",127,0) ;D VISIT^SDECV(SDECC("HOS LOC"),SDECC("APPT DATE"),APTN,SDECC("PAT"),SDECC("CLINIC CODE"),SDECC("PROVIDER"),,.BSDMSG,.BSDVSTN,.SDECC) ;replace GETVISIT^SDECAPI4 to make sure all visit data is updated "RTN","SDEC25",128,0) Q "RTN","SDEC25",129,0) ; "RTN","SDEC25",130,0) CANCHKIN(DFN,SDCL,SDT) ; Logic to cancel a checkin if the checkin date/time is passed in as '@' "RTN","SDEC25",131,0) ; input: DFN := ifn of patient "RTN","SDEC25",132,0) ; SDCL := clinic# "RTN","SDEC25",133,0) ; SDT := appt d/t "RTN","SDEC25",134,0) ; "RTN","SDEC25",135,0) N SDDA "RTN","SDEC25",136,0) S SDDA=$$FIND(DFN,SDT,SDCL) "RTN","SDEC25",137,0) ;I 'SDDA D ERR("SDEC25: Could not locate appointment in database or appointment is cancelled.") Q "RTN","SDEC25",138,0) I 'SDDA D ERR("Could not locate appointment in database or appointment is cancelled.") Q "RTN","SDEC25",139,0) N SDATA,SDCIHDL,X S SDATA=SDDA_U_DFN_U_SDT_U_SDCL,SDCIHDL=$$HANDLE^SDAMEVT(1) "RTN","SDEC25",140,0) D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) "RTN","SDEC25",141,0) S FDA(44.003,SDDA_","_SDT_","_SDCL_",",309)="" D FILE^DIE(,"FDA","ERR") "RTN","SDEC25",142,0) D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) "RTN","SDEC25",143,0) D CHKEVTD(DFN,SDT,SDCL) "RTN","SDEC25",144,0) K FDA,ERR "RTN","SDEC25",145,0) Q "RTN","SDEC25",146,0) ; "RTN","SDEC25",147,0) FIND(DFN,SDT,SDCL) ; -- return appt ifn for pat "RTN","SDEC25",148,0) ; input: DFN := ifn of pat. "RTN","SDEC25",149,0) ; SDT := appt d/t "RTN","SDEC25",150,0) ; SDCL := ifn of clinic "RTN","SDEC25",151,0) ; output: [returned] := ifn if pat has appt on date/time "RTN","SDEC25",152,0) ; "RTN","SDEC25",153,0) N Y "RTN","SDEC25",154,0) S Y=0 F S Y=$O(^SC(SDCL,"S",SDT,1,Y)) Q:'Y I $D(^(Y,0)),DFN=+^(0),$D(^DPT(+DFN,"S",SDT,0)),$$VALID(DFN,SDCL,SDT,Y) Q "RTN","SDEC25",155,0) Q Y "RTN","SDEC25",156,0) ; "RTN","SDEC25",157,0) VALID(DFN,SDCL,SDT,SDDA) ; -- return valid appt. "RTN","SDEC25",158,0) ; **NOTE: For speed consideration the ^SC and ^DPT nodes must be "RTN","SDEC25",159,0) ; check to see they exist prior to calling this entry point. "RTN","SDEC25",160,0) ; input: DFN := ifn of pat. "RTN","SDEC25",161,0) ; SDT := appt d/t "RTN","SDEC25",162,0) ; SDCL := ifn of clinic "RTN","SDEC25",163,0) ; SDDA := ifn of appt "RTN","SDEC25",164,0) ; output: [returned] := 1 for valid appt., 0 for not valid "RTN","SDEC25",165,0) Q $S($P(^SC(SDCL,"S",SDT,1,SDDA,0),U,9)'="C":1,$P(^DPT(DFN,"S",SDT,0),U,2)["C":1,1:0) "RTN","SDEC25",166,0) ; "RTN","SDEC25",167,0) CHKEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CHECKIN APPOINTMENT event "RTN","SDEC25",168,0) ;when appointments CHECKIN via PIMS interface. "RTN","SDEC25",169,0) ;Propagates CHECKIN to SDECAPPT and raises refresh event to running GUI clients "RTN","SDEC25",170,0) ; "RTN","SDEC25",171,0) Q:+$G(SDECNOEV) "RTN","SDEC25",172,0) Q:'+$G(SDECSC) "RTN","SDEC25",173,0) N SDECSTAT,SDECFOUND,SDECRES "RTN","SDEC25",174,0) S SDECSTAT="" "RTN","SDEC25",175,0) S:$G(SDATA("AFTER","STATUS"))["CHECKED IN" SDECSTAT=$P(SDATA("AFTER","STATUS"),"^",4) "RTN","SDEC25",176,0) S SDECFOUND=0 "RTN","SDEC25",177,0) I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$CHKEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT) "RTN","SDEC25",178,0) I SDECFOUND D CHKEVT3(SDECRES) Q "RTN","SDEC25",179,0) Q "RTN","SDEC25",180,0) ; "RTN","SDEC25",181,0) CHKEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT) ; "RTN","SDEC25",182,0) ;Get appointment id in SDECAPT "RTN","SDEC25",183,0) ;If found, call SDECNOS(SDECAPPT) and return 1 "RTN","SDEC25",184,0) ;else return 0 "RTN","SDEC25",185,0) N SDECFOUND,SDECAPPT "RTN","SDEC25",186,0) S SDECFOUND=0 "RTN","SDEC25",187,0) Q:'+$G(SDECRES) SDECFOUND "RTN","SDEC25",188,0) Q:'$D(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART)) SDECFOUND "RTN","SDEC25",189,0) S SDECAPPT=0 F S SDECAPPT=$O(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART,SDECAPPT)) Q:'+SDECAPPT D Q:SDECFOUND "RTN","SDEC25",190,0) . S SDECNOD=$G(^SDEC(409.84,SDECAPPT,0)) Q:SDECNOD="" "RTN","SDEC25",191,0) . I $P(SDECNOD,U,5)=SDECPAT,$P(SDECNOD,U,12)="" S SDECFOUND=1 Q "RTN","SDEC25",192,0) I SDECFOUND,+$G(SDECAPPT) D SDECCHK(SDECAPPT,SDECSTAT) "RTN","SDEC25",193,0) Q SDECFOUND "RTN","SDEC25",194,0) ; "RTN","SDEC25",195,0) CHKEVT3(SDECRES) ; "RTN","SDEC25",196,0) ;Call RaiseEvent to notify GUI clients "RTN","SDEC25",197,0) ; "RTN","SDEC25",198,0) Q "RTN","SDEC25",199,0) N SDECRESN "RTN","SDEC25",200,0) S SDECRESN=$G(^SDEC(409.831,SDECRES,0)) "RTN","SDEC25",201,0) Q:SDECRESN="" "RTN","SDEC25",202,0) S SDECRESN=$P(SDECRESN,"^") "RTN","SDEC25",203,0) ;D EVENT^SDEC23("SCHEDULE-"_SDECRESN,"","","") "RTN","SDEC25",204,0) ;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN) "RTN","SDEC25",205,0) Q "RTN","SDEC25",206,0) ; "RTN","SDEC25",207,0) CHKEVTD(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CHECKIN APPOINTMENT event "RTN","SDEC25",208,0) ;when an appointment CHECKIN is deleted via. "RTN","SDEC25",209,0) ;Deletes CHECKIN to and raises refresh event to running GUI clients "RTN","SDEC25",210,0) ; "RTN","SDEC25",211,0) ; "RTN","SDEC25",212,0) Q:+$G(SDECNOEV) "RTN","SDEC25",213,0) Q:'+$G(SDECSC) "RTN","SDEC25",214,0) N SDECSTAT,SDECFOUND,SDECRES "RTN","SDEC25",215,0) S SDECSTAT="" "RTN","SDEC25",216,0) S:$G(SDATA("AFTER","STATUS"))'="CHECKED IN" SDECSTAT=$P(SDATA("AFTER","STATUS"),"^",4) "RTN","SDEC25",217,0) I SDECSTAT="" S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) "RTN","SDEC25",218,0) I SDECRES D CHKEVT3(SDECRES) Q "RTN","SDEC25",219,0) S SDECFOUND=0 "RTN","SDEC25",220,0) ; "RTN","SDEC25",221,0) ;I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$CHKEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT) "RTN","SDEC25",222,0) ;I SDECFOUND D CHKEVT3(SDECRES) Q "RTN","SDEC25",223,0) Q "RTN","SDEC25",224,0) ; "RTN","SDEC25",225,0) ;CHECK OUT APPOINTMENT - RPC "RTN","SDEC25",226,0) CHECKOUT(SDECY,DFN,SDT,SDCODT,SDECAPTID,VPRV) ;Check Out appointment "RTN","SDEC25",227,0) ;CHECKOUT(SDECY,DFN,SDT,SDCODT,SDECAPTID,VPRV) external parameter tag is in SDEC "RTN","SDEC25",228,0) ; Returns SDECY "RTN","SDEC25",229,0) ; Input -- DFN Patient file IEN "RTN","SDEC25",230,0) ; SDT Appointment Date/Time in FM format "RTN","SDEC25",231,0) ; SDCODT Date/Time of Check Out FM FORMAT [REQUIRED] "RTN","SDEC25",232,0) ; SDECAPTID - Appointment ID "RTN","SDEC25",233,0) ; VPRV - V Provider "RTN","SDEC25",234,0) ;SETUP ERROR TRACKING "RTN","SDEC25",235,0) N APIERR,CNT,ERR,%DT,X,Y "RTN","SDEC25",236,0) N SDCL,SDASK,SDCOACT,SDCOALBF,SDDA,SDLNE,SDQUIET "RTN","SDEC25",237,0) N SDECI,SDECNOD "RTN","SDEC25",238,0) S SDECI=0 "RTN","SDEC25",239,0) K ^TMP("SDEC",$J) "RTN","SDEC25",240,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC25",241,0) S ^TMP("SDEC",$J,0)="T00020ERRORID"_$C(30) "RTN","SDEC25",242,0) I '+SDECAPTID D ERR("Invalid Appointment ID.") Q "RTN","SDEC25",243,0) I '$D(^SDEC(409.84,SDECAPTID,0)) D ERR("Invalid Appointment ID.") Q "RTN","SDEC25",244,0) ;INITIALIZE VARIABLES "RTN","SDEC25",245,0) S %DT="T" "RTN","SDEC25",246,0) S X=SDT "RTN","SDEC25",247,0) D ^%DT ; GET FM FORMAT FOR APPOINTMENT DATE/TIME "RTN","SDEC25",248,0) S SDT=Y "RTN","SDEC25",249,0) S X=SDCODT "RTN","SDEC25",250,0) D ^%DT ; GET FM FORMAT FOR CHECKOUT DATE/TIME "RTN","SDEC25",251,0) ;ChecOut time cannot be in the future "RTN","SDEC25",252,0) S SDCODT=Y "RTN","SDEC25",253,0) I SDCODT>$$HTFM^XLFDT($H) D ERR("Check Out time cannot be in the future.") Q "RTN","SDEC25",254,0) ; "RTN","SDEC25",255,0) ;appointment record "RTN","SDEC25",256,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC25",257,0) ;make sure CHECKOUT time is after CHECKIN time "RTN","SDEC25",258,0) I SDCODT'>$P(SDECNOD,U,3) D ERR("Check Out time must be at least 1 minute after the Check In time of "_$TR($$FMTE^XLFDT($P(SDECNOD,U,3)),"@"," ")_".") Q ;alb/sat 665 "RTN","SDEC25",259,0) ;Hospital Location of RESOURCE "RTN","SDEC25",260,0) S SDECRES=$P(SDECNOD,U,7) ;RESOURCEID "RTN","SDEC25",261,0) S SDECNOD=^SDEC(409.831,SDECRES,0) "RTN","SDEC25",262,0) S SDCL=$P(SDECNOD,U,4) ;HOSPITAL LOCATION "RTN","SDEC25",263,0) ; "RTN","SDEC25",264,0) S SDDA=0 "RTN","SDEC25",265,0) S SDASK=0 "RTN","SDEC25",266,0) S SDCOALBF="" "RTN","SDEC25",267,0) S SDCOACT="CO" "RTN","SDEC25",268,0) S SDLNE="" "RTN","SDEC25",269,0) S SDQUIET=1 "RTN","SDEC25",270,0) K APIERR "RTN","SDEC25",271,0) S APIERR=0 "RTN","SDEC25",272,0) D CO^SDEC25A(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOACT,SDLNE,.SDCOALBF,SDECAPTID,SDQUIET,VPRV,.APIERR) ;Appt Check Out "RTN","SDEC25",273,0) ;ERROR(S) FOUND "RTN","SDEC25",274,0) I APIERR>0 D "RTN","SDEC25",275,0) . S CNT="" "RTN","SDEC25",276,0) . F S CNT=$O(APIERR(CNT)) Q:CNT="" S ERR=APIERR(CNT) S SDECI=SDECI+1 D ERR(ERR) "RTN","SDEC25",277,0) ;NO ERROR "RTN","SDEC25",278,0) I APIERR<1 D "RTN","SDEC25",279,0) . S SDECI=SDECI+1 "RTN","SDEC25",280,0) . S ^TMP("SDEC",$J,SDECI)="0"_$C(30) "RTN","SDEC25",281,0) . S SDECI=SDECI+1 "RTN","SDEC25",282,0) . S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC25",283,0) Q "RTN","SDEC25",284,0) ; "RTN","SDEC25",285,0) ;CHECK OUT APPOINTMENT - RPC "RTN","SDEC25",286,0) CANCKOUT(SDECY,SDECAPTID) ;Cancel Check Out appointment "RTN","SDEC25",287,0) ;CANCKOUT(SDECY,SDECAPTID) external parameter tag is in SDEC "RTN","SDEC25",288,0) ; Returns SDECY "RTN","SDEC25",289,0) ; Input -- SDECAPTID - Appointment ID "RTN","SDEC25",290,0) N APS,DA,DFN,DIE,DR,RES "RTN","SDEC25",291,0) N SDCL,SDN,SDOE,SDT,SDV "RTN","SDEC25",292,0) N SDECI,SDECNOD "RTN","SDEC25",293,0) S SDECI=0 "RTN","SDEC25",294,0) K ^TMP("SDEC",$J) "RTN","SDEC25",295,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC25",296,0) S ^TMP("SDEC",$J,0)="T00020ERRORID"_$C(30) "RTN","SDEC25",297,0) I '+SDECAPTID D ERR("Invalid Appointment ID.") Q "RTN","SDEC25",298,0) I '$D(^SDEC(409.84,SDECAPTID,0)) D ERR("Invalid Appointment ID.") Q "RTN","SDEC25",299,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC25",300,0) S APS=$P(SDECNOD,U,19) "RTN","SDEC25",301,0) S DFN=$P(SDECNOD,U,5) "RTN","SDEC25",302,0) S SDT=$P(SDECNOD,U) "RTN","SDEC25",303,0) S RES=$P(SDECNOD,U,7) "RTN","SDEC25",304,0) S SDCL=$P(^SDEC(409.831,RES,0),U,4) "RTN","SDEC25",305,0) I $P(SDECNOD,U,14)="" D ERR("Appointment is not Checked Out.") Q "RTN","SDEC25",306,0) ; ^SDECAPPT: update piece 8: Data Entry Clerk; clear piece 14: CHECKOUT; "RTN","SDEC25",307,0) S DIE="^SDEC(409.84," "RTN","SDEC25",308,0) S DA=SDECAPTID "RTN","SDEC25",309,0) S DR=".14////@;.08///"_DUZ "RTN","SDEC25",310,0) D ^DIE "RTN","SDEC25",311,0) ; ^SC file 44: clear piece C;3: CHECKED OUT; clear piece C;4: CHECK OUT USER; clear C;6: CHECK OUT ENTERED "RTN","SDEC25",312,0) S DIE="^SC("_SDCL_",""S"","_SDT_",1," "RTN","SDEC25",313,0) S DA(2)=SDCL,DA(1)=SDT,(DA,SDN)=$$SCIEN^SDECU2(DFN,SDCL,SDT) "RTN","SDEC25",314,0) S DR="303///@;304///@;306///@" "RTN","SDEC25",315,0) D ^DIE "RTN","SDEC25",316,0) ; ^AUPNVSIT file 9000010: clear piece 18: CHECK OUT DATE&TIME "RTN","SDEC25",317,0) S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL) "RTN","SDEC25",318,0) S SDV=$$GET1^DIQ(409.68,SDOE,.05,"I") "RTN","SDEC25",319,0) I +SDV D "RTN","SDEC25",320,0) . S DIE="^AUPNVSIT(",DA=SDV "RTN","SDEC25",321,0) . S DR=".18///@" "RTN","SDEC25",322,0) . D ^DIE "RTN","SDEC25",323,0) ; ^SCE file 409.68: Set piece 12 back to CHECKED IN, pointer to APPOINTMENT STATUS file 409.63; clear piece 7: CHECK OUT PROCESS COMPLETION "RTN","SDEC25",324,0) I +APS D "RTN","SDEC25",325,0) . S DIE=409.68,DA=SDOE,DR=".07///@;.12///"_APS_";101///"_DUZ_";102///"_$$NOW^XLFDT "RTN","SDEC25",326,0) . D ^DIE "RTN","SDEC25",327,0) S SDECI=SDECI+1 "RTN","SDEC25",328,0) S ^TMP("SDEC",$J,SDECI)="0"_$C(30) "RTN","SDEC25",329,0) S SDECI=SDECI+1 "RTN","SDEC25",330,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC25",331,0) Q "RTN","SDEC25",332,0) ; "RTN","SDEC25",333,0) CANAPPT(SDECAPTID) ;external call to cancel check out in SDEC APPOINTMENT called by SDCODEL for VistA Delete Check Out "RTN","SDEC25",334,0) N APS,DA,DIE,DR,DFN,RES,SDCL,SDT "RTN","SDEC25",335,0) N SDECNOD "RTN","SDEC25",336,0) I '+$G(SDECAPTID) Q "RTN","SDEC25",337,0) I '$D(^SDEC(409.84,+SDECAPTID,0)) Q "RTN","SDEC25",338,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC25",339,0) S APS=$P(SDECNOD,U,19) "RTN","SDEC25",340,0) S DFN=$P(SDECNOD,U,5) "RTN","SDEC25",341,0) S SDT=$P(SDECNOD,U) "RTN","SDEC25",342,0) S RES=$P(SDECNOD,U,7) "RTN","SDEC25",343,0) S SDCL=$P(^SDEC(409.831,RES,0),U,4) "RTN","SDEC25",344,0) I $P(SDECNOD,U,14)="" Q "RTN","SDEC25",345,0) ; ^SDEC(409.84: update piece 8: Data Entry Clerk; clear piece 14: CHECKOUT; "RTN","SDEC25",346,0) S DIE="^SDEC(409.84," "RTN","SDEC25",347,0) S DA=SDECAPTID "RTN","SDEC25",348,0) S DR=".14////@;.08///"_DUZ "RTN","SDEC25",349,0) D ^DIE "RTN","SDEC25",350,0) Q "RTN","SDEC25",351,0) ; "RTN","SDEC25",352,0) ERROR ; "RTN","SDEC25",353,0) D ERR("VISTA Error") "RTN","SDEC25",354,0) Q "RTN","SDEC25",355,0) ; "RTN","SDEC25",356,0) ERR(ERRNO) ;Error processing "RTN","SDEC25",357,0) S SDECI=SDECI+1 "RTN","SDEC25",358,0) S ^TMP("SDEC",$J,SDECI)=ERRNO_$C(30) "RTN","SDEC25",359,0) S SDECI=SDECI+1 "RTN","SDEC25",360,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC25",361,0) Q "RTN","SDEC32") 0^7^B103453639^B77702065 "RTN","SDEC32",1,0) SDEC32 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDEC32",2,0) ;;5.3;Scheduling;**627,643,642,658,665**;Aug 13, 1993;Build 14 "RTN","SDEC32",3,0) ; "RTN","SDEC32",4,0) Q "RTN","SDEC32",5,0) ; "RTN","SDEC32",6,0) ; "RTN","SDEC32",7,0) ERROR ; "RTN","SDEC32",8,0) D ERR("VistA Error") "RTN","SDEC32",9,0) Q "RTN","SDEC32",10,0) ; "RTN","SDEC32",11,0) ERR(SDECERR) ;Error processing "RTN","SDEC32",12,0) S SDECI=SDECI+1 "RTN","SDEC32",13,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC32",14,0) Q "RTN","SDEC32",15,0) ; "RTN","SDEC32",16,0) HOSPLOC(SDECY,SDECP,MAXREC,LSUB) ;return HOSPITAL LOCATIONs "RTN","SDEC32",17,0) ;HOSPLOC(SDECY) external parameter tag is in SDEC "RTN","SDEC32",18,0) ;INPUT: "RTN","SDEC32",19,0) ; SDECP - (optional) Partial name text "RTN","SDEC32",20,0) ; MAXREC - (optional) Max number of records to return "RTN","SDEC32",21,0) ; LSUB - (optional) subscripts from last call to pick up where left off "RTN","SDEC32",22,0) ;RETURN: "RTN","SDEC32",23,0) ;Global Array in which each array entry "RTN","SDEC32",24,0) ;contains HOSPITAL LOCATION data separated by ^: "RTN","SDEC32",25,0) ; 1. HOSPITAL_LOCATION_ID "RTN","SDEC32",26,0) ; 2. HOSPITAL_LOCATION "RTN","SDEC32",27,0) ; 3. DEFAULT_PROVIDER "RTN","SDEC32",28,0) ; 4. STOP_CODE_NUMBER "RTN","SDEC32",29,0) ; 5. INACTIVATE_DATE "RTN","SDEC32",30,0) ; 6. REACTIVATE_DATE "RTN","SDEC32",31,0) ; 7. LASTSUB "RTN","SDEC32",32,0) N SDECI,SDECIEN,SDECNOD,SDECNOD1,SDECNAM,SDECINA,SDECREA,SDECSCOD "RTN","SDEC32",33,0) N SDECIEN1,SDECPRV,SDDUP,SDNAM "RTN","SDEC32",34,0) N LASTSUB,X "RTN","SDEC32",35,0) K ^TMP("SDEC",$J) "RTN","SDEC32",36,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC32",37,0) S SDECI=0 "RTN","SDEC32",38,0) S ^TMP("SDEC",$J,SDECI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE^T00030LASTSUB"_$C(30) "RTN","SDEC32",39,0) ; "RTN","SDEC32",40,0) S SDECP=$G(SDECP) "RTN","SDEC32",41,0) S MAXREC=+$G(MAXREC) "RTN","SDEC32",42,0) S LSUB=$G(LSUB) "RTN","SDEC32",43,0) S:LSUB="" SDECNAM=$S(SDECP'="":$$GETSUB^SDEC56(SDECP),1:"") "RTN","SDEC32",44,0) S:LSUB'="" SDECNAM=$$GETSUB^SDEC56($P(LSUB,"|",1)) "RTN","SDEC32",45,0) F S SDECNAM=$O(^SC("B",SDECNAM)) Q:(SDECP'="")&(SDECNAM'[SDECP) Q:SDECNAM="" D Q:(+MAXREC)&(SDECI'0 D Q:(+MAXREC)&(SDECI'0 "RTN","SDEC32",48,0) .. Q:'$D(^SC(+SDECIEN,0)) "RTN","SDEC32",49,0) .. Q:$$INACTIVE(+SDECIEN) "RTN","SDEC32",50,0) .. Q:+$$GET1^DIQ(44,SDECIEN_",",50.01,"I")=1 ;OOS? "RTN","SDEC32",51,0) .. S SDECINA=$$GET1^DIQ(44,SDECIEN_",",2505) ;INACTIVATE "RTN","SDEC32",52,0) .. S SDECREA=$$GET1^DIQ(44,SDECIEN_",",2506) ;REACTIVATE "RTN","SDEC32",53,0) .. S SDECNOD=^SC(SDECIEN,0) "RTN","SDEC32",54,0) .. Q:$D(SDDUP(+SDECIEN)) "RTN","SDEC32",55,0) .. S SDDUP(+SDECIEN)="" "RTN","SDEC32",56,0) .. S SDNAM=$P(SDECNOD,U) "RTN","SDEC32",57,0) .. S SDECSCOD=$$GET1^DIQ(44,SDECIEN_",",8) ;STOP CODE "RTN","SDEC32",58,0) .. ;Calculate default provider "RTN","SDEC32",59,0) .. S SDECPRV="" "RTN","SDEC32",60,0) .. I $D(^SC(SDECIEN,"PR")) D "RTN","SDEC32",61,0) ... S SDECIEN1=0 F S SDECIEN1=$O(^SC(SDECIEN,"PR",SDECIEN1)) Q:'+SDECIEN1 Q:SDECPRV]"" D "RTN","SDEC32",62,0) .... S SDECNOD1=$G(^SC(SDECIEN,"PR",SDECIEN1,0)) "RTN","SDEC32",63,0) .... S:$P(SDECNOD1,U,2)="1" SDECPRV=$$GET1^DIQ(200,$P(SDECNOD1,U),.01) "RTN","SDEC32",64,0) .... Q "RTN","SDEC32",65,0) ... Q "RTN","SDEC32",66,0) .. S LASTSUB=SDECNAM_"|"_SDECIEN "RTN","SDEC32",67,0) .. S SDECI=SDECI+1 "RTN","SDEC32",68,0) .. S ^TMP("SDEC",$J,SDECI)=SDECIEN_U_SDNAM_U_SDECPRV_U_SDECSCOD_U_SDECINA_U_SDECREA_U_LASTSUB_$C(30) "RTN","SDEC32",69,0) .. Q "RTN","SDEC32",70,0) I SDECNAM="",SDECIEN="" S $P(^TMP("SDEC",$J,SDECI),U,7)="" ;clear lastsub for last entry if finished "RTN","SDEC32",71,0) S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31) "RTN","SDEC32",72,0) K SDDUP "RTN","SDEC32",73,0) Q "RTN","SDEC32",74,0) ; "RTN","SDEC32",75,0) CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET,MAXREC) ;Returns CLINIC SETUP PARAMETERS for clinics that are active in the HOSPITAL LOCATION file "RTN","SDEC32",76,0) ;CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET) external parameter tag is in SDEC "RTN","SDEC32",77,0) ;INPUT: "RTN","SDEC32",78,0) ; SDNOSLOT - no slots flag - 0=return availability 1=do not return availability "RTN","SDEC32",79,0) ; SDIENS - IENs for individual hospital locations separated by pipes "RTN","SDEC32",80,0) ; SDNOLET - flag to include clinics with no Recall Letter defined "RTN","SDEC32",81,0) ; in RECALL REMINDERS LETTERS file "RTN","SDEC32",82,0) ; 0 = yes (include all clinics including those with no Recall Letter "RTN","SDEC32",83,0) ; defined) [default] "RTN","SDEC32",84,0) ; 1 = no (only return clinics with a Recall Letter "RTN","SDEC32",85,0) ; defined) "RTN","SDEC32",86,0) ;Returns CLINIC SETUP PARAMETERS file entries for clinics which "RTN","SDEC32",87,0) ;are active in ^SC "RTN","SDEC32",88,0) ;MGH Added SDIENS as input parameter to for hospital location IENs "RTN","SDEC32",89,0) ;MGH Added SDECP for partial name lookup "RTN","SDEC32",90,0) ;RETURN "RTN","SDEC32",91,0) ; Global Array in which each array entry contains the following Clinic data separated by ^: "RTN","SDEC32",92,0) ; 1. HOSPITAL_LOCATION_ID "RTN","SDEC32",93,0) ; 2. HOSPITAL_LOCATION "RTN","SDEC32",94,0) ; 3. CREATE_VISIT "RTN","SDEC32",95,0) ; 4. VISIT_SERVICE_CATEGORY "RTN","SDEC32",96,0) ; 5. MULTIPLE_CLINIC_CODES_USED? "RTN","SDEC32",97,0) ; 6. VISIT_PROVIDER_REQUIRED "RTN","SDEC32",98,0) ; 7. GENERATE_PCCPLUS_FORMS? "RTN","SDEC32",99,0) ; 8. MAX_OVERBOOKS "RTN","SDEC32",100,0) ; 9. SDECDAT "RTN","SDEC32",101,0) ;10. SDECDATN "RTN","SDEC32",102,0) ;11. APPTLEN - 1912 Appointment Length Numeric 10-240 "RTN","SDEC32",103,0) ;12. VAPPTLEN "RTN","SDEC32",104,0) ;13. SLOTS "RTN","SDEC32",105,0) ;14. PRIVUSERPRESENT_BOOL "RTN","SDEC32",106,0) ;15. PROTECTED "RTN","SDEC32",107,0) ;16. HOUR_DISPLAY_BEGIN - 1914 Hour Clinic Display Begins "RTN","SDEC32",108,0) ;17. DISPLAY_INCREMENTS - 1917 Display increments per hour "RTN","SDEC32",109,0) ; 1=60-MIN "RTN","SDEC32",110,0) ; 2=30-MIN "RTN","SDEC32",111,0) ; 4=15-MIN "RTN","SDEC32",112,0) ; 3=20-MIN "RTN","SDEC32",113,0) ; 6=10-MIN "RTN","SDEC32",114,0) ;18. HOLIDAYS - 1918.5 Schedule on Holidays? Y=YES "RTN","SDEC32",115,0) ;19. SPECIAL - 1910 SPECIAL INSTRUCTIONS separated by $C(13,10) "RTN","SDEC32",116,0) ;20. CLINIC_STOP - Stop code Number pointer to CLINIC STOP file 40.7 "RTN","SDEC32",117,0) N SDA,SDAPLEN,SDAR,SDDATA,SDF,SDFIELDS,SDI,SDJ,SDK,SDSLOTS,SDVAPL,SDECI,SDECIEN,SDECNOD,SDECNAM,SDECINA,SDECREA,SDTMP ;alb/sat 665 - add SDF "RTN","SDEC32",118,0) N SDECCRV,SDECDAT,SDECDATN,SDECVSC,SDECMULT,SDECREQ,SDECPCC,SDECMOB,SDECHPRV,SDECPROT,SDECNAM,SDCNT,SDL,SDMAX ;alb/sat 665 - add vars "RTN","SDEC32",119,0) K ^TMP("SDEC",$J) "RTN","SDEC32",120,0) S (SDCNT,SDMAX)=0 "RTN","SDEC32",121,0) S SDF="" "RTN","SDEC32",122,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC32",123,0) S SDECI=0 "RTN","SDEC32",124,0) ; 1 2 3 4 "RTN","SDEC32",125,0) S SDTMP="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030CREATE_VISIT^T00030VISIT_SERVICE_CATEGORY" "RTN","SDEC32",126,0) ; 5 6 7 "RTN","SDEC32",127,0) S SDTMP=SDTMP_"^T00030MULTIPLE_CLINIC_CODES_USED?^T00030VISIT_PROVIDER_REQUIRED^T00030GENERATE_PCCPLUS_FORMS?" "RTN","SDEC32",128,0) ; 8 9 10 11 12 13 14 "RTN","SDEC32",129,0) S SDTMP=SDTMP_"^T00030MAX_OVERBOOKS^T00030SDECDAT^T00030SDECDATN^T00030APPTLEN^T00030VAPPTLEN^T00030SLOTS^B00001PRIVUSERPRESENT_BOOL" "RTN","SDEC32",130,0) ; 15 16 17 18 "RTN","SDEC32",131,0) S SDTMP=SDTMP_"^B00001PROTECTED^T00030HOUR_DISPLAY_BEGIN^T00030DISPLAY_INCREMENTS^T00030HOLIDAYS^T00030SPECIAL^T00030CLINIC_STOP" "RTN","SDEC32",132,0) S SDTMP=SDTMP_"^T00030ABBR^T00030MORE" "RTN","SDEC32",133,0) S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(30) "RTN","SDEC32",134,0) ; "RTN","SDEC32",135,0) S (SDECDAT,SDECDATN)="" "RTN","SDEC32",136,0) S SDNOSLOT=$G(SDNOSLOT) "RTN","SDEC32",137,0) S SDNOLET=$G(SDNOLET) "RTN","SDEC32",138,0) S MAXREC=$G(MAXREC,50) "RTN","SDEC32",139,0) ;MGH change made for individual locations "RTN","SDEC32",140,0) I $G(SDIENS) D "RTN","SDEC32",141,0) .F SDK=1:1:$L(SDIENS,"|") D "RTN","SDEC32",142,0) ..S SDECIEN=$P(SDIENS,"|",SDK) "RTN","SDEC32",143,0) ..D PROCESS(SDECIEN) "RTN","SDEC32",144,0) ;MGH change made for partial name lookup "RTN","SDEC32",145,0) I $G(SDECP)'="" D "RTN","SDEC32",146,0) .S SDECNAM=$$GETSUB^SDECU(SDECP) "RTN","SDEC32",147,0) .S SDF="ABBR" F S SDECNAM=$O(^SC("C",SDECNAM)) Q:SDECNAM'[SDECP D I SDCNT'5 "RTN","SDEC32",151,0) ..S SDECIEN=0 F S SDECIEN=$O(^SC("B",SDECNAM,SDECIEN)) Q:SDECIEN="" D PROCESS(SDECIEN) I SDCNT'0 D "RTN","SDEC32",153,0) .D PROCESS(SDECIEN) "RTN","SDEC32",154,0) S SDL=-1 F S SDL=$O(SDAR(SDL)) Q:SDL="" D "RTN","SDEC32",155,0) .S SDI="" F S SDI=$O(SDAR(SDL,SDI)) Q:SDI="" D "RTN","SDEC32",156,0) ..S SDJ="" F S SDJ=$O(SDAR(SDL,SDI,SDJ)) Q:SDJ="" D "RTN","SDEC32",157,0) ...S SDTMP=SDAR(SDL,SDI,SDJ) "RTN","SDEC32",158,0) ...S $P(SDTMP,U,22)=$S(+SDMAX:1,1:0) "RTN","SDEC32",159,0) ...S SDECI=SDECI+1 "RTN","SDEC32",160,0) ...S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(30) "RTN","SDEC32",161,0) S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31) "RTN","SDEC32",162,0) Q "RTN","SDEC32",163,0) PROCESS(SDECIEN) ;Process an individual clinic "RTN","SDEC32",164,0) ;MGH broke this out to do all locations or individual ones "RTN","SDEC32",165,0) N SDECABR,SDECNAM,SDI,SDI1,SDDI,SDH,SDHDB,SDSP,SDSTOP "RTN","SDEC32",166,0) Q:'$D(^SC(+SDECIEN,0)) "RTN","SDEC32",167,0) I SDF="FULL",SDECP'="" S FND=$$CHK(SDECP,SDECIEN) Q:+FND ;alb/sat 665 - stop if 'this' record found in abbreviations "RTN","SDEC32",168,0) Q:$$INACTIVE(+SDECIEN) "RTN","SDEC32",169,0) I SDNOLET,'$O(^SD(403.52,"B",+SDECIEN,0)) Q "RTN","SDEC32",170,0) D RESCLIN1^SDEC01B(SDECIEN) "RTN","SDEC32",171,0) S SDSLOTS="" "RTN","SDEC32",172,0) K SDDATA,SDMSG "RTN","SDEC32",173,0) S SDFIELDS=".01;1;2;8;50.01;1912;1913;1914;1917;1918;1918.5"_$S(SDNOSLOT:"",1:";1920*")_";2505;2506;2507" ;alb/sat 665 - add abbreviation "RTN","SDEC32",174,0) D GETS^DIQ(44,SDECIEN_",",SDFIELDS,"IE","SDDATA","SDMSG") "RTN","SDEC32",175,0) Q:$G(SDDATA(44,SDECIEN_",",2,"I"))'="C" "RTN","SDEC32",176,0) Q:+$G(SDDATA(44,SDECIEN_",",50.01,"I"))=1 ;OOS? "RTN","SDEC32",177,0) S SDA="SDDATA(44,"""_SDECIEN_","")" "RTN","SDEC32",178,0) S SDAPLEN=@SDA@(1912,"E") ;length of appointment "RTN","SDEC32",179,0) S SDVAPL=@SDA@(1913,"I") ;variable appointment length V means yes "RTN","SDEC32",180,0) S SDHDB=@SDA@(1914,"E") ;hour clinic display begins "RTN","SDEC32",181,0) S:SDHDB="" SDHDB=8 "RTN","SDEC32",182,0) S SDDI=@SDA@(1917,"I") ;display increments per hour "RTN","SDEC32",183,0) S SDECINA=@SDA@(2505,"E") ;INACTIVATE "RTN","SDEC32",184,0) S SDECREA=@SDA@(2506,"E") ;REACTIVATE "RTN","SDEC32",185,0) S SDECDAT=@SDA@(2507,"I") ;DEFAULT APPOINTMENT TYPE ien "RTN","SDEC32",186,0) S SDECDATN=@SDA@(2507,"E") ;DEFAULT APPOINTMENT TYPE name "RTN","SDEC32",187,0) S SDSTOP=@SDA@(8,"I") ;STOP CODE NUMBER "RTN","SDEC32",188,0) S SDECNAM=@SDA@(.01,"E") "RTN","SDEC32",189,0) S SDECABR=@SDA@(1,"E") ;alb/sat 665 "RTN","SDEC32",190,0) S SDECNAM=$S((SDF="ABBR")&(@SDA@(1,"E")'=""):@SDA@(1,"E")_" ",1:"")_SDECNAM ;alb/sat 665 - include abbr in name if found by C xref "RTN","SDEC32",191,0) S SDECMOB=@SDA@(1918,"E") "RTN","SDEC32",192,0) S SDH=@SDA@(1918.5,"I") "RTN","SDEC32",193,0) S SDECCRV=1 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.09) ;Create Visit at Check-In? "RTN","SDEC32",194,0) S SDECVSC="" ;$$GET1^DIQ(9009017.2,SDECIEN_",",.12) ;Visit Service Category "RTN","SDEC32",195,0) S SDECMULT=1 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.13) ;Multiple Clinic codes used? "RTN","SDEC32",196,0) S SDECREQ=1 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.14) ;Visit Provider Required "RTN","SDEC32",197,0) S SDECPCC=0 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.15) ;Generate PCCPlus Forms? "RTN","SDEC32",198,0) S:'SDNOSLOT SDSLOTS=$$GETSLOTS(.SDDATA) "RTN","SDEC32",199,0) S SDECHPRV=$O(^SC(+SDECIEN,"SDPRIV",0))>0 "RTN","SDEC32",200,0) S SDECPROT=$G(^SC(+SDECIEN,"SDPROT"))="Y" "RTN","SDEC32",201,0) S SDSP="" S SDI=0 F S SDI=$O(^SC(+SDECIEN,"SI",SDI)) Q:SDI'>0 S SDI1=$G(^SC(+SDECIEN,"SI",SDI,0)) S:SDI1'="" SDSP=$S(SDSP'="":SDSP_$C(13,10),1:"")_SDI1 "RTN","SDEC32",202,0) ; 1 2 3 4 5 6 7 8 "RTN","SDEC32",203,0) S SDTMP=SDECIEN_U_SDECNAM_U_SDECCRV_U_SDECVSC_U_SDECMULT_U_SDECREQ_U_SDECPCC_U_SDECMOB "RTN","SDEC32",204,0) ; 9 10 11 12 13 14 15 "RTN","SDEC32",205,0) S SDTMP=SDTMP_U_SDECDAT_U_SDECDATN_U_+SDAPLEN_U_SDVAPL_U_SDSLOTS_U_SDECHPRV_U_SDECPROT "RTN","SDEC32",206,0) ; 16 17 18 19 20 "RTN","SDEC32",207,0) S SDTMP=SDTMP_U_SDHDB_U_SDDI_U_SDH_U_SDSP_U_SDSTOP_U_SDECABR "RTN","SDEC32",208,0) S SDAR(SDF="FULL",SDECNAM,SDECIEN)=SDTMP "RTN","SDEC32",209,0) S SDCNT=SDCNT+1 "RTN","SDEC32",210,0) Q "RTN","SDEC32",211,0) CHK(SDECP,SDECIEN) ;alb/sat 665 - stop if 'this' record found in abbreviations "RTN","SDEC32",212,0) N FND,SDR,SDX "RTN","SDEC32",213,0) S FND=0 "RTN","SDEC32",214,0) S SDX=$$GETSUB^SDEC56(SDECP) "RTN","SDEC32",215,0) F S SDX=$O(^SC("C",SDX)) Q:SDX="" Q:SDX'[SDECP D Q:+FND "RTN","SDEC32",216,0) .S SDR=0 F S SDR=$O(^SC("C",SDX,SDR)) Q:'+SDR S FND=SDR=SDECIEN Q:+FND "RTN","SDEC32",217,0) Q FND "RTN","SDEC32",218,0) ; "RTN","SDEC32",219,0) ; "RTN","SDEC32",220,0) GETSLOTS(SDDATA) ;get slots - NUMBER OF PATIENTS in the AVAILABILITY multiple of file 44 "RTN","SDEC32",221,0) ;INPUT: "RTN","SDEC32",222,0) ; SDDATA - array from GETS^DIQ against file 44 above to collect timeslots from "RTN","SDEC32",223,0) N SDI,SDDT,SDSLOTS "RTN","SDEC32",224,0) S SDSLOTS="" "RTN","SDEC32",225,0) S SDI="" F S SDI=$O(SDDATA(44.004,SDI)) Q:SDI="" D "RTN","SDEC32",226,0) .S SDDT=$P(SDI,",",2) ;get date "RTN","SDEC32",227,0) .S SDDT=SDDT_"."_SDDATA(44.004,SDI,.01,"I") ;get time "RTN","SDEC32",228,0) .S SDDT=$$FMTE^XLFDT(SDDT) "RTN","SDEC32",229,0) .S SDSLOTS=$S(SDSLOTS'="":SDSLOTS_"|",1:"")_SDDT_";;"_SDDATA(44.004,SDI,1,"E") "RTN","SDEC32",230,0) Q SDSLOTS "RTN","SDEC32",231,0) ; "RTN","SDEC32",232,0) INACTIVE(SDCL,SDDT) ;determine if clinic is active "RTN","SDEC32",233,0) ; X=0=ACTIVE "RTN","SDEC32",234,0) ; X=1=INACTIVE "RTN","SDEC32",235,0) N SDNODI,N21,N25,X "RTN","SDEC32",236,0) S SDDT=$G(SDDT) I SDDT="" S SDDT=DT "RTN","SDEC32",237,0) S SDDT=$P(SDDT,".",1) "RTN","SDEC32",238,0) S X=1 "RTN","SDEC32",239,0) S SDNODI=$G(^SC(SDCL,"I")) "RTN","SDEC32",240,0) Q:SDNODI="" 0 "RTN","SDEC32",241,0) S N21=$P(SDNODI,U,1) ;inactive date/time "RTN","SDEC32",242,0) S N25=$P(SDNODI,U,2) ;reactive date/time "RTN","SDEC32",243,0) I (N21="") S X=0 Q X "RTN","SDEC32",244,0) I (N21'="")&(N21>SDDT) S X=0 Q X "RTN","SDEC32",245,0) I (N25'="")&(N25'>SDDT) S X=0 Q X "RTN","SDEC32",246,0) Q X "RTN","SDEC32",247,0) ; "RTN","SDEC32",248,0) PRIV(SDECY,CLINIEN,USER) ;IS this USER in the PRIVILEGED USER multiple for the clinic "RTN","SDEC32",249,0) ;INPUT: "RTN","SDEC32",250,0) ; CLINIEN - pointer to HOSPITAL LOCATION file 44 "RTN","SDEC32",251,0) ; USER - pointer to NEW PERSON file 200 "RTN","SDEC32",252,0) ;RETURN: "RTN","SDEC32",253,0) ; A single boolean entry indicating that the USER is a PRIVILEGED USER for the clinic. "RTN","SDEC32",254,0) ; RETURNCODE - 0=NO; 1=YES; -1=error "RTN","SDEC32",255,0) ; MESSAGE "RTN","SDEC32",256,0) N SDRET "RTN","SDEC32",257,0) S SDECY="^TMP(""SDEC32"","_$J_",""PRIV"")" "RTN","SDEC32",258,0) K @SDECY "RTN","SDEC32",259,0) S @SDECY@(0)="T00030RETURNCODE^MESSAGE"_$C(30) "RTN","SDEC32",260,0) S CLINIEN=$G(CLINIEN) "RTN","SDEC32",261,0) I (CLINIEN="")!('$D(^SC(CLINIEN,0))) S @SDECY@(1)="-1^Invalid clinic ID."_$C(30,31) Q "RTN","SDEC32",262,0) S USER=$G(USER) "RTN","SDEC32",263,0) I (USER="")!('$D(^VA(200,USER,0))) S @SDECY@(1)="-1^Invalid user ID."_$C(30,31) Q "RTN","SDEC32",264,0) S SDRET=$D(^SC(CLINIEN,"SDPRIV",USER,0)) "RTN","SDEC32",265,0) S $P(SDRET,U,2)=$S(SDRET=1:"YES",1:"NO") "RTN","SDEC32",266,0) S @SDECY@(1)=SDRET_$C(30,31) "RTN","SDEC32",267,0) Q "RTN","SDEC40") 0^8^B68854167^B66764561 "RTN","SDEC40",1,0) SDEC40 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDEC40",2,0) ;;5.3;Scheduling;**627,665**;Aug 13, 1993;Build 14 "RTN","SDEC40",3,0) ; "RTN","SDEC40",4,0) Q "RTN","SDEC40",5,0) ; "RTN","SDEC40",6,0) ; APL - Print Appointment Letter "RTN","SDEC40",7,0) ; "RTN","SDEC40",8,0) APPTLETR(SDECY,SDECAPID,LT) ;Print Appointment Letter "RTN","SDEC40",9,0) ;APPTLETR(SDECY,SDECAPID,LT) external parameter tag is in SDEC "RTN","SDEC40",10,0) ; SDECAPPT = Pointer to appointment in SDEC APPOINTMENT file 409.84 "RTN","SDEC40",11,0) ; LT = Letter type - "N"=No Show; "P"=Pre-Appointment; "A"=Cancelled by Patient; "C"=Cancelled by Clinic "RTN","SDEC40",12,0) ; Called by SDEC PRINT APPT LETTER remote procedure "RTN","SDEC40",13,0) N SDECI,SDECNOD,SDECTMP,DFN,IN,RES,SCLT,SDC,SDLET,SDS,SDT,X1,X2,Y "RTN","SDEC40",14,0) N SDIV,SDFORM,SDNAM,SDSSN,VAPA "RTN","SDEC40",15,0) S SDECI=0 "RTN","SDEC40",16,0) K ^TMP("SDEC",$J) "RTN","SDEC40",17,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC40",18,0) S ^TMP("SDEC",$J,0)="T00080ERRORID"_$C(30) "RTN","SDEC40",19,0) I '+SDECAPID D ERR^SDECERR("Invalid Appointment ID.") Q "RTN","SDEC40",20,0) I '$D(^SDEC(409.84,SDECAPID,0)) D ERR^SDECERR("Invalid Appointment ID.") Q "RTN","SDEC40",21,0) I $G(LT)="" S LT="P" ;D ERR^SDECERR("Invalid Letter Type.") Q "RTN","SDEC40",22,0) S SDECNOD=^SDEC(409.84,SDECAPID,0) "RTN","SDEC40",23,0) S SDT=$P(SDECNOD,U) ;Get appt time "RTN","SDEC40",24,0) S DFN=$P(SDECNOD,U,5) ;Get patient pointer to VA PATIENT (^DPT) file 2 "RTN","SDEC40",25,0) S RES=$P(SDECNOD,U,7) S SDC=$P(^SDEC(409.831,RES,0),U,4) ;get resource and clinic "RTN","SDEC40",26,0) S SDS=^DPT(DFN,"S",SDT,0) "RTN","SDEC40",27,0) S SCLT=$S(LT="N":1,LT="P":2,LT="C":3,LT="A":4,1:"2") ;get storage position of LETTER pointer "RTN","SDEC40",28,0) S SDLET=$P($G(^SC(SDC,"LTR")),U,SCLT) "RTN","SDEC40",29,0) I SDLET="" D ERR^SDECERR($S(SCLT=1:"No-Show",SCLT=2:"Pre-Appointment",SCLT=3:"Clinic Cancellation",1:"Patient Cancellation")_"Letter not defined for Clinic "_$P(^SC(SDC,0),U)_".") Q "RTN","SDEC40",30,0) S SDIV=$P(^SC(SDC,0),"^",15),SDIV=$S(SDIV:SDIV,1:$O(^DG(40.8,0))) "RTN","SDEC40",31,0) S SDFORM=$P($G(^DG(40.8,SDIV,"LTR")),U,1) "RTN","SDEC40",32,0) ; data header "RTN","SDEC40",33,0) S ^TMP("SDEC",$J,0)="T00080TEXT"_$C(30) "RTN","SDEC40",34,0) D PRT(DFN,SDC,SDT,LT,SDLET,SDFORM) "RTN","SDEC40",35,0) D WRAPP(DFN,SDC,SDT,LT,SDLET) "RTN","SDEC40",36,0) D REST(DFN,SDC,SDT,LT,SDLET,SDFORM) "RTN","SDEC40",37,0) S SDECI=SDECI+1 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(30,31) "RTN","SDEC40",38,0) Q "RTN","SDEC40",39,0) ; "RTN","SDEC40",40,0) ; "RTN","SDEC40",41,0) PRT(DFN,SDC,SD,LT,SDLET,SDFORM) ; "RTN","SDEC40",42,0) ; DFN - pointer to PATIENT file 2 "RTN","SDEC40",43,0) ; SDC - pointer to HOSPITAL LOCATION file 44 "RTN","SDEC40",44,0) ; SD - appointment time in FM format "RTN","SDEC40",45,0) ; LT - Letter type - "N"=No Show; "P"=Pre-Appointment; "A"=Cancelled by Patient; "C"=Cancelled by Clinic "RTN","SDEC40",46,0) ; SDLET - pointer to LETTER file 407.5 "RTN","SDEC40",47,0) ;WRITE GREETING AND OPENING TEXT OF LETTER "RTN","SDEC40",48,0) N A,DPTNAME,IN,X,Y "RTN","SDEC40",49,0) S A=DFN "RTN","SDEC40",50,0) Q:DFN="" "RTN","SDEC40",51,0) Q:LT="" "RTN","SDEC40",52,0) S SDFORM=$G(SDFORM) "RTN","SDEC40",53,0) S Y=DT D DTS^SDUTL "RTN","SDEC40",54,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(64," ")_Y_$C(13,10) "RTN","SDEC40",55,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(64," ")_$$LAST4(A)_$C(13,10) "RTN","SDEC40",56,0) I 'SDFORM D "RTN","SDEC40",57,0) .F I=1:1:4 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10) "RTN","SDEC40",58,0) .D ADDR "RTN","SDEC40",59,0) .F I=1:1:4 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10) "RTN","SDEC40",60,0) ; "RTN","SDEC40",61,0) S DPTNAME("FILE")=2,DPTNAME("FIELD")=".01",DPTNAME("IENS")=(+A)_"," "RTN","SDEC40",62,0) S X=$$NAMEFMT^XLFNAME(.DPTNAME,"G","M") "RTN","SDEC40",63,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="Dear "_$S($P(^DPT(+A,0),"^",2)="M":"Mr. ",1:"Ms. ")_X_","_$C(13,10) "RTN","SDEC40",64,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10) "RTN","SDEC40",65,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10) "RTN","SDEC40",66,0) ;loop and display initial section of Letter "RTN","SDEC40",67,0) S IN=0 F S IN=$O(^VA(407.5,SDLET,1,IN)) Q:IN'>0 D "RTN","SDEC40",68,0) . S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=^VA(407.5,SDLET,1,IN,0)_$C(13,10) "RTN","SDEC40",69,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10) "RTN","SDEC40",70,0) Q "RTN","SDEC40",71,0) ; "RTN","SDEC40",72,0) WRAPP(DFN,SDC,SD,LT,SDLET) ;WRITE APPOINTMENT INFORMATION "RTN","SDEC40",73,0) N B,DOW,S,SDCL,SDDAT,SDHX,SDT0,SDTMP,SDX,SDX1,X "RTN","SDEC40",74,0) S SDX=SD,S=$G(^DPT(DFN,"S",SD,0)) ;alb/sat 665 add S "RTN","SDEC40",75,0) S SDCL=$P(^SC(+SDC,0),"^",1),SDCL=" Clinic: "_SDCL D FORM ; SD*5.3*622 end changes "RTN","SDEC40",76,0) ; "RTN","SDEC40",77,0) S SDX1=SDX S:$D(SDS) S=SDS F B=3,4,5 I $P(S,"^",B)]"" S SDCL=$S(B=3:"LAB",B=4:"XRAY",1:"EKG"),SDX=$P(S,"^",B) D FORM ;alb/sat 665 "RTN","SDEC40",78,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10) ;alb/sat 665 "RTN","SDEC40",79,0) S (SDX,X)=SDX1 Q "RTN","SDEC40",80,0) ; SD*5.3*622 - add more detail for appointment and format it "RTN","SDEC40",81,0) FORM S:$D(SDX) X=SDX S SDHX=X D DW^%DTC S DOW=X,X=SDHX X ^DD("FUNC",2,1) S SDT0=X,SDDAT=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",$E(SDHX,4,5))_" "_+$E(SDHX,6,7)_", "_(1700+$E(SDHX,1,3)) "RTN","SDEC40",82,0) I '$D(B) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=" Date/Time: "_DOW_" "_$J(SDDAT,12)_$S('$D(B)&$D(SDC):$J(SDT0,9),1:"")_$C(13,10) "RTN","SDEC40",83,0) I '$D(B),$D(SDC) D "RTN","SDEC40",84,0) .S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=" "_SDCL_$C(13,10) "RTN","SDEC40",85,0) ; get default provider if defined for a given clinic, print it on the "RTN","SDEC40",86,0) ; letter only if we have a YES on file, same for clinic location "RTN","SDEC40",87,0) ; skip printing the provider label if the field is empty in file #44 "RTN","SDEC40",88,0) N J,SDLOC,SDPROV,SDPRNM,SDTEL,SDTELEXT "RTN","SDEC40",89,0) S SDLOC=$P($G(^SC(+SDC,0)),"^",11) ; physical location of the clinic "RTN","SDEC40",90,0) S SDTEL=$G(^SC(+SDC,99)) ; telephone number of clinic "RTN","SDEC40",91,0) S SDTELEXT="" I SDTEL]"",$G(^SC(+SDC,99.1))]"" D "RTN","SDEC40",92,0) .S SDTELEXT=^SC(+SDC,99.1) ; telephone ext of clinic "RTN","SDEC40",93,0) ; get default provider, if any "RTN","SDEC40",94,0) F J=0:0 S J=$O(^SC(+SDC,"PR",J)) Q:'J>0 I $P($G(^SC(+SDC,"PR",J,0)),U,2)=1 S SDPROV=+$P(^SC(+SDC,"PR",J,0),U,1) "RTN","SDEC40",95,0) I $D(SDC),'$D(B),$P($G(^VA(407.5,SDLET,3)),U,2)="Y" D "RTN","SDEC40",96,0) .I SDLOC]"" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=" "_"Location: "_SDLOC_$C(13,10) "RTN","SDEC40",97,0) I $D(SDC),'$D(B),SDTEL]"" D "RTN","SDEC40",98,0) .S SDTMP=" Telephone: "_SDTEL "RTN","SDEC40",99,0) .I SDTELEXT]"" S SDTMP=SDTMP_" Telephone Ext.: "_SDTELEXT "RTN","SDEC40",100,0) .S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(13,10) "RTN","SDEC40",101,0) I $D(SDPROV) D "RTN","SDEC40",102,0) .I $D(SDC),SDPROV>0 S SDPRNM=$P(^VA(200,SDPROV,0),U,1) "RTN","SDEC40",103,0) .I $D(SDC),'$D(B),$P($G(^VA(407.5,SDLET,3)),U,1)="Y" I SDPRNM]"" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=" Provider: "_$G(SDPRNM)_$C(13,10) "RTN","SDEC40",104,0) ; call handler for LAB, XRAY, and EKG tests "RTN","SDEC40",105,0) I $D(B) D TST "RTN","SDEC40",106,0) Q "RTN","SDEC40",107,0) REST(DFN,SDC,SD,LT,SDLET,SDFORM) ;WRITE THE REMAINDER OF LETTER "RTN","SDEC40",108,0) N A,Z5,I,IN,X "RTN","SDEC40",109,0) S A=DFN "RTN","SDEC40",110,0) S SDFORM=$G(SDFORM) "RTN","SDEC40",111,0) ;loop and display final section of Letter "RTN","SDEC40",112,0) S IN=0 F S IN=$O(^VA(407.5,SDLET,2,IN)) Q:IN'>0 D "RTN","SDEC40",113,0) . S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=^VA(407.5,SDLET,2,IN,0)_$C(13,10) "RTN","SDEC40",114,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10) "RTN","SDEC40",115,0) D:SDFORM=1 ADDR "RTN","SDEC40",116,0) Q "RTN","SDEC40",117,0) ADDR K VAHOW S DFN=+A S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(11," ")_$$FML^DGNFUNC(DFN)_$C(13,10) "RTN","SDEC40",118,0) I $D(^DG(43,1,"BT")),'$P(^("BT"),"^",3) S VAPA("P")="" "RTN","SDEC40",119,0) S X1=DT,X2=5 D C^%DTC ;I '$D(VAPA("P")) S (VATEST("ADD",9),VATEST("ADD",10))=X "RTN","SDEC40",120,0) D ADD^VADPT D "RTN","SDEC40",121,0) .;CHANGE STATE TO ABBR. "RTN","SDEC40",122,0) .N SDIENS,X "RTN","SDEC40",123,0) .I $D(VAPA(5)) S SDIENS=+VAPA(5)_",",X=$$GET1^DIQ(5,SDIENS,1),$P(VAPA(5),U,2)=X "RTN","SDEC40",124,0) .I $D(VAPA(17)) S SDIENS=+VAPA(17)_",",X=$$GET1^DIQ(5,SDIENS,1),$P(VAPA(17),U,2)=X "RTN","SDEC40",125,0) .K SDIENS Q "RTN","SDEC40",126,0) N SDCCACT1,SDCCACT2,LL "RTN","SDEC40",127,0) S SDCCACT1=VAPA(12),SDCCACT2=$P($G(VAPA(22,2)),"^",3) "RTN","SDEC40",128,0) ;if confidential address is not active for scheduling/appointment letters, print to regular address "RTN","SDEC40",129,0) I ($G(SDCCACT1)=0)!($G(SDCCACT2)'="Y") D "RTN","SDEC40",130,0) .F LL=1:1:3 I VAPA(LL)]"" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(11," ")_VAPA(LL)_$C(13,10) "RTN","SDEC40",131,0) .;if country is blank display as USA "RTN","SDEC40",132,0) .I (VAPA(25)="")!($P(VAPA(25),"^",2)="UNITED STATES") D ;display city,state,zip "RTN","SDEC40",133,0) ..S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(11," ")_VAPA(4)_" "_$P(VAPA(5),U,2)_" "_$P(VAPA(11),U,2)_$C(13,10) "RTN","SDEC40",134,0) .E D ;display postal code,city,province "RTN","SDEC40",135,0) ..S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(11," ")_VAPA(24)_" "_VAPA(4)_" "_VAPA(23)_$C(13,10) "RTN","SDEC40",136,0) .I ($P(VAPA(25),"^",2)'="UNITED STATES") S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(11," ")_$P(VAPA(25),U,2)_$C(13,10) ;display country "RTN","SDEC40",137,0) ;if confidential address is active for scheduling/appointment letters, print to confidential address "RTN","SDEC40",138,0) I $G(SDCCACT1)=1,$G(SDCCACT2)="Y" D "RTN","SDEC40",139,0) .F LL=13:1:15 I VAPA(LL)]"" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(11," ")_VAPA(LL)_$C(13,10) "RTN","SDEC40",140,0) .I (VAPA(28)="")!($P(VAPA(28),"^",2)="UNITED STATES") D "RTN","SDEC40",141,0) ..S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(11," ")_VAPA(16)_" "_$P(VAPA(17),U,2)_" "_$P(VAPA(18),U,2)_$C(13,10) "RTN","SDEC40",142,0) .E D "RTN","SDEC40",143,0) ..S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(11," ")_VAPA(27)_" "_VAPA(16)_" "_VAPA(26)_$C(13,10) "RTN","SDEC40",144,0) .I ($P(VAPA(28),"^",2)'="UNITED STATES") S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(11," ")_$P(VAPA(28),U,2)_$C(13,10) "RTN","SDEC40",145,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10) "RTN","SDEC40",146,0) D KVAR^VADPT "RTN","SDEC40",147,0) Q "RTN","SDEC40",148,0) ; "RTN","SDEC40",149,0) ; "RTN","SDEC40",150,0) LAST4(DFN) ;Return patient "last four" "RTN","SDEC40",151,0) N SDX "RTN","SDEC40",152,0) S SDX=$G(^DPT(+DFN,0)) "RTN","SDEC40",153,0) Q $E(SDX)_$E($P(SDX,U,9),6,9) "RTN","SDEC40",154,0) ; "RTN","SDEC40",155,0) BADADD ;Print patients with a Bad Address Indicator "RTN","SDEC40",156,0) I '$D(^TMP($J,"BADADD")) Q "RTN","SDEC40",157,0) N SDHDR,SDHDR1 "RTN","SDEC40",158,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(79,"*")_$C(13,10) "RTN","SDEC40",159,0) S SDHDR="BAD ADDRESS INDICATOR LIST" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU((80-$L(SDHDR)/2)," ")_SDHDR_$C(13,10) "RTN","SDEC40",160,0) S SDHDR1="** THE LETTER FOR THESE PATIENT(S) DID NOT PRINT DUE TO A BAD ADDRESS INDICATOR." "RTN","SDEC40",161,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="Last 4"_$C(13,10) "RTN","SDEC40",162,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="of SSN "_"Patient Name"_$C(13,10) "RTN","SDEC40",163,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(79,"*")_$C(13,10) "RTN","SDEC40",164,0) N SDNAM,SDDFN "RTN","SDEC40",165,0) S SDNAM="" F S SDNAM=$O(^TMP($J,"BADADD",SDNAM)) Q:SDNAM="" D "RTN","SDEC40",166,0) . S SDDFN=0 F S SDDFN=$O(^TMP($J,"BADADD",SDNAM,SDDFN)) Q:'SDDFN D "RTN","SDEC40",167,0) . . S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$LAST4(SDDFN)_" "_SDNAM_$C(13,10) "RTN","SDEC40",168,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10) "RTN","SDEC40",169,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10) "RTN","SDEC40",170,0) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDHDR1_$C(13,10) "RTN","SDEC40",171,0) Q "RTN","SDEC40",172,0) ; "RTN","SDEC40",173,0) TST ; SD*5.3*622 - handle scheduled tests "RTN","SDEC40",174,0) ;S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10) ;alb/sat 665 remove blank line "RTN","SDEC40",175,0) I ($L(SDCL)=3&($E(SDCL,1,3)="LAB")) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=" "_SDCL_" SCHEDULED: "_DOW_" "_$J(SDDAT,12)_" "_$J(SDT0,5)_$C(13,10) ;alb/sat 665 add space "RTN","SDEC40",176,0) I ($L(SDCL)=4&($E(SDCL,1,4)="XRAY")) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDCL_" SCHEDULED: "_DOW_" "_$J(SDDAT,12)_" "_$J(SDT0,5)_$C(13,10) "RTN","SDEC40",177,0) I ($L(SDCL)=3&($E(SDCL,1,3)="EKG")) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=" "_SDCL_" SCHEDULED: "_DOW_" "_$J(SDDAT,12)_" "_$J(SDT0,5)_$C(13,10) ;alb/sat 665 add space "RTN","SDEC40",178,0) Q "RTN","SDEC50") 0^21^B97773017^B96405128 "RTN","SDEC50",1,0) SDEC50 ;ALB/SAT/JSM - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDEC50",2,0) ;;5.3;Scheduling;**627,658,665**;Aug 13, 1993;Build 14 "RTN","SDEC50",3,0) ; "RTN","SDEC50",4,0) Q "RTN","SDEC50",5,0) ; "RTN","SDEC50",6,0) FAPPTGET(SDECY,DFN,SDBEG,SDEND,SDANC) ; GET Future appointments for given patient and date range "RTN","SDEC50",7,0) ;FAPPTGET(SDECY,DFN,SDBEG,SDEND,SDANC) external parameter tag is in SDEC "RTN","SDEC50",8,0) ;INPUT: "RTN","SDEC50",9,0) ; DFN = (required) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates) "RTN","SDEC50",10,0) ; SDBEG = (required) Begin of date range to search for appointments in external format "RTN","SDEC50",11,0) ; SDEND = (required) End of date range to search for appointments in external format "RTN","SDEC50",12,0) ; SDANC = (optional) ancillary flag 0=all appointments; 1=only ancillary appointments "RTN","SDEC50",13,0) ;RETURN: "RTN","SDEC50",14,0) ; Successful Return: "RTN","SDEC50",15,0) ; Global Array in which each array entry contains Appointment Data from the PATIENT file "RTN","SDEC50",16,0) ; Data is separated by ^: "RTN","SDEC50",17,0) ; 1. DFN "RTN","SDEC50",18,0) ; 2. CLINIC_IEN - Clinic IEN "RTN","SDEC50",19,0) ; 3. CLINIC_NAME - Clinic Name "RTN","SDEC50",20,0) ; 4. APPT_DATE - Appointment Date in external format "RTN","SDEC50",21,0) ; 5. STATUS - Status text "RTN","SDEC50",22,0) ; 6. ANCTXT - Ancillary Text "RTN","SDEC50",23,0) ; 7. CONS -Consult Link pointer to REQUEST/CONSULTATION file 123 "RTN","SDEC50",24,0) ; "T00020DFN^T00020CLINIC_IEN^T00030CLINIC_NAME^T00020APPT_DATE^T00020STATUS^T00100ANCTXT^T00030CONS" "RTN","SDEC50",25,0) ; Caught Exception Return: "RTN","SDEC50",26,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",27,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",28,0) ; Unexpected Exception Return: "RTN","SDEC50",29,0) ; Handled by the RPC Broker. "RTN","SDEC50",30,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC50",31,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC50",32,0) ; text back to the client. "RTN","SDEC50",33,0) ; "RTN","SDEC50",34,0) N IEN,SDANCT,SDCL,SDCLN,SDCONS,SDATA,SDDT,SDST,SDT,X,Y,%DT "RTN","SDEC50",35,0) S SDECI=0 "RTN","SDEC50",36,0) K ^TMP("SDEC50",$J) "RTN","SDEC50",37,0) S SDECY="^TMP(""SDEC50"","_$J_")" "RTN","SDEC50",38,0) ; data header "RTN","SDEC50",39,0) S @SDECY@(0)="T00020DFN^T00020CLINIC_IEN^T00030CLINIC_NAME^T00020APPT_DATE^T00020STATUS^T00100ANCTXT^T00030CONS^T00030IEN"_$C(30) ;alb/sat 658 add IEN "RTN","SDEC50",40,0) ;validate Patient (required) "RTN","SDEC50",41,0) I '+DFN D ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY) Q "RTN","SDEC50",42,0) I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY) Q "RTN","SDEC50",43,0) ;validate begin date/time (required) "RTN","SDEC50",44,0) S:$G(SDBEG)="" SDBEG=$P($$NOW^XLFDT,".",1) "RTN","SDEC50",45,0) S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y "RTN","SDEC50",46,0) I Y=-1 D ERR1^SDECERR(-1,"Invalid Begin Time.",.SDECI,SDECY) Q "RTN","SDEC50",47,0) ;validate end date/time (required) "RTN","SDEC50",48,0) S:$G(SDEND)="" SDEND=1000000 "RTN","SDEC50",49,0) S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y "RTN","SDEC50",50,0) I Y=-1 D ERR1^SDECERR(-1,"Invalid End Time.",.SDECI,SDECY) Q "RTN","SDEC50",51,0) ;validate ancillary flag (optional) "RTN","SDEC50",52,0) S SDANC=$G(SDANC) "RTN","SDEC50",53,0) S:SDANC'=1 SDANC=0 "RTN","SDEC50",54,0) S SDT=SDBEG F S SDT=$O(^DPT(DFN,"S",SDT)) Q:SDT="" Q:SDT>SDEND D ;fix this with Q:$P(SDT,".",1)>SDEND "RTN","SDEC50",55,0) .S SDST=$$GET1^DIQ(2.98,SDT_","_DFN_",",100) ;current status "RTN","SDEC50",56,0) .;Q:SDST'="FUTURE" "RTN","SDEC50",57,0) .;Q:'("I"[$P(^DPT(DFN,"S",SDT,0),U,2)) ;removed 6/24/2015 "RTN","SDEC50",58,0) .S SDANCT="" "RTN","SDEC50",59,0) .S SDATA=$G(^DPT(DFN,"S",SDT,0)) "RTN","SDEC50",60,0) .S SDANCT=$$ANC^SDAM1 "RTN","SDEC50",61,0) .I +SDANC,SDANCT="" Q ;quit if not ancillary "RTN","SDEC50",62,0) .S SDCL=$$GET1^DIQ(2.98,SDT_","_DFN_",",.01,"I") ;clinic IEN "RTN","SDEC50",63,0) .S SDCLN=$$GET1^DIQ(2.98,SDT_","_DFN_",",.01) ;clinic name "RTN","SDEC50",64,0) .S SDDT=$$GET1^DIQ(2.98,SDT_","_DFN_",",.001) ;appt time "RTN","SDEC50",65,0) .S CONS=$$CONS(SDCL,DFN,SDT) "RTN","SDEC50",66,0) .;S IEN="" "RTN","SDEC50",67,0) .S IEN=$$GETIEN(DFN,SDCL,SDT) ;alb/sat 658 return 409.84 ien "RTN","SDEC50",68,0) .S SDECI=SDECI+1 S @SDECY@(SDECI)=DFN_U_SDCL_U_SDCLN_U_SDDT_U_SDST_U_SDANCT_U_CONS_U_IEN_$C(30) "RTN","SDEC50",69,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC50",70,0) Q "RTN","SDEC50",71,0) ; "RTN","SDEC50",72,0) GETIEN(DFN,SDCLN,SDDT) ;get SDEC APPOINTMENT id "RTN","SDEC50",73,0) N SDF,SDI,SDNOD,SDR "RTN","SDEC50",74,0) Q:$G(DFN)="" "" "RTN","SDEC50",75,0) Q:$G(SDCLN)="" "" "RTN","SDEC50",76,0) Q:$G(SDDT)="" "" "RTN","SDEC50",77,0) S (SDF,SDI)=0 F S SDI=$O(^SDEC(409.84,"CPAT",DFN,SDI)) Q:SDI="" D Q:SDF=1 "RTN","SDEC50",78,0) .S SDNOD=$G(^SDEC(409.84,SDI,0)) "RTN","SDEC50",79,0) .Q:SDNOD="" "RTN","SDEC50",80,0) .S SDR=$$GETRES^SDECUTL(SDCLN) "RTN","SDEC50",81,0) .I $P(SDNOD,U,1)=SDDT,$P(SDNOD,U,7)=SDR S SDF=1 "RTN","SDEC50",82,0) Q $S(SDI'="":SDI,1:"") "RTN","SDEC50",83,0) ; "RTN","SDEC50",84,0) CONS(SDCL,DFN,SDDT) ;check for consult in file 44 "RTN","SDEC50",85,0) ; SDCL = (required) clinic IEN "RTN","SDEC50",86,0) ; DFN = (required) patient IEN "RTN","SDEC50",87,0) ; SDDT = (required) appointment time in FM format "RTN","SDEC50",88,0) N CONS,CSTAT,SDI,SDJ "RTN","SDEC50",89,0) S CONS="" "RTN","SDEC50",90,0) S SDI=0 F S SDI=$O(^SC(SDCL,"S",SDDT,1,SDI)) Q:SDI'>0 D Q:CONS'="" "RTN","SDEC50",91,0) .I $P($G(^SC(SDCL,"S",SDDT,1,SDI,0)),U,1)=DFN D "RTN","SDEC50",92,0) ..S CONS=$G(^SC(SDCL,"S",SDDT,1,SDI,"CONS")) "RTN","SDEC50",93,0) ..I +CONS D "RTN","SDEC50",94,0) ...S CSTAT=$P($G(^GMR(123,CONS,0)),U,12) "RTN","SDEC50",95,0) ...S:(CSTAT=1!(CSTAT=2)!(CSTAT=13)) CONS="" "RTN","SDEC50",96,0) Q CONS "RTN","SDEC50",97,0) ; "RTN","SDEC50",98,0) PCSTGET(SDECY,DFN,SDCL,SDBEG,SDEND) ;GET patient clinic status for a clinic for a given time frame - has the patient been seen by the given Clinic in the past 24 months "RTN","SDEC50",99,0) ;PCSTGET(SDECY,DFN,SDCL,SDBEG,SDEND) external parameter tag is in SDEC "RTN","SDEC50",100,0) ;INPUT: "RTN","SDEC50",101,0) ; DFN = (required) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates) "RTN","SDEC50",102,0) ; SDCL = (required) Clinic code - Pointer to HOSPITAL LOCATION file "RTN","SDEC50",103,0) ; SDBEG = (optional) Begin date in external format; defaults to 730 days previous (24 months) "RTN","SDEC50",104,0) ; SDEND = (optional) End date in external format; defaults to today "RTN","SDEC50",105,0) ;RETURN: "RTN","SDEC50",106,0) ; Successful Return: "RTN","SDEC50",107,0) ; a single entry in the global array indicating that patient has or has "RTN","SDEC50",108,0) ; not been seen. "RTN","SDEC50",109,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",110,0) ; Caught Exception Return: "RTN","SDEC50",111,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",112,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",113,0) ; Unexpected Exception Return: "RTN","SDEC50",114,0) ; Handled by the RPC Broker. "RTN","SDEC50",115,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC50",116,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC50",117,0) ; text back to the client. "RTN","SDEC50",118,0) N SDASD,SDECI,SDS,STOP,SDYN,SDSCL "RTN","SDEC50",119,0) ;N SDSNOD,SDSD,SDSTP,SDT,SDVSP,SDWL,SDYN alb/jsm 658 commented out since variables not used here "RTN","SDEC50",120,0) N X,Y,%DT,APIEN "RTN","SDEC50",121,0) S SDECI=0 "RTN","SDEC50",122,0) S SDECY="^TMP(""SDEC50"","_$J_",""PCSTGET"")" "RTN","SDEC50",123,0) K @SDECY "RTN","SDEC50",124,0) ; data header "RTN","SDEC50",125,0) S @SDECY@(0)="T00020RETURNCODE^T00100TEXT"_$C(30) "RTN","SDEC50",126,0) ;check for valid Patient "RTN","SDEC50",127,0) I '+DFN D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",128,0) I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",129,0) ;check for valid Clinic "RTN","SDEC50",130,0) I '+SDCL D ERR1^SDECERR(-1,"Invalid Clinic ID.",SDECI,SDECY) Q "RTN","SDEC50",131,0) I '$D(^SC(SDCL,0)) D ERR1^SDECERR(-1,"Invalid Clinic ID.",SDECI,SDECY) Q "RTN","SDEC50",132,0) ;check times "RTN","SDEC50",133,0) I $G(SDBEG)'="" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG="" "RTN","SDEC50",134,0) S:$G(SDBEG)="" SDBEG=$P($$FMADD^XLFDT($$NOW^XLFDT,-730),".",1) "RTN","SDEC50",135,0) I $G(SDEND)'="" S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND="" ;alb/sat 665 - remove Q "RTN","SDEC50",136,0) S:$G(SDEND)="" SDEND=$P($$NOW^XLFDT,".",1) "RTN","SDEC50",137,0) S STOP=$$CLSTOP(SDCL) ;get stop code number alb/jsm 658 updated to use new CLSTOP call "RTN","SDEC50",138,0) I '+STOP D ERR1^SDECERR(-1,"Clinic "_$P($G(^SC(+$G(SDCL),0)),U,1)_" does not have a STOP CODE NUMBER defined.",SDECI,SDECY) Q "RTN","SDEC50",139,0) S SDYN="NO" "RTN","SDEC50",140,0) ;look in SD WAIT LIST file for SDSCN stop code "RTN","SDEC50",141,0) ; alb/jsm 658 removed this block of code "RTN","SDEC50",142,0) ;S SDWL="" F S SDWL=$O(^SDWL(409.3,"B",DFN,SDWL)) Q:SDWL="" D Q:SDYN="YES" "RTN","SDEC50",143,0) ;.S SDSD=$P($G(^SDWL(409.3,SDWL,0)),U,23) "RTN","SDEC50",144,0) ;.I (SDSD'SDEND) D "RTN","SDEC50",145,0) ;..S SDSTP=$P($G(^SDWL(409.3,SDWL,"SDAPT")),U,4) "RTN","SDEC50",146,0) ;..I SDSTP=SDSCN S SDYN="YES" "RTN","SDEC50",147,0) ;.Q:SDYN="YES" "RTN","SDEC50",148,0) ;look in PATIENT Appointments "RTN","SDEC50",149,0) ; alb/jsm 658 updated to look at stop codes and check-out time "RTN","SDEC50",150,0) ;I SDYN'="YES" D "RTN","SDEC50",151,0) ;.S SDS="" F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" "RTN","SDEC50",152,0) ;..S SDSD=$$GET1^DIQ(2.98,SDS_","_DFN_",",.001,"I") "RTN","SDEC50",153,0) ;..I (SDSD'SDEND) D "RTN","SDEC50",154,0) ;...I $P($G(^DPT(DFN,"S",SDS,0)),U,1)=SDCL D "RTN","SDEC50",155,0) ;....S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",156,0) ;....Q:APIEN="" "RTN","SDEC50",157,0) ;....S:$G(^SC(SDCL,"S",SDS,1,+APIEN,"C"))'="" SDYN="YES" "RTN","SDEC50",158,0) ;S (SDS,SDSCL)="" F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" "RTN","SDEC50",159,0) ;.S SDSCL=$P($G(^DPT(DFN,"S",SDS,0)),U,1) "RTN","SDEC50",160,0) ;.I $$CLSTOP(SDSCL)=SDSCN D "RTN","SDEC50",161,0) ;..S APIEN=$$FIND^SDAM2(DFN,SDS,SDSCL) "RTN","SDEC50",162,0) ;..Q:APIEN="" "RTN","SDEC50",163,0) ;..S SDSCO=$P($G(^SC(SDSCL,"S",SDS,1,+APIEN,"C")),U,3) "RTN","SDEC50",164,0) ;..S:(SDSCO'="")&(SDSCO'SDEND) SDYN="YES" "RTN","SDEC50",165,0) D CHKPT "RTN","SDEC50",166,0) ;look in HOSPITAL LOCATION "RTN","SDEC50",167,0) ; alb/jsm 658 removing this block of code since we already loop through patient appointments for evaluation "RTN","SDEC50",168,0) ;I SDYN'="YES" D "RTN","SDEC50",169,0) ;.S SDS=SDBEG F S SDS=$O(^SC(SDCL,"S",SDS)) Q:SDS'>0 Q:SDS>SDEND D Q:SDYN="YES" "RTN","SDEC50",170,0) ;..S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",171,0) ;..Q:APIEN="" "RTN","SDEC50",172,0) ;..S:$P($G(^SC(SDCL,"S",SDS,1,APIEN,"C")),U,1)'="" SDYN="YES" "RTN","SDEC50",173,0) S SDECI=SDECI+1 S @SDECY@(SDECI)="0^"_SDYN_$C(30,31) "RTN","SDEC50",174,0) Q "RTN","SDEC50",175,0) ; "RTN","SDEC50",176,0) CLSTOP(CLINIC) ;Return clinic stop code for clinic "RTN","SDEC50",177,0) Q:$G(CLINIC)="" 0 ;Verify clinic is passed in "RTN","SDEC50",178,0) Q $P($G(^SC(CLINIC,0)),U,7) ;Return the stop code for the clinic "RTN","SDEC50",179,0) ; "RTN","SDEC50",180,0) CHKPT ; alb/jsm 658 added to be used by PCSTGET and PCST2GET "RTN","SDEC50",181,0) N SDSCO "RTN","SDEC50",182,0) S SDS=0 F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" ;alb/sat 665 - start with SDS=0 instead of "" "RTN","SDEC50",183,0) .S SDSCL=$P($G(^DPT(DFN,"S",SDS,0)),U,1) "RTN","SDEC50",184,0) .I $$CLSTOP(SDSCL)=STOP D "RTN","SDEC50",185,0) ..S APIEN=$$FIND^SDAM2(DFN,SDS,SDSCL) "RTN","SDEC50",186,0) ..Q:APIEN="" "RTN","SDEC50",187,0) ..S SDSCO=$P($P($G(^SC(SDSCL,"S",SDS,1,+APIEN,"C")),U,3),".",1) "RTN","SDEC50",188,0) ..S:(SDSCO'="")&(SDSCO'SDEND) SDYN="YES" "RTN","SDEC50",189,0) Q "RTN","SDEC50",190,0) ; "RTN","SDEC50",191,0) PCST2GET(SDECY,DFN,STOP,SDBEG,SDEND) ;GET patient clinic status for a service/specialty (clinic stop) for a given time frame - has the patient been seen any clinics with the given service/specialty (clinic stop) in the past 24 months "RTN","SDEC50",192,0) ;PCST2GET(SDECY,DFN,STOP,SDBEG,SDEND) external parameter tag is in SDEC "RTN","SDEC50",193,0) ;INPUT: "RTN","SDEC50",194,0) ; DFN = (required) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates) "RTN","SDEC50",195,0) ; STOP = (required) CLINIC STOP or Service/Specialty name - NAME from the SD WL SERVICE/SPECIALTY file - looks for 1st active "RTN","SDEC50",196,0) ; OR - Pointer to the CLINIC STOP file "RTN","SDEC50",197,0) ; SDBEG = (optional) Begin date in external format; defaults to 730 days previous (24 months) "RTN","SDEC50",198,0) ; SDEND = (optional) End date in external format; defaults to today "RTN","SDEC50",199,0) ;RETURN: "RTN","SDEC50",200,0) ; Successful Return: "RTN","SDEC50",201,0) ; a single entry in the global array indicating that patient has or has "RTN","SDEC50",202,0) ; not been seen. "RTN","SDEC50",203,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",204,0) ; Caught Exception Return: "RTN","SDEC50",205,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",206,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",207,0) ; Unexpected Exception Return: "RTN","SDEC50",208,0) ; Handled by the RPC Broker. "RTN","SDEC50",209,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC50",210,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC50",211,0) ; text back to the client. "RTN","SDEC50",212,0) N SDASD,SDF,SDSCN,SDECI,SDSNOD,SDSD,SDSTP,SDT,SDVSP,SDWL,SDYN "RTN","SDEC50",213,0) N H,WLSRVSP,X,Y,%DT "RTN","SDEC50",214,0) S WLSRVSP="" "RTN","SDEC50",215,0) S (SDF,SDECI,SDSCN)=0 "RTN","SDEC50",216,0) S SDECY="^TMP(""SDEC50"","_$J_",""PCST2GET"")" "RTN","SDEC50",217,0) K @SDECY "RTN","SDEC50",218,0) ; data header "RTN","SDEC50",219,0) S @SDECY@(0)="T00020RETURNCODE^T00100TEXT"_$C(30) "RTN","SDEC50",220,0) ;check for valid Patient "RTN","SDEC50",221,0) I '+DFN D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",222,0) I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",223,0) ;check for valid Service/Specialty "RTN","SDEC50",224,0) S STOP=$G(STOP) "RTN","SDEC50",225,0) ;I +SDSVSP,$D(^SDWL(409.31,SDSVSP,0)) S SDSCN=$P($G(^SDWL(409.31,SDSVSP,0)),U,1) S SDF=1 "RTN","SDEC50",226,0) I +STOP,'$D(^DIC(40.7,STOP,0)) D ERR1^SDECERR(-1,"Invalid stop code.",SDECI,SDECY) Q "RTN","SDEC50",227,0) I +STOP S SDSCN=$$GET1^DIQ(40.7,STOP_",",.01) S SDF=1 "RTN","SDEC50",228,0) I 'SDF,'+STOP D "RTN","SDEC50",229,0) .S H="" F S H=$O(^DIC(40.7,"B",STOP,H)) Q:H="" D Q:+STOP "RTN","SDEC50",230,0) ..I $P(^DIC(40.7,H,0),U,3)'="",$P(^DIC(40.7,H,0),U,3)<$$NOW^XLFDT() Q "RTN","SDEC50",231,0) ..S STOP=H "RTN","SDEC50",232,0) I '+STOP D ERR1^SDECERR(-1,"Invalid Stop code.",SDECI,SDECY) Q "RTN","SDEC50",233,0) ;check times "RTN","SDEC50",234,0) I $G(SDBEG)'="" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG="" "RTN","SDEC50",235,0) S:$G(SDBEG)="" SDBEG=$P($$FMADD^XLFDT($$NOW^XLFDT,-730),".",1) "RTN","SDEC50",236,0) I $G(SDEND)'="" S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND="" Q "RTN","SDEC50",237,0) S:$G(SDEND)="" SDEND=$P($$NOW^XLFDT,".",1) "RTN","SDEC50",238,0) S SDYN="NO" "RTN","SDEC50",239,0) ;D LOOKWL alb/jsm 658 removed only concerned with patient appts that have a check-out date/time "RTN","SDEC50",240,0) ;I SDYN'="YES" S SDCL=0 F S SDCL=$O(^SC(SDCL)) Q:SDCL'>0 D Q:SDYN="YES" "RTN","SDEC50",241,0) ;.S SDCLN=$$CLSTOP(SDCL) ; alb/jsm 658 updated to use CLSTOP $P($G(^SC(SDCL,0)),U,7) "RTN","SDEC50",242,0) ;.D:SDCLN=STOP LOOK "RTN","SDEC50",243,0) D CHKPT "RTN","SDEC50",244,0) S SDECI=SDECI+1 S @SDECY@(SDECI)="0^"_SDYN_$C(30,31) "RTN","SDEC50",245,0) Q "RTN","SDEC50",246,0) ; "RTN","SDEC50",247,0) LOOK ; "RTN","SDEC50",248,0) ;look in PATIENT Appointments "RTN","SDEC50",249,0) I SDYN'="YES" D "RTN","SDEC50",250,0) .S SDS="" F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" "RTN","SDEC50",251,0) ..S SDSD=$$GET1^DIQ(2.98,SDS_","_DFN_",",.001,"I") "RTN","SDEC50",252,0) ..I (SDSD'SDEND) D "RTN","SDEC50",253,0) ...I $P($G(^DPT(DFN,"S",SDS,0)),U,1)=SDCL D "RTN","SDEC50",254,0) ....S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",255,0) ....I APIEN'="",$G(^SC(SDCL,"S",SDS,1,APIEN,"C"))'="" S SDYN="YES" "RTN","SDEC50",256,0) ;look in HOSPITAL LOCATION "RTN","SDEC50",257,0) I SDYN'="YES" D "RTN","SDEC50",258,0) .S SDS=SDBEG F S SDS=$O(^SC(SDCL,"S",SDS)) Q:SDS'>0 Q:SDS>SDEND D Q:SDYN="YES" "RTN","SDEC50",259,0) ..S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",260,0) ..Q:APIEN="" "RTN","SDEC50",261,0) ..S:$P($G(^SC(SDCL,"S",SDS,1,APIEN,"C")),U,1)'="" SDYN="YES" "RTN","SDEC50",262,0) Q "RTN","SDEC50",263,0) ; "RTN","SDEC50",264,0) LOOKWL ; "RTN","SDEC50",265,0) ;look in SD WAIT LIST file for STOP stop code "RTN","SDEC50",266,0) S SDWL="" F S SDWL=$O(^SDWL(409.3,"B",DFN,SDWL)) Q:SDWL="" D Q:SDYN="YES" "RTN","SDEC50",267,0) .S SDSD=$P($G(^SDWL(409.3,SDWL,0)),U,23) "RTN","SDEC50",268,0) .I (SDSD'SDEND) D "RTN","SDEC50",269,0) ..S SDSTP=$P($G(^SDWL(409.3,SDWL,"SDAPT")),U,4) "RTN","SDEC50",270,0) ..I SDSTP=STOP S SDYN="YES" "RTN","SDEC50",271,0) .Q:SDYN="YES" "RTN","SDEC50",272,0) Q "RTN","SDEC50",273,0) ; "RTN","SDEC50",274,0) PCSGET(SDECY,SDSVSP,SDCL) ;GET clinics for a service/specialty (clinic stop) ;alb/sat 658 add SDCL "RTN","SDEC50",275,0) ;PCSGET(SDECY,SDSVSP) external parameter tag is in SDEC "RTN","SDEC50",276,0) ;INPUT: "RTN","SDEC50",277,0) ; SDSVSP = (required) Service/Specialty name - NAME from the SD WL SERVICE/SPECIALTY file - looks for 1st active "RTN","SDEC50",278,0) ; OR - Pointer to the SD WL SERVICE/SPECIALTY file "RTN","SDEC50",279,0) ;RETURN: "RTN","SDEC50",280,0) ; Successful Return: "RTN","SDEC50",281,0) ; global array containing Clinic IEN and Name of matching Hospital Locations "RTN","SDEC50",282,0) ; CLINSTOP - pointer to CLINIC STOP file 40.7 "RTN","SDEC50",283,0) ; CLINIEN - pointer to the HOSPITAL LOCATION file 44 "RTN","SDEC50",284,0) ; CLINNAME - NAME from the HOSPITAL LOCATION file "RTN","SDEC50",285,0) ; Caught Exception Return: "RTN","SDEC50",286,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",287,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",288,0) ; Unexpected Exception Return: "RTN","SDEC50",289,0) ; Handled by the RPC Broker. "RTN","SDEC50",290,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC50",291,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC50",292,0) ; text back to the client. "RTN","SDEC50",293,0) N SDASD,SDSCN,SDECI,SDSNOD,SDSD,SDSTP,SDT,SDVSP,SDWL "RTN","SDEC50",294,0) N H,WLSRVSP,X,Y "RTN","SDEC50",295,0) S WLSRVSP="" "RTN","SDEC50",296,0) S (SDECI,SDSCN)=0 "RTN","SDEC50",297,0) S SDECY="^TMP(""SDEC50"","_$J_",""PCSGET"")" "RTN","SDEC50",298,0) K @SDECY "RTN","SDEC50",299,0) ; data header "RTN","SDEC50",300,0) S @SDECY@(0)="T00030CLINSTOP^T00030CLINIEN^T00030CLINNAME"_$C(30) "RTN","SDEC50",301,0) ;check clinic ;alb/sat 658 "RTN","SDEC50",302,0) S SDCL=$G(SDCL) "RTN","SDEC50",303,0) I SDCL'="",$D(^SC(SDCL,0)) D "RTN","SDEC50",304,0) .S SDSVSP=$$GET1^DIQ(44,SDCL_",",8,"I") "RTN","SDEC50",305,0) ;check for valid Service/Specialty "RTN","SDEC50",306,0) S SDSVSP=$G(SDSVSP) "RTN","SDEC50",307,0) I SDSVSP="" D ERR1^SDECERR(-1,"Service/Specialty ID required",SDECI,SDECY) Q "RTN","SDEC50",308,0) I +SDSVSP,$D(^SDWL(409.31,+SDSVSP,0)) S SDSCN=$P($G(^SDWL(409.31,SDSVSP,0)),U,1) "RTN","SDEC50",309,0) I '+SDSVSP D "RTN","SDEC50",310,0) .S H=0 F S H=$O(^DIC(40.7,"B",SDSVSP,H)) Q:H="" D Q:SDSCN'=0 "RTN","SDEC50",311,0) ..I $P(^DIC(40.7,H,0),U,3)'="",$P(^DIC(40.7,H,0),U,3)<$$NOW^XLFDT() Q "RTN","SDEC50",312,0) ..S SDSCN=H "RTN","SDEC50",313,0) I '+SDSCN D ERR1^SDECERR(-1,"Invalid Service/Specialty.",SDECI,SDECY) Q "RTN","SDEC50",314,0) S SDCL=0 F S SDCL=$O(^SC(SDCL)) Q:SDCL'>0 D "RTN","SDEC50",315,0) .S SDCLN=$P($G(^SC(SDCL,0)),U,7) "RTN","SDEC50",316,0) .I $$GET1^DIQ(44,SDCL_",",2505,)'="",$$GET1^DIQ(44,SDCL_",",2506)="" Q ;only active "RTN","SDEC50",317,0) .I SDCLN=SDSCN S SDECI=SDECI+1 S @SDECY@(SDECI)=SDSCN_U_SDCL_U_$P($G(^SC(SDCL,0)),U,1)_$C(30) "RTN","SDEC50",318,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC50",319,0) Q "RTN","SDEC54") 0^17^B194101898^B193834229 "RTN","SDEC54",1,0) SDEC54 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDEC54",2,0) ;;5.3;Scheduling;**627,642,658,665**;Aug 13, 1993;Build 14 "RTN","SDEC54",3,0) ; "RTN","SDEC54",4,0) ;Reference is made to ICR #6185 "RTN","SDEC54",5,0) Q "RTN","SDEC54",6,0) ; "RTN","SDEC54",7,0) ;DATE RANGE FOR INPUT "RTN","SDEC54",8,0) SUMMGET(SDECRET,SDBEG,SDEND,USER,LSUB,MAXREC) ;GET Audit Summary for given date range "RTN","SDEC54",9,0) N CLOSED,COUNT,DFN,DISPDT,DISPU,FNUM,NAMEPART,PROVNAME,RET,WLDATA,WLIEN,X,Y,%DT "RTN","SDEC54",10,0) N APPO,ARIEN,SDDATA,SDEC54,SDECI,SDECY,SDNUM,SDTMP,SDTOT,SDDEMO,SDSUB,SDT,SDU,USER1 ;alb/sat 642 added APPO "RTN","SDEC54",11,0) S SDECRET="^TMP(""SDEC54"","_$J_",""SUMMGET"")" "RTN","SDEC54",12,0) K @SDECRET "RTN","SDEC54",13,0) S SDSUB="" "RTN","SDEC54",14,0) S SDEC54=0 "RTN","SDEC54",15,0) ; 1 2 3 4 5 6 "RTN","SDEC54",16,0) S SDTMP="T00030REQUESTTYPE^T00030DFN^T00030NAME^T00030DATE^T00030USERIEN^T00030USERNAME" "RTN","SDEC54",17,0) ; 7 8 9 10 11 "RTN","SDEC54",18,0) S SDTMP=SDTMP_"^T00030DATE1^T00030PROVIEN^T00030PROVNAME^T00030PCONTACT^T00030APPT_SCHED_DATE" "RTN","SDEC54",19,0) ; 12 13 14 15 "RTN","SDEC54",20,0) S SDTMP=SDTMP_"^T00030DATE2^T00030CLINIEN^T00030CLINNAME^T00030ACTIVITY^T00030IEN" "RTN","SDEC54",21,0) S SDTMP=SDTMP_"^T00030LASTSUB^T00030NUMBER^T00030TOTAL^T00030MRTC" "RTN","SDEC54",22,0) S @SDECRET@(SDEC54)=SDTMP_$C(30) "RTN","SDEC54",23,0) ;check begin date (optional) "RTN","SDEC54",24,0) I $G(SDBEG)'="" S %DT="" S X=$P($G(SDBEG),"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101 "RTN","SDEC54",25,0) I $G(SDBEG)="" S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101 "RTN","SDEC54",26,0) ;check end date (optional) "RTN","SDEC54",27,0) I $G(SDEND)'="" S %DT="" S X=$P($G(SDEND),"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231 "RTN","SDEC54",28,0) I $G(SDEND)="" S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231 "RTN","SDEC54",29,0) ;check user "RTN","SDEC54",30,0) S USER=$G(USER) "RTN","SDEC54",31,0) I '$D(^VA(200,+USER,0)) S USER="" "RTN","SDEC54",32,0) ;check LSUB | | ... "RTN","SDEC54",33,0) S LSUB=$G(LSUB) "RTN","SDEC54",34,0) S SDTOT=+$P(LSUB,"|",1) "RTN","SDEC54",35,0) ;check MAXREC "RTN","SDEC54",36,0) S MAXREC=$G(MAXREC) S:'+MAXREC MAXREC=9999999 ;alb/sat 665 - remove limits "RTN","SDEC54",37,0) ;get SDEC APPOINTMENT entries with DATE APPT MADE in date range ;alb/sat 642 "RTN","SDEC54",38,0) D APPO^SDEC54A(.APPO,SDBEG,SDEND,USER) ;artf19425 "RTN","SDEC54",39,0) ;get SDEC APPT REQUEST data "RTN","SDEC54",40,0) I (LSUB="")!($P(LSUB,"|",2)="APPT") D APPT "RTN","SDEC54",41,0) G:SDEC54'0 S SDTMP=$P(@SDECRET@(SDEC54),$C(30),1) S $P(SDTMP,U,19)=(SDTOT+SDEC54) S:SDSUB'="" $P(SDTMP,U,17)=SDSUB S @SDECRET@(SDEC54)=SDTMP_$C(30) "RTN","SDEC54",70,0) S @SDECRET@(SDEC54)=@SDECRET@(SDEC54)_$C(31) "RTN","SDEC54",71,0) Q "RTN","SDEC54",72,0) ; "RTN","SDEC54",73,0) EWL ; get SD WAIT LIST data "RTN","SDEC54",74,0) ;get WAIT LIST data "RTN","SDEC54",75,0) D WLINIT "RTN","SDEC54",76,0) S RET="^TMP(""SDEC"","_$J_")" "RTN","SDEC54",77,0) S NAMEPART="" "RTN","SDEC54",78,0) K @RET "RTN","SDEC54",79,0) S CLOSED=1 "RTN","SDEC54",80,0) S FNUM=$$FNUM^SDECWL "RTN","SDEC54",81,0) ;S WLIEN=0 F S WLIEN=$O(^SDWL(409.3,"C",DUZ(2),WLIEN)) Q:'WLIEN D "RTN","SDEC54",82,0) S SDT=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3)-.0001,1:$P(SDBEG,".",1)) "RTN","SDEC54",83,0) F S SDT=$O(^SDWL(409.3,"AC",SDT)) Q:SDT'>0 Q:$P(SDT,".",1)>SDEND D I SDEC54'0 D EWL1 I SDEC54'0 D I SDEC54'0 Q:$P(SDT,".",1)>SDEND D I SDEC54'0 D APPT1 I SDEC54'0 D I SDEC54'(MAXREC-1) "RTN","SDEC54",209,0) .F STAT=OSACT,OSPEND D Q:SDECI>(MAXREC-1) "RTN","SDEC54",210,0) ..Q:STAT="" "RTN","SDEC54",211,0) ..Q:($P(LSUB,"|",4)'="")&($P(LSUB,"|",4)'=STAT) "RTN","SDEC54",212,0) ..S DRQ=$S($P(LSUB,"|",5)'="":$P(LSUB,"|",5)-.0001,1:SDBEG-1) "RTN","SDEC54",213,0) ..F S DRQ=$O(^GMR(123,"AE",SVC,STAT,DRQ)) Q:DRQ="" Q:$P(DRQ,".",1)>SDEND D REQGET1 Q:SDECI>(MAXREC-1) "RTN","SDEC54",214,0) Q "RTN","SDEC54",215,0) REQGET1 ; "RTN","SDEC54",216,0) N SDSTATF "RTN","SDEC54",217,0) S SDGMR=$S($P(LSUB,"|",6)'="":$P(LSUB,"|",6),1:0) "RTN","SDEC54",218,0) S LSUB="" "RTN","SDEC54",219,0) F S SDGMR=$O(^GMR(123,"AE",SVC,STAT,DRQ,SDGMR)) Q:SDGMR="" D I SDEC54'0 D "RTN","SDEC54",223,0) ..S SDRPA0=$G(^GMR(123,SDGMR,40,SDRPA,0)) ;ICR 6185 "RTN","SDEC54",224,0) ..I USER="",$P(SDRPA0,U,4)'=USER Q "RTN","SDEC54",225,0) ..I ($P(SDRPA0,U,2)=SDCAN)!($P(SDRPA0,U,2)=SDSCHED) D "RTN","SDEC54",226,0) ...S SDCANL=$S(SDCANL'="":SDCANL_"|",1:"")_SDGMR_";;"_SDRPA_";;"_$$FMTE^XLFDT($P(SDRPA0,U,1)) "RTN","SDEC54",227,0) ...S SDCANL=SDCANL_";;"_$$GET1^DIQ(123.02,SDRPA_","_SDGMR_",",1)_";;"_$P(SDRPA0,U,5)_";;"_$P($G(^VA(200,+$P(SDRPA0,U,5),0)),U,1) "RTN","SDEC54",228,0) .I SDCANL'="" D "RTN","SDEC54",229,0) ..S DFN=$$GET1^DIQ(123,SDGMR_",",.02,"I") "RTN","SDEC54",230,0) ..;collect demographics "RTN","SDEC54",231,0) ..S NAME=$$GET1^DIQ(2,DFN_",",.01) ;SDDEMO("NAME") "RTN","SDEC54",232,0) ..K SDDATA,SDMSG "RTN","SDEC54",233,0) ..;SDCANL= ;; ;; ;; ;; "RTN","SDEC54",234,0) ..S SDTMP="CONSULT"_U_DFN_U_NAME_U_$$GET1^DIQ(123,SDGMR_",",3,"I")_U_U ;6 "RTN","SDEC54",235,0) ..S SDTMP=SDTMP_U_U_U_U_U ;11 "RTN","SDEC54",236,0) ..S SDTMP=SDTMP_U_U_U_U_SDCANL_U_SDGMR_U_U_(SDTOT+SDEC54+1) ;18 "RTN","SDEC54",237,0) ..S SDEC54=SDEC54+1 S @SDECRET@(SDEC54)=SDTMP_$C(30) "RTN","SDEC54",238,0) Q "RTN","SDEC54",239,0) REQAPPS ;get recall appointments made ;alb/sat 642 "RTN","SDEC54",240,0) N APPT,SDU,SDID,SDCNT,SDATA,SDECY,SDT,SDTMP "RTN","SDEC54",241,0) S SDT=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3),1:"") "RTN","SDEC54",242,0) F S SDT=$O(APPO("C",SDT)) Q:SDT="" D I SDEC54'0 Q:$P(SDT,".",1)>SDEND D I SDEC54'0 Q:(USER'="")&(SDU'=USER) D RECALL1 I SDEC54'0 D I SDEC54' | ... "RTN","SDEC54A",60,0) S LSUB=$G(LSUB) "RTN","SDEC54A",61,0) S SDTOT=+$P(LSUB,"|",1) "RTN","SDEC54A",62,0) ;check MAXREC "RTN","SDEC54A",63,0) S MAXREC=$G(MAXREC) S:'+MAXREC MAXREC=100 "RTN","SDEC54A",64,0) ; "RTN","SDEC54A",65,0) S SDJ=$S($P(LSUB,"|",2)'="":$P(LSUB,"|",2)-.0001,1:SDBEG) "RTN","SDEC54A",66,0) F S SDJ=$O(^SDEC(409.84,"AD",SDJ)) Q:SDJ'>0 Q:SDJ="" Q:$P(SDJ,".",1)>$P(SDEND,".",1) D I SDECI'0 D I SDECI'0 S SDTMP=$P(@SDECY@(SDECI),$C(30),1) S $P(SDTMP,U,16)=(SDTOT+SDECI) S:SDSUB'="" $P(SDTMP,U,14)=SDSUB S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDEC54A",95,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC54A",96,0) Q "RTN","SDEC54A",97,0) ; "RTN","SDEC54A",98,0) CKDT(DATE,BEG,END) ;check date range "RTN","SDEC54A",99,0) ;RETURN "RTN","SDEC54A",100,0) ; 0=out of range "RTN","SDEC54A",101,0) ; 1=in range "RTN","SDEC54A",102,0) N X,Y,%DT "RTN","SDEC54A",103,0) I $G(BEG)="",$G(END)="" Q 1 "RTN","SDEC54A",104,0) I $G(DATE)="" Q 1 "RTN","SDEC54A",105,0) S %DT="T" S X=$P(DATE,"@",1) D ^%DT S DATE=Y "RTN","SDEC54A",106,0) I DATE=-1 Q 0 "RTN","SDEC54A",107,0) Q:DATEEND 0 "RTN","SDEC54A",109,0) Q 1 "RTN","SDEC54A",110,0) ; "RTN","SDEC54A",111,0) APPO(APPO,SDBEG,SDEND,USER) ;get appointments for date range and user ;alb/sat 642 "RTN","SDEC54A",112,0) N SDCNT,SDI,SDJ,SDNOD,SDNOD2,SDTYP,SDTYPID "RTN","SDEC54A",113,0) K APPO "RTN","SDEC54A",114,0) S USER=$G(USER) "RTN","SDEC54A",115,0) S SDI=SDBEG-1 F S SDI=$O(^SDEC(409.84,"AC",SDI)) Q:SDI="" Q:SDI>SDEND D "RTN","SDEC54A",116,0) .S SDJ="" F S SDJ=$O(^SDEC(409.84,"AC",SDI,SDJ)) Q:SDJ="" D "RTN","SDEC54A",117,0) ..S SDNOD=$G(^SDEC(409.84,SDJ,0)) "RTN","SDEC54A",118,0) ..I +USER,$P(SDNOD,U,8)'=USER Q ;check user match "RTN","SDEC54A",119,0) ..Q:($P(SDNOD,U,12)'="")!($P(SDNOD,U,23)'="") ;don't include cancel or no-show "RTN","SDEC54A",120,0) ..S SDNOD2=$G(^SDEC(409.84,SDJ,2)) "RTN","SDEC54A",121,0) ..S SDTYPID=$P($P(SDNOD2,U,1),";",1) "RTN","SDEC54A",122,0) ..S SDTYP=$P($P(SDNOD2,U,1),";",2) S SDTYP=$S(SDTYP="SDEC(409.85,":"A",SDTYP="GMR(123,":"C",SDTYP="SDWL(409.3,":"E",SDTYP="SD(403.5,":"R",1:"") "RTN","SDEC54A",123,0) ..Q:SDTYP="" "RTN","SDEC54A",124,0) ..S (SDCNT,APPO(SDTYP,$P(SDNOD,U,9),$P(SDNOD,U,8)))=$G(APPO(SDTYP,$P(SDNOD,U,9),$P(SDNOD,U,8)))+1 "RTN","SDEC54A",125,0) ..S APPO(SDTYP,$P(SDNOD,U,9),$P(SDNOD,U,8),SDCNT)=SDTYPID "RTN","SDEC54A",126,0) Q "RTN","SDEC54A",127,0) ; "RTN","SDEC54A",128,0) APPTPC(SDEC54,SDECRET,SDTOT,SDBEG,SDEND,USER,MAXREC,LSUB,SDSUB) ;get APPT patient contacts ;alb/sat 642 "RTN","SDEC54A",129,0) N PARENT,SDARR,SDID,SDIEN,SDATA,SDECY,SDPC,SDT,SDTMP,SDU "RTN","SDEC54A",130,0) S SDEC54=$G(SDEC54,0) "RTN","SDEC54A",131,0) Q:$G(SDECRET)="" "RTN","SDEC54A",132,0) S SDTOT=$G(SDTOT,0) "RTN","SDEC54A",133,0) S SDBEG=$P($G(SDBEG),".",1) S:SDBEG="" SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101 "RTN","SDEC54A",134,0) S SDEND=$P($G(SDEND),".",1) S:SDEND="" SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231 "RTN","SDEC54A",135,0) S USER=$G(USER) "RTN","SDEC54A",136,0) S SDT=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3),1:$P(SDBEG,".",1)) "RTN","SDEC54A",137,0) F S SDT=$O(^SDEC(409.85,"AD",SDT)) Q:SDT="" D I SDEC54'5 "RTN","SDEC56",94,0) ...S SDCL=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0) "RTN","SDEC56",95,0) ...S LASTSUB="" "RTN","SDEC56",96,0) ...F S SDCL=$O(^SC("B",SDECNAM,SDCL)) Q:SDCL="" D GET1 I SDCNT'0 D I SDCNT'0)&('+SDMORE) $P(@SDECY@(SDECI),U,32)="" "RTN","SDEC56",110,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC56",111,0) Q "RTN","SDEC56",112,0) GET1 ;get1 record "RTN","SDEC56",113,0) N FND "RTN","SDEC56",114,0) K SDDATA,SDMSG "RTN","SDEC56",115,0) S SDFIELDS=".01;1;2;3;3.5;8;9;9.5;16;23;29;31;50.01;1912;1913;2002;2500;2502;2505;2506;2507" "RTN","SDEC56",116,0) D GETS^DIQ(44,SDCL_",",SDFIELDS,"IE","SDDATA","SDMSG") "RTN","SDEC56",117,0) S SDA="SDDATA(44,"""_SDCL_","")" "RTN","SDEC56",118,0) Q:@SDA@(2,"I")'="C" "RTN","SDEC56",119,0) Q:+$G(@SDA@(50.01,"I"))=1 ;OOS? "RTN","SDEC56",120,0) S SDTMP="" "RTN","SDEC56",121,0) S $P(SDTMP,U,1)=SDCL ;clinic ID "RTN","SDEC56",122,0) S $P(SDTMP,U,2)=@SDA@(.01,"E") ;clinic name "RTN","SDEC56",123,0) S $P(SDTMP,U,33)=@SDA@(1,"E") ;clinic abbreviation "RTN","SDEC56",124,0) I SDF="ABBR",$P(SDTMP,U,33)'="" S $P(SDTMP,U,2)=$P(SDTMP,U,33)_" "_$P(SDTMP,U,2) "RTN","SDEC56",125,0) I SDF="FULL",PNAME'="" S FND=$$CHK^SDEC32(PNAME,SDCL) Q:+FND "RTN","SDEC56",126,0) S $P(SDTMP,U,3)=@SDA@(2,"E") ;clinic type "RTN","SDEC56",127,0) S $P(SDTMP,U,4)=@SDA@(3,"I") ;institution ID "RTN","SDEC56",128,0) S $P(SDTMP,U,5)=@SDA@(3,"E") ;institution name "RTN","SDEC56",129,0) S $P(SDTMP,U,6)=@SDA@(3.5,"I") ;division ID "RTN","SDEC56",130,0) S $P(SDTMP,U,7)=@SDA@(3.5,"E") ;division NAME "RTN","SDEC56",131,0) S:@SDA@(8,"I") $P(SDTMP,U,8)=$$GET1^DIQ(40.7,@SDA@(8,"I"),1) ;stop code ID ;alb/sat 651 "RTN","SDEC56",132,0) S $P(SDTMP,U,9)=@SDA@(8,"E") ;stop code number "RTN","SDEC56",133,0) S $P(SDTMP,U,10)=@SDA@(9,"E") ;service "RTN","SDEC56",134,0) S $P(SDTMP,U,11)=@SDA@(9.5,"I") ;treating specialty ID "RTN","SDEC56",135,0) S $P(SDTMP,U,12)=@SDA@(9.5,"E") ;treating specialty name "RTN","SDEC56",136,0) S $P(SDTMP,U,13)=@SDA@(16,"I") ;default provider ID "RTN","SDEC56",137,0) S $P(SDTMP,U,14)=@SDA@(16,"E") ;default provider name "RTN","SDEC56",138,0) S $P(SDTMP,U,15)=@SDA@(23,"I") ;agency ID "RTN","SDEC56",139,0) S $P(SDTMP,U,16)=@SDA@(23,"E") ;agency name "RTN","SDEC56",140,0) S $P(SDTMP,U,17)=+@SDA@(1912,"E") ;length of appointment "RTN","SDEC56",141,0) S $P(SDTMP,U,18)=@SDA@(1913,"I") ;variable appointment "RTN","SDEC56",142,0) S $P(SDTMP,U,19)=@SDA@(2500,"E") ;prohibit access to clinic "RTN","SDEC56",143,0) S $P(SDTMP,U,20)=@SDA@(2502,"E") ;non-count clinic? "RTN","SDEC56",144,0) S $P(SDTMP,U,21)=@SDA@(2505,"E") ;inactivate date "RTN","SDEC56",145,0) S $P(SDTMP,U,22)=@SDA@(2506,"E") ;reactivate date "RTN","SDEC56",146,0) S $P(SDTMP,U,23)=@SDA@(2507,"I") ;default appointment type ID "RTN","SDEC56",147,0) S $P(SDTMP,U,24)=@SDA@(2507,"E") ;default appointment type name "RTN","SDEC56",148,0) S $P(SDTMP,U,25)=$$GETPRV(SDCL) ;providers - IEN ;; NAME ;; DEF? | ... "RTN","SDEC56",149,0) S $P(SDTMP,U,26)=@SDA@(29,"I") ;clinic services resource ID "RTN","SDEC56",150,0) S $P(SDTMP,U,27)=@SDA@(29,"E") ;clinic services resource name "RTN","SDEC56",151,0) S $P(SDTMP,U,28)=@SDA@(31,"I") ;clinic group (reports) ID "RTN","SDEC56",152,0) S $P(SDTMP,U,29)=@SDA@(31,"E") ;clinic group (reports) name "RTN","SDEC56",153,0) S SDAUD=$O(^DIA(44,"B",SDCL,0)) "RTN","SDEC56",154,0) S SDAUDNOD=$G(^DIA(44,+SDAUD,0)) "RTN","SDEC56",155,0) I $P(SDAUDNOD,U,5)="A" S $P(SDTMP,U,30)=$$FMTE^XLFDT($P(SDAUDNOD,U,2),"M") "RTN","SDEC56",156,0) S $P(SDTMP,U,31)=@SDA@(2002,"E") ;max # days for future booking "RTN","SDEC56",157,0) S $P(SDTMP,U,32)="" ;LASTSUB setup after the loop in last record "RTN","SDEC56",158,0) ; "RTN","SDEC56",159,0) S SDARR(SDF="FULL",$P(SDTMP,U,2))=SDTMP,SDCNT=SDCNT+1 "RTN","SDEC56",160,0) ;S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDEC56",161,0) Q "RTN","SDEC56",162,0) ; "RTN","SDEC56",163,0) GETPRV(SDCL) ;get providers from PROVIDER multiple in file 44 "RTN","SDEC56",164,0) ;INPUT: "RTN","SDEC56",165,0) ; SDCL - clinic ID pointer to HOSPITAL LOCATION file 44 "RTN","SDEC56",166,0) ;RETURN: "RTN","SDEC56",167,0) ; PROVIDERS - Providers separated by pipe. "RTN","SDEC56",168,0) ; Each pipe piece contains the following ;; pieces: "RTN","SDEC56",169,0) ; 1. provider ID pointer to NEW PERSON FILE 200 "RTN","SDEC56",170,0) ; 2. provider NAME from NEW PERSON file "RTN","SDEC56",171,0) ; 3. default provider? 'NO' 'YES' "RTN","SDEC56",172,0) N SDI,SDNOD,SDRET "RTN","SDEC56",173,0) S SDRET="" "RTN","SDEC56",174,0) S SDI=0 F S SDI=$O(^SC(SDCL,"PR",SDI)) Q:SDI'>0 D "RTN","SDEC56",175,0) .S SDNOD=$G(^SC(SDCL,"PR",SDI,0)) "RTN","SDEC56",176,0) .S SDRET=$S(SDRET'="":SDRET_"|",1:"")_$P(SDNOD,U,1)_";;"_$$GET1^DIQ(200,$P(SDNOD,U,1)_",",.01)_";;"_$S($P(SDNOD,U,2)=1:"YES",1:"NO") "RTN","SDEC56",177,0) Q SDRET "RTN","SDEC56",178,0) ; "RTN","SDEC56",179,0) GETSUB(TXT) ; "RTN","SDEC56",180,0) Q $$GETSUB^SDECU(TXT) ;alb/sat 665 "RTN","SDEC57") 0^22^B110596286^B109929639 "RTN","SDEC57",1,0) SDEC57 ;ALB/SAT/JSM - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDEC57",2,0) ;;5.3;Scheduling;**627,642,658,665**;Aug 13, 1993;Build 14 "RTN","SDEC57",3,0) ; "RTN","SDEC57",4,0) Q "RTN","SDEC57",5,0) ;APPSLOTS - return appt slots and availability "RTN","SDEC57",6,0) ;SDECY=Return global array "RTN","SDEC57",7,0) ; FM DATE ^ SLOT START TIME ^ SLOT STOP TIME ^ AVAILABILITY CODE "RTN","SDEC57",8,0) ; Availability codes 0-9,j-z for 0 to 26 available appts, A-W for overbooks 1-23 "RTN","SDEC57",9,0) ;SDECRES=Resource name "RTN","SDEC57",10,0) ;SDECSTRT=Start date/time "RTN","SDEC57",11,0) ;SDECEND=End date/time "RTN","SDEC57",12,0) APPSLOTS(SDECY,SDECRES,SDECSTART,SDECEND) ;GET Create Assigned Slot Schedule "RTN","SDEC57",13,0) N CNT "RTN","SDEC57",14,0) N SDECAD,SDECALO,SDECBS,SDECDEP,SDECERR,SDECI,SDECIEN,SDECK,SDECL,SDECNEND,SDECNOD "RTN","SDEC57",15,0) N SDECNOT,SDECNSTART,SDECPEND,SDECQ,SDECRESD,SDECRESN,SDECS,SDECSUBCD,SDECTMP "RTN","SDEC57",16,0) N SDAB,SDECTYPE,SDECTYPED,SDECZ "RTN","SDEC57",17,0) N %DT,X,Y "RTN","SDEC57",18,0) S SDECERR="" "RTN","SDEC57",19,0) S SDECY="^TMP(""SDEC57"","_$J_",""APPSLOTS"")" "RTN","SDEC57",20,0) K @SDECY "RTN","SDEC57",21,0) S SDECALO=0,SDECI=0 "RTN","SDEC57",22,0) S @SDECY@(SDECI)="T00030DATE^T00030START_TIME^T00030END_TIME^I00010AVAILABILITY"_$C(30) "RTN","SDEC57",23,0) S %DT="T",X=$P($P(SDECSTART,"@",1),".",1) D ^%DT "RTN","SDEC57",24,0) S SDECSTART=Y "RTN","SDEC57",25,0) S %DT="T",X=$P($P(SDECEND,"@",1),".",1) D ^%DT "RTN","SDEC57",26,0) S SDECEND=Y "RTN","SDEC57",27,0) ;validate SDECRES "RTN","SDEC57",28,0) S SDECRES=$G(SDECRES) "RTN","SDEC57",29,0) I SDECRES']"" S @SDECY@(1)="-1^Resource ID is required"_$C(30)_$C(31) Q "RTN","SDEC57",30,0) I +SDECRES,'$D(^SDEC(409.831,+SDECRES,0)) S @SDECY@(1)="-1^Resource ID is required"_$C(30)_$C(31) Q "RTN","SDEC57",31,0) I '+SDECRES S SDECRES=$O(^SDEC(409.831,"B",SDECRES,0)) I '+SDECRES S @SDECY@(1)="-1^Invalid Resource ID"_$C(30)_$C(31) Q "RTN","SDEC57",32,0) S SDAB="^TMP("_$J_",""SDEC57"",""BLKS"")" "RTN","SDEC57",33,0) K @SDAB "RTN","SDEC57",34,0) D GETSLOTS(SDAB,SDECRES,SDECSTART,SDECEND) "RTN","SDEC57",35,0) ;Get Access Type IDs "RTN","SDEC57",36,0) N SD1,SD2,SD3,SD4,SDI,SDNOD,SDENDDT "RTN","SDEC57",37,0) N SDSTRTDT,SDSLOTS,SDSTOPTM,SDSTRTTM "RTN","SDEC57",38,0) S SDI=0 F S SDI=$O(@SDAB@(SDI)) Q:SDI'>0 D "RTN","SDEC57",39,0) .S SDNOD=@SDAB@(SDI) "RTN","SDEC57",40,0) .S SD1=$P(SDNOD,U,2) ;start DT "RTN","SDEC57",41,0) .S SD2=$P(SDNOD,U,3) ;end DT "RTN","SDEC57",42,0) .S SD3=+$P(SDNOD,U,4) ;slots "RTN","SDEC57",43,0) .S SD4=$P(SDNOD,U,5) ;access type(1=avail,2=not avail,3=canc) "RTN","SDEC57",44,0) .S SDSTRTDT=$P(SD1,".") "RTN","SDEC57",45,0) .S SDENDDT=$P(SD2,".") "RTN","SDEC57",46,0) .S SDSTRTTM=$E($P(SD1_"0000",".",2),1,4) "RTN","SDEC57",47,0) .S SDSTOPTM=$E($P(SD2_"0000",".",2),1,4) "RTN","SDEC57",48,0) .S SDSLOTS=$P(SDNOD,U,4) "RTN","SDEC57",49,0) .S SDSLOTS=$S(SDSLOTS=" ":"",1:SDSLOTS) "RTN","SDEC57",50,0) .S SDSLOTS=$S(SD4=2:"",SD4=3:"X",1:SDSLOTS) "RTN","SDEC57",51,0) .S SDECI=SDECI+1,@SDECY@(SDECI)=SDSTRTDT_U_SDSTRTTM_U_SDSTOPTM_U_SDSLOTS_$C(30) "RTN","SDEC57",52,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC57",53,0) K @SDAB "RTN","SDEC57",54,0) Q "RTN","SDEC57",55,0) ; "RTN","SDEC57",56,0) GETSLOTS(SDAB,SDECRES,SDECSTART,SDECEND) ;load SDEC ACCESS BLOCKS from file 44 "RTN","SDEC57",57,0) N SDCL,SDI,SDJ "RTN","SDEC57",58,0) S SDECRES=$G(SDECRES) Q:SDECRES="" "RTN","SDEC57",59,0) I +SDECRES,'$D(^SDEC(409.831,+SDECRES,0)) Q "RTN","SDEC57",60,0) I '+SDECRES S SDECRES=$O(^SDEC(409.831,"B",SDECRES,0)) "RTN","SDEC57",61,0) Q:'SDECRES "RTN","SDEC57",62,0) S %DT="T",X=$P($P(SDECSTART,"@",1),".",1) D ^%DT "RTN","SDEC57",63,0) Q:Y=-1 "RTN","SDEC57",64,0) S SDECSTART=Y "RTN","SDEC57",65,0) S %DT="T",X=$P($P(SDECEND,"@",1),".",1) D ^%DT "RTN","SDEC57",66,0) Q:Y=-1 "RTN","SDEC57",67,0) S SDECEND=Y "RTN","SDEC57",68,0) S SDCL=$$GET1^DIQ(409.831,SDECRES_",",.04,"I") "RTN","SDEC57",69,0) Q:SDCL="" "RTN","SDEC57",70,0) S SDI=$$FMADD^XLFDT(SDECSTART,-1) "RTN","SDEC57",71,0) F S SDI=$$FMADD^XLFDT(SDI,1) Q:SDI>$P(SDECEND,".",1) D "RTN","SDEC57",72,0) .I ($O(^SC(SDCL,"T",0))="")!($O(^SC(SDCL,"T",0))>SDI) Q "RTN","SDEC57",73,0) .I $$GET1^DIQ(44,SDCL_",",1918.5,"I")'="Y",$D(^HOLIDAY("B",SDI)) Q ;do not schedule on holidays "RTN","SDEC57",74,0) .;Q:$G(^SC(SDCL,"ST",SDI,1))["**CANCELLED**" "RTN","SDEC57",75,0) .Q:$$INACTIVE^SDEC32(SDCL,$P(SDI,".",1)) ;don't get availability if clinic inactive on day SDI "RTN","SDEC57",76,0) .D RESAB(SDAB,SDCL,SDI,SDI_"."_2359,SDECRES) "RTN","SDEC57",77,0) Q "RTN","SDEC57",78,0) ; "RTN","SDEC57",79,0) RESAB(SDAB,SDCL,SDBEG,SDEND,SDECRES) ;build access blocks for 1 clinic "RTN","SDEC57",80,0) ; SDECRES (optional) Resource pointer to SDEC RESOURCE file "RTN","SDEC57",81,0) ; used to build access blocks from clinic availability "RTN","SDEC57",82,0) ; for only this resource; all resources are build if null "RTN","SDEC57",83,0) ; .01 name "RTN","SDEC57",84,0) ; 2 type (clinic) "RTN","SDEC57",85,0) ; 1912 length of app't "RTN","SDEC57",86,0) ; 1914 hour clinic display begins default is 8am; whole number 0-16 "RTN","SDEC57",87,0) ; 1917 display increments per hour "RTN","SDEC57",88,0) ; 2505 inactive date "RTN","SDEC57",89,0) ; 2506 reactivate date "RTN","SDEC57",90,0) N SDAY,SDCLS,SDDATA,SDFIELDS,SDIN,SDLEN,SDRA,SDSI,SDT "RTN","SDEC57",91,0) I $P($G(SDBEG),".",1)'?7N S SDBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-1) "RTN","SDEC57",92,0) I $P($G(SDEND),".",1)'?7N S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),365) "RTN","SDEC57",93,0) S SDECRES=$G(SDECRES) I SDECRES'="",'$D(^SDEC(409.831,+SDECRES,0)) S SDECRES="" "RTN","SDEC57",94,0) S SDFIELDS=".01;2;1912;1914;1917;2505;2506" "RTN","SDEC57",95,0) D GETS^DIQ(44,SDCL_",",SDFIELDS,"IE","SDDATA","SDMSG") "RTN","SDEC57",96,0) Q:SDDATA(44,SDCL_",",2,"I")'="C" ;only clinic "RTN","SDEC57",97,0) I $$INACTIVE(SDCL,.SDBEG,.SDEND,SDDATA(44,SDCL_",",2505,"I"),SDDATA(44,SDCL_",",2506,"I")) Q ;only active "RTN","SDEC57",98,0) S SDLEN=SDDATA(44,SDCL_",",1912,"I") ;length of app't is required in file 44 "RTN","SDEC57",99,0) S SDCLS=SDDATA(44,SDCL_",",1914,"I") ;hour clinic display begins "RTN","SDEC57",100,0) S:SDCLS="" SDCLS=8 ;apply default start time of 0800 "RTN","SDEC57",101,0) ;SDSI=DISPLAY INCREMENTS PER HOUR (1-60min,2-30min,3-20min,4-15min,6-10min) "RTN","SDEC57",102,0) S SDSI=SDDATA(44,SDCL_",",1917,"I") "RTN","SDEC57",103,0) D TDAY(SDAB,SDCL,SDCLS,SDLEN,SDSI,SDBEG,SDEND) "RTN","SDEC57",104,0) Q "RTN","SDEC57",105,0) ; "RTN","SDEC57",106,0) TDAY(SDAB,SDCL,SDCLS,SDLEN,SDSI,SDBEG,SDEND) ;add/update access blocks for day template SDT "RTN","SDEC57",107,0) ;SDBEG = (optional) Start date in fileman format; defaults to 'today' "RTN","SDEC57",108,0) ;SDEND = (optional) Stop date in fileman format; defaults to 365 days "RTN","SDEC57",109,0) N SDAY,SDAY1,SDBLKS,SDE,SDE1,SDJ,SDPAT,SDPAT1,SDSIM "RTN","SDEC57",110,0) S SDCL=$G(SDCL) "RTN","SDEC57",111,0) Q:SDCL="" "RTN","SDEC57",112,0) S SDLEN=$G(SDLEN) "RTN","SDEC57",113,0) ;LENGTH OF APP'T "RTN","SDEC57",114,0) I SDLEN="" S SDLEN=$$GET1^DIQ(44,SDCL_",",1912) "RTN","SDEC57",115,0) S SDCLS=$G(SDCLS) "RTN","SDEC57",116,0) ;HOUR CLINIC DISPLAY BEGINS "RTN","SDEC57",117,0) I SDCLS="" S SDCLS=$$GET1^DIQ(44,SDCL_",",1914) ;SDCLS=8 "RTN","SDEC57",118,0) S SDSI=$G(SDSI) "RTN","SDEC57",119,0) ;DISPLAY INCREMENTS PER HOUR "RTN","SDEC57",120,0) I SDSI="" S SDSI=$$GET1^DIQ(44,SDCL_",",1917,"I") ;SDDATA(44,SDCL_",",1917,"I") "RTN","SDEC57",121,0) S SDBEG=$G(SDBEG) "RTN","SDEC57",122,0) D TDAY1 "RTN","SDEC57",123,0) Q "RTN","SDEC57",124,0) TDAY1 ; "RTN","SDEC57",125,0) N D,SDA,SDTP,SS,ST,Y "RTN","SDEC57",126,0) ;SDA=begin position of pattern on template "RTN","SDEC57",127,0) S SDA=$S(SDSI=3:6,SDSI=6:12,1:8) "RTN","SDEC57",128,0) S SDTP="" "RTN","SDEC57",129,0) ;if no CURRENT AVAILABILITY pattern, try to build it "RTN","SDEC57",130,0) I '$D(^SC(SDCL,"ST",$P(SDBEG,".",1),1)) S ST='$$ST(SDCL,SDBEG) Q:ST "RTN","SDEC57",131,0) S SDTP=$G(^SC(SDCL,"ST",$P(SDBEG,".",1),1)) S SDTP=$E(SDTP,SDA,$L(SDTP)) "RTN","SDEC57",132,0) Q:SDTP="" "RTN","SDEC57",133,0) K SDBLKS "RTN","SDEC57",134,0) D GETBLKS^SDEC57A(.SDBLKS,SDTP,$P(SDBEG,".",1),SDCLS,SDLEN,SDSI,SDCL) "RTN","SDEC57",135,0) D RESNB^SDECUTL1(SDAB,.SDBLKS,SDCL,$P(SDBEG,".",1)) "RTN","SDEC57",136,0) K SDBLKS "RTN","SDEC57",137,0) Q "RTN","SDEC57",138,0) ; "RTN","SDEC57",139,0) ST(SDCL,SDBEG) ;build ST "RTN","SDEC57",140,0) ;RETURN - 0=not buildable or built as holiday ;1=buildable "RTN","SDEC57",141,0) N D,SC,SDDT,SS,Y "RTN","SDEC57",142,0) S SDDT=$P(SDBEG,".",1) "RTN","SDEC57",143,0) S SC=SDCL "RTN","SDEC57",144,0) S D=$$DOW^XLFDT(SDDT,1) "RTN","SDEC57",145,0) S Y=D#7 "RTN","SDEC57",146,0) I $D(^HOLIDAY(SDDT))&($$GET1^DIQ(44,SDCL_",",1918.5,"I")'="Y") D H Q 0 "RTN","SDEC57",147,0) S SS=$$FDT(SDCL,Y) "RTN","SDEC57",148,0) Q:+SS="" 0 "RTN","SDEC57",149,0) S ^SC(+SDCL,"ST",SDDT,1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SDDT,6,7)_$S(SDSI=3:"",SDSI=6:" ",1:" ")_SS,^SC(+SDCL,"ST",SDDT,0)=SDDT "RTN","SDEC57",150,0) Q 1 "RTN","SDEC57",151,0) FDT(SDCL,Y) ;find day template pattern "RTN","SDEC57",152,0) N SDE,SDTP "RTN","SDEC57",153,0) S SDTP="" "RTN","SDEC57",154,0) S SDE=$O(^SC(SDCL,"T"_Y,99999999),-1) "RTN","SDEC57",155,0) Q:'SDE "" "RTN","SDEC57",156,0) S SDTP=$G(^SC(SDCL,"T"_Y,SDE,1)) "RTN","SDEC57",157,0) Q:SDTP="" "" "RTN","SDEC57",158,0) F S SDE=$O(^SC(SDCL,"T"_Y,SDE),-1) Q:SDE'>0 Q:$P(SDBEG,".",1)'SDBEG S SDEND=IDATE Q 0 "RTN","SDEC57",180,0) ; inactive 1 0 "RTN","SDEC57",181,0) I IDATE'>SDBEG,RDATE="" Q 1 ;alb/sat 665 "RTN","SDEC57",182,0) ; inactive 1 1 inactive but reactivated "RTN","SDEC57",183,0) ; inactive now reactive now "RTN","SDEC57",184,0) I IDATE'>SDBEG,RDATE'>SDBEG Q 0 ;alb/sat 665 "RTN","SDEC57",185,0) ; inactive now reactive future "RTN","SDEC57",186,0) I IDATE'>SDBEG,RDATE>IDATE S SDBEG=RDATE Q 0 ;alb/sat 665 "RTN","SDEC57",187,0) Q 1 "RTN","SDEC57",188,0) ; "RTN","SDEC57",189,0) OBM(RET,SDCL,SDT,MRTC,USR,SDW) ;GET overbook status and message "RTN","SDEC57",190,0) N %DT,OBM,SDTMP,X,Y "RTN","SDEC57",191,0) S RET=$NA(^TMP("SDEC57",$J,"OBM")) "RTN","SDEC57",192,0) K @RET "RTN","SDEC57",193,0) S @RET@(0)="T00030CONTINUE^T00200MESSAGE^T00200PROMPT^T00030DEFAULT"_$C(30) "RTN","SDEC57",194,0) ;validate SDCL "RTN","SDEC57",195,0) S SDCL=$G(SDCL) "RTN","SDEC57",196,0) I SDCL="" S @RET@(1)="-1^Clinic ID is required."_$C(30,31) Q "RTN","SDEC57",197,0) I '$D(^SC(SDCL,0)) S @RET@(1)="-1^Invalid Clinic ID."_$C(30,31) Q "RTN","SDEC57",198,0) ;validate SDT "RTN","SDEC57",199,0) S SDT=$G(SDT) "RTN","SDEC57",200,0) S %DT="T",X=SDT D ^%DT I Y=-1 S @RET@(1)="-1^Invalid appointment date/time."_$C(30,31) Q "RTN","SDEC57",201,0) S SDT=Y "RTN","SDEC57",202,0) ;validate MRTC "RTN","SDEC57",203,0) S MRTC=$G(MRTC) "RTN","SDEC57",204,0) I MRTC'="","01"'[MRTC S @RET@(1)="-1^Invalid MRTC flag."_$C(30,31) Q "RTN","SDEC57",205,0) ;validate USR "RTN","SDEC57",206,0) S USR=$G(USR) "RTN","SDEC57",207,0) I USR="" S USR=DUZ "RTN","SDEC57",208,0) I '$D(^VA(200,USR,0)) S @RET@(1)="-1^Invalid user ID."_$C(30,31) Q "RTN","SDEC57",209,0) ;validate SDW "RTN","SDEC57",210,0) S SDW=$G(SDW) "RTN","SDEC57",211,0) S OBM=$$OBM1(SDCL,SDT,MRTC,USR,SDW) "RTN","SDEC57",212,0) I OBM="" S @RET@(1)=1 "RTN","SDEC57",213,0) E D "RTN","SDEC57",214,0) .S SDTMP="" "RTN","SDEC57",215,0) .F I=1:1:$L(OBM,"|") S $P(SDTMP,U,I)=$P(OBM,"|",I) "RTN","SDEC57",216,0) .S @RET@(1)=SDTMP "RTN","SDEC57",217,0) S @RET@(1)=@RET@(1)_$C(30,31) "RTN","SDEC57",218,0) Q "RTN","SDEC57",219,0) OBM1(SDCL,SDT,MRTC,USR,SDW) ;return message and possible prompt for overbook ;alb/sat 658 "RTN","SDEC57",220,0) ; RETURN - | | | "RTN","SDEC57",221,0) ; - 0=do not continue "RTN","SDEC57",222,0) ; 1=continue "RTN","SDEC57",223,0) ; 2=continue based on prompt response "RTN","SDEC57",224,0) N %,CAN,D,DATE,HSI,I,OBM,MOB,MOBR,S,SB,SI,SL,SM,SM7,SDA,SDDIF,ST,STARTDAY,STR,X "RTN","SDEC57",225,0) ; "RTN","SDEC57",226,0) S OBM="" "RTN","SDEC57",227,0) S (CAN,SM,SM7)=0 "RTN","SDEC57",228,0) ;validate SDCL "RTN","SDEC57",229,0) S SDCL=$G(SDCL) "RTN","SDEC57",230,0) Q:SDCL="" "" "RTN","SDEC57",231,0) Q:'$D(^SC(SDCL,0)) "" "RTN","SDEC57",232,0) ;validate MRTC "RTN","SDEC57",233,0) S MRTC=$G(MRTC) "RTN","SDEC57",234,0) ;validate USR "RTN","SDEC57",235,0) S USR=$G(USR) "RTN","SDEC57",236,0) I USR="" S USR=DUZ "RTN","SDEC57",237,0) Q:'$D(^VA(200,USR,0)) "" "RTN","SDEC57",238,0) ;validate SDT "RTN","SDEC57",239,0) S SDT=$G(SDT) "RTN","SDEC57",240,0) S %DT="T",X=SDT D ^%DT I Y=-1 Q "" "RTN","SDEC57",241,0) S SDT=Y "RTN","SDEC57",242,0) S DATE=$$FMTE^XLFDT($P(SDT,".",1)) "RTN","SDEC57",243,0) ;validate SDW walk-in flag "RTN","SDEC57",244,0) S SDW=$G(SDW) "RTN","SDEC57",245,0) ; "RTN","SDEC57",246,0) ;SM=6=OVERBOOK SM=7=NOT IN SCHEDULE PERIOD "RTN","SDEC57",247,0) S SL=$G(^SC(+SDCL,"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) "RTN","SDEC57",248,0) S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) "RTN","SDEC57",249,0) S S=$G(^SC(SDCL,"ST",$P(SDT,".",1),1)) "RTN","SDEC57",250,0) S I=SDT#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST "RTN","SDEC57",251,0) ;check if not during schedule period (SM=7) "RTN","SDEC57",252,0) 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","SDEC57",253,0) ;check if OB (SM=6) "RTN","SDEC57",254,0) S SDA=$S($P(SL,U,6)=3:6,$P(SL,U,6)=6:12,1:8) "RTN","SDEC57",255,0) F I=ST+ST:SDDIF:SS-SDDIF S ST=$E(S,I+1) S:ST="" ST=" " S Y=$E(STR,$F(STR,ST)-2),SM7=$S(I+^SC(SDCL,"SL") "RTN","SDEC57",258,0) .S ST=" " "RTN","SDEC57",259,0) .Q "RTN","SDEC57",260,0) I CAN S OBM="0|CAN'T BOOK WITHIN A CANCELLED TIME PERIOD!" G OBX "RTN","SDEC57",261,0) I +SDW,+SM7 S OBM="1" G OBX "RTN","SDEC57",262,0) S (MOBR,MOB)=$P($G(^SC(SDCL,"SL")),U,7) ;MOB=MAX OB ALLOWED MOBR=MAX OB REMAINING "RTN","SDEC57",263,0) ; alb/jsm 658 updated to used the $P(SDT,".",1)-.01 "RTN","SDEC57",264,0) I MOBR F D=$P(SDT,".",1)-.01:0 S D=$O(^SC(SDCL,"S",D)) Q:$P(D,".",1)-$P(SDT,".",1) F %=0:0 S %=$O(^SC(SDCL,"S",D,1,%)) Q:'% I $P(^(%,0),"^",9)'["C",$D(^("OB")) S MOBR=MOBR-1 "RTN","SDEC57",265,0) ; "RTN","SDEC57",266,0) ;not MRTC "RTN","SDEC57",267,0) ; MAX OB DEFINED "RTN","SDEC57",268,0) I 'MRTC,MOB'="",SM#9'=0,MOBR<1,'$D(^XUSEC("SDMOB",DUZ)) S OBM="0|ONLY "_MOB_" OVERBOOK"_$E("S",MOB>1)_" ALLOWED PER DAY!!" G OBX "RTN","SDEC57",269,0) I 'MRTC,MOB'="",SM#9'=0,MOBR<1,$D(^XUSEC("SDMOB",DUZ)) S OBM="2||WILL EXCEED MAXIMUM ALLOWABLE OVERBOOKS, OK?|YES" G OBX "RTN","SDEC57",270,0) I 'MRTC,MOB'="",SM#9'=0,MOBR>0,'$D(^XUSEC("SDOB",DUZ)) S OBM="0|NO OPEN SLOTS THEN" G OBX "RTN","SDEC57",271,0) I 'MRTC,MOB'="",SM=7,$D(^XUSEC("SDOB",DUZ)) S OBM="2||THAT TIME IS NOT WITHIN SCHEDULED PERIOD!...OK?|NO" G OBX "RTN","SDEC57",272,0) I 'MRTC,MOB'="",SM=6,$D(^XUSEC("SDOB",DUZ)) S OBM="2||OVERBOOK!...OK?|NO" G OBX "RTN","SDEC57",273,0) ; MAX OB NOT DEFINED "RTN","SDEC57",274,0) I 'MRTC,MOB="",SM#9'=0,'$D(^XUSEC("SDOB",DUZ)) S OBM="0|NO OPEN SLOTS THEN" G OBX "RTN","SDEC57",275,0) I 'MRTC,MOB="",SM=7,$D(^XUSEC("SDOB",DUZ)) S OBM="2||THAT TIME IS NOT WITHIN SCHEDULED PERIOD!...OK?|NO" G OBX "RTN","SDEC57",276,0) I 'MRTC,MOB="",SM=6,$D(^XUSEC("SDOB",DUZ)) S OBM="2||OVERBOOK!...OK?|NO" G OBX "RTN","SDEC57",277,0) ;MRTC "RTN","SDEC57",278,0) I MRTC,MOBR<1,'$D(^XUSEC("SDOB",DUZ)),'$D(^XUSEC("SDMOB",DUZ)) S OBM="NO OPEN SLOTS ON "_DATE_" AT THAT TIME." G OBX "RTN","SDEC57",279,0) I MRTC,MOBR<1 D G OBX "RTN","SDEC57",280,0) .S:'$D(^XUSEC("SDMOB",USR)) OBM="0|ONLY "_MOB_" OVERBOOK"_$E("S",MOB>1)_" ALLOWED PER DAY!! NO OPEN SLOTS ON "_DATE_" AT THAT TIME." "RTN","SDEC57",281,0) .S:$D(^XUSEC("SDMOB",USR)) OBM="2||WILL EXCEED MAXIMUM ALLOWABLE OVERBOOKS FOR "_DATE_", OK?|YES" "RTN","SDEC57",282,0) .S:$D(^XUSEC("SDOB",DUZ)) OBM="2||"_DATE_" WILL BE AN OVERBOOK, OK?|NO" "RTN","SDEC57",283,0) I 0,MRTC,MOBR>0 D G OBX "RTN","SDEC57",284,0) .S:'$D(^XUSEC("SDOB",DUZ)) OBM="0|NO OPEN SLOTS ON "_DATE_" AT THAT TIME." "RTN","SDEC57",285,0) .S:$D(^XUSEC("SDOB",DUZ)) OBM="2||"_DATE_" WILL BE AN OVERBOOK, OK?|NO" "RTN","SDEC57",286,0) OBX Q OBM "RTN","SDEC57",287,0) CAN(S,ST,SDCL,SDT) ; "RTN","SDEC57",288,0) Q S["CAN"!(ST="X"&($D(^SC(+SDCL,"ST",$P(SDT,"."),"CAN")))) "RTN","SDEC665") 0^10^B24153499^n/a "RTN","SDEC665",1,0) SDEC665 ;ALB/SAT/JSM - VISTA SCHEDULING PRE/POST ;JUN 21, 2017 "RTN","SDEC665",2,0) ;;5.3;Scheduling;**665**;Aug 13, 1993;Build 14 "RTN","SDEC665",3,0) ; "RTN","SDEC665",4,0) Q "RTN","SDEC665",5,0) ; "RTN","SDEC665",6,0) PRE ; "RTN","SDEC665",7,0) Q "RTN","SDEC665",8,0) ; "RTN","SDEC665",9,0) POST ;alb/sat 665 "RTN","SDEC665",10,0) D NOTE "RTN","SDEC665",11,0) Q "RTN","SDEC665",12,0) ; "RTN","SDEC665",13,0) NOTE ;sync OTHER in HOSPITAL LOCATION appointment record and NOTE in SDEC APPOINTMENT "RTN","SDEC665",14,0) ;per Irene Smith, Debbie Malkovich 2/8/2017 "RTN","SDEC665",15,0) ; If NOTE is empty AND OTHER is defined, OTHER data will be set to NOTE. "RTN","SDEC665",16,0) ; If NOTE is defined AND OTHER is defined, OTHER data will be set to NOTE - NOTE data is replaced by OTHER data. (VistA wins!) "RTN","SDEC665",17,0) ; If NOTE is defined AND OTHER is empty, NOTE data will be set to OTHER "RTN","SDEC665",18,0) N Y "RTN","SDEC665",19,0) S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y) "RTN","SDEC665",20,0) W !!,"Syncing OTHER in clinic appointments with NOTE in SDEC APPOINTMENTs ..." "RTN","SDEC665",21,0) W !,Y "RTN","SDEC665",22,0) N ZTDESC,ZTDTH,ZTIO,ZTRTN "RTN","SDEC665",23,0) S ZTRTN="N2^SDEC665" "RTN","SDEC665",24,0) S ZTIO="" "RTN","SDEC665",25,0) S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,1) "RTN","SDEC665",26,0) S ZTDESC="SD*5.3*665 NOTE UPDATE REPORT DATA" "RTN","SDEC665",27,0) D ^%ZTLOAD "RTN","SDEC665",28,0) Q "RTN","SDEC665",29,0) N2 ;called by background job "RTN","SDEC665",30,0) ;GET conflicts "RTN","SDEC665",31,0) N AIEN,AIEN2,ANOD,CNOT,ARR,CNT,LCNT,LINE,SC,SCN,SDR,SDT,SDTMP,SDX,SID,SNOD,SNOT,SSC,X,XMSUB,XMTEXT,XMY,SDECSDT "RTN","SDEC665",32,0) K ^XTMP("VSGUI_OI") "RTN","SDEC665",33,0) S ^XTMP("VSGUI_OI",0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT S $P(LINE,"=",78)="=" "RTN","SDEC665",34,0) S (CNT,LCNT)=0 "RTN","SDEC665",35,0) S SDX="^XTMP(""SDEC665M"")" "RTN","SDEC665",36,0) K @SDX "RTN","SDEC665",37,0) S @SDX@(0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT "RTN","SDEC665",38,0) S SDECSDT=$O(^SDEC(409.84,"B",0)) ;alb/jsm set very first starttime of SDEC APPOINTMENTS "RTN","SDEC665",39,0) D BLD("CONFLICTS:"),BLD("=========") "RTN","SDEC665",40,0) D BLD(LINE) "RTN","SDEC665",41,0) S SCN="" F S SCN=$O(^SC("AG","C",SCN)) Q:SCN="" D "RTN","SDEC665",42,0) .S SC=0 F S SC=$O(^SC("AG","C",SCN,SC)) Q:SC="" D "RTN","SDEC665",43,0) ..S SDT=$P(SDECSDT,".",1) F S SDT=$O(^SC(SC,"S",SDT)) Q:SDT'>0 D ;alb/jsm reset SDT to the starttime from SDEC APPOINTMENTS "RTN","SDEC665",44,0) ...S AIEN=0 F S AIEN=$O(^SC(SC,"S",SDT,1,AIEN)) Q:AIEN'>0 D "RTN","SDEC665",45,0) ....S ANOD=$G(^SC(SC,"S",SDT,1,AIEN,0)) "RTN","SDEC665",46,0) ....S CNOT=$P(ANOD,U,4) "RTN","SDEC665",47,0) ....S AIEN2=$$FIND^SDAM2($P(ANOD,U,1),SDT,SC) ;665 "RTN","SDEC665",48,0) ....I AIEN2=AIEN D ;665 "RTN","SDEC665",49,0) .....S SID=0 F S SID=$O(^SDEC(409.84,"B",SDT,SID)) Q:SID="" D "RTN","SDEC665",50,0) ......S SNOD=$G(^SDEC(409.84,SID,0)) "RTN","SDEC665",51,0) ......S SDR=$P(SNOD,U,7),SSC=$$GET1^DIQ(409.831,SDR_",",.04,"I") "RTN","SDEC665",52,0) ......I $P(SNOD,U,5)=$P(ANOD,U,1),SC=SSC D "RTN","SDEC665",53,0) .......K ARR "RTN","SDEC665",54,0) .......S SNOT="" "RTN","SDEC665",55,0) .......S X=$$GET1^DIQ(409.84,SID_",",1,,"ARR") "RTN","SDEC665",56,0) .......S SNOT=$$WPSTR^SDECUTL(.ARR) "RTN","SDEC665",57,0) .......S SNOT=$E(SNOT,1,150) "RTN","SDEC665",58,0) .......I SNOT["^" D STRIP K ARR S X=$$GET1^DIQ(409.84,SID_",",1,,"ARR") S SNOT=$$WPSTR^SDECUTL(.ARR) S SNOT=$E(SNOT,1,150) "RTN","SDEC665",59,0) .......I CNOT'=SNOT D "RTN","SDEC665",60,0) ........S CNT=CNT+1,(XSTR,^XTMP("VSGUI_OI","DIFF",SCN,CNT))=SDT_U_SC_U_SCN_U_AIEN_U_$P(SNOD,U,5)_U_CNOT_U_SID_U_SNOT "RTN","SDEC665",61,0) ........S SDTMP=$$GET1^DIQ(2,+$P(XSTR,U,5),.01)_" ("_$P(XSTR,U,5)_")" "RTN","SDEC665",62,0) ........D BLD(SDTMP) "RTN","SDEC665",63,0) ........S SDTMP="CLINIC: "_$E("("_$P(XSTR,U,2)_") "_$P(XSTR,U,3),1,39),SDTMP=SDTMP_$$FILL^SDECU(49-$L(SDTMP))_"APPT TIME: "_$$FMTE^XLFDT($P(XSTR,U,1)) "RTN","SDEC665",64,0) ........D BLD(SDTMP) "RTN","SDEC665",65,0) ........S SDTMP="OTHER:" "RTN","SDEC665",66,0) ........D BLD(SDTMP) "RTN","SDEC665",67,0) ........D BLD($P(XSTR,U,6)),BLD("") "RTN","SDEC665",68,0) ........S SDTMP="NOTE ("_$P(XSTR,U,7)_"):" "RTN","SDEC665",69,0) ........D BLD(SDTMP) "RTN","SDEC665",70,0) ........D BLD($P(XSTR,U,8)),BLD(LINE) "RTN","SDEC665",71,0) ;FIX conflicts "RTN","SDEC665",72,0) K ANOD,CNOT,CNT,IENS,LINE,SCN,SNOT,X,XSTR "RTN","SDEC665",73,0) S $P(LINE,"=",78)="=" "RTN","SDEC665",74,0) D BLD(""),BLD(""),BLD(""),BLD("RESOLUTIONS:"),BLD("===========") "RTN","SDEC665",75,0) D BLD(LINE) "RTN","SDEC665",76,0) S SCN="" F S SCN=$O(^XTMP("VSGUI_OI","DIFF",SCN)) Q:SCN="" D "RTN","SDEC665",77,0) .S CNT=0 F S CNT=$O(^XTMP("VSGUI_OI","DIFF",SCN,CNT)) Q:CNT="" D "RTN","SDEC665",78,0) ..K ARR,FDA "RTN","SDEC665",79,0) ..S XSTR=$G(^XTMP("VSGUI_OI","DIFF",SCN,CNT)) "RTN","SDEC665",80,0) ..S CNOT=$P(XSTR,U,6) "RTN","SDEC665",81,0) ..S SNOT=$P(XSTR,U,8) "RTN","SDEC665",82,0) ..S IENS=$P(XSTR,U,4)_","_$P(XSTR,U,1)_","_$P(XSTR,U,2)_"," "RTN","SDEC665",83,0) ..D:(CNOT="")&(SNOT'="") WP^DIE(409.84,$P(XSTR,U,7)_",",1,"","@") ;FDA(44.003,IENS,3)=SNOT "RTN","SDEC665",84,0) ..D:(CNOT'="")&(SNOT="") WP^SDECUTL(.ARR,CNOT) "RTN","SDEC665",85,0) ..D:(CNOT'="")&(SNOT'="")&(CNOT'=SNOT) WP^SDECUTL(.ARR,CNOT) "RTN","SDEC665",86,0) ..;D:$D(FDA) UPDATE^DIE("","FDA") "RTN","SDEC665",87,0) ..D:$D(ARR) WP^DIE(409.84,$P(XSTR,U,7)_",",1,"","ARR") "RTN","SDEC665",88,0) ..S ANOD=$G(^SC($P(XSTR,U,2),"S",$P(XSTR,U,1),1,$P(XSTR,U,4),0)) "RTN","SDEC665",89,0) ..S CNOT=$P(ANOD,U,4) "RTN","SDEC665",90,0) ..K ARR "RTN","SDEC665",91,0) ..S X=$$GET1^DIQ(409.84,$P(XSTR,U,7)_",",1,,"ARR") "RTN","SDEC665",92,0) ..S SNOT=$$WPSTR^SDECUTL(.ARR) "RTN","SDEC665",93,0) ..S SNOT=$E(SNOT,1,150) "RTN","SDEC665",94,0) ..S SDTMP=$$GET1^DIQ(2,+$P(XSTR,U,5),.01)_" ("_$P(XSTR,U,5)_")" "RTN","SDEC665",95,0) ..D BLD(SDTMP) "RTN","SDEC665",96,0) ..S SDTMP="CLINIC: "_$E("("_$P(XSTR,U,2)_") "_$P(XSTR,U,3),1,39),SDTMP=SDTMP_$$FILL^SDECU(49-$L(SDTMP))_"APPT TIME: "_$$FMTE^XLFDT($P(XSTR,U,1)) "RTN","SDEC665",97,0) ..D BLD(SDTMP) "RTN","SDEC665",98,0) ..S SDTMP="OTHER:" "RTN","SDEC665",99,0) ..D BLD(SDTMP) "RTN","SDEC665",100,0) ..D BLD(CNOT) "RTN","SDEC665",101,0) ..D BLD("") "RTN","SDEC665",102,0) ..S SDTMP="NOTE ("_$P(XSTR,U,7)_"):" "RTN","SDEC665",103,0) ..D BLD(SDTMP) "RTN","SDEC665",104,0) ..D BLD(SNOT) "RTN","SDEC665",105,0) ..D BLD(LINE) "RTN","SDEC665",106,0) ;SEND message "RTN","SDEC665",107,0) S XMY(DUZ)="",XMSUB="SD*5.3*665 NOTE UPDATE REPORT DATA for "_$$FMTE^XLFDT($$NOW^XLFDT) "RTN","SDEC665",108,0) S XMTEXT=$P(SDX,")")_"," "RTN","SDEC665",109,0) D ^XMD "RTN","SDEC665",110,0) Q "RTN","SDEC665",111,0) ; "RTN","SDEC665",112,0) BLD(TXT) ;build output text for email "RTN","SDEC665",113,0) S LCNT=LCNT+1 "RTN","SDEC665",114,0) S @SDX@(LCNT)=TXT "RTN","SDEC665",115,0) Q "RTN","SDEC665",116,0) STRIP ; "RTN","SDEC665",117,0) N FDA "RTN","SDEC665",118,0) Q:SNOT'["^" "RTN","SDEC665",119,0) S SNOT=$TR(SNOT,"^"," ") "RTN","SDEC665",120,0) D WP^SDECUTL(.ARR,SNOT) "RTN","SDEC665",121,0) D WP^DIE(409.84,SID_",",1,"","ARR") "RTN","SDEC665",122,0) Q "RTN","SDECDEV") 0^23^B81564531^B76696246 "RTN","SDECDEV",1,0) SDECDEV ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDECDEV",2,0) ;;5.3;Scheduling;**627,658,665**;Aug 13, 1993;Build 14 "RTN","SDECDEV",3,0) ; "RTN","SDECDEV",4,0) Q "RTN","SDECDEV",5,0) ; "RTN","SDECDEV",6,0) DEVICE(SDECY) ;EP List of printers "RTN","SDECDEV",7,0) ; OUTPUT: "RTN","SDECDEV",8,0) ; SDECY(n)=REPORT TEXT "RTN","SDECDEV",9,0) ; "RTN","SDECDEV",10,0) N SDECI,FROM,DIR,ARR "RTN","SDECDEV",11,0) S SDECI=0 "RTN","SDECDEV",12,0) S SDECY=$NA(^TMP("SDECDEV",$J,"DEVICE")) K @SDECY "RTN","SDECDEV",13,0) S @SDECY@(SDECI)="I00030PRINTER_IEN^T00040PRINTER_NAME"_$C(30) "RTN","SDECDEV",14,0) N CNT,IEN,X,Y,X0,XLOC,XSEC,XTYPE,XSTYPE,XTIME,XOSD,MW,PL,DEV "RTN","SDECDEV",15,0) S FROM="",DIR=1 "RTN","SDECDEV",16,0) F S FROM=$O(^%ZIS(1,"B",FROM),DIR),IEN=0 Q:FROM="" D "RTN","SDECDEV",17,0) .F S IEN=$O(^%ZIS(1,"B",FROM,IEN)) Q:'IEN D "RTN","SDECDEV",18,0) ..Q:$D(ARR(IEN)) "RTN","SDECDEV",19,0) ..S ARR(IEN)="" "RTN","SDECDEV",20,0) ..S DEV="",X0=$G(^%ZIS(1,IEN,0)),XLOC=$P($G(^(1)),U),XOSD=+$G(^(90)),MW=$G(^(91)),XSEC=$G(^(95)),XSTYPE=+$G(^("SUBTYPE")),XTIME=$P($G(^("TIME")),U),XTYPE=$P($G(^("TYPE")),U) "RTN","SDECDEV",21,0) ..Q:$E($G(^%ZIS(2,XSTYPE,0)))'="P" ; Printers only "RTN","SDECDEV",22,0) ..Q:"^TRM^HG^CHAN^OTH^"'[(U_XTYPE_U) "RTN","SDECDEV",23,0) ..Q:$P(X0,U,2)="0"!($P(X0,U,12)=2) ; Queuing allowed "RTN","SDECDEV",24,0) ..I XOSD,XOSD'>DT Q ; Out of Service "RTN","SDECDEV",25,0) ..I $L(XTIME) D Q:'$L(XTIME) ; Prohibited Times "RTN","SDECDEV",26,0) ...S Y=$P($H,",",2),Y=Y\60#60+(Y\3600*100),X=$P(XTIME,"-",2) "RTN","SDECDEV",27,0) ...S:X'X&(Y'X))) XTIME="" "RTN","SDECDEV",28,0) ..I $L(XSEC),$G(DUZ(0))'="@",$TR(XSEC,$G(DUZ(0)))=XSEC Q "RTN","SDECDEV",29,0) ..S PL=$P(MW,U,3),MW=$P(MW,U),X=$G(^%ZIS(2,XSTYPE,1)) "RTN","SDECDEV",30,0) ..S:'MW MW=$P(X,U) "RTN","SDECDEV",31,0) ..S:'PL PL=$P(X,U,3) "RTN","SDECDEV",32,0) ..S X=$P(X0,U) "RTN","SDECDEV",33,0) ..Q:$E(X,1,4)["NULL" "RTN","SDECDEV",34,0) ..S:X'=FROM X=FROM_" <"_X_">" "RTN","SDECDEV",35,0) ..S SDECI=SDECI+1,@SDECY@(SDECI)=IEN_U_$P(X0,U)_$C(30) "RTN","SDECDEV",36,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDECDEV",37,0) Q "RTN","SDECDEV",38,0) ; "RTN","SDECDEV",39,0) DEV(RET,TYPE,MAX,LSUB,PARTIAL) ;GET devices of the given type ;alb/sat 658 "RTN","SDECDEV",40,0) ;INPUT: "RTN","SDECDEV",41,0) ; TYPE - (optional) Device type "RTN","SDECDEV",42,0) ; A:All Printers (default) "RTN","SDECDEV",43,0) ; P:Printers only on current namespace "RTN","SDECDEV",44,0) ; C:Complete Device Listing (not supported) "RTN","SDECDEV",45,0) ; D:Devices only on current namespace (not supported) "RTN","SDECDEV",46,0) ; N:New Format for Device Specification (not supported) "RTN","SDECDEV",47,0) ; E:Extended Help (not supported) "RTN","SDECDEV",48,0) ; MAX - (optional) Max records to return "RTN","SDECDEV",49,0) ; LSUB - (optional) Last subscripts used to continue from last call "RTN","SDECDEV",50,0) ; Use LASTSUB (return piece 3) from previous call "RTN","SDECDEV",51,0) ; PARTIAL - (optional) - partial device name lookup "RTN","SDECDEV",52,0) ;RETURN: "RTN","SDECDEV",53,0) ; DIEN = Device IEN pointer to DEVICE file (#3.5) OR -1 if error "RTN","SDECDEV",54,0) ; DNAME = Device Name OR message if error "RTN","SDECDEV",55,0) ; LOCT = Location of Terminal text "RTN","SDECDEV",56,0) ; LASTSUB = Last subscripts to continue with next call "RTN","SDECDEV",57,0) ; Pass in as LSUB input "RTN","SDECDEV",58,0) N SDCNT,SDSUB,SDTMP "RTN","SDECDEV",59,0) S SDSUB="" "RTN","SDECDEV",60,0) S SDCNT=0 "RTN","SDECDEV",61,0) S RET=$NA(^TMP("SDECDEV",$J,"DEV")) "RTN","SDECDEV",62,0) K @RET "RTN","SDECDEV",63,0) S SDTMP="T00030DIEN^T00030DNAME^T00050LOCT^T00100LASTSUB" "RTN","SDECDEV",64,0) S @RET@(0)=SDTMP_$C(30) "RTN","SDECDEV",65,0) ;validate TYPE "RTN","SDECDEV",66,0) S TYPE=$G(TYPE) "RTN","SDECDEV",67,0) I TYPE="" S TYPE="A" "RTN","SDECDEV",68,0) I "AP"'[TYPE S @RET@(1)="-1^Invalid Device Type - "_TYPE_"."_$C(30,31) Q ;"APCDNE" "RTN","SDECDEV",69,0) ;validate MAX "RTN","SDECDEV",70,0) S MAX=$G(MAX) "RTN","SDECDEV",71,0) I MAX'="",MAX'=+MAX S @RET@(1)="-1^Invalid max records value - "_MAX_"."_$C(30,31) Q "RTN","SDECDEV",72,0) S:MAX="" MAX=9999999 "RTN","SDECDEV",73,0) ;validate LSUB "RTN","SDECDEV",74,0) S LSUB=$G(LSUB) "RTN","SDECDEV",75,0) ;validate PARTIAL "RTN","SDECDEV",76,0) S PARTIAL=$G(PARTIAL) "RTN","SDECDEV",77,0) ; "RTN","SDECDEV",78,0) D @TYPE "RTN","SDECDEV",79,0) ; "RTN","SDECDEV",80,0) I SDSUB'="" S SDTMP=$P(@RET@(SDCNT),$C(30),1),$P(SDTMP,U,4)=SDSUB,@RET@(SDCNT)=SDTMP_$C(30) "RTN","SDECDEV",81,0) S @RET@(SDCNT)=@RET@(SDCNT)_$C(31) "RTN","SDECDEV",82,0) Q "RTN","SDECDEV",83,0) A ;All Printers "RTN","SDECDEV",84,0) N DN,SDID "RTN","SDECDEV",85,0) S DN=$S($P(LSUB,"|",1)'="":$P(LSUB,"|",1),PARTIAL'="":$$GETSUB^SDECU(PARTIAL),1:"") "RTN","SDECDEV",86,0) F S DN=$O(^%ZIS(1,"B",DN)) Q:DN="" Q:(PARTIAL'="")&(DN'[PARTIAL) D I SDCNT>MAX S SDSUB=DN_"|"_SDID Q "RTN","SDECDEV",87,0) .S SDID=$S($P(LSUB,"|",2)'="":$P(LSUB,"|",2),1:0) "RTN","SDECDEV",88,0) .S LSUB="" "RTN","SDECDEV",89,0) .F S SDID=$O(^%ZIS(1,"B",DN,SDID)) Q:SDID="" D I SDCNT>MAX S SDSUB=DN_"|"_SDID Q "RTN","SDECDEV",90,0) ..Q:'$D(^%ZIS(1,SDID,0)) ;existence check "RTN","SDECDEV",91,0) ..Q:$P($G(^%ZIS(2,+$G(^%ZIS(1,SDID,"SUBTYPE")),0)),U)'?1"P".E ;subtype check "RTN","SDECDEV",92,0) ..Q:+$G(^%ZIS(1,SDID,90)) ;out of service "RTN","SDECDEV",93,0) ..S SDCNT=SDCNT+1 S @RET@(SDCNT)=SDID_U_DN_U_$$GET1^DIQ(3.5,SDID_",",.02,"E")_$C(30) "RTN","SDECDEV",94,0) Q "RTN","SDECDEV",95,0) P ;Printers only on current namespace "RTN","SDECDEV",96,0) N DN,SDID "RTN","SDECDEV",97,0) K ^UTILITY("ZIS",$J) ;^UTILITY is already used in device processing "RTN","SDECDEV",98,0) D LCPU "RTN","SDECDEV",99,0) S DN=$S($P(LSUB,"|",1)'="":$P(LSUB,"|",1),PARTIAL'="":$$GETSUB^SDECU(PARTIAL),1:"") "RTN","SDECDEV",100,0) F S DN=$O(^UTILITY("ZIS",$J,"DEVLST","B",DN)) Q:DN="" Q:(PARTIAL'="")&(DN'[PARTIAL) D I SDCNT>MAX S SDSUB=DN_"|"_SDID Q "RTN","SDECDEV",101,0) .S SDID=$S($P(LSUB,"|",2)'="":$P(LSUB,"|",2),1:0) "RTN","SDECDEV",102,0) .S LSUB="" "RTN","SDECDEV",103,0) .F S SDID=$O(^UTILITY("ZIS",$J,"DEVLST","B",DN,SDID)) Q:SDID="" D I SDCNT>MAX S SDSUB=DN_"|"_SDID Q "RTN","SDECDEV",104,0) ..Q:'$D(^%ZIS(1,SDID,0)) ;existence check "RTN","SDECDEV",105,0) ..Q:$P($G(^%ZIS(2,+$G(^%ZIS(1,SDID,"SUBTYPE")),0)),U)'?1"P".E ;subtype check "RTN","SDECDEV",106,0) ..Q:+$G(^%ZIS(1,SDID,90)) ;out of service "RTN","SDECDEV",107,0) ..S SDCNT=SDCNT+1 S @RET@(SDCNT)=SDID_U_DN_U_$$GET1^DIQ(3.5,SDID_",",.02,"E")_$C(30) "RTN","SDECDEV",108,0) K ^UTILITY("ZIS",$J) "RTN","SDECDEV",109,0) Q "RTN","SDECDEV",110,0) LCPU ;build list of local devices (namespace text needs to be in VOLUME SET(CPU) field) "RTN","SDECDEV",111,0) N %ZISV "RTN","SDECDEV",112,0) ;S %ZISV=$G(^%ZOSF("VOL")) "RTN","SDECDEV",113,0) S %ZISV="TIS" "RTN","SDECDEV",114,0) Q:%ZISV="" "RTN","SDECDEV",115,0) D LCPU^%ZIS5 "RTN","SDECDEV",116,0) Q "RTN","SDECDEV",117,0) ; "RTN","SDECDEV",118,0) ;=== "RTN","SDECDEV",119,0) ; "RTN","SDECDEV",120,0) PRINT(RET,APID,TYPE,SDID) ;Print patient letters "RTN","SDECDEV",121,0) ;INPUT: "RTN","SDECDEV",122,0) ; APID - (required) Appointment ID pointer to SDEC APPOINTMENT file (#409.84) "RTN","SDECDEV",123,0) ; TYPE - (required) Letter type "RTN","SDECDEV",124,0) ; P:Pre-Appointment "RTN","SDECDEV",125,0) ; C:Cancel Appointment "RTN","SDECDEV",126,0) ; N:No Show "RTN","SDECDEV",127,0) ; SDID - (required) Printer Device ID pointer to DEVICE file (#3.5) "RTN","SDECDEV",128,0) ;RETURN: "RTN","SDECDEV",129,0) ; CODE ^ MESSAGE "RTN","SDECDEV",130,0) ; CODE - 0=Success; -1=error "RTN","SDECDEV",131,0) ; MESSAGE "RTN","SDECDEV",132,0) N A,DFN,J,L,L0,L2,S,S1,SC,ZTS "RTN","SDECDEV",133,0) N SD9,SDAMTYP,SDBD,SDCL,SDC,SDCLN,SDED,SDFN,SDFIRST,SDFORM,SDLET,SDLET1,SDLT,SDNOD,SDRES,SDT,SDTTM,SDV1,SDWH,SDX,SDY "RTN","SDECDEV",134,0) N VAUTNALL,VAUTNI "RTN","SDECDEV",135,0) S SDFIRST=1 "RTN","SDECDEV",136,0) S RET=$NA(^TMP("SDECDEV",$J,"PRINT")) "RTN","SDECDEV",137,0) K @RET "RTN","SDECDEV",138,0) S @RET@(0)="I00030CODE^T00500MESSAGE"_$C(30) "RTN","SDECDEV",139,0) ;validate APID "RTN","SDECDEV",140,0) S APID=$G(APID) "RTN","SDECDEV",141,0) I APID="" S @RET@(1)="-1^Appointment ID is required."_$C(30,31) Q "RTN","SDECDEV",142,0) I '$D(^SDEC(409.84,APID,0)) S @RET@(1)="-1^Invalid Appointment ID."_$C(30,31) Q "RTN","SDECDEV",143,0) ;validate TYPE "RTN","SDECDEV",144,0) S TYPE=$G(TYPE) "RTN","SDECDEV",145,0) I TYPE="" S @RET@(1)="-1^Letter Type is required."_$C(30,31) Q "RTN","SDECDEV",146,0) I "PCN"'[TYPE S @RET@(1)="-1^Invalid Letter Type."_$C(30,31) Q "RTN","SDECDEV",147,0) ;validate SDID "RTN","SDECDEV",148,0) S SDID=$G(SDID) "RTN","SDECDEV",149,0) I SDID="" S @RET@(1)="-1^Device ID is required."_$C(30,31) Q "RTN","SDECDEV",150,0) I '$D(^%ZIS(1,SDID,0)) S @RET@(1)="-1^Invalid Device ID."_$C(30,31) Q "RTN","SDECDEV",151,0) ; "RTN","SDECDEV",152,0) S SDNOD=$G(^SDEC(409.84,APID,0)) "RTN","SDECDEV",153,0) I SDNOD="" S @RET@(1)="-1^Error getting Appointment data."_$C(30,31) Q "RTN","SDECDEV",154,0) S DFN=$P(SDNOD,U,5) "RTN","SDECDEV",155,0) ;check bad address "RTN","SDECDEV",156,0) I $$BADADR^DGUTL3(+DFN) S @RET@(1)="-1^THIS PATIENT HAS BEEN FLAGGED WITH A BAD ADDRESS INDICATOR, NO LETTER WILL BE PRINTED."_$C(30,31) Q "RTN","SDECDEV",157,0) ; "RTN","SDECDEV",158,0) S SDRES=$P(SDNOD,U,7) "RTN","SDECDEV",159,0) I SDRES="" S @RET@(1)="-1^Resource is not defined for this appointment."_$C(30,31) Q "RTN","SDECDEV",160,0) S SC=$$GET1^DIQ(409.831,SDRES_",",.04,"I") "RTN","SDECDEV",161,0) I SC="" S @RET@(1)="-1^Clinic is not defined for the resource."_$C(30,31) Q "RTN","SDECDEV",162,0) S (SDT,SDTTM)=$P(SDNOD,U,1) "RTN","SDECDEV",163,0) S SDWH=$P(SDNOD,U,17) "RTN","SDECDEV",164,0) S @RET@(1)="0^SUCCESS"_$C(30) "RTN","SDECDEV",165,0) D PRE:TYPE="P",CAN:TYPE="C",NS:TYPE="N" "RTN","SDECDEV",166,0) S @RET@(1)=@RET@(1)_$C(31) "RTN","SDECDEV",167,0) Q "RTN","SDECDEV",168,0) ; "RTN","SDECDEV",169,0) ; "RTN","SDECDEV",170,0) PRE ;print pre-appointment letter "RTN","SDECDEV",171,0) S SDY=0 F S SDY=$O(^SC(SC,"S",SDTTM,1,SDY)) Q:SDY="" Q:$P($G(^SC(SC,"S",SDTTM,1,SDY,0)),U,1)=DFN "RTN","SDECDEV",172,0) I SDY="" S @RET@(1)="-1^Clinic appointment not found."_$C(30) Q "RTN","SDECDEV",173,0) ;check for a PRE-APPT letter defined "RTN","SDECDEV",174,0) I $P($G(^SC(SC,"LTR")),U,2)="" S @RET@(1)="-1^A pre-appointment letter is not defined for "_$$GET1^DIQ(44,SC_",",.01)_"."_$C(30) Q "RTN","SDECDEV",175,0) ; "RTN","SDECDEV",176,0) ; pre-define letter type (P), the division, date for appt, etc. "RTN","SDECDEV",177,0) S (SDBD,SDED)=SDTTM,L0="P",SD9=0,VAUTNALL=1,VAUTNI=2,S1="P",SDLT=1,SDV1=1,SDFORM="" "RTN","SDECDEV",178,0) S L2=$S(L0="P":"^SDL1",1:"^SDL1"),J=SDBD "RTN","SDECDEV",179,0) S (A,SDFN,S)=DFN,L="^SDL1",SDCL=+$P(^SC(SC,0),U,1),SDC=SC,SDX=SDTTM "RTN","SDECDEV",180,0) S SDLET=$P(^SC(SC,"LTR"),U,2) ; letter IEN "RTN","SDECDEV",181,0) S SDLET1=SDLET "RTN","SDECDEV",182,0) S SDAMTYP="P" ;always by patient "RTN","SDECDEV",183,0) ;I SDY["DPT(" S SDAMTYP="P",SDFN=+SDY "RTN","SDECDEV",184,0) ;I SDY["SC(" S SDAMTYP="C",SDCLN=+SDY "RTN","SDECDEV",185,0) ; prepare to queue the letter if the user so desires "RTN","SDECDEV",186,0) N %ZIS,IOP,POP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE "RTN","SDECDEV",187,0) S IOP="`"_SDID "RTN","SDECDEV",188,0) S %ZIS("B")="",POP=0,%ZIS="MQ" D ^%ZIS "RTN","SDECDEV",189,0) I POP S @RET@(1)="-1^Print error."_$C(30) Q "RTN","SDECDEV",190,0) S ZTIO=ION,ZTRTN="QUE^SDM1A",ZTDESC="PRINT PRE-APPT LETTER",ZTDTH=$$NOW^XLFDT ;,ZTSAVE("*")="" "RTN","SDECDEV",191,0) F ZTS="A","AUTO(","DFN","DUZ","S","SC","SDCL","SDFORM","SDLET","SDWH","SDX" S ZTSAVE(ZTS)="" "RTN","SDECDEV",192,0) D ^%ZTLOAD K IO("Q") "RTN","SDECDEV",193,0) Q "RTN","SDECDEV",194,0) ; "RTN","SDECDEV",195,0) CAN ;print cancel-appointment letter "RTN","SDECDEV",196,0) N A,SDCL,SDL "RTN","SDECDEV",197,0) S SDL="" "RTN","SDECDEV",198,0) S A=DFN "RTN","SDECDEV",199,0) S SDCL(1)=SC_U_SDTTM "RTN","SDECDEV",200,0) I $D(^SC(SC,"LTR")) S:SDWH["P" SDL=$P(^SC(SC,"LTR"),"^",4) S:SDWH'["P" SDL=$P(^SC(SC,"LTR"),"^",3) "RTN","SDECDEV",201,0) I SDL="" S @RET@(1)="-1^Clinic is not assigned a "_$S(SDWH["P":"clinic",1:"appointment")_" cancellation letter"_$C(30) Q "RTN","SDECDEV",202,0) ; "RTN","SDECDEV",203,0) N %ZIS,POP,ZTDESC,ZTIO,ZTRTN,ZTSAVE "RTN","SDECDEV",204,0) S SDWH=$G(SDWH) "RTN","SDECDEV",205,0) I SDWH'="C",SDWH'="PC" S @RET@(1)="-1^Invalid Cancel Status"_$C(30) Q "RTN","SDECDEV",206,0) S IOP="`"_SDID "RTN","SDECDEV",207,0) S %ZIS("B")="",POP=0,%ZIS="MQ" D ^%ZIS ;alb/sat 665 - change ^%ZIS params to match PRE "RTN","SDECDEV",208,0) I POP S @RET@(1)="-1^Print error."_$C(30) Q "RTN","SDECDEV",209,0) S ZTIO=ION,ZTRTN="SDLET^SDCNP1A",ZTDESC="PRINT CANCEL APPOINTMENT LETTER",ZTDTH=$$NOW^XLFDT F ZTS="SDCL(","DUZ","DFN","DT","A","SDWH","AUTO(" S ZTSAVE(ZTS)="" "RTN","SDECDEV",210,0) K ZTS D ^%ZTLOAD K IO("Q") "RTN","SDECDEV",211,0) Q "RTN","SDECDEV",212,0) ; "RTN","SDECDEV",213,0) NS ;print no-show appointment letter "RTN","SDECDEV",214,0) N ALS,ANS,C,DATEND,SDDT,SDLET,SDLT1,SDMSG,SDNSACT,SDTIME,SDV1 "RTN","SDECDEV",215,0) I SDT="" S @RET@(1)="-1^Print error."_$C(30) Q "RTN","SDECDEV",216,0) S SDT=$P(SDT,".",1) "RTN","SDECDEV",217,0) S ALS="Y",ANS="N",C=SC,SDDT=DT "RTN","SDECDEV",218,0) S DATEND=SDT+.9 "RTN","SDECDEV",219,0) S (SDLT1,SDLET)="" "RTN","SDECDEV",220,0) S SDNSACT=0 "RTN","SDECDEV",221,0) S SDV1=$O(^DG(40.8,0)) "RTN","SDECDEV",222,0) S SDTIME=$P(SDNOD,U,23) "RTN","SDECDEV",223,0) S:SDTIME="" SDTIME="*" "RTN","SDECDEV",224,0) S SDMSG=" DOES NOT HAVE A NO-SHOW LETTER ASSIGNED TO IT!" "RTN","SDECDEV",225,0) I '$D(^SC(C,"LTR")) S @RET@(1)="-1^"_$P(^SC(C,0),"^")_SDMSG Q "RTN","SDECDEV",226,0) I $D(^SC(C,"LTR")),'+^SC(C,"LTR") S @RET@(1)="-1^"_$P(^SC(C,0),"^")_SDMSG Q "RTN","SDECDEV",227,0) I $D(^SC(C,"LTR")),+^SC(C,"LTR") S SDLET=+^("LTR") "RTN","SDECDEV",228,0) I SDLET="" S @RET@(1)="-1^"_$P(^SC(C,0),"^")_SDMSG Q "RTN","SDECDEV",229,0) S IOP="`"_SDID "RTN","SDECDEV",230,0) S %ZIS("B")="",POP=0,%ZIS="MQ" D ^%ZIS ;alb/sat 665 - change ^%ZIS params to match PRE "RTN","SDECDEV",231,0) I POP S @RET@(1)="-1^Print error."_$C(30) Q "RTN","SDECDEV",232,0) S ZTIO=ION,ZTRTN="START^SDN0",ZTDESC="PRINT NO SHOW APPOINTMENT LETTER",ZTDTH=$$NOW^XLFDT F ZTS="SC","SDDT","ALS","ANS","SDLET","SDV1","SDT","C","DATEND","SDTIME","SDLT1","AUTO(","SDNSACT" S ZTSAVE(ZTS)="" "RTN","SDECDEV",233,0) K ZTS D ^%ZTLOAD K IO("Q") "RTN","SDECDEV",234,0) Q "RTN","SDECIDX") 0^11^B47077475^B43422995 "RTN","SDECIDX",1,0) SDECIDX ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDECIDX",2,0) ;;5.3;Scheduling;**627,642,658,665**;Aug 13, 1993;Build 14 "RTN","SDECIDX",3,0) ; "RTN","SDECIDX",4,0) ; The following entry point causes the ^XTMP("SDEC","IDX" global "RTN","SDECIDX",5,0) ; to be rebuilt based on the scheduling of the SDEC BUILD IDX option. "RTN","SDECIDX",6,0) ENTRY ; When executed, the following actions will occur: "RTN","SDECIDX",7,0) ; - purge existing ^XTMP("SDEC","IDX" data "RTN","SDECIDX",8,0) ; - Loop through files 123, 403.5, 409.3, and 409.85 and placing content "RTN","SDECIDX",9,0) ; into the XTMP global for retrieval by the SDECIDX GET RPC call. "RTN","SDECIDX",10,0) ; "RTN","SDECIDX",11,0) D PURGE "RTN","SDECIDX",12,0) D BUILD "RTN","SDECIDX",13,0) Q "RTN","SDECIDX",14,0) ; "RTN","SDECIDX",15,0) PURGE ;EP- Delete the content of the global and set zero node "RTN","SDECIDX",16,0) ; "RTN","SDECIDX",17,0) K ^XTMP("SDEC","IDX") "RTN","SDECIDX",18,0) S ^XTMP("SDEC",0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT "RTN","SDECIDX",19,0) Q "RTN","SDECIDX",20,0) ; "RTN","SDECIDX",21,0) BUILD ;EP- Generate content "RTN","SDECIDX",22,0) ; "RTN","SDECIDX",23,0) N FILE,CNT,DLM "RTN","SDECIDX",24,0) S CNT=0 ;alb/sat 658 "RTN","SDECIDX",25,0) S DLM="|" "RTN","SDECIDX",26,0) F LP=123,403.5,409.3,409.85 D "RTN","SDECIDX",27,0) .D BLD(LP) "RTN","SDECIDX",28,0) D SETNODEC(CNT) "RTN","SDECIDX",29,0) Q "RTN","SDECIDX",30,0) ; "RTN","SDECIDX",31,0) BLD(FIL) ;EP- "RTN","SDECIDX",32,0) I FIL=123 D Q "RTN","SDECIDX",33,0) .D BLD123 "RTN","SDECIDX",34,0) E I FIL=403.5 D Q "RTN","SDECIDX",35,0) .D BLD4035 "RTN","SDECIDX",36,0) E I FIL=409.3 D Q "RTN","SDECIDX",37,0) .D BLD4093 "RTN","SDECIDX",38,0) E I FIL=409.85 D Q "RTN","SDECIDX",39,0) .D BLD40985 "RTN","SDECIDX",40,0) Q "RTN","SDECIDX",41,0) ; "RTN","SDECIDX",42,0) BLD123 ;EP- REQUEST/CONSULTATION (C) "RTN","SDECIDX",43,0) Q:'$$TEST("REQGET^SDEC51") "RTN","SDECIDX",44,0) ;Key stored in 4Oth piece "RTN","SDECIDX",45,0) ;SVCCONN - 27th piece "RTN","SDECIDX",46,0) ;SVCCONNP - 28th piece "RTN","SDECIDX",47,0) ;WLSVCCON - no value use "" "RTN","SDECIDX",48,0) ;Desired DATE - no value use 0 "RTN","SDECIDX",49,0) ;Origination Date - ORIGDT - 2nd piece "RTN","SDECIDX",50,0) ;Priority Group (PRIGRP header)- 24th piece "RTN","SDECIDX",51,0) N LP,NOD,NODRMG,GBL,SDSUB,SVCP "RTN","SDECIDX",52,0) N SDECY,SDECY1,SDBEG,SDEND,MAXREC,LASTSUB,SORTSTR "RTN","SDECIDX",53,0) S GBL="~GMR(123," "RTN","SDECIDX",54,0) D RMG^SDECRMG(.SDECY,9999999,,"REQUESTTYPE^C|WAITTIME^>=90|ALL^C",,,200) "RTN","SDECIDX",55,0) S LP=0 F S LP=$O(@SDECY@(LP)) Q:LP'>0 D "RTN","SDECIDX",56,0) .S NODRMG=@SDECY@(LP) "RTN","SDECIDX",57,0) .D REQGET^SDEC(.SDECY1,,,,,$P(NODRMG,U,2)) "RTN","SDECIDX",58,0) .D SETNODEP(GBL,$G(@SDECY1@(0))) "RTN","SDECIDX",59,0) .S NOD=@SDECY1@(1) "RTN","SDECIDX",60,0) .S SORTSTR=$P(NODRMG,U,3) "RTN","SDECIDX",61,0) .D SETNODE(SORTSTR,GBL_DLM_$$PC(NOD,1)_DLM_"C",NOD,40) "RTN","SDECIDX",62,0) .I $P(NOD,U,8)'="" D "RTN","SDECIDX",63,0) ..K SDSUB "RTN","SDECIDX",64,0) ..S SDSUB($P(NOD,U,8))="" "RTN","SDECIDX",65,0) ..D SETXREF("C","E",.SDSUB,$P(NOD,U,1)) "RTN","SDECIDX",66,0) .K @SDECY1 "RTN","SDECIDX",67,0) K @SDECY "RTN","SDECIDX",68,0) Q "RTN","SDECIDX",69,0) BLD4035 ;EP- RECALL REMINDERS (R) "RTN","SDECIDX",70,0) Q:'$$TEST("RECGET^SDEC52") "RTN","SDECIDX",71,0) ;Key stored in 42nd piece "RTN","SDECIDX",72,0) ;SVCCONN - 28th piece "RTN","SDECIDX",73,0) ;SVCCONNP - 29th piece "RTN","SDECIDX",74,0) ;WLSVCCON - no value use "" "RTN","SDECIDX",75,0) ;Desired DATE - 19th piece - External format "RTN","SDECIDX",76,0) ;Origination Date - ORIGDT - 32nd piece "RTN","SDECIDX",77,0) ;Priority Group (PRIGRP header)- 25th piece "RTN","SDECIDX",78,0) N LP,NOD,NODRMG,GBL,SVCP,SORTSTR "RTN","SDECIDX",79,0) N SDECY,SDECY1,DFN,SDBEG,SDEND,MAXREC,LASTSUB "RTN","SDECIDX",80,0) S GBL="~SD(403.5," "RTN","SDECIDX",81,0) D RMG^SDECRMG(.SDECY,9999999,,"REQUESTTYPE^R|WAITTIME^>=90",,,200) "RTN","SDECIDX",82,0) S LP=0 F S LP=$O(@SDECY@(LP)) Q:LP'>0 D "RTN","SDECIDX",83,0) .S NODRMG=@SDECY@(LP) "RTN","SDECIDX",84,0) .D RECGET^SDEC(.SDECY1,,,,,,$P(NODRMG,U,2)) "RTN","SDECIDX",85,0) .D SETNODEP(GBL,@SDECY1@(0)) "RTN","SDECIDX",86,0) .S NOD=@SDECY1@(1) "RTN","SDECIDX",87,0) .S SORTSTR=$P(NODRMG,U,3) "RTN","SDECIDX",88,0) .D SETNODE(SORTSTR,GBL_DLM_$$PC(NOD,1)_DLM_"R",NOD,42) "RTN","SDECIDX",89,0) .K @SDECY1 "RTN","SDECIDX",90,0) K @SDECY "RTN","SDECIDX",91,0) Q "RTN","SDECIDX",92,0) BLD4093 ;EP- SD WAIT LIST (E) "RTN","SDECIDX",93,0) Q:'$$TEST("WLGET^SDECWL1") "RTN","SDECIDX",94,0) ;Key stored in 56th piece "RTN","SDECIDX",95,0) ;SVCCONN - 36th piece "RTN","SDECIDX",96,0) ;SVCCONNP - 37th piece "RTN","SDECIDX",97,0) ;Desired DATE - 24th piece "RTN","SDECIDX",98,0) ;Origination Date - ORIGDT - 8th piece "RTN","SDECIDX",99,0) ;Enrollment Priority Group (PRIGRP header) - 33rd piece "RTN","SDECIDX",100,0) ;WLSVCCON - 44th piece "RTN","SDECIDX",101,0) N LP,NOD,NODRMG,GBL,SCPRI,SVCP "RTN","SDECIDX",102,0) N SDECY,SDECY1,MAXREC,SDBEG,SDEND,DFN,LASTSUB,SORTSTR "RTN","SDECIDX",103,0) S GBL="~SDWL(409.3," "RTN","SDECIDX",104,0) D RMG^SDECRMG(.SDECY,9999999,,"REQUESTTYPE^E|WAITTIME^>=90",,,200) "RTN","SDECIDX",105,0) S LP=0 F S LP=$O(@SDECY@(LP)) Q:LP'>0 D "RTN","SDECIDX",106,0) .S NODRMG=@SDECY@(LP) "RTN","SDECIDX",107,0) .D WLGET^SDEC(.SDECY1,$P(NODRMG,U,2)) "RTN","SDECIDX",108,0) .D SETNODEP(GBL,$G(@SDECY1@(0))) "RTN","SDECIDX",109,0) .S NOD=@SDECY1@(1) "RTN","SDECIDX",110,0) .S SORTSTR=$P(NODRMG,U,3) "RTN","SDECIDX",111,0) .D SETNODE(SORTSTR,GBL_DLM_$$PC(NOD,7)_DLM_"E",NOD,56) "RTN","SDECIDX",112,0) .K @SDECY1 "RTN","SDECIDX",113,0) K @SDECY "RTN","SDECIDX",114,0) Q "RTN","SDECIDX",115,0) BLD40985 ;EP- SDEC APPT REQUEST (A) "RTN","SDECIDX",116,0) Q:'$$TEST("ARGET^SDECAR1") "RTN","SDECIDX",117,0) ;Key stored in 56th piece "RTN","SDECIDX",118,0) ;SVCCONN - 29th piece "RTN","SDECIDX",119,0) ;SVCCONNP - 30th piece "RTN","SDECIDX",120,0) ;Desired DATE - 20th piece "RTN","SDECIDX",121,0) ;Origination Date - ORIGDT - 8th piece "RTN","SDECIDX",122,0) ;Priority Group (PRIGRP header) - 26th piece "RTN","SDECIDX",123,0) ;WLSVCCON = 37th piece "RTN","SDECIDX",124,0) N LP,NOD,NODRMG,GBL,SVCP,SORTSTR "RTN","SDECIDX",125,0) N SDECY,SDECY1,DFN,MAXREC,LASTSUB,ARIEN1,SDBEG,SDEND "RTN","SDECIDX",126,0) S GBL="~SDEC(409.85," "RTN","SDECIDX",127,0) D RMG^SDECRMG(.SDECY,9999999,,"REQUESTTYPE^A|WAITTIME^>=90",,,200) "RTN","SDECIDX",128,0) S LP=0 F S LP=$O(@SDECY@(LP)) Q:LP'>0 D "RTN","SDECIDX",129,0) .S NODRMG=@SDECY@(LP) "RTN","SDECIDX",130,0) .D ARGET^SDEC(.SDECY1,$P(NODRMG,U,2)) "RTN","SDECIDX",131,0) .D SETNODEP(GBL,$G(@SDECY1@(0))) "RTN","SDECIDX",132,0) .S NOD=@SDECY1@(1) "RTN","SDECIDX",133,0) .S SORTSTR=$P(NODRMG,U,3) "RTN","SDECIDX",134,0) .D SETNODE(SORTSTR,GBL_DLM_$$PC(NOD,7)_DLM_"A",NOD,56) "RTN","SDECIDX",135,0) .K @SDECY1 "RTN","SDECIDX",136,0) K @SDECY "RTN","SDECIDX",137,0) Q "RTN","SDECIDX",138,0) ; "RTN","SDECIDX",139,0) SETNODE(S1,S3,VAL,KEYP) ;EP- "RTN","SDECIDX",140,0) ; S1 - Sort String "RTN","SDECIDX",141,0) ; S2 - not used "RTN","SDECIDX",142,0) ; S3 - GBL | IEN | ACER "RTN","SDECIDX",143,0) ; VAL - "RTN","SDECIDX",144,0) ; KEYP - "RTN","SDECIDX",145,0) Q:'$L($D(S1))!'$L($D(S3)) "RTN","SDECIDX",146,0) N KEY "RTN","SDECIDX",147,0) S KEY=S1_DLM_S3 "RTN","SDECIDX",148,0) S CNT=$G(CNT)+1 "RTN","SDECIDX",149,0) S VAL=$P(VAL,$C(30)) "RTN","SDECIDX",150,0) S:$G(KEYP) $P(VAL,U,KEYP)=KEY "RTN","SDECIDX",151,0) S ^XTMP("SDEC","IDX","XREF1",S1,0,S3)=CNT "RTN","SDECIDX",152,0) S ^XTMP("SDEC","IDX","DATA",CNT)=$G(VAL) "RTN","SDECIDX",153,0) S ^XTMP("SDEC","IDX","XREF2",KEY)=CNT "RTN","SDECIDX",154,0) Q "RTN","SDECIDX",155,0) ; "RTN","SDECIDX",156,0) SETXREF(S4,S5,DX,DA,VAL) ;request type specific xref for 1 entry "RTN","SDECIDX",157,0) ; S4 = request type A C E or R "RTN","SDECIDX",158,0) ; S5 = xref subscript "RTN","SDECIDX",159,0) ; .DX = array of subscripts "RTN","SDECIDX",160,0) ; DA = pointer to request type "RTN","SDECIDX",161,0) ; VAL = value to set xref to; default to "" "RTN","SDECIDX",162,0) N SDI,SDSUB "RTN","SDECIDX",163,0) S VAL=$G(VAL) "RTN","SDECIDX",164,0) S SDSUB="" "RTN","SDECIDX",165,0) S SDI="" F S SDI=$O(DX(SDI)) Q:SDI="" D "RTN","SDECIDX",166,0) .S SDSUB=$S(SDSUB'="":SDSUB_",",1:"")_SDI "RTN","SDECIDX",167,0) S ^XTMP("SDEC","IDX","XREF"_S4,S5,SDSUB,DA)=VAL "RTN","SDECIDX",168,0) Q "RTN","SDECIDX",169,0) ; "RTN","SDECIDX",170,0) SETNODEC(CNT) ;EP- "RTN","SDECIDX",171,0) S ^XTMP("SDEC","IDX","COUNT")=$G(CNT) "RTN","SDECIDX",172,0) Q "RTN","SDECIDX",173,0) ; "RTN","SDECIDX",174,0) SETNODEP(GBL,VAL) ;EP- "RTN","SDECIDX",175,0) Q:'$L($D(GBL)) "RTN","SDECIDX",176,0) S ^XTMP("SDEC","IDX","PATTERNS",GBL)=$P($G(VAL),$C(30)) "RTN","SDECIDX",177,0) Q "RTN","SDECIDX",178,0) ; "RTN","SDECIDX",179,0) PC(VAL,PIECE,DLM) ;EP- "RTN","SDECIDX",180,0) S DLM=$G(DLM,U) "RTN","SDECIDX",181,0) Q $P($G(VAL),DLM,+$G(PIECE)) "RTN","SDECIDX",182,0) ; "RTN","SDECIDX",183,0) ; Test for tag/routine "RTN","SDECIDX",184,0) TEST(X) ;EP "RTN","SDECIDX",185,0) N Z "RTN","SDECIDX",186,0) S:X[U Z=$P(X,U),X=$P(X,U,2) "RTN","SDECIDX",187,0) Q:'$L(X)!(X'?.1"%"1.AN) 0 "RTN","SDECIDX",188,0) X ^%ZOSF("TEST") "RTN","SDECIDX",189,0) Q $S('$T:0,$G(Z)="":1,Z'?.1"%"1.AN:0,1:$T(@Z^@X)'="") "RTN","SDECIDX",190,0) ; "RTN","SDECIDX",191,0) ; The GETREC entry point is called by the SDECIDX GETREC RPC. "RTN","SDECIDX",192,0) ; Input: LASTREC - (optional) holds the key to the last call and when passed "RTN","SDECIDX",193,0) ; the next bolus of data will start with the "RTN","SDECIDX",194,0) ; following record. "RTN","SDECIDX",195,0) ; MAXREC - (optional) returns 25 records by default "RTN","SDECIDX",196,0) ; STYLE - (optional) (D)ata (default) or (R)ecord pointer. "RTN","SDECIDX",197,0) ; (D)ata returns data in the format specific to the file "RTN","SDECIDX",198,0) ; (R)ecord returns the Type^IEN of the Type file "RTN","SDECIDX",199,0) ; "RTN","SDECIDX",200,0) GETREC(DATA,LASTREC,MAXREC,STYLE) ;EP- "RTN","SDECIDX",201,0) N LP,REC,IDX,CNT,DLM "RTN","SDECIDX",202,0) S DLM="|" "RTN","SDECIDX",203,0) S DATA=$$TMPGBL "RTN","SDECIDX",204,0) S LASTREC=$G(LASTREC,"") "RTN","SDECIDX",205,0) S MAXREC=$G(MAXREC,25) "RTN","SDECIDX",206,0) S STYLE=$G(STYLE,"D") "RTN","SDECIDX",207,0) S CNT=0 "RTN","SDECIDX",208,0) I STYLE="D" D "RTN","SDECIDX",209,0) .S LP=LASTREC F S LP=$O(^XTMP("SDEC","IDX","XREF2",LP)) Q:LP="" D Q:((CNT\2)=MAXREC) "RTN","SDECIDX",210,0) ..S REC=^(LP) "RTN","SDECIDX",211,0) ..I $$PC(LP,8,DLM)="R",'$D(^SD(403.5,$$PC(LP,7,DLM),0)) Q ;record has been moved to RECALL REMINDERS REMOVED "RTN","SDECIDX",212,0) ..S REC=$P(^XTMP("SDEC","IDX","DATA",REC),$C(30)) "RTN","SDECIDX",213,0) ..S CNT=CNT+1 "RTN","SDECIDX",214,0) ..S @DATA@(CNT)=$G(^XTMP("SDEC","IDX","PATTERNS",$P(LP,DLM,6)))_$C(30) "RTN","SDECIDX",215,0) ..S CNT=CNT+1 "RTN","SDECIDX",216,0) ..S @DATA@(CNT)=REC_$C(30) "RTN","SDECIDX",217,0) E I STYLE="R" D "RTN","SDECIDX",218,0) .S @DATA@(0)="T00030TYPE^T00030IEN^T00030KEY"_$C(30) "RTN","SDECIDX",219,0) .S LP=LASTREC F S LP=$O(^XTMP("SDEC","IDX","XREF2",LP)) Q:LP="" D Q:(CNT=MAXREC) "RTN","SDECIDX",220,0) ..I $$PC(LP,8,DLM)="R",'$D(^SD(403.5,$$PC(LP,7,DLM),0)) Q ;record has been moved to RECALL REMINDERS REMOVED "RTN","SDECIDX",221,0) ..I $$PC(LP,8,DLM)="C",$$REQCHK^SDEC51("",$$PC(LP,7,DLM)) Q ;record has an activity scheduled or has been cancelled "RTN","SDECIDX",222,0) ..I $$PC(LP,8,DLM)="E",$$GET1^DIQ(409.3,$$PC(LP,7,DLM),23,"I")="C" Q ;alb/sat 665 - record is closed "RTN","SDECIDX",223,0) ..I $$PC(LP,8,DLM)="A",$$GET1^DIQ(409.85,$$PC(LP,7,DLM),23,"I")="C" Q ;alb/sat 665 - record is closed "RTN","SDECIDX",224,0) ..S CNT=CNT+1 "RTN","SDECIDX",225,0) ..S @DATA@(CNT)=$$PC(LP,8,DLM)_U_$$PC(LP,7,DLM)_U_LP_$C(30) "RTN","SDECIDX",226,0) S @DATA@(CNT)=$P(@DATA@(CNT),$C(30))_$C(30,31) "RTN","SDECIDX",227,0) Q "RTN","SDECIDX",228,0) ; "RTN","SDECIDX",229,0) TMPGBL() ;EP- "RTN","SDECIDX",230,0) K ^TMP("SDECIDX",$J) Q $NA(^($J)) "RTN","SDECIDX",231,0) ; Convert external dates to FileMan format "RTN","SDECIDX",232,0) CVTDT(VAL) ;EP- "RTN","SDECIDX",233,0) D DT^DILF(,VAL,.VAL) "RTN","SDECIDX",234,0) Q VAL "RTN","SDECIDX",235,0) ; Returns inverse date value "RTN","SDECIDX",236,0) INVDT(VAL) ;EP- "RTN","SDECIDX",237,0) Q:(VAL<1) VAL "RTN","SDECIDX",238,0) Q (9999999.9999-VAL) "RTN","SDECIDX",239,0) RECCNT(DATA) ;EP- "RTN","SDECIDX",240,0) S DATA=+$G(^XTMP("SDEC","IDX","COUNT")) "RTN","SDECIDX",241,0) Q "RTN","SDECU") 0^24^B23913880^B22991058 "RTN","SDECU",1,0) SDECU ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDECU",2,0) ;;5.3;Scheduling;**627,665**;Aug 13, 1993;Build 14 "RTN","SDECU",3,0) ; "RTN","SDECU",4,0) Q "RTN","SDECU",5,0) ; "RTN","SDECU",6,0) DIV() ;EP; -- returns division ien for user "RTN","SDECU",7,0) ;Q +$O(^DG(40.8,"C",DUZ(2),0)) ;cmi/maw 10/1/2009 patch 1011 orig line "RTN","SDECU",8,0) Q +$O(^DG(40.8,"AD",DUZ(2),0)) ;cmi/maw 10/1/2009 patch 1011 for station number "RTN","SDECU",9,0) ; "RTN","SDECU",10,0) DIVC(CLINIC) ;EP; -- returns division for clinic "RTN","SDECU",11,0) Q $$GET1^DIQ(44,+CLINIC,3.5,"I") "RTN","SDECU",12,0) ; "RTN","SDECU",13,0) FAC(CLINIC) ;EP; -- returns institution for clinic based on division "RTN","SDECU",14,0) NEW X S X=$$DIVC(CLINIC) "RTN","SDECU",15,0) Q $S(+X:$$GET1^DIQ(40.8,+X,.07,"I"),1:"") "RTN","SDECU",16,0) ; "RTN","SDECU",17,0) PRIN(CLINIC) ;PEP -- returns name of clinic's principal clinic "RTN","SDECU",18,0) NEW X S X=$$GET1^DIQ(44,+CLINIC,1916) "RTN","SDECU",19,0) Q $S(X]"":X,1:"UNAFFILIATED CLINICS") "RTN","SDECU",20,0) ; "RTN","SDECU",21,0) CONF() ;EP; -- returns confidential warning "RTN","SDECU",22,0) Q "Confidential Patient Data Covered by Privacy Act" "RTN","SDECU",23,0) ; "RTN","SDECU",24,0) GREETING(LETTER,PAT) ;EP; -- returns letter salutation "RTN","SDECU",25,0) NEW LINE "RTN","SDECU",26,0) S LINE="Dear " "RTN","SDECU",27,0) S LINE=LINE_$S($$SEX^SDECPAT(PAT)="M":"Mr. ",1:"Ms. ") "RTN","SDECU",28,0) ; "RTN","SDECU",29,0) ;S LINE=LINE_$$NAMEPRT^BDGF2(PAT,1) ;add printable name "RTN","SDECU",30,0) ;S LINE=LINE_$$NAMEPRT^BDGF2(PAT,1)_"," ;add printable name "RTN","SDECU",31,0) Q LINE "RTN","SDECU",32,0) ; "RTN","SDECU",33,0) PRV(SDCL) ; "RTN","SDECU",34,0) Q "RTN","SDECU",35,0) ; "RTN","SDECU",36,0) PAUSE N X "RTN","SDECU",37,0) U IO(0) W !!,"Press RETURN to continue, '^' to exit:" "RTN","SDECU",38,0) R X:$G(DTIME) "RTN","SDECU",39,0) U IO "RTN","SDECU",40,0) Q "RTN","SDECU",41,0) ; "RTN","SDECU",42,0) CLEAR ;remove SDEC RESOURCE USER entries; command line utility for testing "RTN","SDECU",43,0) N DA,DIK,SDI,SDJ,SDK "RTN","SDECU",44,0) S SDI=0 F S SDI=$O(^SDEC(409.833,SDI)) Q:SDI'>0 D "RTN","SDECU",45,0) .;W !,SDI "RTN","SDECU",46,0) .S DIK="^SDEC(409.833," "RTN","SDECU",47,0) .S DA=SDI "RTN","SDECU",48,0) .D ^DIK "RTN","SDECU",49,0) Q "RTN","SDECU",50,0) ;S SDI=0 F S SDI=$O(^SDEC(409.833,SDI)) Q:SDI'>0 W !,SDI S DIK="^SDEC(409.833," S DA=SDI D ^DIK "RTN","SDECU",51,0) ; "RTN","SDECU",52,0) DUPS ;find duplicate entries in SDEC APPOINTMENT "RTN","SDECU",53,0) N DUP,H,NOD,NOD2,PAT,RES,TYP "RTN","SDECU",54,0) ; 1 2 3 4 5 6 "RTN","SDECU",55,0) ;DUP("ENTERED",,,,,type)=CNT "RTN","SDECU",56,0) ;DUP("START", ,,,,type)=CNT "RTN","SDECU",57,0) S H=0 F S H=$O(^SDEC(409.84,H)) Q:H'>0 D "RTN","SDECU",58,0) .S NOD=$G(^SDEC(409.84,H,0)) "RTN","SDECU",59,0) .S NOD2=$G(^SDEC(409.84,H,2)) "RTN","SDECU",60,0) .S PAT=$P(NOD,U,5)_" "_$$GET1^DIQ(2,$P(NOD,U,5)_",",.01) "RTN","SDECU",61,0) .S RES=$P(NOD,U,7)_" "_$$GET1^DIQ(409.831,$P(NOD,U,7)_",",.01) "RTN","SDECU",62,0) .S TYP=$$GET1^DIQ(409.84,H_",",.22) S TYP=$S(TYP="":0,1:TYP) "RTN","SDECU",63,0) .S DUP("ENTERED",$P(NOD,U,9),$P(NOD,U,1),PAT,RES,TYP)=$G(DUP($P(NOD,U,1),PAT,RES,$P(NOD,U,9),TYP))+1 "RTN","SDECU",64,0) .S DUP("START",$P(NOD,U,1),PAT,RES,$P(NOD,U,9),TYP)=$G(DUP($P(NOD,U,1),PAT,RES,$P(NOD,U,9),TYP))+1 "RTN","SDECU",65,0) N S1,S2,S3,S4,S5 "RTN","SDECU",66,0) S S1="" F S S1=$O(DUP(S1)) Q:S1="" D "RTN","SDECU",67,0) .S S2="" F S S2=$O(DUP(S1,S2)) Q:S2="" D "RTN","SDECU",68,0) ..S S3="" F S S3=$O(DUP(S1,S2,S3)) Q:S3="" D "RTN","SDECU",69,0) ...S S4="" F S S4=$O(DUP(S1,S2,S3,S4)) Q:S4="" D "RTN","SDECU",70,0) ....S S5="" F S S5=$O(DUP(S1,S2,S3,S4,S5)) Q:S5="" D "RTN","SDECU",71,0) .....W !,$E(S1,1,12),?(14),$E(S2,1,15),?(31),$E(S3,1,15),?(48),$E(S4,1,12),?(62),S5," ",DUP(S1,S2,S3,S4,S5) "RTN","SDECU",72,0) Q "RTN","SDECU",73,0) ; "RTN","SDECU",74,0) GETSUB(TXT) ; "RTN","SDECU",75,0) N LAST "RTN","SDECU",76,0) S LAST="" "RTN","SDECU",77,0) I +TXT,+TXT=TXT S LAST=TXT-1 ;alb/sat 665 - handle numeric "RTN","SDECU",78,0) E D "RTN","SDECU",79,0) .S LAST=$E(TXT,$L(TXT)) "RTN","SDECU",80,0) .S LAST=$C($A(LAST)-1) "RTN","SDECU",81,0) .S LAST=$E(TXT,1,$L(TXT)-1)_LAST_"~" "RTN","SDECU",82,0) Q LAST "RTN","SDECU",83,0) ; "RTN","SDECU",84,0) FILL(PADS,CHAR) ;pad string "RTN","SDECU",85,0) N I,RET "RTN","SDECU",86,0) S CHAR=$G(CHAR) "RTN","SDECU",87,0) S:CHAR="" CHAR=" " "RTN","SDECU",88,0) S RET="" "RTN","SDECU",89,0) F I=1:1:PADS S RET=RET_CHAR "RTN","SDECU",90,0) Q RET "RTN","SDECU",91,0) ; "RTN","SDECU",92,0) RPC(BUILD) ;list rpcs Same as fields used in 7.2 Interface Detailed Design "RTN","SDECU",93,0) N DASH,RP,RPA,RPN,SDI,SDJ,SDK "RTN","SDECU",94,0) Q:$G(BUILD)="" "RTN","SDECU",95,0) S BUILD=$O(^XPD(9.6,"B",BUILD,0)) "RTN","SDECU",96,0) Q:BUILD="" "RTN","SDECU",97,0) S $P(DASH,"-",75)="-" "RTN","SDECU",98,0) S SDI=0 F S SDI=$O(^XPD(9.6,BUILD,"KRN",8994,"NM",SDI)) Q:SDI'>0 D "RTN","SDECU",99,0) .S RPN=$P($G(^XPD(9.6,BUILD,"KRN",8994,"NM",SDI,0)),U,1) "RTN","SDECU",100,0) .S RP(RPN)=$O(^XWB(8994,"B",RPN,0)) "RTN","SDECU",101,0) S RPN="" F S RPN=$O(RP(RPN)) Q:RPN="" D "RTN","SDECU",102,0) .S RP=RP(RPN) "RTN","SDECU",103,0) .W !!,DASH,!! "RTN","SDECU",104,0) .;NAME "RTN","SDECU",105,0) .W RPN "RTN","SDECU",106,0) .;DESCRIPTION "RTN","SDECU",107,0) .S SDJ=0 F S SDJ=$O(^XWB(8994,RP,1,SDJ)) Q:SDJ'>0 W !,^(SDJ,0) "RTN","SDECU",108,0) .;INPUT "RTN","SDECU",109,0) .W !!,"***INPUT:" "RTN","SDECU",110,0) .I $O(^XWB(8994,RP,2,0))'>0 W !," NO INPUT" "RTN","SDECU",111,0) .S SDJ=0 F S SDJ=$O(^XWB(8994,RP,2,SDJ)) Q:SDJ'>0 D "RTN","SDECU",112,0) ..W !," ",$P(^XWB(8994,RP,2,SDJ,0),U,1) "RTN","SDECU",113,0) ..S SDK=0 F S SDK=$O(^XWB(8994,RP,2,SDJ,1,SDK)) Q:SDK'>0 D "RTN","SDECU",114,0) ...W !,^XWB(8994,RP,2,SDJ,1,SDK,0) "RTN","SDECU",115,0) .W !!,"***RETURN:" "RTN","SDECU",116,0) .S SDJ=0 F S SDJ=$O(^XWB(8994,RP,3,SDJ)) Q:SDJ'>0 D "RTN","SDECU",117,0) ..W !,^XWB(8994,RP,3,SDJ,0) "RTN","SDECU",118,0) Q "RTN","SDECU",119,0) ; "RTN","SDECU",120,0) RPC2(BUILD) ;list rpcs - same fields as 6.2.2.3.11 Remote Procedure Call (RPC) "RTN","SDECU",121,0) N DASH,DATA,RP,RPA,RPN,SDI,SDJ,SDK,X "RTN","SDECU",122,0) Q:$G(BUILD)="" "RTN","SDECU",123,0) S BUILD=$O(^XPD(9.6,"B",BUILD,0)) "RTN","SDECU",124,0) Q:BUILD="" "RTN","SDECU",125,0) S $P(DASH,"-",75)="-" "RTN","SDECU",126,0) S SDI=0 F S SDI=$O(^XPD(9.6,BUILD,"KRN",8994,"NM",SDI)) Q:SDI'>0 D "RTN","SDECU",127,0) .S RPN=$P($G(^XPD(9.6,BUILD,"KRN",8994,"NM",SDI,0)),U,1) "RTN","SDECU",128,0) .S RP(RPN)=$O(^XWB(8994,"B",RPN,0)) "RTN","SDECU",129,0) S RPN="" F S RPN=$O(RP(RPN)) Q:RPN="" D "RTN","SDECU",130,0) .S RP=RP(RPN) "RTN","SDECU",131,0) .K DATA "RTN","SDECU",132,0) .D GETS^DIQ(8994,RP,"*","IE","DATA") "RTN","SDECU",133,0) .S X="DATA(8994,"""_RP_","")" "RTN","SDECU",134,0) .W !!,DASH,!! "RTN","SDECU",135,0) .W "Name",?20,RPN "RTN","SDECU",136,0) .W !,"TAG^RTN",?20,@X@(.02,"E")_"^"_@X@(.03,"E") "RTN","SDECU",137,0) .W !!,"***Input Parameters" "RTN","SDECU",138,0) .I $O(^XWB(8994,RP,2,0))'>0 W !," NO INPUT" "RTN","SDECU",139,0) .S SDJ=0 F S SDJ=$O(^XWB(8994,RP,2,SDJ)) Q:SDJ'>0 D "RTN","SDECU",140,0) ..W !," ",$P(^XWB(8994,RP,2,SDJ,0),U,1) "RTN","SDECU",141,0) ..S SDK=0 F S SDK=$O(^XWB(8994,RP,2,SDJ,1,SDK)) Q:SDK'>0 D "RTN","SDECU",142,0) ...W !,^XWB(8994,RP,2,SDJ,1,SDK,0) "RTN","SDECU",143,0) .W !!,"Return Value Type",?20,@X@(.04,"E") "RTN","SDECU",144,0) .;DESCRIPTION "RTN","SDECU",145,0) .W !!,"DESCRIPTION" "RTN","SDECU",146,0) .S SDJ=0 F S SDJ=$O(^XWB(8994,RP,1,SDJ)) Q:SDJ'>0 W !,^(SDJ,0) "RTN","SDECU",147,0) Q "RTN","SDECUTL") 0^12^B101052538^B100019264 "RTN","SDECUTL",1,0) SDECUTL ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDECUTL",2,0) ;;5.3;Scheduling;**627,658,665**;Aug 13, 1993;Build 14 "RTN","SDECUTL",3,0) ; "RTN","SDECUTL",4,0) ;Reference is made to ICR #4837 "RTN","SDECUTL",5,0) Q "RTN","SDECUTL",6,0) ; "RTN","SDECUTL",7,0) SYSSTAT(SDECY) ; SYSTEM STATUS "RTN","SDECUTL",8,0) ;SYSSTAT(SDECY) external parameter tag in SDEC "RTN","SDECUTL",9,0) N SDECCNT,SDECD,SDECH,SDECII,SDECROW,SDECROW1,SDECYA "RTN","SDECUTL",10,0) S SDECII=0 "RTN","SDECUTL",11,0) S SDECY=$NA(^TMP("SDEC",$J)) K @SDECY "RTN","SDECUTL",12,0) ;S SDECYA=$NA(^SDECTMPA($J)) K @SDECYA "RTN","SDECUTL",13,0) S @SDECY@(SDECII)="T00080ERROR_ID^T00080ERROR_TEXT"_$C(30) "RTN","SDECUTL",14,0) S SDECII=SDECII+1 S @SDECY@(SDECII)=$C(30,31) "RTN","SDECUTL",15,0) Q "RTN","SDECUTL",16,0) ; "RTN","SDECUTL",17,0) STRIP(SDECSTR) ; "RTN","SDECUTL",18,0) ; SDECSTR = input string to parse "RTN","SDECUTL",19,0) N SDECDN,SDECI,SDECPC,SDECPCNT,SDECPDN,SDECRET "RTN","SDECUTL",20,0) Q:$E(SDECSTR,1,8)=" " "" "RTN","SDECUTL",21,0) S SDECI="" "RTN","SDECUTL",22,0) S SDECRET="" "RTN","SDECUTL",23,0) S SDECPCNT="" "RTN","SDECUTL",24,0) S SDECDN="" "RTN","SDECUTL",25,0) F Q:SDECDN D "RTN","SDECUTL",26,0) . S SDECI=SDECI+1 "RTN","SDECUTL",27,0) . Q:$E(SDECSTR,SDECI)=" " "RTN","SDECUTL",28,0) . S SDECPCNT=SDECPCNT+1 "RTN","SDECUTL",29,0) . S SDECPC="" "RTN","SDECUTL",30,0) . S SDECPDN="" "RTN","SDECUTL",31,0) . F Q:SDECPDN D "RTN","SDECUTL",32,0) . . S SDECPC=SDECPC_$E(SDECSTR,SDECI) "RTN","SDECUTL",33,0) . . S SDECI=SDECI+1 "RTN","SDECUTL",34,0) . . I ($E(SDECSTR,SDECI)=" ")!(SDECI>$L(SDECSTR)) S SDECPDN=1 "RTN","SDECUTL",35,0) . ; "RTN","SDECUTL",36,0) . S SDECRET=$S(SDECPCNT'=1:SDECRET_U,1:"")_$S(SDECPCNT=4:$E(SDECPC,1,8),1:SDECPC) "RTN","SDECUTL",37,0) . I (SDECPCNT=4)!(SDECI>$L(SDECSTR)) S SDECDN=1 "RTN","SDECUTL",38,0) ; "RTN","SDECUTL",39,0) Q SDECRET "RTN","SDECUTL",40,0) ; "RTN","SDECUTL",41,0) FL(SDECSTR,SDECW,SDECD) ;EP "RTN","SDECUTL",42,0) ;format line "RTN","SDECUTL",43,0) ; SDECSTR = Text String to be formatted "RTN","SDECUTL",44,0) ; SDECW = Maximum width of text line "RTN","SDECUTL",45,0) ; SDECD = Delimiter; defaults to double pipe "||" to be used as the line separator "RTN","SDECUTL",46,0) ; "RTN","SDECUTL",47,0) ;RETURNS string delimited by double pipe "||" to be used as line separator "RTN","SDECUTL",48,0) N SDECOUT,SDECPTR,SDECTMP "RTN","SDECUTL",49,0) I $G(SDECW)="" S SDECW=80 "RTN","SDECUTL",50,0) I '+SDECW S SDECW=80 "RTN","SDECUTL",51,0) I $L(SDECSTR)'>SDECW Q SDECSTR "RTN","SDECUTL",52,0) I $G(SDECD)="" S SDECD="||" "RTN","SDECUTL",53,0) S SDECOUT="" "RTN","SDECUTL",54,0) S SDECPTR=SDECW "RTN","SDECUTL",55,0) ;handle no spaces in the string "RTN","SDECUTL",56,0) I SDECSTR'[" " D "RTN","SDECUTL",57,0) . F Q:SDECSTR="" D "RTN","SDECUTL",58,0) . . I $L(SDECSTR)'>SDECW D "RTN","SDECUTL",59,0) . . . S SDECOUT=$S(SDECOUT'="":SDECOUT_SDECD,1:"")_SDECSTR "RTN","SDECUTL",60,0) . . . S SDECSTR="" "RTN","SDECUTL",61,0) . . I $L(SDECSTR)>SDECW D "RTN","SDECUTL",62,0) . . . S SDECOUT=$S(SDECOUT'="":SDECOUT_SDECD,1:"")_$E(SDECSTR,1,SDECW) "RTN","SDECUTL",63,0) . . . S SDECSTR=$E(SDECSTR,SDECW+1,$L(SDECSTR)) "RTN","SDECUTL",64,0) ;string does contain a space "RTN","SDECUTL",65,0) I SDECSTR[" " D "RTN","SDECUTL",66,0) . F Q:SDECSTR="" D "RTN","SDECUTL",67,0) . . I $L(SDECSTR)'>SDECW D "RTN","SDECUTL",68,0) . . . S SDECOUT=$S(SDECOUT'="":SDECOUT_SDECD,1:"")_SDECSTR "RTN","SDECUTL",69,0) . . . S SDECSTR="" "RTN","SDECUTL",70,0) . . I $L(SDECSTR)>SDECW D "RTN","SDECUTL",71,0) . . . F Q:$E(SDECSTR,SDECPTR)=" " D "RTN","SDECUTL",72,0) . . . . S SDECPTR=SDECPTR-1 "RTN","SDECUTL",73,0) . . . S SDECOUT=$S(SDECOUT'="":SDECOUT_SDECD,1:"")_$E(SDECSTR,1,SDECPTR-1) "RTN","SDECUTL",74,0) . . . S SDECSTR=$E(SDECSTR,SDECPTR+1,$L(SDECSTR)) "RTN","SDECUTL",75,0) . . . S SDECPTR=SDECW "RTN","SDECUTL",76,0) Q SDECOUT "RTN","SDECUTL",77,0) ; "RTN","SDECUTL",78,0) ; Check and validate visit "RTN","SDECUTL",79,0) CHKVISIT(VIEN,DFN,CAT) ;EP "RTN","SDECUTL",80,0) N RET,X0 "RTN","SDECUTL",81,0) S RET=$$ISLOCKED(VIEN) "RTN","SDECUTL",82,0) Q:RET $S(RET<0:$$ERR^SDEC44("Visit "_VIEN_" not found."),1:$$ERR^SDEC44("Visit "_VIEN_" is locked.")) "RTN","SDECUTL",83,0) S X0=$G(^AUPNVSIT(VIEN,0)) "RTN","SDECUTL",84,0) I $G(DFN),$P(X0,U,5)'=DFN S RET=$$ERR^SDEC44("Visit "_VIEN_" does not belong to Patient "_DFN_".") "RTN","SDECUTL",85,0) E I $P(X0,U,11) S RET=$$ERR^SDEC44("Visit "_VIEN_" has been deleted.") "RTN","SDECUTL",86,0) E I $L($G(CAT)),CAT'[$P(X0,U,7) S RET=$$ERR^SDEC44("Service Category of Visit "_VIEN_" is not "_CAT_".",$$EXTERNAL^DILFD(9000010,.07,,$P(X0,U,7))) "RTN","SDECUTL",87,0) Q RET "RTN","SDECUTL",88,0) ; "RTN","SDECUTL",89,0) ; Returns visit lock status: "RTN","SDECUTL",90,0) ; -1: Visit not found "RTN","SDECUTL",91,0) ; 0: Visit is not locked "RTN","SDECUTL",92,0) ; 1: Visit is locked "RTN","SDECUTL",93,0) ISLOCKED(IEN) ;PEP - Is visit locked? "RTN","SDECUTL",94,0) N DAT,DAYS,EXPDT "RTN","SDECUTL",95,0) S DAT=$$VISREFDT(IEN) "RTN","SDECUTL",96,0) Q:'DAT -1 "RTN","SDECUTL",97,0) ;IHS/MSC/PLS - 02/18/09 - Parameter now holds lock expiration date "RTN","SDECUTL",98,0) ;S EXPDT=$$GET^XPAR("USR","BEHOENCX VISIT LOCK OVERRIDE","`"_IEN) "RTN","SDECUTL",99,0) ;Q:EXPDT'<$$DT^XLFDT() 0 "RTN","SDECUTL",100,0) ;D:EXPDT DEL^XPAR("USR","BEHOENCX VISIT LOCK OVERRIDE","`"_IEN) ; remove expired locked "RTN","SDECUTL",101,0) ;Q:$$GET^XPAR("USR","BEHOENCX VISIT LOCK OVERRIDE","`"_IEN) 0 "RTN","SDECUTL",102,0) ;S DAYS=$$GET^XPAR("ALL","BEHOENCX VISIT LOCKED") "RTN","SDECUTL",103,0) Q $$FMDIFF^XLFDT(DT,DAT)>1 ;$S(DAYS<1:1,1:DAYS) "RTN","SDECUTL",104,0) ; Returns reference date for visit lock check "RTN","SDECUTL",105,0) VISREFDT(IEN) ; "RTN","SDECUTL",106,0) N ADM,DIS,DAT "RTN","SDECUTL",107,0) S DAT=$P($G(^AUPNVSIT(+IEN,0)),U,2) "RTN","SDECUTL",108,0) Q:'DAT "" "RTN","SDECUTL",109,0) S ADM=$O(^DGPM("AVISIT",IEN,0)) "RTN","SDECUTL",110,0) Q:'ADM DAT "RTN","SDECUTL",111,0) S DIS=$P($G(^DGPM(ADM,0)),U,17) "RTN","SDECUTL",112,0) Q $S(DIS:$P($G(^DGPM(DIS,0)),U),1:DT) "RTN","SDECUTL",113,0) ; "RTN","SDECUTL",114,0) ; Add/edit a file entry "RTN","SDECUTL",115,0) UPDATE(FDA,FLG,IEN) ;EP "RTN","SDECUTL",116,0) N ERR,DFN,X "RTN","SDECUTL",117,0) I $G(FLG)["@" S FLG=$TR(FLG,"@") "RTN","SDECUTL",118,0) E D "RTN","SDECUTL",119,0) .S X="FDA" "RTN","SDECUTL",120,0) .F S X=$Q(@X) Q:'$L(X) K:'$L(@X) @X "RTN","SDECUTL",121,0) Q:$D(FDA)'>1 "" "RTN","SDECUTL",122,0) D UPDATE^DIE(.FLG,"FDA","IEN","ERR") "RTN","SDECUTL",123,0) K FDA "RTN","SDECUTL",124,0) Q $S($G(ERR("DIERR",1)):-ERR("DIERR",1)_U_ERR("DIERR",1,"TEXT",1),1:"") "RTN","SDECUTL",125,0) ; "RTN","SDECUTL",126,0) ISACTIVE(ADT,IDT,CDT) ;is CDT an active date given an active date and inactive date "RTN","SDECUTL",127,0) ;INPUT: "RTN","SDECUTL",128,0) ; ADT = Activation date in FM format "RTN","SDECUTL",129,0) ; IDT = Inactivation date in FM format "RTN","SDECUTL",130,0) ; CDT = date to check - default to 'today' "RTN","SDECUTL",131,0) ;RETURN: "RTN","SDECUTL",132,0) ; 0=inactive "RTN","SDECUTL",133,0) ; 1=active "RTN","SDECUTL",134,0) ; 2=ADT & IDT null; calling routine can decide if default to active or inactive "RTN","SDECUTL",135,0) ; 3=date to check is before both activation and inactivation; calling routine can decide if default to active or inactive "RTN","SDECUTL",136,0) N RET "RTN","SDECUTL",137,0) S RET="" "RTN","SDECUTL",138,0) S ADT=$S($P($G(ADT),".",1)?7N:$P(ADT,".",1),1:"") "RTN","SDECUTL",139,0) S IDT=$S($P($G(IDT),".",1)?7N:$P(IDT,".",1),1:"") "RTN","SDECUTL",140,0) S CDT=$S($P($G(CDT),".",1)?7N:$P(CDT,".",1),1:$P($$NOW^XLFDT,".",1)) "RTN","SDECUTL",141,0) ;0 0 "RTN","SDECUTL",142,0) I ADT="",IDT="" S RET=2 "RTN","SDECUTL",143,0) Q:RET'="" RET "RTN","SDECUTL",144,0) ;1 0 "RTN","SDECUTL",145,0) I ADT'="",IDT="" D "RTN","SDECUTL",146,0) .S RET=1 ;TODO: what if 'today' or CDT is before ADT "RTN","SDECUTL",147,0) Q:RET'="" RET "RTN","SDECUTL",148,0) ;0 1 "RTN","SDECUTL",149,0) I ADT="",IDT'="" S RET=0 ;TODO: what if 'today' or CDT is before IDT "RTN","SDECUTL",150,0) Q:RET'="" RET "RTN","SDECUTL",151,0) ;1 1 "RTN","SDECUTL",152,0) ; active < T < inactive "RTN","SDECUTL",153,0) I CDT'IDT S RET=1 "RTN","SDECUTL",154,0) Q:RET'="" RET "RTN","SDECUTL",155,0) ; active < inactive < T "RTN","SDECUTL",156,0) I ADT0 D Q:SDAPPT'="" "RTN","SDECUTL",174,0) .S SDNOD=$G(^SDEC(409.84,SDI,0)) "RTN","SDECUTL",175,0) .Q:SDBEG'=$P(SDNOD,U,1) "RTN","SDECUTL",176,0) .I +SDRES Q:+SDRES'=$P(SDNOD,U,7) "RTN","SDECUTL",177,0) .I 'SDRES S SDARES=$P(SDNOD,U,7) S SDRCL=$P($G(^SDEC(409.831,+SDARES,0)),U,4) Q:SDRCL'=SDCL "RTN","SDECUTL",178,0) .S SDAPPT=SDI "RTN","SDECUTL",179,0) Q SDAPPT "RTN","SDECUTL",180,0) ; "RTN","SDECUTL",181,0) GETRES(SDCL,INACT) ;get resource for clinic - SDEC RESOURCE "RTN","SDECUTL",182,0) N SDHLN,SDI,SDNOD,SDRES,SDRES1 "RTN","SDECUTL",183,0) S (SDRES,SDRES1)="" "RTN","SDECUTL",184,0) S SDHLN=$P($G(^SC(SDCL,0)),U,1) "RTN","SDECUTL",185,0) Q:SDHLN="" "" "RTN","SDECUTL",186,0) S SDI="" F S SDI=$O(^SDEC(409.831,"ALOC",SDCL,SDI)) Q:SDI="" D Q:SDRES'="" "RTN","SDECUTL",187,0) .S SDNOD=$G(^SDEC(409.831,SDI,0)) "RTN","SDECUTL",188,0) .I '$G(INACT) Q:$$GET1^DIQ(409.831,SDI_",",.02)="YES" "RTN","SDECUTL",189,0) .S:SDRES1="" SDRES1=SDI "RTN","SDECUTL",190,0) .Q:$P($P(SDNOD,U,11),";",2)'="SC(" "RTN","SDECUTL",191,0) .S SDRES=SDI "RTN","SDECUTL",192,0) .;I $$UP^XLFSTR($P(SDNOD,U,1))=SDHLN S SDRES=SDI "RTN","SDECUTL",193,0) I SDRES="",SDRES1'="" S SDRES=SDRES1 "RTN","SDECUTL",194,0) Q SDRES "RTN","SDECUTL",195,0) ; "RTN","SDECUTL",196,0) RECALL(DFN,SDT,SDCL) ;is this appointment for RECALL "RTN","SDECUTL",197,0) ;INPUT: "RTN","SDECUTL",198,0) ; DFN = Patient ID pointer to PATIENT file 2 "RTN","SDECUTL",199,0) ; SDT = Appointment date/time in fm format "RTN","SDECUTL",200,0) N SDI,SDNOD1,SDRET "RTN","SDECUTL",201,0) S SDRET="" "RTN","SDECUTL",202,0) S SDI=0 F S SDI=$O(^SD(403.56,"B",DFN,SDI)) Q:SDI'>0 D Q:SDRET'="" "RTN","SDECUTL",203,0) .S SDNOD1=$G(^SD(403.56,SDI,1)) "RTN","SDECUTL",204,0) .Q:$P(SDNOD1,U,1)'=SDT "RTN","SDECUTL",205,0) .Q:$P(SDNOD1,U,2)'=SDCL "RTN","SDECUTL",206,0) .S SDRET=SDI "RTN","SDECUTL",207,0) Q SDRET "RTN","SDECUTL",208,0) ; "RTN","SDECUTL",209,0) SDCL(SDAPID) ;get clinic for given SDEC APPOINTMENT id "RTN","SDECUTL",210,0) ;INPUT: "RTN","SDECUTL",211,0) ; SDAPID - appt ID pointer to SDEC APPOINTMENT file 409.84 "RTN","SDECUTL",212,0) ;RETURN: "RTN","SDECUTL",213,0) ; Clinic ID pointer to HOSPITAL LOCATION file 44 "RTN","SDECUTL",214,0) N SDAPTYP,SDCL "RTN","SDECUTL",215,0) S SDCL="" "RTN","SDECUTL",216,0) S SDAPTYP=$$GET1^DIQ(409.84,SDAPID_",",.22,"I") "RTN","SDECUTL",217,0) S:$P(SDAPTYP,"|",2)="SDWL(409.3," SDCL=$$GET1^DIQ(409.3,$P(SDAPTYP,"|",2)_",",13.2,"I") "RTN","SDECUTL",218,0) S:$P(SDAPTYP,"|",1)="SD(403.5," SDCL=$$GET1^DIQ(403.5,$P(SDAPTYP,"|",2)_",",4.5,"I") "RTN","SDECUTL",219,0) S:$P(SDAPTYP,"|",1)="GMR(123," SDCL=$$GET1^DIQ(123,$P(SDAPTYP,"|",2)_",",.04,"I") ;ICR 4837 "RTN","SDECUTL",220,0) Q SDCL "RTN","SDECUTL",221,0) ; "RTN","SDECUTL",222,0) PTSEC(DFN) ;patient sensitive & record access checks; calls DG SENSITIVE RECORD ACCESS api "RTN","SDECUTL",223,0) ;INPUT: "RTN","SDECUTL",224,0) ; DFN - patient ID pointer to PATIENT file 2 "RTN","SDECUTL",225,0) ;RETURN: "RTN","SDECUTL",226,0) ; RESULT - the following pipe pieces: "RTN","SDECUTL",227,0) ; 1. return code: "RTN","SDECUTL",228,0) ; -1-RPC/API failed "RTN","SDECUTL",229,0) ; Required variable not defined "RTN","SDECUTL",230,0) ; 0-No display/action required "RTN","SDECUTL",231,0) ; Not accessing own, employee, or sensitive record "RTN","SDECUTL",232,0) ; 1-Display warning message "RTN","SDECUTL",233,0) ; Sensitive and DG SENSITIVITY key holder "RTN","SDECUTL",234,0) ; or Employee and DG SECURITY OFFICER key holder "RTN","SDECUTL",235,0) ; 2-Display warning message/require OK to continue "RTN","SDECUTL",236,0) ; Sensitive and not a DG SENSITIVITY key holder "RTN","SDECUTL",237,0) ; Employee and not a DG SECURITY OFFICER key holder "RTN","SDECUTL",238,0) ; 3-Access to record denied "RTN","SDECUTL",239,0) ; Accessing own record "RTN","SDECUTL",240,0) ; 4-Access to Patient (#2) file records denied "RTN","SDECUTL",241,0) ; SSN not defined "RTN","SDECUTL",242,0) ; 2. display text/message "RTN","SDECUTL",243,0) ; 3. display text/message "RTN","SDECUTL",244,0) ; 4. display text/message "RTN","SDECUTL",245,0) ; "RTN","SDECUTL",246,0) N SDI,SDLINE,SDRET,SDSEC,SDTXT "RTN","SDECUTL",247,0) K SDRET,SDSEC "RTN","SDECUTL",248,0) S SDRET="" "RTN","SDECUTL",249,0) ;D PTSEC^DGSEC4(.SDSEC,DFN,0) ;alb/sat 658 "RTN","SDECUTL",250,0) D PTSEC4(.SDSEC,DFN,0) "RTN","SDECUTL",251,0) S $P(SDRET,"|",1)=SDSEC(1) "RTN","SDECUTL",252,0) S:$G(SDSEC(2))'="" $P(SDRET,"|",2)=SDSEC(2) ;I DUZ=51 S:$G(SDSEC(2))'="" $P(SDRET,"|",2)=$$STRIP1(SDSEC(2)) "RTN","SDECUTL",253,0) S:$G(SDSEC(3))'="" $P(SDRET,"|",3)=SDSEC(3) ;I DUZ=51 S:$G(SDSEC(3))'="" $P(SDRET,"|",3)=$$STRIP1(SDSEC(3)) "RTN","SDECUTL",254,0) S SDTXT="" "RTN","SDECUTL",255,0) S SDI=3 F S SDI=$O(SDSEC(SDI)) Q:SDI="" D "RTN","SDECUTL",256,0) .S SDLINE=$$STRIP1(SDSEC(SDI)) "RTN","SDECUTL",257,0) .Q:SDLINE?." " "RTN","SDECUTL",258,0) .S SDTXT=$S(SDTXT'="":SDTXT,1:"")_SDLINE "RTN","SDECUTL",259,0) S:SDTXT'="" $P(SDRET,"|",4)=SDTXT "RTN","SDECUTL",260,0) Q SDRET "RTN","SDECUTL",261,0) PTSEC4(RESULT,DFN,DGMSG,DGOPT) ;RPC/API entry point for patient sensitive & record access checks ;alb/sat 658 "RTN","SDECUTL",262,0) ;Output array (Required) "RTN","SDECUTL",263,0) ; RESULT(1)= -1-RPC/API failed "RTN","SDECUTL",264,0) ; Required variable not defined "RTN","SDECUTL",265,0) ; 0-No display/action required "RTN","SDECUTL",266,0) ; Not accessing own, employee, or sensitive record "RTN","SDECUTL",267,0) ; 1-Display warning message "RTN","SDECUTL",268,0) ; Sensitive and DG SENSITIVITY key holder "RTN","SDECUTL",269,0) ; or Employee and DG SECURITY OFFICER key holder "RTN","SDECUTL",270,0) ; 2-Display warning message/require OK to continue "RTN","SDECUTL",271,0) ; Sensitive and not a DG SENSITIVITY key holder "RTN","SDECUTL",272,0) ; Employee and not a DG SECURITY OFFICER key holder "RTN","SDECUTL",273,0) ; 3-Access to record denied "RTN","SDECUTL",274,0) ; Accessing own record "RTN","SDECUTL",275,0) ; 4-Access to Patient (#2) file records denied "RTN","SDECUTL",276,0) ; SSN not defined "RTN","SDECUTL",277,0) ; RESULT(2-10) = error or display messages "RTN","SDECUTL",278,0) ; "RTN","SDECUTL",279,0) ;Input parameters: DFN = Patient file entry (Required) "RTN","SDECUTL",280,0) ; DGMSG = If 1, generate message (optional) "RTN","SDECUTL",281,0) ; DGOPT = Option name^Menu text (Optional) "RTN","SDECUTL",282,0) ; "RTN","SDECUTL",283,0) K RESULT "RTN","SDECUTL",284,0) I $G(DFN)="" D Q "RTN","SDECUTL",285,0) .S RESULT(1)=-1 "RTN","SDECUTL",286,0) .S RESULT(2)="Required variable missing." "RTN","SDECUTL",287,0) S DGMSG=$G(DGMSG,0) "RTN","SDECUTL",288,0) D OWNREC^DGSEC4(.RESULT,DFN,$G(DUZ),DGMSG) "RTN","SDECUTL",289,0) I RESULT(1)=1 S RESULT(1)=3 Q "RTN","SDECUTL",290,0) I RESULT(1)=2 S RESULT(1)=4 Q "RTN","SDECUTL",291,0) K RESULT "RTN","SDECUTL",292,0) D SENS^DGSEC4(.RESULT,DFN,$G(DUZ)) "RTN","SDECUTL",293,0) I RESULT(1)=1 D "RTN","SDECUTL",294,0) .I $G(DUZ)="" D Q "RTN","SDECUTL",295,0) ..;DUZ must be defined to access sensitive record & update DG Security log "RTN","SDECUTL",296,0) ..S RESULT(1)=-1 "RTN","SDECUTL",297,0) ..S RESULT(2)="Your user code is undefined. This must be defined to access a restricted patient record." "RTN","SDECUTL",298,0) .;D SETLOG1^DGSEC(DFN,DUZ,,$G(DGOPT)) "RTN","SDECUTL",299,0) Q "RTN","SDECUTL",300,0) ; "RTN","SDECUTL",301,0) STRIP1(SDTXT) ;strip out "*" "RTN","SDECUTL",302,0) N SDI "RTN","SDECUTL",303,0) S SDTXT=$TR(SDTXT,"*","") "RTN","SDECUTL",304,0) F SDI=$L(SDTXT):-1:1 Q:$E(SDTXT,SDI)'=" " S SDTXT=$E(SDTXT,1,$L(SDTXT)-1) "RTN","SDECUTL",305,0) Q SDTXT "RTN","SDECUTL",306,0) ; "RTN","SDECUTL",307,0) WP(RET,STR,CH) ;Convert string STR to Word Processing array ;alb/sat 658 "RTN","SDECUTL",308,0) ;INPUT: "RTN","SDECUTL",309,0) ; STR - String to convert "RTN","SDECUTL",310,0) ; CH - Max characters per line "RTN","SDECUTL",311,0) ;RETURN: "RTN","SDECUTL",312,0) ; RET - WP Array RET(,0)= "RTN","SDECUTL",313,0) N CH1,CNT,BEG,END,LCNT "RTN","SDECUTL",314,0) K RET "RTN","SDECUTL",315,0) Q:$G(STR)="" "RTN","SDECUTL",316,0) I '+$G(CH) S CH=80 "RTN","SDECUTL",317,0) I $L(STR'>CH) S RET(1,0)=STR Q ;alb/sat 665 "RTN","SDECUTL",318,0) S (END,LCNT)=0 "RTN","SDECUTL",319,0) S BEG=1 "RTN","SDECUTL",320,0) F CNT=1:1:$L(STR) S CH1=$E(STR,CNT) D "RTN","SDECUTL",321,0) .I CH1=" " S END=CNT "RTN","SDECUTL",322,0) .I CNT'=BEG,'((CNT-BEG)#CH) D "RTN","SDECUTL",323,0) ..S LCNT=LCNT+1 S RET(LCNT,0)=$E(STR,BEG,$S(END'=0:END,1:CNT)) "RTN","SDECUTL",324,0) ..S BEG=$S(END'=0:END,1:CNT)+1 "RTN","SDECUTL",325,0) ..S END=0 "RTN","SDECUTL",326,0) I CNT'=BEG S LCNT=LCNT+1 S RET(LCNT,0)=$E(STR,BEG,$L(STR)) "RTN","SDECUTL",327,0) Q "RTN","SDECUTL",328,0) WPSTR(ARR) ;convert WP field array to single string ;alb/sat 658 "RTN","SDECUTL",329,0) N RET,WPI "RTN","SDECUTL",330,0) S RET="" "RTN","SDECUTL",331,0) Q:'$D(ARR) RET "RTN","SDECUTL",332,0) S WPI=0 F S WPI=$O(ARR(WPI)) Q:WPI="" D "RTN","SDECUTL",333,0) .S RET=RET_ARR(WPI) "RTN","SDECUTL",334,0) Q RET "RTN","SDECUTL",335,0) PF(STRING,SUB,DI) ;piece find "RTN","SDECUTL",336,0) N SDI "RTN","SDECUTL",337,0) S STRING=$G(STRING) Q:STRING="" "" "RTN","SDECUTL",338,0) S SUB=$G(SUB) Q:SUB="" "" "RTN","SDECUTL",339,0) S DI=$G(DI) S:DI="" DI=U "RTN","SDECUTL",340,0) F SDI=1:1:$L(STRING,DI) Q:$P(STRING,DI,SDI)=SUB "RTN","SDECUTL",341,0) Q SDI "RTN","SDECUTL",342,0) PD(STRING,PC,DI) ;piece delete "RTN","SDECUTL",343,0) N SDI,NSTR "RTN","SDECUTL",344,0) S NSTR="" "RTN","SDECUTL",345,0) S STRING=$G(STRING) Q:STRING="" STRING "RTN","SDECUTL",346,0) S PC=$G(PC) Q:'PC STRING "RTN","SDECUTL",347,0) S DI=$G(DI) S:DI="" DI=U "RTN","SDECUTL",348,0) F SDI=1:1:$L(STRING,DI) D "RTN","SDECUTL",349,0) .Q:SDI=PC "RTN","SDECUTL",350,0) .S NSTR=NSTR_$S(NSTR'="":DI,1:"")_$P(STRING,DI,SDI) "RTN","SDECUTL",351,0) Q NSTR "RTN","SDECUTL",352,0) PFD(STRING,SUB,DI) ;piece find/delete delete all pieces with matching SUB values "RTN","SDECUTL",353,0) N SDI,NSTR "RTN","SDECUTL",354,0) S NSTR="" "RTN","SDECUTL",355,0) S STRING=$G(STRING) Q:STRING="" STRING "RTN","SDECUTL",356,0) S SUB=$G(SUB) Q:SUB="" STRING "RTN","SDECUTL",357,0) S DI=$G(DI) S:DI="" DI=U "RTN","SDECUTL",358,0) F SDI=1:1:$L(STRING,DI) S:$P(STRING,DI,SDI)'=SUB NSTR=NSTR_$S(NSTR'="":DI,1:"")_$P(STRING,DI,SDI) "RTN","SDECUTL",359,0) Q NSTR "RTN","SDECUTL2") 0^25^B142335116^B140702694 "RTN","SDECUTL2",1,0) SDECUTL2 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDECUTL2",2,0) ;;5.3;Scheduling;**627,642,658,665**;Aug 13, 1993;Build 14 "RTN","SDECUTL2",3,0) ; "RTN","SDECUTL2",4,0) Q "RTN","SDECUTL2",5,0) ; "RTN","SDECUTL2",6,0) RESAB(SDAB,SDCL,SDBEG,SDEND,SDECRES) ;build access blocks for 1 clinic "RTN","SDECUTL2",7,0) ; SDECRES (optional) Resource pointer to SDEC RESOURCE file "RTN","SDECUTL2",8,0) ; used to build access blocks from clinic availability "RTN","SDECUTL2",9,0) ; for only this resource; all resources are build if null "RTN","SDECUTL2",10,0) ; .01 name "RTN","SDECUTL2",11,0) ; 2 type (clinic) "RTN","SDECUTL2",12,0) ; 1912 length of app't "RTN","SDECUTL2",13,0) ; 1914 hour clinic display begins default is 8am; whole number 0-16 "RTN","SDECUTL2",14,0) ; 1917 display increments per hour "RTN","SDECUTL2",15,0) ; 2505 inactive date "RTN","SDECUTL2",16,0) ; 2506 reactivate date "RTN","SDECUTL2",17,0) N SDAY,SDCLS,SDDATA,SDFIELDS,SDIN,SDLEN,SDRA,SDSI,SDT "RTN","SDECUTL2",18,0) I $P($G(SDBEG),".",1)'?7N S SDBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-1) "RTN","SDECUTL2",19,0) I $P($G(SDEND),".",1)'?7N S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),365) "RTN","SDECUTL2",20,0) S SDECRES=$G(SDECRES) I SDECRES'="",'$D(^SDEC(409.831,+SDECRES,0)) S SDECRES="" "RTN","SDECUTL2",21,0) S SDFIELDS=".01;2;1912;1914;1917;2505;2506" "RTN","SDECUTL2",22,0) D GETS^DIQ(44,SDCL_",",SDFIELDS,"IE","SDDATA","SDMSG") "RTN","SDECUTL2",23,0) Q:SDDATA(44,SDCL_",",2,"I")'="C" ;only clinic "RTN","SDECUTL2",24,0) I $$INACTIVE(SDCL,.SDBEG,.SDEND,SDDATA(44,SDCL_",",2505,"I"),SDDATA(44,SDCL_",",2506,"I")) Q ;only active "RTN","SDECUTL2",25,0) S SDLEN=SDDATA(44,SDCL_",",1912,"I") ;length of app't is required in file 44 "RTN","SDECUTL2",26,0) S SDCLS=SDDATA(44,SDCL_",",1914,"I") ;hour clinic display begins "RTN","SDECUTL2",27,0) S:SDCLS="" SDCLS=8 "RTN","SDECUTL2",28,0) S SDSI=SDDATA(44,SDCL_",",1917,"I") "RTN","SDECUTL2",29,0) ;add to SDEC ACCESS BLOCK from AVAILABILITY in file 44 "RTN","SDECUTL2",30,0) I 0 S SDAY=$$FMADD^XLFDT(SDBEG,-1) F S SDAY=$O(^SC(SDCL,"T",SDAY)) Q:SDAY'>0 Q:SDAY>SDEND D "RTN","SDECUTL2",31,0) .D RESABDAY(SDAB,SDCL,SDAY,SDLEN,SDCLS,+SDECRES) "RTN","SDECUTL2",32,0) ;add to SDEC ACCESS BLOCK from day templates in file 44 "RTN","SDECUTL2",33,0) ;F SDT="T0","T1","T2","T3","T4","T5","T6" D "RTN","SDECUTL2",34,0) D TDAY(SDAB,SDCL,SDCLS,SDLEN,SDSI,SDBEG,SDEND) "RTN","SDECUTL2",35,0) Q "RTN","SDECUTL2",36,0) ; "RTN","SDECUTL2",37,0) TDAY(SDAB,SDCL,SDCLS,SDLEN,SDSI,SDBEG,SDEND) ;add/update access blocks for day template SDT "RTN","SDECUTL2",38,0) ;SDBEG = (optional) Start date in fileman format; defaults to 'today' "RTN","SDECUTL2",39,0) ;SDEND = (optional) Stop date in fileman format; defaults to 365 days "RTN","SDECUTL2",40,0) N SDAY,SDAY1,SDBLKS,SDE,SDE1,SDJ,SDPAT,SDPAT1,SDSIM "RTN","SDECUTL2",41,0) S SDCL=$G(SDCL) "RTN","SDECUTL2",42,0) Q:SDCL="" "RTN","SDECUTL2",43,0) ;S SDT=$G(SDT) "RTN","SDECUTL2",44,0) ;Q:SDT'?1"T"1N "RTN","SDECUTL2",45,0) S SDLEN=$G(SDLEN) "RTN","SDECUTL2",46,0) I SDLEN="" S SDLEN=$$GET1^DIQ(44,SDCL_",",1912) "RTN","SDECUTL2",47,0) S SDCLS=$G(SDCLS) "RTN","SDECUTL2",48,0) I SDCLS="" S SDCLS=$$GET1^DIQ(44,SDCL_",",1914) ;SDCLS=8 "RTN","SDECUTL2",49,0) S SDSI=$G(SDSI) "RTN","SDECUTL2",50,0) I SDSI="" S SDSI=$$GET1^DIQ(44,SDCL_",",1917,"I") ;SDDATA(44,SDCL_",",1917,"I") "RTN","SDECUTL2",51,0) S SDBEG=$G(SDBEG) "RTN","SDECUTL2",52,0) ;S STDAT=$O(^SC(SDCL,"T",0)) S:STDAT<1 STDAT=DT "RTN","SDECUTL2",53,0) ;S SDBEG=$S(SDBEG'?7N:STDAT,SDBEG$P(SDEND,".",1) D TDAY1 "RTN","SDECUTL2",59,0) D TDAY1 "RTN","SDECUTL2",60,0) Q "RTN","SDECUTL2",61,0) TDAY1 ; "RTN","SDECUTL2",62,0) N D,SDA,SDTP,SS,ST,Y "RTN","SDECUTL2",63,0) S SDA=$S(SDSI=3:6,SDSI=6:12,1:8) "RTN","SDECUTL2",64,0) S SDTP="" "RTN","SDECUTL2",65,0) I '$D(^SC(SDCL,"ST",$P(SDBEG,".",1),1)) S ST='$$ST(SDCL,SDBEG) Q:ST "RTN","SDECUTL2",66,0) ;Q:'$D(^SC(SDCL,"ST",$P(SDBEG,".",1),1)) "RTN","SDECUTL2",67,0) I $D(^SC(SDCL,"ST",$P(SDBEG,".",1),9)) S SDTP=$G(^SC(SDCL,"OST",$P(SDBEG,".",1),1)) S SDTP=$E(SDTP,SDA,$L(SDTP)) "RTN","SDECUTL2",68,0) E D "RTN","SDECUTL2",69,0) .S D=$$DOW^XLFDT($P(SDBEG,".",1),1) "RTN","SDECUTL2",70,0) .S Y=D#7 "RTN","SDECUTL2",71,0) .S SS=$$FDT(SDCL,Y) "RTN","SDECUTL2",72,0) .Q:SS="" "RTN","SDECUTL2",73,0) .S SDTP=SS "RTN","SDECUTL2",74,0) Q:SDTP="" "RTN","SDECUTL2",75,0) K SDBLKS "RTN","SDECUTL2",76,0) D GETBLKS^SDECUTL1(.SDBLKS,SDTP,$P(SDBEG,".",1),SDCLS,SDLEN,SDSI,SDCL) "RTN","SDECUTL2",77,0) D RESNB^SDECUTL1(SDAB,.SDBLKS,SDCL,$P(SDBEG,".",1)) "RTN","SDECUTL2",78,0) K SDBLKS "RTN","SDECUTL2",79,0) Q "RTN","SDECUTL2",80,0) ; "RTN","SDECUTL2",81,0) S SDPAT1=$E($P($T(DAY),U,$E(SDT,2)+2),1,2) "RTN","SDECUTL2",82,0) S SDAY=$S(SDAY1'="":$$FMADD^XLFDT(SDAY1,-1),1:$P($$NOW^XLFDT,".",1)) ;$$FMADD^XLFDT(SDE,-1) "RTN","SDECUTL2",83,0) S SDE1=$$FMADD^XLFDT(SDAY,1) ;$S(SDEND'="":SDEND,1:$$FMADD^XLFDT(SDAY,365)) ;$S(SDAY1'="":SDAY1,1:$$FMADD^XLFDT(SDAY,365)) "RTN","SDECUTL2",84,0) F S SDAY=$$FMADD^XLFDT($P($$SCH^XLFDT($E("UMTWRFS",$E(SDT,2)+1),SDAY),".",1),1) Q:SDAY'>0 Q:SDAY>SDE1 D ;alb/sat 665 "RTN","SDECUTL2",85,0) .I $$GET1^DIQ(44,SDCL_",",1918.5,"I")'="Y",$D(^HOLIDAY("B",SDAY)) Q ;do not schedule on holidays "RTN","SDECUTL2",86,0) .Q:$D(^SC(SDCL,"T",SDAY,2,1)) ;if AVAILABILITY defined, this day is already built "RTN","SDECUTL2",87,0) .S SDSIM=$S(SDSI="":4,SDSI<3:4,SDSI:SDSI,1:4) "RTN","SDECUTL2",88,0) .S SDPAT=SDPAT1_" "_$E(SDAY,6,7)_$J("",SDSIM+SDSIM-6)_SDTP "RTN","SDECUTL2",89,0) .K SDBLKS "RTN","SDECUTL2",90,0) .D GETBLKS^SDECUTL1(.SDBLKS,SDPAT,SDAY,SDCLS,SDLEN,SDSI,SDCL) "RTN","SDECUTL2",91,0) .D RESNB^SDECUTL1(SDAB,.SDBLKS,SDCL,SDAY) "RTN","SDECUTL2",92,0) .K SDBLKS "RTN","SDECUTL2",93,0) Q "RTN","SDECUTL2",94,0) ST(SDCL,SDBEG) ;build ST "RTN","SDECUTL2",95,0) ;RETURN - 0=not buildable or built as holiday ;1=buildable "RTN","SDECUTL2",96,0) N D,SC,SDDT,SS,Y "RTN","SDECUTL2",97,0) S SDDT=$P(SDBEG,".",1) "RTN","SDECUTL2",98,0) S SC=SDCL "RTN","SDECUTL2",99,0) S D=$$DOW^XLFDT(SDDT,1) "RTN","SDECUTL2",100,0) S Y=D#7 "RTN","SDECUTL2",101,0) I $D(^HOLIDAY(SDDT))&($$GET1^DIQ(44,SDCL_",",1918.5,"I")'="Y") D H Q 0 "RTN","SDECUTL2",102,0) S SS=$$FDT(SDCL,Y) "RTN","SDECUTL2",103,0) Q:+SS="" 0 "RTN","SDECUTL2",104,0) S ^SC(+SDCL,"ST",SDDT,1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SDDT,6,7)_$S(SDSI=3:"",SDSI=6:" ",1:" ")_SS,^SC(+SDCL,"ST",SDDT,0)=SDDT "RTN","SDECUTL2",105,0) Q 1 "RTN","SDECUTL2",106,0) FDT(SDCL,Y) ;find day template pattern "RTN","SDECUTL2",107,0) N SDE,SDTP "RTN","SDECUTL2",108,0) S SDTP="" "RTN","SDECUTL2",109,0) S SDE=$O(^SC(SDCL,"T"_Y,99999999),-1) "RTN","SDECUTL2",110,0) Q:'SDE "" "RTN","SDECUTL2",111,0) S SDTP=$G(^SC(SDCL,"T"_Y,SDE,1)) "RTN","SDECUTL2",112,0) Q:SDTP="" "" "RTN","SDECUTL2",113,0) F S SDE=$O(^SC(SDCL,"T"_Y,SDE),-1) Q:SDE'>0 Q:$P(SDBEG,".",1)'0 D ;alb/sat 665 "RTN","SDECUTL2",167,0) .S SDNOD2=$G(SDAV(2,SDTIME,0)) "RTN","SDECUTL2",168,0) .S:SDB1="" SDB1=$P(SDNOD2,U,1) "RTN","SDECUTL2",169,0) .I PTIME'="" D "RTN","SDECUTL2",170,0) ..I (PSLOT'=$P(SDNOD2,U,2))!(($$ADD(PTIME,SDLEN)'=$P(SDNOD2,U,1))) D ;new block "RTN","SDECUTL2",171,0) ...S SDEND=$$ADD(PTIME,SDLEN) S SDEND=$S(SDEND<$P(SDNOD2,U,1):SDEND,1:$P(SDNOD2,U,1)) ;use the lesser of the 2 "RTN","SDECUTL2",172,0) ...S SDEND1=$S($E(SDEND,1,2)>23:"2359",1:SDEND) "RTN","SDECUTL2",173,0) ...;S SDEND1=$S($E(SDEND,1,2)>23:"0000",1:SDEND) "RTN","SDECUTL2",174,0) ...S SDBI=SDBI+1 S SDBLKS(SDBI)=$$FM(SDAY_"."_SDB1)_U_$$FM(SDAY_"."_SDEND1)_U_PSLOT_U_SDATAV "RTN","SDECUTL2",175,0) ...I SDEND'=$P(SDNOD2,U,1) D "RTN","SDECUTL2",176,0) ....S SDBI=SDBI+1 S SDBLKS(SDBI)=$$FM(SDAY_"."_SDEND)_U_$$FM(SDAY_"."_$P(SDNOD2,U,1))_U_0_U_SDATUN "RTN","SDECUTL2",177,0) ...S SDB1=$P(SDNOD2,U,1) "RTN","SDECUTL2",178,0) .S PTIME=$P(SDNOD2,U,1) "RTN","SDECUTL2",179,0) .S PSLOT=$P(SDNOD2,U,2) "RTN","SDECUTL2",180,0) I SDB1'="" D ;setup last block "RTN","SDECUTL2",181,0) .S SDEND=$$ADD(PTIME,$S(SDLEN>SDDH:SDLEN,1:SDDH)) "RTN","SDECUTL2",182,0) .S SDEND1=$S($E(SDEND,1,2)>23:"2359",1:SDEND) "RTN","SDECUTL2",183,0) .;S SDEND1=$S($E(SDEND,1,2)>23:"0000",1:SDEND) "RTN","SDECUTL2",184,0) .I $E(SDEND,1,2)>23 S SDEND="2359" "RTN","SDECUTL2",185,0) .;I $E(SDEND,1,2)>23 S SDEND="0000" "RTN","SDECUTL2",186,0) .S SDBI=SDBI+1 S SDBLKS(SDBI)=$$FM(SDAY_"."_SDB1)_U_$$FM(SDAY_"."_SDEND)_U_PSLOT_U_SDATAV "RTN","SDECUTL2",187,0) I PTIME<1800 D "RTN","SDECUTL2",188,0) .S SDBI=SDBI+1 S SDBLKS(SDBI)=$$FM(SDAY_"."_SDEND)_U_$$FM(SDAY_".1800")_U_0_U_SDATUN "RTN","SDECUTL2",189,0) K SDAV "RTN","SDECUTL2",190,0) Q "RTN","SDECUTL2",191,0) ; "RTN","SDECUTL2",192,0) COMPARE(T1,T2) ;compare time "RTN","SDECUTL2",193,0) ;RETURN: "RTN","SDECUTL2",194,0) ; 0 = same "RTN","SDECUTL2",195,0) ; 1 = T1 is greater than "RTN","SDECUTL2",196,0) ; 2 = T1 is less than "RTN","SDECUTL2",197,0) N T1M,T2M "RTN","SDECUTL2",198,0) S T1M=+T1,T2M=+T2 "RTN","SDECUTL2",199,0) Q:T1M=T2M 0 "RTN","SDECUTL2",200,0) Q:T1M>T2M 1 "RTN","SDECUTL2",201,0) Q:T1M59 S M1=M1-60,H1=H1+1 G:M1>59 AGAIN "RTN","SDECUTL2",210,0) I $L(H1)=1 S H1="0"_H1 "RTN","SDECUTL2",211,0) I $L(M1)=1 S M1="0"_M1 "RTN","SDECUTL2",212,0) Q H1_M1 "RTN","SDECUTL2",213,0) ; "RTN","SDECUTL2",214,0) FM(SDDATE) ;use to strip zeros off of the end of the time "RTN","SDECUTL2",215,0) N %DT,X,Y "RTN","SDECUTL2",216,0) S %DT="DT",X=SDDATE D ^%DT "RTN","SDECUTL2",217,0) Q Y "RTN","SDECUTL2",218,0) ; "RTN","SDECUTL2",219,0) DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR "RTN","SDECUTL2",220,0) ; "RTN","SDECUTL2",221,0) SDB(SDEC) ;add/update access blocks after clinic modifications using SDBUILD in routine SDB "RTN","SDECUTL2",222,0) ; SDEC = array of modified days or day templates "RTN","SDECUTL2",223,0) ; SDEC(,)="" "RTN","SDECUTL2",224,0) ; day = date in FM format "RTN","SDECUTL2",225,0) ; template = T# "RTN","SDECUTL2",226,0) N %,SDCL,SDCLN,SDT "RTN","SDECUTL2",227,0) S SDCL="" F S SDCL=$O(SDEC(SDCL)) Q:SDCL="" D "RTN","SDECUTL2",228,0) .D SDRES(SDCL) "RTN","SDECUTL2",229,0) .S SDT="" F S SDT=$O(SDEC(SDCL,SDT)) Q:SDT="" D "RTN","SDECUTL2",230,0) ..I $E(SDT,1)="T" D TDAY(SDCL,SDT) "RTN","SDECUTL2",231,0) ..I SDT?7N D RESABDAY(SDCL,SDT) "RTN","SDECUTL2",232,0) K SDEC "RTN","SDECUTL2",233,0) Q "RTN","SDECUTL2",234,0) ; "RTN","SDECUTL2",235,0) SDRES(SDCL) ;add clinic resource "RTN","SDECUTL2",236,0) N ABBR,SDDATA,SDDI,SDFDA,SDFOUND,SDI,SDNOD,SDRT "RTN","SDECUTL2",237,0) S SDFOUND=0 "RTN","SDECUTL2",238,0) S SDI="" F S SDI=$O(^SDEC(409.831,"ALOC",SDCL,SDI)) Q:SDI="" D Q:SDFOUND=1 "RTN","SDECUTL2",239,0) .S SDNOD=$G(^SDEC(409.831,SDI,0)) "RTN","SDECUTL2",240,0) .S SDRT=$P(SDNOD,U,11) "RTN","SDECUTL2",241,0) .I $P(SDRT,";",2)="SC(",$P(SDRT,";",1)=SDCL S SDFOUND=1 "RTN","SDECUTL2",242,0) S SDI=$S(SDFOUND=1:SDI,1:"+1") "RTN","SDECUTL2",243,0) S SDFIELDS=".01;1;1917" ;alb/sat 658 - add field 1 "RTN","SDECUTL2",244,0) D GETS^DIQ(44,SDCL_",",SDFIELDS,"IE","SDDATA") "RTN","SDECUTL2",245,0) S SDFDA(409.831,SDI_",",.01)=SDDATA(44,SDCL_",",.01,"E") "RTN","SDECUTL2",246,0) S SDDI=SDDATA(44,SDCL_",",1917,"E") S SDFDA(409.831,SDI_",",.03)=$E(SDDI,1,2) "RTN","SDECUTL2",247,0) S ABBR=SDDATA(44,SDCL_",",1,"E") S:ABBR'="" SDFDA(409.831,SDI_",",.011)=ABBR ;alb/sat 658 - add abbreviation "RTN","SDECUTL2",248,0) S SDFDA(409.831,SDI_",",.04)=SDCL "RTN","SDECUTL2",249,0) S SDFDA(409.831,SDI_",",.012)=SDCL_";SC(" "RTN","SDECUTL2",250,0) S SDFDA(409.831,SDI_",",.015)=$E($$NOW^XLFDT,1,12) "RTN","SDECUTL2",251,0) S SDFDA(409.831,SDI_",",.016)=DUZ "RTN","SDECUTL2",252,0) D UPDATE^DIE("","SDFDA") "RTN","SDECUTL2",253,0) Q "RTN","SDECUTL2",254,0) ; "RTN","SDECUTL2",255,0) INACTIVE(SDCL,SDBEG,SDEND,IDATE,RDATE) ; "RTN","SDECUTL2",256,0) ;INPUT: "RTN","SDECUTL2",257,0) ; SDCL - clinic ID "RTN","SDECUTL2",258,0) ; .SDBEG - begin date in FM format, no time "RTN","SDECUTL2",259,0) ; .SDEND - end date in FM format, no time "RTN","SDECUTL2",260,0) ; IDATE - clinic's inactivation date "RTN","SDECUTL2",261,0) ; RDATE - clinic's reactivation date "RTN","SDECUTL2",262,0) ;RETURN: "RTN","SDECUTL2",263,0) ; 0=Clinic is active "RTN","SDECUTL2",264,0) ; 1=Clinic is inactive "RTN","SDECUTL2",265,0) ; active 0 0 "RTN","SDECUTL2",266,0) I IDATE="" Q 0 "RTN","SDECUTL2",267,0) ; active but inactivated in future "RTN","SDECUTL2",268,0) I IDATE>SDBEG S SDEND=IDATE Q 0 "RTN","SDECUTL2",269,0) ; inactive 1 0 "RTN","SDECUTL2",270,0) I IDATE'>SDBEG,RDATE="" Q 1 ;alb/sat 665 "RTN","SDECUTL2",271,0) ; inactive 1 1 inactive but reactivated "RTN","SDECUTL2",272,0) ; inactive now reactive now "RTN","SDECUTL2",273,0) I IDATE'>SDBEG,RDATE'>SDBEG Q 0 ;alb/sat 665 "RTN","SDECUTL2",274,0) ; inactive now reactive future "RTN","SDECUTL2",275,0) I IDATE'>SDBEG,RDATE>IDATE S SDBEG=RDATE Q 0 ;alb/sat 665 "RTN","SDECUTL2",276,0) Q 1 "RTN","SDECUTL2",277,0) ; "RTN","SDECUTL2",278,0) DEL ; "RTN","SDECUTL2",279,0) N H "RTN","SDECUTL2",280,0) S H=0 F S H=$O(^SDEC(409.821,H)) Q:H'>0 W !,H," ",$G(^SDEC(409.821,H,0)) S SDFDA(409.821,H_",",.01)="@" D UPDATE^DIE("","SDFDA") "RTN","SDECUTL2",281,0) K ^SDEC(409.821,"ARSCT") "RTN","SDECUTL2",282,0) Q "RTN","SDECUTL2",283,0) DEL1 ; "RTN","SDECUTL2",284,0) N H "RTN","SDECUTL2",285,0) S H=0 F S H=$O(^SDEC(409.821,H)) Q:H'>0 S SDFDA(409.821,H_",",.01)="@" D UPDATE^DIE("","SDFDA") "RTN","SDECUTL2",286,0) K ^SDEC(409.821,"ARSCT") "RTN","SDECUTL2",287,0) Q "RTN","SDECUTL2",288,0) ; "RTN","SDECUTL2",289,0) ARRAY(DTARRAY,SDPAT,SDAY,SDLEN,SDCLS,SDSI,SDF) ;build date/time array from pattern "RTN","SDECUTL2",290,0) ; .DTARRAY - Array of cancelled date/times "RTN","SDECUTL2",291,0) ; CARRAY(FMDATE,TIME)= "RTN","SDECUTL2",292,0) ; SDPAT - (required) pattern "RTN","SDECUTL2",293,0) ; SDAY - (required) date in FM format (no time) "RTN","SDECUTL2",294,0) ; SDLEN - (required) length of appointment "RTN","SDECUTL2",295,0) ; SDCLS - (required) hour schedule starts; default to 8 "RTN","SDECUTL2",296,0) ; SDSI - (required) display increments per hour "RTN","SDECUTL2",297,0) N SDA,SDI,SDSIM "RTN","SDECUTL2",298,0) ;SDSIM - calculated using DISPLAY INCREMENTS PER HOUR field from file 44 "RTN","SDECUTL2",299,0) ; $S(X="":4,X<3:4,X:X,1:4) "RTN","SDECUTL2",300,0) S SDF=$G(SDF,0) ;cancelled flag "RTN","SDECUTL2",301,0) S SDA=$S(SDSI=3:6,SDSI=6:12,1:8) "RTN","SDECUTL2",302,0) S SDSIM=$S(SDSI="":4,SDSI<3:4,SDSI:SDSI,1:4) "RTN","SDECUTL2",303,0) ;S:$E(SDPAT)?1A SDPAT=$E(SDPAT,SDA,$L(SDPAT)) "RTN","SDECUTL2",304,0) ;1 2 3 4 OR 6 "RTN","SDECUTL2",305,0) D @SDSI "RTN","SDECUTL2",306,0) Q "RTN","SDECUTL2",307,0) 1 ;1 increments per hour (60 min) "RTN","SDECUTL2",308,0) N BSTART,CNT,HOUR,SDI "RTN","SDECUTL2",309,0) S BSTART="" "RTN","SDECUTL2",310,0) S SDI=0 "RTN","SDECUTL2",311,0) S HOUR=SDCLS-1 "RTN","SDECUTL2",312,0) F CNT=2:8 Q:CNT>$L(SDPAT) D "RTN","SDECUTL2",313,0) .I (CNT#8)=2 S HOUR=HOUR+1 "RTN","SDECUTL2",314,0) .S BSTART=SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR) "RTN","SDECUTL2",315,0) .S DTARRAY($P(BSTART,".",1),$P(BSTART,".",2))=$S(+SDF:"X",1:$E(SDPAT,CNT)) "RTN","SDECUTL2",316,0) Q "RTN","SDECUTL2",317,0) 2 ;2 increments per hour (30 min) "RTN","SDECUTL2",318,0) N BSTART,CNT,HOUR "RTN","SDECUTL2",319,0) S BSTART="" "RTN","SDECUTL2",320,0) S SDI=0 "RTN","SDECUTL2",321,0) S HOUR=SDCLS-1 "RTN","SDECUTL2",322,0) F CNT=2:4 Q:CNT>$L(SDPAT) D "RTN","SDECUTL2",323,0) .I (CNT#8)=2 S HOUR=HOUR+1 "RTN","SDECUTL2",324,0) .S BSTART=SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#8)=6:30,1:"00") "RTN","SDECUTL2",325,0) .S DTARRAY($P(BSTART,".",1),$P(BSTART,".",2))=$S(+SDF:"X",1:$E(SDPAT,CNT)) "RTN","SDECUTL2",326,0) Q "RTN","SDECUTL2",327,0) 3 ;3 increments per hour (20 min) "RTN","SDECUTL2",328,0) N BSTART,CNT,HOUR "RTN","SDECUTL2",329,0) S BSTART="" "RTN","SDECUTL2",330,0) S SDI=0 "RTN","SDECUTL2",331,0) S HOUR=SDCLS-1 "RTN","SDECUTL2",332,0) F CNT=2:2 Q:CNT>$L(SDPAT) D "RTN","SDECUTL2",333,0) .I (CNT#6)=2 S HOUR=HOUR+1 "RTN","SDECUTL2",334,0) .S BSTART=SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#6)=4:20,(CNT#6)=0:40,1:"00") "RTN","SDECUTL2",335,0) .S DTARRAY($P(BSTART,".",1),$P(BSTART,".",2))=$S(+SDF:"X",1:$E(SDPAT,CNT)) "RTN","SDECUTL2",336,0) Q "RTN","SDECUTL2",337,0) 4 ;4 increments per hour (15 min) "RTN","SDECUTL2",338,0) N BSTART,CNT,HOUR "RTN","SDECUTL2",339,0) S BSTART="" "RTN","SDECUTL2",340,0) S SDI=0 "RTN","SDECUTL2",341,0) S HOUR=SDCLS-1 "RTN","SDECUTL2",342,0) F CNT=2:2 Q:CNT>$L(SDPAT) D "RTN","SDECUTL2",343,0) .I (CNT#8)=2 S HOUR=HOUR+1 "RTN","SDECUTL2",344,0) .S BSTART=SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#8)=4:15,(CNT#8)=6:30,(CNT#8)=0:45,1:"00") "RTN","SDECUTL2",345,0) .S DTARRAY($P(BSTART,".",1),$P(BSTART,".",2))=$S(+SDF:"X",1:$E(SDPAT,CNT)) "RTN","SDECUTL2",346,0) Q "RTN","SDECUTL2",347,0) 6 ;6 increments per hour (10 min) "RTN","SDECUTL2",348,0) N BSTART,CNT,HOUR "RTN","SDECUTL2",349,0) S BSTART="" "RTN","SDECUTL2",350,0) S SDI=0 "RTN","SDECUTL2",351,0) S HOUR=SDCLS-1 "RTN","SDECUTL2",352,0) F CNT=2:2 Q:CNT>$L(SDPAT) D "RTN","SDECUTL2",353,0) .I (CNT#12)=2 S HOUR=HOUR+1 "RTN","SDECUTL2",354,0) .S BSTART=SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#12)=4:10,(CNT#12)=6:20,(CNT#12)=8:30,(CNT#12)=10:40,(CNT#12)=0:50,1:"00") "RTN","SDECUTL2",355,0) .S DTARRAY($P(BSTART,".",1),$P(BSTART,".",2))=$S(+SDF:"X",1:$E(SDPAT,CNT)) "RTN","SDECUTL2",356,0) Q "RTN","SDECUTL2",357,0) SDAV(SDAV,SDCL,SDAY,SDLEN,SDCLS,SDSI) ;build modified availability array from AVAILABILITY in 44 "RTN","SDECUTL2",358,0) N DTARRAY "RTN","SDECUTL2",359,0) N SDCAN,SDI,SDPAT,SDTIME "RTN","SDECUTL2",360,0) K SDAV "RTN","SDECUTL2",361,0) M SDAV=^SC(SDCL,"T",SDAY) "RTN","SDECUTL2",362,0) S SDPAT=$G(^SC(SDCL,"ST",SDAY,1)) ;get PATTERN from file 44 "RTN","SDECUTL2",363,0) Q:SDPAT="" "RTN","SDECUTL2",364,0) D ARRAY(.DTARRAY,SDPAT,SDAY,SDLEN,SDCLS,SDSI) ;convert pattern to array "RTN","SDECUTL2",365,0) S SDTIME=0 F S SDTIME=$O(SDAV(2,SDTIME)) Q:SDTIME'>0 D "RTN","SDECUTL2",366,0) .S SDNOD2=$G(SDAV(2,SDTIME,0)) "RTN","SDECUTL2",367,0) .I $G(DTARRAY(SDAY,$P(SDNOD2,U,1)))="X" D "RTN","SDECUTL2",368,0) ..K SDAV(2,SDTIME,0) "RTN","SDECUTL2",369,0) Q "RTN","SDECWL") 0^13^B99990256^B69248242 "RTN","SDECWL",1,0) SDECWL ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDECWL",2,0) ;;5.3;Scheduling;**627,642,665**;Aug 13, 1993;Build 14 "RTN","SDECWL",3,0) ; "RTN","SDECWL",4,0) Q "RTN","SDECWL",5,0) ; "RTN","SDECWL",6,0) ; entry points for Clinical Scheduling/Wait List related Remote Procedures "RTN","SDECWL",7,0) APPTGET(RET,WLIEN) ; EP for SDEC WLGET remote procedure "RTN","SDECWL",8,0) S RET="I00020ERRORID^T00256ERRORTEXT"_$C(30) "RTN","SDECWL",9,0) S RET="-1^Not yet implemented"_$C(30,31) "RTN","SDECWL",10,0) Q "RTN","SDECWL",11,0) ;------------------------------------------------ "RTN","SDECWL",12,0) DEL(RET,INP) ;not used "RTN","SDECWL",13,0) S RET="I00020ERRORID^T00256ERRORTEXT"_$C(30) "RTN","SDECWL",14,0) S RET="-1^Not yet implemented"_$C(30,31) "RTN","SDECWL",15,0) Q "RTN","SDECWL",16,0) ; "RTN","SDECWL",17,0) WLCLOSE(RET,INP) ;Waitlist Close "RTN","SDECWL",18,0) ; INP - Input parameters array "RTN","SDECWL",19,0) ; INP(1) - Waitlist ID - Pointer to SD WAIT LIST file "RTN","SDECWL",20,0) ; INP(2) - Disposition "RTN","SDECWL",21,0) ; INP(3) - User Id - Pointer to NEW PERSON file "RTN","SDECWL",22,0) ; INP(4) - Date Dispositioned in external form "RTN","SDECWL",23,0) N MI,WLDISP,WLDISPBY,WLDISPDT,WLFDA,WLIEN,WLMSG,WLRET "RTN","SDECWL",24,0) S RET="I00020ERRORID^T00256ERRORTEXT"_$C(30) "RTN","SDECWL",25,0) ;validate IEN "RTN","SDECWL",26,0) S WLIEN=$G(INP(1)) I WLIEN="" S RET=RET_"-1^Missing IEN"_$C(30,31) Q "RTN","SDECWL",27,0) ;validate DISPOSITION "RTN","SDECWL",28,0) S WLDISP=$G(INP(2)) "RTN","SDECWL",29,0) I (WLDISP'="D"),(WLDISP'="NC"),(WLDISP'="SA"),(WLDISP'="CC"),(WLDISP'="NN"),(WLDISP'="ER"),(WLDISP'="TR"),(WLDISP'="CL") D "RTN","SDECWL",30,0) .S:WLDISP="DEATH" WLDISP="D" "RTN","SDECWL",31,0) .S:WLDISP="REMOVED/NON-VA CARE" WLDISP="NC" "RTN","SDECWL",32,0) .S:WLDISP="REMOVED/SCHEDULED-ASSIGNED" WLDISP="SA" "RTN","SDECWL",33,0) .S:WLDISP="REMOVED/VA CONTRACT CARE" WLDISP="CC" "RTN","SDECWL",34,0) .S:WLDISP="REMOVED/NO LONGER NECESSARY" WLDISP="NN" "RTN","SDECWL",35,0) .S:WLDISP="ENTERED IN ERROR" WLDISP="ER" "RTN","SDECWL",36,0) .S:WLDISP="TRANSFERRED" WLDISP="TR" "RTN","SDECWL",37,0) .S:WLDISP="CHANGED CLINIC" WLDISP="CL" "RTN","SDECWL",38,0) I WLDISP="" S RET=RET_"-1^Missing value for DISPOSITION"_$C(30,31) Q "RTN","SDECWL",39,0) I (WLDISP'="D"),(WLDISP'="NC"),(WLDISP'="SA"),(WLDISP'="CC"),(WLDISP'="NN"),(WLDISP'="ER"),(WLDISP'="TR"),(WLDISP'="CL") D "RTN","SDECWL",40,0) .S RET=RET_"-1^Invalid value for DISPOSITION"_$C(30,31) Q "RTN","SDECWL",41,0) ;validate DISPOSITIONED BY "RTN","SDECWL",42,0) S WLDISPBY=$G(INP(3),DUZ) "RTN","SDECWL",43,0) I '+WLDISPBY S WLDISPBY=$O(^VA(200,"B",WLDISPBY,0)) "RTN","SDECWL",44,0) I '+WLDISPBY S RET=RET_"-1^Invalid 'DISPOSITIONED BY' user"_$C(30,31) Q "RTN","SDECWL",45,0) ;validate DATE DISPOSITIONED "RTN","SDECWL",46,0) S WLDISPDT=$G(INP(4),DT) I WLDISPDT'="" S %DT="" S X=WLDISPDT D ^%DT S WLDISPDT=Y "RTN","SDECWL",47,0) I Y=-1 S RET=RET_"-1^Invalid 'DATE DISPOSITIONED'"_$C(30,31) Q "RTN","SDECWL",48,0) S WLFDA=$NA(WLFDA($$FNUM,WLIEN_",")) "RTN","SDECWL",49,0) S @WLFDA@(19)=WLDISPDT "RTN","SDECWL",50,0) S @WLFDA@(20)=WLDISPBY "RTN","SDECWL",51,0) S @WLFDA@(21)=WLDISP "RTN","SDECWL",52,0) S @WLFDA@(23)="C" "RTN","SDECWL",53,0) D UPDATE^DIE("","WLFDA","WLRET","WLMSG") "RTN","SDECWL",54,0) I $D(WLMSG("DIERR")) D "RTN","SDECWL",55,0) . F MI=1:1:$G(WLMSG("DIERR")) S RET=RET_"-1^"_$G(WLMSG("DIERR",MI,"TEXT",1))_$C(30) "RTN","SDECWL",56,0) S RET=RET_$C(31) "RTN","SDECWL",57,0) Q "RTN","SDECWL",58,0) ; "RTN","SDECWL",59,0) WLOPEN(RET,WLAPP,WLIEN,WLDDT) ;SET Waitlist Open/re-open "RTN","SDECWL",60,0) ;WLOPEN(RET,WLAPP,WLIEN,WLDDT) external parameter tag in SDEC "RTN","SDECWL",61,0) ;INPUT: "RTN","SDECWL",62,0) ; WLAPP - (required if no WLIEN) Appointment ID pointer to "RTN","SDECWL",63,0) ; SDEC APPOINTMENT file 409.84 "RTN","SDECWL",64,0) ; WLIEN - (required if no WLAPP) Waitlist ID - Pointer to "RTN","SDECWL",65,0) ; SD WAIT LIST file "RTN","SDECWL",66,0) ; WLDDT - (optional) Desired Date of appointment in external format "RTN","SDECWL",67,0) N SDART,SDECI,SDQ,WLFDA,WLMSG,X,Y,%DT "RTN","SDECWL",68,0) S RET="^TMP(""SDECWL"","_$J_",""WLOPEN"")" "RTN","SDECWL",69,0) K @RET "RTN","SDECWL",70,0) S (SDECI,SDQ)=0 "RTN","SDECWL",71,0) S @RET@(SDECI)="T00030ERRORID^T00030ERRTEXT"_$C(30) "RTN","SDECWL",72,0) ;validate WLAPP (required if WLIEN not passed it) "RTN","SDECWL",73,0) S WLAPP=$G(WLAPP) "RTN","SDECWL",74,0) I WLAPP'="" I $D(^SDEC(409.84,WLAPP,0)) D "RTN","SDECWL",75,0) .S SDART=$$GET1^DIQ(409.84,WLAPP_",",.22,"I") "RTN","SDECWL",76,0) .I $P(SDART,";",2)'="SDWL(409.3," S SDECI=SDECI+1 S @RET@(SDECI)="-1^Not an EWL appointment."_$C(30),SDQ=1 Q "RTN","SDECWL",77,0) .I $G(WLIEN)'="",WLIEN'=$P(SDART,";",1) S SDECI=SDECI+1 S @RET@(SDECI)="-1^Appointment EWL does not match passed in EWL."_$C(30),SDQ=1 Q "RTN","SDECWL",78,0) .S WLIEN=$P(SDART,";",1) "RTN","SDECWL",79,0) G:SDQ WLX "RTN","SDECWL",80,0) ;validate WLIEN "RTN","SDECWL",81,0) S WLIEN=$G(WLIEN) "RTN","SDECWL",82,0) I WLIEN="" S SDECI=SDECI+1 S @RET@(SDECI)="-1^Wait List ID or Appointment ID is required."_$C(30,31) Q "RTN","SDECWL",83,0) I '$D(^SDWL(409.3,WLIEN,0)) S SDECI=SDECI+1 S @RET@(SDECI)="-1^Invalid wait list ID."_$C(30,31) Q "RTN","SDECWL",84,0) ;validate WLDDT "RTN","SDECWL",85,0) S WLDDT=$P($G(WLDDT),"@",1) "RTN","SDECWL",86,0) I $G(WLDDT)'="" S %DT="" S X=WLDDT D ^%DT I Y=-1 S SDECI=SDECI+1 S @RET@(SDECI)="-1^Invalid desired date of appointment."_$C(30,31) Q "RTN","SDECWL",87,0) ; "RTN","SDECWL",88,0) S WLFDA=$NA(WLFDA(409.3,WLIEN_",")) "RTN","SDECWL",89,0) S @WLFDA@(19)="" "RTN","SDECWL",90,0) S @WLFDA@(20)="" "RTN","SDECWL",91,0) S @WLFDA@(21)="" "RTN","SDECWL",92,0) S:WLDDT'="" @WLFDA@(22)=WLDDT "RTN","SDECWL",93,0) S @WLFDA@(23)="OPEN" "RTN","SDECWL",94,0) D UPDATE^DIE("E","WLFDA","WLRET","WLMSG") "RTN","SDECWL",95,0) I $D(WLMSG("DIERR")) D "RTN","SDECWL",96,0) . F MI=1:1:$G(WLMSG("DIERR")) S SDECI=SDECI+1 S @RET@(SDECI)="-1^"_$G(WLMSG("DIERR",MI,"TEXT",1))_$C(30) "RTN","SDECWL",97,0) I '$D(WLMSG("DIERR")) S SDECI=SDECI+1 S @RET@(SDECI)="0^"_WLIEN_$C(30) "RTN","SDECWL",98,0) WLX S @RET@(SDECI)=@RET@(SDECI)_$C(31) "RTN","SDECWL",99,0) Q "RTN","SDECWL",100,0) ; "RTN","SDECWL",101,0) FNUM(RET) ;file number "RTN","SDECWL",102,0) S RET=409.3 "RTN","SDECWL",103,0) Q RET "RTN","SDECWL",104,0) ; "RTN","SDECWL",105,0) CLINALL(RET,MAXREC,SDECP) ;Return the IEN and NAME for all entries in the SD WL CLINIC LOCATION file "RTN","SDECWL",106,0) ;CLINALL(RET) external parameter tag is in SDEC "RTN","SDECWL",107,0) N CLINARR,CLINIEN,CLINNAME,COUNT,GLOREF,INACTIVE,LOCIEN,X "RTN","SDECWL",108,0) N CLINABR,SDCNT,SDECIEN,SDECNAM,SDF,SDMAX,SDTMP ;alb/sat 665 "RTN","SDECWL",109,0) S SDF="" "RTN","SDECWL",110,0) S (SDCNT,SDMAX)=0 ;alb/sat 665 "RTN","SDECWL",111,0) S RET="^TMP(""SDEC"","_$J_")" "RTN","SDECWL",112,0) K @RET "RTN","SDECWL",113,0) S @RET@(0)="T00020CLINIC_IEN^T00030CLINIC_NAME^T00020HOSPITAL_LOCATION_ID^T00030ABBR^T00030MORE"_$C(30) "RTN","SDECWL",114,0) S MAXREC=$G(MAXREC,50) "RTN","SDECWL",115,0) S SDECP=$G(SDECP) "RTN","SDECWL",116,0) ;Search for entries using partial name "RTN","SDECWL",117,0) I SDECP'="" D "RTN","SDECWL",118,0) .S SDECNAM=$$GETSUB^SDECU(SDECP) "RTN","SDECWL",119,0) .S SDF="ABBR" F S SDECNAM=$O(^SC("C",SDECNAM)) Q:SDECNAM'[SDECP D I SDCNT'$P($$NOW^XLFDT,".",1)) Q "RTN","SDECWL",141,0) S LOCIEN=$P(^SDWL(409.32,CLINIEN,0),U) "RTN","SDECWL",142,0) S CLINNAME=$P($G(^SC(LOCIEN,0)),U) "RTN","SDECWL",143,0) S CLINABR=$P($G(^SC(LOCIEN,0)),U,2) "RTN","SDECWL",144,0) S:SDF="ABBR" CLINNAME=CLINABR_" "_CLINNAME "RTN","SDECWL",145,0) Q:$$GET1^DIQ(44,LOCIEN_",",50.01,"I")=1 ;OOS? "RTN","SDECWL",146,0) I CLINNAME'="" S CLINARR(SDF="FULL",CLINNAME)=CLINIEN_U_LOCIEN_U_CLINABR,SDCNT=SDCNT+1 "RTN","SDECWL",147,0) Q "RTN","SDECWL",148,0) ; "RTN","SDECWL",149,0) SVSPALL(RET) ;return IEN and NAME for all entries in the SD WL SERVICE/SPECIALTY file "RTN","SDECWL",150,0) ;SVSPALL(RET) external parameter tag is in SDEC "RTN","SDECWL",151,0) N COUNT,GLOREF,CLSTPIEN,SVSPARR,SVSPIEN,SVSPNAME,X "RTN","SDECWL",152,0) S RET="^TMP(""SDEC"","_$J_")" "RTN","SDECWL",153,0) K @RET "RTN","SDECWL",154,0) S @RET@(0)="T00020SERVICESPECIALTY_IEN^T00030SERVICESPECIALTY_NAME"_$C(30) "RTN","SDECWL",155,0) S GLOREF=$NA(^SDWL(409.31)) "RTN","SDECWL",156,0) ; Search for all SD WL SERVICE/SPECIALTY entries "RTN","SDECWL",157,0) ; Lookup the CLINIC STOP name "RTN","SDECWL",158,0) ; Save the names in a local array so the return array will be sorted by Name "RTN","SDECWL",159,0) S SVSPIEN=0 "RTN","SDECWL",160,0) F S SVSPIEN=$O(@GLOREF@(SVSPIEN)) Q:'SVSPIEN D "RTN","SDECWL",161,0) . S CLSTPIEN=$P(@GLOREF@(SVSPIEN,0),U) "RTN","SDECWL",162,0) . S SVSPNAME=$P($G(^DIC(40.7,CLSTPIEN,0)),U) "RTN","SDECWL",163,0) . I SVSPNAME'="" S SVSPARR(SVSPNAME)=SVSPIEN "RTN","SDECWL",164,0) S SVSPNAME="",COUNT=0 "RTN","SDECWL",165,0) F S SVSPNAME=$O(SVSPARR(SVSPNAME)) Q:SVSPNAME="" D "RTN","SDECWL",166,0) . S COUNT=COUNT+1,@RET@(COUNT)=SVSPARR(SVSPNAME)_U_SVSPNAME_$C(30) "RTN","SDECWL",167,0) ;S COUNT=COUNT+1,@RET@(COUNT)=$C(31) "RTN","SDECWL",168,0) S @RET@(COUNT)=@RET@(COUNT)_$C(31) "RTN","SDECWL",169,0) Q "RTN","SDECWL",170,0) ; "RTN","SDECWL",171,0) APPTYPES(RET,DFN) ; EP for SDEC APPTYPES "RTN","SDECWL",172,0) ;APPTYPES(RET,DFN) external parameter tag is in SDEC "RTN","SDECWL",173,0) ; Return the different appointment types "RTN","SDECWL",174,0) N APTYDATA,APTYIEN,APTYINAC,APTYNAME,COUNT,GLOREF "RTN","SDECWL",175,0) N ISVET,PTYPE,SDEC,SDI "RTN","SDECWL",176,0) S PTYPE="" "RTN","SDECWL",177,0) S ISVET=1 ;0=not a vet; 1=is a vet "RTN","SDECWL",178,0) S RET=$NA(^TMP("SDEC",$J)),COUNT=0 "RTN","SDECWL",179,0) K @RET "RTN","SDECWL",180,0) S @RET@(0)="T00020APPTTYPE_IEN^T00030APPTTYPE_NAME"_$C(30) "RTN","SDECWL",181,0) S DFN=$G(DFN) I DFN'="" S:'$D(^DPT(+DFN,0)) DFN="" "RTN","SDECWL",182,0) S GLOREF=$NA(^SD(409.1)) "RTN","SDECWL",183,0) I '+DFN D "RTN","SDECWL",184,0) .S APTYNAME="" F S APTYNAME=$O(@GLOREF@("B",APTYNAME)) Q:APTYNAME="" D "RTN","SDECWL",185,0) ..S APTYIEN=0 F S APTYIEN=$O(@GLOREF@("B",APTYNAME,APTYIEN)) Q:'APTYIEN D "RTN","SDECWL",186,0) ...S APTYDATA=$G(@GLOREF@(APTYIEN,0)) "RTN","SDECWL",187,0) ...Q:$P(APTYDATA,U,3) "RTN","SDECWL",188,0) ...S COUNT=COUNT+1,@RET@(COUNT)=APTYIEN_U_APTYNAME_$C(30) "RTN","SDECWL",189,0) ; "RTN","SDECWL",190,0) I +DFN D "RTN","SDECWL",191,0) .N VAEL D ELIG^VADPT "RTN","SDECWL",192,0) .S SDEC=$S($D(^DIC(8,+VAEL(1),0)):$P(^(0),U,5),1:"") "RTN","SDECWL",193,0) .S APTYNAME="" F S APTYNAME=$O(@GLOREF@("B",APTYNAME)) Q:APTYNAME="" D "RTN","SDECWL",194,0) ..S APTYIEN=0 F S APTYIEN=$O(@GLOREF@("B",APTYNAME,APTYIEN)) Q:'APTYIEN D "RTN","SDECWL",195,0) ...S APTYDATA=$G(@GLOREF@(APTYIEN,0)) "RTN","SDECWL",196,0) ...Q:$P(APTYDATA,U,3) "RTN","SDECWL",197,0) ...I $S(SDEC["Y":1,1:$P(APTYDATA,U,5)),$S('$P(APTYDATA,U,6):1,$D(VAEL(1,+$P(APTYDATA,U,6))):1,+VAEL(1)=$P(APTYDATA,U,6):1,1:0) D "RTN","SDECWL",198,0) ....S COUNT=COUNT+1,@RET@(COUNT)=APTYIEN_U_APTYNAME_$C(30) "RTN","SDECWL",199,0) ; "RTN","SDECWL",200,0) S @RET@(COUNT)=@RET@(COUNT)_$C(31) "RTN","SDECWL",201,0) Q "RTN","SDECWL",202,0) ; "RTN","SDECWL",203,0) WLPCSET(SDECY,INP,WLIEN) ;SET update patient contacts in SD WAIT LIST file "RTN","SDECWL",204,0) ;WLSETPC(SDECY,INP,WLIEN) external parameter tag in SDEC "RTN","SDECWL",205,0) ; INP = Patient Contacts separated by :: "RTN","SDECWL",206,0) ; Each :: piece has the following ~~ pieces: (same as they are passed into SDEC WLSET) "RTN","SDECWL",207,0) ; 1) = (required) DATE ENTERED external date/time "RTN","SDECWL",208,0) ; 2) = (optional) PC ENTERED BY USER ID or NAME - Pointer to NEW PERSON file or NAME "RTN","SDECWL",209,0) ; 4) = (optional) ACTION - valid values are: "RTN","SDECWL",210,0) ; CALLED "RTN","SDECWL",211,0) ; MESSAGE LEFT "RTN","SDECWL",212,0) ; LETTER "RTN","SDECWL",213,0) ; 5) = (optional) PATIENT PHONE Free-Text 4-20 characters "RTN","SDECWL",214,0) ; 6) = NOT USED (optional) Comment 1-160 characters "RTN","SDECWL",215,0) ; WLIEN = (required) Wait List Id pointer to SDEC WAIT LIST file 409.3 "RTN","SDECWL",216,0) N SDECI,SDTMP,WLMSG1 "RTN","SDECWL",217,0) S SDECY="^TMP(""SDECWL"","_$J_",""WLSETPC"")" "RTN","SDECWL",218,0) K @SDECY "RTN","SDECWL",219,0) S SDECI=0 "RTN","SDECWL",220,0) S @SDECY@(SDECI)="T00030RETURNCODE^T00030TEXT"_$C(30) "RTN","SDECWL",221,0) S WLIEN=$G(WLIEN) "RTN","SDECWL",222,0) I (WLIEN="")!('$D(^SDWL(409.3,WLIEN,0))) D ERR1^SDECERR(-1,"Invalid wait list ID "_WLIEN_".",SDECI,SDECY) Q "RTN","SDECWL",223,0) D WL23^SDECWL2(INP,WLIEN) "RTN","SDECWL",224,0) I $D(WLMSG1) D ERR1^SDECERR(-1,"Error storing patient contacts.",SDECI,SDECY) Q "RTN","SDECWL",225,0) S SDECI=SDECI+1 S @SDECY@(SDECI)="0^SUCCESS"_$C(30,31) "RTN","SDECWL",226,0) Q "RTN","SDECWL",227,0) ; "RTN","SDECWL",228,0) AUDITGET(SDECY,WLIEN) ;GET entries from VS AUDIT field of SD WAIT LIST file 409.3 "RTN","SDECWL",229,0) N WLDATA,SDECI,SDI,SDTMP,SDX "RTN","SDECWL",230,0) S SDECY="^TMP(""SDECWL"","_$J_",""AUDITGET"")" "RTN","SDECWL",231,0) K @SDECY "RTN","SDECWL",232,0) S SDECI=0 "RTN","SDECWL",233,0) S SDTMP="T00030IEN^T00030ID^T00030DATE^T00030USERIEN^T00030USERNAME" "RTN","SDECWL",234,0) S SDTMP=SDTMP_"^T00030WLCINIEN^T00030WLCINNAME^T00030CLINIEN^T00030CLINNAME" "RTN","SDECWL",235,0) S SDTMP=SDTMP_"^T00030STOPIEN^T00030STOPNAME" "RTN","SDECWL",236,0) S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDECWL",237,0) ;validate WLIEN "RTN","SDECWL",238,0) S WLIEN=$G(WLIEN) "RTN","SDECWL",239,0) I '+$D(^SDWL(409.3,+WLIEN,0)) S @SDECY@(1)="-1^Invalid SD WAIT LIST id."_$C(30,31) Q "RTN","SDECWL",240,0) S SDI=0 F S SDI=$O(^SDWL(409.3,+WLIEN,6,SDI)) Q:SDI'>0 D "RTN","SDECWL",241,0) .K WLDATA "RTN","SDECWL",242,0) .D GETS^DIQ(409.345,SDI_","_WLIEN_",","**","IE","WLDATA") "RTN","SDECWL",243,0) .S SDX="WLDATA(409.345,"""_SDI_","_WLIEN_","")" "RTN","SDECWL",244,0) .S SDTMP=WLIEN_U_SDI_U_@SDX@(.01,"E")_U_@SDX@(1,"I")_U_@SDX@(1,"E") "RTN","SDECWL",245,0) .S SDTMP=SDTMP_U_@SDX@(2,"I")_U_@SDX@(2,"E")_U_@SDX@(3,"I")_U_@SDX@(3,"E") "RTN","SDECWL",246,0) .S SDTMP=SDTMP_U_@SDX@(4,"I")_U_@SDX@(4,"E") "RTN","SDECWL",247,0) .S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDECWL",248,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDECWL",249,0) Q "RTN","SDECWL2") 0^19^B126043834^B125348916 "RTN","SDECWL2",1,0) SDECWL2 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDECWL2",2,0) ;;5.3;Scheduling;**627,642,658,665**;Aug 13, 1993;Build 14 "RTN","SDECWL2",3,0) ; "RTN","SDECWL2",4,0) Q "RTN","SDECWL2",5,0) ; "RTN","SDECWL2",6,0) WLSET(RET,INP) ;Waitlist Set "RTN","SDECWL2",7,0) ;WLSET(RET,INP...) external parameter tag in SDEC "RTN","SDECWL2",8,0) ; INP(1) = (integer) Wait List IEN point to "RTN","SDECWL2",9,0) ; SD WAIT LIST file 409.3. "RTN","SDECWL2",10,0) ; If null, a new entry will be added "RTN","SDECWL2",11,0) ; INP(2) = (text) DFN Pointer to the PATIENT file 2 "RTN","SDECWL2",12,0) ; INP(3) = (date) Originating Date/time in external date form "RTN","SDECWL2",13,0) ; INP(4) = (text) Institution name NAME field from the INSTITUTION file "RTN","SDECWL2",14,0) ; INP(5) = (text) Wait List Type "RTN","SDECWL2",15,0) ; PCMM TEAM ASSIGNMENT "RTN","SDECWL2",16,0) ; PCMM POSITION ASSIGNMENT "RTN","SDECWL2",17,0) ; SERVICE/SPECIALITY "RTN","SDECWL2",18,0) ; SPECIFIC CLINIC "RTN","SDECWL2",19,0) ; INP(6) = (text) WL Specific Team name - NAME field in the TEAM file 404.51 "RTN","SDECWL2",20,0) ; INP(7) = (text) WL Specific Position name - NAME field in the "RTN","SDECWL2",21,0) ; TEAM POSITION file 404.57. "RTN","SDECWL2",22,0) ; INP(8) = (text) WL Service/Specialty name - NAME field in "RTN","SDECWL2",23,0) ; SD WL SERVICE/SPECIALTY file 409.31 OR ien from 409.31 "RTN","SDECWL2",24,0) ; INP(9) = (text) WL Specific Clinic name - NAME field in "RTN","SDECWL2",25,0) ; SD WL CLINIC LOCATION file 409.32. "RTN","SDECWL2",26,0) ; INP(10) = (text) Originating User name - NAME field in NEW PERSON file 200 "RTN","SDECWL2",27,0) ; INP(11) = (text) Priority - 'ASAP' or 'FUTURE' "RTN","SDECWL2",28,0) ; INP(12) = (text) Request By - 'PROVIDER' or 'PATIENT' "RTN","SDECWL2",29,0) ; INP(13) = (text) Provider name - NAME field in NEW PERSON file 200 "RTN","SDECWL2",30,0) ; INP(14) = (date) Desired Date of appointment in external format. "RTN","SDECWL2",31,0) ; INP(15) = (text) comment must be 1-60 characters "RTN","SDECWL2",32,0) ; INP(16) = (text) EWL Enrollee Status "RTN","SDECWL2",33,0) ; NEW "RTN","SDECWL2",34,0) ; ESTABLISHED "RTN","SDECWL2",35,0) ; PRIOR "RTN","SDECWL2",36,0) ; UNDETERMINED "RTN","SDECWL2",37,0) ; INP(17) = (text) NOT USED - PATIENT TELEPHONE 4-20 characters "RTN","SDECWL2",38,0) ; INP(18) = (text) ENROLLMENT PRIORITY - Valid Values are: "RTN","SDECWL2",39,0) ; GROUP 1 "RTN","SDECWL2",40,0) ; GROUP 2 "RTN","SDECWL2",41,0) ; GROUP 3 "RTN","SDECWL2",42,0) ; GROUP 4 "RTN","SDECWL2",43,0) ; GROUP 5 "RTN","SDECWL2",44,0) ; GROUP 6 "RTN","SDECWL2",45,0) ; GROUP 7 "RTN","SDECWL2",46,0) ; GROUP 8 "RTN","SDECWL2",47,0) ; INP(19) = (text) NOT USED - APPT SCHEDULED DATE "RTN","SDECWL2",48,0) ; INP(20) = (text) MULTIPLE APPOINTMENT RTC NO; YES "RTN","SDECWL2",49,0) ; INP(21) = (integer) MULT APPT RTC INTERVAL integer between 1-365 "RTN","SDECWL2",50,0) ; INP(22) = (integer) MULT APPT NUMBER integer between 1-100 "RTN","SDECWL2",51,0) ; INP(23) = Patient Contacts separated by :: "RTN","SDECWL2",52,0) ; Each :: piece has the following ~~ pieces: "RTN","SDECWL2",53,0) ; 1) = (date) DATE ENTERED external date/time "RTN","SDECWL2",54,0) ; 2) = (text) PC ENTERED BY USER ID or NAME - Pointer to NEW PERSON file or NAME "RTN","SDECWL2",55,0) ; 4) = (text) ACTION - 'CALLED', 'MESSAGE LEFT', or 'LETTER' "RTN","SDECWL2",56,0) ; 5) = (optional) PATIENT PHONE Free-Text 4-20 characters "RTN","SDECWL2",57,0) ; 6) = NOT USED (optional) Comment 1-160 characters "RTN","SDECWL2",58,0) ; INP(24) = (optional) SERVICE CONNECTED PRIORITY valid values are NO YES "RTN","SDECWL2",59,0) ; INP(25) = (optional) SERVICE CONNECTED PERCENTAGE = numeric 0-100 "RTN","SDECWL2",60,0) ; INP(27) = (optional) Appointment Type ID pointer to APPOINTMENT TYPE file 409.1 "RTN","SDECWL2",61,0) ; "RTN","SDECWL2",62,0) N X,Y,%DT "RTN","SDECWL2",63,0) N DFN,MI,WLIEN,WLORIGDT,WLINST,WLINSTI,WLTYPE,WLTEAM,WLPOS,WLSRVSP,WLCLIN "RTN","SDECWL2",64,0) N WLUSER,WLPRIO,WLREQBY,WLPROV,WLDAPTDT,WLCOMM,WLEESTAT,WLEDT,WLQUIT "RTN","SDECWL2",65,0) N AUDF,FNUM,FDA,WLNEW,WLRET,WLMSG,WLDATA,WLERR,WLHOS "RTN","SDECWL2",66,0) N WLAPTYP,WLPATTEL,WLENPRI,WLSVCCON,WLSVCCOP "RTN","SDECWL2",67,0) S (AUDF,WLQUIT)=0 "RTN","SDECWL2",68,0) S FNUM=$$FNUM^SDECWL "RTN","SDECWL2",69,0) S RET="I00020ERRORID^T00030ERRORTEXT"_$C(30) "RTN","SDECWL2",70,0) ; Use MERGE instead of SET so we can know if values were actually specified or not. "RTN","SDECWL2",71,0) ; This way, if a value is null, we will delete any previous value, "RTN","SDECWL2",72,0) ; but if it is missing, then we will just ignore it. "RTN","SDECWL2",73,0) M WLIEN=INP(1) "RTN","SDECWL2",74,0) S WLHOS="" "RTN","SDECWL2",75,0) S DFN=$G(INP(2)) "RTN","SDECWL2",76,0) I '+DFN S RET=RET_"-1^Invalid Patient ID."_$C(30,31) Q "RTN","SDECWL2",77,0) I '$D(^DPT(DFN,0)) S RET=RET_"-1^Invalid Patient ID"_$C(30,31) Q "RTN","SDECWL2",78,0) S WLEDT=$P($G(INP(3)),":",1,2) "RTN","SDECWL2",79,0) S %DT="TX" S X=WLEDT D ^%DT S WLEDT=Y "RTN","SDECWL2",80,0) I Y=-1 S RET=RET_"-1^Invalid Origination date."_$C(30,31) Q "RTN","SDECWL2",81,0) S WLORIGDT=$P(WLEDT,".",1) "RTN","SDECWL2",82,0) S WLINST=$G(INP(4)) I WLINST'="" D "RTN","SDECWL2",83,0) .I '+WLINST S WLINST=$O(^DIC(4,"B",WLINST,0)) "RTN","SDECWL2",84,0) S WLTYPE=$G(INP(5)) I WLTYPE'="" S WLTYPE=$S(WLTYPE="PCMM TEAM ASSIGNMENT":1,WLTYPE="PCMM POSSITION ASSIGNMENT":2,WLTYPE="SERVICE/SPECIALITY":3,WLTYPE="SPECIFIC CLINIC":4,+WLTYPE:+WLTYPE,1:"") "RTN","SDECWL2",85,0) I WLTYPE="" S RET=RET_"-1^Invalid Wait List Type."_$c(30,31) Q "RTN","SDECWL2",86,0) S WLTEAM=$G(INP(6)) I WLTEAM'="" D "RTN","SDECWL2",87,0) .I '+WLTEAM S WLTEAM=$O(^SCTM(404.51,"B",WLTEAM,0)) "RTN","SDECWL2",88,0) .I +WLTEAM I '$D(^SCTM(404.51,+WLTEAM,0)) S WLTEAM="" "RTN","SDECWL2",89,0) S WLPOS=$G(INP(7)) I WLPOS'="" D "RTN","SDECWL2",90,0) .I '+WLPOS S WLPOS=$O(^DIC(404.57,"B",WLPOS,0)) "RTN","SDECWL2",91,0) .I +WLPOS I '$D(^SCTM(404.57,WLPOS,0)) S WLPOS="" "RTN","SDECWL2",92,0) S WLCLIN=$G(INP(9)) "RTN","SDECWL2",93,0) I WLCLIN'="" D ;WLCLIN pointer to SD WL CLINIC LOCATION; WLHOS pointer to HOSPITAL LOCATION "RTN","SDECWL2",94,0) .I +WLCLIN D "RTN","SDECWL2",95,0) ..I '$D(^SDWL(409.32,+WLCLIN,0)) S RET=RET_"-1^"_WLCLIN_" is an invalid WL Waitlist Specific Clinic ID."_$C(30,31) S WLQUIT=1 Q "RTN","SDECWL2",96,0) ..S WLHOS=+$P($G(^SDWL(409.32,+WLCLIN,0)),U,1) "RTN","SDECWL2",97,0) .I '+WLCLIN D "RTN","SDECWL2",98,0) ..S WLHOS=$O(^SC("B",WLCLIN,0)) ;$S(+WLCLIN:$P($G(^SC($P($G(^SDWL(409.32,WLCLIN,0)),U,1),0)),U,1),1:WLCLIN) "RTN","SDECWL2",99,0) ..S WLCLIN=$O(^SDWL(409.32,"B",+WLHOS,0)) I 'WLCLIN S RET=RET_"-1^"_WLCLIN_" is an invalid WL Waitlist Specific Clinic Name."_$C(30,31) S WLQUIT=1 Q "RTN","SDECWL2",100,0) Q:+WLQUIT ;alb/sat 665 "RTN","SDECWL2",101,0) S INP(8)=$G(INP(8)) "RTN","SDECWL2",102,0) I INP(8)'="",WLCLIN'="" S RET=RET_"-1^Cannot include both Clinic and Service."_$C(30,31) Q ;alb/sat 642 "RTN","SDECWL2",103,0) I +INP(8),'$D(^SDWL(409.31,+INP(8),0)) S RET=RET_"-1^Invalid service/specialty "_+INP(8)_"."_$C(30,31) Q ;alb/sat 642 "RTN","SDECWL2",104,0) S WLUSER=$G(INP(10)) "RTN","SDECWL2",105,0) I WLUSER'="" I '+WLUSER S WLUSER=$O(^VA(200,"B",WLUSER,0)) "RTN","SDECWL2",106,0) I WLUSER="" S WLUSER=DUZ "RTN","SDECWL2",107,0) S WLREQBY=$G(INP(12)) I WLREQBY'="" S WLREQBY=$S(WLREQBY="PATIENT":2,WLREQBY="PROVIDER":1,1:"") "RTN","SDECWL2",108,0) S WLPROV=$G(INP(13)) I WLPROV'="" I '+WLPROV S WLPROV=$O(^VA(200,"B",WLPROV,0)) "RTN","SDECWL2",109,0) S WLDAPTDT=$G(INP(14)) "RTN","SDECWL2",110,0) S %DT="" S X=$P($G(WLDAPTDT),"@",1) D ^%DT S WLPRIO=$S(Y=$P($$NOW^XLFDT,".",1):"A",1:"F") "RTN","SDECWL2",111,0) S WLDAPTDT=Y "RTN","SDECWL2",112,0) I Y=-1 S WLDAPTDT="" ;S RET=RET_"-1^Invalid Desired Date."_$C(30,31) Q "RTN","SDECWL2",113,0) S (INP(15),WLCOMM)=$TR($G(INP(15)),"^"," ") ;alb/sat 658 "RTN","SDECWL2",114,0) S WLEESTAT=$G(INP(16)) I WLEESTAT'="" S WLEESTAT=$S(WLEESTAT="NEW":"N",WLEESTAT="ESTABLISHED":"E",WLEESTAT="PRIOR":"P",WLEESTAT="UNDETERMINED":"U",1:WLEESTAT) "RTN","SDECWL2",115,0) M WLPATTEL=INP(17) "RTN","SDECWL2",116,0) S WLENPRI=$G(INP(18)) D "RTN","SDECWL2",117,0) .S:WLENPRI'="" WLENPRI=$S(WLENPRI="GROUP 1":1,WLENPRI="GROUP 2":2,WLENPRI="GROUP 3":3,WLENPRI="GROUP 4":4,WLENPRI="GROUP 5":5,WLENPRI="GROUP 6":6,WLENPRI="GROUP 7":7,WLENPRI="GROUP 8":8,1:WLENPRI) "RTN","SDECWL2",118,0) S WLSVCCON=$G(INP(24)) S:WLSVCCON'="" WLSVCCON=$S(WLSVCCON="YES":1,1:0) "RTN","SDECWL2",119,0) S WLSVCCOP=$G(INP(25)) I WLSVCCOP'="" S WLSVCCOP=+$G(WLSVCCOP) S:(+WLSVCCOP<0)!(+WLSVCCOP>100) WLSVCCOP="" "RTN","SDECWL2",120,0) S WLAPTYP=+$G(INP(27)) I +WLAPTYP,'$D(^SD(409.1,WLAPTYP,0)) S WLAPTYP="" "RTN","SDECWL2",121,0) S WLIEN=$G(WLIEN) "RTN","SDECWL2",122,0) S WLNEW=WLIEN="" "RTN","SDECWL2",123,0) I WLNEW D "RTN","SDECWL2",124,0) . S FDA=$NA(FDA(FNUM,"+1,")) "RTN","SDECWL2",125,0) . S @FDA@(.01)=+DFN "RTN","SDECWL2",126,0) . ;This handles the date/time coming in as "8/27/2014 12:00:00 AM" "RTN","SDECWL2",127,0) . S:$G(WLORIGDT)'="" @FDA@(1)=WLORIGDT "RTN","SDECWL2",128,0) . S:$G(WLINST)'="" @FDA@(2)=+WLINST "RTN","SDECWL2",129,0) . S:$G(WLTYPE)'="" @FDA@(4)=WLTYPE "RTN","SDECWL2",130,0) . ;S:$G(WLTEAM)'="" @FDA@(5)=+WLTEAM "RTN","SDECWL2",131,0) . S:$G(WLPOS)'="" @FDA@(6)=+WLPOS "RTN","SDECWL2",132,0) . ;S:$G(WLSRVSP)'="" @FDA@(7)=$S(+WLSRVSP:$P($G(^SDWL(409.31,WLSRVSP,0)),U),1:WLSRVSP) "RTN","SDECWL2",133,0) . S:$G(WLCLIN)'="" @FDA@(8)=+WLCLIN "RTN","SDECWL2",134,0) . S:$G(WLHOS)'="" @FDA@(8.5)=WLHOS "RTN","SDECWL2",135,0) . S:+WLAPTYP @FDA@(8.7)=+WLAPTYP "RTN","SDECWL2",136,0) . S:$G(WLUSER)'="" @FDA@(9)=+WLUSER "RTN","SDECWL2",137,0) . S:$G(WLEDT)'="" @FDA@(9.5)=WLEDT "RTN","SDECWL2",138,0) . S:$G(WLPRIO)'="" @FDA@(10)=WLPRIO "RTN","SDECWL2",139,0) . S:$G(WLENPRI)'="" @FDA@(10.5)=WLENPRI "RTN","SDECWL2",140,0) . S:$G(WLREQBY)'="" @FDA@(11)=WLREQBY "RTN","SDECWL2",141,0) . S:$G(WLPROV)'="" @FDA@(12)=+WLPROV "RTN","SDECWL2",142,0) . S:$G(WLSVCCOP)'="" @FDA@(14)=WLSVCCOP "RTN","SDECWL2",143,0) . S:$G(WLSVCCON)'="" @FDA@(15)=WLSVCCON "RTN","SDECWL2",144,0) . S:$G(WLDAPTDT)'="" @FDA@(22)=WLDAPTDT "RTN","SDECWL2",145,0) . S @FDA@(23)="O" "RTN","SDECWL2",146,0) . S:$G(WLCOMM)'="" @FDA@(25)=WLCOMM "RTN","SDECWL2",147,0) . S:$G(WLEESTAT)'="" @FDA@(27)=WLEESTAT "RTN","SDECWL2",148,0) . S:+WLAPTYP @FDA@(8.7)=+WLAPTYP "RTN","SDECWL2",149,0) E D "RTN","SDECWL2",150,0) . S WLIEN=WLIEN_"," ; Append the comma for both "RTN","SDECWL2",151,0) . K WLDATA,WLERR "RTN","SDECWL2",152,0) . D GETS^DIQ(FNUM,WLIEN,"*","IE","WLDATA","WLERR") "RTN","SDECWL2",153,0) . I $D(WLERR) M WLMSG=WLERR K FDA Q "RTN","SDECWL2",154,0) . S FDA=$NA(FDA(FNUM,WLIEN)) "RTN","SDECWL2",155,0) . I $D(WLORIGDT) D "RTN","SDECWL2",156,0) . . I WLORIGDT'=WLDATA(FNUM,WLIEN,1,"I") S @FDA@(1)=WLORIGDT "RTN","SDECWL2",157,0) . I $D(WLINST),WLINST'=WLDATA(FNUM,WLIEN,2,"I") S @FDA@(2)=$S(WLINST="":"@",1:+WLINST) "RTN","SDECWL2",158,0) . I $D(WLTYPE),WLTYPE'=WLDATA(FNUM,WLIEN,4,"E") S @FDA@(4)=WLTYPE "RTN","SDECWL2",159,0) . ;I $D(WLTEAM),WLTEAM'=WLDATA(FNUM,WLIEN,5,"I") S @FDA@(5)=$S(WLTEAM="":"@",1:+WLTEAM) "RTN","SDECWL2",160,0) . I $D(WLPOS),WLPOS'=WLDATA(FNUM,WLIEN,6,"I") S @FDA@(6)=$S(WLPOS="":"@",1:+WLPOS) "RTN","SDECWL2",161,0) . ;I $D(WLSRVSP),WLSRVSP'=WLDATA(FNUM,WLIEN,7,"I") S @FDA@(7)=$S(WLSRVSP="":"@",+WLSRVSP:$P($G(^DIC(40.7,$P($G(^SDWL(409.31,WLSRVSP,0)),U),0)),U),1:WLSRVSP) "RTN","SDECWL2",162,0) . I $D(WLCLIN),WLCLIN'=WLDATA(FNUM,WLIEN,8,"I") S @FDA@(8)=$S(WLCLIN="":"@",1:+WLCLIN),AUDF=1 S:WLDATA(FNUM,WLIEN,7,"I")'="" @FDA@(7)="@" "RTN","SDECWL2",163,0) . I $D(WLHOS),WLHOS'=WLDATA(FNUM,WLIEN,8.5,"I") S @FDA@(8.5)=WLHOS,AUDF=1 S:WLDATA(FNUM,WLIEN,7,"I")'="" @FDA@(7)="@" "RTN","SDECWL2",164,0) . S:+WLAPTYP @FDA@(8.7)=+WLAPTYP "RTN","SDECWL2",165,0) . I $D(WLUSER),WLUSER'=WLDATA(FNUM,WLIEN,9,"I") S @FDA@(9)=$S(WLUSER="":"@",1:+WLUSER) "RTN","SDECWL2",166,0) . I $D(WLEDT),WLEDT'=$G(WLDATA(FNUM,WLIEN,9.5,"I")) S @FDA@(9.5)=WLEDT "RTN","SDECWL2",167,0) . I $D(WLPRIO),WLPRIO'=WLDATA(FNUM,WLIEN,10,"I") S @FDA@(10)=$S(WLPRIO="":"@",1:WLPRIO) "RTN","SDECWL2",168,0) . I $D(WLENPRI),WLENPRI'=WLDATA(FNUM,WLIEN,10.5,"E") S @FDA@(10.5)=WLENPRI "RTN","SDECWL2",169,0) . I $D(WLREQBY),WLREQBY'=WLDATA(FNUM,WLIEN,11,"I") S @FDA@(11)=$S(WLREQBY="":"@",1:WLREQBY) "RTN","SDECWL2",170,0) . I $D(WLPROV),WLPROV'=WLDATA(FNUM,WLIEN,12,"I") S @FDA@(12)=$S(WLPROV="":"@",1:+WLPROV) "RTN","SDECWL2",171,0) . I $D(WLSVCCOP),WLSVCCOP'=$G(WLDATA(FNUM,WLIEN,14,"I")) S @FDA@(14)=WLSVCCOP "RTN","SDECWL2",172,0) . I $D(WLSVCCON),WLSVCCON'=WLDATA(FNUM,WLIEN,15,"E") S @FDA@(15)=WLSVCCON "RTN","SDECWL2",173,0) . I $D(WLDAPTDT),WLDAPTDT'=WLDATA(FNUM,WLIEN,22,"I") S @FDA@(22)=$S(WLDAPTDT="":"@",1:WLDAPTDT) "RTN","SDECWL2",174,0) . I $D(WLCOMM),WLCOMM'=WLDATA(FNUM,WLIEN,25,"I") S @FDA@(25)=$S(WLCOMM="":"@",1:WLCOMM) "RTN","SDECWL2",175,0) . I $D(WLEESTAT),WLEESTAT'=WLDATA(FNUM,WLIEN,27,"I") S @FDA@(27)=$S(WLEESTAT="":"@",1:WLEESTAT) "RTN","SDECWL2",176,0) ; Only call UPDATE^DIE if there are any array entries in FDA "RTN","SDECWL2",177,0) D:$D(@FDA) UPDATE^DIE("","FDA","WLRET","WLMSG") "RTN","SDECWL2",178,0) I $D(WLMSG) D "RTN","SDECWL2",179,0) . F MI=1:1:$G(WLMSG("DIERR")) S RET=RET_"-1^"_$G(WLMSG("DIERR",MI,"TEXT",1))_$C(30) "RTN","SDECWL2",180,0) . S RET=RET_$C(31) "RTN","SDECWL2",181,0) Q:$D(WLMSG) "RTN","SDECWL2",182,0) S WLINSTI=$P($G(^SDWL(409.3,$S(+WLIEN:WLIEN,1:WLRET(1)),0)),U,3) "RTN","SDECWL2",183,0) I $G(INP(6))'="" D WL6 ;wl specific team "RTN","SDECWL2",184,0) I $G(INP(8))'="" D WL8 ;wl service specialty "RTN","SDECWL2",185,0) I $D(INP(23)) D WL23(INP(23),$S(+WLIEN:WLIEN,1:WLRET(1))) ;patient contacts "RTN","SDECWL2",186,0) I +AUDF D WLAUD($S(+WLIEN:+WLIEN,1:WLRET(1)),WLCLIN,WLHOS,INP(8)) ;VS AUDIT "RTN","SDECWL2",187,0) I +$G(WLRET(1)) S RET=RET_WLRET(1)_U_$C(30,31) "RTN","SDECWL2",188,0) E S RET=RET_+WLIEN_U_$C(30,31) "RTN","SDECWL2",189,0) Q "RTN","SDECWL2",190,0) ; "RTN","SDECWL2",191,0) WL6 ;WL SPECIFIC TEAM does not store with bulk UPDATE^DIE with external data; don't know why "RTN","SDECWL2",192,0) N FDA,H "RTN","SDECWL2",193,0) S H=$O(^SCTM(404.51,"B",+$G(INP(6)),0)) "RTN","SDECWL2",194,0) I +H K FDA S FDA=$NA(FDA(409.3,$S(+WLIEN:WLIEN,1:WLRET(1))_",")) S @FDA@(5)=H D UPDATE^DIE("","FDA") "RTN","SDECWL2",195,0) Q "RTN","SDECWL2",196,0) ; "RTN","SDECWL2",197,0) WL8 ;WL SERVICE/SPECIALTY does not store with bulk UPDATE^DIE if duplicates; need to look for 1st active one "RTN","SDECWL2",198,0) ; WL Service/Specialty name - NAME field in "RTN","SDECWL2",199,0) ; SD WL SERVICE/SPECIALTY file 409.31. "RTN","SDECWL2",200,0) N ADUF,SDWLNOD,WLSRVSP "RTN","SDECWL2",201,0) S WLSRVSP="" "RTN","SDECWL2",202,0) I +INP(8) S WLSRVSP=INP(8) "RTN","SDECWL2",203,0) I WLSRVSP="" S H="" F S H=$O(^DIC(40.7,"B",$G(INP(8)),H)) Q:H="" D Q:WLSRVSP'="" "RTN","SDECWL2",204,0) .I $P(^DIC(40.7,H,0),U,3)'="",$P(^DIC(40.7,H,0),U,3)<$$NOW^XLFDT() Q "RTN","SDECWL2",205,0) .S WLSRVSP=$O(^SDWL(409.31,"B",H,0)) "RTN","SDECWL2",206,0) I WLSRVSP'="" D "RTN","SDECWL2",207,0) .K FDA "RTN","SDECWL2",208,0) .S FDA=$NA(FDA(409.3,$S(+WLIEN:WLIEN,1:WLRET(1))_",")) "RTN","SDECWL2",209,0) .S @FDA@(7)=WLSRVSP,ADUF=1 "RTN","SDECWL2",210,0) .I +WLIEN,$D(WLDATA) D "RTN","SDECWL2",211,0) ..S:WLDATA(FNUM,WLIEN,8,"I")'="" @FDA@(8)="@" ;errors "RTN","SDECWL2",212,0) ..S:WLDATA(FNUM,WLIEN,8.5,"I")'="" @FDA@(8.5)="@" ;errors "RTN","SDECWL2",213,0) .D:$D(FDA) UPDATE^DIE("","FDA") "RTN","SDECWL2",214,0) Q "RTN","SDECWL2",215,0) ; "RTN","SDECWL2",216,0) WLACT(NAME) ; "RTN","SDECWL2",217,0) N ACTIVE,H "RTN","SDECWL2",218,0) S ACTIVE="" "RTN","SDECWL2",219,0) S H="" F S H=$O(^DIC(40.7,"B",NAME,H)) Q:H="" D Q:ACTIVE'="" "RTN","SDECWL2",220,0) .I $P(^DIC(40.7,H,0),U,3)'="",$P(^DIC(40.7,H,0),U,3)<$$NOW^XLFDT() Q "RTN","SDECWL2",221,0) .S ACTIVE=H "RTN","SDECWL2",222,0) Q ACTIVE "RTN","SDECWL2",223,0) ; "RTN","SDECWL2",224,0) WL23(INP23,WLI) ;Patient Contacts "RTN","SDECWL2",225,0) N STR23,WLASD,WLASDH,WLDATA1,WLERR1,WLI1,WLIENS,WLIENS1,WLRET1,FDA "RTN","SDECWL2",226,0) N WLUSR,X,Y,%DT "RTN","SDECWL2",227,0) S WLIENS=WLI_"," "RTN","SDECWL2",228,0) F WLI1=1:1:$L(INP23,"::") D "RTN","SDECWL2",229,0) .S STR23=$P(INP23,"::",WLI1) "RTN","SDECWL2",230,0) .K FDA "RTN","SDECWL2",231,0) .S %DT="T" S X=$P($P(STR23,"~~",1),":",1,2) D ^%DT S WLASD=Y "RTN","SDECWL2",232,0) .I (WLASD=-1)!(WLASD="") Q "RTN","SDECWL2",233,0) .S WLASDH="" ;$O(^SDWL(409.3,WLI,4,"B",WLASD,0)) "RTN","SDECWL2",234,0) .S WLIENS1=$S(WLASDH'="":WLASDH,1:"+1")_","_WLIENS "RTN","SDECWL2",235,0) .S FDA=$NA(FDA(409.344,WLIENS1)) "RTN","SDECWL2",236,0) .I WLASDH'="" D "RTN","SDECWL2",237,0) ..D GETS^DIQ(409.344,WLIENS1,"*","IE","WLDATA1","WLERR1") "RTN","SDECWL2",238,0) ..I $P(STR23,"~~",1)'="" S @FDA@(.01)=$P($P(STR23,"~~",1),":",1,2) ;DATE ENTERED external date/time "RTN","SDECWL2",239,0) ..I $P(STR23,"~~",2)'="" S WLUSR=$P(STR23,"~~",2) S @FDA@(2)=$S(WLUSR="":"@",+WLUSR:$P($G(^VA(200,WLUSR,0)),U,1),1:WLUSR) ;PC ENTERED BY USER "RTN","SDECWL2",240,0) ..I $P(STR23,"~~",4)'="" S @FDA@(3)=$P(STR23,"~~",4) ;ACTION C=Called; M=Message Left; L=LETTER "RTN","SDECWL2",241,0) ..I $P(STR23,"~~",5)'="" S @FDA@(4)=$P(STR23,"~~",5) ;PATIENT PHONE "RTN","SDECWL2",242,0) ..;I $P(STR23,"~~",6)'="" S @FDA@(5)=$E($P(STR23,"~~",6),1,160) ;COMMENT "RTN","SDECWL2",243,0) .I WLASDH="" D "RTN","SDECWL2",244,0) ..I $P(STR23,"~~",1)'="" S @FDA@(.01)=$P($P(STR23,"~~",1),":",1,2) ;DATE ENTERED external date/time "RTN","SDECWL2",245,0) ..I $P(STR23,"~~",2)'="" S WLUSR=$P(STR23,"~~",2) S @FDA@(2)=$S(WLUSR="":"@",+WLUSR:$P($G(^VA(200,WLUSR,0)),U,1),1:WLUSR) ;PC ENTERED BY USER "RTN","SDECWL2",246,0) ..I $P(STR23,"~~",4)'="" S @FDA@(3)=$P(STR23,"~~",4) ;ACTION C=Called; M=Message Left; L=LETTER "RTN","SDECWL2",247,0) ..I $P(STR23,"~~",5)'="" S @FDA@(4)=$P(STR23,"~~",5) ;PATIENT PHONE "RTN","SDECWL2",248,0) ..;I $P(STR23,"~~",6)'="" S @FDA@(5)=$E($P(STR23,"~~",6),1,160) ;COMMENT "RTN","SDECWL2",249,0) .D:$D(@FDA) UPDATE^DIE("E","FDA","WLRET1","WLMSG1") "RTN","SDECWL2",250,0) .;D:$D(@FDA) UPDATE^DIE("E","FDA","WLRET1") "RTN","SDECWL2",251,0) Q "RTN","SDECWL2",252,0) ; "RTN","SDECWL2",253,0) WLAUD(WLIEN,WLCLIN,SDCL,WLSTOP,DATE,USER) ;populate VS AUDIT multiple field 45 "RTN","SDECWL2",254,0) ; WLIEN - (required) pointer to SDEC APPT REQUEST file 409.85 "RTN","SDECWL2",255,0) ; WLCLIN - (optional) pointer to SD WL SPECIFIC CLINIC "RTN","SDECWL2",256,0) ; SDCL - (optional) pointer to HOSPITAL LOCATION file 44 "RTN","SDECWL2",257,0) ; WLSTOP - (optional) pointer to CLINIC STOP file "RTN","SDECWL2",258,0) ; DATE - (optional) date/time in fileman format "RTN","SDECWL2",259,0) N SDFDA,SDP,SDPN "RTN","SDECWL2",260,0) S WLIEN=$G(WLIEN) Q:WLIEN="" "RTN","SDECWL2",261,0) S WLCLIN=$G(WLCLIN) "RTN","SDECWL2",262,0) S SDCL=$G(SDCL) "RTN","SDECWL2",263,0) S WLSTOP=$G(WLSTOP) "RTN","SDECWL2",264,0) S SDP=$O(^SDWL(409.3,WLIEN,6,9999999),-1) "RTN","SDECWL2",265,0) I +SDP S SDPN=^SDWL(409.3,WLIEN,6,SDP,0) I $P(SDPN,U,3)=WLCLIN,$P(SDPN,U,4)=SDCL,$P(SDPN,U,5)=WLSTOP Q "RTN","SDECWL2",266,0) S DATE=$G(DATE) S:DATE="" DATE=$E($$NOW^XLFDT,1,12) "RTN","SDECWL2",267,0) S USER=$G(USER) S:USER="" USER=DUZ "RTN","SDECWL2",268,0) S SDFDA(409.345,"+1,"_WLIEN_",",.01)=DATE "RTN","SDECWL2",269,0) S SDFDA(409.345,"+1,"_WLIEN_",",1)=USER "RTN","SDECWL2",270,0) S:WLCLIN'="" SDFDA(409.345,"+1,"_WLIEN_",",2)=WLCLIN "RTN","SDECWL2",271,0) S:SDCL'="" SDFDA(409.345,"+1,"_WLIEN_",",3)=SDCL "RTN","SDECWL2",272,0) S:WLSTOP'="" SDFDA(409.345,"+1,"_WLIEN_",",4)=WLSTOP "RTN","SDECWL2",273,0) D UPDATE^DIE("","SDFDA") "RTN","SDECWL2",274,0) Q "RTN","SDECWL3") 0^26^B33768778^B33650726 "RTN","SDECWL3",1,0) SDECWL3 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDECWL3",2,0) ;;5.3;Scheduling;**627,658,665**;Aug 13, 1993;Build 14 "RTN","SDECWL3",3,0) ; "RTN","SDECWL3",4,0) Q "RTN","SDECWL3",5,0) ; "RTN","SDECWL3",6,0) WLHIDE(SDECY,DFN,WLCL) ;GET wait list entries in which the associated clinic's 'HIDE FROM DISPLAY?' field is 'YES' "RTN","SDECWL3",7,0) ;WLHIDE(SDECY,DFN,WLCL) external parameter tag in SDEC "RTN","SDECWL3",8,0) ; INPUT: "RTN","SDECWL3",9,0) ; DFN = (optional) Patient ID pointer to PATIENT file 2 "RTN","SDECWL3",10,0) ; WLCL = (optional) Clinic ID pointer to SD WL CLINIC LOCATION "RTN","SDECWL3",11,0) ; RETURN: "RTN","SDECWL3",12,0) ; DFN "RTN","SDECWL3",13,0) ; ORIGDT = Originating Date "RTN","SDECWL3",14,0) ; TYPE = Wait List Type "RTN","SDECWL3",15,0) ; CLINIEN = Clinic IEN pointer to HOSPITAL LOCATION file 44 "RTN","SDECWL3",16,0) ; WLCLNAME = WL SPECIFIC CLINIC "RTN","SDECWL3",17,0) ; USERIEN = Originating User "RTN","SDECWL3",18,0) ; USERNAME = Originating User name "RTN","SDECWL3",19,0) ; DATE1 = Date/Time Entered "RTN","SDECWL3",20,0) ; DAPTDT = Desired Date of appointment "RTN","SDECWL3",21,0) ; STATUS = Current Status "RTN","SDECWL3",22,0) ; OPEN CLOSED "RTN","SDECWL3",23,0) N CLINIEN,DAPTDT,DATE1,ORIGDT,STATUS,TYPE,USERIEN,USERNAME,WLCLIEN,WLCLNAME "RTN","SDECWL3",24,0) N SDI,SDCL,SDCL1,SDECI,SDDATA,INACTIVE,SDFIELDS,SDTMP,PTNAME "RTN","SDECWL3",25,0) N WLIEN "RTN","SDECWL3",26,0) S SDCL="" "RTN","SDECWL3",27,0) S SDECI=0 "RTN","SDECWL3",28,0) S SDECY=$NA(^TMP("SDECWL3",$J,"WLHIDE")) "RTN","SDECWL3",29,0) K @SDECY "RTN","SDECWL3",30,0) S SDTMP="I00030DFN^T00030ORIGDT^T00030TYPE^T00030CLINIEN^T00030WLCLNAME^T00030USERIEN^" "RTN","SDECWL3",31,0) S SDTMP=SDTMP_"T00030USERNAME^T00030DATE1^T00030DAPTDT^T00030STATUS^T00030PATIENTNAME"_$C(30) "RTN","SDECWL3",32,0) S @SDECY@(SDECI)=SDTMP "RTN","SDECWL3",33,0) S DFN=$G(DFN) "RTN","SDECWL3",34,0) I DFN'="" I '$D(^DPT(DFN,0)) S @SDECY@(1)="-1^Invalid Patient ID." Q "RTN","SDECWL3",35,0) S WLCL=$G(WLCL) "RTN","SDECWL3",36,0) I +WLCL D "RTN","SDECWL3",37,0) .S SDI=0 F S SDI=$O(^SDWL(409.32,"B",WLCL,SDI)) Q:SDI="" D ;Need to get the correct IEN "RTN","SDECWL3",38,0) ..S INACTIVE=$$GET1^DIQ(409.32,SDI_",",3,"I") "RTN","SDECWL3",39,0) ..I (INACTIVE'="")&($P(INACTIVE,".",1)'>$P($$NOW^XLFDT,".",1)) Q ;alb/sat 665 "RTN","SDECWL3",40,0) ..S (SDCL,SDCL1)=$$GET1^DIQ(409.32,+SDI_",",.01,"I") "RTN","SDECWL3",41,0) ;I +WLCL,SDCL="" S @SDECY@(1)="-1^Invalid Clinic Location ID." Q "RTN","SDECWL3",42,0) I +DFN D "RTN","SDECWL3",43,0) .I 'WLCL S (SDCL,SDCL1)=0 "RTN","SDECWL3",44,0) .E S SDCL=WLCL-1 "RTN","SDECWL3",45,0) .F S SDCL=$O(^SDWL(409.3,"AD",DFN,SDCL)) Q:SDCL'>0 Q:(WLCL>0)&(WLCL'=SDCL) D "RTN","SDECWL3",46,0) ..Q:$P($G(^SC(SDCL,0)),U,26)'=1 "RTN","SDECWL3",47,0) ..S WLIEN=0 F S WLIEN=$O(^SDWL(409.3,"AD",DFN,SDCL,WLIEN)) Q:WLIEN'>0 D GET1 "RTN","SDECWL3",48,0) G:DFN'="" XIT "RTN","SDECWL3",49,0) S SDCL1=+SDCL "RTN","SDECWL3",50,0) S SDCL=$S(+SDCL:SDCL-1,1:0) F S SDCL=$O(^SC("AF",1,SDCL)) Q:SDCL'>0 Q:(SDCL1>0)&(SDCL1'=SDCL) D "RTN","SDECWL3",51,0) .S WLIEN=0 F S WLIEN=$O(^SDWL(409.3,"AE",SDCL,WLIEN)) Q:WLIEN'>0 D GET1 "RTN","SDECWL3",52,0) XIT ; "RTN","SDECWL3",53,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDECWL3",54,0) Q "RTN","SDECWL3",55,0) ; "RTN","SDECWL3",56,0) GET1 ; "RTN","SDECWL3",57,0) K SDDATA "RTN","SDECWL3",58,0) Q:$P($G(^SDWL(409.3,WLIEN,0)),U,17)="C" "RTN","SDECWL3",59,0) S SDFIELDS=".01;1;4;8;8.5;9;9.5;22;23" "RTN","SDECWL3",60,0) D GETS^DIQ(409.3,WLIEN,SDFIELDS,"IE","SDDATA") "RTN","SDECWL3",61,0) S DFN=SDDATA(409.3,WLIEN_",",.01,"I") ;DFN "RTN","SDECWL3",62,0) S PTNAME=$$GET1^DIQ(2,DFN,.01) ;NAME OF PT "RTN","SDECWL3",63,0) S ORIGDT=SDDATA(409.3,WLIEN_",",1,"E") ;ORIGINATING DATE "RTN","SDECWL3",64,0) S TYPE=SDDATA(409.3,WLIEN_",",4,"E") ;WAIT LIST TYPE "RTN","SDECWL3",65,0) S CLINIEN=SDDATA(409.3,WLIEN_",",8.5,"I") ;CLINIC IEN "RTN","SDECWL3",66,0) I CLINIEN="" D "RTN","SDECWL3",67,0) .S WLCLIEN=SDDATA(409.3,WLIEN_",",8,"I") "RTN","SDECWL3",68,0) .S CLINIEN=$$GET1^DIQ(409.32,WLCLIEN_",",.01,"I") "RTN","SDECWL3",69,0) Q:CLINIEN="" "RTN","SDECWL3",70,0) S WLCLNAME=$$GET1^DIQ(44,CLINIEN_",",.01) ;Clinic name "RTN","SDECWL3",71,0) S USERIEN=SDDATA(409.3,WLIEN_",",9,"I") ;ORIGINATING USER "RTN","SDECWL3",72,0) S USERNAME=SDDATA(409.3,WLIEN_",",9,"E") ;ORIGINATING USER name "RTN","SDECWL3",73,0) S DATE1=SDDATA(409.3,WLIEN_",",9.5,"E") ;DATE/TIME ENTERED "RTN","SDECWL3",74,0) S DAPTDT=SDDATA(409.3,WLIEN_",",22,"E") ;Desired Date of Appointment "RTN","SDECWL3",75,0) S STATUS=SDDATA(409.3,WLIEN_",",23,"E") ;CURRENT STATUS "RTN","SDECWL3",76,0) S SDTMP=DFN_U_ORIGDT_U_TYPE_U_CLINIEN_U_WLCLNAME_U_USERIEN_U_USERNAME "RTN","SDECWL3",77,0) S SDTMP=SDTMP_U_DATE1_U_DAPTDT_U_STATUS_U_PTNAME "RTN","SDECWL3",78,0) S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDECWL3",79,0) Q "RTN","SDECWL3",80,0) ; "RTN","SDECWL3",81,0) WLDEMO(STR,DFN) ;collect patient demographics and return in STR ;alb/sat 658 "RTN","SDECWL3",82,0) N SDDEMO "RTN","SDECWL3",83,0) D PDEMO^SDECU3(.SDDEMO,DFN) ;alb/sat 658 PDEMO moved to SDECU3 "RTN","SDECWL3",84,0) S $P(STR,U,2)=SDDEMO("NAME") "RTN","SDECWL3",85,0) S $P(STR,U,4)=SDDEMO("DOB") "RTN","SDECWL3",86,0) S $P(STR,U,5)=SDDEMO("SSN") "RTN","SDECWL3",87,0) S $P(STR,U,6)=SDDEMO("GENDER") "RTN","SDECWL3",88,0) S $P(STR,U,27)=SDDEMO("HPHONE") ;alb/sat 658 change to HPHONE "RTN","SDECWL3",89,0) S $P(STR,U,33)=SDDEMO("PRIGRP") "RTN","SDECWL3",90,0) S $P(STR,U,34)=SDDEMO("ELIGIEN") "RTN","SDECWL3",91,0) S $P(STR,U,35)=SDDEMO("ELIGNAME") "RTN","SDECWL3",92,0) S $P(STR,U,36)=SDDEMO("SVCCONN") "RTN","SDECWL3",93,0) S $P(STR,U,37)=SDDEMO("SVCCONNP") "RTN","SDECWL3",94,0) S $P(STR,U,38)=SDDEMO("TYPEIEN") "RTN","SDECWL3",95,0) S $P(STR,U,39)=SDDEMO("TYPENAME") "RTN","SDECWL3",96,0) S $P(STR,U,45)=SDDEMO("PADDRES1") "RTN","SDECWL3",97,0) S $P(STR,U,46)=SDDEMO("PADDRES2") "RTN","SDECWL3",98,0) S $P(STR,U,47)=SDDEMO("PADDRES3") "RTN","SDECWL3",99,0) S $P(STR,U,48)=SDDEMO("PCITY") "RTN","SDECWL3",100,0) S $P(STR,U,49)=SDDEMO("PSTATE") "RTN","SDECWL3",101,0) S $P(STR,U,50)=SDDEMO("PCOUNTRY") "RTN","SDECWL3",102,0) S $P(STR,U,51)=SDDEMO("PZIP+4") "RTN","SDECWL3",103,0) S $P(STR,U,63)=SDDEMO("HRN") "RTN","SDECWL3",104,0) S $P(STR,U,64)=SDDEMO("BADADD") "RTN","SDECWL3",105,0) S $P(STR,U,65)=SDDEMO("OPHONE") "RTN","SDECWL3",106,0) S $P(STR,U,66)=SDDEMO("NOK") "RTN","SDECWL3",107,0) S $P(STR,U,67)=SDDEMO("KNAME") "RTN","SDECWL3",108,0) S $P(STR,U,68)=SDDEMO("KREL") "RTN","SDECWL3",109,0) S $P(STR,U,69)=SDDEMO("KPHONE") "RTN","SDECWL3",110,0) S $P(STR,U,70)=SDDEMO("KSTREET") "RTN","SDECWL3",111,0) S $P(STR,U,71)=SDDEMO("KSTREET2") "RTN","SDECWL3",112,0) S $P(STR,U,72)=SDDEMO("KSTREET3") "RTN","SDECWL3",113,0) S $P(STR,U,73)=SDDEMO("KCITY") "RTN","SDECWL3",114,0) S $P(STR,U,74)=SDDEMO("KSTATE") "RTN","SDECWL3",115,0) S $P(STR,U,75)=SDDEMO("KZIP") "RTN","SDECWL3",116,0) S $P(STR,U,76)=SDDEMO("NOK2") "RTN","SDECWL3",117,0) S $P(STR,U,77)=SDDEMO("K2NAME") "RTN","SDECWL3",118,0) S $P(STR,U,78)=SDDEMO("K2REL") "RTN","SDECWL3",119,0) S $P(STR,U,79)=SDDEMO("K2PHONE") "RTN","SDECWL3",120,0) S $P(STR,U,80)=SDDEMO("K2STREET") "RTN","SDECWL3",121,0) S $P(STR,U,81)=SDDEMO("K2STREET2") "RTN","SDECWL3",122,0) S $P(STR,U,82)=SDDEMO("K2STREET3") "RTN","SDECWL3",123,0) S $P(STR,U,83)=SDDEMO("K2CITY") "RTN","SDECWL3",124,0) S $P(STR,U,84)=SDDEMO("K2STATE") "RTN","SDECWL3",125,0) S $P(STR,U,85)=SDDEMO("K2ZIP") "RTN","SDECWL3",126,0) S $P(STR,U,86)=SDDEMO("PCOUNTY") "RTN","SDECWL3",127,0) S $P(STR,U,87)=SDDEMO("PETH") "RTN","SDECWL3",128,0) S $P(STR,U,88)=SDDEMO("PRACE") "RTN","SDECWL3",129,0) S $P(STR,U,89)=SDDEMO("PMARITAL") "RTN","SDECWL3",130,0) S $P(STR,U,90)=SDDEMO("PRELIGION") "RTN","SDECWL3",131,0) S $P(STR,U,91)=SDDEMO("PTACTIVE") "RTN","SDECWL3",132,0) S $P(STR,U,92)=SDDEMO("PTADDRESS1") "RTN","SDECWL3",133,0) S $P(STR,U,93)=SDDEMO("PTADDRESS2") "RTN","SDECWL3",134,0) S $P(STR,U,94)=SDDEMO("PTADDRESS3") "RTN","SDECWL3",135,0) S $P(STR,U,95)=SDDEMO("PTCITY") "RTN","SDECWL3",136,0) S $P(STR,U,96)=SDDEMO("PTSTATE") "RTN","SDECWL3",137,0) S $P(STR,U,97)=SDDEMO("PTZIP") "RTN","SDECWL3",138,0) S $P(STR,U,98)=SDDEMO("PTZIP+4") "RTN","SDECWL3",139,0) S $P(STR,U,99)=SDDEMO("PTCOUNTRY") "RTN","SDECWL3",140,0) S $P(STR,U,100)=SDDEMO("PTCOUNTY") "RTN","SDECWL3",141,0) S $P(STR,U,101)=SDDEMO("PTPHONE") "RTN","SDECWL3",142,0) S $P(STR,U,102)=SDDEMO("PTSTART") "RTN","SDECWL3",143,0) S $P(STR,U,103)=SDDEMO("PTEND") "RTN","SDECWL3",144,0) S $P(STR,U,104)=SDDEMO("PCELL") "RTN","SDECWL3",145,0) S $P(STR,U,105)=SDDEMO("PPAGER") "RTN","SDECWL3",146,0) S $P(STR,U,106)=SDDEMO("PEMAIL") "RTN","SDECWL3",147,0) S $P(STR,U,107)=SDDEMO("PF_FFF") "RTN","SDECWL3",148,0) S $P(STR,U,108)=SDDEMO("PF_VCD") "RTN","SDECWL3",149,0) S $P(STR,U,109)=SDDEMO("PFNATIONAL") "RTN","SDECWL3",150,0) S $P(STR,U,110)=SDDEMO("PFLOCAL") "RTN","SDECWL3",151,0) S $P(STR,U,111)=SDDEMO("SUBGRP") "RTN","SDECWL3",152,0) S $P(STR,U,112)=($P(STR,U,33)="GROUP 8")&(SDDEMO("SUBGRP")="g") "RTN","SDECWL3",153,0) S $P(STR,U,113)=SDDEMO("SIMILAR") "RTN","SDECWL3",154,0) Q "RTN","SDM1A") 0^14^B130744784^B126358746 "RTN","SDM1A",1,0) SDM1A ;SF/GFT,ALB/TMP - MAKE APPOINTMENT ;JUN 21, 2017 "RTN","SDM1A",2,0) ;;5.3;Scheduling;**26,94,155,206,168,223,241,263,327,478,446,544,621,622,627,658,665**;Aug 13, 1993;Build 14 "RTN","SDM1A",3,0) ; "RTN","SDM1A",4,0) OK I $D(SDMLT) D ^SDM4 Q:X="^"!(SDMADE=2) "RTN","SDM1A",5,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",6,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",7,0) I SM S ^("OB")="O" ;NAKED REFERENCE - ^SC(IFN,"S",Date,1,SDY,"OB") "RTN","SDM1A",8,0) I $D(^SC(SC,"RAD")),^("RAD")="Y"!(^("RAD")=1) S ^SC("ARAD",SC,SD,DFN)="" "RTN","SDM1A",9,0) S SDINP=$$INP^SDAM2(DFN,SD) "RTN","SDM1A",10,0) ;-- added sub-category "RTN","SDM1A",11,0) S COV=3,SDYC="",COV=$S(COLLAT=1:1,1:3),SDYC=$S(COLLAT=7:1,1:"") "RTN","SDM1A",12,0) S:SD
DT,$D(^DPT(DFN,.321)) D EN1^SDM3 "RTN","SDM1A",27,0) ;Wait List SD*5.3*263 "RTN","SDM1A",28,0) ;I '$D(SDWLLIST) D ^SDWLR ;replaced with sd/372, see below "RTN","SDM1A",29,0) EWLCHK ;check if patient has any open EWL entries (SD/372) "RTN","SDM1A",30,0) ;get appointment "RTN","SDM1A",31,0) K ^TMP($J,"SDAMA301"),^TMP($J,"APPT") "RTN","SDM1A",32,0) D APPT^SDWLEVAL(DFN,SD,SC) "RTN","SDM1A",33,0) Q:'$D(^TMP($J,"APPT")) "RTN","SDM1A",34,0) N SDWL,SDWLF,SDWLIST S SDWL="" S SDWLF=0 ;alb/sat 627 "RTN","SDM1A",35,0) N SDEV D EN^SDWLEVAL(DFN,.SDEV) I SDEV,$L(SDEV(1))>0 D "RTN","SDM1A",36,0) .K ^TMP("SDWLPL",$J),^TMP($J,"SDWLPL") "RTN","SDM1A",37,0) .D INIT^SDWLPL(DFN,"M") "RTN","SDM1A",38,0) .Q:'$D(^TMP($J,"SDWLPL")) "RTN","SDM1A",39,0) .D LIST^SDWLPL("M",DFN) "RTN","SDM1A",40,0) .D SDGET(.SDWLIST) ;alb/sat 627 "RTN","SDM1A",41,0) .F Q:'$D(^TMP($J,"SDWLPL")) N SDR D ANSW^SDWLEVAL(1,.SDR) S:SDR SDWLF=1 I 'SDR D LIST^SDWLPL("M",DFN) D "RTN","SDM1A",42,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",! ;alb/sat665 remove S SDWLF=1 "RTN","SDM1A",43,0) .S:+SDWLF SDWL=$$SDWL(.SDWLIST) ;alb/sat 627 "RTN","SDM1A",44,0) ;update SDEC APPOINTMENT file 409.84 ;alb/sat 627 "RTN","SDM1A",45,0) N SDECAR,SDREC,SDRES "RTN","SDM1A",46,0) S SDREC="" "RTN","SDM1A",47,0) I $G(CNSLTLNK)="",SDWL="" S SDREC=$$RECALL^SDECUTL(DFN,SD,SDSC) ;check if recall appt "RTN","SDM1A",48,0) I SDWL="",$G(CNSLTLNK)="",SDREC="" S SDECAR=$$SDWLA(DFN,SD,SDSC,SDDATE,$G(SDAPTYP),$G(SDECANS)) ;alb/sat 665 add SDECANS "RTN","SDM1A",49,0) K SDECANS "RTN","SDM1A",50,0) S SDRES=$$GETRES^SDECUTL(SC) "RTN","SDM1A",51,0) S SDAPTYP=$G(SDAPTYP) S:SDAPTYP="" SDAPTYP=$$GET1^DIQ(44,SC_",",2507,"I") "RTN","SDM1A",52,0) ;alb/sat 658 - moved below OTHER INFO prompt to store in NOTE field of 409.84 "RTN","SDM1A",53,0) ;D SDECADD^SDEC07(SD,$$FMADD^XLFDT(SD,,,+SL),DFN,SDRES,0,SDDATE,"",$S(+SDWL:"E|"_SDWL,+$G(CNSLTLNK):"C|"_CNSLTLNK,+SDREC:"R|"_SDREC,+SDECAR:"A|"_SDECAR,1:""),,SC,,,,SDAPTYP) ;ADD SDEC APPOINTMENT ENTRY "RTN","SDM1A",54,0) ;end addition/modification ;alb/sat 627 "RTN","SDM1A",55,0) ;CREATE 120 FLAG IF APPLICABLE; appt created "RTN","SDM1A",56,0) FLG N SDST S SDST=$G(^TMP($J,"APPT",1)) I +SDST>0 D "RTN","SDM1A",57,0) .Q ; sd/446 "RTN","SDM1A",58,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",59,0) .S X=SDT D H^%DTC S SDT1=%H "RTN","SDM1A",60,0) .S X=SDDES D H^%DTC S SDDES1=%H "RTN","SDM1A",61,0) .I SDT1-SDDES1>120 N SD120,SD120A S SD120=1,SD120A=1 D "RTN","SDM1A",62,0) ..; CREATE ewl eN SDPR S SDPR=$S(SDDES=DT:"A",1:"F") entry with 120 flag "RTN","SDM1A",63,0) ..N SDPR S SDPR=$S(SDDES=DT:"A",1:"F") ;10 "RTN","SDM1A",64,0) ..N SDWLIN S SDWLIN=+$P(SDST,U,15) ;2 "RTN","SDM1A",65,0) ..N SDWLSCPR S SDWLSCPR=0 I +$P(SDST,U,10)=11 S SDWLSCPR=1 ;15 "RTN","SDM1A",66,0) ..N SC,SDWLSCL S SC=+$P(SDST,U,2) D "RTN","SDM1A",67,0) ...I $D(^SDWL(409.32,"B",SC)) S SDWLSCL=$O(^SDWL(409.32,"B",SC,"")) Q ;8 "RTN","SDM1A",68,0) ...;create 409.32 entry "RTN","SDM1A",69,0) ...N DA,DIC S DIC(0)="LX",X=SC,DIC="^SDWL(409.32," D FILE^DICN "RTN","SDM1A",70,0) ...S SDWLSCL=DA "RTN","SDM1A",71,0) ...S DIE="^SDWL(409.32," "RTN","SDM1A",72,0) ...S DR=".02////^S X=SDWLIN" D ^DIE "RTN","SDM1A",73,0) ...S DR="1////^S X=DT" "RTN","SDM1A",74,0) ...S DR=DR_";2////^S X=DUZ" "RTN","SDM1A",75,0) ...D ^DIE S SDPAR=1 "RTN","SDM1A",76,0) ..N DA S DIC(0)="LX",(X,SDWLDFN)=+$P(SDST,U,4),X=SDWLDFN,DIC="^SDWL(409.3," D FILE^DICN "RTN","SDM1A",77,0) ..F L +^SDWL(409.3,DA):$G(DILOCKTM,5) Q:$T D "RTN","SDM1A",78,0) ...I '$T W !,"Unable to acquire a lock on the Wait List file" Q "RTN","SDM1A",79,0) ..; Update EWL variables. "RTN","SDM1A",80,0) ..S SDWLDA=DA D EN^SDWLE11 ; get enrollee both SDWLDA and SDWLDFN have to be "RTN","SDM1A",81,0) ..N SDWLCM S SDWLCM=" > 120 days; appt created" "RTN","SDM1A",82,0) ..N SDWLSCPG S SDWLSCPG=$S($P($G(^DPT(SDWLDFN,.3)),U,1)="Y":$P(^(.3),U,2),1:"") "RTN","SDM1A",83,0) ..S DR="1////^S X=DT" "RTN","SDM1A",84,0) ..S DR=DR_";2////^S X=SDWLIN" "RTN","SDM1A",85,0) ..S DR=DR_";4////^S X=4" "RTN","SDM1A",86,0) ..S DR=DR_";8////^S X=SDWLSCL" "RTN","SDM1A",87,0) ..S DR=DR_";9////^S X=DUZ" "RTN","SDM1A",88,0) ..S DR=DR_";10////^S X=SDPR" "RTN","SDM1A",89,0) ..S DR=DR_";11////^S X=2" ; by patient for this entry to avoid asking for provider "RTN","SDM1A",90,0) ..S DR=DR_";14////^S X=SDWLSCPG" "RTN","SDM1A",91,0) ..S DR=DR_";15////^S X=SDWLSCPR" "RTN","SDM1A",92,0) ..S DR=DR_";22////^S X=SDDES" "RTN","SDM1A",93,0) ..S DR=DR_";23////^S X=""O""" "RTN","SDM1A",94,0) ..S DR=DR_";25////^S X=SDWLCM" "RTN","SDM1A",95,0) ..S DR=DR_";36////^S X=SD120" "RTN","SDM1A",96,0) ..S DR=DR_";39////^S X=SD120A" "RTN","SDM1A",97,0) ..S DIE="^SDWL(409.3," "RTN","SDM1A",98,0) ..D ^DIE "RTN","SDM1A",99,0) ..L -^SDWL(409.3,DA) "RTN","SDM1A",100,0) ..D MESS^SDWL120(SDWLDFN,SC,SDT,SDPAR) "RTN","SDM1A",101,0) ;continue appointment entry process "RTN","SDM1A",102,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",103,0) I '(%-1) D ORDY^SDM3 "RTN","SDM1A",104,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",105,0) S TMPD=D I $L(D)>150 D MSG^SDMM G OTHER ;SD/478 "RTN","SDM1A",106,0) I D]"",D?."?"!(D'?.ANP) W " ENTER LAB, SCAN, ETC." G OTHER "RTN","SDM1A",107,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",108,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",109,0) S $P(^(0),"^",4)=D ;NAKED REFERENCE - ^SC(IFN,"S",Date,1,SDY,0) 544 moved DUZ&DT to tag S1. "RTN","SDM1A",110,0) S:$G(SL)="" SL=$G(^SC(+SC,"SL")) ;alb/sat 658 - SL gets killed in SDM3 if 'WANT PATIENT NOTIFIED OF LAB,X-RAY, OR EKG STOPS' is answered with Y "RTN","SDM1A",111,0) D SDECADD^SDEC07(SD,$$FMADD^XLFDT(SD,,,+SL),DFN,SDRES,0,SDDATE,"",$S(+SDWL:"E|"_SDWL,+$G(CNSLTLNK):"C|"_CNSLTLNK,+SDREC:"R|"_SDREC,+SDECAR:"A|"_SDECAR,1:""),,SC,$G(D),,,SDAPTYP) ;ADD SDEC APPOINTMENT ENTRY ;alb/sat 658 moved from above "RTN","SDM1A",112,0) D:$D(TMP) LINK^SDCNSLT(SC,SDY,SD,CNSLTLNK) ;SD/478 "RTN","SDM1A",113,0) D:$D(TMP) EDITCS^SDCNSLT(SD,TMPD,TMPYCLNC,CNSLTLNK) ;SD/478 "RTN","SDM1A",114,0) K TMP ;SD/478 "RTN","SDM1A",115,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",116,0) SDMM S SDEMP=0 I COLLAT=7 S:SDEC'=SDCOL SDEMP=SDCOL G OV "RTN","SDM1A",117,0) D ELIG^VADPT I $O(VAEL(1,0))>0 D ELIG^SDM4:"369"[SDAPTYP S SDEMP=$S(SDDECOD:SDDECOD,1:SDEMP) "RTN","SDM1A",118,0) OV Q:$D(SDZM) K SDQ1,SDEC,SDCOL I +SDEMP S $P(^SC(SC,"S",SD,1,SDY,0),"^",10)=+SDEMP "RTN","SDM1A",119,0) S SDMADE=1 D EVT "RTN","SDM1A",120,0) LET ; SD*5.3*622 - help user print the PRE-APPT letter for a patient "RTN","SDM1A",121,0) ; check for a PRE-APPT letter defined and if none, don't issue a device prompt "RTN","SDM1A",122,0) N SDFN ; new SDFN to see the patient prompt next time "RTN","SDM1A",123,0) S %=2 W !!,"WANT TO PRINT THE PRE-APPOINTMENT LETTER" D YN^DICN I %=0 W !,"RESPOND YES (Y) OR NO (N)" G:'% LET "RTN","SDM1A",124,0) I (%=2)!(%=-1) Q "RTN","SDM1A",125,0) I $P($G(^SC(SC,"LTR")),U,2)="" D Q "RTN","SDM1A",126,0) . W $C(7),!!,"PATIENT "_$P(^DPT(DFN,0),U,1)," ",$P(^(0),U,9)," HAS FUTURE APPTS., but" "RTN","SDM1A",127,0) . W !,$P(^SC(SC,0),U,1)_" is not assigned a PRE-APPOINTMENT LETTER",! "RTN","SDM1A",128,0) . S DIR(0)="E" D ^DIR K DIR "RTN","SDM1A",129,0) ; "RTN","SDM1A",130,0) ; pre-define letter type (P), the division, date for appt, etc. "RTN","SDM1A",131,0) S (SDBD,SDED)=SDTTM,L0="P",SD9=0,VAUTNALL=1,VAUTNI=2,S1="P",SDLT=1,SDV1=1,SDFORM="" "RTN","SDM1A",132,0) S L2=$S(L0="P":"^SDL1",1:"^SDL1"),J=SDBD "RTN","SDM1A",133,0) S (A,SDFN,S)=DFN,L="^SDL1",SDCL=+$P(^SC(SC,0),U,1),SDC=SC,SDX=SDTTM "RTN","SDM1A",134,0) S SDLET=$P(^SC(SC,"LTR"),U,2) ; letter IEN "RTN","SDM1A",135,0) S SDLET1=SDLET "RTN","SDM1A",136,0) I SDY["DPT(" S SDAMTYP="P",SDFN=+SDY "RTN","SDM1A",137,0) I SDY["SC(" S SDAMTYP="C",SDCLN=+SDY "RTN","SDM1A",138,0) ; prepare to queue the letter if the user so desires "RTN","SDM1A",139,0) N %ZIS,POP,ZTDESC,ZTRTN,ZTSAVE "RTN","SDM1A",140,0) S %ZIS("B")="",POP=0,%ZIS="MQ" D ^%ZIS Q:POP "RTN","SDM1A",141,0) I $D(IO("Q")) S ZTRTN="QUE^SDM1A",ZTDESC="PRINT PRE-APPT LETTER",ZTSAVE("*")="" D ^%ZTLOAD,HOME^%ZIS K IO("Q") Q "RTN","SDM1A",142,0) D QUE ; print right away without getting into the queue "RTN","SDM1A",143,0) D HOME^%ZIS "RTN","SDM1A",144,0) Q "RTN","SDM1A",145,0) ; "RTN","SDM1A",146,0) QUE ; execute whether by queue or immediate print request "RTN","SDM1A",147,0) U IO "RTN","SDM1A",148,0) D PRT^SDLT,WRAPP^SDLT "RTN","SDM1A",149,0) ; if there are x-ray, lab, or ekg appts, print them too "RTN","SDM1A",150,0) S SDATA=$G(^DPT(DFN,"S",SDX,0)) "RTN","SDM1A",151,0) I $D(SDATA) F B=3,4,5 D "RTN","SDM1A",152,0) . S SDCL=$S(B=3:"LAB",B=4:"XRAY",1:"EKG") "RTN","SDM1A",153,0) . S SDX=$P($G(SDATA),U,B) "RTN","SDM1A",154,0) . S SC=SDCL Q:$G(SDX)="" D FORM^SDLT "RTN","SDM1A",155,0) ; "RTN","SDM1A",156,0) D REST^SDLT "RTN","SDM1A",157,0) D ^%ZISC "RTN","SDM1A",158,0) Q ; SD*5.3*622 - end of changes "RTN","SDM1A",159,0) ; "RTN","SDM1A",160,0) HXR W !," Enter YES to have previous XRAY results sent to the clinic" G XR "RTN","SDM1A",161,0) Q "RTN","SDM1A",162,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",163,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",164,0) K SDCS Q "RTN","SDM1A",165,0) STATUS(SDCL,SDINP,SDT) ; -- determine status for NEW appts "RTN","SDM1A",166,0) Q $S(SDINP]"":SDINP,$$CHK(.SDCL,.SDT):"NT",1:"") "RTN","SDM1A",167,0) CHK(SDCL,SDT) ; -- should appt be NT'ed "RTN","SDM1A",168,0) ; -- non-count clinic check := don't NT appt "RTN","SDM1A",169,0) ; -- appt update executed := need to NT appt "RTN","SDM1A",170,0) ; -- otherwise := don't NT appt "RTN","SDM1A",171,0) Q $S($P($G(^SC(SDCL,0)),U,17)="Y":0,$D(^SDD(409.65,"AUPD",$P(SDT,"."))):1,1:0) "RTN","SDM1A",172,0) EVT ; -- separate tag if need to NEW vars "RTN","SDM1A",173,0) D MAKE^SDAMEVT(DFN,SD,SC,SDY,0) "RTN","SDM1A",174,0) Q "RTN","SDM1A",175,0) REQ(SDT) ; -- which is required check in(CI) or out(CO) "RTN","SDM1A",176,0) Q $S($$REQDT()>SDT:"CI",1:"CO") "RTN","SDM1A",177,0) REQDT() ; -- co required date "RTN","SDM1A",178,0) Q $S($P(^DG(43,1,"SCLR"),U,23):$P(^("SCLR"),U,23),1:2931001) "RTN","SDM1A",179,0) COCMP(DFN,SDT) ; -- date CO completed "RTN","SDM1A",180,0) Q $P($G(^SCE(+$P($G(^DPT(DFN,"S",SDT,0)),U,20),0)),U,7) "RTN","SDM1A",181,0) CI(SDCL,SDT,SDDA,SDACT) ; -- ok to update DPT "RTN","SDM1A",182,0) N C "RTN","SDM1A",183,0) I '$$CHK(.SDCL,.SDT) G CIQ "RTN","SDM1A",184,0) I $$REQ(SDT)'="CI" G CIQ "RTN","SDM1A",185,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",186,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",187,0) CIQ Q "RTN","SDM1A",188,0) CO(SDCL,SDT,SDDA,SDACT) ; -- ok to update DPT "RTN","SDM1A",189,0) N DFN,C "RTN","SDM1A",190,0) I '$$CHK(.SDCL,.SDT) G COQ "RTN","SDM1A",191,0) I $$REQ(.SDT)'="CO" D G COQ "RTN","SDM1A",192,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",193,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",194,0) S DFN=+^SC(SDCL,"S",SDT,1,SDDA,0) "RTN","SDM1A",195,0) D UPD(.DFN,.SDT,$$COCMP(.DFN,.SDT),$S(SDACT="SET":X,1:"")) "RTN","SDM1A",196,0) COQ Q "RTN","SDM1A",197,0) UPD(DFN,SDT,SDCOCMP,SDCODT) ; -- update status "RTN","SDM1A",198,0) N Y "RTN","SDM1A",199,0) I $D(^DPT(DFN,"S",SDT,0)) S Y=$P(^(0),U,2) D "RTN","SDM1A",200,0) .I 'SDCOCMP!('SDCODT) S:Y="" $P(^DPT(DFN,"S",SDT,0),U,2)="NT" Q "RTN","SDM1A",201,0) .S:Y="NT" $P(^DPT(DFN,"S",SDT,0),U,2)="" "RTN","SDM1A",202,0) Q "RTN","SDM1A",203,0) OE(SDOE,SDACT) ; -- called by x-ref on co completed field(#.07) in ^SCE "RTN","SDM1A",204,0) N Y S Y=^SCE(SDOE,0) "RTN","SDM1A",205,0) I $P(Y,U,8)'=1 G OEQ "RTN","SDM1A",206,0) I $$REQ(+Y)'="CO" G OEQ "RTN","SDM1A",207,0) I '$$CANT(+$P(Y,U,2),+Y,SDOE),'$$CHK(+$P(Y,U,4),+Y) G OEQ "RTN","SDM1A",208,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",209,0) OEQ Q "RTN","SDM1A",210,0) CONF(SDSRTY,SDSRFU,DFN,SDT,SC) ;Confirm scheduling request type "RTN","SDM1A",211,0) ;Input: SDSRTY=request type "RTN","SDM1A",212,0) ;Input: SDSRFU=follow-up indicator "RTN","SDM1A",213,0) ;Input: DFN=patient ien "RTN","SDM1A",214,0) ;Input: SDT=appointment date/time "RTN","SDM1A",215,0) ;Input: SC=clinic ifn "RTN","SDM1A",216,0) N DIR,DIE,DA,DR,SDX,SDY,X,Y "RTN","SDM1A",217,0) S DIR(0)="Y",DIR("B")="YES" "RTN","SDM1A",218,0) S DIR("A")="THIS APPOINTMENT IS MARKED AS '"_SDSRTY(0)_"', IS THIS CORRECT" "RTN","SDM1A",219,0) W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) "RTN","SDM1A",220,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",221,0) ;S DIR("A")="THIS APPOINTMENT IS DEFINED AS '"_$S(SDSRFU:"FOLLOW-UP",1:"OTHER THAN FOLLOW-UP")_"', OK" "RTN","SDM1A",222,0) ;W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) "RTN","SDM1A",223,0) ;I 'Y S SDY='SDSRFU W " (changed)" "RTN","SDM1A",224,0) Q:'$D(SDX) S DR="" "RTN","SDM1A",225,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",226,0) ;I $D(SDY) S:$L(DR) DR=DR_";" S DR=DR_"26///^S X=SDY" "RTN","SDM1A",227,0) S DA=SDT,DA(1)=DFN "RTN","SDM1A",228,0) S DIE="^DPT(DA(1),""S""," D ^DIE "RTN","SDM1A",229,0) Q "RTN","SDM1A",230,0) TXRT(SDSRTY) ;Transform request type "RTN","SDM1A",231,0) ;Input: SDSRTY=variable to return request type (pass by reference) "RTN","SDM1A",232,0) ;Output: external text for SDSRTY(0) "RTN","SDM1A",233,0) I SDSRTY S SDSRTY=SDSRTY_U_"N" Q "NEXT AVAILABLE" "RTN","SDM1A",234,0) S SDSRTY=SDSRTY_U_"O" Q "NOT NEXT AVAILABLE" "RTN","SDM1A",235,0) CANT(DFN,SDT,SDOE) ;Determine if clinic appt. has been marked "NT" "RTN","SDM1A",236,0) ;Output: '1' if appt. points to encounter and is marked "NT", otherwise '0' "RTN","SDM1A",237,0) N SDAPP S SDAPP=$G(^DPT(DFN,"S",SDT,0)) "RTN","SDM1A",238,0) Q:$P(SDAPP,U,20)'=SDOE 0 "RTN","SDM1A",239,0) Q $P(SDAPP,U,2)="NT" "RTN","SDM1A",240,0) SDGET(SDWLIST) ;build array of wait list entries that are in ^TMP($J,"SDWLPL") "RTN","SDM1A",241,0) N SDI "RTN","SDM1A",242,0) K SDWLIST "RTN","SDM1A",243,0) S SDI="" F S SDI=$O(^TMP($J,"SDWLPL",SDI)) Q:SDI="" D "RTN","SDM1A",244,0) .S SDWLIST(+$G(^TMP($J,"SDWLPL",SDI)))="" "RTN","SDM1A",245,0) Q "RTN","SDM1A",246,0) ; -- Variable doc for above tags "RTN","SDM1A",247,0) ; SDCL := file 44 ien "RTN","SDM1A",248,0) ; SDT := appt date/time "RTN","SDM1A",249,0) ; DFN := file 2 ien "RTN","SDM1A",250,0) ; SDDA := ^SC(SDCL,"S",SDT,1,SDDA,0) "RTN","SDM1A",251,0) ; SDACT := current x-ref action 'set' or 'kill' "RTN","SDM1A",252,0) ; SDCOCMP := check out completed date "RTN","SDM1A",253,0) ; SDCODT := check out date/time "RTN","SDM1A",254,0) ; SDOE := Outpatient Encounter ien "RTN","SDM1A",255,0) ; SDINP := inpatient status ('I' or null) "RTN","SDM1A",256,0) ; SDINP := inpatient status ('I' or null) "RTN","SDM1A",257,0) ; "RTN","SDM1A",258,0) SDWL(SDWLIST) ;determine EWL that was closed for this appointment ;alb/sat SD/627 "RTN","SDM1A",259,0) N SDI "RTN","SDM1A",260,0) S SDI="" F S SDI=$O(^TMP($J,"SDWLPL",SDI)) Q:SDI="" D "RTN","SDM1A",261,0) .I $D(SDWLIST(+$G(^TMP($J,"SDWLPL",SDI)))) K SDWLIST(+$G(^TMP($J,"SDWLPL",SDI))) "RTN","SDM1A",262,0) Q $O(SDWLIST(0)) "RTN","SDM1A",263,0) SDWLA(DFN,SD,SDSC,SDDATE,SDAPTYP,SDECANS) ;add SDEC APPT REQUEST entry ;alb/sat SD/627 ;alb/sat 665 add SDECANS "RTN","SDM1A",264,0) ;INPUT: "RTN","SDM1A",265,0) ; DFN "RTN","SDM1A",266,0) ; SD = appointment date/time in fm format "RTN","SDM1A",267,0) ; SDSC = clinic code pointer to HOSPITAL LOCATION file "RTN","SDM1A",268,0) ; SDDATE = desired date of appointment "RTN","SDM1A",269,0) ; SDAPTYP = pointer to APPOINTMENT TYPE file 409.1 "RTN","SDM1A",270,0) ; SDECANS = service connected condition Y=yes N=no from SDM4 ;alb/sat 665 "RTN","SDM1A",271,0) N SDECINP,SDWLSTAT,SDARIEN,SDWLRET,X "RTN","SDM1A",272,0) S SDAPTYP=$G(SDAPTYP) "RTN","SDM1A",273,0) S SDECANS=$G(SDECANS) ;alb/sat 665 "RTN","SDM1A",274,0) ;get clinic location name "RTN","SDM1A",275,0) K ^TMP("SDEC50",$J,"PCSTGET") "RTN","SDM1A",276,0) D PCSTGET^SDEC(.SDWLRET,DFN,SDSC) "RTN","SDM1A",277,0) S SDWLSTAT=$P($P($G(^TMP("SDEC50",$J,"PCSTGET",1)),$C(30),1),U,2) "RTN","SDM1A",278,0) K ^TMP("SDEC50",$J,"PCSTGET") "RTN","SDM1A",279,0) ;set appt request entry "RTN","SDM1A",280,0) S SDECINP(1)="" "RTN","SDM1A",281,0) S SDECINP(2)=DFN ;patient "RTN","SDM1A",282,0) S SDECINP(3)=$E($$NOW^XLFDT,1,12) ;originating date/time "RTN","SDM1A",283,0) S SDECINP(4)=DUZ(2) ;institution "RTN","SDM1A",284,0) S SDECINP(5)="APPOINTMENT" ;wait list type - specific clinic "RTN","SDM1A",285,0) S SDECINP(6)=SDSC ;clinic "RTN","SDM1A",286,0) S SDECINP(7)=DUZ ;originating user "RTN","SDM1A",287,0) S SDECINP(8)="ASAP" ;priority "RTN","SDM1A",288,0) S SDECINP(9)="PATIENT" ;requested by "RTN","SDM1A",289,0) S SDECINP(11)=SDDATE ;desired date of appointment "RTN","SDM1A",290,0) ;S SDECINP(16)=$S(SDWLSTAT="YES":"ESTABLISHED",1:"NEW") "RTN","SDM1A",291,0) S SDECINP(14)="NO" ;multiple appointment RTC "RTN","SDM1A",292,0) S SDECINP(15)=0 "RTN","SDM1A",293,0) S SDECINP(16)=0 "RTN","SDM1A",294,0) S:SDECANS'="" SDECINP(18)=$S(SDECANS="Y":"YES",1:0) ;alb/sat 665 "RTN","SDM1A",295,0) S:+SDAPTYP SDECINP(22)=+SDAPTYP ;appointment type "RTN","SDM1A",296,0) K SDWLRET "RTN","SDM1A",297,0) S SDWLRET="" "RTN","SDM1A",298,0) D ARSET1^SDEC(.SDWLRET,.SDECINP) "RTN","SDM1A",299,0) S SDARIEN=$P($P(SDWLRET,$C(30),2),U,1) "RTN","SDM1A",300,0) S SDWLRET="" "RTN","SDM1A",301,0) Q:'$D(^SDEC(409.85,+SDARIEN,0)) "" "RTN","SDM1A",302,0) ;close appt request entry "RTN","SDM1A",303,0) K INP "RTN","SDM1A",304,0) S INP(1)=SDARIEN "RTN","SDM1A",305,0) S INP(2)="REMOVED/SCHEDULED-ASSIGNED" "RTN","SDM1A",306,0) S INP(3)=DUZ "RTN","SDM1A",307,0) S INP(4)=$P(SD,".",1) "RTN","SDM1A",308,0) D ARCLOSE1^SDEC(.SDWLRET,.INP) "RTN","SDM1A",309,0) Q SDARIEN "RTN","SDM4") 0^15^B43938157^B43568059 "RTN","SDM4",1,0) SDM4 ;ALB/BOK - MAKE APPOINTMENT ;JUN 21, 2017; Compiled April 9, 2007 14:26:51 "RTN","SDM4",2,0) ;;5.3;Scheduling;**263,273,327,394,417,496,585,665**;Aug 13, 1993;Build 14 "RTN","SDM4",3,0) ; "RTN","SDM4",4,0) ;09/15/2002 $N FUNCTION REMOVED AND REPLACED WITH $O - IOFO - BAY PINES - TEH "RTN","SDM4",5,0) ; "RTN","SDM4",6,0) ;ICR Agreements: "RTN","SDM4",7,0) ; "RTN","SDM4",8,0) ;ICR - 1476 For reference to PRIMARY ELIG. ^DPT(IEN,.372). "RTN","SDM4",9,0) ;ICR - 427 For reference to ^DIC(8) "RTN","SDM4",10,0) ;ICR - 10061 For reference to 2^VADPT "RTN","SDM4",11,0) ;ICR - 2056 For reference to $$GET1^DIQ "RTN","SDM4",12,0) ;ICR - 10116 for reference to $$UPPER^VALM1 "RTN","SDM4",13,0) ;ICR - 2516 For reference to ^DIC(8.1 - SD*585 "RTN","SDM4",14,0) ; "RTN","SDM4",15,0) ;09/23/2005 Patch SD*5.3*417 Upper/Lower case usage. "RTN","SDM4",16,0) ;04/09/2007 Patch SD*5.3*496 Accept entry in file 44 without STOP CODE "RTN","SDM4",17,0) ; "RTN","SDM4",18,0) ; "RTN","SDM4",19,0) TYPE ; "RTN","SDM4",20,0) D SC "RTN","SDM4",21,0) RAT ;Display rated service connected disabilities patch SD*5.3*394 "RTN","SDM4",22,0) D 2^VADPT "RTN","SDM4",23,0) W !!,"PATIENT'S SERVICE CONNECTION AND RATED DISABILITIES:" "RTN","SDM4",24,0) IF $$GET1^DIQ(2,DFN_",",.301,"E")="YES"&($P(VAEL(3),"^",2)'="") D "RTN","SDM4",25,0) .W !,"SC Percent: "_$P(VAEL(3),"^",2)_"%" "RTN","SDM4",26,0) IF $$GET1^DIQ(2,DFN_",",.301,"E")="NO"&($P(VAEL(3),"^",2)="") D "RTN","SDM4",27,0) .W !,"Service Connected: No" "RTN","SDM4",28,0) ;Rated Disabilities "RTN","SDM4",29,0) N SDSER,SDRAT,SDPER,SDREC,NN,NUM,ANS,SDELIG,SDATD,SDSCFLG,SDVAEL S (ANS,NN,NUM)=0 "RTN","SDM4",30,0) F S NN=$O(^DPT(DFN,.372,NN)) Q:'NN D "RTN","SDM4",31,0) .S SDREC=$G(^DPT(DFN,.372,NN,0)) IF SDREC'="" D "RTN","SDM4",32,0) ..S SDRAT="" S NUM=$P($G(SDREC),"^",1) IF NUM>0 S SDRAT=$$GET1^DIQ(31,NUM_",",.01) "RTN","SDM4",33,0) ..S SDSER="" S SDSER=$S($P(SDREC,"^",3)="1":"SC",1:"NSC") "RTN","SDM4",34,0) ..W !," "_SDRAT_" ("_SDSER_" - "_$P(SDREC,"^",2)_"%)" "RTN","SDM4",35,0) ..Q "RTN","SDM4",36,0) W !,"Primary Eligibility Code: "_$P(VAEL(1),"^",2) "RTN","SDM4",37,0) IF $P($G(^DPT(DFN,.372,0)),"^",4)<1 W !,"No Service Connected Disabilities Listed" "RTN","SDM4",38,0) W ! "RTN","SDM4",39,0) S SDELIG=$$GET1^DIQ(2,DFN_",",.301,"E"),SDSCFLG=0 "RTN","SDM4",40,0) IF SDELIG="" W !,"'SERVICE CONNECTED?' field is blank please update patient record." S SDSCFLG=1 "RTN","SDM4",41,0) IF $P(VAEL(1),U,2)="" W !,"'PRIMARY ELIGIBILITY CODE' field is blank please update patient record." S SDSCFLG=1 "RTN","SDM4",42,0) D GETMAS ;SD*585 get MAS Eligibility Code (file #8.1) for each of patient's eligibilities returns array SDVAEL "RTN","SDM4",43,0) ;SD*585 modified each out of sync check to use correct code from MAS Eligibility Code file (#8.1) - in array SDVAEL "RTN","SDM4",44,0) IF SDELIG="NO",($P(VAEL(3),U,2)>0)!($P(SDVAEL(1),U,2)="SC LESS THAN 50%")!($P(SDVAEL(1),U,2)="SERVICE CONNECTED 50% to 100%")!($P(SDVAEL(1),U,2)="") D ;SD*585 "RTN","SDM4",45,0) .W !,"The 'SC Percent','Service Connected' and 'Primary Eligibility Codes' are OUT OF SYNC, Please CORRECT the problem." S SDSCFLG=1 "RTN","SDM4",46,0) IF SDELIG="YES",($P(VAEL(3),"^",2)<50),($P(SDVAEL(1),U,2)'="SC LESS THAN 50%") D ;SD*585 "RTN","SDM4",47,0) .W !,"The 'SC Percent','Service Connected' and 'Primary Eligibility Codes' are OUT OF SYNC, Please CORRECT the problem." S SDSCFLG=1 "RTN","SDM4",48,0) IF SDELIG="YES",($P(VAEL(3),"^",2)>49),($P(SDVAEL(1),U,2)'="SERVICE CONNECTED 50% to 100%") D ;SD*585 "RTN","SDM4",49,0) .W !,"The 'SC Percent','Service Connected' and 'Primary Eligibility Codes' are OUT OF SYNC, Please CORRECT the problem." S SDSCFLG=1 "RTN","SDM4",50,0) W ! "RTN","SDM4",51,0) ;Ask about service connected appointment "RTN","SDM4",52,0) N STOP,STOPN,SIEN S (ACT,IENACT)="" S STOP=$$GET1^DIQ(44,+SC_",",8,"I") "RTN","SDM4",53,0) I +STOP>0 S STOPN=$$GET1^DIQ(40.7,+STOP_",",1),IENACT=$O(^SD(409.45,"B",STOPN,IENACT)) "RTN","SDM4",54,0) E W "***NO STOP CODE ASSIGNED***" S SDATD="REGULAR" D APT Q "RTN","SDM4",55,0) IF IENACT'="" S SDATD=99999999999,SDATD=$O(^SD(409.45,IENACT,"E",SDATD),-1) D "RTN","SDM4",56,0) .IF SDATD>0 S ACT=$P(^SD(409.45,IENACT,"E",SDATD,0),"^",2) "RTN","SDM4",57,0) IF ACT=1 S SDATD=$$GET1^DIQ(44,+SC_",",2507) GOTO APT "RTN","SDM4",58,0) S SDATD="",SDATD=$$GET1^DIQ(44,+SC_",",2502) IF SDATD="YES" S SDATD=$$GET1^DIQ(44,+SC_",",2507) W " ***NON-COUNT CLINIC***" GOTO APT "RTN","SDM4",59,0) S SDATD="",SDATD=$$INP^SDAM2(DFN,DT) IF SDATD="I" S SDATD=$$GET1^DIQ(44,+SC_",",2507) W " ***PATIENT IS CURRENTLY AN INPATIENT***" GOTO APT "RTN","SDM4",60,0) ;STOP EXCEPTION CODES "RTN","SDM4",61,0) S SDATD="",SDATD=$P(SDVAEL(1),U,2) ;SD*585 "RTN","SDM4",62,0) IF SDATD'="SC LESS THAN 50%"&(SDATD'="SERVICE CONNECTED 50% to 100%") S SDATD="" S SDATD=$S($D(SDAPTYP):SDAPTYP,$D(^SC(+SC,"AT")):$S($D(^SD(409.1,+^("AT"),0)):$P(^(0),U),1:"REGULAR"),1:"REGULAR") D "RTN","SDM4",63,0) .IF SDSCFLG&(SDATD="SERVICE CONNECTED") S SDATD="REGULAR" "RTN","SDM4",64,0) IF SDATD="SC LESS THAN 50%"!(SDATD="SERVICE CONNECTED 50% to 100%") D "RTN","SDM4",65,0) .D SBR K SDANS,SDECANS S SDECANS=ANS ;alb/sat 665 - add SDECANS "RTN","SDM4",66,0) .IF ANS="N" S SDATD=$S($D(SDAPTYP):SDAPTYP,$D(^SC(+SC,"AT")):$S($D(^SD(409.1,+^("AT"),0)):$P(^(0),U),1:"REGULAR"),1:"REGULAR") "RTN","SDM4",67,0) .IF ANS="Y" D "RTN","SDM4",68,0) ..S ANS="" S ANS=$$GET1^DIQ(44,+SC_",",2507) IF ANS="REGULAR"!(ANS="") D "RTN","SDM4",69,0) ...S NN=$O(^SD(409.1,"B","SERVICE CONNECTED",NN)),SDATD=$$GET1^DIQ(409.1,NN_",",.01) "RTN","SDM4",70,0) ..IF ANS'="REGULAR"&(ANS'="") S SDATD=ANS "RTN","SDM4",71,0) APT W !,"APPOINTMENT TYPE: "_SDATD_"//" R X:DTIME I X']"" S X=SDATD "RTN","SDM4",72,0) I X["^" W !,"APPOINTMENT TYPE IS REQUIRED" G APT "RTN","SDM4",73,0) I X="S" W !,"PLEASE ENTER MORE THAN ONE CHARACTER" G APT "RTN","SDM4",74,0) I SDSCFLG D "RTN","SDM4",75,0) .S DIC("S")="I $D(X),$E(X,1,2)'[""SE""" "RTN","SDM4",76,0) .S DIC(0)="QEMNZ",DIC=409.1 D ^DIC I Y<0 Q "RTN","SDM4",77,0) .S SDSCFLG=0 "RTN","SDM4",78,0) G APT:SDSCFLG "RTN","SDM4",79,0) S SDEC=$S($D(^DIC(8,+VAEL(1),0)):$P(^(0),U,5),1:"") "RTN","SDM4",80,0) S DIC("S")="I '$P(^(0),U,3),$S(SDEC[""Y"":1,1:$P(^(0),U,5)),$S('$P(^(0),U,6):1,$D(VAEL(1,+$P(^(0),U,6))):1,+VAEL(1)=$P(^(0),U,6):1,1:0)",DIC="^SD(409.1,",DIC(0)="EQMZ" D ^DIC K DIC "RTN","SDM4",81,0) I X["^"!(Y'>0) W !,"Appointment type is required",!,"Patient must have the eligibility code EMPLOYEE, COLLATERAL or SHARING AGREEMENT",!,"to choose those types of appointments." G TYPE "RTN","SDM4",82,0) S COLLAT=$S(+Y=1:1,+Y=7:7,1:0),SDAPTYP=+Y,SDDECOD=$P(^SD(409.1,+Y,0),U,6) I COLLAT W !!,"** Note - You are making a ",$P(^SD(409.1,+COLLAT,0),U)," appt.",! "RTN","SDM4",83,0) Q:$D(SDAMBAE) "RTN","SDM4",84,0) I COLLAT=7 S SDCOL=$P(^SD(409.1,SDAPTYP,0),U,6) I '$D(SDMLT)&'$D(SDD) D ^SDM0,END^SDM "RTN","SDM4",85,0) Q "RTN","SDM4",86,0) ELIG S SDALLE="",SDEMP=$P(VAEL(1),U,2) W !,"THIS PATIENT HAS OTHER ENTITLED ELIGIBILITIES:" F SDOEL=0:0 S SDOEL=$O(VAEL(1,SDOEL)) Q:SDOEL="" W !?5,$P(VAEL(1,SDOEL),U,2) S SDALLE=SDALLE_"^"_$P(VAEL(1,SDOEL),U,2) "RTN","SDM4",87,0) 1 W !,"ENTER THE ELIGIBILITY FOR THIS APPOINTMENT: "_SDEMP_"// " R X:DTIME Q:"^"[X S X=$$UPPER^VALM1(X) G ELIG:X["?",1:SDALLE'[("^"_X) "RTN","SDM4",88,0) S SDEMP=X_$P($P(SDALLE,"^"_X,2),"^") W $P($P(SDALLE,"^"_X,2),"^") "RTN","SDM4",89,0) F SDOEL=0:0 S SDOEL=$O(VAEL(1,SDOEL)) Q:SDOEL="" I $P(VAEL(1,SDOEL),U,2)=SDEMP S SDEMP=SDOEL_"^"_SDEMP Q "RTN","SDM4",90,0) Q "RTN","SDM4",91,0) SC ;SERVICE CONNECTED MESSAGE/IOFO - BAY PINES/TEH "RTN","SDM4",92,0) I $D(^DPT(DFN,.3)) S SDAMSCN=+$P(^(.3),U,2) I SDAMSCN>49 D "RTN","SDM4",93,0) .W !,?7,"********** THIS PATIENT IS 50% OR GREATER SERVICE-CONNECTED **********",! "RTN","SDM4",94,0) ;I $D(SDWLLIST),SDWLLIST D ^SDWLR ;Patch SD*5.3*327 "RTN","SDM4",95,0) Q "RTN","SDM4",96,0) ; "RTN","SDM4",97,0) GETMAS ;SD*585 get MAS Eligibility Code (file #8.1) for each of patient's "RTN","SDM4",98,0) ;eligibilities passed back from Registration API VADPT in array VAEL. "RTN","SDM4",99,0) ;Returns array SDVAEL. "RTN","SDM4",100,0) S SDVAEL(1)="" "RTN","SDM4",101,0) Q:'+$G(VAEL(1)) "RTN","SDM4",102,0) Q:'$D(^DIC(8,+VAEL(1),0)) "RTN","SDM4",103,0) S MASIEN=0,MASIEN=$P(^DIC(8,+VAEL(1),0),U,9) ;pointer to file #8.1 "RTN","SDM4",104,0) Q:'MASIEN "RTN","SDM4",105,0) Q:'$D(^DIC(8.1,MASIEN,0)) "RTN","SDM4",106,0) S SDVAEL(1)=MASIEN_"^"_$P(^DIC(8.1,MASIEN,0),U,1) ;primary eligibility "RTN","SDM4",107,0) ;check for additional eligibilities "RTN","SDM4",108,0) S CT=0 "RTN","SDM4",109,0) F S CT=$O(VAEL(1,CT)) Q:'CT D "RTN","SDM4",110,0) .Q:'$D(^DIC(8,+VAEL(1,CT),0)) "RTN","SDM4",111,0) .S MASIEN=0,MASIEN=$P(^DIC(8,+VAEL(1,CT),0),U,9) ;pointer to file #8.1 "RTN","SDM4",112,0) .Q:'MASIEN "RTN","SDM4",113,0) .Q:'$D(^DIC(8.1,MASIEN,0)) "RTN","SDM4",114,0) .S SDVAEL(1,MASIEN)=MASIEN_"^"_$P(^DIC(8.1,MASIEN,0),U,1) "RTN","SDM4",115,0) K CT,MASIEN "RTN","SDM4",116,0) Q "RTN","SDM4",117,0) ; "RTN","SDM4",118,0) SBR S (ANS,SDANS)="" "RTN","SDM4",119,0) IF SDSCFLG S ANS="N" Q "RTN","SDM4",120,0) IF $D(^DPT(DFN,.3)) S SDANS=$$GET1^DIQ(2,DFN_",",.302) IF SDANS>49 S ANS="Y" Q "RTN","SDM4",121,0) S DIR("A")="IS THIS APPOINTMENT FOR A SERVICE CONNECTED CONDITION",DIR(0)="Y^A0" D ^DIR S ANS=$S(Y=1:"Y",1:"N") "RTN","SDM4",122,0) I ANS'="Y"&(ANS'="N") W !,*7,"ENTER (Y or N) PLEASE!" G SBR "RTN","SDM4",123,0) K DIR Q "RTN","SDMM1") 0^16^B21571193^B21006684 "RTN","SDMM1",1,0) SDMM1 ;ALB/GRR - MULTIPLE BOOKINGS ;JUN 21, 2017 "RTN","SDMM1",2,0) ;;5.3;Scheduling;**28,206,168,327,622,645,658,665**;Aug 13, 1993;Build 14 "RTN","SDMM1",3,0) MAKE S (SDX3,X,SD)=Y,SM=0 D DOW^SDM0 I $D(^DPT(DFN,"S",X)) S I=^(X,0) I $P(I,"^",2)'["C" W !,"PATIENT ALREADY HAS APPOINTMENT ON ",$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",$E(X,4,5))," ",$E(X,6,7)," AT THAT TIME" Q "RTN","SDMM1",4,0) S SDX7=X D SDFT^SDMM S X=SDX7 I $P(SDX3,".")'1 S ^DPT(DFN,"S",SD,1)=$P($G(SD),".",1)_U_SDSRFU "RTN","SDMM1",22,0) E S ^DPT(DFN,"S",SD,1)=SDDATE_U_SDSRFU ; end changes for SD*5.3*645 "RTN","SDMM1",23,0) D XRDT(DFN,X) ;xref DATE APPT. MADE field "RTN","SDMM1",24,0) K:$D(^DPT("ASDCN",SC,X,DFN)) ^(DFN) K:$D(^DPT(DFN,"S",X,"R")) ^("R") "RTN","SDMM1",25,0) S SDRT="A",SDTTM=X,SDPL=SDY,SDSC=SC D RT^SDUTL "RTN","SDMM1",26,0) ;update SDEC APPOINTMENT file 409.84 ;alb/sat 658 "RTN","SDMM1",27,0) N SDECAR,SDREC,SDECR "RTN","SDMM1",28,0) S SDREC="" "RTN","SDMM1",29,0) I $G(CNSLTLNK)="",$G(SDWL)="" S SDREC=$$RECALL^SDECUTL(DFN,SD,SDSC) ;check if recall appt "RTN","SDMM1",30,0) I $G(SDWL)="",$G(CNSLTLNK)="",SDREC="" S SDECAR=$$SDWLA^SDM1A(DFN,SDTTM,SC,SDDATE,$G(SDAPTYP),$G(SDECANS)) ;alb/sat 665 add SDECANS "RTN","SDMM1",31,0) K SDECANS ;alb/sat 665 "RTN","SDMM1",32,0) S SDECR=$$GETRES^SDECUTL(SC) "RTN","SDMM1",33,0) S SDAPTYP=$G(SDAPTYP) S:SDAPTYP="" SDAPTYP=$$GET1^DIQ(44,SC_",",2507,"I") "RTN","SDMM1",34,0) D SDECADD^SDEC07(SDTTM,$$FMADD^XLFDT(SDTTM,,,+SL),DFN,SDECR,0,SDDATE,"",$S(+$G(SDWL):"E|"_SDWL,+$G(CNSLTLNK):"C|"_CNSLTLNK,+SDREC:"R|"_SDREC,+SDECAR:"A|"_SDECAR,1:""),,SC,$G(D),,SDECR,SDAPTYP) ;ADD SDEC APPOINTMENT ENTRY ;alb/sat 658 "RTN","SDMM1",35,0) ;alb/sat 658 end modification "RTN","SDMM1",36,0) L W !,"APPOINTMENT MADE ON " S Y=X D DT^DIQ "RTN","SDMM1",37,0) ;check for open EWL entries and create TMP($J,"APPT";SD/327 "RTN","SDMM1",38,0) N SDEV,SD D EN^SDWLEVAL(DFN,.SDEV) S SD=X I SDEV D APPT^SDWLEVAL(DFN,SD,SC) "RTN","SDMM1",39,0) D EVT "RTN","SDMM1",40,0) Q "RTN","SDMM1",41,0) ; "RTN","SDMM1",42,0) XRDT(DFN,X) ;cross reference DATE APPT. MADE field "RTN","SDMM1",43,0) ;Input: DFN=patient ifn "RTN","SDMM1",44,0) ;Input: X=appointment date "RTN","SDMM1",45,0) N DIK,DA,DIV S DA=X,DA(1)=DFN "RTN","SDMM1",46,0) S DIK="^DPT(DA(1),""S"",",DIK(1)=20 D EN1^DIK "RTN","SDMM1",47,0) Q "RTN","SDMM1",48,0) ; "RTN","SDMM1",49,0) NOOB S SDMES="NO OPEN SLOTS ON " "RTN","SDMM1",50,0) WRTER W !,SDMES D DT W:SDNOT " AT THAT TIME" S SDNOT=0 Q "RTN","SDMM1",51,0) DT W $P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",$E(X,4,5))," ",$E(X,6,7) Q "RTN","SDMM1",52,0) DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR "RTN","SDMM1",53,0) ; "RTN","SDMM1",54,0) X L I SDZ=1 W !,*7,"CLINIC DOES NOT MEET THEN!!" S SDERRFT=1 Q "RTN","SDMM1",55,0) S SDMES="CLINIC DOES NOT MEET ON " G WRTER "RTN","SDMM1",56,0) ; "RTN","SDMM1",57,0) EVT ; -- separate tag if need to NEW vars "RTN","SDMM1",58,0) N D,SI,SC,SL,COLLAT D MAKE^SDAMEVT(DFN,SDTTM,SDSC,SDPL,0) "RTN","SDMM1",59,0) Q "RTN","SDMM1",60,0) ; "RTN","SDMM1",61,0) OB ; check for overbook keys "RTN","SDMM1",62,0) N %,D,I,S,ST "RTN","SDMM1",63,0) S SDNOT=1 "RTN","SDMM1",64,0) I '$D(^XUSEC("SDOB",DUZ)),'$D(^XUSEC("SDMOB",DUZ)) D NOOB G OBQ ; user has neither key "RTN","SDMM1",65,0) S I=$P(SD,".",1),(S,ST)=$P(SL,U,7) ; counter of OBs for day = ST "RTN","SDMM1",66,0) I ST F D=I-.01:0 S D=$O(^SC(SC,"S",D)) Q:$P(D,".",1)-I F %=0:0 S %=$O(^SC(SC,"S",D,1,%)) Q:'% I $P(^(%,0),"^",9)'["C",$D(^("OB")) S ST=ST-1 "RTN","SDMM1",67,0) I ST<1 D G OBQ "RTN","SDMM1",68,0) . I '$D(^XUSEC("SDMOB",DUZ)) W !,*7,"ONLY "_S_" OVERBOOK"_$E("S",S>1)_" ALLOWED PER DAY!!" D NOOB Q "RTN","SDMM1",69,0) . S MXOK=$$DIR("WILL EXCEED MAXIMUM ALLOWABLE OVERBOOKS FOR "_$$FMTE^XLFDT(Y)_", OK","YES") "RTN","SDMM1",70,0) . I 'MXOK S SM=9,SDNOT=0 Q "RTN","SDMM1",71,0) . I MXOK S S=^SC(SC,"ST",I,1),SM=9,MXOK="" "RTN","SDMM1",72,0) I '$D(^XUSEC("SDOB",DUZ)) D NOOB G OBQ "RTN","SDMM1",73,0) I '$$DIR($$FMTE^XLFDT(Y)_" WILL BE AN OVERBOOK, OK","NO") S SM=9,SDNOT=0 "RTN","SDMM1",74,0) OBQ Q "RTN","SDMM1",75,0) ; "RTN","SDMM1",76,0) DIR(TEXT,DEF) ; reader processor "RTN","SDMM1",77,0) ; Input: TEXT as text of read "RTN","SDMM1",78,0) ; DEF as default response (if any) "RTN","SDMM1",79,0) ; "RTN","SDMM1",80,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","SDMM1",81,0) S DIR(0)="Y",DIR("A")=TEXT "RTN","SDMM1",82,0) I $G(DEF)]"" S DIR("B")=DEF "RTN","SDMM1",83,0) D ^DIR "RTN","SDMM1",84,0) W:'Y ! "RTN","SDMM1",85,0) Q Y "VER") 8.0^22.2 "BLD",10315,6) ^549 **END** **END**