Released SD*5.3*651 SEQ #544 Extracted from mail message **KIDS**:SD*5.3*651^ **INSTALL NAME** SD*5.3*651 "BLD",9603,0) SD*5.3*651^SCHEDULING^0^3160719^y "BLD",9603,4,0) ^9.64PA^^ "BLD",9603,6.3) 14 "BLD",9603,"KRN",0) ^9.67PA^779.2^20 "BLD",9603,"KRN",.4,0) .4 "BLD",9603,"KRN",.401,0) .401 "BLD",9603,"KRN",.402,0) .402 "BLD",9603,"KRN",.403,0) .403 "BLD",9603,"KRN",.5,0) .5 "BLD",9603,"KRN",.84,0) .84 "BLD",9603,"KRN",3.6,0) 3.6 "BLD",9603,"KRN",3.8,0) 3.8 "BLD",9603,"KRN",9.2,0) 9.2 "BLD",9603,"KRN",9.8,0) 9.8 "BLD",9603,"KRN",9.8,"NM",0) ^9.68A^12^12 "BLD",9603,"KRN",9.8,"NM",1,0) SDEC51^^0^B148461955 "BLD",9603,"KRN",9.8,"NM",2,0) SDEC07A^^0^B82467094 "BLD",9603,"KRN",9.8,"NM",3,0) SDEC08^^0^B200693919 "BLD",9603,"KRN",9.8,"NM",4,0) SDEC57A^^0^B120731427 "BLD",9603,"KRN",9.8,"NM",5,0) SDECRMG2^^0^B68379335 "BLD",9603,"KRN",9.8,"NM",6,0) SDAMWI1^^0^B15911901 "BLD",9603,"KRN",9.8,"NM",7,0) SDEC^^0^B124015151 "BLD",9603,"KRN",9.8,"NM",8,0) SDEC07^^0^B229461706 "BLD",9603,"KRN",9.8,"NM",9,0) SDEC52^^0^B144746730 "BLD",9603,"KRN",9.8,"NM",10,0) SDEC56^^0^B36808383 "BLD",9603,"KRN",9.8,"NM",11,0) SDECRMG1^^0^B133859295 "BLD",9603,"KRN",9.8,"NM",12,0) SDN^^0^B34257653 "BLD",9603,"KRN",9.8,"NM","B","SDAMWI1",6) "BLD",9603,"KRN",9.8,"NM","B","SDEC",7) "BLD",9603,"KRN",9.8,"NM","B","SDEC07",8) "BLD",9603,"KRN",9.8,"NM","B","SDEC07A",2) "BLD",9603,"KRN",9.8,"NM","B","SDEC08",3) "BLD",9603,"KRN",9.8,"NM","B","SDEC51",1) "BLD",9603,"KRN",9.8,"NM","B","SDEC52",9) "BLD",9603,"KRN",9.8,"NM","B","SDEC56",10) "BLD",9603,"KRN",9.8,"NM","B","SDEC57A",4) "BLD",9603,"KRN",9.8,"NM","B","SDECRMG1",11) "BLD",9603,"KRN",9.8,"NM","B","SDECRMG2",5) "BLD",9603,"KRN",9.8,"NM","B","SDN",12) "BLD",9603,"KRN",19,0) 19 "BLD",9603,"KRN",19.1,0) 19.1 "BLD",9603,"KRN",101,0) 101 "BLD",9603,"KRN",409.61,0) 409.61 "BLD",9603,"KRN",771,0) 771 "BLD",9603,"KRN",779.2,0) 779.2 "BLD",9603,"KRN",870,0) 870 "BLD",9603,"KRN",8989.51,0) 8989.51 "BLD",9603,"KRN",8989.52,0) 8989.52 "BLD",9603,"KRN",8994,0) 8994 "BLD",9603,"KRN","B",.4,.4) "BLD",9603,"KRN","B",.401,.401) "BLD",9603,"KRN","B",.402,.402) "BLD",9603,"KRN","B",.403,.403) "BLD",9603,"KRN","B",.5,.5) "BLD",9603,"KRN","B",.84,.84) "BLD",9603,"KRN","B",3.6,3.6) "BLD",9603,"KRN","B",3.8,3.8) "BLD",9603,"KRN","B",9.2,9.2) "BLD",9603,"KRN","B",9.8,9.8) "BLD",9603,"KRN","B",19,19) "BLD",9603,"KRN","B",19.1,19.1) "BLD",9603,"KRN","B",101,101) "BLD",9603,"KRN","B",409.61,409.61) "BLD",9603,"KRN","B",771,771) "BLD",9603,"KRN","B",779.2,779.2) "BLD",9603,"KRN","B",870,870) "BLD",9603,"KRN","B",8989.51,8989.51) "BLD",9603,"KRN","B",8989.52,8989.52) "BLD",9603,"KRN","B",8994,8994) "BLD",9603,"QUES",0) ^9.62^^ "BLD",9603,"REQB",0) ^9.611^3^3 "BLD",9603,"REQB",1,0) SD*5.3*642^1 "BLD",9603,"REQB",2,0) GMRC*3.0*86^1 "BLD",9603,"REQB",3,0) SD*5.3*627^1 "BLD",9603,"REQB","B","GMRC*3.0*86",2) "BLD",9603,"REQB","B","SD*5.3*627",3) "BLD",9603,"REQB","B","SD*5.3*642",1) "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^2930813^2960613 "PKG",48,22,1,"PAH",1,0) 651^3160719 "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") 12 "RTN","SDAMWI1") 0^6^B15911901^B14489968 "RTN","SDAMWI1",1,0) SDAMWI1 ;ALB/MJK - Walk-Ins (cont.) ;JUL 19, 2016 "RTN","SDAMWI1",2,0) ;;5.3;Scheduling;**94,167,206,168,544,627,651**;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) I $G(SDWL)="" N SDCLN S SDCLN=$$GET1^DIQ(44,SDCL_",",.01) S SDAPPT=$$SDWLA^SDM1A(DFN,SDT,SDCLN,$P(SDT,".",1),SDAPTYP) "RTN","SDAMWI1",40,0) S SDRES=$$GETRES^SDECUTL(SDCL) "RTN","SDAMWI1",41,0) S SDECSL=$G(SL) ;alb/sat 651 "RTN","SDAMWI1",42,0) I '+SDECSL S SDECSL=$G(^SC(SDCL,"SL")) ;alb/sat 651 "RTN","SDAMWI1",43,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",44,0) Q "RTN","SDAMWI1",45,0) ;end addition/modification ;alb/sat 627 "RTN","SDAMWI1",46,0) ; "RTN","SDAMWI1",47,0) RT ; -- request record "RTN","SDAMWI1",48,0) S SDRT="A",SDTTM=SDT,SDPL=I,SDSC=SC D RT^SDUTL "RTN","SDAMWI1",49,0) Q "RTN","SDAMWI1",50,0) ; "RTN","SDAMWI1",51,0) ROUT(DFN) ; -- print routing slip "RTN","SDAMWI1",52,0) S DIR("A")="DO YOU WANT TO PRINT A ROUTING SLIP NOW",DIR(0)="Y" "RTN","SDAMWI1",53,0) W ! D ^DIR K DIR G ROUTQ:$D(DIRUT)!(Y=0) "RTN","SDAMWI1",54,0) K IOP S (SDX,SDSTART,ORDER,SDREP)="" D EN^SDROUT1 "RTN","SDAMWI1",55,0) ROUTQ Q "RTN","SDAMWI1",56,0) ; "RTN","SDAMWI1",57,0) DUAL ; -- ask elig if pt has more than one "RTN","SDAMWI1",58,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",59,0) Q "RTN","SDAMWI1",60,0) ; "RTN","SDAMWI1",61,0) EVT ; -- separate if need to NEW vars "RTN","SDAMWI1",62,0) N I,DIV D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,0) "RTN","SDAMWI1",63,0) Q "RTN","SDEC") 0^7^B124015151^B123628700 "RTN","SDEC",1,0) SDEC ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 19, 2016 "RTN","SDEC",2,0) ;;5.3;Scheduling;**627,643,642,651**;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) ;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)) 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) ; EP Return the IEN and NAME for all entries in the SD WL CLINIC LOCATION file "RTN","SDEC",85,0) D CLINALL^SDECWL(.RET) 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) ;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)) Q "RTN","SDEC",100,0) CLINSTOP(SDECY) ;EP CLINIC STOP remote procedure "RTN","SDEC",101,0) D CLINSTOP^SDEC45(.SDECY) 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) ;EP Set values to SDEC PREFERENCES AND SPECIAL NEEDS file "RTN","SDEC",181,0) D PREFSET^SDEC49(.SDECY,$G(DFN),$G(PREF)) 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) ; GET entries from the RECALL REMINDERS file 403.5 for a given Patient and Recall Date range. "RTN","SDEC",209,0) D RECGET^SDEC52(.SDECY,$G(DFN),$G(SDBEG),$G(SDEND),$G(MAXREC),$G(LASTSUB),$G(RECIEN),$G(SDSTOP),$G(SDFLAGS)) 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) ;EP Waitlist GET "RTN","SDEC",271,0) D WLGET^SDECWL1(.RET,$G(WLIEN1),$G(MAXREC),$G(SDBEG),$G(SDEND),$G(DFN),$G(LASTSUB),$G(SDTOP)) 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","SDEC07") 0^8^B229461706^B225769196 "RTN","SDEC07",1,0) SDEC07 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 19, 2016 "RTN","SDEC07",2,0) ;;5.3;Scheduling;**627,642,651**;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) ;APPADD(SDECY,SDECSTART,SDECEND,DFN,SDECRES,SDECLEN,SDECNOTE,SDECATID,SDECCR,SDMRTC,SDDDT,SDREQBY,SDLAB,PROVIEN,SDID,SDAPTYP,SDSVCP,SDSVCPR,SDCL,SDEKG,SDXRAY,APPTYPE) "RTN","SDEC07",9,0) ; external parameter tag is in SDEC "RTN","SDEC07",10,0) ;Create entry in SDEC APPOINTMENT "RTN","SDEC07",11,0) ;INPUT: "RTN","SDEC07",12,0) ; 1. SDECSTART - (external date/time format) Appointment start date/time "RTN","SDEC07",13,0) ; 2. SDECEND - (external date/time format) Appointment end date/time "RTN","SDEC07",14,0) ; 3. DFN - (integer) Patient ID - pointer to the PATIENT file 2 "RTN","SDEC07",15,0) ; 4. SDECRES - (required) Resource Name from the NAME field of the "RTN","SDEC07",16,0) ; SDEC RESOURCE file "RTN","SDEC07",17,0) ; OR pointer to the SDEC RESOURCE file "RTN","SDEC07",18,0) ; 5. SDECLEN - (optional) Appointment duration in minutes "RTN","SDEC07",19,0) ; 6. SDECNOTE - (text) Represents a note; Only the 1st 150 characters are used "RTN","SDEC07",20,0) ; 7. SDECATID - SDECATID is used for 2 purposes: "RTN","SDEC07",21,0) ; if SDECATID = "WALKIN" then create a walkin appt. "RTN","SDEC07",22,0) ; if SDECATID = a number, then it is the access type id "RTN","SDEC07",23,0) ; (used for rebooking) "RTN","SDEC07",24,0) ; 8. SDECCR - (flag) 0=don't print routing slip for WALKIN/Same Day "RTN","SDEC07",25,0) ; appointment "RTN","SDEC07",26,0) ; 1=allow print routing slip "RTN","SDEC07",27,0) ; 9. SDMRTC - (optional) MTRC flag (multiple appointments) - Valid values False True "RTN","SDEC07",28,0) ; 10. SDDDT - (optional) Desired Date of Appointment in external format "RTN","SDEC07",29,0) ; 11. SDREQBY - (optional) Requested By - valid values are PROVIDER PATIENT "RTN","SDEC07",30,0) ; 12. SDLAB - (optional) LAB date/time in external format "RTN","SDEC07",31,0) ; 13. PROVIEN - (optional) Provider pointer to NEW PERSON file "RTN","SDEC07",32,0) ; 14. SDID - (optional) External ID (free-text) "RTN","SDEC07",33,0) ; 15. SDAPTYP - (required) Appt Request type - variable pointer pointer to one of these files: "RTN","SDEC07",34,0) ; SD WAIT LIST - E| E|123 "RTN","SDEC07",35,0) ; REQUEST/CONSULTATION - C| C|123 "RTN","SDEC07",36,0) ; RECALL REMINDERS - R|^ R|123 "RTN","SDEC07",37,0) ; 16. SDSVCP - (optional) SERVICE CONNECTED PRIORITY valid values are NO YES "RTN","SDEC07",38,0) ; 17. SDSVCPR - (optional) SERVICE CONNECTED PERCENTAGE numeric 0-100 "RTN","SDEC07",39,0) ; 18. SDCL - (required) clinic ID pointer to HOSPITAL LOCATION file 44 "RTN","SDEC07",40,0) ; 19. SDEKG - (optional) EKG date/time in external format "RTN","SDEC07",41,0) ; 20. SDXRAY- (optional) X-Ray date/time in external format "RTN","SDEC07",42,0) ; 21. APPTYPE - (optional) Appointment type ID pointer to APPOINTMENT TYPE file 409.1 "RTN","SDEC07",43,0) ; 22. EESTAT - (optional) Patient Status N=NEW E=ESTABLISHED "RTN","SDEC07",44,0) ; 23. OVB - (optional) overbook flag - 1=yes, this appointment is an overbook "RTN","SDEC07",45,0) ; 24. SDPARENT - (optional) the parent request IEN from SDEC APPT REQUEST (409.85) "RTN","SDEC07",46,0) ; "RTN","SDEC07",47,0) ;RETURN: "RTN","SDEC07",48,0) ; recordset having fields "RTN","SDEC07",49,0) ; AppointmentID and ErrorNumber "RTN","SDEC07",50,0) ; "RTN","SDEC07",51,0) N SDAPPTYP "RTN","SDEC07",52,0) N SDECERR,SDECIEN,SDECDEP,SDECI,SDECJ,SDECAPPTI,SDECDJ,SDECRESD,SDECRNOD,SDECC,SDECERR,SDECWKIN "RTN","SDEC07",53,0) N SDECNOEV,SDECDEV,SDECDERR,SDECTMP,SAVESTRT "RTN","SDEC07",54,0) N %DT,X,Y,DGQUIET "RTN","SDEC07",55,0) S SDECNOEV=1 ;Don't execute SDEC ADD APPOINTMENT protocol "RTN","SDEC07",56,0) K ^TMP("SDEC",$J) "RTN","SDEC07",57,0) S SDECERR=0 "RTN","SDEC07",58,0) S SDECI=0 "RTN","SDEC07",59,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC07",60,0) S ^TMP("SDEC",$J,SDECI)="I00020APPOINTMENTID^T00020ERRORID"_$C(30) "RTN","SDEC07",61,0) S SDECI=SDECI+1 "RTN","SDEC07",62,0) ;Check input data for errors "RTN","SDEC07",63,0) S SAVESTRT=SDECSTART ;MGH save date/time for consult request "RTN","SDEC07",64,0) S:SDECSTART["@0000" SDECSTART=$P(SDECSTART,"@") "RTN","SDEC07",65,0) S:SDECEND["@0000" SDECEND=$P(SDECEND,"@") "RTN","SDEC07",66,0) S %DT="RXT",X=SDECSTART D ^%DT S SDECSTART=Y "RTN","SDEC07",67,0) I SDECSTART=-1 D ERR(SDECI+1,"SDEC07 Error: Invalid Start Time") Q "RTN","SDEC07",68,0) S %DT="RXT",X=SDECEND D ^%DT S SDECEND=Y "RTN","SDEC07",69,0) I SDECEND=-1 D ERR(SDECI+1,"SDEC07 Error: Invalid End Time") Q "RTN","SDEC07",70,0) I $L(SDECEND,".")=1 D ERR(SDECI+1,"SDEC07 Error: Invalid End Time") Q "RTN","SDEC07",71,0) I SDECSTART>SDECEND S SDECTMP=SDECEND,SDECEND=SDECSTART,SDECSTART=SDECTMP "RTN","SDEC07",72,0) S DFN=$G(DFN) "RTN","SDEC07",73,0) I DFN="" D ERR(SDECI+1,"SDEC07: Patient ID required.") Q "RTN","SDEC07",74,0) I '$D(^DPT(DFN,0)) D ERR(SDECI+1,"SDEC07 Error: Invalid Patient ID") Q "RTN","SDEC07",75,0) ;Validate Resource "RTN","SDEC07",76,0) S SDECERR=0 K SDECRESD "RTN","SDEC07",77,0) S SDECRES=$G(SDECRES) "RTN","SDEC07",78,0) I +SDECRES,'$D(^SDEC(409.831,SDECRES,0)) D ERR(SDECI+1,"SDEC07 Error: Invalid Resource ID") Q "RTN","SDEC07",79,0) I '+SDECRES,'$D(^SDEC(409.831,"B",SDECRES)) D ERR(SDECI+1,"SDEC07 Error: Invalid Resource ID") Q "RTN","SDEC07",80,0) S SDECRESD=$S(+SDECRES:+SDECRES,1:$O(^SDEC(409.831,"B",SDECRES,0))) "RTN","SDEC07",81,0) S SDECRNOD=$G(^SDEC(409.831,SDECRESD,0)) "RTN","SDEC07",82,0) I SDECRNOD="" D ERR(SDECI+1,"SDEC07 Error: Unable to add appointment -- invalid Resource entry.") Q "RTN","SDEC07",83,0) S SDECWKIN=0 "RTN","SDEC07",84,0) S SDECATID=$G(SDECATID) "RTN","SDEC07",85,0) I SDECATID="WALKIN" S SDECWKIN=1 "RTN","SDEC07",86,0) I SDECATID'?.N&(SDECATID'="WALKIN") S SDECATID="" "RTN","SDEC07",87,0) ;validate appointment length - if passed in, must be 5-120 "RTN","SDEC07",88,0) S SDECLEN=$G(SDECLEN) "RTN","SDEC07",89,0) ;I SDECLEN'="",(+SDECLEN<5)!(SDECLEN>120) D ERR(SDECI+1,"SDEC07 Error: Appointment length must be between 5 - 120.") Q "RTN","SDEC07",90,0) ;validate MTRC flag (optional) "RTN","SDEC07",91,0) S SDMRTC=$$UP^XLFSTR($G(SDMRTC)) "RTN","SDEC07",92,0) S SDMRTC=$S(SDMRTC="TRUE":1,1:0) "RTN","SDEC07",93,0) ;validate desired date of appt (optional) "RTN","SDEC07",94,0) S SDDDT=$G(SDDDT) "RTN","SDEC07",95,0) I SDDDT'="" S %DT="" S X=$P(SDDDT,"@",1) D ^%DT S SDDDT=Y I Y=-1 S SDDDT="" "RTN","SDEC07",96,0) I SDDDT="",SDECATID'="WALKIN" S SDDDT=$P(SDECSTART,".",1) "RTN","SDEC07",97,0) ;validate requested by "RTN","SDEC07",98,0) S SDREQBY=$$UP^XLFSTR($G(SDREQBY)) "RTN","SDEC07",99,0) I SDREQBY'="" S SDREQBY=$S(SDREQBY="PROVIDER":1,SDREQBY="PATIENT":2,1:0) "RTN","SDEC07",100,0) ;validate lab date/time (optional) "RTN","SDEC07",101,0) S SDLAB=$G(SDLAB) "RTN","SDEC07",102,0) I SDLAB'="" S %DT="T" S X=SDLAB D ^%DT S SDLAB=Y I Y=-1 S SDLAB="" "RTN","SDEC07",103,0) ;validate EKG date/time (optional) "RTN","SDEC07",104,0) S SDEKG=$G(SDEKG) "RTN","SDEC07",105,0) I SDEKG'="" S %DT="T" S X=SDEKG D ^%DT S SDEKG=Y I Y=-1 S SDEKG="" "RTN","SDEC07",106,0) ;validate XRAY date/time (optional) "RTN","SDEC07",107,0) S SDXRAY=$G(SDXRAY) "RTN","SDEC07",108,0) I SDXRAY'="" S %DT="T" S X=SDXRAY D ^%DT S SDXRAY=Y I Y=-1 S SDXRAY="" "RTN","SDEC07",109,0) ;validate provider "RTN","SDEC07",110,0) I '$D(^VA(200,+$G(PROVIEN),0)) S PROVIEN="" "RTN","SDEC07",111,0) S SDID=$G(SDID) "RTN","SDEC07",112,0) ;validate clinic "RTN","SDEC07",113,0) S SDCL=$G(SDCL) "RTN","SDEC07",114,0) I SDCL'="" I '$D(^SC(SDCL,0)) S SDCL="" "RTN","SDEC07",115,0) I SDCL="" S SDCL=$$GET1^DIQ(409.831,SDECRESD_",",.04,"I") ;clinic ID ;support for single HOSPITAL LOCATION in SDEC RESOURCE "RTN","SDEC07",116,0) ;validate appt request type (required) "RTN","SDEC07",117,0) S SDAPTYP=$G(SDAPTYP) "RTN","SDEC07",118,0) I SDAPTYP'="" D "RTN","SDEC07",119,0) .I $P(SDAPTYP,"|",1)="E" I '$D(^SDWL(409.3,+$P(SDAPTYP,"|",2),0)) S SDAPTYP="" "RTN","SDEC07",120,0) .I $P(SDAPTYP,"|",1)="R" I '$D(^SD(403.5,+$P(SDAPTYP,"|",2),0)) S SDAPTYP="" "RTN","SDEC07",121,0) .I $P(SDAPTYP,"|",1)="C" I '$D(^GMR(123,+$P(SDAPTYP,"|",2),0)) S SDAPTYP="" ;ICR 4837 "RTN","SDEC07",122,0) .I $P(SDAPTYP,"|",1)="A" I '$D(^SDEC(409.85,+$P(SDAPTYP,"|",2),0)) S SDAPTYP="" "RTN","SDEC07",123,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",124,0) I SDCL="" D "RTN","SDEC07",125,0) .S:$P(SDAPTYP,"|",1)="E" SDCL=$$GET1^DIQ(409.3,$P(SDAPTYP,"|",2)_",",13.2,"I") "RTN","SDEC07",126,0) .S:$P(SDAPTYP,"|",1)="R" SDCL=$$GET1^DIQ(403.5,$P(SDAPTYP,"|",2)_",",4.5,"I") "RTN","SDEC07",127,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",128,0) .S:$P(SDAPTYP,"|",1)="A" SDCL=$$GET1^DIQ(409.85,$P(SDAPTYP,"|",2)_",",8,"I") "RTN","SDEC07",129,0) I SDCL="" D ERR(SDECI+1,"SDEC07 Error: Invalid clinic ID.") Q "RTN","SDEC07",130,0) I $$INACTIVE^SDEC32(SDCL) D ERR(SDECI+1,"SDEC07 Error: "_$$GET1^DIQ(44,SDCL_",",.01)_" is an inactive clinic.") Q "RTN","SDEC07",131,0) ;validate service connected "RTN","SDEC07",132,0) S SDSVCP=$G(SDSVCP) "RTN","SDEC07",133,0) I SDSVCP'="" S SDSVCP=+$G(SDSVCP) S:(+SDSVCP<0)!(+SDSVCP>100) SDSVCP="" "RTN","SDEC07",134,0) S SDSVCPR=$G(SDSVCPR) "RTN","SDEC07",135,0) S SDSVCPR=$S(SDSVCPR=0:0,SDSVCPR="NO":0,SDSVCPR=1:1,SDSVCPR="YES":1,1:"") "RTN","SDEC07",136,0) ;validate note "RTN","SDEC07",137,0) S SDECNOTE=$G(SDECNOTE) "RTN","SDEC07",138,0) ;validate APPTYPE "RTN","SDEC07",139,0) S APPTYPE=$G(APPTYPE) I APPTYPE'="",'$D(^SD(409.1,+APPTYPE,0)) S APPTYPE="" "RTN","SDEC07",140,0) ;validate Patient Status (EESTAT) "RTN","SDEC07",141,0) S EESTAT=$G(EESTAT) "RTN","SDEC07",142,0) I EESTAT="" D "RTN","SDEC07",143,0) .I $P(SDAPTYP,"|",1)="E" S EESTAT=$$GET1^DIQ(409.3,$P(SDAPTYP,"|",2)_",",27,"I") "RTN","SDEC07",144,0) .I $P(SDAPTYP,"|",1)="A" S EESTAT=$$GET1^DIQ(409.3,$P(SDAPTYP,"|",2)_",",.02,"I") "RTN","SDEC07",145,0) S EESTAT=$S(EESTAT="N":"N",EESTAT="NEW":"N",EESTAT="E":"E",EESTAT="ESTABLISHED":"E",1:"") "RTN","SDEC07",146,0) ;validate OVB (overbook) "RTN","SDEC07",147,0) S OVB=+$G(OVB) "RTN","SDEC07",148,0) D "RTN","SDEC07",149,0) .S SDAPPTYP=+APPTYPE "RTN","SDEC07",150,0) .I 'SDAPPTYP D "RTN","SDEC07",151,0) ..I $P(SDAPTYP,"|",1)="E" S SDAPPTYP=$$GET1^DIQ(409.3,+$P(SDAPTYP,"|",2)_",",8.7,"I") "RTN","SDEC07",152,0) ..I $P(SDAPTYP,"|",1)="A" S SDAPPTYP=$$GET1^DIQ(409.85,+$P(SDAPTYP,"|",2)_",",8.7,"I") "RTN","SDEC07",153,0) ..I $P(SDAPTYP,"|",1)="C",+APPTYPE S SDAPPTYP=+APPTYPE "RTN","SDEC07",154,0) .S:'SDAPPTYP SDAPPTYP=$O(^SD(409.1,"B","REGULAR",0)) "RTN","SDEC07",155,0) ;Lock SDEC node "RTN","SDEC07",156,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",157,0) ; "RTN","SDEC07",158,0) ;TSTART "RTN","SDEC07",159,0) S SDECAPPTID=$$SDECADD(SDECSTART,SDECEND,DFN,SDECRESD,SDECATID,SDDDT,SDID,SDAPTYP,PROVIEN,SDCL,SDECNOTE,SAVESTRT,SDECRES,SDAPPTYP,EESTAT,1) "RTN","SDEC07",160,0) I 'SDECAPPTID D ERR(SDECI+1,"SDEC07 Error: Unable to add appointment to SDEC APPOINTMENT file.") Q "RTN","SDEC07",161,0) ;Save the Appointment and start a new transaction that will get rolled back if there's an error "RTN","SDEC07",162,0) ;TCOMMIT "RTN","SDEC07",163,0) ;TSTART "RTN","SDEC07",164,0) ; call chart request "RTN","SDEC07",165,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",166,0) I SDECATID="WALKIN",$G(SDECCR),$G(SDECDEV)'="" S DGQUIET=1 D WISD^SDECRT(DFN,$P(SDECSTART,"."),"",SDECDEV) "RTN","SDEC07",167,0) I SDECNOTE]"" D SDECWP(SDECAPPTID,SDECNOTE) "RTN","SDEC07",168,0) ; "RTN","SDEC07",169,0) ;Create Appointment in VistA ;TODO: have this call APPVISTA^SDEC07 "RTN","SDEC07",170,0) I +SDCL,$D(^SC(SDCL,0)) D I +SDECERR D ERR(SDECI+1,$P(SDECERR,U,2)) "RTN","SDEC07",171,0) . S SDECC("PAT")=DFN "RTN","SDEC07",172,0) . S SDECC("CLN")=SDCL "RTN","SDEC07",173,0) . S SDECC("TYP")=$S(+SDECWKIN:4,SDAPPTYP=1:1,1:3) ;3 for scheduled appts, 4 for walkins "RTN","SDEC07",174,0) . S SDECC("COL")=$S(SDAPPTYP=7:1,1:"") ;collateral visit if appointment type is COLLATERAL OF VET. "RTN","SDEC07",175,0) . S SDECC("APT")=SDAPPTYP "RTN","SDEC07",176,0) . S SDECC("ADT")=SDECSTART "RTN","SDEC07",177,0) . S SDECC("LEN")=SDECLEN "RTN","SDEC07",178,0) . S SDECC("OI")=$E($G(SDECNOTE),1,150) ;File 44 has 150 character limit on OTHER field "RTN","SDEC07",179,0) . S SDECC("OI")=$TR(SDECC("OI"),";"," ") ;No semicolons allowed "RTN","SDEC07",180,0) . S SDECC("OI")=$$STRIP(SDECC("OI")) ;Strip control characters from note "RTN","SDEC07",181,0) . S SDECC("RES")=SDECRESD "RTN","SDEC07",182,0) . S SDECC("USR")=DUZ "RTN","SDEC07",183,0) . S SDECC("MTR")=$G(SDMRTC) "RTN","SDEC07",184,0) . S SDECC("DDT")=SDDDT "RTN","SDEC07",185,0) . S SDECC("REQ")=SDREQBY "RTN","SDEC07",186,0) . S SDECC("LAB")=SDLAB "RTN","SDEC07",187,0) . S SDECC("XRA")=SDXRAY "RTN","SDEC07",188,0) . S SDECC("EKG")=SDEKG "RTN","SDEC07",189,0) . S SDECC("OVB")=+OVB "RTN","SDEC07",190,0) . S:$P(SDAPTYP,"|",1)="C" SDECC("CON")=$P(SDAPTYP,"|",2) "RTN","SDEC07",191,0) . S SDECERR=$$MAKE^SDEC07B(.SDECC) "RTN","SDEC07",192,0) . Q:SDECERR "RTN","SDEC07",193,0) . ;Update Clinic availability "RTN","SDEC07",194,0) . D AVUPDT(SDCL,SDECSTART,SDECLEN) "RTN","SDEC07",195,0) . ;L "RTN","SDEC07",196,0) . Q "RTN","SDEC07",197,0) ;update wait list "RTN","SDEC07",198,0) I $P(SDAPTYP,"|",1)="E" D EWL^SDEC07A($P(SDAPTYP,"|",2),SDECSTART,SDCL,SDSVCP,SDSVCPR,SDECNOTE,SDAPPTYP) "RTN","SDEC07",199,0) ;update appt request "RTN","SDEC07",200,0) I $P(SDAPTYP,"|",1)="A" D "RTN","SDEC07",201,0) .D UPDATE^SDECAR2($P(SDAPTYP,"|",2),SDECSTART,SDCL,SDSVCP,SDSVCPR,SDECNOTE,SDAPPTYP) "RTN","SDEC07",202,0) .I $G(SDMRTC),$G(SDPARENT) D AR433^SDECAR2(SDPARENT,SDECAPPTID_"~"_$P(SDAPTYP,"|",2)) "RTN","SDEC07",203,0) .D:$G(SDPARENT) AR438^SDECAR2($P(SDAPTYP,"|",2),SDPARENT) "RTN","SDEC07",204,0) ; "RTN","SDEC07",205,0) ;Return Recordset "RTN","SDEC07",206,0) ;TCOMMIT "RTN","SDEC07",207,0) L -^SDEC(409.84,DFN) "RTN","SDEC07",208,0) S SDECI=SDECI+1 "RTN","SDEC07",209,0) S ^TMP("SDEC",$J,SDECI)=SDECAPPTID_"^"_$G(SDECDERR)_$C(30) "RTN","SDEC07",210,0) S SDECI=SDECI+1 "RTN","SDEC07",211,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC07",212,0) Q "RTN","SDEC07",213,0) ; "RTN","SDEC07",214,0) ;Create Appointment "RTN","SDEC07",215,0) APPVISTA(SDECLEN,SDECNOTE,DFN,SDECRESD,SDECSTART,SDECWKIN,SDCL) ; "RTN","SDEC07",216,0) N SDECC,SDECRNOD "RTN","SDEC07",217,0) S SDECRNOD=$G(^SDEC(409.831,SDECRESD,0)) "RTN","SDEC07",218,0) I SDECRNOD="" D ERR(SDECI+1,"SDEC07 Error: Unable to add appointment -- invalid Resource entry.") Q 1 "RTN","SDEC07",219,0) S SDECERR="" "RTN","SDEC07",220,0) I +SDCL,$D(^SC(SDCL,0)) D I +SDECERR D ERR(SDECI+1,SDECERR) Q SDECERR "RTN","SDEC07",221,0) . S SDECC("PAT")=DFN "RTN","SDEC07",222,0) . S SDECC("CLN")=SDCL "RTN","SDEC07",223,0) . S SDECC("TYP")=3 ;3 for scheduled appts, 4 for walkins "RTN","SDEC07",224,0) . S:SDECWKIN SDECC("TYP")=4 "RTN","SDEC07",225,0) . S SDECC("ADT")=SDECSTART "RTN","SDEC07",226,0) . S SDECC("LEN")=SDECLEN "RTN","SDEC07",227,0) . S SDECC("OI")=$E($G(SDECNOTE),1,150) ;File 44 has 150 character limit on OTHER field "RTN","SDEC07",228,0) . S SDECC("OI")=$TR(SDECC("OI"),";"," ") ;No semicolons allowed "RTN","SDEC07",229,0) . S SDECC("OI")=$$STRIP(SDECC("OI")) ;Strip control characters from note "RTN","SDEC07",230,0) . S SDECC("RES")=SDECRESD "RTN","SDEC07",231,0) . S SDECC("USR")=DUZ "RTN","SDEC07",232,0) . S SDECERR=$$MAKE^SDEC07B(.SDECC) "RTN","SDEC07",233,0) . Q:SDECERR "RTN","SDEC07",234,0) . D AVUPDT(SDCL,SDECSTART,SDECLEN) "RTN","SDEC07",235,0) . ;L "RTN","SDEC07",236,0) . Q "RTN","SDEC07",237,0) Q +SDECERR "RTN","SDEC07",238,0) ; "RTN","SDEC07",239,0) SDECDEL(SDECAPPTID) ;Deletes appointment SDECAPPTID from SDECAPPOINTMETN "RTN","SDEC07",240,0) N DA,DIK "RTN","SDEC07",241,0) S DIK="^SDEC(409.84,",DA=SDECAPPTID "RTN","SDEC07",242,0) D ^DIK "RTN","SDEC07",243,0) Q "RTN","SDEC07",244,0) ; "RTN","SDEC07",245,0) STRIP(SDECZ) ;Replace control characters with spaces "RTN","SDEC07",246,0) N SDECI "RTN","SDEC07",247,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",248,0) Q SDECZ "RTN","SDEC07",249,0) ; "RTN","SDEC07",250,0) SDECADD(SDECSTART,SDECEND,DFN,SDECRESD,SDECATID,SDDDT,SDID,SDAPTYP,PROVIEN,SDCL,SDECNOTE,SAVESTRT,SDECRES,SDAPPTYP,EESTAT,SDF) ;ADD SDEC APPOINTMENT ENTRY "RTN","SDEC07",251,0) ;SDF - (optional) flags "RTN","SDEC07",252,0) ; 1. called from GUI (update consult only if called from GUI) "RTN","SDEC07",253,0) ;Returns ien in SDECAPPT or 0 if failed "RTN","SDEC07",254,0) ;called from SDEC APPADD rpc and from VistA via SDM1A "RTN","SDEC07",255,0) ;Create entry in SDEC APPOINTMENT "RTN","SDEC07",256,0) N SDIEN,SDECAPPTID,SDECFDA,SDECIEN,SDECMSG,SL "RTN","SDEC07",257,0) S SDECSTART=$G(SDECSTART) "RTN","SDEC07",258,0) S SAVESTRT=$G(SAVESTRT),SDECRES=$G(SDECRES) ;MGH save date/time for consult request "RTN","SDEC07",259,0) S DFN=$G(DFN) "RTN","SDEC07",260,0) S SDECRESD=$G(SDECRESD) "RTN","SDEC07",261,0) S SDECATID=$G(SDECATID) "RTN","SDEC07",262,0) S SDDDT=$G(SDDDT) "RTN","SDEC07",263,0) S SDID=$G(SDID) "RTN","SDEC07",264,0) S SDAPTYP=$G(SDAPTYP) "RTN","SDEC07",265,0) S SDAPPTYP=$G(SDAPPTYP) "RTN","SDEC07",266,0) S PROVIEN=$G(PROVIEN) "RTN","SDEC07",267,0) S SDCL=$G(SDCL) "RTN","SDEC07",268,0) S SDECEND=$G(SDECEND) "RTN","SDEC07",269,0) ;I SDECEND="" S SL=$G(^SC(SDCL,"SL")) S:'+SL SL=30 S SDECEND=$$FMADD^XLFDT(SDECSTART,,,+SL) ;alb/sat 651 "RTN","SDEC07",270,0) S SDECNOTE=$G(SDECNOTE) "RTN","SDEC07",271,0) S SDECLEN=$G(SDECLEN) I SDECLEN="" S SDECLEN=+$G(^SC(SDCL,"SL")) S:SDECEND="" SDECEND=$$FMADD^XLFDT(SDECSTART,,,+SDECLEN) ;alb/sat 651 "RTN","SDEC07",272,0) S SDF=$G(SDF,0) "RTN","SDEC07",273,0) I PROVIEN="" D "RTN","SDEC07",274,0) .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I") "RTN","SDEC07",275,0) S SDIEN=$$APPTGET^SDECUTL(DFN,SDECSTART,SDCL) "RTN","SDEC07",276,0) S SDIEN=$S(SDIEN'="":SDIEN_",",1:"+1,") "RTN","SDEC07",277,0) S SDECFDA(409.84,SDIEN,.01)=SDECSTART "RTN","SDEC07",278,0) S SDECFDA(409.84,SDIEN,.02)=SDECEND "RTN","SDEC07",279,0) S SDECFDA(409.84,SDIEN,.05)=DFN "RTN","SDEC07",280,0) S:+SDAPPTYP SDECFDA(409.84,SDIEN,.06)=SDAPPTYP "RTN","SDEC07",281,0) ;S:SDECATID?.N SDECFDA(409.84,SDIEN,.06)=SDECATID "RTN","SDEC07",282,0) S SDECFDA(409.84,SDIEN,.07)=SDECRESD "RTN","SDEC07",283,0) S SDECFDA(409.84,SDIEN,.08)=$G(DUZ) "RTN","SDEC07",284,0) S SDECFDA(409.84,SDIEN,.09)=$P($$NOW^XLFDT,".",1) "RTN","SDEC07",285,0) S SDECFDA(409.84,SDIEN,.1)="" "RTN","SDEC07",286,0) S SDECFDA(409.84,SDIEN,.101)="" "RTN","SDEC07",287,0) S SDECFDA(409.84,SDIEN,.102)="" "RTN","SDEC07",288,0) S SDECFDA(409.84,SDIEN,.11)="" "RTN","SDEC07",289,0) S SDECFDA(409.84,SDIEN,.12)="" "RTN","SDEC07",290,0) S SDECFDA(409.84,SDIEN,.121)="" "RTN","SDEC07",291,0) S SDECFDA(409.84,SDIEN,.122)="" "RTN","SDEC07",292,0) S:SDECATID="WALKIN" SDECFDA(409.84,SDIEN,.13)="y" "RTN","SDEC07",293,0) S:PROVIEN'="" SDECFDA(409.84,SDIEN,.16)=PROVIEN "RTN","SDEC07",294,0) S SDECFDA(409.84,SDIEN,.17)="" "RTN","SDEC07",295,0) S:$G(SDECLEN)'="" SDECFDA(409.84,SDIEN,.18)=SDECLEN "RTN","SDEC07",296,0) S SDECFDA(409.84,SDIEN,.2)=SDDDT "RTN","SDEC07",297,0) S:$G(SDID)'="" SDECFDA(409.84,SDIEN,.21)=SDID "RTN","SDEC07",298,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",299,0) S:$G(EESTAT)'="" SDECFDA(409.84,SDIEN,.23)=EESTAT "RTN","SDEC07",300,0) K SDECIEN,SDECMSG "RTN","SDEC07",301,0) D UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG") "RTN","SDEC07",302,0) S SDECAPPTID=$S(SDIEN'="+1,":+SDIEN,1:+$G(SDECIEN(1))) "RTN","SDEC07",303,0) K SDECMSG "RTN","SDEC07",304,0) D WP^DIE(409.84,$S(+$G(SDECAPPTID):SDECAPPTID_",",1:SDIEN_","),1,"","@","SDECMSG") "RTN","SDEC07",305,0) I SDECAPPTID'="" D "RTN","SDEC07",306,0) .I $P(SDAPTYP,"|",1)="C",SDF D "RTN","SDEC07",307,0) ..D REQSET^SDEC07A($P(SDAPTYP,"|",2),PROVIEN,"",1,"",SDECNOTE,SAVESTRT,SDECRES) ;MGH added 3 parameters to this call "RTN","SDEC07",308,0) Q SDECAPPTID "RTN","SDEC07",309,0) ; "RTN","SDEC07",310,0) SDECWP(SDECAPPTID,SDECNOTE) ; "RTN","SDEC07",311,0) ;Add WP field "RTN","SDEC07",312,0) I SDECNOTE]"" S SDECNOTE(.5)=SDECNOTE,SDECNOTE="" "RTN","SDEC07",313,0) I $D(SDECNOTE(0)) S SDECNOTE(.5)=SDECNOTE(0) K SDECNOTE(0) "RTN","SDEC07",314,0) I $D(SDECNOTE(.5)) D "RTN","SDEC07",315,0) . D WP^DIE(409.84,SDECAPPTID_",",1,"","SDECNOTE","SDECMSG") "RTN","SDEC07",316,0) Q "RTN","SDEC07",317,0) ; "RTN","SDEC07",318,0) ADDEVT(DFN,SDECSTART,SDECSC,SDCLA) ;EP "RTN","SDEC07",319,0) ;Called by SDEC ADD APPOINTMENT protocol "RTN","SDEC07",320,0) ;SDECSC=IEN of clinic in ^SC "RTN","SDEC07",321,0) ;SDCLA=IEN for ^SC(SDECSC,"S",SDECSTART,1,SDCLA). Use to get Length & Note "RTN","SDEC07",322,0) ; "RTN","SDEC07",323,0) N SDECNOD,SDECLEN,SDECAPPTID,SDECNODP,SDECWKIN,SDECRES "RTN","SDEC07",324,0) Q:+$G(SDECNOEV) "RTN","SDEC07",325,0) I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) "RTN","SDEC07",326,0) Q:'+$G(SDECRES) "RTN","SDEC07",327,0) S SDECNOD=$G(^SC(SDECSC,"S",SDECSTART,1,SDCLA,0)) "RTN","SDEC07",328,0) Q:SDECNOD="" "RTN","SDEC07",329,0) S SDECNODP=$G(^DPT(DFN,"S",SDECSTART,0)) "RTN","SDEC07",330,0) S SDECWKIN="" "RTN","SDEC07",331,0) S:$P(SDECNODP,U,7)=4 SDECWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile "RTN","SDEC07",332,0) S SDECLEN=$P(SDECNOD,U,2) "RTN","SDEC07",333,0) Q:'+SDECLEN "RTN","SDEC07",334,0) S SDECEND=$$FMADD^XLFDT(SDECSTART,0,0,SDECLEN,0) "RTN","SDEC07",335,0) S SDECAPPTID=$$SDECADD(SDECSTART,SDECEND,DFN,SDECRES,SDECWKIN,,,,,SDECSC,,,,,,1) "RTN","SDEC07",336,0) Q:'+SDECAPPTID "RTN","SDEC07",337,0) S SDECNOTE=$P(SDECNOD,U,4) "RTN","SDEC07",338,0) I SDECNOTE]"" D SDECWP(SDECAPPTID,SDECNOTE) "RTN","SDEC07",339,0) D ADDEVT3(SDECRES) "RTN","SDEC07",340,0) Q "RTN","SDEC07",341,0) ; "RTN","SDEC07",342,0) ADDEVT3(SDECRES) ; "RTN","SDEC07",343,0) ;Call RaiseEvent to notify GUI clients "RTN","SDEC07",344,0) Q "RTN","SDEC07",345,0) N SDECRESN "RTN","SDEC07",346,0) S SDECRESN=$G(^SDEC(409.831,SDECRES,0)) "RTN","SDEC07",347,0) Q:SDECRESN="" "RTN","SDEC07",348,0) S SDECRESN=$P(SDECRESN,"^") "RTN","SDEC07",349,0) ;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN) "RTN","SDEC07",350,0) Q "RTN","SDEC07",351,0) ; "RTN","SDEC07",352,0) ERR(SDECI,SDECERR) ;Error processing "RTN","SDEC07",353,0) S SDECI=SDECI+1 "RTN","SDEC07",354,0) S SDECERR=$TR(SDECERR,"^","~") "RTN","SDEC07",355,0) S ^TMP("SDEC",$J,SDECI)=$G(SDECAPPTID,0)_"^"_SDECERR_$C(30) "RTN","SDEC07",356,0) S SDECI=SDECI+1 "RTN","SDEC07",357,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC07",358,0) L "RTN","SDEC07",359,0) Q "RTN","SDEC07",360,0) ; "RTN","SDEC07",361,0) ETRAP ;EP Error trap entry "RTN","SDEC07",362,0) D ^%ZTER "RTN","SDEC07",363,0) I '$D(SDECI) N SDECI S SDECI=999999 "RTN","SDEC07",364,0) S SDECI=SDECI+1 "RTN","SDEC07",365,0) D ERR(SDECI,"SDEC07 Error") "RTN","SDEC07",366,0) Q "RTN","SDEC07",367,0) ; "RTN","SDEC07",368,0) DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR "RTN","SDEC07",369,0) ; "RTN","SDEC07",370,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",371,0) F SDTMP=SDTMP:-1:281 S Y=SDTMP#4=1+1+Y "RTN","SDEC07",372,0) S Y=$E(X,6,7)+Y#7 "RTN","SDEC07",373,0) Q "RTN","SDEC07",374,0) ; "RTN","SDEC07",375,0) AVUPDT(SDCL,SDECSTART,SDECLEN) ;Update Clinic availability "RTN","SDEC07",376,0) ;SEE SDM1 "RTN","SDEC07",377,0) N %,ABORT,SDNOT,Y,DFN,SDVAL "RTN","SDEC07",378,0) N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG "RTN","SDEC07",379,0) N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I,SDECINC "RTN","SDEC07",380,0) S Y=SDCL ;,DFN=DFN ;renamed SDECPATID to DFN "RTN","SDEC07",381,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",382,0) ;Determine maximum days for scheduling "RTN","SDEC07",383,0) S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365 "RTN","SDEC07",384,0) S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1)) "RTN","SDEC07",385,0) S SDDATE=SDECSTART "RTN","SDEC07",386,0) S SDSDATE=SDDATE,SDDATE=SDDATE\1 "RTN","SDEC07",387,0) 1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC "RTN","SDEC07",388,0) ;Q:$D(SDXXX) "RTN","SDEC07",389,0) S CCXN=0 K MXOK,COV,SDPROT Q:$G(DFN)<0 S SC=+SC "RTN","SDEC07",390,0) S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2) "RTN","SDEC07",391,0) S X2=SDEDT D C^%DTC S SDEDT=X "RTN","SDEC07",392,0) S Y=SDECSTART "RTN","SDEC07",393,0) EN1 S (X,SD)=Y,SM=0 D DOW "RTN","SDEC07",394,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",395,0) S S=SDECLEN "RTN","SDEC07",396,0) ;Check if SDECLEN evenly divisible by appointment length "RTN","SDEC07",397,0) S SDVAL=$P(SL,U) "RTN","SDEC07",398,0) I SDECLEN9 "RTN","SDEC07",405,0) L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC "RTN","SDEC07",406,0) S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1) "RTN","SDEC07",407,0) S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST "RTN","SDEC07",408,0) I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q "RTN","SDEC07",409,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",410,0) ; "RTN","SDEC07",411,0) SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP "RTN","SDEC07",412,0) S SDNOT=1 "RTN","SDEC07",413,0) S ABORT=0 "RTN","SDEC07",414,0) F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT "RTN","SDEC07",415,0) . S ST=$E(S,I+1) S:ST="" ST=" " "RTN","SDEC07",416,0) . S Y=$E(STR,$F(STR,ST)-2) "RTN","SDEC07",417,0) . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q "RTN","SDEC07",418,0) . I Y="" S ABORT=1 Q "RTN","SDEC07",419,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",420,0) . Q "RTN","SDEC07",421,0) S ^SC(SC,"ST",$P(SD,"."),1)=S "RTN","SDEC07",422,0) L -^SC(SC,"ST",$P(SD,"."),1) "RTN","SDEC07",423,0) Q "RTN","SDEC07",424,0) ; "RTN","SDEC07",425,0) ERROR ; "RTN","SDEC07",426,0) D ERR1("Error") "RTN","SDEC07",427,0) Q "RTN","SDEC07",428,0) ; "RTN","SDEC07",429,0) ERR1(SDECERR) ;Error processing "RTN","SDEC07",430,0) S SDECI=SDECI+1 "RTN","SDEC07",431,0) S ^TMP("SDEC",$J,SDECI)=SDECERR_$C(30) "RTN","SDEC07",432,0) S SDECI=SDECI+1 "RTN","SDEC07",433,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC07",434,0) Q "RTN","SDEC07A") 0^2^B82467094^B75289640 "RTN","SDEC07A",1,0) SDEC07A ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 19, 2016 "RTN","SDEC07A",2,0) ;;5.3;Scheduling;**627,642,651**;Aug 13, 1993;Build 14 "RTN","SDEC07A",3,0) ; "RTN","SDEC07A",4,0) ;References made to ICR #6185 and #4837 "RTN","SDEC07A",5,0) Q "RTN","SDEC07A",6,0) ; "RTN","SDEC07A",7,0) OVBOOK(SDECY,SDCL,NSDT,SDECRES) ;RPC - OVERBOOK - Check if Overbook is allowed for given Clinic and Date. "RTN","SDEC07A",8,0) ;OVBOOK(SDECY,SDCL,NSDT,SDECRES) external parameter tag is in SDEC "RTN","SDEC07A",9,0) ; .SDECY = returned pointer to OVERBOOK data "RTN","SDEC07A",10,0) ; SDCL = clinic code - pointer to Hospital Location file ^SC "RTN","SDEC07A",11,0) ; NSDT = date/time of new appointment "RTN","SDEC07A",12,0) ; SDECRES = resource to check for overbook "RTN","SDEC07A",13,0) N %DT,AP,SDECI,OB,SDBK,OBCNT,OBMAX,SDCLN,SDCLRES,SDCLSL,SDCNT,SDRET,SDT,SDTD,SDTE,X,Y "RTN","SDEC07A",14,0) N SD30,SDARR,OBCNTSUM "RTN","SDEC07A",15,0) S OBCNTSUM=0 "RTN","SDEC07A",16,0) ; SDTD = new schedule Date only in FM format "RTN","SDEC07A",17,0) ; SDT = loop value for $o through schedules "RTN","SDEC07A",18,0) ; SDTE = end of loop schedule "RTN","SDEC07A",19,0) ; NSDT = new appointment schedule Date/Time will be converted to FM format "RTN","SDEC07A",20,0) S SDECI=0 "RTN","SDEC07A",21,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC07A",22,0) K @SDECY "RTN","SDEC07A",23,0) S @SDECY@(0)="T00020ERRORID"_$C(30) "RTN","SDEC07A",24,0) ;check for valid Hospital location "RTN","SDEC07A",25,0) I '+SDCL D ERR1("Invalid Clinic ID - Cannot determine if Overbook is allowed.") Q "RTN","SDEC07A",26,0) I '$D(^SC(SDCL,0)) D ERR1("Invalid Clinic ID - Cannot determine if Overbook is allowed.") Q "RTN","SDEC07A",27,0) ;check for valid resource ID "RTN","SDEC07A",28,0) I '+SDECRES D ERR1("Invalid Resource ID - Cannot determine if Overbook is allowed.") Q "RTN","SDEC07A",29,0) I '$D(^SDEC(409.831,SDECRES,0)) D ERR1("Invalid Resource ID - Cannot determine if Overbook is allowed.") Q "RTN","SDEC07A",30,0) ;check for valid DATE/TIME "RTN","SDEC07A",31,0) S %DT="T" "RTN","SDEC07A",32,0) S X=NSDT "RTN","SDEC07A",33,0) D ^%DT ; GET FM FORMAT FOR APPOINTMENT DATE/TIME "RTN","SDEC07A",34,0) S NSDT=Y "RTN","SDEC07A",35,0) I NSDT=-1 D ERR1("Invalid Appointment Date.") Q "RTN","SDEC07A",36,0) S SDTD=$P(NSDT,".") "RTN","SDEC07A",37,0) ; data header "RTN","SDEC07A",38,0) ; OVERBOOK 0=not overbooked; 1=overbooked "RTN","SDEC07A",39,0) S @SDECY@(0)="T00020OVERBOOK"_$C(30) "RTN","SDEC07A",40,0) ;get allowed number of overbookings for clinic "RTN","SDEC07A",41,0) S SDCLSL=$G(^SC(SDCL,"SL")) "RTN","SDEC07A",42,0) S OBMAX=$P(SDCLSL,U,7) "RTN","SDEC07A",43,0) I '+OBMAX S (OBCNT,OBMAX)=0 G XIT "RTN","SDEC07A",44,0) N SDAB,SLOTSIZE "RTN","SDEC07A",45,0) S SDAB="^TMP("_$J_",""SDEC"",""BLKS"")" "RTN","SDEC07A",46,0) S SLOTSIZE="^TMP("_$J_",""SDEC"",""SLOTSIZE"")" "RTN","SDEC07A",47,0) K @SDAB,@SLOTSIZE "RTN","SDEC07A",48,0) ;get original slot sizes "RTN","SDEC07A",49,0) D GETSLOTS^SDEC04(SLOTSIZE,SDECRES,SDTD,SDTD_".2359") "RTN","SDEC07A",50,0) ;get current appt availability "RTN","SDEC07A",51,0) D GETSLOTS^SDEC57(SDAB,SDECRES,SDTD,SDTD_".2359") "RTN","SDEC07A",52,0) N IDX,SDR,SDSTART,SDSTOP,SDSLOTS,XX,IDX2,YY "RTN","SDEC07A",53,0) ;restore original slot sizes into appts slots "RTN","SDEC07A",54,0) S IDX="" F S IDX=$O(@SLOTSIZE@(IDX)) Q:'IDX D "RTN","SDEC07A",55,0) .S XX=@SLOTSIZE@(IDX) "RTN","SDEC07A",56,0) .S SDSTART=$P(XX,U,2),SDSTOP=$P(XX,U,3),SDSLOTS=$P(XX,U,4) "RTN","SDEC07A",57,0) .S IDX2="" F S IDX2=$O(@SDAB@(IDX2)) Q:'IDX2 D "RTN","SDEC07A",58,0) ..S YY=@SDAB@(IDX2) "RTN","SDEC07A",59,0) ..S:($P(YY,U,2)'SDSTOP) $P(@SDAB@(IDX2),U,4)=SDSLOTS "RTN","SDEC07A",60,0) ;find overbooks "RTN","SDEC07A",61,0) S IDX="" F S IDX=$O(@SDAB@(IDX)) Q:IDX="" D "RTN","SDEC07A",62,0) .S XX=@SDAB@(IDX) "RTN","SDEC07A",63,0) .S SDSTART=$P(XX,U,2),SDSTOP=$P(XX,U,3),SDSLOTS=$P(XX,U,4) "RTN","SDEC07A",64,0) .;loop thru schedule "RTN","SDEC07A",65,0) .; SDBK(,)=counter starting at 0 "RTN","SDEC07A",66,0) .K SDBK ;overbook counter array "RTN","SDEC07A",67,0) .S SDRET="" D CRSCHED^SDEC(.SDRET,SDECRES,SDSTART,SDSTOP) "RTN","SDEC07A",68,0) .K SDARR "RTN","SDEC07A",69,0) .S SD30=1,SDCNT=0,SDT=0 F S SDT=$O(@SDRET@(SDT)) Q:SDT="" D "RTN","SDEC07A",70,0) ..S SDR=$G(@SDRET@(SDT)) "RTN","SDEC07A",71,0) ..I $P(SDR,U,1)[$c(30) S SD30=1 Q "RTN","SDEC07A",72,0) ..Q:SD30'=1 "RTN","SDEC07A",73,0) ..S SDCNT=SDCNT+1 "RTN","SDEC07A",74,0) ..S SDARR($P(SDR,U,1))="" "RTN","SDEC07A",75,0) ..S SD30=0 "RTN","SDEC07A",76,0) .S SDCNT=0 F S SDCNT=$O(SDARR(SDCNT)) Q:SDCNT="" D "RTN","SDEC07A",77,0) ..S SDR=$G(^SDEC(409.84,+SDCNT,0)) "RTN","SDEC07A",78,0) ..S SDT=$P(SDR,U,1) "RTN","SDEC07A",79,0) ..S SDTE=$P(SDR,U,2) "RTN","SDEC07A",80,0) ..Q:$P(SDR,U,12)]"" ;don't count cancelled appts "RTN","SDEC07A",81,0) ..;if time ranges overlap, add to SDBK array "RTN","SDEC07A",82,0) ..I (SDTE>SDT)&(((SDT'SDSTART)&(SDTE'>SDSTOP))!((SDT'>SDSTART)&(SDTE'0 Q:SDECRES'=0 D "RTN","SDEC07A",103,0) . S SDECAPN=$G(^SDEC(409.84,ID,0)) "RTN","SDEC07A",104,0) . I $P(SDECAPN,U,5)=DFN S SDECRES=$P(SDECAPN,U,7) "RTN","SDEC07A",105,0) Q SDECRES "RTN","SDEC07A",106,0) ; "RTN","SDEC07A",107,0) ;check if appointment start/stop is in range of an existing appointment "RTN","SDEC07A",108,0) CKOB(START,STOP,SDBK) ;called internally "RTN","SDEC07A",109,0) ; START = appointment start date/time in FM format "RTN","SDEC07A",110,0) ; STOP = appointment stop date/time in FM format "RTN","SDEC07A",111,0) ; .SDBK = bookings Array - SDBK(,)=counter starting at 0 "RTN","SDEC07A",112,0) N B,E,OB,OBF "RTN","SDEC07A",113,0) S OBF=0 "RTN","SDEC07A",114,0) S B="" "RTN","SDEC07A",115,0) F S B=$O(SDBK(B)) Q:B'>0 D Q:+OBF "RTN","SDEC07A",116,0) . S E="" F S E=$O(SDBK(B,E)) Q:E'>0 D Q:+OBF "RTN","SDEC07A",117,0) . . S OB=SDBK(B,E) "RTN","SDEC07A",118,0) . . S OBF=1 "RTN","SDEC07A",119,0) . . ;S OBF=(($$FMADD^XLFDT(START,B,2)'<0)&($$FMADD^XLFDT(START,E,2)<0))!(($$FMADD^XLFDT(STOP,B,2)>0)&($$FMADD^XLFDT(STOP,E,2)'<0)) "RTN","SDEC07A",120,0) . . ;S OBF=(($P(START,".",2)'<$P(B,".",2))&($P(START,".",2)'>$P(E,".",2)))!(($P(STOP,".",2)>$P(B,".",2))&($P(STOP,".",2)'>$P(E,".",2))) "RTN","SDEC07A",121,0) . . I OBF S SDBK(B,E)=(OB+1) "RTN","SDEC07A",122,0) I 'OBF S SDBK(START,STOP)=1 "RTN","SDEC07A",123,0) ; "RTN","SDEC07A",124,0) Q "RTN","SDEC07A",125,0) ; "RTN","SDEC07A",126,0) ;count overbookings "RTN","SDEC07A",127,0) CNTOB(SDBK,SDECRES,SDTD,OBMAX,SDAB) ;called internally "RTN","SDEC07A",128,0) N AB,ABF,ABN,CNT,BK,SLOTS,B,E "RTN","SDEC07A",129,0) S BK="" "RTN","SDEC07A",130,0) S CNT=0 "RTN","SDEC07A",131,0) S B="" F S B=$O(SDBK(B)) Q:B="" D Q:CNT'0 D Q:+ABF "RTN","SDEC07A",143,0) .S ABN=@SDAB@(SDI) "RTN","SDEC07A",144,0) .S ABF=((B'<$P(ABN,U,2))&(B<$P(ABN,U,3)))!((E>$P(ABN,U,2))&(E'>$P(ABN,U,3))) "RTN","SDEC07A",145,0) .S:ABF SLOTS=+$P(ABN,U,4) "RTN","SDEC07A",146,0) Q SLOTS "RTN","SDEC07A",147,0) ; "RTN","SDEC07A",148,0) REQSET(SDRIEN,SDPROV,SDUSR,SDACT,SDECTYP,SDECNOTE,SAVESTRT,SDECRES) ;add SCHEDULED activity to REQUEST/CONSULTATION file "RTN","SDEC07A",149,0) ;INPUT: "RTN","SDEC07A",150,0) ; SDRIEN - (required) pointer to RFEQUEST/CONSULTATION file 123 "RTN","SDEC07A",151,0) ; SDPROV - (required) Provider pointer to NEW PERSON "RTN","SDEC07A",152,0) ; SDUSR - (optional) User that entered appointment pointer to NEW PERSON "RTN","SDEC07A",153,0) ; SDACT - (required) ACTIVITY type to add 1=SCHEDULED 2=STATUS CHANGE "RTN","SDEC07A",154,0) ; SDECTYP - (required if SDACT=2) appointment Status valid values: "RTN","SDEC07A",155,0) ; C=CANCELLED BY CLINIC "RTN","SDEC07A",156,0) ; PC=CANCELLED BY PATIENT "RTN","SDEC07A",157,0) ; SDECNOTE - Comments from Appointment "RTN","SDEC07A",158,0) ; SAVESTRT - Appointment time in external format ;alb/sat 651 corrected comment "RTN","SDEC07A",159,0) ; SDECRES - Appointment Resource "RTN","SDEC07A",160,0) N SDDT,SDFDA,SDI,SDIEN,SDOA,SDOS,SDPDC,SDSCHED,SDSCHEDF,SDSTAT,SDTXT,SDERR,Y "RTN","SDEC07A",161,0) S SDACT=$G(SDACT) "RTN","SDEC07A",162,0) S SAVESTRT=$G(SAVESTRT) "RTN","SDEC07A",163,0) S SDECRES=$G(SDECRES) "RTN","SDEC07A",164,0) Q:"12"'[SDACT "RTN","SDEC07A",165,0) S SDSCHEDF=0 "RTN","SDEC07A",166,0) S SDUSR=$G(SDUSR) "RTN","SDEC07A",167,0) S:SDUSR="" SDUSR=DUZ "RTN","SDEC07A",168,0) S:'$D(^VA(200,+SDUSR,0)) SDUSR=DUZ ;take this out "RTN","SDEC07A",169,0) S SDSCHED=$$GETIEN^SDEC51("SCHEDULED") "RTN","SDEC07A",170,0) S SDSTAT=$$GETIEN^SDEC51("STATUS CHANGE") "RTN","SDEC07A",171,0) S SDPDC=$O(^ORD(100.01,"B","DISCONTINUED",0)) "RTN","SDEC07A",172,0) I SDACT=1,SDSCHED="" Q "RTN","SDEC07A",173,0) I SDACT=2,SDSTAT="" Q "RTN","SDEC07A",174,0) Q:$$GET1^DIQ(123,SDRIEN_",",8,"I")=SDPDC ;never update file 123 if CPRS STATUS is DISCONTINUED "RTN","SDEC07A",175,0) S SDECNOTE=$G(SDECNOTE) "RTN","SDEC07A",176,0) ;it is possible to have multiple scheduled activities; make sure there is not already a SCHEDULED activity "RTN","SDEC07A",177,0) ;S SDI=0 F S SDI=$O(^GMR(123,SDRIEN,40,SDI)) Q:SDI'>0 D Q:+SDSCHEDF "RTN","SDEC07A",178,0) ;.I $P($G(^GMR(123,SDRIEN,40,SDI,0)),U,2)=SDSCHED S SDSCHEDF=1 Q "RTN","SDEC07A",179,0) ;Q:+SDSCHEDF "RTN","SDEC07A",180,0) S SDDT=$E($$NOW^XLFDT,1,12) "RTN","SDEC07A",181,0) S SDFDA(123.02,"+1,"_SDRIEN_",",.01)=SDDT ;ICR 6185 "RTN","SDEC07A",182,0) S SDFDA(123.02,"+1,"_SDRIEN_",",1)=$S(SDACT=1:SDSCHED,SDACT=2:SDSTAT,1:"") ;ICR 6185 "RTN","SDEC07A",183,0) S SDFDA(123.02,"+1,"_SDRIEN_",",2)=SDDT ;ICR 6185 "RTN","SDEC07A",184,0) S SDFDA(123.02,"+1,"_SDRIEN_",",3)=SDPROV ;ICR 6185 "RTN","SDEC07A",185,0) S SDFDA(123.02,"+1,"_SDRIEN_",",4)=SDUSR ;ICR 6185 "RTN","SDEC07A",186,0) D UPDATE^DIE("","SDFDA","SDIEN") "RTN","SDEC07A",187,0) S SDTXT="" "RTN","SDEC07A",188,0) ;MGH modified to add in note text and appointment data "RTN","SDEC07A",189,0) I SDACT=1 D "RTN","SDEC07A",190,0) .S SDTXT(1)=$P($G(^SDEC(409.831,+SDECRES,0)),U,1)_" Consult Appt. on "_SAVESTRT "RTN","SDEC07A",191,0) .I SDECNOTE'="" S SDTXT(2)=SDECNOTE "RTN","SDEC07A",192,0) I SDACT=2 D "RTN","SDEC07A",193,0) .S SDECTYP=$G(SDECTYP) "RTN","SDEC07A",194,0) .S SDTXT(1)=$P($G(^SDEC(409.831,+SDECRES,0)),U,1)_" Appt. on "_SAVESTRT_" was cancelled"_$S(SDECTYP["P":" by the Patient.",SDECTYP["C":" by the Clinic.",1:".") ;alb/sat 651 include appt info "RTN","SDEC07A",195,0) .I SDECNOTE'="" S SDTXT(2)="Remarks: "_SDECNOTE "RTN","SDEC07A",196,0) I $D(SDTXT) D "RTN","SDEC07A",197,0) .D WP^DIE(123.02,SDIEN(1)_","_SDRIEN_",",5,"","SDTXT","SDERR") ;ICR 6185 "RTN","SDEC07A",198,0) K SDFDA ;alb/sat 651 "RTN","SDEC07A",199,0) ;set CPRS status field ICR 6185 "RTN","SDEC07A",200,0) S SDOS=$O(^ORD(100.01,"B","SCHEDULED",0)) "RTN","SDEC07A",201,0) S SDOA=$O(^ORD(100.01,"B","ACTIVE",0)) "RTN","SDEC07A",202,0) I SDOS'="" D "RTN","SDEC07A",203,0) .;K SDFDA ;alb/sat 651 moved up "RTN","SDEC07A",204,0) .S SDFDA(123,SDRIEN_",",8)=$S(SDACT=1:SDOS,1:SDOA) "RTN","SDEC07A",205,0) .;D UPDATE^DIE("","SDFDA") ;ICR 6185 ;alb/sat 651 moved down out of IF scope "RTN","SDEC07A",206,0) S:+$G(SDSCHED) SDFDA(123,SDRIEN_",",9)=$S(SDACT=1:SDSCHED,1:SDSTAT) ;alb/sat 651 - set LAST ACTION TAKEN ICR 4837 "RTN","SDEC07A",207,0) D:$D(SDFDA) UPDATE^DIE("","SDFDA") ;alb/sat 651 "RTN","SDEC07A",208,0) Q "RTN","SDEC07A",209,0) ; "RTN","SDEC07A",210,0) EWL(WLIEN,APPDT,SDCL,SVCP,SVCPR,NOTE,SDAPPTYP) ;update SD WAIT LIST at appointment add "RTN","SDEC07A",211,0) ;INPUT: "RTN","SDEC07A",212,0) ; WLIEN = Wait List ID pointer to SD WAIT LIST file 409.3 "RTN","SDEC07A",213,0) ; APPDT = Appointment date/time (Scheduled Date of appt) in fm format "RTN","SDEC07A",214,0) ; SDCL = Clinic ID pointer to HOSPITAL LOCATION file 44 "RTN","SDEC07A",215,0) ; SVCP = Service Connected Percentage numeric 0-100 "RTN","SDEC07A",216,0) ; SVCPR = Service Connected Priority 0:NO 1:YES "RTN","SDEC07A",217,0) ; NOTE = Comment only 1st 60 characters are used "RTN","SDEC07A",218,0) ; SDAPPTYP - (optional) Appointment type ID pointer to APPOINTMENT TYPE file 409.1 "RTN","SDEC07A",219,0) ; "RTN","SDEC07A",220,0) ;all input must be verified by calling routine "RTN","SDEC07A",221,0) N SDDIV,SDFDA,SDSN "RTN","SDEC07A",222,0) S:+$G(SDAPPTYP) SDFDA(409.3,WLIEN_",",8.7)=SDAPPTYP "RTN","SDEC07A",223,0) S SDFDA(409.3,WLIEN_",",13)=APPDT ;SCHEDULED DATE OF APPT = APPDT (SDECSTART) "RTN","SDEC07A",224,0) S SDFDA(409.3,WLIEN_",",13.1)=$P($$NOW^XLFDT,".",1) ;DATE APPT. MADE = TODAY "RTN","SDEC07A",225,0) S SDFDA(409.3,WLIEN_",",13.2)=SDCL ;APPT CLINIC = SDCL (SDECSCD) "RTN","SDEC07A",226,0) S SDFDA(409.3,WLIEN_",",13.3)=$P($G(^SC(SDCL,0)),U,4) ;APPT INSTITUTION = Get from 44 using SDCL "RTN","SDEC07A",227,0) S SDFDA(409.3,WLIEN_",",13.4)=$P($G(^SC(SDCL,0)),U,7) ;APPT STOP CODE = Get from 44 using SDCL "RTN","SDEC07A",228,0) S SDDIV=$P($G(^SC(SDCL,0)),U,15) "RTN","SDEC07A",229,0) S SDSN=$S(SDDIV'="":$P($G(^DG(40.8,SDDIV,0)),U,2),1:"") "RTN","SDEC07A",230,0) S SDFDA(409.3,WLIEN_",",13.6)=SDSN ;APPT STATION NUMBER "RTN","SDEC07A",231,0) S SDFDA(409.3,WLIEN_",",13.7)=DUZ ;APPT CLERK = Current User "RTN","SDEC07A",232,0) S SDFDA(409.3,WLIEN_",",13.8)="R" ;APPT STATUS = R:Scheduled/Kept "RTN","SDEC07A",233,0) S:SVCP'="" SDFDA(409.3,WLIEN_",",14)=SVCP ;SERVICE CONNECTED PERCENTAGE = SVCP (SDSVCP) "RTN","SDEC07A",234,0) S:SVCPR'="" SDFDA(409.3,WLIEN_",",15)=SVCPR ;SERVICE CONNECTED PRIORITY = SVCPR (SDSVCPR) "RTN","SDEC07A",235,0) S:$G(NOTE)'="" SDFDA(409.3,WLIEN_",",25)=NOTE "RTN","SDEC07A",236,0) S SDFDA(409.3,WLIEN_",",27)="U" ;EWL ENROLLEE STATUS = U:UNDETERMINED "RTN","SDEC07A",237,0) S SDFDA(409.3,WLIEN_",",27.2)=0 ;EWL ENROLLEE DATABASE FILE = 0:NONE "RTN","SDEC07A",238,0) S SDFDA(409.3,WLIEN_",",28)=DUZ ;EDITING USER = Current User "RTN","SDEC07A",239,0) D UPDATE^DIE("","SDFDA") "RTN","SDEC07A",240,0) Q "RTN","SDEC07A",241,0) ; "RTN","SDEC07A",242,0) ERROR ; "RTN","SDEC07A",243,0) D ERR1("Error") "RTN","SDEC07A",244,0) Q "RTN","SDEC07A",245,0) ; "RTN","SDEC07A",246,0) ERR1(SDECERR) ;Error processing "RTN","SDEC07A",247,0) S SDECI=SDECI+1 "RTN","SDEC07A",248,0) S ^TMP("SDEC",$J,SDECI)=SDECERR_$C(30) "RTN","SDEC07A",249,0) S SDECI=SDECI+1 "RTN","SDEC07A",250,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC07A",251,0) Q "RTN","SDEC08") 0^3^B200693919^B196754600 "RTN","SDEC08",1,0) SDEC08 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 19, 2016 "RTN","SDEC08",2,0) ;;5.3;Scheduling;**627,651**;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 cancel date/time "RTN","SDEC08",40,0) S SDECDATE=$G(SDECDATE) "RTN","SDEC08",41,0) I SDECDATE'="" S %DT="T" S X=SDECDATE D ^%DT S SDECDATE=Y I Y=-1 S SDECDATE="" "RTN","SDEC08",42,0) I $G(SDECDATE)="" S SDECDATE=$$NOW^XLFDT "RTN","SDEC08",43,0) ;validate user "RTN","SDEC08",44,0) S SDUSER=$G(SDUSER) "RTN","SDEC08",45,0) I SDUSER'="" I '$D(^VA(200,+SDUSER,0)) S SDUSER="" "RTN","SDEC08",46,0) I SDUSER="" S SDUSER=DUZ "RTN","SDEC08",47,0) ; "RTN","SDEC08",48,0) TSTART "RTN","SDEC08",49,0) ; "RTN","SDEC08",50,0) ;Delete APPOINTMENT entries "RTN","SDEC08",51,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC08",52,0) S SDECPATID=$P(SDECNOD,U,5) "RTN","SDEC08",53,0) S SDECSTART=$P(SDECNOD,U) "RTN","SDEC08",54,0) ; "RTN","SDEC08",55,0) ;Lock SDEC node "RTN","SDEC08",56,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",57,0) ;cancel check-in if walk-in "RTN","SDEC08",58,0) I $P(SDECNOD,U,13)="y" D "RTN","SDEC08",59,0) .S SDRET="" "RTN","SDEC08",60,0) .D CHECKIN^SDEC25(.SDRET,SDECAPTID,"@") "RTN","SDEC08",61,0) ;cancel SDEC APPOINTMENT record "RTN","SDEC08",62,0) D SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,1) "RTN","SDEC08",63,0) ; "RTN","SDEC08",64,0) S SDECSC1=$P(SDECNOD,U,7) ;RESOURCEID "RTN","SDEC08",65,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",66,0) . S SDECNOD=^SDEC(409.831,SDECSC1,0) "RTN","SDEC08",67,0) . S SDECLOC=$P(SDECNOD,U,4) ;HOSPITAL LOCATION "RTN","SDEC08",68,0) . Q:'+SDECLOC "RTN","SDEC08",69,0) . S SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART) I SDECSCIEN="" D I 'SDECZ Q ;Q:SDECZ "RTN","SDEC08",70,0) . . S SDECERR="SDEC08: Unable to find associated appointment for this patient. " "RTN","SDEC08",71,0) . . S SDECZ=1 "RTN","SDEC08",72,0) . . I '$D(^SDEC(409.831,SDECSC1,20)) S SDECZ=0 Q "RTN","SDEC08",73,0) . . N SDEC1 "RTN","SDEC08",74,0) . . S SDEC1=0 "RTN","SDEC08",75,0) . . F S SDEC1=$O(^SDEC(409.831,SDECSC1,20,SDEC1)) Q:'+SDEC1 Q:SDECZ=0 D "RTN","SDEC08",76,0) . . . Q:'$D(^SDEC(409.831,SDECSC1,20,SDEC1,0)) "RTN","SDEC08",77,0) . . . S SDECLOC=$P(^SDEC(409.831,SDECSC1,20,SDEC1,0),U) "RTN","SDEC08",78,0) . . . S SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART) I +SDECSCIEN S SDECZ=0 Q "RTN","SDEC08",79,0) . S SDECERR="SDEC08: CANCEL^SDEC08 Returned " "RTN","SDEC08",80,0) . I SDECLOC']"" S SDECZ="0^Unable to find associated appointment for this patient." Q "RTN","SDEC08",81,0) . I '$D(^SC(SDECLOC,0)) S SDECZ="0^Unable to find associated appointment for this patient." Q "RTN","SDEC08",82,0) . S SDECNOD=$G(^SC(SDECLOC,"S",SDECSTART,1,+SDECSCIEN,0)) "RTN","SDEC08",83,0) . I SDECNOD="" S SDECZ="0^Unable to find associated appointment for this patient." Q "RTN","SDEC08",84,0) . S SDECLEN=$P(SDECNOD,U,2) "RTN","SDEC08",85,0) . D APCAN(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECAPTID,SDECLEN) "RTN","SDEC08",86,0) . Q:+$G(SDECZ) "RTN","SDEC08",87,0) . D AVUPDT(SDECLOC,SDECSTART,SDECLEN) "RTN","SDEC08",88,0) . D AR433D^SDECAR2(SDECAPTID) "RTN","SDEC08",89,0) . ;L "RTN","SDEC08",90,0) ; "RTN","SDEC08",91,0) TCOMMIT "RTN","SDEC08",92,0) L -^SDEC(409.84,SDECPATID) "RTN","SDEC08",93,0) S SDECI=SDECI+1 "RTN","SDEC08",94,0) S @SDECY@(SDECI)=""_$C(30) "RTN","SDEC08",95,0) S SDECI=SDECI+1 "RTN","SDEC08",96,0) S @SDECY@(SDECI)=$C(31) "RTN","SDEC08",97,0) Q "RTN","SDEC08",98,0) ; "RTN","SDEC08",99,0) AVUPDT(SDECSCD,SDECSTART,SDECLEN) ;Update Clinic availability "RTN","SDEC08",100,0) ;See SDCNP0 "RTN","SDEC08",101,0) N HSI,I,S,SB,SD,SDDIF,SI,SL,SS,ST,STARTDAY,STR,X,Y "RTN","SDEC08",102,0) S (SD,S)=SDECSTART "RTN","SDEC08",103,0) S I=SDECSCD "RTN","SDEC08",104,0) Q:'$D(^SC(I,"ST",SD\1,1)) "RTN","SDEC08",105,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",106,0) S SL=SDECLEN "RTN","SDEC08",107,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",108,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",109,0) S ^SC(SDECSCD,"ST",SD\1,1)=S "RTN","SDEC08",110,0) Q "RTN","SDEC08",111,0) ; "RTN","SDEC08",112,0) APCAN(SDECZ,SDECLOC,SDECDFN,SDECSD,SDECAPTID,SDECLEN) ; "RTN","SDEC08",113,0) ;Cancel appointment for patient SDECDFN in clinic SDECSC1 "RTN","SDEC08",114,0) ;at time SDECSD "RTN","SDEC08",115,0) N SDECPNOD,SDECC,DA,DIE,DPTST,DR,%H "RTN","SDEC08",116,0) ;save data into SDEC APPOINTMENT in case of un-cancel (status & appt length) "RTN","SDEC08",117,0) S SDECPNOD=^DPT(SDECPATID,"S",SDECSD,0) "RTN","SDEC08",118,0) S DPTST=$P(SDECPNOD,U,2) "RTN","SDEC08",119,0) S DIE=409.84 "RTN","SDEC08",120,0) S DA=SDECAPTID "RTN","SDEC08",121,0) S DR=".17///"_DPTST_";"_".18///"_SDECLEN "RTN","SDEC08",122,0) D ^DIE "RTN","SDEC08",123,0) S SDECC("PAT")=SDECDFN "RTN","SDEC08",124,0) S SDECC("CLN")=SDECLOC "RTN","SDEC08",125,0) S SDECC("TYP")=SDECTYP "RTN","SDEC08",126,0) S SDECC("ADT")=SDECSD "RTN","SDEC08",127,0) S %H=$H D YMD^%DTC "RTN","SDEC08",128,0) S SDECC("CDT")=SDECDATE ;X+% "RTN","SDEC08",129,0) S SDECC("NOT")=SDECNOT "RTN","SDEC08",130,0) S:+SDECCR SDECC("CR")=SDECCR "RTN","SDEC08",131,0) S SDECC("USR")=SDUSER "RTN","SDEC08",132,0) ; "RTN","SDEC08",133,0) S SDECZ=$$CANCEL(.SDECC) "RTN","SDEC08",134,0) Q "RTN","SDEC08",135,0) ; "RTN","SDEC08",136,0) SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,SDF) ;cancel SDEC APPOINTMENT entry "RTN","SDEC08",137,0) ;SDECAPTID - (required) pointer to SDEC APPOINTMENT file "RTN","SDEC08",138,0) ;SDECTYP - (required) appointment Status valid values: "RTN","SDEC08",139,0) ; C=CANCELLED BY CLINIC "RTN","SDEC08",140,0) ; PC=CANCELLED BY PATIENT "RTN","SDEC08",141,0) ;SDECCR - (optional) pointer to CANCELLATION REASON File (409.2) "RTN","SDEC08",142,0) ;SDECNOT - (optional) text representing user note "RTN","SDEC08",143,0) ;SDECDATE - (optional) Cancel Date/Time in fm format; defaults to NOW) ; "RTN","SDEC08",144,0) ;SDF - (optional) flags "RTN","SDEC08",145,0) ; 1. called from GUI (update consult only if called from GUI) "RTN","SDEC08",146,0) ;Cancel SDEC APPOINTMENT entry "RTN","SDEC08",147,0) N DFN,PROVIEN,Y "RTN","SDEC08",148,0) N SAVESTRT,SDAPTYP,SDCL,SDI,SDIEN,SDECIENS,SDECFDA,SDECMSG,SDECWP,SDRES,SDT ;alb/sat 651 add SAVESTRT and SDRES "RTN","SDEC08",149,0) S SDF=$G(SDF,0) "RTN","SDEC08",150,0) S SDT=$$GET1^DIQ(409.84,SDECAPTID_",",.01,"I") "RTN","SDEC08",151,0) S SAVESTRT=$$GET1^DIQ(409.84,SDECAPTID_",",.01) ;alb/sat 651 "RTN","SDEC08",152,0) S SDRES=$$GET1^DIQ(409.84,SDECAPTID_",",.07,"I") ;alb/sat 651 "RTN","SDEC08",153,0) S SDECIENS=SDECAPTID_"," "RTN","SDEC08",154,0) S SDECFDA(409.84,SDECIENS,.12)=$S($G(SDECDATE)'="":SDECDATE,1:$$NOW^XLFDT) "RTN","SDEC08",155,0) S SDECFDA(409.84,SDECIENS,.121)=$S($G(SDUSER)'="":SDUSER,1:DUZ) "RTN","SDEC08",156,0) S:$G(SDECCR)'="" SDECFDA(409.84,SDECIENS,.122)=SDECCR "RTN","SDEC08",157,0) S SDECFDA(409.84,SDECIENS,.17)=SDECTYP "RTN","SDEC08",158,0) K SDECMSG "RTN","SDEC08",159,0) D FILE^DIE("","SDECFDA","SDECMSG") "RTN","SDEC08",160,0) S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I") "RTN","SDEC08",161,0) I $G(SDECNOT)'="" D "RTN","SDEC08",162,0) .K SDECMSG,SDECWP "RTN","SDEC08",163,0) .S SDECWP(1)=SDECNOT "RTN","SDEC08",164,0) .D WP^DIE(409.84,SDECIENS,1,"A","SDECWP","SDECMSG") "RTN","SDEC08",165,0) I $P(SDAPTYP,";",2)="GMR(123,",SDF D "RTN","SDEC08",166,0) .S SDCL=$$SDCL^SDECUTL(SDECAPTID) "RTN","SDEC08",167,0) .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I") "RTN","SDEC08",168,0) .D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",2,SDECTYP,SDECNOT,SAVESTRT,SDRES) ;alb/sat 651 added SAVESTRT "RTN","SDEC08",169,0) I $P(SDAPTYP,";",2)="SDWL(409.3," D ;update EWL "RTN","SDEC08",170,0) .S DFN=$$GET1^DIQ(409.3,$P(SDAPTYP,";",1)_",",.01,"I") "RTN","SDEC08",171,0) .Q:DFN="" "RTN","SDEC08",172,0) .S SDIEN=0 F S SDIEN=$O(^SDWL(409.3,"B",DFN,SDIEN)) Q:SDIEN="" D "RTN","SDEC08",173,0) ..I $$GET1^DIQ(409.3,SDIEN_",",13,"I")=SDT D "RTN","SDEC08",174,0) ...K SDECFDA,SDECMSG,SDECWP "RTN","SDEC08",175,0) ...;S SDIEN=$P(SDAPTYP,";",1) "RTN","SDEC08",176,0) ...S SDECFDA(409.3,SDIEN_",",13)="@" "RTN","SDEC08",177,0) ...S SDECFDA(409.3,SDIEN_",",13.1)="@" "RTN","SDEC08",178,0) ...S SDECFDA(409.3,SDIEN_",",13.2)="@" "RTN","SDEC08",179,0) ...S SDECFDA(409.3,SDIEN_",",13.3)="@" "RTN","SDEC08",180,0) ...S SDECFDA(409.3,SDIEN_",",13.4)="@" "RTN","SDEC08",181,0) ...S SDECFDA(409.3,SDIEN_",",13.5)="@" "RTN","SDEC08",182,0) ...S SDECFDA(409.3,SDIEN_",",13.6)="@" "RTN","SDEC08",183,0) ...S SDECFDA(409.3,SDIEN_",",13.7)="@" "RTN","SDEC08",184,0) ...S SDECFDA(409.3,SDIEN_",",13.8)="@" "RTN","SDEC08",185,0) ...D UPDATE^DIE("","SDECFDA") "RTN","SDEC08",186,0) ...D WLOPEN^SDECWL("","",SDIEN) "RTN","SDEC08",187,0) I $P(SDAPTYP,";",2)="SDEC(409.85," D ;update APPT "RTN","SDEC08",188,0) .K SDECFDA,SDECMSG,SDECWP "RTN","SDEC08",189,0) .D AROPEN^SDECAR("",SDECAPTID) "RTN","SDEC08",190,0) .S SDIEN=$P(SDAPTYP,";",1) "RTN","SDEC08",191,0) .S SDECFDA(409.85,SDIEN_",",13)="@" "RTN","SDEC08",192,0) .S SDECFDA(409.85,SDIEN_",",13.1)="@" "RTN","SDEC08",193,0) .S SDECFDA(409.85,SDIEN_",",13.2)="@" "RTN","SDEC08",194,0) .S SDECFDA(409.85,SDIEN_",",13.3)="@" "RTN","SDEC08",195,0) .S SDECFDA(409.85,SDIEN_",",13.4)="@" "RTN","SDEC08",196,0) .S SDECFDA(409.85,SDIEN_",",13.5)="@" "RTN","SDEC08",197,0) .S SDECFDA(409.85,SDIEN_",",13.6)="@" "RTN","SDEC08",198,0) .S SDECFDA(409.85,SDIEN_",",13.7)="@" "RTN","SDEC08",199,0) .S SDECFDA(409.85,SDIEN_",",13.8)="@" "RTN","SDEC08",200,0) .D UPDATE^DIE("","SDECFDA") "RTN","SDEC08",201,0) Q "RTN","SDEC08",202,0) ; "RTN","SDEC08",203,0) CANEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CANCEL APPOINTMENT event "RTN","SDEC08",204,0) ;when appointments cancelled via PIMS interface. "RTN","SDEC08",205,0) ;Propagates cancellation to SDECAPPT and raises refresh event to running GUI clients "RTN","SDEC08",206,0) N SDECFOUND,SDECRES "RTN","SDEC08",207,0) Q:+$G(SDECNOEV) "RTN","SDEC08",208,0) Q:'+$G(SDECSC) "RTN","SDEC08",209,0) S SDECFOUND=0 "RTN","SDEC08",210,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",211,0) I SDECFOUND D CANEVT3(SDECRES) Q "RTN","SDEC08",212,0) Q "RTN","SDEC08",213,0) ; "RTN","SDEC08",214,0) CANEVT1(SDECRES,SDECSTART,SDECPAT) ; "RTN","SDEC08",215,0) ;Get appointment id in SDECAPT "RTN","SDEC08",216,0) ;If found, call SDECCAN(SDECAPPT) and return 1 "RTN","SDEC08",217,0) ;else return 0 "RTN","SDEC08",218,0) N SDECFOUND,SDECAPPT "RTN","SDEC08",219,0) S SDECFOUND=0 "RTN","SDEC08",220,0) Q:'+SDECRES SDECFOUND "RTN","SDEC08",221,0) Q:'$D(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART)) SDECFOUND "RTN","SDEC08",222,0) S SDECAPPT=0 F S SDECAPPT=$O(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART,SDECAPPT)) Q:'+SDECAPPT D Q:SDECFOUND "RTN","SDEC08",223,0) . S SDECNOD=$G(^SDEC(409.84,SDECAPPT,0)) Q:SDECNOD="" "RTN","SDEC08",224,0) . I $P(SDECNOD,U,5)=SDECPAT,$P(SDECNOD,U,12)="" S SDECFOUND=1 Q "RTN","SDEC08",225,0) I SDECFOUND,+$G(SDECAPPT) D SDECCAN(SDECAPPT,,,,,,1) "RTN","SDEC08",226,0) Q SDECFOUND "RTN","SDEC08",227,0) ; "RTN","SDEC08",228,0) CANEVT3(SDECRES) ; "RTN","SDEC08",229,0) ;Call RaiseEvent to notify GUI clients "RTN","SDEC08",230,0) ; "RTN","SDEC08",231,0) Q "RTN","SDEC08",232,0) N SDECRESN "RTN","SDEC08",233,0) S SDECRESN=$G(^SDEC(409.831,SDECRES,0)) "RTN","SDEC08",234,0) Q:SDECRESN="" "RTN","SDEC08",235,0) S SDECRESN=$P(SDECRESN,"^") "RTN","SDEC08",236,0) ;D EVENT^SDEC23("SCHEDULE-"_SDECRESN,"","","") "RTN","SDEC08",237,0) ;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN) "RTN","SDEC08",238,0) Q "RTN","SDEC08",239,0) ; "RTN","SDEC08",240,0) CANCEL(BSDR) ;EP; called to cancel appt "RTN","SDEC08",241,0) ; "RTN","SDEC08",242,0) ; Make call using: S ERR=$$CANCEL^SDEC08(.ARRAY) "RTN","SDEC08",243,0) ; "RTN","SDEC08",244,0) ; Input Array - "RTN","SDEC08",245,0) ; BSDR("PAT") = ien of patient in file 2 "RTN","SDEC08",246,0) ; BSDR("CLN") = ien of clinic in file 44 "RTN","SDEC08",247,0) ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled "RTN","SDEC08",248,0) ; BSDR("ADT") = appointment date and time "RTN","SDEC08",249,0) ; BSDR("CDT") = cancel date and time "RTN","SDEC08",250,0) ; BSDR("USR") = user who canceled appt "RTN","SDEC08",251,0) ; BSDR("CR") = cancel reason - pointer to file 409.2 "RTN","SDEC08",252,0) ; BSDR("NOT") = cancel remarks - optional notes to 160 characters "RTN","SDEC08",253,0) ; "RTN","SDEC08",254,0) ;Output: error status and message "RTN","SDEC08",255,0) ; = 0 or null: everything okay "RTN","SDEC08",256,0) ; = 1^message: error and reason "RTN","SDEC08",257,0) ; "RTN","SDEC08",258,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","SDEC08",259,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","SDEC08",260,0) I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP")) "RTN","SDEC08",261,0) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds "RTN","SDEC08",262,0) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) "RTN","SDEC08",263,0) I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds "RTN","SDEC08",264,0) I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT")) "RTN","SDEC08",265,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) "RTN","SDEC08",266,0) I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) "RTN","SDEC08",267,0) ; "RTN","SDEC08",268,0) NEW IEN,DIE,DA,DR,SDMODE "RTN","SDEC08",269,0) S IEN=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) "RTN","SDEC08",270,0) I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") "RTN","SDEC08",271,0) ; "RTN","SDEC08",272,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",273,0) ; "RTN","SDEC08",274,0) ; remember before status "RTN","SDEC08",275,0) NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL "RTN","SDEC08",276,0) S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN "RTN","SDEC08",277,0) S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL "RTN","SDEC08",278,0) D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) "RTN","SDEC08",279,0) ; "RTN","SDEC08",280,0) ; get user who made appt and date appt made from ^SC "RTN","SDEC08",281,0) ; because data in ^SC will be deleted "RTN","SDEC08",282,0) NEW USER,DATE "RTN","SDEC08",283,0) S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) "RTN","SDEC08",284,0) S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) "RTN","SDEC08",285,0) ; "RTN","SDEC08",286,0) ; update file 2 info "RTN","SDEC08",287,0) NEW DIE,DA,DR "RTN","SDEC08",288,0) N SDFDA,SDIEN,SDMSG "RTN","SDEC08",289,0) S SDFDA="SDFDA(2.98,SDT_"",""_DFN_"","")" "RTN","SDEC08",290,0) S @SDFDA@(3)=BSDR("TYP") "RTN","SDEC08",291,0) S @SDFDA@(14)=BSDR("USR") "RTN","SDEC08",292,0) S @SDFDA@(15)=BSDR("CDT") "RTN","SDEC08",293,0) S:+$G(BSDR("CR")) @SDFDA@(16)=BSDR("CR") "RTN","SDEC08",294,0) S:$G(BSDR("NOT"))]"" @SDFDA@(17)=$E(BSDR("NOT"),1,160) "RTN","SDEC08",295,0) S @SDFDA@(19)=USER "RTN","SDEC08",296,0) S @SDFDA@(20)=DATE "RTN","SDEC08",297,0) D UPDATE^DIE("","SDFDA") "RTN","SDEC08",298,0) N SDPCE "RTN","SDEC08",299,0) S SDPCE=$P($G(^DPT(DFN,"S",SDT,0)),U,20) "RTN","SDEC08",300,0) D:+SDPCE EN^SDCODEL(SDPCE,0) ;remove OUTPATIENT ENCOUNTER link "RTN","SDEC08",301,0) ; "RTN","SDEC08",302,0) ; delete data in ^SC "RTN","SDEC08",303,0) NEW DIK,DA "RTN","SDEC08",304,0) S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," "RTN","SDEC08",305,0) S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN "RTN","SDEC08",306,0) D ^DIK "RTN","SDEC08",307,0) ; call event driver "RTN","SDEC08",308,0) S SDATA=SDDA_U_DFN_U_SDT_U_SDCL "RTN","SDEC08",309,0) ;D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) "RTN","SDEC08",310,0) Q 0 "RTN","SDEC08",311,0) ; "RTN","SDEC08",312,0) UNDOCANA(SDECY,SDECAPTID) ;Undo Cancel Appointment "RTN","SDEC08",313,0) ;UNDOCANA(SDECY,SDECAPTID) external parameter tag in SDEC "RTN","SDEC08",314,0) ;called by SDEC UNCANCEL APPT "RTN","SDEC08",315,0) ; SDECAPTID = ien of appointment in SDEC APPOINTMENT (^SDECAPPT) file 409.84 "RTN","SDEC08",316,0) N SDECDAM,SDECDEC,SDECI,SDECNOD,SDECPATID,SDECSTART "RTN","SDEC08",317,0) S SDECNOEV=1 ;Don't execute SDEC CANCEL APPOINTMENT protocol ;is this used? "RTN","SDEC08",318,0) ; "RTN","SDEC08",319,0) S SDECI=0 "RTN","SDEC08",320,0) K ^TMP("SDEC",$J) "RTN","SDEC08",321,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC08",322,0) S ^TMP("SDEC",$J,SDECI)="T00020ERRORID"_$C(30) "RTN","SDEC08",323,0) TSTART "RTN","SDEC08",324,0) I '+SDECAPTID TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID.") Q "RTN","SDEC08",325,0) I '$D(^SDEC(409.84,SDECAPTID,0)) TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID") Q "RTN","SDEC08",326,0) ;Make sure appointment is cancelled "RTN","SDEC08",327,0) I $$GET1^DIQ(409.84,SDECAPTID_",",.12)="" TROLLBACK D ERR(SDECI+1,"Appointment is not Cancelled.") Q "RTN","SDEC08",328,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC08",329,0) ;appts cancelled by patient cannot be un-cancelled. /* removed 9/17/2010 */ "RTN","SDEC08",330,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",331,0) ;get appointment data "RTN","SDEC08",332,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC08",333,0) S SDECDAM=$P(SDECNOD,U,9) ;date appt made "RTN","SDEC08",334,0) S SDECDEC=$P(SDECNOD,U,8) ;data entry clerk "RTN","SDEC08",335,0) S SDECLEN=$P(SDECNOD,U,18) ;length of appt in minutes "RTN","SDEC08",336,0) S SDECNOTE=$G(^SDEC(409.84,SDECAPTID,1,1,0)) ;note from SDEC APPOINTMENT "RTN","SDEC08",337,0) S SDECPATID=$P(SDECNOD,U,5) ;pointer to VA PATIENT file 2 "RTN","SDEC08",338,0) S SDECSC1=$P($G(SDECNOD),U,7) ;resource "RTN","SDEC08",339,0) S SDECSTART=$P(SDECNOD,U) ;appt start time "RTN","SDEC08",340,0) S SDECWKIN=$P($G(SDECNOD),U,13) ;walk-in "RTN","SDEC08",341,0) ;lock SDEC node "RTN","SDEC08",342,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",343,0) ;un-cancel SDEC APPOINTMENT "RTN","SDEC08",344,0) D SDECUCAN(SDECAPTID) "RTN","SDEC08",345,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",346,0) . S SDECLOC="" "RTN","SDEC08",347,0) . S SDECNOD=^SDEC(409.831,SDECSC1,0) "RTN","SDEC08",348,0) . S SDECLOC=$P(SDECNOD,U,4) ;HOSPITAL LOCATION ;support for single HOSPITAL LOCATION in SDEC RESOURCE "RTN","SDEC08",349,0) . I SDECLOC="" S SDECLOC=$$SDCL^SDECUTL(SDECAPTID) ;HOSPITAL LOCATION "RTN","SDEC08",350,0) . Q:'+SDECLOC "RTN","SDEC08",351,0) . ;un-cancel patient appointment and re-instate clinic appointment "RTN","SDEC08",352,0) . S SDECZ="" "RTN","SDEC08",353,0) . D APUCAN(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECSC1,SDECWKIN) "RTN","SDEC08",354,0) TCOMMIT "RTN","SDEC08",355,0) L -^SDEC(409.84,SDECPATID) "RTN","SDEC08",356,0) S SDECI=SDECI+1 "RTN","SDEC08",357,0) S ^TMP("SDEC",$J,SDECI)=""_$C(30) "RTN","SDEC08",358,0) S SDECI=SDECI+1 "RTN","SDEC08",359,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC08",360,0) Q "RTN","SDEC08",361,0) ; "RTN","SDEC08",362,0) SDECUCAN(SDECAPTID) ;called internally to update SDEC APPOINTMENT by clearing cancel date/time "RTN","SDEC08",363,0) N PROVIEN,SDAPTYP,SDCL,SDRES "RTN","SDEC08",364,0) S SDECIENS=SDECAPTID_"," "RTN","SDEC08",365,0) S SDECFDA(409.84,SDECIENS,.12)="" "RTN","SDEC08",366,0) K SDECMSG "RTN","SDEC08",367,0) D FILE^DIE("","SDECFDA","SDECMSG") "RTN","SDEC08",368,0) S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I") "RTN","SDEC08",369,0) I $P(SDAPTYP,";",2)="GMR(123," D "RTN","SDEC08",370,0) .S SDCL=$$SDCL^SDECUTL(SDECAPTID) "RTN","SDEC08",371,0) .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I") "RTN","SDEC08",372,0) .D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",1) "RTN","SDEC08",373,0) Q "RTN","SDEC08",374,0) ; "RTN","SDEC08",375,0) APUCAN(SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECRES,SDECWKIN) ; "RTN","SDEC08",376,0) ;un-Cancel appointment for patient SDECDFN in clinic SDECSC1 "RTN","SDEC08",377,0) ; SDECLOC = pointer to hospital location ^SC file 44 "RTN","SDEC08",378,0) ; SDECPATID = pointer to VA Patient ^DPT file 2 "RTN","SDEC08",379,0) ; SDECSTART = Appointment time "RTN","SDEC08",380,0) ; SDECDAM = Date appointment made in FM format "RTN","SDEC08",381,0) ; SDECDEC = Data entry clerk - pointer to NEW PERSON file 200 "RTN","SDEC08",382,0) N SDECC,%H "RTN","SDEC08",383,0) S SDECC("PAT")=SDECPATID "RTN","SDEC08",384,0) S SDECC("CLN")=SDECLOC "RTN","SDEC08",385,0) S SDECC("ADT")=SDECSTART "RTN","SDEC08",386,0) S SDECC("NOTE")=SDECNOTE ;user note "RTN","SDEC08",387,0) S SDECC("RES")=SDECRES "RTN","SDEC08",388,0) S SDECC("USR")=DUZ "RTN","SDEC08",389,0) S SDECC("LEN")=SDECLEN "RTN","SDEC08",390,0) S SDECC("WKIN")=SDECWKIN "RTN","SDEC08",391,0) ; "RTN","SDEC08",392,0) S SDECZ=$$UNCANCEL(.SDECC) "RTN","SDEC08",393,0) Q "RTN","SDEC08",394,0) ; "RTN","SDEC08",395,0) UNCANCEL(BSDR) ;PEP; called to un-cancel appt "RTN","SDEC08",396,0) ; "RTN","SDEC08",397,0) ; Make call using: S ERR=$$UNCANCEL(.ARRAY) "RTN","SDEC08",398,0) ; "RTN","SDEC08",399,0) ; Input Array - "RTN","SDEC08",400,0) ; BSDR("PAT") = ien of patient in file 2 "RTN","SDEC08",401,0) ; BSDR("CLN") = ien of clinic in file 44 "RTN","SDEC08",402,0) ; BSDR("ADT") = appointment date and time "RTN","SDEC08",403,0) ; BSDR("USR") = user who un-canceled appt "RTN","SDEC08",404,0) ; BSDR("NOTE") = appointment note from SDEC APPOINTMENT "RTN","SDEC08",405,0) ; BSDR("LEN") = appt length in minutes (numeric) "RTN","SDEC08",406,0) ; BSDR("RES") = resource "RTN","SDEC08",407,0) ; BSDR("WKIN")= walk-in "RTN","SDEC08",408,0) ; "RTN","SDEC08",409,0) ;Output: error status and message "RTN","SDEC08",410,0) ; = 0 or null: everything okay "RTN","SDEC08",411,0) ; = 1^message: error and reason "RTN","SDEC08",412,0) ; "RTN","SDEC08",413,0) N DPTNOD,DPTNODR "RTN","SDEC08",414,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","SDEC08",415,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","SDEC08",416,0) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds "RTN","SDEC08",417,0) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) "RTN","SDEC08",418,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) "RTN","SDEC08",419,0) ; "RTN","SDEC08",420,0) S SDECERR=$$APPVISTA^SDEC07(BSDR("LEN"),BSDR("NOTE"),BSDR("PAT"),BSDR("RES"),BSDR("ADT"),BSDR("WKIN"),BSDR("CLN")) "RTN","SDEC08",421,0) Q SDECERR "RTN","SDEC08",422,0) ; "RTN","SDEC08",423,0) ERR(SDECI,SDECERR) ;Error processing "RTN","SDEC08",424,0) S SDECI=SDECI+1 "RTN","SDEC08",425,0) S SDECERR=$TR(SDECERR,"^","~") "RTN","SDEC08",426,0) TROLLBACK "RTN","SDEC08",427,0) S ^TMP("SDEC",$J,SDECI)=SDECERR_$C(30) "RTN","SDEC08",428,0) S SDECI=SDECI+1 "RTN","SDEC08",429,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC08",430,0) Q "RTN","SDEC08",431,0) ; "RTN","SDEC08",432,0) ETRAP ;EP Error trap entry "RTN","SDEC08",433,0) D ^%ZTER "RTN","SDEC08",434,0) I '$D(SDECI) N SDECI S SDECI=999999 "RTN","SDEC08",435,0) S SDECI=SDECI+1 "RTN","SDEC08",436,0) D ERR(SDECI,"SDEC08 Error") "RTN","SDEC08",437,0) Q "RTN","SDEC51") 0^1^B148461955^B122637073 "RTN","SDEC51",1,0) SDEC51 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 19, 2016 "RTN","SDEC51",2,0) ;;5.3;Scheduling;**627,642,651**;Aug 13, 1993;Build 14 "RTN","SDEC51",3,0) ; "RTN","SDEC51",4,0) ;Reference is made to ICR's #4837, #4557, #6185, and #6186 "RTN","SDEC51",5,0) Q "RTN","SDEC51",6,0) ; "RTN","SDEC51",7,0) REQGET(SDECY,SDBEG,SDEND,MAXREC,LASTSUB,SDGMR) ; GET entries that are not SCHEDULED. "RTN","SDEC51",8,0) REQGETA ; "RTN","SDEC51",9,0) N PADDRES1,PADDRES2,PADDRES3,PCITY,PSTATE,PCOUNTRY,PTPHONE,PZIP4 "RTN","SDEC51",10,0) N SDECI,SDI,SDJ,SDREASON,SDREC,SDRECL,SDRPA,SDRPA0,SDTMP,SDWP,X,Y,%DT "RTN","SDEC51",11,0) N SDCNT,SDCAN,SDCDC,SDCANF,SDCSTOP,SDSCHED,SDSCHEDF,SDSENS,SDSTAT,SDSTATF,SDDONE "RTN","SDEC51",12,0) N DIC,ELIGIEN,ELIGNAME,GAF,PRIGRP,SVCCONN,SVCCONNP,TYPEIEN,TYPENAME "RTN","SDEC51",13,0) N SDDEMO,SDNOCHK,SDSUB "RTN","SDEC51",14,0) N DOB,GENDER,HRN,INSTIEN,INSTNAME,NAME,SSN,SVVCCONN "RTN","SDEC51",15,0) S (SDNOCHK,SDSUB)="" "RTN","SDEC51",16,0) S SDECI=0 "RTN","SDEC51",17,0) K ^TMP("SDEC",$J) "RTN","SDEC51",18,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC51",19,0) ; data header "RTN","SDEC51",20,0) D HDR "RTN","SDEC51",21,0) S (SDCANF,SDSCHEDF)=0 "RTN","SDEC51",22,0) S SDREC=$$GETIEN("RECEIVED") "RTN","SDEC51",23,0) I SDREC="" D ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of RECEIVED.",.SDECI,SDECY) Q "RTN","SDEC51",24,0) S SDSCHED=$$GETIEN("SCHEDULED") "RTN","SDEC51",25,0) I SDSCHED="" D ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of SCHEDULED.",.SDECI,SDECY) Q "RTN","SDEC51",26,0) S SDSTAT=$$GETIEN("STATUS CHANGE") "RTN","SDEC51",27,0) S SDCAN=$$GETIEN("CANCELLED") "RTN","SDEC51",28,0) S SDDONE=$$GETIEN("COMPLETE/UPDATE") "RTN","SDEC51",29,0) S SDCDC=$$GETIEN("DISCONTINUED") "RTN","SDEC51",30,0) ;validate SDBEG (optional) "RTN","SDEC51",31,0) S SDBEG=$G(SDBEG) "RTN","SDEC51",32,0) I $G(SDBEG)'="" S %DT="" S X=$P($G(SDBEG),"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-1825) "RTN","SDEC51",33,0) I $G(SDBEG)="" S SDBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-1825) "RTN","SDEC51",34,0) ;validate SDEND (optional) "RTN","SDEC51",35,0) S SDEND=$G(SDEND) "RTN","SDEC51",36,0) I SDEND'="" S %DT="" S X=$P($G(SDEND),"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-90) "RTN","SDEC51",37,0) I SDEND="" S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-90) "RTN","SDEC51",38,0) ;validate SDGMR (optional) "RTN","SDEC51",39,0) S SDGMR=$G(SDGMR) "RTN","SDEC51",40,0) I SDGMR'="" I '$D(^GMR(123,+SDGMR,0)) D ERR1^SDECERR(-1,"Invalid Request/Consultation ID.",.SDECI,SDECY) Q ;ICR 4837 "RTN","SDEC51",41,0) I SDGMR'="" S SDNOCHK=1 D REQGET1 G REQX "RTN","SDEC51",42,0) ;validate MAXREC (optional) "RTN","SDEC51",43,0) S MAXREC=+$G(MAXREC) "RTN","SDEC51",44,0) I 'MAXREC S MAXREC=9999999 "RTN","SDEC51",45,0) ;validate LASTSUB (optional) "RTN","SDEC51",46,0) S LASTSUB=$G(LASTSUB) "RTN","SDEC51",47,0) S SDCNT=0 "RTN","SDEC51",48,0) S SDJ=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1),1:(SDBEG-1)_".2359") "RTN","SDEC51",49,0) ;ICR 6185 allows use of "AG" xref "RTN","SDEC51",50,0) F S SDJ=$O(^GMR(123,"AG",SDJ)) Q:SDJ'>0 Q:$P(SDJ,".",1)>SDEND D I SDECI>(MAXREC-1) S SDSUB=SDJ_"|"_$S(SDGMR>0:SDGMR,1:"") Q "RTN","SDEC51",51,0) .S SDGMR=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2),1:0),LASTSUB="" F S SDGMR=$O(^GMR(123,"AG",SDJ,SDGMR)) Q:SDGMR'>0 D Q:SDECI>(MAXREC-1) "RTN","SDEC51",52,0) ..D REQGET1 "RTN","SDEC51",53,0) REQX ; "RTN","SDEC51",54,0) S SDTMP=@SDECY@(SDECI) S SDTMP=$P(SDTMP,$C(30),1) "RTN","SDEC51",55,0) S:$G(SDSUB)'="" $P(SDTMP,U,40)=SDSUB "RTN","SDEC51",56,0) S @SDECY@(SDECI)=SDTMP_$C(30,31) "RTN","SDEC51",57,0) Q "RTN","SDEC51",58,0) HDR ;Get the header information "RTN","SDEC51",59,0) ; 1 2 3 4 "RTN","SDEC51",60,0) S SDTMP="T00020CONSULTIEN^T00020ORIGDT^T00020DFN^T00030NAME" "RTN","SDEC51",61,0) ; 5 6 7 8 9 "RTN","SDEC51",62,0) S SDTMP=SDTMP_"^T00030TO_SERVICE^T00010CLINIEN^T00030CLINNAME^T00030DATE_OF_REQUEST^T00030PRIO" "RTN","SDEC51",63,0) ; 10 11 12 13 "RTN","SDEC51",64,0) S SDTMP=SDTMP_"^T00030USERIEN^T00030USERNAME^T00030PROVIEN^T00030PROVNAME" "RTN","SDEC51",65,0) ; 14 15 16 17 "RTN","SDEC51",66,0) S SDTMP=SDTMP_"^T00030REQUEST_TYPE^T00030SERVICE_RENDERED_AS^T00100COMM^T00500REQ_PROC_ACT" "RTN","SDEC51",67,0) ; 18 19 20 21 22 23 "RTN","SDEC51",68,0) S SDTMP=SDTMP_"^T00030HRN^T00030DOB^T00030SSN^T00030GENDER^T00030INSTIEN^T00030INSTNAME" "RTN","SDEC51",69,0) ; 24 25 26 27 28 "RTN","SDEC51",70,0) S SDTMP=SDTMP_"^T00030PRIGRP^T00030ELIGIEN^T00030ELIGNAME^T00030SVCCONN^T00030SVCCONNP" "RTN","SDEC51",71,0) ; 29 30 31 32 33 "RTN","SDEC51",72,0) S SDTMP=SDTMP_"^T00030TYPEIEN^T00030TYPENAME^T00030PADDRES1^T00030PADDRES2^T00030PADDRES3" "RTN","SDEC51",73,0) ; 34 35 36 37 38 39 40 "RTN","SDEC51",74,0) S SDTMP=SDTMP_"^T00030PCITY^T00030PSTATE^T00030PCOUNTRY^T00030PZIP4^T00030GAF^T00100SENSITIVE^T00030LASTSUB" "RTN","SDEC51",75,0) ; 41 42 43 44 45 46 47 "RTN","SDEC51",76,0) S SDTMP=SDTMP_"^T00100STOP^T00030PTPHONE^T00030URGENCY^T00030PRACE^T00030PRACEN^T00030PETH^T00030PETHN" "RTN","SDEC51",77,0) ; 48 49 "RTN","SDEC51",78,0) S SDTMP=SDTMP_"^T00030PRHBLOC^T00030EARLIEST" "RTN","SDEC51",79,0) S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDEC51",80,0) Q "RTN","SDEC51",81,0) GETONE(SDECY,SDGMR) ;Get one specific consult "RTN","SDEC51",82,0) ; 1 2 3 4 "RTN","SDEC51",83,0) N PADDRES1,PADDRES2,PADDRES3,PCITY,PSTATE,PCOUNTRY,PZIP4 "RTN","SDEC51",84,0) N SDECI,SDI,SDJ,SDREASON,SDREC,SDRECL,SDRPA,SDRPA0,SDTMP,SDWP,X,Y,%DT "RTN","SDEC51",85,0) N SDCNT,SDCAN,SDCDC,SDCANF,SDCSTOP,SDSCHED,SDSCHEDF,SDSENS,SDSTAT,SDSTATF,SDDONE "RTN","SDEC51",86,0) N ELIGIEN,ELIGNAME,GAF,PRIGRP,SVCCONN,SVCCONNP,TYPEIEN,TYPENAME "RTN","SDEC51",87,0) N SDDEMO,SDSUB "RTN","SDEC51",88,0) N DOB,GENDER,HRN,INSTIEN,INSTNAME,NAME,SSN,SVVCCONN "RTN","SDEC51",89,0) N PRACE,PRACEN,PETH,PETHN "RTN","SDEC51",90,0) S SDSUB="" "RTN","SDEC51",91,0) S SDECI=0 "RTN","SDEC51",92,0) K ^TMP("SDEC",$J) "RTN","SDEC51",93,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC51",94,0) D HDR "RTN","SDEC51",95,0) S (SDCANF,SDSCHEDF)=0 "RTN","SDEC51",96,0) S SDREC=$$GETIEN("RECEIVED") "RTN","SDEC51",97,0) I SDREC="" D ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of RECEIVED.",.SDECI,SDECY) Q "RTN","SDEC51",98,0) S SDSCHED=$$GETIEN("SCHEDULED") "RTN","SDEC51",99,0) I SDSCHED="" D ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of SCHEDULED.",.SDECI,SDECY) Q "RTN","SDEC51",100,0) S SDSTAT=$$GETIEN("STATUS CHANGE") "RTN","SDEC51",101,0) S SDCAN=$$GETIEN("CANCELLED") "RTN","SDEC51",102,0) S SDDONE=$$GETIEN("COMPLETE/UPDATE") "RTN","SDEC51",103,0) S SDCDC=$$GETIEN("DISCONTINUED") "RTN","SDEC51",104,0) D REQGET1 "RTN","SDEC51",105,0) Q "RTN","SDEC51",106,0) REQGET1 ; "RTN","SDEC51",107,0) N SDCL,SDGMR0,SDDATA,SDSER,SDSTOP,SIEN,STOP,IN,PRHBLOC "RTN","SDEC51",108,0) N PRIO "RTN","SDEC51",109,0) S SDRECL="",SDSTOP="" "RTN","SDEC51",110,0) S (SDCANF,SDSCHEDF,SDSTATF)=0 "RTN","SDEC51",111,0) S SDCL=$P($G(^GMR(123,+SDGMR,0)),U,6) ;ICR 4837 "RTN","SDEC51",112,0) I SDCL'="",$$GET1^DIQ(44,SDCL_",",50.01,"I")=1 Q ;check OOS? "RTN","SDEC51",113,0) S PRHBLOC=$S($$GET1^DIQ(44,+SDCL_",",2500,"I")="Y":1,1:0) "RTN","SDEC51",114,0) S SDGMR0=$G(^GMR(123,SDGMR,0)) ;ICR 4837 states 'Zero node read into variable' "RTN","SDEC51",115,0) S IN=$P(SDGMR0,U,18) ;$$GET1^DIQ(123,SDGMR_",",14) "RTN","SDEC51",116,0) ;Q:IN="inpatient" ;Inpatient consults do not have appointments "RTN","SDEC51",117,0) S SDSER=$P(SDGMR0,U,5) "RTN","SDEC51",118,0) I +SDSER D "RTN","SDEC51",119,0) .S SIEN=0 F S SIEN=$O(^GMR(123.5,SDSER,688,SIEN)) Q:'+SIEN D "RTN","SDEC51",120,0) ..S STOP=$G(^GMR(123.5,SDSER,688,SIEN,0)) ;ICR 4557 "RTN","SDEC51",121,0) ..I SDSTOP="" S SDSTOP=STOP "RTN","SDEC51",122,0) ..E S SDSTOP=SDSTOP_"|"_STOP "RTN","SDEC51",123,0) S DFN=$$GET1^DIQ(123,SDGMR_",",.02,"I") "RTN","SDEC51",124,0) Q:DFN="" "RTN","SDEC51",125,0) ; "RTN","SDEC51",126,0) I '$G(SDNOCHK) Q:$$REQCHK(.SDRECL,SDGMR,DFN) "RTN","SDEC51",127,0) ; "RTN","SDEC51",128,0) ;Q:SDCANF "RTN","SDEC51",129,0) ;Q:SDSCHEDF "RTN","SDEC51",130,0) I 1 D "RTN","SDEC51",131,0) .;get REASON FOR REQUEST wp text "RTN","SDEC51",132,0) .K SDWP "RTN","SDEC51",133,0) .S X=$$GET1^DIQ(123,SDGMR_",",20,"","SDWP") "RTN","SDEC51",134,0) .;S SDREASON="" "RTN","SDEC51",135,0) .;I $D(SDWP) S SDI="" F S SDI=$O(SDWP(SDI)) Q:SDI="" S SDREASON=$S(SDREASON'="":SDREASON_$C(13,10),1:"")_$TR(SDWP(SDI),"^") Q "RTN","SDEC51",136,0) .;collect demographics "RTN","SDEC51",137,0) .D PDEMO^SDECU2(.SDDEMO,DFN) "RTN","SDEC51",138,0) .S NAME=SDDEMO("NAME") "RTN","SDEC51",139,0) .S DOB=SDDEMO("DOB") "RTN","SDEC51",140,0) .S GENDER=SDDEMO("GENDER") "RTN","SDEC51",141,0) .S HRN=SDDEMO("HRN") "RTN","SDEC51",142,0) .S SSN=SDDEMO("SSN") "RTN","SDEC51",143,0) .S INSTIEN=SDDEMO("INSTIEN") "RTN","SDEC51",144,0) .S INSTNAME=SDDEMO("INSTNAME") "RTN","SDEC51",145,0) .S PRIGRP=SDDEMO("PRIGRP") ;24 "RTN","SDEC51",146,0) .S ELIGIEN=SDDEMO("ELIGIEN") ;25 "RTN","SDEC51",147,0) .S ELIGNAME=SDDEMO("ELIGNAME") ;26 "RTN","SDEC51",148,0) .S SVVCCONN=SDDEMO("SVCCONN") ;27 "RTN","SDEC51",149,0) .S SVCCONNP=SDDEMO("SVCCONNP") ;28 "RTN","SDEC51",150,0) .S TYPEIEN=SDDEMO("TYPEIEN") ;29 "RTN","SDEC51",151,0) .S TYPENAME=SDDEMO("TYPENAME") ;30 "RTN","SDEC51",152,0) .S PADDRES1=SDDEMO("PADDRES1") ;31 - Patient Address line 1 "RTN","SDEC51",153,0) .S PADDRES2=SDDEMO("PADDRES2") ;32 - Patient Address line 2 "RTN","SDEC51",154,0) .S PADDRES3=SDDEMO("PADDRES3") ;33 - Patient Address line 3 "RTN","SDEC51",155,0) .S PCITY=SDDEMO("PCITY") ;34 - Patient City "RTN","SDEC51",156,0) .S PSTATE=SDDEMO("PSTATE") ;35 - Patient state name "RTN","SDEC51",157,0) .S PCOUNTRY=SDDEMO("PCOUNTRY") ;36 - Patient country name "RTN","SDEC51",158,0) .S PZIP4=SDDEMO("PZIP+4") ;37 - Patient Zip+4 "RTN","SDEC51",159,0) .S PTPHONE=SDDEMO("HPHONE") ;42 - Patient phone "RTN","SDEC51",160,0) .S GAF=$$GAF^SDECU2(DFN) ;38 "RTN","SDEC51",161,0) .S SDSENS=$$PTSEC^SDECUTL(DFN) ;39 "RTN","SDEC51",162,0) .D RACELST^SDECU2(DFN,.PRACE,.PRACEN) "RTN","SDEC51",163,0) .D ETH^SDECU2(DFN,.PETH,.PETHN) ;get ethnicity "RTN","SDEC51",164,0) .S PRIO=$$PRIO(SDGMR) "RTN","SDEC51",165,0) .; 1 2 3 4 "RTN","SDEC51",166,0) .S SDTMP=SDGMR_"^"_$$GET1^DIQ(123,SDGMR_",",.01,"I")_"^"_$P(SDGMR0,U,2)_"^"_$$GET1^DIQ(123,SDGMR_",",.02) "RTN","SDEC51",167,0) .; 5 6 7 8 "RTN","SDEC51",168,0) .S SDTMP=SDTMP_"^"_$$GET1^DIQ(123,SDGMR_",",1)_"^"_$$GET1^DIQ(123,SDGMR_",",2,"I")_"^"_$$GET1^DIQ(123,SDGMR_",",2)_"^"_$$GET1^DIQ(123,SDGMR_",",3,"I") "RTN","SDEC51",169,0) .; 9 10 11 12 "RTN","SDEC51",170,0) .S SDTMP=SDTMP_"^"_PRIO_"^"_$$GET1^DIQ(123,SDGMR_",",7,"I")_"^"_$$GET1^DIQ(123,SDGMR_",",7)_"^"_$P(SDGMR0,U,14) "RTN","SDEC51",171,0) .; 13 14 15 "RTN","SDEC51",172,0) .S SDTMP=SDTMP_"^"_$$GET1^DIQ(123,SDGMR_",",10)_"^"_$$GET1^DIQ(123,SDGMR_",",13)_"^"_$$GET1^DIQ(123,SDGMR_",",14) "RTN","SDEC51",173,0) .; 16 17 "RTN","SDEC51",174,0) .S SDTMP=SDTMP_"^"_""_"^"_SDRECL "RTN","SDEC51",175,0) .; 18 19 20 21 22 23 "RTN","SDEC51",176,0) .S SDTMP=SDTMP_U_""_U_DOB_U_SSN_U_GENDER_U_INSTIEN_U_INSTNAME ;23 "RTN","SDEC51",177,0) .; 24 25 26 27 28 "RTN","SDEC51",178,0) .S SDTMP=SDTMP_U_PRIGRP_U_ELIGIEN_U_ELIGNAME_U_SVVCCONN_U_SVCCONNP ;28 "RTN","SDEC51",179,0) .; 29 30 31 32 33 "RTN","SDEC51",180,0) .S SDTMP=SDTMP_U_TYPEIEN_U_TYPENAME_U_PADDRES1_U_PADDRES2_U_PADDRES3 ;33 "RTN","SDEC51",181,0) .; 34 35 36 37 38 39 "RTN","SDEC51",182,0) .S SDTMP=SDTMP_U_PCITY_U_PSTATE_U_PCOUNTRY_U_PZIP4_U_GAF_U_SDSENS ;39 "RTN","SDEC51",183,0) .S SDTMP=SDTMP_U_U_SDSTOP_U_PTPHONE_U_$$GET1^DIQ(123,SDGMR_",",5,"I") ;save the 40th position for LASTSUB if it is to be returned "RTN","SDEC51",184,0) .S SDTMP=SDTMP_U_PRACE_U_PRACEN_U_PETH_U_PETHN_U_PRHBLOC_U_$$GET1^DIQ(123,SDGMR_",",17,"I") ;49 "RTN","SDEC51",185,0) .S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDEC51",186,0) Q "RTN","SDEC51",187,0) ; "RTN","SDEC51",188,0) PRIO(SDGMR) ; "RTN","SDEC51",189,0) N FED,PRIO,PRIO1,SDED "RTN","SDEC51",190,0) S PRIO="" "RTN","SDEC51",191,0) S SDED=$P($$GET1^DIQ(123,SDGMR_",",17,"I"),".",1) ;earliest date ;ICR 6185 "RTN","SDEC51",192,0) S FED=$P($$GET1^DIQ(123,SDGMR_",",.01,"I"),".",1) ;file entry date ;ICR 4837 "RTN","SDEC51",193,0) S PRIO1=$$GET1^DIQ(123,SDGMR_",",5) ;urgency text ;ICR 4837 "RTN","SDEC51",194,0) I SDED="" S PRIO=PRIO1 ;2.6.17.2 - use URGENCY text if EARLIEST DATE is null "RTN","SDEC51",195,0) I (PRIO=""),(FED="")!(SDED'=FED) S PRIO=SDED ;2.6.17.1 - use EARLIEST DATE if not = FILE ENTRY DATE "RTN","SDEC51",196,0) I (PRIO=""),((PRIO1["STAT")!(PRIO1["NEXT AVAILABLE")!(PRIO1["EMERGENCY")!(PRIO1["TODAY")) S PRIO=SDED ;2.6.17.3 "RTN","SDEC51",197,0) S:PRIO="" PRIO=PRIO1 ;2.6.17.3 "RTN","SDEC51",198,0) Q PRIO "RTN","SDEC51",199,0) ; "RTN","SDEC51",200,0) REQCHK(SDRECL,SDGMR,DFN) ; "RTN","SDEC51",201,0) N CPRSTAT,X,X1,X2 ;alb/sat 651 "RTN","SDEC51",202,0) N SDCAN,SDCANF,SDCDC,SDDONE,SDES,SDESF,SDFD,SDPDC,SDRPA,SDRPA0,SDSCHED,SDSCHEDF,SDSER,SDSTAT,SDSTATF "RTN","SDEC51",203,0) N SDNOS ;alb/sat 651 "RTN","SDEC51",204,0) S SDPDC=$O(^ORD(100.01,"B","DISCONTINUED",0)) "RTN","SDEC51",205,0) S CPRSTAT=$$GET1^DIQ(123,SDGMR_",",8,"I") ;alb/sat 651 - set new CPRSTAT var "RTN","SDEC51",206,0) Q:CPRSTAT=SDPDC 1 ;don't return this entry if CPRS STATUS is DISCONTINUED ;alb/sat 651 - use CPRSTAT instead of GET1^DIQ "RTN","SDEC51",207,0) S SDFD=$P($$GET1^DIQ(123,SDGMR_",",.01,"I"),".",1) ;alb/sat 651 - get FILE ENTRY DATE "RTN","SDEC51",208,0) Q:$$FMADD^XLFDT(DT,-365)>SDFD 1 ;alb/sat 651 - do not include records with FILE ENTRY DATE older than 1 year "RTN","SDEC51",209,0) S SDSCHED=$$GETIEN("SCHEDULED") ;$O(^GMR(123.1,"B","SCHEDULED",0)) "RTN","SDEC51",210,0) S SDSTAT=$$GETIEN("STATUS CHANGE") ;$O(^GMR(123.1,"B","STATUS CHANGE",0)) "RTN","SDEC51",211,0) S SDCAN=$$GETIEN("CANCELLED") ;$O(^GMR(123.1,"B","CANCELLED",0)) "RTN","SDEC51",212,0) S SDDONE=$$GETIEN("COMPLETE/UPDATE") ;$O(^GMR(123.1,"B","COMPLETE/UPDATE",0)) "RTN","SDEC51",213,0) S SDCDC=$$GETIEN("DISCONTINUED") ;$O(^GMR(123.1,"B","DISCONTINUED",0)) "RTN","SDEC51",214,0) S SDES=$$GETIEN("EDIT/RESUBMITTED") "RTN","SDEC51",215,0) S SDSER=$$GET1^DIQ(123,SDGMR_",",1,"I") ;ICR 6185 "RTN","SDEC51",216,0) S DFN=$G(DFN) I '+DFN S DFN=$$GET1^DIQ(123,SDGMR_",",.02,"I") ;ICR 6185 "RTN","SDEC51",217,0) S SDRECL=$G(SDRECL) "RTN","SDEC51",218,0) S (SDCANF,SDESF,SDSCHEDF,SDSTATF)=0 "RTN","SDEC51",219,0) ;alb/sat 651 - start modification "RTN","SDEC51",220,0) I CPRSTAT=13 D G REQCHKX ;cancel/no-show ;13 is cancel - see A+7^SDCNSLT SD*5.3*627 "RTN","SDEC51",221,0) .S SDCANF=1 "RTN","SDEC51",222,0) .S SDNOS=$O(^GMR(123,SDGMR,40,":"),-1) Q:'+SDNOS ;ICR 6185 "RTN","SDEC51",223,0) .S SDNOS=$O(^GMR(123,SDGMR,40,SDNOS),-1) Q:'+SDNOS "RTN","SDEC51",224,0) .S X2=$P($G(^GMR(123,SDGMR,40,SDNOS,0)),U),X1=DT D ^%DTC Q:X'=""&(X>180) ;ICR 6185 "RTN","SDEC51",225,0) .I $$FINDTXT(SDGMR,SDNOS,"no-show") D "RTN","SDEC51",226,0) ..S SDCANF=0 "RTN","SDEC51",227,0) ..S:$L($G(SDRECL))<225 SDRECL=SDNOS_";;"_$$GET1^DIQ(123.02,SDNOS_","_SDGMR_",",.01,"E")_";;"_SDCAN_$S(SDRECL'="":"|"_SDRECL,1:"") "RTN","SDEC51",228,0) ;alb/sat 651 - end modification "RTN","SDEC51",229,0) S SDRPA=9999999 F S SDRPA=$O(^GMR(123,SDGMR,40,SDRPA),-1) Q:SDRPA'>0 D Q:SDCANF=1 Q:SDSCHEDF=1 Q:SDESF=1 ;ICR 6185 "RTN","SDEC51",230,0) .K SDDATA "RTN","SDEC51",231,0) .D GETS^DIQ(123.02,SDRPA_","_SDGMR_",",".01;1;2;4","IE","SDDATA") ;ICR 6185 "RTN","SDEC51",232,0) .S SDRPA0=SDDATA(123.02,SDRPA_","_SDGMR_",",1,"I") ; $G(^GMR(123,SDGMR,40,SDRPA,0)) "RTN","SDEC51",233,0) .I SDRPA0'=SDSCHED,SDRPA0'=SDSTAT,SDRPA0'=SDCAN,SDRPA0'=SDDONE,SDRPA0'=SDCDC,SDRPA0'=SDES Q ;SDRECL is getting too long; only watch the ones we need "RTN","SDEC51",234,0) .I (SDRPA0=SDCAN)!(SDRPA0=SDDONE)!(SDRPA0=SDCDC) S SDCANF=1 Q ;skip completed consults/mgh "RTN","SDEC51",235,0) .I SDRPA0=SDES S SDESF=1 Q "RTN","SDEC51",236,0) .I SDRPA0=SDSCHED,SDSTATF'=1,$$SDCHED(DFN,SDDATA(123.02,SDRPA_","_SDGMR_",",2,"I"),SDSER) S SDSCHEDF=1 Q "RTN","SDEC51",237,0) .I SDRPA0=SDSTAT,$$FINDTXT(SDGMR,SDRPA) S SDSTATF=1 "RTN","SDEC51",238,0) .S:$L($G(SDRECL))<225 SDRECL=SDRPA_";;"_SDDATA(123.02,SDRPA_","_SDGMR_",",.01,"E")_";;"_SDRPA0_$S(SDRECL'="":"|"_SDRECL,1:"") "RTN","SDEC51",239,0) REQCHKX ; exit ;alb/sat 651 - add REQCHKX tag "RTN","SDEC51",240,0) K SDDATA "RTN","SDEC51",241,0) Q:SDSCHEDF SDSCHEDF "RTN","SDEC51",242,0) Q:SDCANF SDCANF "RTN","SDEC51",243,0) Q:SDESF 0 "RTN","SDEC51",244,0) Q 0 "RTN","SDEC51",245,0) ; "RTN","SDEC51",246,0) GETIEN(NAME) ;get ID from REQUEST ACTION TYPES file 123.1 ;ICR 6186 "RTN","SDEC51",247,0) N DIC "RTN","SDEC51",248,0) S DIC=123.1 "RTN","SDEC51",249,0) S DIC(0)="BO" "RTN","SDEC51",250,0) S X=NAME "RTN","SDEC51",251,0) D ^DIC "RTN","SDEC51",252,0) I Y=-1 Q "" "RTN","SDEC51",253,0) Q $P(Y,U,1) "RTN","SDEC51",254,0) ; "RTN","SDEC51",255,0) SDCHED(DFN,SDACTDT,SDTSVC) ;look for appointment with stop code for REQUEST SERVICES "RTN","SDEC51",256,0) ;INPUT: "RTN","SDEC51",257,0) ; DFN - patient ID pointer to PATIENT file "RTN","SDEC51",258,0) ; SDACTDT - actual activity date in FM format "RTN","SDEC51",259,0) ; SDTSVC - request services ID pointer to REQUEST SERVICES file 123.5 "RTN","SDEC51",260,0) ;RETURN: "RTN","SDEC51",261,0) ; 0 = no appointment found with matching stop code "RTN","SDEC51",262,0) ; 1 = appointment found with matching stop code "RTN","SDEC51",263,0) ;Q 1 ;do not check for match for now "RTN","SDEC51",264,0) N SDCL,SDI,SDRET,SDSTP,SDSTPL "RTN","SDEC51",265,0) S SDRET=0 "RTN","SDEC51",266,0) S SDTSVC=$G(SDTSVC) "RTN","SDEC51",267,0) Q:SDTSVC="" 0 "RTN","SDEC51",268,0) S SDACTDT=$P($G(SDACTDT),".",1) "RTN","SDEC51",269,0) I SDACTDT'?7N S SDACTDT=1000103 "RTN","SDEC51",270,0) S SDI=0 F S SDI=$O(^GMR(123.5,SDTSVC,688,SDI)) Q:SDI'>0 D Q:SDRET=1 "RTN","SDEC51",271,0) .S SDSTPL(+$P($G(^GMR(123.5,SDTSVC,688,SDI,0)),U,1))="" ;ICR 4557 "RTN","SDEC51",272,0) S SDI=$$FMADD^XLFDT(SDACTDT,-2) F S SDI=$O(^DPT(DFN,"S",SDI)) Q:SDI'>0 D "RTN","SDEC51",273,0) .S SDCL=$$GET1^DIQ(2.98,SDI_","_DFN_",",.01,"I") "RTN","SDEC51",274,0) .S SDSTP=$$GET1^DIQ(44,SDCL_",",8,"I") "RTN","SDEC51",275,0) .I $$GET1^DIQ(2.98,SDI_","_DFN_",",15,"I")="",$D(SDSTPL(+SDSTP)) S SDRET=1 ;alb/sat 651 "RTN","SDEC51",276,0) Q SDRET "RTN","SDEC51",277,0) ; "RTN","SDEC51",278,0) FINDTXT(SDGMR,SDRPA,SDTXT) ;find text in word processing field "RTN","SDEC51",279,0) ;INPUT: "RTN","SDEC51",280,0) ; SDGMR - Pointer to REQUEST/CONSULTATION file "RTN","SDEC51",281,0) ; SDRPA - Pointer to REQUEST PROCESSING ACTIVITY in REQUEST/CONSULTATION file "RTN","SDEC51",282,0) ;RETURN: "RTN","SDEC51",283,0) ; 1=Text Fount; 0=Not Found "RTN","SDEC51",284,0) N SDI,SDJ,SDLINE,SDMSG,SDPREV,SDRET,SDTHIS,SDWP,X ;alb/sat 651 add SDLINE "RTN","SDEC51",285,0) S (SDTHIS,SDPREV)="" "RTN","SDEC51",286,0) S SDRET=0 "RTN","SDEC51",287,0) S SDTXT=$G(SDTXT) S:SDTXT'="" SDTXT=$$UP^XLFSTR(SDTXT) ;alb/sat 651 "RTN","SDEC51",288,0) K SDWP S X=$$GET1^DIQ(123.02,SDRPA_","_SDGMR_",",5,"","SDWP","SDMSG") ;ICR 6185 "RTN","SDEC51",289,0) S SDI=0 F S SDI=$O(SDWP(SDI)) Q:SDI="" D Q:SDRET=1 "RTN","SDEC51",290,0) .S SDTHIS=SDWP(SDI) "RTN","SDEC51",291,0) .;alb/sat 651 begin modification "RTN","SDEC51",292,0) .;I $$UP^XLFSTR(SDPREV_SDTHIS)[SDTXT S SDRET=1 "RTN","SDEC51",293,0) .S SDLINE=$$UP^XLFSTR(SDPREV_SDTHIS) "RTN","SDEC51",294,0) .I SDTXT'="" S:SDLINE[SDTXT SDRET=1 Q "RTN","SDEC51",295,0) .F SDJ=1:1 S SDTXT=$P($T(SDTXT+SDJ),";;",2) Q:SDTXT="" D Q:SDRET=1 "RTN","SDEC51",296,0) ..S:SDLINE[SDTXT SDRET=1 "RTN","SDEC51",297,0) .;alb/sat 651 end modification "RTN","SDEC51",298,0) .S SDPREV=SDTHIS "RTN","SDEC51",299,0) Q SDRET "RTN","SDEC51",300,0) ; "RTN","SDEC51",301,0) ;alb/sat 651 "RTN","SDEC51",302,0) SDTXT ; "RTN","SDEC51",303,0) ;;CANCEL "RTN","SDEC51",304,0) ;;NOSHOW "RTN","SDEC51",305,0) ;;NO-SHOW "RTN","SDEC51",306,0) ;;NO SHOW "RTN","SDEC51",307,0) ; "RTN","SDEC52") 0^9^B144746730^B135366085 "RTN","SDEC52",1,0) SDEC52 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 19, 2016 "RTN","SDEC52",2,0) ;;5.3;Scheduling;**627,642,651**;Aug 13, 1993;Build 14 "RTN","SDEC52",3,0) ; "RTN","SDEC52",4,0) Q "RTN","SDEC52",5,0) ; "RTN","SDEC52",6,0) RECGET(SDECY,DFN,SDBEG,SDEND,MAXREC,LASTSUB,RECIEN,SDSTOP,SDFLAGS) ; GET entries from the RECALL REMINDERS file 403.5 for a given Patient and Recall Date range. "RTN","SDEC52",7,0) RECGETA ; "RTN","SDEC52",8,0) ;RECGET(SDECY,DFN,SDBEG,SDEND,MAXREC,LASTSUB,RECIEN,SDSTOP) external parameter tag is in SDEC "RTN","SDEC52",9,0) ;INPUT: "RTN","SDEC52",10,0) ; DFN = (optional) pointer to PATIENT file 2; returns all data if null "RTN","SDEC52",11,0) ; SDBEG = (optional) Begin Date range in external format to search RECALL DATE range. (no time) "RTN","SDEC52",12,0) ; SDEND = (optional) End Date range in external format to search RECALL DATE range. (no time) "RTN","SDEC52",13,0) ; MAXREC - (optional) maximum number of records to return "RTN","SDEC52",14,0) ; LASTSUB - (optional) last subscripts from previous call; "RTN","SDEC52",15,0) ; Used to collect the data in multiple "RTN","SDEC52",16,0) ; background calls "RTN","SDEC52",17,0) ; RECIEN - (optional) Recall Reminders ID pointer to RECALL REMINDERS file "RTN","SDEC52",18,0) ; returns the single record pointed to by RECIEN "RTN","SDEC52",19,0) ; SDTOP - (optional) runs through the xrefs in reverse using -1 in $O 0=forward; 1=reverse "RTN","SDEC52",20,0) ; SDFLAGS - (optional) character flags ;alb/sat 651 "RTN","SDEC52",21,0) ; 1. do not return entries with no clinic defined "RTN","SDEC52",22,0) ; "RTN","SDEC52",23,0) ;RETURN: "RTN","SDEC52",24,0) ; Successful Return: "RTN","SDEC52",25,0) ; Global Array in which each array entry contains data from the RECALL REMINDERS file 403.5. "RTN","SDEC52",26,0) ; Data is separated by ^: "RTN","SDEC52",27,0) ; 1. IEN - pointer to RECALL REMINDERS "RTN","SDEC52",28,0) ; 2. DFN - Pointer to PATIENT file "RTN","SDEC52",29,0) ; 3. NAME - Patient NAME from PATIENT file "RTN","SDEC52",30,0) ; 4. HRN "RTN","SDEC52",31,0) ; 5. DOB - Date of Birth in external format "RTN","SDEC52",32,0) ; 6. SSN - Social Security Number "RTN","SDEC52",33,0) ; 7. GENDER "RTN","SDEC52",34,0) ; 8 INSTIEN - INSTITUTION ien "RTN","SDEC52",35,0) ; 9 INSTNAME - INSTITUTION NAME "RTN","SDEC52",36,0) ; 10. ACCESION - Accession # (free-text 1-25 characters) "RTN","SDEC52",37,0) ; 11. COMM - COMMENT (free-text 1-80 characters) "RTN","SDEC52",38,0) ; 12. FASTING - FAST/NON-FASTING valid values: "RTN","SDEC52",39,0) ; FASTING "RTN","SDEC52",40,0) ; NON-FASTING "RTN","SDEC52",41,0) ; 13. RRAPPTYP - Test/App pointer to RECALL REMINDERS APPT TYPE file 403.51 "RTN","SDEC52",42,0) ; 14. RRPROVIEN - Provider - Pointer to RECALL REMINDERS PROVIDERS file 403.54 "RTN","SDEC52",43,0) ; 15. PROVNAME - Provider NAME of Provider in RECALL REMINDERS PROVIDERS file "RTN","SDEC52",44,0) ; 16. CLINIEN - Clinic pointer to HOSPITAL LOCATION file "RTN","SDEC52",45,0) ; 17. CLINNAME - Clinic NAME from HOSPITAL LOCATION file "RTN","SDEC52",46,0) ; 18. APPTLEN - Length of Appointment numeric between 10 and 120 "RTN","SDEC52",47,0) ; 19. DATE - Recall Date in external format (no time) "RTN","SDEC52",48,0) ; 20. DATE1 - Recall Date (Per patient) in external format (no time) "RTN","SDEC52",49,0) ; 21. DAPTDT - Date Reminder Sent in external format (no time) "RTN","SDEC52",50,0) ; 22. USERIEN - User Who Entered Recall pointer to NEW PERSON file "RTN","SDEC52",51,0) ; 23. USERNAME - User Who Entered Recall NAME from NEW PERSON file "RTN","SDEC52",52,0) ; 24. DATE2 - Second Print Date in external format (no time) "RTN","SDEC52",53,0) ; 25. PRIGRP - ENROLLMENT PRIORITY text from PATIENT ENROLLMENT file "RTN","SDEC52",54,0) ; Valid Values: "RTN","SDEC52",55,0) ; GROUP 1 "RTN","SDEC52",56,0) ; GROUP 2 "RTN","SDEC52",57,0) ; GROUP 3 "RTN","SDEC52",58,0) ; GROUP 4 "RTN","SDEC52",59,0) ; GROUP 5 "RTN","SDEC52",60,0) ; GROUP 6 "RTN","SDEC52",61,0) ; GROUP 7 "RTN","SDEC52",62,0) ; GROUP 8 "RTN","SDEC52",63,0) ; 26. ELIGIEN - Pointer to MAS ELIGIBILITY CODE file 8.1 "RTN","SDEC52",64,0) ; 27. ELIGNAME - NAME from MAS ELIGIBILITY CODE file "RTN","SDEC52",65,0) ; 28. SVCCONN - SERVICE CONNECTED field from PATIENT ENROLLMENT file "RTN","SDEC52",66,0) ; Valid values: "RTN","SDEC52",67,0) ; YES "RTN","SDEC52",68,0) ; NO "RTN","SDEC52",69,0) ; 29. SVCCONNP - SERVICE CONNECTED PERCENTAGE field from PATIENT ENROLLMENT file "RTN","SDEC52",70,0) ; Numeric between 0-100 "RTN","SDEC52",71,0) ; 30. TYPEIEN - Pointer to TYPE OF PATIENT file 391 "RTN","SDEC52",72,0) ; 31. TYPENAME - NAME from TYPE OF PATIENT file 391 "RTN","SDEC52",73,0) ; 32. DATE3 - DATE/TIME RECALL ADDED from RECALL REMINDERS file 403.5 "RTN","SDEC52",74,0) ; 33. PADDRES1 - Patient Address line 1 "RTN","SDEC52",75,0) ; 34. PADDRES2 - Patient Address line 2 "RTN","SDEC52",76,0) ; 35. PADDRES3 - Patient Address line 3 "RTN","SDEC52",77,0) ; 36. PCITY - Patient City "RTN","SDEC52",78,0) ; 37. PSTATE - Patient state name "RTN","SDEC52",79,0) ; 38. PCOUNTRY - Patient country pointer to COUNTRY CODE file 779.004 "RTN","SDEC52",80,0) ; 39. PZIP4 - Patient Zip+4 "RTN","SDEC52",81,0) ; 40. GAF - | | | | "RTN","SDEC52",82,0) ; 41. SENSITIVE - Sensitive Record Access data "RTN","SDEC52",83,0) ; separated by pipe |: "RTN","SDEC52",84,0) ; 1. return code: "RTN","SDEC52",85,0) ; -1 -RPC/API failed "RTN","SDEC52",86,0) ; Required variable not defined "RTN","SDEC52",87,0) ; 0 -No display/action required "RTN","SDEC52",88,0) ; Not accessing own, employee, or sensitive record "RTN","SDEC52",89,0) ; 1 -Display warning message "RTN","SDEC52",90,0) ; Sensitive and DG SENSITIVITY key holder "RTN","SDEC52",91,0) ; or Employee and DG SECURITY OFFICER key holder "RTN","SDEC52",92,0) ; 2 -Display warning message/require OK to continue "RTN","SDEC52",93,0) ; Sensitive and not a DG SENSITIVITY key holder "RTN","SDEC52",94,0) ; Employee and not a DG SECURITY OFFICER key holder "RTN","SDEC52",95,0) ; 3 -Access to record denied "RTN","SDEC52",96,0) ; Accessing own record "RTN","SDEC52",97,0) ; 4 -Access to Patient (#2) file records denied "RTN","SDEC52",98,0) ; SSN not defined "RTN","SDEC52",99,0) ; 2. display text/message "RTN","SDEC52",100,0) ; 3. display text/message "RTN","SDEC52",101,0) ; 4. display text/message "RTN","SDEC52",102,0) ; 42. LASTSUB - last subscripts of data in the return. "RTN","SDEC52",103,0) ; Will only be in the last record of the return. "RTN","SDEC52",104,0) ; Pass this as LASTSUB in the next call to continue "RTN","SDEC52",105,0) ; collecting data. "RTN","SDEC52",106,0) ; 43. PTPHONE ? Patient Phone number ? Free-text 4-20 characters "RTN","SDEC52",107,0) ; 44. PRACE - Patient Race pointer to RACE file 10 | separates entries "RTN","SDEC52",108,0) ; 45. PRACEN - Patient Race name from RACE file | separates entries "RTN","SDEC52",109,0) ; 46. PETH - Patient Ethnicity list separated by pipe | "RTN","SDEC52",110,0) ; Pointer to ETHNICITY file 10.2 "RTN","SDEC52",111,0) ; 47. PETHN - Patient Ethnicity names separated by pipe | "RTN","SDEC52",112,0) ; 48. PRHBLOC - Boolean indicating if location is a "RTN","SDEC52",113,0) ; Prohibit Access clinic "RTN","SDEC52",114,0) ; "RTN","SDEC52",115,0) ; Caught Exception Return: "RTN","SDEC52",116,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC52",117,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC52",118,0) ; Unexpected Exception Return: "RTN","SDEC52",119,0) ; Handled by the RPC Broker. "RTN","SDEC52",120,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC52",121,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC52",122,0) ; text back to the client. "RTN","SDEC52",123,0) N SDDATA,SDECI,SDDEMO,SDMSG,SDTMP "RTN","SDEC52",124,0) N ACCESION,APPTLEN,CLINIEN,CLINNAME,COMM,DAPTDT,DATE,DATE1,DATE2,DATE3,DOB,ELIGIEN,ELIGNAME,FASTING "RTN","SDEC52",125,0) N GAF,GENDER,HRN,IEN,INSTIEN,INSTNAME,NAME,PD,PM,PRIGRP,RRAPPTYP,RRPROVNAME,PTINFO,RRPROVIEN,SSN "RTN","SDEC52",126,0) N SVCCONNP,SVVCCONN,SDDFN "RTN","SDEC52",127,0) N PADDRES1,PADDRES2,PADDRES3,PCITY,PSTATE,PCOUNTRY,PTPHONE,PZIP4 "RTN","SDEC52",128,0) N SDCNT,SDI,SDSENS,SDSUB,TYPEIEN,TYPENAME,USERIEN,USERNAME,X,Y,%DT "RTN","SDEC52",129,0) S SDSUB="" "RTN","SDEC52",130,0) S SDECY="^TMP(""SDEC52"","_$J_",""RECGET"")" "RTN","SDEC52",131,0) K @SDECY "RTN","SDEC52",132,0) S SDECI=0 "RTN","SDEC52",133,0) D HDR "RTN","SDEC52",134,0) ;validate SDFLAGS (optional) ;alb/sat 651 "RTN","SDEC52",135,0) S SDFLAGS=$G(SDFLAGS) "RTN","SDEC52",136,0) ;validate RECIEN (optional) "RTN","SDEC52",137,0) S RECIEN=$G(RECIEN) "RTN","SDEC52",138,0) I RECIEN'="" I '$D(^SD(403.5,RECIEN,0)) D ERR1^SDECERR(-1,"Invalid Recall Reminders ID.",SDECI,SDECY) Q "RTN","SDEC52",139,0) I RECIEN'="" D RECIEN1 G RECX "RTN","SDEC52",140,0) S SDCNT=0 "RTN","SDEC52",141,0) ;validate SDBEG "RTN","SDEC52",142,0) S SDBEG=$G(SDBEG) "RTN","SDEC52",143,0) I $G(SDBEG)'="" S %DT="" S X=$P($G(SDBEG),"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-1825) "RTN","SDEC52",144,0) I $G(SDBEG)="" S SDBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-1825) "RTN","SDEC52",145,0) ;validate SDEND (optional) "RTN","SDEC52",146,0) S SDEND=$G(SDEND) "RTN","SDEC52",147,0) I SDEND'="" S %DT="" S X=$P($G(SDEND),"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-90) "RTN","SDEC52",148,0) I SDEND="" S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-90) "RTN","SDEC52",149,0) ;validate SDSTOP (optional) "RTN","SDEC52",150,0) S SDSTOP=$G(SDSTOP) "RTN","SDEC52",151,0) ;validate DFN (optional) "RTN","SDEC52",152,0) S DFN=$G(DFN) "RTN","SDEC52",153,0) I DFN'="" I '$D(^DPT(DFN,0)) S DFN="" "RTN","SDEC52",154,0) ;get all records for a specific patient "RTN","SDEC52",155,0) I +DFN D RECGET1(DFN,,SDBEG,SDEND,SDFLAGS) G RECX ;alb/sat 651 - add SDFLAGS "RTN","SDEC52",156,0) ;get records in specified date range "RTN","SDEC52",157,0) ;validate MAXREC (optional) "RTN","SDEC52",158,0) S MAXREC=$G(MAXREC) I 'MAXREC S MAXREC=9999999 "RTN","SDEC52",159,0) ;validate LASTSUB (optional) "RTN","SDEC52",160,0) S LASTSUB=$G(LASTSUB) "RTN","SDEC52",161,0) D RECGETD "RTN","SDEC52",162,0) RECX S SDTMP=@SDECY@(SDECI) S SDTMP=$P(SDTMP,$C(30),1) "RTN","SDEC52",163,0) S:$G(SDSUB)'="" $P(SDTMP,U,42)=SDSUB "RTN","SDEC52",164,0) S @SDECY@(SDECI)=SDTMP_$C(30,31) "RTN","SDEC52",165,0) Q "RTN","SDEC52",166,0) ; "RTN","SDEC52",167,0) HDR ;Print out the header "RTN","SDEC52",168,0) S SDTMP="T00030IEN^T00030DFN^T00030NAME^T00030HRN^T00030DOB^T00030SSN^T00030GENDER^T00030INSTIEN^T00030INSTNAME" "RTN","SDEC52",169,0) S SDTMP=SDTMP_"^T00030ACCESION^T00080COMM^T00030FASTING^T00030RRAPPTYP" "RTN","SDEC52",170,0) S SDTMP=SDTMP_"^T00030RRPROVIEN^T00030PROVNAME^T00030CLINIEN^T00030CLINNAME^T00030APPTLEN" "RTN","SDEC52",171,0) S SDTMP=SDTMP_"^T00030DATE^T00030DATE1^T00030DAPTDT^T00030USERIEN^T00030USERNAME^T00030DATE2" "RTN","SDEC52",172,0) S SDTMP=SDTMP_"^T00030PRIGRP^T00030ELIGIEN^T00030ELIGNAME^T00030SVCCONN^T00030SVCCONNP" "RTN","SDEC52",173,0) S SDTMP=SDTMP_"^T00030TYPEIEN^T00030TYPENAME^T00030DATE3^T00030PADDRES1^T00030PADDRES2^T00030PADDRES3" "RTN","SDEC52",174,0) S SDTMP=SDTMP_"^T00030PCITY^T00030PSTATE^T00030PCOUNTRY^T00030PZIP4^T00030GAF^T00100SENSITIVE^T00030LASTSUB^T00030PTPHONE" "RTN","SDEC52",175,0) S SDTMP=SDTMP_"^T00030PRACE^T00030PRACEN^T00030PETH^T00030PETHN^T00030PRHBLOC" "RTN","SDEC52",176,0) S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDEC52",177,0) Q "RTN","SDEC52",178,0) ; "RTN","SDEC52",179,0) RECGET1(DFN,IEN,SDBEG,SDEND,SDFLAGS) ;get all recall data for 1 patient ;alb/sat 651 - add SDFLAGS "RTN","SDEC52",180,0) ; DFN = (required) patient ID pointer to PATIENT file 2 "RTN","SDEC52",181,0) ; IEN - (optional) recall ID pointer to RECALL REMINDERS file "RTN","SDEC52",182,0) ; all records in date range will be return if IEN="" "RTN","SDEC52",183,0) N X,Y,%DT "RTN","SDEC52",184,0) S SDFLAGS=$G(SDFLAGS) ;alb/sat 651 "RTN","SDEC52",185,0) ;check for valid Patient (required) "RTN","SDEC52",186,0) I '$D(^DPT(+$G(DFN),0)) D ERR1^SDECERR(-1,"Invalid Patient ID",SDECI,SDECY) Q "RTN","SDEC52",187,0) ;check begin date (optional) "RTN","SDEC52",188,0) I $G(SDBEG)'="" S %DT="" S X=$P($G(SDBEG),"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG=1000101 "RTN","SDEC52",189,0) I $G(SDBEG)="" S SDBEG=1000101 "RTN","SDEC52",190,0) ;check end date (optional) "RTN","SDEC52",191,0) I $G(SDEND)'="" S %DT="" S X=$P($G(SDEND),"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-90) ;9991231 "RTN","SDEC52",192,0) I $G(SDEND)="" S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-90) ;9991231 "RTN","SDEC52",193,0) ;get PATIENT data "RTN","SDEC52",194,0) D RECGETP(DFN) "RTN","SDEC52",195,0) ;get RECALL REMINDERS data "RTN","SDEC52",196,0) S IEN=$G(IEN) "RTN","SDEC52",197,0) I IEN'="" D GET1 Q "RTN","SDEC52",198,0) I IEN="" F S IEN=$O(^SD(403.5,"B",DFN,IEN)) Q:IEN="" D GET1 "RTN","SDEC52",199,0) Q "RTN","SDEC52",200,0) ; "RTN","SDEC52",201,0) RECGETD ;get recall data for date range "RTN","SDEC52",202,0) S SDFLAGS=$G(SDFLAGS) ;alb/sat 651 "RTN","SDEC52",203,0) I 'SDSTOP D "RTN","SDEC52",204,0) .S SDI=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1)-1,1:SDBEG-1) F S SDI=$O(^SD(403.5,"D",SDI)) Q:SDI'>0 Q:SDI>$P(SDEND,".",1) D I SDECI>(MAXREC-1) S SDSUB=SDI_"|"_$S(SDDFN>0:SDDFN,1:"") Q "RTN","SDEC52",205,0) ..S SDDFN=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2),1:"") S LASTSUB="" F S SDDFN=$O(^SD(403.5,"D",SDI,SDDFN)) Q:SDDFN'>0 D Q:SDECI>(MAXREC-1) "RTN","SDEC52",206,0) ...S DFN=$$GET1^DIQ(403.5,SDDFN_",",.01,"I") D RECGET1(DFN,SDDFN,SDBEG,SDEND,SDFLAGS) ;alb/sat 651 - add SDFLAGS "RTN","SDEC52",207,0) I +SDSTOP D "RTN","SDEC52",208,0) .S SDI=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1)+1,1:SDEND+1) F S SDI=$O(^SD(403.5,"D",SDI),-1) Q:SDI'>0 Q:SDI<$P(SDBEG,".",1) D I SDECI>(MAXREC-1) S SDSUB=SDI_"|"_$S(SDDFN>0:SDDFN,1:"") Q "RTN","SDEC52",209,0) ..S SDDFN=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2),1:999999999) S LASTSUB="" F S SDDFN=$O(^SD(403.5,"D",SDI,SDDFN),-1) Q:SDDFN'>0 D Q:SDECI>(MAXREC-1) "RTN","SDEC52",210,0) ...S DFN=$$GET1^DIQ(403.5,SDDFN_",",.01,"I") D RECGET1(DFN,SDDFN,SDBEG,SDEND,SDFLAGS) ;alb/sat 651 - add SDFLAGS "RTN","SDEC52",211,0) Q "RTN","SDEC52",212,0) RECIEN(SDECY,RECIEN) ;Get recall data for one entry "RTN","SDEC52",213,0) RECIEN1 ; "RTN","SDEC52",214,0) ;Input is IEN to retieve data on "RTN","SDEC52",215,0) N ACCESION,APPTLEN,CLINIEN,CLINNAME,COMM,DAPTDT,DATE,DATE1,DATE2,DATE3,DOB,ELIGIEN,ELIGNAME,FASTING "RTN","SDEC52",216,0) N GAF,GENDER,HRN,IEN,INSTIEN,INSTNAME,NAME,PD,PM,PRIGRP,RRAPPTYP,RRPROVNAME,PTINFO,RRPROVIEN,SSN "RTN","SDEC52",217,0) N SVCCONNP,SVVCCONN,SDBEG,SDEND "RTN","SDEC52",218,0) N PADDRES1,PADDRES2,PADDRES3,PCITY,PSTATE,PCOUNTRY,PZIP4 "RTN","SDEC52",219,0) N SDCNT,SDI,SDSENS,SDSUB,TYPEIEN,TYPENAME,USERIEN,USERNAME,X,Y,%DT "RTN","SDEC52",220,0) S SDSUB="" "RTN","SDEC52",221,0) S SDECY="^TMP(""SDEC52"","_$J_",""RECGET"")" "RTN","SDEC52",222,0) K @SDECY "RTN","SDEC52",223,0) S SDECI=0 "RTN","SDEC52",224,0) D HDR "RTN","SDEC52",225,0) S SDBEG=1000101 "RTN","SDEC52",226,0) S SDEND=9991231 "RTN","SDEC52",227,0) S DFN=$$GET1^DIQ(403.5,RECIEN_",",.01,"I") I +DFN D "RTN","SDEC52",228,0) .D RECGETP(DFN) "RTN","SDEC52",229,0) .D RECGET1(DFN,RECIEN,SDBEG,SDEND) "RTN","SDEC52",230,0) Q "RTN","SDEC52",231,0) ; "RTN","SDEC52",232,0) RECGETP(DFN) ;get patient data "RTN","SDEC52",233,0) ;collect demographics "RTN","SDEC52",234,0) D PDEMO^SDECU2(.SDDEMO,DFN) "RTN","SDEC52",235,0) S NAME=SDDEMO("NAME") "RTN","SDEC52",236,0) S DOB=SDDEMO("DOB") "RTN","SDEC52",237,0) S GENDER=SDDEMO("GENDER") "RTN","SDEC52",238,0) S HRN=SDDEMO("HRN") "RTN","SDEC52",239,0) S SSN=SDDEMO("SSN") "RTN","SDEC52",240,0) S INSTIEN=SDDEMO("INSTIEN") "RTN","SDEC52",241,0) S INSTNAME=SDDEMO("INSTNAME") "RTN","SDEC52",242,0) S PRIGRP=SDDEMO("PRIGRP") ;25 "RTN","SDEC52",243,0) S ELIGIEN=SDDEMO("ELIGIEN") ;26 "RTN","SDEC52",244,0) S ELIGNAME=SDDEMO("ELIGNAME") ;27 "RTN","SDEC52",245,0) S SVVCCONN=SDDEMO("SVCCONN") ;28 "RTN","SDEC52",246,0) S SVCCONNP=SDDEMO("SVCCONNP") ;29 "RTN","SDEC52",247,0) S TYPEIEN=SDDEMO("TYPEIEN") ;30 "RTN","SDEC52",248,0) S TYPENAME=SDDEMO("TYPENAME") ;31 "RTN","SDEC52",249,0) S PADDRES1=SDDEMO("PADDRES1") ;33 - Patient Address line 1 "RTN","SDEC52",250,0) S PADDRES2=SDDEMO("PADDRES2") ;34 - Patient Address line 2 "RTN","SDEC52",251,0) S PADDRES3=SDDEMO("PADDRES3") ;35 - Patient Address line 3 "RTN","SDEC52",252,0) S PCITY=SDDEMO("PCITY") ;36 - Patient City "RTN","SDEC52",253,0) S PSTATE=SDDEMO("PSTATE") ;37 - Patient state name "RTN","SDEC52",254,0) S PCOUNTRY=SDDEMO("PCOUNTRY") ;38 - Patient country name "RTN","SDEC52",255,0) S PZIP4=SDDEMO("PZIP+4") ;39 - Patient Zip+4 "RTN","SDEC52",256,0) S PTPHONE=SDDEMO("HPHONE") ;43 - Patient Phone "RTN","SDEC52",257,0) S GAF=$$GAF^SDECU2(DFN) ;40 "RTN","SDEC52",258,0) S SDSENS=$$PTSEC^SDECUTL(DFN) ;41 "RTN","SDEC52",259,0) Q "RTN","SDEC52",260,0) ; "RTN","SDEC52",261,0) GET1 ; "RTN","SDEC52",262,0) N PRACE,PRACEN,PETH,PETHN,PRHBLOC,PROVNAME "RTN","SDEC52",263,0) K SDDATA,SDMSG "RTN","SDEC52",264,0) S SDFLAGS=$G(SDFLAGS) ;alb/sat 651 "RTN","SDEC52",265,0) S PRHBLOC=0 "RTN","SDEC52",266,0) D GETS^DIQ(403.5,IEN,"**","IE","SDDATA","SDMSG") "RTN","SDEC52",267,0) S DATE=SDDATA(403.5,IEN_",",5,"I") "RTN","SDEC52",268,0) Q:(DATESDEND) "RTN","SDEC52",269,0) S ACCESION=SDDATA(403.5,IEN_",",2,"E") ; 10. Accession # (free-text 1-25 characters) "RTN","SDEC52",270,0) S COMM=SDDATA(403.5,IEN_",",2.5,"E") ; 11. COMMENT (free-text 1-80 characters) "RTN","SDEC52",271,0) S FASTING=SDDATA(403.5,IEN_",",2.6,"I") ; 12. FASTING/NON-FASTING "RTN","SDEC52",272,0) S RRAPPTYP=SDDATA(403.5,IEN_",",3,"I") ; 13. Test/App pointer to RECALL REMINDERS APPT TYPE file 403.51 "RTN","SDEC52",273,0) S RRPROVIEN=SDDATA(403.5,IEN_",",4,"I") ; 14. Pointer to RECALL REMINDERS PROVIDERS file 403.54 "RTN","SDEC52",274,0) S PROVNAME=SDDATA(403.5,IEN_",",4,"E") ; 15. Provider NAME of Provider in RECALL REMINDERS PROVIDERS file "RTN","SDEC52",275,0) S CLINIEN=SDDATA(403.5,IEN_",",4.5,"I") ; 16. Clinic pointer to HOSPITAL LOCATION file "RTN","SDEC52",276,0) I CLINIEN="",+$E(SDFLAGS) Q ; do not return if no clinic defined ;alb/sat 651 "RTN","SDEC52",277,0) S CLINNAME=SDDATA(403.5,IEN_",",4.5,"E") ; 17. Clinic NAME from HOSPITAL LOCATION file "RTN","SDEC52",278,0) I CLINIEN'="",$$GET1^DIQ(44,CLINIEN_",",50.01,"I")=1 Q ;check OOS? "RTN","SDEC52",279,0) S:CLINIEN'="" PRHBLOC=$S($$GET1^DIQ(44,+CLINIEN_",",2500,"I")="Y":1,1:0) "RTN","SDEC52",280,0) S APPTLEN=SDDATA(403.5,IEN_",",4.7,"E") ; 18. Length of Appointment numeric between 10 and 120 "RTN","SDEC52",281,0) S DATE=SDDATA(403.5,IEN_",",5,"I") S DATE=$$FMTE^XLFDT(DATE) ;19. Recall Date in external format (no time) "RTN","SDEC52",282,0) S DATE1=SDDATA(403.5,IEN_",",5.5,"I") S DATE1=$$FMTE^XLFDT(DATE1) ;20. Recall Date (Per patient) in external format (no time) "RTN","SDEC52",283,0) S DAPTDT=SDDATA(403.5,IEN_",",6,"I") S DAPTDT=$$FMTE^XLFDT(DAPTDT) ;21. Date Reminder Sent in external format (no time) "RTN","SDEC52",284,0) S USERIEN=SDDATA(403.5,IEN_",",7,"I") ; 22. User Who Entered Recall pointer to NEW PERSON file "RTN","SDEC52",285,0) S USERNAME=SDDATA(403.5,IEN_",",7,"E") ; 23. User Who Entered Recall NAME from NEW PERSON file "RTN","SDEC52",286,0) S DATE3=SDDATA(403.5,IEN_",",7.5,"E") ; 32. DATE/TIME RECALL ADDED "RTN","SDEC52",287,0) S:DATE3="" DATE3=DATE "RTN","SDEC52",288,0) S DATE2=SDDATA(403.5,IEN_",",8,"I") S DATE2=$$FMTE^XLFDT(DATE2) ;24. Second Print Date in external format (no time) "RTN","SDEC52",289,0) D RACELST^SDECU2(DFN,.PRACE,.PRACEN) "RTN","SDEC52",290,0) D ETH^SDECU2(DFN,.PETH,.PETHN) ;get ethnicity "RTN","SDEC52",291,0) S SDTMP=IEN_U_DFN_U_NAME_U_HRN_U_DOB_U_SSN_U_GENDER_U_INSTIEN_U_INSTNAME ; 9 "RTN","SDEC52",292,0) S SDTMP=SDTMP_U_ACCESION_U_COMM_U_FASTING_U_RRAPPTYP ;13 "RTN","SDEC52",293,0) S SDTMP=SDTMP_U_RRPROVIEN_U_PROVNAME_U_CLINIEN_U_CLINNAME_U_APPTLEN ;18 "RTN","SDEC52",294,0) S SDTMP=SDTMP_U_DATE_U_DATE1_U_DAPTDT_U_USERIEN_U_USERNAME_U_DATE2 ;24 "RTN","SDEC52",295,0) S SDTMP=SDTMP_U_PRIGRP_U_ELIGIEN_U_ELIGNAME_U_SVVCCONN_U_SVCCONNP ;29 "RTN","SDEC52",296,0) S SDTMP=SDTMP_U_TYPEIEN_U_TYPENAME_U_DATE3_U_PADDRES1_U_PADDRES2_U_PADDRES3 ;35 "RTN","SDEC52",297,0) S SDTMP=SDTMP_U_PCITY_U_PSTATE_U_PCOUNTRY_U_PZIP4_U_GAF_U_SDSENS ;41 "RTN","SDEC52",298,0) S SDTMP=SDTMP_U_U_PTPHONE_U_PRACE_U_PRACEN_U_PETH_U_PETHN_U_PRHBLOC ;47 "RTN","SDEC52",299,0) S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDEC52",300,0) Q "RTN","SDEC56") 0^10^B36808383^B36315965 "RTN","SDEC56",1,0) SDEC56 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 19, 2016 "RTN","SDEC56",2,0) ;;5.3;Scheduling;**627,642,651**;Aug 13, 1993;Build 14 "RTN","SDEC56",3,0) ; "RTN","SDEC56",4,0) Q "RTN","SDEC56",5,0) ; "RTN","SDEC56",6,0) REP1GET(SDECY,MAXREC,LASTSUB,PNAME) ;GET clinic data for report "RTN","SDEC56",7,0) ;INPUT: "RTN","SDEC56",8,0) ; MAXREC - (optional) Max records returned "RTN","SDEC56",9,0) ; LASTSUB - (optional) last subscripts from previous call "RTN","SDEC56",10,0) ; PNAME - (optional) partial name "RTN","SDEC56",11,0) ;RETURN: "RTN","SDEC56",12,0) ; 1. CLINIEN - clinic ID pointer to HOSPITAL LOCATION file 44 "RTN","SDEC56",13,0) ; 2. CLINNAME - clinic NAME from HOSPITAL LOCATION file 44 "RTN","SDEC56",14,0) ; 3. TYPE - clinic type - only valid value is 'CLINIC' "RTN","SDEC56",15,0) ; 4. INSTIEN - institution ID pointer to INSTITUTION file "RTN","SDEC56",16,0) ; 5. INSTNAME - institution NAME from INSTITUTION file "RTN","SDEC56",17,0) ; 6. DIVIEN - division ID pointer to MEDICAL CENTER DIVISION file 40.8 "RTN","SDEC56",18,0) ; 7. DIVNAME - division NAME from MEDICAL CENTER DIVISION file "RTN","SDEC56",19,0) ; 8. STOP_CODE_ID - stop code ID pointer to CLINIC STOP file 40.7 "RTN","SDEC56",20,0) ; 9. STOP_CODE_NUMBER - stop code number "RTN","SDEC56",21,0) ; 10. SERVICE - service assigned - valid values: "RTN","SDEC56",22,0) ; MEDICINE "RTN","SDEC56",23,0) ; SURGERY "RTN","SDEC56",24,0) ; PSYCHIATRY "RTN","SDEC56",25,0) ; REHAB MEDICINE "RTN","SDEC56",26,0) ; NEUROLOGY "RTN","SDEC56",27,0) ; NONE "RTN","SDEC56",28,0) ; 11. TREATSPECID - treating specialty ID pointer to FACILITY TREATING SPECIALTY file 45.7 "RTN","SDEC56",29,0) ; 12. TREATSPECNAME - treating specialty NAME from FACILITY TREATING SPECIALTY file "RTN","SDEC56",30,0) ; 13. PROVIEN - default provider ID pointer to NEW PERSON file 200 "RTN","SDEC56",31,0) ; 14. PROVNAME - default provider NAME from NEW PERSON file "RTN","SDEC56",32,0) ; 15. AGENCYID - agency ID pointer to AGENCY file 4.11 "RTN","SDEC56",33,0) ; 16. AGENCYNAME - agency NAME from AGENCY file "RTN","SDEC56",34,0) ; 17. APPTLEN - length of app't numeric 10-240 and multiple of 10 or 15 "RTN","SDEC56",35,0) ; 18. VAPPTLEN - variable appointment length 'V' means "YES, VARIABLE LENGTH"; otherwise null "RTN","SDEC56",36,0) ; 19. PROHIBITACC - prohibit access to clinic? 'YES' or null "RTN","SDEC56",37,0) ; 20. NON-COUNT - non-count clinic? 'YES' 'NO' "RTN","SDEC56",38,0) ; 21. INACTIVATE_DT - inactivate date in external format - date clinic was inactivated "RTN","SDEC56",39,0) ; 22. REACTIVATE_DT - reactivate date in external format - date clinic was reactivated "RTN","SDEC56",40,0) ; 23. DEF-APPT-TYPE_ID - default appointment type ID pointer to APPOINTMENT TYPE file 409.1 "RTN","SDEC56",41,0) ; 24. DEF-APPT-TYPE_NAME - default appointment type NAME from APPOINTMENT TYPE file "RTN","SDEC56",42,0) ; 25. PROVIDERS - Providers separated by pipe. "RTN","SDEC56",43,0) ; Each pipe piece contains the following ;; pieces: "RTN","SDEC56",44,0) ; 1. provider ID pointer to NEW PERSON FILE 200 "RTN","SDEC56",45,0) ; 2. provider NAME from NEW PERSON file "RTN","SDEC56",46,0) ; 3. default provider? 'NO' 'YES' "RTN","SDEC56",47,0) ; 26. CLIN-SVCS-RES_ID - clinic services resource ID pointer to "RTN","SDEC56",48,0) ; 27. CLIN-SVCS-RES_NAME - clinic services resource NAME "RTN","SDEC56",49,0) ; 28. CLINIC-GRP_ID - clinic group (reports) ID pointer to CLINIC GROUP file 409.67 "RTN","SDEC56",50,0) ; 29. CLINIC-GRP_NAME - clinic group (reports) NAME from CLINIC GROUP file "RTN","SDEC56",51,0) ; 30. DATE - Date/Time this Clinic was created in external format "RTN","SDEC56",52,0) ; 31. MAXDAYS - max # days for future booking 2002 "RTN","SDEC56",53,0) ; 32. LASTSUB - last subscripts of data in the return. "RTN","SDEC56",54,0) ; Pass this as LASTSUB in the next call to continue "RTN","SDEC56",55,0) ; collecting data. "RTN","SDEC56",56,0) N SDA,SDAUD,SDAUDNOD,SDCL,SDCLN,SDDATA,SDFIELDS,SDECI,SDI,SDMSG,SDTMP "RTN","SDEC56",57,0) S SDECY="^TMP(""SDEC56"","_$J_",""HLREP1"")" "RTN","SDEC56",58,0) K @SDECY "RTN","SDEC56",59,0) ; 1 2 3 4 5 "RTN","SDEC56",60,0) S SDTMP="T00030CLINIEN^T00030CLINNAME^T00030TYPE^T00030INSTIEN^T00030INSTNAME" "RTN","SDEC56",61,0) ; 6 7 8 9 "RTN","SDEC56",62,0) S SDTMP=SDTMP_"^T00030DIVIEN^T00030DIVNAME^T00030STOP_CODE_ID^T00030STOP_CODE_NUMBER" "RTN","SDEC56",63,0) ; 10 11 12 "RTN","SDEC56",64,0) S SDTMP=SDTMP_"^T00030SERVICE^T00030TREATSPECID^T00030TREATSPECNAME" "RTN","SDEC56",65,0) ; 13 14 15 16 17 "RTN","SDEC56",66,0) S SDTMP=SDTMP_"^T00030PROVIEN^T00030PROVNAME^T00030AGENCYID^T00030AGENCYNAME^T00030APPTLEN" "RTN","SDEC56",67,0) ; 18 19 20 21 "RTN","SDEC56",68,0) S SDTMP=SDTMP_"^T00030VAPPTLEN^T00030PROHIBITACC^T00030NON-COUNT^T00030INACTIVATE_DT" "RTN","SDEC56",69,0) ; 22 23 24 "RTN","SDEC56",70,0) S SDTMP=SDTMP_"^T00030REACTIVATE_DT^T00030DEF-APPT-TYPE_ID^T00030DEF-APPT-TYPE_NAME" "RTN","SDEC56",71,0) ; 25 26 27 "RTN","SDEC56",72,0) S SDTMP=SDTMP_"^T00030PROVIDERS^T00030CLIN-SVCS-RES_ID^T00030CLIN-SVCS-RES_NAME" "RTN","SDEC56",73,0) ; 28 29 30 "RTN","SDEC56",74,0) S SDTMP=SDTMP_"^T00030CLINIC-GRP_ID^T00030CLINIC-GRP_NAME^T00030DATE^T00030MAXDAYS^T00030LASTSUB" "RTN","SDEC56",75,0) S SDECI=0 "RTN","SDEC56",76,0) S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDEC56",77,0) S MAXREC=+$G(MAXREC,200) "RTN","SDEC56",78,0) S LASTSUB=$G(LASTSUB) "RTN","SDEC56",79,0) S PNAME=$G(PNAME) "RTN","SDEC56",80,0) S SDCLN=$S($P(LASTSUB,"|",2)'="":$$GETSUB($P(LASTSUB,"|",2)),PNAME'="":$$GETSUB(PNAME),1:"") "RTN","SDEC56",81,0) F S SDCLN=$O(^SC("AG","C",SDCLN)) S:(PNAME'="")&($E(SDCLN,1,$L(PNAME))'=PNAME) SDCLN="" Q:SDCLN="" D I +MAXREC,SDECI'0 D I +MAXREC,SDECI'0 D "RTN","SDEC56",144,0) .S SDNOD=$G(^SC(SDCL,"PR",SDI,0)) "RTN","SDEC56",145,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",146,0) Q SDRET "RTN","SDEC56",147,0) ; "RTN","SDEC56",148,0) GETSUB(TXT) ; "RTN","SDEC56",149,0) N LAST "RTN","SDEC56",150,0) S LAST=$E(TXT,$L(TXT)) "RTN","SDEC56",151,0) S LAST=$C($A(LAST)-1) "RTN","SDEC56",152,0) S LAST=$E(TXT,1,$L(TXT)-1)_LAST_"ZZZZ" "RTN","SDEC56",153,0) Q LAST "RTN","SDEC57A") 0^4^B120731427^B104060307 "RTN","SDEC57A",1,0) SDEC57A ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 19, 2016 "RTN","SDEC57A",2,0) ;;5.3;Scheduling;**627,643,642,651**;Aug 13, 1993;Build 14 "RTN","SDEC57A",3,0) ; "RTN","SDEC57A",4,0) Q "RTN","SDEC57A",5,0) ; "RTN","SDEC57A",6,0) ;build access block array SDBLKS from pattern SDPAT "RTN","SDEC57A",7,0) GETBLKS(SDBLKS,SDPAT,SDAY,SDCLS,SDLEN,SDSI,SDCL) ; "RTN","SDEC57A",8,0) ;INPUT: "RTN","SDEC57A",9,0) ; SDPAT - Pattern from CURRENT AVAILABILITY field of PATTERN multiple in file 44 "RTN","SDEC57A",10,0) ; SDAY - date (no time) in FM format "RTN","SDEC57A",11,0) ; SDCLS - hour clinic display begins from field 1914 in file 44 "RTN","SDEC57A",12,0) ; SDLEN - length of app't from field 1912 in file 44 "RTN","SDEC57A",13,0) ; SDSI - display increments per hour "RTN","SDEC57A",14,0) ; SDCL - clinic IEN "RTN","SDEC57A",15,0) ;RETURN: "RTN","SDEC57A",16,0) ; .SDBLKS - array of access block data to be stored in SDEC ACCESS BLOCK file "RTN","SDEC57A",17,0) ; SDBLKS()= ^ ^ ^ "RTN","SDEC57A",18,0) N DTARRAY "RTN","SDEC57A",19,0) N SDA,SDATAV,SDATCA,SDATUN,SDF,SDI,SDPATC,SDSE,SDSIM ;alb/sat 651 add SDPATC "RTN","SDEC57A",20,0) S SDF=0 "RTN","SDEC57A",21,0) ;get SDEC ACCESS TYPEs "RTN","SDEC57A",22,0) S SDATAV=$O(^SDEC(409.823,"B","AVAILABLE",0)) "RTN","SDEC57A",23,0) S SDATCA=$O(^SDEC(409.823,"B","CANCELED",0)) "RTN","SDEC57A",24,0) S SDATUN=$O(^SDEC(409.823,"B","UNAVAILABLE",0)) "RTN","SDEC57A",25,0) ;SDSIM - calculated using DISPLAY INCREMENTS PER HOUR field from file 44 "RTN","SDEC57A",26,0) S SDSIM=$S(SDSI="":4,SDSI<3:4,SDSI:SDSI,1:4) "RTN","SDEC57A",27,0) S SDA=$S(SDSI=3:6,SDSI=6:12,1:8) "RTN","SDEC57A",28,0) I SDPAT="" S SDPAT=$G(^SC(SDCL,"ST",SDAY,1)) S SDPAT=$E(SDPAT,SDA,$L(SDPAT)) "RTN","SDEC57A",29,0) S SDPATC=$G(^SC(SDCL,"ST",SDAY,"CAN")) S:SDPATC'="" SDPATC=$E(SDPATC,SDA,$L(SDPATC)) ;alb/sat 651 "RTN","SDEC57A",30,0) I ^SC(SDCL,"ST",SDAY,1)["CANCELLED" S SDF=1,SDPAT=$G(^SC(SDCL,"ST",SDAY,"CAN")) S SDPAT=$E(SDPAT,SDSIM+SDSIM,90) ;get PATTERN from file 44 "RTN","SDEC57A",31,0) D:SDPAT'="" ARRAY^SDECUTL2(.DTARRAY,SDPAT,SDAY,SDLEN,SDCLS,SDSI,+SDF) ;convert pattern to array "RTN","SDEC57A",32,0) S SDSE=$S(SDSI=2:30,SDSI=3:20,SDSI=4:15,SDSI=6:10,1:60) "RTN","SDEC57A",33,0) K SDBLKS "RTN","SDEC57A",34,0) ;1 2 3 4 OR 6 "RTN","SDEC57A",35,0) D @SDSI "RTN","SDEC57A",36,0) Q "RTN","SDEC57A",37,0) 1 ;1 increments per hour (60 min) "RTN","SDEC57A",38,0) N BMIN,BSLOT,BSTART,BSTOP,BTIME,CLBEG,CNT1,DIFF,FX,HOUR,NSTART,PSLOT,SDI,SDJ,SLOT,STA,STAR,VAL,XTIME "RTN","SDEC57A",39,0) S (PSLOT,XTIME)="" "RTN","SDEC57A",40,0) S SDI=0 "RTN","SDEC57A",41,0) D A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS) "RTN","SDEC57A",42,0) ;build array of start times "RTN","SDEC57A",43,0) ;STAR(O_BTIME)=SLOT^ETIME PSLOT "RTN","SDEC57A",44,0) F CNT1=2:2 Q:CNT1>$L(SDPAT) S SLOT=$E(SDPAT,CNT1) D STAR "RTN","SDEC57A",45,0) I $E(SDPAT,(CNT1-2))="X" S SLOT="X" D STAR "RTN","SDEC57A",46,0) S CLBEG=$S($L(SDCLS)=1:"0"_SDCLS,1:SDCLS)_"00" ;clinic begin time "RTN","SDEC57A",47,0) S SDJ=$O(STAR("")) I CLBEG'=$E(SDJ,2,5) S SDI=SDI+1 S SDBLKS(SDI)=CLBEG_U_$E(SDJ,2,5)_U_$S(+SDF:"X",1:0)_U_$S(+SDF:SDATCA,1:SDATUN) "RTN","SDEC57A",48,0) S (BSLOT,BSTART,BSTOP)="" "RTN","SDEC57A",49,0) S SDJ="" F S SDJ=$O(STAR(SDJ)) Q:SDJ="" D Q:SLOT="" "RTN","SDEC57A",50,0) .S HOUR=$E(SDJ,2,3) "RTN","SDEC57A",51,0) .I '$D(STA(HOUR)) D STA "RTN","SDEC57A",52,0) .;S BSTART=SDAY_"."_HOUR_$S($E(SDJ,4,5)="00":"",$E(SDJ,4,5)=15:15,$E(SDJ,4,5)=30:3,$E(SDJ,4,5)=45:45,1:"") ;alb/sat 651 "RTN","SDEC57A",53,0) .S BSTART=SDAY_"."_HOUR_$S($E(SDJ,4,5)="00":"",$E(SDJ,4,5)=10:1,$E(SDJ,4,5)=20:2,$E(SDJ,4,5)=30:3,$E(SDJ,4,5)=40:4,$E(SDJ,4,5)=50:5,1:$E(SDJ,4,5)) "RTN","SDEC57A",54,0) .I BSTOP'="",BSTOP23 S BSTOP=$P(BSTOP,".",1)_".2359" "RTN","SDEC57A",63,0) .S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_BSTOP_U_$S(+SDF:"X",1:BSLOT)_U_$S(+SDF:SDATCA,BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV) "RTN","SDEC57A",64,0) S BTIME=$E($P(BSTOP,".",2),1,2) S:$L(BTIME)=1 BTIME=BTIME_0 I BTIME<18 S SDI=SDI+1 S SDBLKS(SDI)=BSTOP_U_SDAY_"."_18_U_$S(+SDF:"X",1:0)_U_$S(+SDF:SDATCA,1:SDATUN) "RTN","SDEC57A",65,0) Q "RTN","SDEC57A",66,0) 2 ;2 increments per hour (30 min) "RTN","SDEC57A",67,0) N BMIN,BSLOT,BSTART,BSTOP,BTIME,CLBEG,CNT1,HOUR,PSLOT,SDI,SDJ,SLOT,STA,STAR,XTIME "RTN","SDEC57A",68,0) S (PSLOT,XTIME)="" "RTN","SDEC57A",69,0) S SDI=0 "RTN","SDEC57A",70,0) D A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS) "RTN","SDEC57A",71,0) ;build array of start times "RTN","SDEC57A",72,0) F CNT1=2:2 Q:CNT1>$L(SDPAT) S SLOT=$E(SDPAT,CNT1) D STAR "RTN","SDEC57A",73,0) I $E(SDPAT,(CNT1-2))="X" S SLOT="X" D STAR "RTN","SDEC57A",74,0) S CLBEG=$S($L(SDCLS)=1:"0"_SDCLS,1:SDCLS)_"00" ;clinic begin time "RTN","SDEC57A",75,0) S SDJ=$O(STAR("")) I CLBEG'=$E(SDJ,2,5) S SDI=SDI+1 S SDBLKS(SDI)=CLBEG_U_$E(SDJ,2,5)_U_$S(+SDF:"X",1:0)_U_$S(+SDF:SDATCA,1:SDATUN) "RTN","SDEC57A",76,0) S (BSLOT,BSTART,BSTOP)="" "RTN","SDEC57A",77,0) S SDJ="" F S SDJ=$O(STAR(SDJ)) Q:SDJ="" D Q:SLOT="" "RTN","SDEC57A",78,0) .S HOUR=$E(SDJ,2,3) "RTN","SDEC57A",79,0) .I '$D(STA(HOUR)) D STA "RTN","SDEC57A",80,0) .;S BSTART=SDAY_"."_HOUR_$S($E(SDJ,4,5)="00":"",$E(SDJ,4,5)=15:15,$E(SDJ,4,5)=30:3,$E(SDJ,4,5)=45:45,1:"") ;alb/sat 651 "RTN","SDEC57A",81,0) .S BSTART=SDAY_"."_HOUR_$S($E(SDJ,4,5)="00":"",$E(SDJ,4,5)=10:1,$E(SDJ,4,5)=20:2,$E(SDJ,4,5)=30:3,$E(SDJ,4,5)=40:4,$E(SDJ,4,5)=50:5,1:$E(SDJ,4,5)) "RTN","SDEC57A",82,0) .I BSTOP'="",BSTOP23 S BSTOP=$P(BSTOP,".",1)_".2359" "RTN","SDEC57A",91,0) .S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_BSTOP_U_$S(+SDF:"X",1:BSLOT)_U_$S(+SDF:SDATCA,BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV) "RTN","SDEC57A",92,0) S BTIME=$E($P(BSTOP,".",2),1,2) S:$L(BTIME)=1 BTIME=BTIME_0 I BTIME<18 S SDI=SDI+1 S SDBLKS(SDI)=BSTOP_U_SDAY_"."_18_U_$S(+SDF:"X",1:0)_U_$S(+SDF:SDATCA,1:SDATUN) "RTN","SDEC57A",93,0) Q "RTN","SDEC57A",94,0) 3 ;3 increments per hour (20 min) "RTN","SDEC57A",95,0) N BCNT,BSLOT,BSTART,BSTOP,BTIME,CNT,CNT1,HOUR,HR,SDCAN,SDI,SLOT,STA "RTN","SDEC57A",96,0) S (BSLOT,BSTART,SLOT)="" "RTN","SDEC57A",97,0) S SDI=0 "RTN","SDEC57A",98,0) S HOUR=SDCLS-1 "RTN","SDEC57A",99,0) F CNT1=2:2 S:(CNT1#6)=2 HOUR=HOUR+1 S SLOT=$E(SDPAT,CNT1) Q:$$VAL(SLOT) Q:CNT1>$L(SDPAT) ;find 1st slot ;might not be on the hour "RTN","SDEC57A",100,0) Q:CNT1>$L(SDPAT) "RTN","SDEC57A",101,0) D A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS) "RTN","SDEC57A",102,0) I CNT1>2 D "RTN","SDEC57A",103,0) .S BSTART=SDAY_"."_$S($L(SDCLS)=1:"0"_SDCLS,1:SDCLS) "RTN","SDEC57A",104,0) .S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR) "RTN","SDEC57A",105,0) .I '$D(STA(HR)) D STA "RTN","SDEC57A",106,0) .S BSTOP=SDAY_"."_HR_$S((CNT1#6)=4:$P(STA(HR,4),U,2),(CNT1#6)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2)) "RTN","SDEC57A",107,0) .D MAKE(.SDBLKS,.SDI,BSTART,BSTOP,"",SDF) "RTN","SDEC57A",108,0) S BSTART="" "RTN","SDEC57A",109,0) I ((CNT1#6)=2) S HOUR=HOUR-1 "RTN","SDEC57A",110,0) F CNT=CNT1:2 D Q:SLOT="" "RTN","SDEC57A",111,0) .I (CNT#6)=2 S HOUR=HOUR+1 "RTN","SDEC57A",112,0) .S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR) "RTN","SDEC57A",113,0) .I '$D(STA(HR)) D STA "RTN","SDEC57A",114,0) .S:BSTART="" BSTART=SDAY_"."_HR_$S((CNT#6)=4:$P(STA(HR,4),U,2),(CNT#6)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2)) "RTN","SDEC57A",115,0) .S SDCAN=$G(DTARRAY(SDAY,HR_$S((CNT#6)=4:$P(STA(HR,4),U,1),(CNT#6)=0:$P(STA(HR,0),U,1),1:$P(STA(HR,2),U,1))))="X" "RTN","SDEC57A",116,0) .S SLOT=$S(SDCAN:"X",1:$E(SDPAT,CNT)) "RTN","SDEC57A",117,0) .S SLOT=$S(SDCAN:"X",SLOT="":SLOT,$$VAL(SLOT):SLOT,1:" ") "RTN","SDEC57A",118,0) .S:BSLOT="" BSLOT=$S(SLOT="X":SLOT,$$VAL(SLOT):SLOT,1:" ") "RTN","SDEC57A",119,0) .I 1 D "RTN","SDEC57A",120,0) ..I BSLOT=" ",SLOT="",$E($P(BSTART,".",2),1,2)<18 Q "RTN","SDEC57A",121,0) ..S BTIME=$S(((CNT#6)=2)&((HOUR#10)=0):$E(HOUR),1:$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#6)=4:$P(STA(HR,4),U,2),(CNT#6)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2))) "RTN","SDEC57A",122,0) ..S BSTOP=SDAY_"."_BTIME "RTN","SDEC57A",123,0) ..I $E($P(BSTOP,".",2),1,2)>23 S BSTOP=$P(BSTOP,".",1)_".2359" "RTN","SDEC57A",124,0) ..I +BSTART'=+BSTOP D "RTN","SDEC57A",125,0) ...S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_BSTOP_U_$S(+SDF:"X",1:BSLOT)_U_$S(+SDF:SDATCA,BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV) "RTN","SDEC57A",126,0) ..S BSLOT=$S(SLOT="X":"X",$$VAL(SLOT):SLOT,1:" ") "RTN","SDEC57A",127,0) ..S BSTART=BSTOP ;SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#6)=4:2,(CNT#6)=0:4,1:"") "RTN","SDEC57A",128,0) .S BCNT=CNT "RTN","SDEC57A",129,0) I $E($P(BSTART,".",2),1,2)<18 S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_SDAY_"."_18_U_$S(+SDF:"X",1:"")_U_$S(+SDF:SDATCA,1:SDATUN) "RTN","SDEC57A",130,0) Q "RTN","SDEC57A",131,0) 4 ;4 increments per hour (15 min) "RTN","SDEC57A",132,0) N BCNT,BSLOT,BSTART,BSTOP,BTIME,CNT,CNT1,HOUR,HR,SDCAN,SDI,SLOT,STA "RTN","SDEC57A",133,0) S (BSLOT,BSTART,SLOT,STA)="" "RTN","SDEC57A",134,0) S SDI=0 "RTN","SDEC57A",135,0) D A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS) "RTN","SDEC57A",136,0) S HOUR=SDCLS-1 "RTN","SDEC57A",137,0) F CNT=2:2 D Q:SLOT="" "RTN","SDEC57A",138,0) .I (CNT#8)=2 S HOUR=HOUR+1 "RTN","SDEC57A",139,0) .S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR) "RTN","SDEC57A",140,0) .I '$D(STA(HR)) D STA "RTN","SDEC57A",141,0) .S:BSTART="" BSTART=SDAY_"."_HR_$S((CNT#8)=4:$P(STA(HR,4),U,2),(CNT#8)=6:$P(STA(HR,6),U,2),(CNT#8)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2)) "RTN","SDEC57A",142,0) .S SDCAN=$G(DTARRAY(SDAY,HR_$S((CNT#8)=4:$P(STA(HR,4),U,1),(CNT#8)=6:$P(STA(HR,6),U,1),(CNT#8)=0:$P(STA(HR,0),U,1),1:$P(STA(HR,2),U,1))))="X" "RTN","SDEC57A",143,0) .S SLOT=$S(SDCAN:"X",1:$E(SDPAT,CNT)) "RTN","SDEC57A",144,0) .S SLOT=$S(SDCAN:"X",SLOT="":SLOT,$$VAL(SLOT):SLOT,1:" ") "RTN","SDEC57A",145,0) .S:BSLOT="" BSLOT=$S(SLOT="X":SLOT,$$VAL(SLOT):SLOT,1:" ") "RTN","SDEC57A",146,0) .I 1 D "RTN","SDEC57A",147,0) ..I BSLOT=" ",SLOT="",$E($P(BSTART,".",2),1,2)<18 Q "RTN","SDEC57A",148,0) ..S BTIME=$S(((CNT#8)=2)&((HOUR#10)=0):$E(HOUR),1:$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#8)=4:$P(STA(HR,4),U,2),(CNT#8)=6:$P(STA(HR,6),U,2),(CNT#8)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2))) "RTN","SDEC57A",149,0) ..S BSTOP=SDAY_"."_BTIME "RTN","SDEC57A",150,0) ..I $E($P(BSTOP,".",2),1,2)>23 S BSTOP=$P(BSTOP,".",1)_".2359" "RTN","SDEC57A",151,0) ..I +BSTART'=+BSTOP D "RTN","SDEC57A",152,0) ...S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_BSTOP_U_$S(+SDF:"X",1:BSLOT)_U_$S(+SDF:SDATCA,BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV) "RTN","SDEC57A",153,0) ..S BSLOT=$S(SLOT="X":"X",$$VAL(SLOT):SLOT,1:" ") "RTN","SDEC57A",154,0) ..S BSTART=BSTOP ;SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#8)=4:15,(CNT#8)=6:3,(CNT#8)=0:45,1:"") "RTN","SDEC57A",155,0) .S BCNT=CNT "RTN","SDEC57A",156,0) I $E($P(BSTART,".",2),1,2)<18 S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_SDAY_"."_18_U_$S(+SDF:"X",1:"")_U_$S(+SDF:SDATCA,1:SDATUN) "RTN","SDEC57A",157,0) Q "RTN","SDEC57A",158,0) 6 ;6 increments per hour (10 min) "RTN","SDEC57A",159,0) N BCNT,BSLOT,BSTART,BSTOP,BTIME,CNT,CNT1,HOUR,HR,SDCAN,SDI,SLOT,STA "RTN","SDEC57A",160,0) S (BSLOT,BSTART,SLOT)="" "RTN","SDEC57A",161,0) S SDI=0 "RTN","SDEC57A",162,0) D A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS) "RTN","SDEC57A",163,0) S HOUR=SDCLS-1 "RTN","SDEC57A",164,0) F CNT=2:2 D Q:SLOT="" "RTN","SDEC57A",165,0) .I (CNT#12)=2 S HOUR=HOUR+1 "RTN","SDEC57A",166,0) .S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR) "RTN","SDEC57A",167,0) .I '$D(STA(HR)) D STA "RTN","SDEC57A",168,0) .S:BSTART="" BSTART=SDAY_"."_HR_$S((CNT#12)=4:$P(STA(HR,4),U,2),(CNT#12)=6:$P(STA(HR,6),U,2),(CNT#12)=8:$P(STA(HR,8),U,2),(CNT#12)=10:$P(STA(HR,10),U,2),(CNT#12)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2)) "RTN","SDEC57A",169,0) .S SDCAN=$G(DTARRAY(SDAY,$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#12)=4:$P(STA(HR,4),U,1),(CNT#12)=6:$P(STA(HR,6),U,1),(CNT#12)=8:$P(STA(HR,8),U,1),(CNT#12)=10:$P(STA(HR,10),U,1),(CNT#12)=0:$P(STA(HR,0),U,1),1:$P(STA(HR,2),U,1))))="X" "RTN","SDEC57A",170,0) .S SLOT=$S(SDCAN:"X",1:$E(SDPAT,CNT)) "RTN","SDEC57A",171,0) .S SLOT=$S(SDCAN:"X",SLOT="":SLOT,$$VAL(SLOT):SLOT,1:" ") "RTN","SDEC57A",172,0) .S:BSLOT="" BSLOT=$S(SLOT="X":SLOT,$$VAL(SLOT):SLOT,1:" ") "RTN","SDEC57A",173,0) .I 1 D "RTN","SDEC57A",174,0) ..I BSLOT=" ",SLOT="",$E($P(BSTART,".",2),1,2)<18 Q "RTN","SDEC57A",175,0) ..S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR) "RTN","SDEC57A",176,0) ..S BTIME=HR_$S((CNT#12)=4:$P(STA(HR,4),U,2),(CNT#12)=6:$P(STA(HR,6),U,2),(CNT#12)=8:$P(STA(HR,8),U,2),(CNT#12)=10:$P(STA(HR,10),U,2),(CNT#12)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2)) "RTN","SDEC57A",177,0) ..S BSTOP=SDAY_"."_BTIME "RTN","SDEC57A",178,0) ..I $E($P(BSTOP,".",2),1,2)>23 S BSTOP=$P(BSTOP,".",1)_".2359" "RTN","SDEC57A",179,0) ..I +BSTART'=+BSTOP D "RTN","SDEC57A",180,0) ...S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_BSTOP_U_$S(+SDF:"X",1:BSLOT)_U_$S(+SDF:SDATCA,BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV) "RTN","SDEC57A",181,0) ..S BSLOT=$S(SLOT="X":"X",$$VAL(SLOT):SLOT,1:" ") "RTN","SDEC57A",182,0) ..S BSTART=BSTOP ;SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#12)=4:1,(CNT#12)=6:2,(CNT#12)=8:3,(CNT#12)=10:4,(CNT#12)=0:5,1:"") "RTN","SDEC57A",183,0) .S BCNT=CNT "RTN","SDEC57A",184,0) I $E($P(BSTART,".",2),1,2)<18 S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_SDAY_"."_18_U_$S(+SDF:"X",1:"")_U_$S(+SDF:SDATCA,1:SDATUN) "RTN","SDEC57A",185,0) Q "RTN","SDEC57A",186,0) ; "RTN","SDEC57A",187,0) STAR ; "RTN","SDEC57A",188,0) S VAL=$$VAL(SLOT) "RTN","SDEC57A",189,0) S HOUR=(SDCLS+((CNT1-2)\8)) "RTN","SDEC57A",190,0) S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR) "RTN","SDEC57A",191,0) I '$D(STA(HR)) D STA "RTN","SDEC57A",192,0) S BTIME=HR_$S((CNT1#8)=4:$P(STA(HR,4),U,1),(CNT1#8)=6:$P(STA(HR,6),U,1),(CNT1#8)=0:$P(STA(HR,0),U,1),1:$P(STA(HR,2),U,1)) "RTN","SDEC57A",193,0) I 'VAL,PSLOT="X" S $P(STAR("O"_XTIME),U,2)=BTIME,(PSLOT,XTIME)="" "RTN","SDEC57A",194,0) Q:'VAL "RTN","SDEC57A",195,0) I SLOT="X" D "RTN","SDEC57A",196,0) .I PSLOT="X" S $P(STAR("O"_XTIME),U,2)=BTIME "RTN","SDEC57A",197,0) .I PSLOT'="X" S STAR("O"_BTIME)=SLOT,XTIME=BTIME "RTN","SDEC57A",198,0) .S PSLOT=SLOT "RTN","SDEC57A",199,0) I SLOT'="X" D "RTN","SDEC57A",200,0) .I PSLOT="X" S $P(STAR("O"_XTIME),U,2)=BTIME,XTIME="",PSLOT="" "RTN","SDEC57A",201,0) .S STAR("O"_BTIME)=SLOT "RTN","SDEC57A",202,0) Q "RTN","SDEC57A",203,0) NSTAR(STAR,BSTART,BSTOP) ;return 1 if BSTOP is after the cancelled time range; 0 if not after cancelled time range ;alb/sat 651 - add $$NSTAR "RTN","SDEC57A",204,0) N SDAY,SDT,SDI,START,STOP "RTN","SDEC57A",205,0) S SDAY=$P(BSTART,".",1) "RTN","SDEC57A",206,0) S START=$P(BSTART,".",2),START=START_$S($L(START)=1:"000",$L(START)=2:"00",$L(START)=3:"0",1:"") "RTN","SDEC57A",207,0) S STOP=$P(BSTOP,".",2),STOP=STOP_$S($L(STOP)=1:"000",$L(STOP)=2:"00",$L(STOP)=3:"0",1:"") "RTN","SDEC57A",208,0) S SDI="O"_START F S SDI=$O(STAR(SDI)) Q:SDI="" Q:STAR(SDI)'="X" "RTN","SDEC57A",209,0) S:SDI="" SDI=STOP ;alb/sat 651 "RTN","SDEC57A",210,0) Q $$FMDIFF^XLFDT(BSTOP,SDAY_"."_$E(SDI,2,5),2)'>0 "RTN","SDEC57A",211,0) ; "RTN","SDEC57A",212,0) STA ; "RTN","SDEC57A",213,0) N HRP "RTN","SDEC57A",214,0) S HRP=HR-1 S HRP=$S($L(HRP)=1:"0"_HRP,1:HRP) "RTN","SDEC57A",215,0) I $D(STA(HRP)) D "RTN","SDEC57A",216,0) .S STA(HR,4)=STA(HRP,4) "RTN","SDEC57A",217,0) .S:SDSI'=3 STA(HR,6)=STA(HRP,6) "RTN","SDEC57A",218,0) .S:SDSI=6 STA(HR,8)=STA(HRP,8) "RTN","SDEC57A",219,0) .S:SDSI=6 STA(HR,10)=STA(HRP,10) "RTN","SDEC57A",220,0) .S STA(HR,0)=STA(HRP,0) "RTN","SDEC57A",221,0) .S STA(HR,2)=STA(HRP,2) "RTN","SDEC57A",222,0) E X "D B"_SDSI_"^SDECUT1A(.STA,"""_HR_""",0)" "RTN","SDEC57A",223,0) Q "RTN","SDEC57A",224,0) ; "RTN","SDEC57A",225,0) MAKE(SDBLKS,SDI,START,STOP,SLOT,SDF) ;make block "RTN","SDEC57A",226,0) N SDATCA,SDATAV,SDATUN "RTN","SDEC57A",227,0) S SDF=$G(SDF) "RTN","SDEC57A",228,0) S SDATAV=$O(^SDEC(409.823,"B","AVAILABLE",0)) "RTN","SDEC57A",229,0) S SDATCA=$O(^SDEC(409.823,"B","CANCELED",0)) "RTN","SDEC57A",230,0) S SDATUN=$O(^SDEC(409.823,"B","UNAVAILABLE",0)) "RTN","SDEC57A",231,0) S SDI=SDI+1 S SDBLKS(SDI)=START_U_STOP_U_$S(+SDF:"X",1:SLOT)_U_$S(+SDF:SDATCA,$$VAL(SLOT):SDATAV,1:SDATUN) "RTN","SDEC57A",232,0) Q "RTN","SDEC57A",233,0) ;0-9,j-z for 0 to 26 available appts, A-W for overbooks 1-23, "RTN","SDEC57A",234,0) ;'*$!@#?' for overbook outside normal hours, X for cancelled "RTN","SDEC57A",235,0) VAL(SLOT) ;Return 1 if valid available/overbook slots character "RTN","SDEC57A",236,0) I $L(SLOT)=0 Q 0 "RTN","SDEC57A",237,0) Q "*$!@#0123456789jklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWX"[$E(SLOT,1) "RTN","SDECRMG1") 0^11^B133859295^B133141523 "RTN","SDECRMG1",1,0) SDECRMG1 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 19, 2016 "RTN","SDECRMG1",2,0) ;;5.3;Scheduling;**627,642,651**;Aug 13, 1993;Build 14 "RTN","SDECRMG1",3,0) ; "RTN","SDECRMG1",4,0) ; The following entry point causes the ^XTMP("SDEC","IDX" global "RTN","SDECRMG1",5,0) ; to be rebuilt based on the scheduling of the SDEC BUILD IDX option. "RTN","SDECRMG1",6,0) WAIT(SDCY,MAXREC,DFN,SDBEG,SDEND,CLINIC,PRI,SVCCONN,SVCCON,ORIGDT,DESDT,DESDTR,PRIGRP,SORT,PTS,SDMAX,URG,SDSVC,SDLASTE,ORIGDTR,SDCNT,MGIENS,SDALL) ;EP "RTN","SDECRMG1",7,0) ;Key stored in 56th piece "RTN","SDECRMG1",8,0) ;SVCCONNP - 37th piece "RTN","SDECRMG1",9,0) ;Desired DATE - 24th piece "RTN","SDECRMG1",10,0) ;Origination Date - ORIGDT - 8th piece "RTN","SDECRMG1",11,0) ;Priority Group - 33th piece "RTN","SDECRMG1",12,0) ;IEN in 7th piece "RTN","SDECRMG1",13,0) Q:+URG ;only check consults if urgency filter passed in "RTN","SDECRMG1",14,0) N LP,NOD,GBL,DLM,TYP,SDCF,SDI,X "RTN","SDECRMG1",15,0) N RET,WLIEN1,LASTSUB "RTN","SDECRMG1",16,0) S SDCF=1 "RTN","SDECRMG1",17,0) I +CLINIC S SDCF=0 D "RTN","SDECRMG1",18,0) .S SDI="" F S SDI=$O(CLINIC(SDI)) Q:SDI="" D Q:SDCF=1 "RTN","SDECRMG1",19,0) ..S:$O(^SDWL(409.32,"B",SDI,0)) SDCF=1 "RTN","SDECRMG1",20,0) Q:'+SDCF "RTN","SDECRMG1",21,0) S SDMAX=$G(SDMAX,50) "RTN","SDECRMG1",22,0) S GBL="~SDWL(409.3," "RTN","SDECRMG1",23,0) S DLM="|",TYP="E",LASTSUB="" "RTN","SDECRMG1",24,0) S WLIEN1=$G(WLIEN1),MAXREC=$G(MAXREC),SDBEG=$G(SDBEG),SDEND=$G(SDEND),DFN=$G(DFN),CLINIC=$G(CLINIC) "RTN","SDECRMG1",25,0) S:SDBEG="" SDBEG=1000101 "RTN","SDECRMG1",26,0) S:SDEND="" SDEND=$S(DFN'="":9991231,1:$$FMADD^XLFDT($$NOW^XLFDT,-90)) "RTN","SDECRMG1",27,0) S SVCCONN=$G(SVCCONN) "RTN","SDECRMG1",28,0) S SVCCON=$G(SVCCON) "RTN","SDECRMG1",29,0) S SDSVC=$G(SDSVC) "RTN","SDECRMG1",30,0) S SDLASTE=$G(SDLASTE) "RTN","SDECRMG1",31,0) F D Q:SDLASTE="" Q:SDCNT'$P(DESDTR,"~",2)) Q ;match date of request with range of desired dates "RTN","SDECRMG1",55,0) S ORIGGP=$P(NOD,U,8) "RTN","SDECRMG1",56,0) I ORIGDTR'="",ORIGGP'="",(ORIGGP<$P(ORIGDTR,"~",1))!(ORIGGP>$P(ORIGDTR,"~",2)) Q ;match origination date range with file entry date "RTN","SDECRMG1",57,0) I ORIGDT'="",ORIGGP'="",$D(ORIGDT(ORIGGP))=0 Q ;match origination date with file entry date "RTN","SDECRMG1",58,0) S IEN=$P(NOD,U,7) "RTN","SDECRMG1",59,0) S SVCP=$P(NOD,U,37) "RTN","SDECRMG1",60,0) S SVCPINV=100-SVCP "RTN","SDECRMG1",61,0) I SVCCONN'="",SVCCONN'="BOTH" Q:(SVCCONN="NO")&($P(NOD,U,36)="") Q:SVCCONN'=$P(NOD,U,36) ;SCVisit for filter (patient) "RTN","SDECRMG1",62,0) ;S SCPRI=$S($P(NOD,U,36)="YES":0,1:1) ;SCVisit for sorting "RTN","SDECRMG1",63,0) S SCPRI=$P(NOD,U,26)="YES" "RTN","SDECRMG1",64,0) I SVCCON'="",SVCCON'="BOTH" Q:(SVCCON="NO")&($P(NOD,U,44)="") Q:SVCCON'=$P(NOD,U,44) ;SERVICERELATED for filter (request) "RTN","SDECRMG1",65,0) I +SDSVC Q:$P(NOD,U,15)="" Q:'$D(SDSVC($P(NOD,U,15))) ;Service/Clinic Stop "RTN","SDECRMG1",66,0) S WAITD=$$FMDIFF^XLFDT($P($$NOW^XLFDT,".",1),$$CVTDT($P(NOD,U,8))) "RTN","SDECRMG1",67,0) S WAITD=9999999-WAITD ;Wait days for sorting "RTN","SDECRMG1",68,0) S ODTE=$P($$CVTDT($P(NOD,U,8)),".") ;Origination date for sorting "RTN","SDECRMG1",69,0) S DDTE=$P($$CVTDT($P(NOD,U,24)),".") ;Desired date for sorting "RTN","SDECRMG1",70,0) ;S SORTSTR=$$SORT(.SORT) "RTN","SDECRMG1",71,0) S SORTSTR=$$SORT(.SORT,IEN,WAITD,TYP,PT,SVCPINV,PGRP,CLGP,DDTE,ODTE,SCPRI,.MGIENS) "RTN","SDECRMG1",72,0) D SETNODE(WAITD,TYP,IEN,NOD,56,SORTSTR,.SDCNT) "RTN","SDECRMG1",73,0) ;S SDCNT=SDCNT+1 "RTN","SDECRMG1",74,0) Q "RTN","SDECRMG1",75,0) APPT(SDECY,MAXREC,DFN,SDBEG,SDEND,CLINIC,PRI,SVCCONN,SVCCON,ORIGDT,DESDT,DESDTR,PRIGRP,SORT,PTS,SDMAX,URG,SDSVC,SDLASTA,ORIGDTR,SDCNT,MGIENS,SDALL) ; EP get data from appt request file "RTN","SDECRMG1",76,0) Q:'$$TEST("ARGET^SDECAR1") "RTN","SDECRMG1",77,0) Q:+URG ;only check consults if urgency filter passed in "RTN","SDECRMG1",78,0) ;Key stored in 56th piece "RTN","SDECRMG1",79,0) ;SVCCONNP - 30th piece "RTN","SDECRMG1",80,0) ;Desired DATE - 20th piece "RTN","SDECRMG1",81,0) ;Origination Date - ORIGDT - 8th piece "RTN","SDECRMG1",82,0) ;Priority Group - 26th piece "RTN","SDECRMG1",83,0) ;IEN in 7th piece "RTN","SDECRMG1",84,0) N LP,NOD,GBL,DLM,TYP,X "RTN","SDECRMG1",85,0) N RET,LASTSUB "RTN","SDECRMG1",86,0) S SDMAX=$G(SDMAX,50) "RTN","SDECRMG1",87,0) S SVCCONN=$G(SVCCONN) "RTN","SDECRMG1",88,0) S SVCCON=$G(SVCCON) "RTN","SDECRMG1",89,0) S SDSVC=$G(SDSVC) "RTN","SDECRMG1",90,0) S LASTSUB="" "RTN","SDECRMG1",91,0) S DLM="|",TYP="A" "RTN","SDECRMG1",92,0) S GBL="~SDEC(409.85," "RTN","SDECRMG1",93,0) S MAXREC=$G(MAXREC),SDBEG=$G(SDBEG),SDEND=$G(SDEND),DFN=$G(DFN),CLINIC=$G(CLINIC) "RTN","SDECRMG1",94,0) S:SDBEG="" SDBEG=1000101 "RTN","SDECRMG1",95,0) S:SDEND="" SDEND=$S(DFN'="":9991231,1:$$FMADD^XLFDT($$NOW^XLFDT,-90)) "RTN","SDECRMG1",96,0) S SDLASTA=$G(SDLASTA) "RTN","SDECRMG1",97,0) F D Q:SDLASTA="" Q:SDCNT'$P(DESDTR,"~",2)) Q ;match date of request with range of desired dates "RTN","SDECRMG1",120,0) S ORIGGP=$P(NOD,U,8) "RTN","SDECRMG1",121,0) I ORIGGP'="",(ORIGGP>SDEND)!(ORIGGP$P(ORIGDTR,"~",2)) Q ;match origination date range with file entry date "RTN","SDECRMG1",123,0) I ORIGDT'="",ORIGGP'="",$D(ORIGDT(ORIGGP))=0 Q ;match origination date with file entry date "RTN","SDECRMG1",124,0) S IEN=$P(NOD,U,7) "RTN","SDECRMG1",125,0) S SVCP=$P(NOD,U,30) "RTN","SDECRMG1",126,0) S SVCPINV=100-SVCP "RTN","SDECRMG1",127,0) I SVCCONN'="",SVCCONN'="BOTH" Q:(SVCCONN="NO")&($P(NOD,U,29)="") Q:SVCCONN'=$P(NOD,U,29) ;SCVisit for filter (patient) "RTN","SDECRMG1",128,0) ;S SCPRI=$S($P(NOD,U,36)="YES":0,1:1) ;SCVisit for sorting "RTN","SDECRMG1",129,0) I SVCCON'="",SVCCON'="BOTH" Q:(SVCCON="NO")&($P(NOD,U,37)="") Q:SVCCON'=$P(NOD,U,37) ;SERVICERELATED for filter (request) "RTN","SDECRMG1",130,0) S SCPRI=1 ;SCVisit for sorting "RTN","SDECRMG1",131,0) I +SDSVC Q:$P(NOD,U,58)="" Q:'$D(SDSVC($P(NOD,U,58))) ;Service/Clinic Stop "RTN","SDECRMG1",132,0) S WAITD=$$FMDIFF^XLFDT($P($$NOW^XLFDT,".",1),$P(NOD,U,8)) "RTN","SDECRMG1",133,0) S WAITD=9999999-WAITD "RTN","SDECRMG1",134,0) S ODTE=$P($$CVTDT($P(NOD,U,8)),".") "RTN","SDECRMG1",135,0) S DDTE=$P($$CVTDT($P(NOD,U,20)),".") "RTN","SDECRMG1",136,0) ;S SORTSTR=$$SORT(.SORT) "RTN","SDECRMG1",137,0) S SORTSTR=$$SORT(.SORT,IEN,WAITD,TYP,PT,SVCPINV,PGRP,CLGP,DDTE,ODTE,SCPRI,.MGIENS) "RTN","SDECRMG1",138,0) D SETNODE(WAITD,TYP,IEN,NOD,56,SORTSTR,.SDCNT) "RTN","SDECRMG1",139,0) ;S SDCNT=SDCNT+1 "RTN","SDECRMG1",140,0) Q "RTN","SDECRMG1",141,0) ; "RTN","SDECRMG1",142,0) ;Return recall list "RTN","SDECRMG1",143,0) RECALL(RET,MAXREC,DFN,SDBEG,SDEND,CLINIC,PRI,SVCCONN,SVCCON,ORIGDT,DESDT,DESDTR,PRIGRP,SORT,PTS,SDMAX,URG,SDSVC,SDLASTR,ORIGDTR,SDCNT,MGIENS,SDALL) ;EP "RTN","SDECRMG1",144,0) Q:'$$TEST("RECGET^SDEC52") "RTN","SDECRMG1",145,0) Q:+URG ;only check consults if urgency filter passed in "RTN","SDECRMG1",146,0) ;Key stored in 42nd piece "RTN","SDECRMG1",147,0) ;SVCCONNP - 29th piece "RTN","SDECRMG1",148,0) ;Desired DATE - 19th piece - External format "RTN","SDECRMG1",149,0) ;Origination Date - ORIGDT - 32nd piece "RTN","SDECRMG1",150,0) ;Priority Group - 25th piece "RTN","SDECRMG1",151,0) ;IEN - 1st piece "RTN","SDECRMG1",152,0) N LP,NOD,GBL,SVCP,PG,DD,OD,DLM,TYP,PT,SORTSTR,SVCP,SCPRI,ORIGGP "RTN","SDECRMG1",153,0) N CLGP,IEN,PGRP,SDECY,SVCP,SVCPINV,LASTSUB,ODTE,DDTE,WAITD,X "RTN","SDECRMG1",154,0) Q:$G(SVCCON)'="" ;only SD WAIT LIST and SDEC APPT REQUEST have this value "RTN","SDECRMG1",155,0) S SDSVC=$G(SDSVC) "RTN","SDECRMG1",156,0) S SDMAX=$G(SDMAX,50) "RTN","SDECRMG1",157,0) S GBL="~SD(403.5," "RTN","SDECRMG1",158,0) S DLM="|",TYP="R",LASTSUB="" "RTN","SDECRMG1",159,0) S DFN=$G(DFN),SDBEG=$G(SDBEG),SDEND=$G(SDEND),MAXREC=$G(MAXREC),SDLASTR=$G(SDLASTR),CLINIC=$G(CLINIC) "RTN","SDECRMG1",160,0) F D Q:SDLASTR="" Q:SDCNT'$P(DESDTR,"~",2)) Q ;match date of request with range of desired dates "RTN","SDECRMG1",180,0) ..S ORIGGP=$P(NOD,U,32) "RTN","SDECRMG1",181,0) ..I ORIGDTR'="",ORIGGP'="",(ORIGGP<$P(ORIGDTR,"~",1))!(ORIGGP>$P(ORIGDTR,"~",2)) Q ;match origination date range with file entry date "RTN","SDECRMG1",182,0) ..I ORIGDT'="",ORIGGP'="",$D(ORIGDT(ORIGGP))=0 Q ;match origination date with file entry date "RTN","SDECRMG1",183,0) ..S IEN=$P(NOD,U,1) "RTN","SDECRMG1",184,0) ..I SVCCONN'="",SVCCONN'="BOTH" Q:(SVCCONN="NO")&($P(NOD,U,28)="") Q:SVCCONN'=$P(NOD,U,28) ;SCVisit for filter (patient) "RTN","SDECRMG1",185,0) ..S SCPRI=0 ;SCVisit for sorting "RTN","SDECRMG1",186,0) ..S WAITD=$$FMDIFF^XLFDT($P($$NOW^XLFDT,".",1),$$CVTDT($P(NOD,U,19))) "RTN","SDECRMG1",187,0) ..S WAITD=9999999-WAITD "RTN","SDECRMG1",188,0) ..S ODTE=$P($$CVTDT($P(NOD,U,32)),".") "RTN","SDECRMG1",189,0) ..S DDTE=$P($$CVTDT($P(NOD,U,19)),".") "RTN","SDECRMG1",190,0) ..;S SORTSTR=$$SORT(.SORT) "RTN","SDECRMG1",191,0) ..S SORTSTR=$$SORT(.SORT,IEN,WAITD,TYP,PT,SVCPINV,PGRP,CLGP,DDTE,ODTE,SCPRI) "RTN","SDECRMG1",192,0) ..D SETNODE(WAITD,TYP,IEN,NOD,42,SORTSTR,.SDCNT) "RTN","SDECRMG1",193,0) ..;S SDCNT=SDCNT+1 "RTN","SDECRMG1",194,0) Q "RTN","SDECRMG1",195,0) ; "RTN","SDECRMG1",196,0) SETNODE(S1,S2,S3,VAL,KEYP,SLIST,CNT) ;EP- "RTN","SDECRMG1",197,0) ; S1 =Wait Days "RTN","SDECRMG1",198,0) ; S2 =Request Type - A C E R "RTN","SDECRMG1",199,0) ; S3 =Request Type IEN "RTN","SDECRMG1",200,0) ; VAL = Request Type data from rpc call "RTN","SDECRMG1",201,0) ; KEYP = Storage piece number where LASTSUB is stored "RTN","SDECRMG1",202,0) ; SLIST = Sort String from $$SORT "RTN","SDECRMG1",203,0) Q:'$L($D(S1))!'$L($D(S2))!'$L($D(S3)) "RTN","SDECRMG1",204,0) N KEY,DLM "RTN","SDECRMG1",205,0) S DLM="|" "RTN","SDECRMG1",206,0) Q:$D(^TMP("SDECIDX",$J,"XREF-ID",S2_DLM_S3)) ;quit if duplicate "RTN","SDECRMG1",207,0) ;S KEY=9999999-S1_DLM_S2_DLM_S3_DLM_SLIST "RTN","SDECRMG1",208,0) S KEY=SLIST_DLM_S3 "RTN","SDECRMG1",209,0) S CNT=$G(CNT)+1 "RTN","SDECRMG1",210,0) S VAL=$P(VAL,$C(30)) "RTN","SDECRMG1",211,0) S:$G(KEYP) $P(VAL,U,KEYP)=KEY "RTN","SDECRMG1",212,0) S ^TMP("SDECIDX",$J,"DATA",CNT)=$G(VAL) "RTN","SDECRMG1",213,0) S ^TMP("SDECIDX",$J,"XREF",KEY)=S2_U_S3_U_KEY "RTN","SDECRMG1",214,0) S ^TMP("SDECIDX",$J,"COUNT")=CNT "RTN","SDECRMG1",215,0) S ^TMP("SDECIDX",$J,"XREF-ID",S2_DLM_S3)="" "RTN","SDECRMG1",216,0) Q "RTN","SDECRMG1",217,0) ; "RTN","SDECRMG1",218,0) SETNODEP(GBL,VAL) ;EP- "RTN","SDECRMG1",219,0) Q:'$L($D(GBL)) "RTN","SDECRMG1",220,0) S ^XTMP("SDEC","IDX","PATTERNS",GBL)=$P($G(VAL),$C(30)) "RTN","SDECRMG1",221,0) Q "RTN","SDECRMG1",222,0) ; "RTN","SDECRMG1",223,0) PC(VAL,PIECE,DLM) ;EP- "RTN","SDECRMG1",224,0) S DLM=$G(DLM,U) "RTN","SDECRMG1",225,0) Q $P($G(VAL),DLM,+$G(PIECE)) "RTN","SDECRMG1",226,0) ; "RTN","SDECRMG1",227,0) ;SORT(SORT) ;Sort out the variables "RTN","SDECRMG1",228,0) SORT(SORT,IEN,WAITD,TYP,PT,SVCPINV,PGRP,CLGP,DDTE,ODTE,SCPRI,MGIENS) ; "RTN","SDECRMG1",229,0) N SOR,SCNT,SD,STRING,DLM,STR "RTN","SDECRMG1",230,0) N STCNT,STID,STJ,STTYP "RTN","SDECRMG1",231,0) S SCNT=0,(STR,STRING)="",DLM="|" "RTN","SDECRMG1",232,0) I $D(MGIENS(TYP_IEN)) S STRING="0|0|0" "RTN","SDECRMG1",233,0) S SOR="" F S SOR=$O(SORT(SOR)) Q:SOR'>0 D "RTN","SDECRMG1",234,0) .S SCNT=SCNT+1 "RTN","SDECRMG1",235,0) .S SD=$G(SORT(SOR)) "RTN","SDECRMG1",236,0) .S STR="" "RTN","SDECRMG1",237,0) .;I SD?1A1.N.A D "RTN","SDECRMG1",238,0) .;.S STCNT=-1 "RTN","SDECRMG1",239,0) .;.S STTYP=$E(SD,1),SD=$E(SD,2,$L(SD)) "RTN","SDECRMG1",240,0) .;.F STJ=1:1:$L(SD,"~") D "RTN","SDECRMG1",241,0) .;..S STID=$P(SD,"~",STJ) "RTN","SDECRMG1",242,0) .;..Q:TYP'=STTYP "RTN","SDECRMG1",243,0) .;..Q:STID'=IEN "RTN","SDECRMG1",244,0) .;..S STCNT=STCNT+1 S STR="0|"_STCNT "RTN","SDECRMG1",245,0) .S STR=$S(SD="RTOPD":$S(TYP="R":0,1:1),SD="ATOPD":$S(TYP="A":0,1:1),SD="ETOPD":$S(TYP="E":0,1:1),SD="CTOPD":$S(TYP="C":0,1:1),1:"") "RTN","SDECRMG1",246,0) .S:STR=0 STR=STR_"|"_$$PAD(999999999-IEN) "RTN","SDECRMG1",247,0) .I SD="PRIORITYGROUP" D "RTN","SDECRMG1",248,0) ..S STR=$S(PGRP="GROUP 0":0,PGRP="GROUP 1":1,PGRP="GROUP 2":2,PGRP="GROUP 3":3,PGRP="GROUP 4":4,PGRP="GROUP 5":5,PGRP="GROUP 6":6,PGRP="GROUP 7":7,PGRP="GROUP 8":8,1:0) "RTN","SDECRMG1",249,0) ..S STR=STR_DLM_0 "RTN","SDECRMG1",250,0) ..;I +SCPRI S STR=$S(STR=0:0,1:1)_DLM_0 "RTN","SDECRMG1",251,0) ..;E S STR=STR_DLM_1 "RTN","SDECRMG1",252,0) .S:STR="" STR=$S(SD="WAITTIME":WAITD,SD="REQUESTTYPE":TYP,SD="PATIENTNAME":PT,SD="SCVISIT":SVCPINV,SD="CLINICS":CLGP,SD="DESIREDDATE":DDTE,SD="ORIGINATIONDATE":ODTE,1:"") "RTN","SDECRMG1",253,0) .I SD="PATIENTNAME" S STR=$$GET1^DIQ(2,PT_",",.01) "RTN","SDECRMG1",254,0) .I SD="CLINICS" S STR=$$GET1^DIQ(44,CLGP_",",.01) "RTN","SDECRMG1",255,0) .I STRING="" S STRING=STR "RTN","SDECRMG1",256,0) .E S STRING=STRING_DLM_STR "RTN","SDECRMG1",257,0) Q STRING "RTN","SDECRMG1",258,0) ; "RTN","SDECRMG1",259,0) PAD(STRING,CHAR,CNT) ;prepend characters (default is 0 zero) to STRING "RTN","SDECRMG1",260,0) N SDI,SDR "RTN","SDECRMG1",261,0) S STRING=$G(STRING) "RTN","SDECRMG1",262,0) S CHAR=$G(CHAR) "RTN","SDECRMG1",263,0) S:CHAR="" CHAR="0" "RTN","SDECRMG1",264,0) S CNT=$G(CNT) "RTN","SDECRMG1",265,0) S:+CNT CNT=+CNT+1 "RTN","SDECRMG1",266,0) S:'+CNT CNT=10 ;(9 characters) "RTN","SDECRMG1",267,0) S $P(SDR,CHAR,CNT-$L(STRING))=STRING "RTN","SDECRMG1",268,0) Q SDR "RTN","SDECRMG1",269,0) ; Test for tag/routine "RTN","SDECRMG1",270,0) TEST(X) ;EP "RTN","SDECRMG1",271,0) N Z "RTN","SDECRMG1",272,0) S:X[U Z=$P(X,U),X=$P(X,U,2) "RTN","SDECRMG1",273,0) Q:'$L(X)!(X'?.1"%"1.AN) 0 "RTN","SDECRMG1",274,0) X ^%ZOSF("TEST") "RTN","SDECRMG1",275,0) Q $S('$T:0,$G(Z)="":1,Z'?.1"%"1.AN:0,1:$T(@Z^@X)'="") "RTN","SDECRMG1",276,0) ; "RTN","SDECRMG1",277,0) TMPGBL() ;EP- "RTN","SDECRMG1",278,0) K ^TMP("SDECIDX",$J) Q $NA(^($J)) "RTN","SDECRMG1",279,0) ; Convert external dates to FileMan format "RTN","SDECRMG1",280,0) CVTDT(VAL) ;EP- "RTN","SDECRMG1",281,0) D DT^DILF(,VAL,.VAL) "RTN","SDECRMG1",282,0) Q VAL "RTN","SDECRMG1",283,0) ; Returns inverse date value "RTN","SDECRMG1",284,0) INVDT(VAL) ;EP- "RTN","SDECRMG1",285,0) Q:(VAL<1) VAL "RTN","SDECRMG1",286,0) Q (9999999.9999-VAL) "RTN","SDECRMG1",287,0) RECCNT(DATA) ;EP- "RTN","SDECRMG1",288,0) S DATA=$G(^TMP("SDECIDX",$J,"COUNT")) "RTN","SDECRMG1",289,0) Q "RTN","SDECRMG2") 0^5^B68379335^B65998765 "RTN","SDECRMG2",1,0) SDECRMG2 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 19, 2016 "RTN","SDECRMG2",2,0) ;;5.3;Scheduling;**627,642,651**;Aug 13, 1993;Build 14 "RTN","SDECRMG2",3,0) ; "RTN","SDECRMG2",4,0) ;Reference is made to ICR #6185 "RTN","SDECRMG2",5,0) Q "RTN","SDECRMG2",6,0) ; "RTN","SDECRMG2",7,0) URGENCY(SDECY) ;GET valid urgency protocol values that are used in the URGENCY field 5 of the REQUEST CONSULTAION file 123 "RTN","SDECRMG2",8,0) ;INPUT: none "RTN","SDECRMG2",9,0) ;RETURN: "RTN","SDECRMG2",10,0) ; Global array in which each entry contains the IEN and NAME of a protocol entry "RTN","SDECRMG2",11,0) ; 1. IEN - pointer to PROTOCOL file 101 "RTN","SDECRMG2",12,0) ; 2. NAME - name field from PROTOCOL file "RTN","SDECRMG2",13,0) ; 3. SYNONYM - Short name list separated by pipe. "RTN","SDECRMG2",14,0) ; Synonym that might be what is recognized by the users "RTN","SDECRMG2",15,0) N SDECI,SDI,SDID,SDJ,SDK,SDNAME,SDSYN "RTN","SDECRMG2",16,0) S SDECY="^TMP(""SDECRMG2"","_$J_",""URGENCY"")" "RTN","SDECRMG2",17,0) K @SDECY "RTN","SDECRMG2",18,0) S SDECI=0 "RTN","SDECRMG2",19,0) S @SDECY@(SDECI)="T00030IEN^T00030NAME^T00030SYNONYM"_$C(30) "RTN","SDECRMG2",20,0) S SDI="GMRCURGENCY" F S SDI=$O(^ORD(101,"B",SDI)) Q:$P(SDI," ",1)'="GMRCURGENCY" Q:SDI="" D "RTN","SDECRMG2",21,0) .S SDJ="" F S SDJ=$O(^ORD(101,"B",SDI,SDJ)) Q:SDJ="" D "RTN","SDECRMG2",22,0) ..S SDNAME=$$GET1^DIQ(101,SDJ_",",.01) "RTN","SDECRMG2",23,0) ..S SDSYN="" "RTN","SDECRMG2",24,0) ..S SDK=0 F S SDK=$O(^ORD(101,SDJ,2,SDK)) Q:SDK'>0 D "RTN","SDECRMG2",25,0) ...S SDSYN=SDSYN_$S(SDSYN'="":"|",1:"")_$$GET1^DIQ(101.02,SDK_","_SDJ_",",.01) "RTN","SDECRMG2",26,0) ..S SDECI=SDECI+1 "RTN","SDECRMG2",27,0) ..S @SDECY@(SDECI)=SDJ_U_SDNAME_U_SDSYN_$C(30) "RTN","SDECRMG2",28,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDECRMG2",29,0) Q "RTN","SDECRMG2",30,0) ; "RTN","SDECRMG2",31,0) CONSULT(RET,MAXREC,DFN,SDBEG,SDEND,CLINIC,PRI,SVCCONN,SVCCON,ORIGDT,DESDT,DESDTR,PRIGRP,SORT,PTS,SDMAX,URG,SDSVC,SDLASTC,ORIGDTR,SDCNT,MGIENS,SDALL) ;REQUEST/CONSULTATION "RTN","SDECRMG2",32,0) N LOOP,CLIEN,SDSTOP "RTN","SDECRMG2",33,0) Q:$G(SVCCON)'="" ;only SD WAIT LIST and SDEC APPT REQUEST have this value "RTN","SDECRMG2",34,0) Q:+$G(CLINIC) "RTN","SDECRMG2",35,0) S SVCCONN=$G(SVCCONN) "RTN","SDECRMG2",36,0) S SDSVC=$G(SDSVC) "RTN","SDECRMG2",37,0) S SDMAX=$G(SDMAX,200) ;S SDMAX=$S(+SDMAX>100:100,+SDMAX:SDMAX,1:50) "RTN","SDECRMG2",38,0) S SDSTOP=+$D(SORT("B","CTOPD")) "RTN","SDECRMG2",39,0) S SDBEG=$G(SDBEG) S:SDBEG="" SDBEG=1000101 "RTN","SDECRMG2",40,0) S SDEND=$G(SDEND) S:SDEND="" SDEND=$S(DFN'="":9991231,1:$$FMADD^XLFDT($$NOW^XLFDT,-90)) "RTN","SDECRMG2",41,0) I $D(SDALL("C")) D CDTRALL Q "RTN","SDECRMG2",42,0) I +DFN D CDFN Q "RTN","SDECRMG2",43,0) ;I DESDT'="" D CDTR Q "RTN","SDECRMG2",44,0) ;I DESDTR'="" D CDTR1 Q "RTN","SDECRMG2",45,0) I ORIGDT'="" D COR Q "RTN","SDECRMG2",46,0) I +CLINIC D Q "RTN","SDECRMG2",47,0) .S LOOP="" F S LOOP=$O(CLINIC(LOOP)) Q:LOOP="" D "RTN","SDECRMG2",48,0) ..S CLIEN=LOOP "RTN","SDECRMG2",49,0) ..D CSDCL "RTN","SDECRMG2",50,0) D CDTR "RTN","SDECRMG2",51,0) Q "RTN","SDECRMG2",52,0) COR ;look up REQUEST/CONSULTATION by file entry date "RTN","SDECRMG2",53,0) N SDGMR,SDI,SDJ "RTN","SDECRMG2",54,0) N %DT,X,Y "RTN","SDECRMG2",55,0) S SDI="" F S SDI=$O(ORIGDT(SDI)) Q:SDI="" D "RTN","SDECRMG2",56,0) .S SDJ=SDI "RTN","SDECRMG2",57,0) .F S SDJ=$O(^GMR(123,"B",SDJ)) Q:SDJ'>0 Q:$P(SDJ,".",1)'=SDI D Q:SDCNT'0 D CGET1 Q:SDCNT'0 D CGET1 Q:SDCNT'0 D CGET1 Q:SDCNT'0 D CGET1 Q:SDCNT'0 Q:$P(SDJ,".",1)>SDEND D Q:SDCNT'0 D CGET1 Q:SDCNT'0 Q:$P(SDJ,".",1)>SDEND D Q:SDCNT'0 D CGET1 Q:SDCNT'0 Q:(DESDT'="")&($P(SDJ,".",1)'=SDJ1) Q:SDJ0 D CGET1 Q:SDCNT'0 Q:(DESDT'="")&($P(SDJ,".",1)'=SDJ1) Q:SDJ0 D CGET1 Q:SDCNT'0 Q:SDJ>SDJ1 D Q:SDCNT'0 D CGET1 Q:SDCNT'0 D Q:SDCNT'0 D CGET1 Q:SDCNT'0 Q:SDJ>SDBEGI D Q:SDCNT'0 D CGET1 Q:SDCNT'0 Q:(DESDT'="")&($P(SDJ,".",1)'=SDJ1) Q:SDJ0 D CGET1 Q:SDCNT'Y ;alb/sat 651 - do not return entries older than 365 days "RTN","SDECRMG2",130,0) I +URG I '$D(URG(+$P(SDR,U,43))) Q "RTN","SDECRMG2",131,0) S SDR2=$P($P(SDR,U,2),".",1) ; S %DT="" S X=$P(SDR2,"@",1) D ^%DT S SDR2=$P(Y,".",1) "RTN","SDECRMG2",132,0) S SDR9=$P($P(SDR,U,9),".",1) ; S %DT="" S X=$P(SDR8,"@",1) D ^%DT S SDR8=$P(Y,".",1) "RTN","SDECRMG2",133,0) S PGRP=$P(SDR,U,24) "RTN","SDECRMG2",134,0) S PT=$P(SDR,U,3) ;Patient "RTN","SDECRMG2",135,0) I PTS'="",PT'="",$D(PTS(PT))=0 Q "RTN","SDECRMG2",136,0) I PGRP="" S PGRP="GROUP 0" "RTN","SDECRMG2",137,0) I PRIGRP'="",$D(PRI(PGRP))=0 Q ;No match on priority group "RTN","SDECRMG2",138,0) S CLGP=$P(SDR,U,6) "RTN","SDECRMG2",139,0) I +$G(CLINIC),$D(CLINIC(+CLGP))=0 Q ;match clinic "RTN","SDECRMG2",140,0) S DESGP=$P(SDR,U,9) "RTN","SDECRMG2",141,0) S SDEDT=$P(SDR,U,49) I SDEDT'="",(SDEDT>SDEND)!(SDEDTSDR8SDEND) G CGET1X ;check date range of earliest date "RTN","SDECRMG2",144,0) I +DESDT,$D(DESDT(+SDEDT))=0 Q ;match EARLIEST DATE with desired date "RTN","SDECRMG2",145,0) S ORIGGP=$P(SDR,U,2) "RTN","SDECRMG2",146,0) I SDEDT="",ORIGGP'="",(ORIGGP>SDEND)!(ORIGGP$P(ORIGDTR,"~",2)) Q ;match origination date range with file entry date "RTN","SDECRMG2",148,0) I ORIGDT'="",ORIGGP'="",$D(ORIGDT($P(ORIGGP,".",1)))=0 Q ;match origination date with file entry date "RTN","SDECRMG2",149,0) I SVCCONN'="",SVCCONN'="BOTH" Q:(SVCCONN="NO")&($P(SDR,U,27)="") Q:SVCCONN'=$P(SDR,U,27) ;SCVisit for filter (patient) "RTN","SDECRMG2",150,0) ;I +SDSVC N SDSVCN S SDSVCN=$$GET1^DIQ(44,+$P(SDR,U,6)_",",8,"E") Q:SDSVCN="" Q:'$D(SDSVC(SDSVCN)) ;check service "RTN","SDECRMG2",151,0) I +SDSVC D Q:'SDSVCF "RTN","SDECRMG2",152,0) .D STOP^SDECGMR(.GMRSTOP,SDGMR) "RTN","SDECRMG2",153,0) .S SDI=0 F S SDI=$O(GMRSTOP(SDI)) Q:SDI="" D Q:SDSVCF=1 "RTN","SDECRMG2",154,0) ..S SDSVCN=GMRSTOP(SDI) "RTN","SDECRMG2",155,0) ..S:$D(SDSVC(SDSVCN)) SDSVCF=1 "RTN","SDECRMG2",156,0) S SCPRI=0 ;SCVisit for sorting "RTN","SDECRMG2",157,0) S WAITD=$$FMDIFF^XLFDT($P($$NOW^XLFDT,".",1),$$CVTDT^SDECRMG1($P(SDR,U,2))) "RTN","SDECRMG2",158,0) S IEN=$P(SDR,U,1) "RTN","SDECRMG2",159,0) S SVCP=$P(SDR,U,28) "RTN","SDECRMG2",160,0) S SVCPINV=100-SVCP "RTN","SDECRMG2",161,0) ;S ODTE=$$INVDT^SDECRMG1($P(SDR2,".")) "RTN","SDECRMG2",162,0) S ODTE=$P(SDR2,".") "RTN","SDECRMG2",163,0) S DDTE=$TR($P(SDR9,"-",2)," ","") "RTN","SDECRMG2",164,0) S WAITD=9999999-WAITD "RTN","SDECRMG2",165,0) ;S SORTSTR=$$SORT^SDECRMG1(.SORT) "RTN","SDECRMG2",166,0) ;S SORTSTR=$$SORT^SDECRMG1(.SORT,IEN,WAITD,TYP,PT,SVCPINV,PGRP,CLGP,DDTE,ODTE,SCPRI) "RTN","SDECRMG2",167,0) S SORTSTR=$$SORT^SDECRMG1(.SORT,IEN,WAITD,TYP,PT,SVCPINV,PGRP,CLGP,SDEDT,ODTE,SCPRI) "RTN","SDECRMG2",168,0) D SETNODE^SDECRMG1(WAITD,TYP,IEN,SDR,42,SORTSTR,.SDCNT) "RTN","SDECRMG2",169,0) ;S SDCNT=SDCNT+1 "RTN","SDECRMG2",170,0) Q "RTN","SDECRMG2",171,0) CGET1X ; "RTN","SDECRMG2",172,0) K @SDECY "RTN","SDECRMG2",173,0) Q "RTN","SDECRMG2",174,0) ; "RTN","SDECRMG2",175,0) INRANGE(CHK,BEG,END) ; "RTN","SDECRMG2",176,0) ; return 1 if CHK is within BEG and END inclusive "RTN","SDECRMG2",177,0) ; return 0 if not "RTN","SDECRMG2",178,0) Q:CHK="" 0 "RTN","SDECRMG2",179,0) Q:CHKEND 0 "RTN","SDECRMG2",181,0) Q 1 "RTN","SDECRMG2",182,0) ; "RTN","SDECRMG2",183,0) MGIENS(MGIENS,MAXREC,DFN,SDBEG,SDEND,CLINIC,PRI,SVCCONN,SVCCON,ORIGDT,DESDT,DESDTR,PRIGRP,SORT,PTS,SDMAX,URG,SDSVC,SDLASTA,ORIGDTR,SDCNT) ;get specified IENs and sort to the top "RTN","SDECRMG2",184,0) ; MGIENS("A123")="" "RTN","SDECRMG2",185,0) N SDI,SIEN,STYP "RTN","SDECRMG2",186,0) S SDI="" F S SDI=$O(MGIENS(SDI)) Q:SDI="" D "RTN","SDECRMG2",187,0) .S STYP=$E(SDI,1) "RTN","SDECRMG2",188,0) .S SIEN=$E(SDI,2,$L(SDI)) "RTN","SDECRMG2",189,0) .D @STYP "RTN","SDECRMG2",190,0) Q "RTN","SDECRMG2",191,0) A ; "RTN","SDECRMG2",192,0) N NOD,RET "RTN","SDECRMG2",193,0) D ARGET^SDEC(.RET,SIEN) "RTN","SDECRMG2",194,0) S NOD=@RET@(1) D APPT1^SDECRMG1(MAXREC,DFN,SDBEG,SDEND,.CLINIC,.PRI,SVCCONN,SVCCON,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLASTA,.ORIGDTR,.SDCNT,NOD,.MGIENS) "RTN","SDECRMG2",195,0) Q "RTN","SDECRMG2",196,0) C ; "RTN","SDECRMG2",197,0) Q "RTN","SDECRMG2",198,0) E ; "RTN","SDECRMG2",199,0) N NOD,RET "RTN","SDECRMG2",200,0) D WLGET^SDEC(.RET,SIEN) "RTN","SDECRMG2",201,0) S NOD=@RET@(1) D WAIT1^SDECRMG1(MAXREC,DFN,SDBEG,SDEND,.CLINIC,.PRI,SVCCONN,SVCCON,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLASTA,.ORIGDTR,.SDCNT,NOD,.MGIENS) "RTN","SDECRMG2",202,0) Q "RTN","SDECRMG2",203,0) R ; "RTN","SDECRMG2",204,0) Q "RTN","SDN") 0^12^B34257653^B32745405 "RTN","SDN",1,0) SDN ;SF/GFT,ALB/LDB - RECORD NO SHOWS ;JUL 19, 2016 "RTN","SDN",2,0) ;;5.3;Scheduling;**32,79,398,478,627,651**;Aug 13, 1993;Build 14 "RTN","SDN",3,0) ; "RTN","SDN",4,0) N SDATA ; for evt driver "RTN","SDN",5,0) S U="^" D NOW^%DTC S SDTIME=%,SDLT1="" K ^UTILITY($J),SDCP,SDLT D LO^DGUTL "RTN","SDN",6,0) S SDDT=DT,SDV1=$O(^DG(40.8,0)) D DIV^SDUTL I $T S DIC=40.8,DIC(0)="AEQM" S SDLT=1 D NSLET1^SDDIV K SDLT G:Y<0 END^SDN0 S SDV1=DIV "RTN","SDN",7,0) 7 R !!,"NO-SHOWS FOR WHAT DATE: ",X:DTIME Q:U[X S %DT="EP",%DT(0)=-DT D ^%DT G 7:Y<0 S SDT=Y,SDYES="" "RTN","SDN",8,0) S SM="S SDCT=0 F I=SD1:0:SD2 S I=$N(^DPT(+Y,""S"",I)) S:I<0!(I'1!($P(SDSTAT,";",4)) R !!,"SELECT APPOINTMENT: ",SDCT:DTIME Q:'$T!(U[SDCT) I SDCT["?"!('$D(SDT(SDCT))) W !,"Please enter one number to indicate which appointment." S SDCT=SDCNT G ASK "RTN","SDN",89,0) W ! Q "RTN","SDN",90,0) ; "RTN","SDN",91,0) EVT ; -- separate tag if need to NEW vars "RTN","SDN",92,0) N I,SDINP,Y,SDSTAT,SDTIME,SDYES,SM,SM1,SD1,SD2,SDMSG,SDT,SDCT,CNSTLNK,CN,CNPAT "RTN","SDN",93,0) D NOSHOW^SDAMEVT(.SDATA,DFN,SDDTM,SC,SDDA,0,SDNSHDL) "RTN","SDN",94,0) S CNSTLNK="",CN=0 F S CN=$O(^SC(SC,"S",SDDTM,1,CN)) Q:'+CN S CNPAT=$P($G(^SC(SC,"S",SDDTM,1,CN,0)),U) I CNPAT=DFN S CNSTLNK=$P($G(^SC(SC,"S",SDDTM,1,CN,"CONS")),U) Q ;SD/478 "RTN","SDN",95,0) D:+CNSTLNK NOSHOW^SDCNSLT(SC,SDDTM,CNPAT,CNSTLNK,CN,.AUTO,.NSDIE,.NSDA) ;SD/478 "RTN","SDN",96,0) Q "RTN","SDN",97,0) ; "VER") 8.0^22.0 "BLD",9603,6) ^544 **END** **END**