Released SD*5.3*672 SEQ #560 Extracted from mail message **KIDS**:SD*5.3*672^ **INSTALL NAME** SD*5.3*672 "BLD",10319,0) SD*5.3*672^SCHEDULING^0^3170926^y "BLD",10319,4,0) ^9.64PA^^ "BLD",10319,6.3) 9 "BLD",10319,"KRN",0) ^9.67PA^779.2^20 "BLD",10319,"KRN",.4,0) .4 "BLD",10319,"KRN",.401,0) .401 "BLD",10319,"KRN",.402,0) .402 "BLD",10319,"KRN",.403,0) .403 "BLD",10319,"KRN",.5,0) .5 "BLD",10319,"KRN",.84,0) .84 "BLD",10319,"KRN",3.6,0) 3.6 "BLD",10319,"KRN",3.8,0) 3.8 "BLD",10319,"KRN",9.2,0) 9.2 "BLD",10319,"KRN",9.8,0) 9.8 "BLD",10319,"KRN",9.8,"NM",0) ^9.68A^10^10 "BLD",10319,"KRN",9.8,"NM",1,0) SDRRREP^^0^B11839336 "BLD",10319,"KRN",9.8,"NM",2,0) SDECWL^^0^B102048711 "BLD",10319,"KRN",9.8,"NM",3,0) SDEC56^^0^B65059855 "BLD",10319,"KRN",9.8,"NM",4,0) SDEC54A^^0^B86091542 "BLD",10319,"KRN",9.8,"NM",5,0) SDEC50^^0^B102324779 "BLD",10319,"KRN",9.8,"NM",6,0) SDEC32^^0^B114220847 "BLD",10319,"KRN",9.8,"NM",7,0) SDEC07^^0^B193088585 "BLD",10319,"KRN",9.8,"NM",8,0) SDEC01A^^0^B123678452 "BLD",10319,"KRN",9.8,"NM",9,0) SDEC^^0^B129523309 "BLD",10319,"KRN",9.8,"NM",10,0) SDEC02^^0^B68680067 "BLD",10319,"KRN",9.8,"NM","B","SDEC",9) "BLD",10319,"KRN",9.8,"NM","B","SDEC01A",8) "BLD",10319,"KRN",9.8,"NM","B","SDEC02",10) "BLD",10319,"KRN",9.8,"NM","B","SDEC07",7) "BLD",10319,"KRN",9.8,"NM","B","SDEC32",6) "BLD",10319,"KRN",9.8,"NM","B","SDEC50",5) "BLD",10319,"KRN",9.8,"NM","B","SDEC54A",4) "BLD",10319,"KRN",9.8,"NM","B","SDEC56",3) "BLD",10319,"KRN",9.8,"NM","B","SDECWL",2) "BLD",10319,"KRN",9.8,"NM","B","SDRRREP",1) "BLD",10319,"KRN",19,0) 19 "BLD",10319,"KRN",19.1,0) 19.1 "BLD",10319,"KRN",101,0) 101 "BLD",10319,"KRN",409.61,0) 409.61 "BLD",10319,"KRN",771,0) 771 "BLD",10319,"KRN",779.2,0) 779.2 "BLD",10319,"KRN",870,0) 870 "BLD",10319,"KRN",8989.51,0) 8989.51 "BLD",10319,"KRN",8989.51,"NM",0) ^9.68A^1^1 "BLD",10319,"KRN",8989.51,"NM",1,0) SDEC VS GUI CLINIC VIEW^^0 "BLD",10319,"KRN",8989.51,"NM","B","SDEC VS GUI CLINIC VIEW",1) "BLD",10319,"KRN",8989.52,0) 8989.52 "BLD",10319,"KRN",8994,0) 8994 "BLD",10319,"KRN","B",.4,.4) "BLD",10319,"KRN","B",.401,.401) "BLD",10319,"KRN","B",.402,.402) "BLD",10319,"KRN","B",.403,.403) "BLD",10319,"KRN","B",.5,.5) "BLD",10319,"KRN","B",.84,.84) "BLD",10319,"KRN","B",3.6,3.6) "BLD",10319,"KRN","B",3.8,3.8) "BLD",10319,"KRN","B",9.2,9.2) "BLD",10319,"KRN","B",9.8,9.8) "BLD",10319,"KRN","B",19,19) "BLD",10319,"KRN","B",19.1,19.1) "BLD",10319,"KRN","B",101,101) "BLD",10319,"KRN","B",409.61,409.61) "BLD",10319,"KRN","B",771,771) "BLD",10319,"KRN","B",779.2,779.2) "BLD",10319,"KRN","B",870,870) "BLD",10319,"KRN","B",8989.51,8989.51) "BLD",10319,"KRN","B",8989.52,8989.52) "BLD",10319,"KRN","B",8994,8994) "BLD",10319,"QUES",0) ^9.62^^ "BLD",10319,"REQB",0) ^9.611^1^1 "BLD",10319,"REQB",1,0) SD*5.3*671^1 "BLD",10319,"REQB","B","SD*5.3*671",1) "KRN",8989.51,835,-1) 0^1 "KRN",8989.51,835,0) SDEC VS GUI CLINIC VIEW^VistA Scheduling GUI Clinic View^1^^VIEW "KRN",8989.51,835,1) S^D:DAY;W:WEEK^ENTER D or DAY for Day OR ENTER W or WEEK for Week view "KRN",8989.51,835,6) P^44^ENTER D or DAY for Day OR ENTER W or WEEK for Week view "KRN",8989.51,835,30,0) ^8989.513I^1^1 "KRN",8989.51,835,30,1,0) 1^9.4 "MBREQ") 0 "ORD",20,8989.51) 8989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^XPDIA3(%) "ORD",20,8989.51,0) PARAMETER DEFINITION "PKG",48,-1) 1^1 "PKG",48,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",48,20,0) ^9.402P^^ "PKG",48,22,0) ^9.49I^1^1 "PKG",48,22,1,0) 5.3^3051119^2960613 "PKG",48,22,1,"PAH",1,0) 672^3170926 "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") 10 "RTN","SDEC") 0^9^B129523309^B129056425 "RTN","SDEC",1,0) SDEC ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDEC",2,0) ;;5.3;Scheduling;**627,643,642,651,658,665,672**;Aug 13, 1993;Build 9 "RTN","SDEC",3,0) ; "RTN","SDEC",4,0) Q "RTN","SDEC",5,0) ; "RTN","SDEC",6,0) ACCGROUP(SDECY) ;EP return active entries from the SDEC ACCESS GROUP file 409.822 "RTN","SDEC",7,0) D ACCGROUP^SDEC45(.SDECY) Q "RTN","SDEC",8,0) ACCGPTYG(SDECY) ;EP Get access group types "RTN","SDEC",9,0) D ACCGPTYG^SDEC15(.SDECY) Q "RTN","SDEC",10,0) ACCTYPE(SDECY) ;EP return active entries from the SDEC ACCESS TYPE file 409.823 "RTN","SDEC",11,0) D ACCTYPE^SDEC45(.SDECY) Q "RTN","SDEC",12,0) ADDACCG(SDECY,SDECVAL) ;EP ADD/EDIT ACCESS GROUP "RTN","SDEC",13,0) D ADDACCG^SDEC21(.SDECY,$G(SDECVAL)) Q "RTN","SDEC",14,0) ADDACCTY(SDECY,SDECVAL) ;EP ADD/EDIT ACCESS TYPE "RTN","SDEC",15,0) D ADDACCTY^SDEC14(.SDECY,$G(SDECVAL)) Q "RTN","SDEC",16,0) ADDAGI(SDECY,SDECIEN,SDECIEN1) ;EP Add access group item - Adds ACCESS GROUP TYPE file entry "RTN","SDEC",17,0) D ADDAGI^SDEC22(.SDECY,$G(SDECIEN),$G(SDECIEN1)) Q "RTN","SDEC",18,0) ADDRES(SDECY,SDECVAL) ;EP ADD/EDIT RESOURCE "RTN","SDEC",19,0) D ADDRES^SDEC16(.SDECY,$G(SDECVAL)) Q "RTN","SDEC",20,0) ADDRESU(SDECY,SDECVAL) ;EP ADD/EDIT RESOURCE USER "RTN","SDEC",21,0) D ADDRESU^SDEC18(.SDECY,$G(SDECVAL)) Q "RTN","SDEC",22,0) ADDRG(SDECY,SDECVAL) ;EP ADD/EDIT RESOURCE GROUP "RTN","SDEC",23,0) D ADDRG^SDEC19(.SDECY,$G(SDECVAL)) Q "RTN","SDEC",24,0) ADDRGI(SDECY,SDECIEN,SDECIEN1) ;EP Adds RESOURCEID SDECIEN1 to RESOURCE GROUP entry SDECIEN "RTN","SDEC",25,0) D ADDRGI^SDEC20(.SDECY,$G(SDECIEN),$G(SDECIEN1)) Q "RTN","SDEC",26,0) APBLKALL(SDECY,SDECSTART,SDECEND) ;EP List of all appointments for all resources "RTN","SDEC",27,0) D APBLKALL^SDEC05(.SDECY,$G(SDECSTART),$G(SDECEND)) Q "RTN","SDEC",28,0) APBLKOV(SDECY,SDECSTART,SDECEND,SDECRES,SDECWI) ;EP APPT BLOCKS OVERLAP "RTN","SDEC",29,0) D APBLKOV^SDEC05(.SDECY,$G(SDECSTART),$G(SDECEND),$G(SDECRES),$G(SDECWI)) Q "RTN","SDEC",30,0) APPADD ;EP ADD NEW APPOINTMENT "RTN","SDEC",31,0) Q ;rpc calls directly to APPADD^SDEC07 "RTN","SDEC",32,0) APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER) ;EP Cancels appointment "RTN","SDEC",33,0) D APPDEL^SDEC08(.SDECY,$G(SDECAPTID),$G(SDECTYP),$G(SDECCR),$G(SDECNOT),$G(SDECDATE),$G(SDUSER)) Q "RTN","SDEC",34,0) APPIDGET(SDECY,SDID) ;GET SDEC APPOINTMENT ien for given External ID "RTN","SDEC",35,0) D APPIDGET^SDEC55(.SDECY,$G(SDID)) Q "RTN","SDEC",36,0) APPSDGET(SDECY,MAXREC,LASTSUB,SDBEG,SDEND,NOTEFLG,SDRES,DFN,SDID,SDIEN) ;GET appointment data from SDEC APPOINTMENT file 409.84 "RTN","SDEC",37,0) D APPSDGET^SDEC55A(.SDECY,$G(MAXREC),$G(LASTSUB),$G(SDBEG),$G(SDEND),$G(NOTEFLG),$G(SDRES),$G(DFN),$G(SDID),$G(SDIEN)) Q "RTN","SDEC",38,0) APPSLOTS(SDECY,SDCL,SDBEG,SDEND) ;return array of appt slots and availability - RPC "RTN","SDEC",39,0) D APPSLOTS^SDEC57(.SDECY,$G(SDCL),$G(SDBEG),$G(SDEND)) Q "RTN","SDEC",40,0) APPTEVLG(SDECY,DFN) ;EP return appointment data for given patient - RPC "RTN","SDEC",41,0) D APPTEVLG^SDEC38(.SDECY,$G(DFN)) Q "RTN","SDEC",42,0) APPTLETR(SDECY,SDECAPID,LT) ;EP Print Appointment Letter "RTN","SDEC",43,0) D APPTLETR^SDEC40(.SDECY,$G(SDECAPID),$G(LT)) Q "RTN","SDEC",44,0) APPTYPES(RET,DFN) ; EP for SDEC APPTYPES - Return all active Appointment types from the APPOINTMENT TYPE file 409.1 "RTN","SDEC",45,0) D APPTYPES^SDECWL(.RET,$G(DFN)) Q "RTN","SDEC",46,0) ARCLOSE(RET,INP...) ; "RTN","SDEC",47,0) D ARCLOSE^SDECAR(.RET,.INP) Q "RTN","SDEC",48,0) ARCLOSE1(RET,INP) ; Appt Request CLOSE (without ... for VistA calls) "RTN","SDEC",49,0) D ARCLOSE^SDECAR(.RET,.INP) Q "RTN","SDEC",50,0) ARDGET(SDECY) ;get values for disposition field of SDEC APPT REQUEST file "RTN","SDEC",51,0) D ARDGET^SDECAR(.SDECY) Q "RTN","SDEC",52,0) ARGET(RET,ARIEN1,MAXREC,SDBEG,SDEND,DFN,LASTSUB,SDTOP,SVCL,DESDT,PRL,SVCR,SCVISIT,CLINIC,ORIGDT) ;EP Appt Request GET "RTN","SDEC",53,0) D ARGET^SDECAR1(.RET,$G(ARIEN1),$G(MAXREC),$G(SDBEG),$G(SDEND),$G(DFN),$G(LASTSUB),$G(SDTOP),$G(SVCL),$G(DESDT),$G(PRL),$G(SVCR),$G(SCVISIT),$G(CLINIC),$G(ORIGDT)) Q "RTN","SDEC",54,0) ARMRTGET(SDECY,ARIEN) ;GET number of entries and values in MRTC CALC PREF DATES "RTN","SDEC",55,0) D ARMRTGET^SDECAR(.SDECY,$G(ARIEN)) Q "RTN","SDEC",56,0) ARMRTSET(SDECY,ARIEN,MRTC) ;SET MRTC CALC PREF DATES dates - clears the multiple and sets the new ones that are passed in "RTN","SDEC",57,0) D ARMRTSET^SDECAR(.SDECY,$G(ARIEN),$G(MRTC)) Q "RTN","SDEC",58,0) AROPEN(RET,ARAPP,ARIEN,ARDDT) ;Appt Request Open/re-open "RTN","SDEC",59,0) D AROPEN^SDECAR(.RET,$G(ARAPP),$G(ARIEN),$G(ARDDT)) Q "RTN","SDEC",60,0) ARPCSET(SDECY,INP,ARIEN) ;SET update patient contacts in SDEC APPT REQUEST file "RTN","SDEC",61,0) D ARPCSET^SDECAR(.SDECY,$G(INP),$G(ARIEN)) Q "RTN","SDEC",62,0) ARSET(RET,INP...) ;EP Appt Request Set "RTN","SDEC",63,0) D ARSET^SDECAR2(.RET,.INP) Q "RTN","SDEC",64,0) ARSET1(RET,INP) ;EP Appt Request Set (without ... for VistA calls) "RTN","SDEC",65,0) D ARSET^SDECAR2(.RET,.INP) Q "RTN","SDEC",66,0) AVADD(SDECY,SDECSTART,SDECEND,SDECTYPID,SDECRES,SDECSLOTS,SDECNOTE) ;EP SET Create entry in SDEC ACCESS BLOCK "RTN","SDEC",67,0) D AVADD^SDEC12(.SDECY,$G(SDECSTART),$G(SDECEND),$G(SDECTYPID),$G(SDECRES),$G(SDECSLOTS),$G(SDECNOTE)) Q "RTN","SDEC",68,0) AVDEL(SDECY,SDECAVID) ;EP Cancel Availability - Deletes Access Block "RTN","SDEC",69,0) D AVDEL^SDEC13(.SDECY,$G(SDECAVID)) Q "RTN","SDEC",70,0) AVDELDT(SDECY,SDECRESD,SDECSTART,SDECEND) ;EP Cancel availability in a date range "RTN","SDEC",71,0) D AVDELDT^SDEC13(.SDECY,$G(SDECRESD),$G(SDECSTART),$G(SDECEND)) Q "RTN","SDEC",72,0) CANCKOUT(SDECY,SDECAPTID) ;EP Cancel Check Out appointment "RTN","SDEC",73,0) D CANCKOUT^SDEC25(.SDECY,$G(SDECAPTID)) Q "RTN","SDEC",74,0) CANREAS(SDECY,SDECIN) ;EP return active/inactive entries from the CANCELLATION REASONS table 409.2 "RTN","SDEC",75,0) D CANREAS^SDEC45(.SDECY,$G(SDECIN)) Q "RTN","SDEC",76,0) CAP(SDECY,DFN,SDAMEVT,SDT,DVBADA,SDAUTORB,SDCANVET) ; "RTN","SDEC",77,0) D CAP^SDEC58(.SDECY,$G(DFN),$G(SDAMEVT),$G(SDT),$G(DVBADA),$G(SDAUTORB),$G(SDCANVET)) Q "RTN","SDEC",78,0) CGET(SDECY) ;GET active Countries from the COUNTRY CODE file 779.004 "RTN","SDEC",79,0) D CGET^SDEC55(.SDECY) Q "RTN","SDEC",80,0) CHECKIN(SDECY,SDECAPTID,SDECCDT,SDECCC,SDECPRV,SDECROU,SDECVCL,SDECVFM,SDECOG,SDECCR,SDECPCC,SDECWHF) ;EP Check in appointment "RTN","SDEC",81,0) D CHECKIN^SDEC25(.SDECY,$G(SDECAPTID),$G(SDECCDT),$G(SDECCC),$G(SDECPRV),$G(SDECROU),$G(SDECVCL),$G(SDECVFM),$G(SDECOG),$G(SDECCR),$G(SDECPCC),$G(SDECWHF)) Q "RTN","SDEC",82,0) CHECKOUT(SDECY,DFN,SDT,SDCODT,SDECAPTID,VPRV) ;EP Check Out appointment "RTN","SDEC",83,0) D CHECKOUT^SDEC25(.SDECY,$G(DFN),$G(SDT),$G(SDCODT),$G(SDECAPTID),$G(VPRV)) Q "RTN","SDEC",84,0) CLINALL(RET,MAXREC,SDECP) ; EP Return the IEN and NAME for all entries in the SD WL CLINIC LOCATION file "RTN","SDEC",85,0) D CLINALL^SDECWL(.RET,$G(MAXREC),$G(SDECP)) Q "RTN","SDEC",86,0) CLINCAN(SDECY,SDECCLST,SDECBEG,SDECEND) ;EP Return recordset of CANCELLED patient appointments "RTN","SDEC",87,0) D CLINCAN^SDEC34(.SDECY,$G(SDECCLST),$G(SDECBEG),$G(SDECEND)) Q "RTN","SDEC",88,0) CLINDIS(SDECY,SDECCLST,SDECBEG,SDECEND,SDECWI) ;EP Return formatted text output of the Clinic Schedules Report "RTN","SDEC",89,0) D CLINDIS^SDEC47(.SDECY,$G(SDECCLST),$G(SDECBEG),$G(SDECEND),$G(SDECWI)) Q "RTN","SDEC",90,0) CLINDISW(SDECY,SDECCLST,SDECBEG,SDECEND) ;EP Return formatted text output of the Clinic Schedules Report for Walkins "RTN","SDEC",91,0) D CLINDISW^SDEC47(.SDECY,$G(SDECCLST),$G(SDECBEG),$G(SDECEND)) Q "RTN","SDEC",92,0) CLINLET(SDECY,SDECCLST,SDECBEG,SDECEND,SDECWI) ;EP CLINIC LETTERS Appointment data "RTN","SDEC",93,0) D CLINLET^SDEC27(.SDECY,$G(SDECCLST),$G(SDECBEG),$G(SDECEND),$G(SDECWI)) Q "RTN","SDEC",94,0) CLINLETW(SDECY,SDECCLST,SDECBEG,SDECEND) ;EP CLINIC LETTERS WALK-IN Appointment data for Walk-in Appointments only "RTN","SDEC",95,0) D CLINLETW^SDEC27(.SDECY,$G(SDECCLST),$G(SDECBEG),$G(SDECEND)) Q "RTN","SDEC",96,0) CLINPROV(SDECY,SDECCL) ;EP return all providers for a given clinic from the HOSPITAL LOCATION file 44 "RTN","SDEC",97,0) D CLINPROV^SDEC45(.SDECY,$G(SDECCL)) Q "RTN","SDEC",98,0) CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET,MAXREC) ;EP Returns CLINIC SETUP PARAMETERS for clinics that are active in the HOSPITAL LOCATION file "RTN","SDEC",99,0) D CLINSET^SDEC32(.SDECY,$G(SDNOSLOT),$G(SDIENS),$G(SDECP),$G(SDNOLET),$G(MAXREC)) Q "RTN","SDEC",100,0) CLINSTOP(SDECY,SDP) ;EP CLINIC STOP remote procedure "RTN","SDEC",101,0) D CLINSTOP^SDEC45(.SDECY,$G(SDP)) Q "RTN","SDEC",102,0) COPYAPPT(SDECY,SDECRES,SDEC44,SDECBEG,SDECEND) ;EP Copy appointments from HOSPITAL LOCATION to SDEC RESOURCE "RTN","SDEC",103,0) D COPYAPPT^SDEC29(.SDECY,$G(SDECRES),$G(SDEC44),$G(SDECBEG),$G(SDECEND)) Q "RTN","SDEC",104,0) CPCANC(SDECY,SDECTSK) ;EP Copy Appointment Cancel "RTN","SDEC",105,0) D CPCANC^SDEC29(.SDECY,$G(SDECTSK)) Q "RTN","SDEC",106,0) CPSTAT(SDECY,SDECTSK) ;EP Copy Appointment Status "RTN","SDEC",107,0) D CPSTAT^SDEC29(.SDECY,$G(SDECTSK)) Q "RTN","SDEC",108,0) CRSCHED(SDECY,SDECRES,SDECSTART,SDECEND,SDECWKIN,MAXREC,LASTSUB) ;EP Create Resource Appointment Schedule ;alb/sat 672 "RTN","SDEC",109,0) D CRSCHED^SDEC02(.SDECY,$G(SDECRES),$G(SDECSTART),$G(SDECEND),$G(SDECWKIN),$G(MAXREC),$G(LASTSUB)) Q "RTN","SDEC",110,0) CSLOTSCH(SDECY,SDECRES,SDECSTART,SDECEND,SDECTYPES,SDECSRCH) ;GET Create Assigned Slot Schedule "RTN","SDEC",111,0) D CSLOTSCH^SDEC04(.SDECY,$G(SDECRES),$G(SDECSTART),$G(SDECEND),$G(SDECTYPES),$G(SDECSRCH)) Q "RTN","SDEC",112,0) CURFACG(SDECY,SDECDUZ) ;EP get current division/facility for given user "RTN","SDEC",113,0) D CURFACG^SDEC46(.SDECY,$G(SDECDUZ)) Q "RTN","SDEC",114,0) CVARAPPT(SDECY,SDCL) ;EP IS Clinic Variable Appointment Length "RTN","SDEC",115,0) D CVARAPPT^SDEC37(.SDECY,$G(SDCL)) Q "RTN","SDEC",116,0) DELAG(SDECY,SDECGRP) ;EP Deletes entry having IEN SDECGRP from SDEC ACCESS GROUP file "RTN","SDEC",117,0) D DELAG^SDEC21(.SDECY,$G(SDECGRP)) Q "RTN","SDEC",118,0) DELAGI(SDECY,SDECIEN,SDECIEN1) ;EP Deletes entry having Access Group SDECIEN and Access Type SDECIEN1 the SDEC ACCESS GROUP TYPE file "RTN","SDEC",119,0) D DELAGI^SDEC22(.SDECY,$G(SDECIEN),$G(SDECIEN1)) Q "RTN","SDEC",120,0) DELRESGP(SDECY,SDECGRP) ;EP Deletes entry name SDECGRP from SDEC RESOURCE GROUP file "RTN","SDEC",121,0) D DELRESGP^SDEC19(.SDECY,$G(SDECGRP)) Q "RTN","SDEC",122,0) DELRGI(SDECY,SDECIEN,SDECIEN1) ;EP Deletes entry SDECIEN1 from entry SDECIEN in the SDEC RESOURCE GROUP file "RTN","SDEC",123,0) D DELRGI^SDEC20(.SDECY,$G(SDECIEN),$G(SDECIEN1)) Q "RTN","SDEC",124,0) DELRU(SDECY,SDECIEN) ;EP Delete Resource User from SDEC RESOURCE USER file "RTN","SDEC",125,0) D DELRU^SDEC18(.SDECY,$G(SDECIEN)) Q "RTN","SDEC",126,0) EDITAPPT(SDECY,SDECAPTID,SDECNOTE,SDECLEN) ;EP Edit appointment (only 'note text' and appointment length can be edited) "RTN","SDEC",127,0) D EDITAPPT^SDEC26(.SDECY,$G(SDECAPTID),$G(SDECNOTE),$G(SDECLEN)) Q "RTN","SDEC",128,0) EHRPT(SDECY,SDECWID,SDECDFN) ;EP Raise patient selection event to EHR "RTN","SDEC",129,0) D EHRPT^SDEC30(.SDECY,$G(SDECWID),$G(SDECDFN)) Q "RTN","SDEC",130,0) ETHGET(SDECY) ;GET active Ethnicities from the ETHNICITY file 10.2 "RTN","SDEC",131,0) D ETHGET^SDEC55(.SDECY) Q "RTN","SDEC",132,0) ETHCMGET(SDECY) ;GET values from the RACE AND ETHNICITY COLLECTION METHOD file 10.3 "RTN","SDEC",133,0) D ETHCMGET^SDEC55(.SDECY) Q "RTN","SDEC",134,0) FACLIST(SDECY,DFN) ; Return list of remote facilities for patient "RTN","SDEC",135,0) D PTINQ^SDECPT(.SDECY,$G(DFN)) Q "RTN","SDEC",136,0) FAPPTGET(SDECY,DFN,SDBEG,SDEND,SDANC) ;GET Future appointments for given patient and date range "RTN","SDEC",137,0) D FAPPTGET^SDEC50(.SDECY,$G(DFN),$G(SDBEG),$G(SDEND),$G(SDANC)) Q "RTN","SDEC",138,0) GETFAC(SDECY,SDECDUZ) ;EP Gets all facilities for a user "RTN","SDEC",139,0) D GETFAC^SDEC46(.SDECY,$G(SDECDUZ)) Q "RTN","SDEC",140,0) GETONE(SDECY,SDGMR) ;EP Return data on one consult "RTN","SDEC",141,0) D GETONE^SDEC51(.SDECY,$G(SDGMR)) Q "RTN","SDEC",142,0) GETREGA(SDECRET,DFN) ;EP return basic reg info/demographics for given patient "RTN","SDEC",143,0) D GETREGA^SDEC09(.SDECRET,$G(DFN)) Q "RTN","SDEC",144,0) GETSITES(SDECY) ;return active National VA site names and station numbers "RTN","SDEC",145,0) D GETSITES^SDEC59(.SDECY) Q "RTN","SDEC",146,0) GETVPRV(BGOY,VPRV) ;EP return data from the V PROVIDER file "RTN","SDEC",147,0) D GETVPRV^SDEC44(.BGOY,$G(VPRV)) Q "RTN","SDEC",148,0) HIDE(SDECY) ;Return clinics hidden from display "RTN","SDEC",149,0) D HIDE^SDEC45(.SDECY) Q "RTN","SDEC",150,0) HOLIDAY(SDECY,SDECBD) ;EP return all entries from the HOLIDAY file 40.5 "RTN","SDEC",151,0) D HOLIDAY^SDEC45(.SDECY,$G(SDECBD)) Q "RTN","SDEC",152,0) HOSPLOC(SDECY,SDECP,MAXREC,LSUB) ;EP return HOSPITAL LOCATIONs "RTN","SDEC",153,0) D HOSPLOC^SDEC32(.SDECY,$G(SDECP),$G(MAXREC),$G(LSUB)) Q "RTN","SDEC",154,0) IMHERE(SDECRES) ;EP I'm Here "RTN","SDEC",155,0) D IMHERE^SDEC31(.SDECRES) Q "RTN","SDEC",156,0) NETLOC(SDECY,LOCATION) ;GET data from the NETWORK LOCATION file 2005.2 "RTN","SDEC",157,0) D NETLOC^SDEC59(.SDECY,$G(LOCATION)) Q "RTN","SDEC",158,0) NEWPERS(SDECY,SDCLASS,SDPART,MAXREC,LSUB,INACT) ;return entries from the USR CLASS MEMBERSHIP file that have the given USR CLASS (default is PROVIDER) "RTN","SDEC",159,0) D NEWPERS^SDEC45(.SDECY,$G(SDCLASS),$G(SDPART),$G(MAXREC),$G(LSUB),$G(INACT)) Q "RTN","SDEC",160,0) NOSHOPAT(SDECY,DFN,SDCL) ;EP COLLECT NO-SHOW DATA for Patient "RTN","SDEC",161,0) D NOSHOPAT^SDEC37(.SDECY,$G(DFN),$G(SDCL)) Q "RTN","SDEC",162,0) NOSHOW(SDECY,SDECAPTID,SDECNS,USERIEN,SDECDATE) ;EP Sets appointment noshow flag in SDEC APPOINTMENT file "RTN","SDEC",163,0) D NOSHOW^SDEC31(.SDECY,$G(SDECAPTID),$G(SDECNS),$G(USERIEN),$G(SDECDATE)) Q "RTN","SDEC",164,0) OVBOOK(SDECY,SDCL,SDBEG,SDECRES) ;EP RPC - OVERBOOK - CHECK FOR OVERBOOK FOR GIVEN CLINIC, DATE, AND RESOURCE "RTN","SDEC",165,0) D OVBOOK^SDEC07A(.SDECY,$G(SDCL),$G(SDBEG),$G(SDECRES)) Q "RTN","SDEC",166,0) PATAPPTD(SDECY,DFN) ;EP Return the Patient appointment display "RTN","SDEC",167,0) D PATAPPTD^SDEC27(.SDECY,$G(DFN)) Q "RTN","SDEC",168,0) PATAPPTH(SDECY,DFN) ;EP return patient's appointment history for given patient - RPC "RTN","SDEC",169,0) D PATAPPTH^SDEC48(.SDECY,$G(DFN)) Q "RTN","SDEC",170,0) PCSGET(SDECY,SDSVSP) ;GET clinics for a service/specialty (clinic stop) "RTN","SDEC",171,0) D PCSGET^SDEC50(.SDECY,$G(SDSVSP)) Q "RTN","SDEC",172,0) PCSTGET(SDECY,DFN,SDCL,SDBEG,SDEND) ;GET patient clinic status for a clinic for a given time frame - has the patient been seen by the given Clinic in the past 24 months "RTN","SDEC",173,0) D PCSTGET^SDEC50(.SDECY,$G(DFN),$G(SDCL),$G(SDBEG),$G(SDEND)) Q "RTN","SDEC",174,0) PCST2GET(SDECY,DFN,STOP,SDBEG,SDEND) ;GET patient clinic status for a service/specialty (clinic stop) for a given time frame - has the patient been seen any clinics with the given service/specialty (clinic stop) in the past 24 months "RTN","SDEC",175,0) D PCST2GET^SDEC50(.SDECY,$G(DFN),$G(STOP),$G(SDBEG),$G(SDEND)) Q "RTN","SDEC",176,0) PREFGET(SDECY,DFN,INAC) ;EP Get values from SDEC PREFERENCES AND SPECIAL NEEDS file for given patient "RTN","SDEC",177,0) D PREFGET^SDEC49(.SDECY,$G(DFN),$G(INAC)) Q "RTN","SDEC",178,0) PREFGETV(SDECY) ;EP Get all valid PREFERENCE text from SDEC PREFERENCES AND SPECIAL NEEDS file "RTN","SDEC",179,0) D PREFGETV^SDEC49(.SDECY) Q "RTN","SDEC",180,0) PREFSET(SDECY,DFN,PREF,REMARK) ;EP Set values to SDEC PREFERENCES AND SPECIAL NEEDS file ;alb/sat 658 add REMARK "RTN","SDEC",181,0) D PREFSET^SDEC49(.SDECY,$G(DFN),$G(PREF),$G(REMARK)) Q "RTN","SDEC",182,0) PRIV(SDECY,CLINIEN,USER) ;IS this USER in the PRIVILEGED USER multiple for the clinic "RTN","SDEC",183,0) D PRIV^SDEC32(.SDECY,$G(CLINIEN),$G(USER)) Q "RTN","SDEC",184,0) PROVALL(SDECY,SDECCL) ;EP return all providers for a given clinic from the HOSPITAL LOCATION file 44 "RTN","SDEC",185,0) D PROVALL^SDEC45(.SDECY,$G(SDECCL)) Q "RTN","SDEC",186,0) PROVCLIN(SDECY,SDECPRV) ;EP PROVIDER CLINICS remote procedure "RTN","SDEC",187,0) D PROVCLIN^SDEC45(.SDECY,$G(SDECPRV)) Q "RTN","SDEC",188,0) PTINQ(SDECY,DFN) ;GET output from ORWPT PTINQ in DataTable format "RTN","SDEC",189,0) D PTINQ^SDECPT(.SDECY,$G(DFN)) Q "RTN","SDEC",190,0) PTLOOKRS(SDECY,SDECP,SDECC,LASTSUB) ;EP Patient Lookup "RTN","SDEC",191,0) D PTLOOKRS^SDEC28(.SDECY,$G(SDECP),$G(SDECC),$G(LASTSUB)) Q "RTN","SDEC",192,0) PTSET(SDECY,INP...) ;SET patient demographics "RTN","SDEC",193,0) D PTSET^SDEC53(.SDECY,.INP) Q "RTN","SDEC",194,0) PTSET1(SDECY,INP) ;SET patient demographics (call from debug) "RTN","SDEC",195,0) D PTSET^SDEC53(.SDECY,.INP) Q "RTN","SDEC",196,0) RACEGET(SDECY) ;GET active Race entries from the RACE file 10 "RTN","SDEC",197,0) D RACEGET^SDEC55(.SDECY) Q "RTN","SDEC",198,0) RAISEVNT(SDECY,SDECEVENT,SDECPARAM,SDECSIP,SDECSPT) ;EP RAISE EVENT "RTN","SDEC",199,0) D RAISEVNT^SDEC23(.SDECY,$G(SDECEVENT),$G(SDECPARAM),$G(SDECSIP),$G(SDECSPT)) Q "RTN","SDEC",200,0) REBKCLIN(SDECY,SDECCLST,SDECBEG,SDECEND) ;EP Return recordset of rebooked patient appointments between given dates "RTN","SDEC",201,0) D REBKCLIN^SDEC34(.SDECY,$G(SDECCLST),$G(SDECBEG),$G(SDECEND)) Q "RTN","SDEC",202,0) REBKLIST(SDECY,SDECLIST) ;EP patient appointments used in listing REBOOKED appointments for a list of appointmentIDs. "RTN","SDEC",203,0) D REBKLIST^SDEC34(.SDECY,$G(SDECLIST)) Q "RTN","SDEC",204,0) REBKNEXT(SDECY,SDECDATE,SDECRES,SDECTPID) ;EP find the next ACCESS BLOCK in resource SDECRES after SDECSTART "RTN","SDEC",205,0) D REBKNEXT^SDEC33(.SDECY,$G(SDECDATE),$G(SDECRES),$G(SDECTPID)) Q "RTN","SDEC",206,0) RECIEN(SDECY,RECIEN) ;GET RECALL REMINDERS for given ID "RTN","SDEC",207,0) D RECIEN^SDEC52(.SDECY,$G(RECIEN)) Q "RTN","SDEC",208,0) RECGET(SDECY,DFN,SDBEG,SDEND,MAXREC,LASTSUB,RECIEN,SDSTOP,SDFLAGS,SDCLL) ; GET entries from the RECALL REMINDERS file 403.5 for a given Patient and Recall Date range. ;alb/sat 658 add SDCLL "RTN","SDEC",209,0) D RECGET^SDEC52(.SDECY,$G(DFN),$G(SDBEG),$G(SDEND),$G(MAXREC),$G(LASTSUB),$G(RECIEN),$G(SDSTOP),$G(SDFLAGS),$G(SDCLL)) Q "RTN","SDEC",210,0) RECSET(SDECY,INP...) ; SET/EDIT/CANCEL/DELETE an entry to the RECALL REMINDERS file 403.5 "RTN","SDEC",211,0) D RECSET^SDEC52A(.SDECY,.INP) Q "RTN","SDEC",212,0) RECSET1(SDECY,INP) ; SET/EDIT/CANCEL/DELETE an entry to the RECALL REMINDERS file 403.5 "RTN","SDEC",213,0) D RECSET^SDEC52A(.SDECY,.INP) Q "RTN","SDEC",214,0) RECDSET(SDECY,RECALLIEN,SDRRFTR,SDCOMM) ; DELETE an entry to the RECALL REMINDERS file 403.5 "RTN","SDEC",215,0) D RECDSET^SDEC52A(.SDECY,$G(RECALLIEN),$G(SDRRFTR),$G(SDCOMM)) Q "RTN","SDEC",216,0) RECAPGET(SDECY) ; GET entries from the RECALL REMINDERS APPT TYPE file 403.51 "RTN","SDEC",217,0) D RECAPGET^SDEC52B(.SDECY) Q "RTN","SDEC",218,0) RECPRGET(SDECY,RECINACT,SDECP,MAXREC,LASTSUB) ;GET entries from the RECALL REMINDERS PROVIDERS file 403.54 "RTN","SDEC",219,0) D RECPRGET^SDEC52B(.SDECY,$G(RECINACT),$G(SDECP),$G(MAXREC),$G(LASTSUB)) Q "RTN","SDEC",220,0) REGEVENT(SDECY,SDECEVENT,SDECIP,SDECPORT) ;EP Called by client to inform server of client's interest in SDECEVENT "RTN","SDEC",221,0) D REGEVENT^SDEC23(.SDECY,$G(SDECEVENT),$G(SDECIP),$G(SDECPORT)) Q "RTN","SDEC",222,0) REP1GET(SDECY,MAXREC,LASTSUB,PNAME) ;GET clinic data for report "RTN","SDEC",223,0) D REP1GET^SDEC56(.SDECY,$G(MAXREC),$G(LASTSUB),$G(PNAME)) Q "RTN","SDEC",224,0) REQGET(SDECY,SDBEG,SDEND,MAXREC,LASTSUB,SDGMR) ; GET entries with an ACTIVITY of RECEIVED, but do not have an ACTIVITY of SCHEDULED from the REQUEST/CONSULTATING file 123 "RTN","SDEC",225,0) D REQGET^SDEC51(.SDECY,$G(SDBEG),$G(SDEND),$G(MAXREC),$G(LASTSUB),$G(SDGMR)) Q "RTN","SDEC",226,0) RESGPUSR(SDECY,SDECDUZ) ;EP GROUP RESOURCE "RTN","SDEC",227,0) D RESGPUSR^SDEC01(.SDECY,$G(SDECDUZ)) Q "RTN","SDEC",228,0) RESGRPUS(SDECY,SDECDUZ) ;EP return ACTIVE resource group names for the given user "RTN","SDEC",229,0) D RESGRPUS^SDEC01(.SDECY,$G(SDECDUZ)) Q "RTN","SDEC",230,0) RESLETRF(SDECY,SDECRES,SDECLT) ;EP Return formatted text output of the Resource's Letter - either "LETTER TEXT" (also used as Reminder Letter), NO SHOW LETTER, or CLINIC CANCELLATION LETTER. "RTN","SDEC",231,0) D RESLETRF^SDEC47(.SDECY,$G(SDECRES),$G(SDECLT)) Q "RTN","SDEC",232,0) RESLETRS(SDECY,SDECLIST,SDLTR,SDNOS,SDCAN) ;EP GET recordset of RESOURCES and associated LETTERS "RTN","SDEC",233,0) D RESLETRS^SDEC35(.SDECY,$G(SDECLIST),$G(SDLTR),$G(SDNOS),$G(SDCAN)) Q "RTN","SDEC",234,0) RESUSER(SDECY,SDRES) ;EP SDEC RESOURCE USER remote procedure returns all entries from the SDEC RESOURCE USER table 409.833 "RTN","SDEC",235,0) D RESUSER^SDEC45(.SDECY,$G(SDRES)) Q "RTN","SDEC",236,0) RESOURCE(SDECY,SDECDUZ,SDACT,SDTYPE,MAXREC,LASTSUBI,SDIEN,SDECP) ;EP Returns ADO Recordset with ALL RESOURCE names "RTN","SDEC",237,0) D RESOURCE^SDEC01A(.SDECY,$G(SDECDUZ),$G(SDACT),$G(SDTYPE),$G(MAXREC),$G(LASTSUBI),$G(SDIEN),$G(SDECP)) Q "RTN","SDEC",238,0) SCHUSR(SDECY) ;EP Return recordset of all users in NEW PERSON having SDECZMENU key "RTN","SDEC",239,0) D SCHUSR^SDEC17(.SDECY) Q "RTN","SDEC",240,0) SEARCHAV(SDECY,SDECRES,SDECSTRT,SDECEND,SDECTYPES,SDECAMPM,SDECWKDY) ;EP Searches availability database "RTN","SDEC",241,0) D SEARCHAV^SDEC24(.SDECY,$G(SDECRES),$G(SDECSTRT),$G(SDECEND),$G(SDECTYPES),$G(SDECAMPM),$G(SDECWKDY)) Q "RTN","SDEC",242,0) SETFAC(SDECY,SDECDUZ,SDECFAC) ;EP SET FACILITY "RTN","SDEC",243,0) D SETFAC^SDEC46(.SDECY,$G(SDECDUZ),$G(SDECFAC)) Q "RTN","SDEC",244,0) SETRBOOK(SDECY,SDECAPPT,SDECDATE) ;EP Sets rebook date into appointment "RTN","SDEC",245,0) D SETRBOOK^SDEC33(.SDECY,$G(SDECAPPT),$G(SDECDATE)) Q "RTN","SDEC",246,0) SPACEBAR(SDECY,SDECDIC,SDECVAL) ;EP Update ^DISV with most recent lookup value SDECVAL from file SDECDIC "RTN","SDEC",247,0) D SPACEBAR^SDEC30(.SDECY,$G(SDECDIC),$G(SDECVAL)) Q "RTN","SDEC",248,0) SUMMGET(SDECRET,SDBEG,SDEND,USER,LSUB,MAXREC) ;GET Audit Summary for given date range "RTN","SDEC",249,0) D SUMMGET^SDEC54(.SDECRET,$G(SDBEG),$G(SDEND),$G(USER),$G(LSUB),$G(MAXREC)) Q "RTN","SDEC",250,0) SUMMAGET(SDECY,SDBEG,SDEND,USER,LSUB,MAXREC) ;get ALL appointments with a cancel status from SDEC APPOINTMENT for given date range and user "RTN","SDEC",251,0) D SUMMAGET^SDEC54A(.SDECY,$G(SDBEG),$G(SDEND),$G(USER),$G(LSUB),$G(MAXREC)) Q "RTN","SDEC",252,0) SUSRINFO(SDECY,SDECDUZ) ;EP SCHEDULING USER INFO "RTN","SDEC",253,0) D SUSRINFO^SDEC01(.SDECY,$G(SDECDUZ)) Q "RTN","SDEC",254,0) SVSPALL(RET) ; EP return IEN and NAME for all entries in the SD WL SERVICE/SPECIALTY file "RTN","SDEC",255,0) D SVSPALL^SDECWL(.RET) Q "RTN","SDEC",256,0) SYSSTAT(SDECY) ; EP SYSTEM STATUS "RTN","SDEC",257,0) D SYSSTAT^SDECUTL(.SDECY) Q "RTN","SDEC",258,0) TPBLKOV(SDECY,SDECSTART,SDECEND,SDECRES) ;EP TYPE BLOCKS OVERLAP "RTN","SDEC",259,0) D TPBLKOV^SDEC06(.SDECY,$G(SDECSTART),$G(SDECEND),$G(SDECRES)) Q "RTN","SDEC",260,0) UNDOCANA(SDECY,SDECAPTID) ;EP Undo Cancel Appointment "RTN","SDEC",261,0) D UNDOCANA^SDEC08(.SDECY,$G(SDECAPTID)) Q "RTN","SDEC",262,0) UNREGEV(SDECY,SDECEVENT,SDECIP,SDECPORT) ;EP rpc SDE UNREGEV Called by client to Unregister client's interest in SDECEVENT "RTN","SDEC",263,0) D UNREGEV^SDEC23(.SDECY,$G(SDECEVENT),$G(SDECIP),$G(SDECPORT)) Q "RTN","SDEC",264,0) WAITLIST(SDECY,SDECRES) ;EP COLLECT WAITLIST DATA "RTN","SDEC",265,0) D WAITLIST^SDEC36(.SDECY,$G(SDECRES)) Q "RTN","SDEC",266,0) WLCLOSE(RET,INP...) ; Waitlist CLOSE "RTN","SDEC",267,0) D WLCLOSE^SDECWL(.RET,.INP) Q "RTN","SDEC",268,0) WLCLOSE1(RET,INP) ; Waitlist CLOSE (without ... for VistA calls) "RTN","SDEC",269,0) D WLCLOSE^SDECWL(.RET,.INP) Q "RTN","SDEC",270,0) WLGET(RET,WLIEN1,MAXREC,SDBEG,SDEND,DFN,LASTSUB,SDTOP,SVCL,DESDT,PRI,SVCR,SCVISIT,CLINIC,ORIGDT) ;EP Waitlist GET ;alb/sat 658 add SVCL-SCVISIT "RTN","SDEC",271,0) D WLGET^SDECWL1(.RET,$G(WLIEN1),$G(MAXREC),$G(SDBEG),$G(SDEND),$G(DFN),$G(LASTSUB),$G(SDTOP),$G(SVCL),$G(DESDT),$G(PRI),$G(SVCR),$G(SCVISIT),$G(CLINIC),$G(ORIGDT)) Q "RTN","SDEC",272,0) WLHIDE(SDECY,DFN,WLCL) ;GET wait list entries in which the associated clinic's 'HIDE FROM DISPLAY?' field is 'YES' "RTN","SDEC",273,0) D WLHIDE^SDECWL3(.SDECY,$G(DFN),$G(WLCL)) Q "RTN","SDEC",274,0) WLOPEN(RET,WLAPP,WLIEN,WLDDT) ;SET Waitlist Open/re-open "RTN","SDEC",275,0) D WLOPEN^SDECWL(.RET,$G(WLAPP),$G(WLIEN),$G(WLDDT)) Q "RTN","SDEC",276,0) WLPCSET(SDECY,INP,WLIEN) ;SET update patient contacts in SD WAIT LIST file "RTN","SDEC",277,0) D WLPCSET^SDECWL(.SDECY,$G(INP),$G(WLIEN)) Q "RTN","SDEC",278,0) WLSET(RET,INP...) ;EP Waitlist Set "RTN","SDEC",279,0) D WLSET^SDECWL2(.RET,.INP) Q "RTN","SDEC",280,0) WLSET1(RET,INP) ;EP Waitlist Set (without ... for VistA calls) "RTN","SDEC",281,0) D WLSET^SDECWL2(.RET,.INP) Q "RTN","SDEC01A") 0^8^B123678452^B116433919 "RTN","SDEC01A",1,0) SDEC01A ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 26, 2017 "RTN","SDEC01A",2,0) ;;5.3;Scheduling;**627,642,658,665,672**;Aug 13, 1993;Build 9 "RTN","SDEC01A",3,0) ; "RTN","SDEC01A",4,0) Q "RTN","SDEC01A",5,0) ; "RTN","SDEC01A",6,0) RESOURCE(SDECY,SDECDUZ,SDACT,SDTYPE,MAXREC,LASTSUBI,SDIEN,SDECP) ;Returns ADO Recordset with ALL RESOURCE names "RTN","SDEC01A",7,0) ; SDECDUZ = (optional) pointer to NEW PERSON file "RTN","SDEC01A",8,0) ; Defaults to current user "RTN","SDEC01A",9,0) ; checks that overbook is allowed "RTN","SDEC01A",10,0) ; SDACT = (optional) 1 or YES will return only active resources "RTN","SDEC01A",11,0) ; 0, NO, or null will include inactive "RTN","SDEC01A",12,0) ; SDTYPE = (optional) null will return all resource types "RTN","SDEC01A",13,0) ; H will only return HOSPITAL LOCATION (clinic) resources "RTN","SDEC01A",14,0) ; P will only return NEW PERSON (Provider) resources "RTN","SDEC01A",15,0) ; A will only return SDEC ADDITIONAL RESOURCE resources "RTN","SDEC01A",16,0) ; PH will only return prohibited clinics "RTN","SDEC01A",17,0) ; MAXREC - (optional) Max records returned "RTN","SDEC01A",18,0) ; LASTSUBI - (optional) last subscripts from previous call "RTN","SDEC01A",19,0) ; SDIEN - (optional) pointer to SDEC RESOURCE file "RTN","SDEC01A",20,0) ; only 1 record will be returned if SDIEN is present "RTN","SDEC01A",21,0) ; SDECP - (optional) Partial name text "RTN","SDEC01A",22,0) ;RETURN: "RTN","SDEC01A",23,0) ; Successful Return: "RTN","SDEC01A",24,0) ; a global array in which each array entry contains data from the "RTN","SDEC01A",25,0) ; SDEC RESOURCE file "RTN","SDEC01A",26,0) ; 1. RESOURCEID - Pointer to the SDEC RESOURCE file "RTN","SDEC01A",27,0) ; 2. RESOURCE_NAME - NAME from SDEC RESOURCE file "RTN","SDEC01A",28,0) ; 3. INACTIVE - inactive Clinic - Returned values will be NO YES "RTN","SDEC01A",29,0) ; 4. TIMESCALE - Valid Values: "RTN","SDEC01A",30,0) ; 5, 10, 15, 20, 30, 60 "RTN","SDEC01A",31,0) ; 5. HOSPITAL_LOCATION_ID "RTN","SDEC01A",32,0) ; 6. LETTER_TEXT "RTN","SDEC01A",33,0) ; 7. NO_SHOW_LETTER "RTN","SDEC01A",34,0) ; 8. CLINIC_CANCELLATION_LETTER "RTN","SDEC01A",35,0) ; 9. VIEW - User can VIEW 1=YES; 0=NO "RTN","SDEC01A",36,0) ; 10. OVERBOOK - User can OVERBOOK 1=YES; 0=NO "RTN","SDEC01A",37,0) ; 11. MODIFY_SCHEDULE - User can Modify Schedule 1=YES; 0=NO "RTN","SDEC01A",38,0) ; 12. MODIFY_APPOINTMENTS User can modify appointments 1=YES; 0=NO "RTN","SDEC01A",39,0) ; 13. RESOURCETYPE - 3 pipe pieces: "RTN","SDEC01A",40,0) ; 1. type H, P, or A "RTN","SDEC01A",41,0) ; 2. IEN - pointer to [H] HOSPITAL LOCATION, [P] NEW PERSON, "RTN","SDEC01A",42,0) ; or [A] SDEC ADDITIONAL RESOURCE file "RTN","SDEC01A",43,0) ; 3. Name - name from the appropriate type file "RTN","SDEC01A",44,0) ; 14. DATE - Date/Time entered in external format "RTN","SDEC01A",45,0) ; 15. USERIEN - Entered By User ID pointer to NEW PERSON file 200 "RTN","SDEC01A",46,0) ; 16. USERNAME - Entered By User name from NEW PERSON file "RTN","SDEC01A",47,0) ; 17. DATE1 - Inactive Date/Time in external format "RTN","SDEC01A",48,0) ; 18. USERIEN1 - Inactivating User ID pointer to NEW PERSON file "RTN","SDEC01A",49,0) ; 19. USERNAME1 - Inactivating User Name from NEW PERSON file "RTN","SDEC01A",50,0) ; 20. DATE2 - Reactivated Date/Time in external format "RTN","SDEC01A",51,0) ; 21. USERIEN2 - Reactivating User ID pointer to NEW PERSON file "RTN","SDEC01A",52,0) ; 22. USERNAME2 - Reactivating User Name from NEW PERSON file "RTN","SDEC01A",53,0) ; 23. CLINNAME - Clinic Name from HOSPITAL LOCATION file 44 "RTN","SDEC01A",54,0) ; 24. PROVCLIN - Boolean indicating 'this' P type resource is a provider for a clinic "RTN","SDEC01A",55,0) ; 0 = not a provider (not found in the AVADPR index for file 44) "RTN","SDEC01A",56,0) ; 1 = is a provider "RTN","SDEC01A",57,0) ; 25. PRIVLOC - Boolean indicating presence of privileged users for hospital location "RTN","SDEC01A",58,0) ; 26. PRHBLOC - Boolean indicating if location is a Prohibit Access clinic "RTN","SDEC01A",59,0) ; 27. LASTSUB - Last subscript in return data. Used in next call to "RTN","SDEC01A",60,0) ; SDEC RESOURCE to get additional records "RTN","SDEC01A",61,0) ; 28. ABBR - Abbreviation "RTN","SDEC01A",62,0) ; "RTN","SDEC01A",63,0) ; "RTN","SDEC01A",64,0) N SDA,SDCL,SDDATA,SDMSG,SDECERR,SDECRET,SDECIEN,SDECRES,SDECDEP,SDECDDR,SDECDEPN,SDECRDAT,SDECRNOD,SDECI,SDEC,SDECLTR "RTN","SDEC01A",65,0) N ABBR,SDECNOS,SDECCAN,SDF,SDTYPR,SDX,SDPRO,PRO,SDH,SDK,SDRT,SDT,SDXT "RTN","SDEC01A",66,0) N SDARR,SDARR1,SDCNT,SDMORE,SDNAM,SDREF ;alb/sat 665 ;alb/sat 672 add SDARR1,SDREF "RTN","SDEC01A",67,0) N SDVW ;alb/sat 672 "RTN","SDEC01A",68,0) S (SDRT,SDT,SDX)="",SDPRO=0 "RTN","SDEC01A",69,0) S (SDCNT,SDF,SDMORE)=0 "RTN","SDEC01A",70,0) S SDVW="" ;alb/sat 672 "RTN","SDEC01A",71,0) S SDECY="^TMP(""SDEC01A"","_$J_",""RESOURCE"")" "RTN","SDEC01A",72,0) K @SDECY "RTN","SDEC01A",73,0) S SDECI=0 "RTN","SDEC01A",74,0) S (SDECERR,SDTYPR)="" "RTN","SDEC01A",75,0) ; 1 2 3 4 5 6 7 "RTN","SDEC01A",76,0) S @SDECY@(SDECI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00010INACTIVE^I00010TIMESCALE^I00010HOSPITAL_LOCATION_ID^T00030LETTER_TEXT^T00030NO_SHOW_LETTER" "RTN","SDEC01A",77,0) ; 8 9 10 11 12 "RTN","SDEC01A",78,0) S @SDECY@(SDECI)=^(SDECI)_"^T00030CLINIC_CANCELLATION_LETTER^I00010VIEW^I00010OVERBOOK^I00010MODIFY_SCHEDULE^I00010MODIFY_APPOINTMENTS" "RTN","SDEC01A",79,0) ; 13 14 15 16 "RTN","SDEC01A",80,0) S @SDECY@(SDECI)=^(SDECI)_"^T00030RESOURCETYPE^T00030DATE^T00030USERIEN^T00030USERNAME" "RTN","SDEC01A",81,0) ; 17 18 19 20 21 22 "RTN","SDEC01A",82,0) S @SDECY@(SDECI)=^(SDECI)_"^T00030DATE1^T00030USERIEN1^T00030USERNAME1^T00030DATE2^T00030USERIEN2^T00030USERNAME2" "RTN","SDEC01A",83,0) ; 23 24 25 26 27 "RTN","SDEC01A",84,0) S @SDECY@(SDECI)=^(SDECI)_"^T00030CLINNAME^T00030PROVCLIN^T00030PRIVLOC^T00030PRHBLOC^T00030LASTSUB^T00030ABBR" "RTN","SDEC01A",85,0) S @SDECY@(SDECI)=^(SDECI)_"^T00030DEFAULT_VIEW"_$C(30) ;alb/sat 672 - add DEFAULT_VIEW "RTN","SDEC01A",86,0) ;validate user "RTN","SDEC01A",87,0) S SDECDUZ=$G(SDECDUZ) "RTN","SDEC01A",88,0) I '+SDECDUZ S SDECDUZ=DUZ "RTN","SDEC01A",89,0) ;validate active "RTN","SDEC01A",90,0) S SDACT=$G(SDACT) "RTN","SDEC01A",91,0) S SDACT=$S(SDACT=1:1,SDACT="YES":1,1:0) "RTN","SDEC01A",92,0) ;validate type "RTN","SDEC01A",93,0) S SDTYPE=$G(SDTYPE) "RTN","SDEC01A",94,0) ;MGH added new type "RTN","SDEC01A",95,0) I SDTYPE="PH" S SDPRO=1 "RTN","SDEC01A",96,0) S SDTYPE=$S(SDTYPE="H":"SC(",SDTYPE="P":"VA(200",SDTYPE="A":"SDEC",1:"") "RTN","SDEC01A",97,0) ;validate MAXREC "RTN","SDEC01A",98,0) S MAXREC=$G(MAXREC,9999999) "RTN","SDEC01A",99,0) ;validate LASTSUBI "RTN","SDEC01A",100,0) S LASTSUBI=$G(LASTSUBI) "RTN","SDEC01A",101,0) ;validate SDIEN "RTN","SDEC01A",102,0) ;MGH changed to allow multiple IENS "RTN","SDEC01A",103,0) ;S SDIEN=$G(SDIEN) "RTN","SDEC01A",104,0) ;I SDIEN'="",'$D(^SDEC(409.831,+SDIEN,0)) S SDIEN="" "RTN","SDEC01A",105,0) I $G(SDIEN) D G RESX "RTN","SDEC01A",106,0) .F SDK=1:1:$L(SDIEN,"|") D "RTN","SDEC01A",107,0) ..S SDECIEN=$P(SDIEN,"|",SDK) "RTN","SDEC01A",108,0) ..Q:'$D(^SDEC(409.831,+SDECIEN,0)) "RTN","SDEC01A",109,0) ..S SDECRES=SDECIEN "RTN","SDEC01A",110,0) ..D RES1 "RTN","SDEC01A",111,0) ;ien lookup "RTN","SDEC01A",112,0) ;I +SDIEN S SDECRES=+SDIEN D RES1 G RESX "RTN","SDEC01A",113,0) ;validate SDECP "RTN","SDEC01A",114,0) S SDECP=$G(SDECP) "RTN","SDEC01A",115,0) ;partial name lookup "RTN","SDEC01A",116,0) I SDECP'="" D "RTN","SDEC01A",117,0) .S SDF=$S($P(LASTSUBI,"|",1)'="":$P(LASTSUBI,"|",1),1:"") "RTN","SDEC01A",118,0) .;alb/sat 672 - begin modification; separate string and numeric lookup "RTN","SDEC01A",119,0) .S (SDX,SDXT)=$S($P(LASTSUBI,"|",2)'="":$$GETSUB^SDECU($P(LASTSUBI,"|",2)),1:$$GETSUB^SDECU(SDECP)) "RTN","SDEC01A",120,0) .;abbreviation as string "RTN","SDEC01A",121,0) .I ($P(LASTSUBI,"|",1)="")!($P(LASTSUBI,"|",1)="ABBRSTR") S SDF="ABBRSTR" D "RTN","SDEC01A",122,0) ..S SDREF="C" D PART Q "RTN","SDEC01A",123,0) .;abbreviation as numeric "RTN","SDEC01A",124,0) .I ($P(LASTSUBI,"|",1)="")!($P(LASTSUBI,"|",1)="ABBRNUM"),(+SDXT=SDXT) S SDF="ABBRNUM",SDX=SDXT_" " D "RTN","SDEC01A",125,0) ..S SDREF="C" D PART Q "RTN","SDEC01A",126,0) .;name as string "RTN","SDEC01A",127,0) .I ($P(LASTSUBI,"|",1)="")!($P(LASTSUBI,"|",1)="FULLSTR") S SDF="FULLSTR",SDX=SDXT D "RTN","SDEC01A",128,0) ..S SDREF="B" D PART Q "RTN","SDEC01A",129,0) .;name as numeric "RTN","SDEC01A",130,0) .I ($P(LASTSUBI,"|",1)="")!($P(LASTSUBI,"|",1)="FULLNUM"),(+SDXT=SDXT) S SDF="FULLNUM",SDX=SDXT_" " D "RTN","SDEC01A",131,0) ..S SDREF="B" D PART Q "RTN","SDEC01A",132,0) .;alb/sat 672 - end modification; separate string and numeric lookup "RTN","SDEC01A",133,0) ;$O THRU SDEC RESOURCE File "RTN","SDEC01A",134,0) I SDECP="",'+SDIEN S SDECRES=$S($P(LASTSUBI,"|",2)'="":$P(LASTSUBI,"|",2),1:0) F S SDECRES=$O(^SDEC(409.831,SDECRES)) Q:'+SDECRES D I (+MAXREC)&(SDCNT'0,'+SDMORE S $P(@SDECY@(SDECI),U,27)="" "RTN","SDEC01A",141,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC01A",142,0) Q "RTN","SDEC01A",143,0) PART ;partial name lookup ;alb/sat 672 "RTN","SDEC01A",144,0) Q:SDREF="" "RTN","SDEC01A",145,0) F S SDX=$O(^SDEC(409.831,SDREF,SDX)) Q:SDX="" Q:SDX'[SDECP D I (+MAXREC)&(SDCNT'0,1:0) ;contains privileged users "RTN","SDEC01A",232,0) S:$G(SDCL) $P(SDECRDAT,U,26)=$$GET1^DIQ(44,SDCL_",",2500)["Y" ;prohibited clinic "RTN","SDEC01A",233,0) S $P(SDECRDAT,U,27)=SDF_"|"_SDX_"|"_SDECRES ;LASTSUB "RTN","SDEC01A",234,0) S $P(SDECRDAT,U,28)=@SDA@(.011,"E") ;abbreviation "RTN","SDEC01A",235,0) S:$P(SDECRDAT,U,23)'="" SDVW=$$GET^XPAR("PKG.SCHEDULING","SDEC VS GUI CLINIC VIEW",$P(SDECRDAT,U,23),"B") ;alb/sat 672 "RTN","SDEC01A",236,0) S $P(SDECRDAT,U,29)=$S(SDVW'="":$P(SDVW,U,1),1:"W") ;alb/sat 672 "RTN","SDEC01A",237,0) S $P(SDECRDAT,U,2)=$S(($G(SDF)["ABBR")&(@SDA@(.011,"E")'=""):@SDA@(.011,"E")_" ",1:"")_$P(SDECRDAT,U,2) ;alb/sat 658 - include abbr in name if found by C xref "RTN","SDEC01A",238,0) S SDARR(SDF["FULL",$P(SDECRDAT,U,2))=SDECRDAT,SDCNT=SDCNT+1 "RTN","SDEC01A",239,0) Q "RTN","SDEC01A",240,0) ; "RTN","SDEC01A",241,0) GETACC(SDECACC,SDECDUZ,SDECRES) ;get view, overbook, modify appt, and modify schedule abilities "RTN","SDEC01A",242,0) ;INPUT: "RTN","SDEC01A",243,0) ; SDECDUZ = user ID pointer to NEW PERSON file "RTN","SDEC01A",244,0) ; SDECRES = resource ID pointer to SDEC RESOURCE file "RTN","SDEC01A",245,0) ;RETURN: "RTN","SDEC01A",246,0) ; .SDECACC = access separated by ^: "RTN","SDEC01A",247,0) ; 1. VIEW - User can VIEW 1=YES; 0=NO "RTN","SDEC01A",248,0) ; 2. OVERBOOK - User can OVERBOOK 1=YES; 0=NO "RTN","SDEC01A",249,0) ; 3. MODIFY SCHEDULE - User can Modify Schedule 1=YES; 0=NO "RTN","SDEC01A",250,0) ; 4. MODIFY APPOINTMENTS User can modify appointments 1=YES; 0=NO "RTN","SDEC01A",251,0) N SDECMGR "RTN","SDEC01A",252,0) S SDECACC="0^0^0^0" "RTN","SDEC01A",253,0) S SDECMGR=$O(^DIC(19.1,"B","SDECZMGR",0)) "RTN","SDEC01A",254,0) I +SDECMGR,$D(^VA(200,SDECDUZ,51,SDECMGR)) S SDECACC="1^1^1^1" "RTN","SDEC01A",255,0) I SDECACC="0^0^0^0" D "RTN","SDEC01A",256,0) . N SDECNOD,SDECRUID "RTN","SDEC01A",257,0) . S SDECRUID=0 "RTN","SDEC01A",258,0) . ;Get entry for this user and resource "RTN","SDEC01A",259,0) . F S SDECRUID=$O(^SDEC(409.833,"AC",SDECDUZ,SDECRUID)) Q:'+SDECRUID I $D(^SDEC(409.833,SDECRUID,0)),$P(^(0),U)=SDECRES Q "RTN","SDEC01A",260,0) . Q:'+SDECRUID "RTN","SDEC01A",261,0) . S $P(SDECACC,U)=1 "RTN","SDEC01A",262,0) . S SDECNOD=$G(^SDEC(409.833,SDECRUID,0)) "RTN","SDEC01A",263,0) . S $P(SDECACC,U,2)=+$P(SDECNOD,U,3) "RTN","SDEC01A",264,0) . S $P(SDECACC,U,3)=+$P(SDECNOD,U,4) "RTN","SDEC01A",265,0) . S $P(SDECACC,U,4)=+$P(SDECNOD,U,5) "RTN","SDEC01A",266,0) Q "RTN","SDEC01A",267,0) ; "RTN","SDEC01A",268,0) GETLTRS(SDECLTR,SDECNOS,SDECCAN,SDECRES,SDCL) ;get resource letters "RTN","SDEC01A",269,0) ;INPUT: "RTN","SDEC01A",270,0) ; SDECRES = resource ID pointer to SDEC RESOURCE file "RTN","SDEC01A",271,0) ; SDCL = clinic ID pointer to HOSPITAL LOCATION file "RTN","SDEC01A",272,0) ;RETURN: "RTN","SDEC01A",273,0) ; .SDECLTR = LETTER TEXT "RTN","SDEC01A",274,0) ; .SDECNOS = NO SHOW LETTER "RTN","SDEC01A",275,0) ; .SDECCAN = CLINIC CANCELLATION LETTER "RTN","SDEC01A",276,0) ; .Get letter text from wp field "RTN","SDEC01A",277,0) N SDECIEN "RTN","SDEC01A",278,0) S SDECLTR="" "RTN","SDEC01A",279,0) I $D(^SDEC(409.831,SDECRES,2,SDCL,1)) D "RTN","SDEC01A",280,0) . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.831,SDECRES,2,SDCL,1,SDECIEN)) Q:'+SDECIEN D "RTN","SDEC01A",281,0) . . S SDECLTR=SDECLTR_$G(^SDEC(409.831,SDECRES,2,SDCL,1,SDECIEN,0)) "RTN","SDEC01A",282,0) . . S SDECLTR=SDECLTR_$C(13)_$C(10) "RTN","SDEC01A",283,0) S SDECNOS="" "RTN","SDEC01A",284,0) I $D(^SDEC(409.831,SDECRES,2,SDCL,12)) D "RTN","SDEC01A",285,0) . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.831,SDECRES,2,SDCL,12,SDECIEN)) Q:'+SDECIEN D "RTN","SDEC01A",286,0) . . S SDECNOS=SDECNOS_$G(^SDEC(409.831,SDECRES,2,SDCL,12,SDECIEN,0)) "RTN","SDEC01A",287,0) . . S SDECNOS=SDECNOS_$C(13)_$C(10) "RTN","SDEC01A",288,0) S SDECCAN="" "RTN","SDEC01A",289,0) I $D(^SDEC(409.831,SDECRES,13)) D "RTN","SDEC01A",290,0) . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.831,SDECRES,2,SDCL,13,SDECIEN)) Q:'+SDECIEN D "RTN","SDEC01A",291,0) . . S SDECCAN=SDECCAN_$G(^SDEC(409.831,SDECRES,2,SDCL,13,SDECIEN,0)) "RTN","SDEC01A",292,0) . . S SDECCAN=SDECCAN_$C(13)_$C(10) "RTN","SDEC01A",293,0) Q "RTN","SDEC02") 0^10^B68680067^B53389862 "RTN","SDEC02",1,0) SDEC02 ;ALB/SAT - VISTA SCHEDULING RPCS ;MAR 15, 2017 "RTN","SDEC02",2,0) ;;5.3;Scheduling;**627,642,658,672**;Aug 13, 1993;Build 9 "RTN","SDEC02",3,0) ; "RTN","SDEC02",4,0) Q "RTN","SDEC02",5,0) ; "RTN","SDEC02",6,0) CRSCHED(SDECY,SDECRES,SDECSTART,SDECEND,SDECWKIN,MAXREC,LASTSUB) ;Create Resource Appointment Schedule ;alb/sat 672 "RTN","SDEC02",7,0) ;CRSCHED(SDECY,SDECRES,SDECSTART,SDECEND,SDECWKIN) external parameter tag is in SDEC "RTN","SDEC02",8,0) ;Create Resource Appointment Schedule recordset "RTN","SDEC02",9,0) ;On error, returns 0 in APPOINTMENTID field and error text in NOTE field "RTN","SDEC02",10,0) ; "RTN","SDEC02",11,0) ;$O Thru ^SDEC(409.84,"ARSRC", RESOURCE, STARTTIME, APPTID) "RTN","SDEC02",12,0) ;SDECRES - pipe | delimited list of resource names "RTN","SDEC02",13,0) ;SDECSTART - Start date/time in external form "RTN","SDEC02",14,0) ;SDECEND - End Date/time in external form "RTN","SDEC02",15,0) ;SDECWKIN - Include Walk-ins 1=return walkins; 0=skip walk-ins "RTN","SDEC02",16,0) ;9-27-2004 Added walkin to returned datatable "RTN","SDEC02",17,0) ;TODO: Change SDECRES from names to IDs "RTN","SDEC02",18,0) ;RETURN: "RTN","SDEC02",19,0) ; Global Array in which each array entry contains data for the Resource Appointment Schedule separated by ^: "RTN","SDEC02",20,0) ; 1. APPOINTMENTID "RTN","SDEC02",21,0) ; 2. START_TIME "RTN","SDEC02",22,0) ; 3. END_TIME "RTN","SDEC02",23,0) ; 4. CHECKIN "RTN","SDEC02",24,0) ; 5. AUXTIME "RTN","SDEC02",25,0) ; 6. PATIENTID "RTN","SDEC02",26,0) ; 7. PATIENTNAME "RTN","SDEC02",27,0) ; 8. RESOURCENAME "RTN","SDEC02",28,0) ; 9. NOSHOW "RTN","SDEC02",29,0) ;10. HRN "RTN","SDEC02",30,0) ;11. ACCESSTYPEID "RTN","SDEC02",31,0) ;12. WALKIN "RTN","SDEC02",32,0) ;13. CHECKOUT "RTN","SDEC02",33,0) ;14. VPROVIDER "RTN","SDEC02",34,0) ;15. CANCELLED "RTN","SDEC02",35,0) ;16. NOTE "RTN","SDEC02",36,0) ;17. DAPTDT "RTN","SDEC02",37,0) ;18. APPTREQTYPE "RTN","SDEC02",38,0) ;19. DIEDON "RTN","SDEC02",39,0) ;20. EESTAT - Patient Status N=NEW E=ESTABLISHED "RTN","SDEC02",40,0) ;21. MULT - data from MULT APPTS MADE field of SDEC APPT REQUEST separated by pipe ;alb/sat 642 "RTN","SDEC02",41,0) ; each pipe piece contains the following ~ pieces: "RTN","SDEC02",42,0) ; 1. MULT APPTS MADE - pointer to SDEC APPOINTMENT "RTN","SDEC02",43,0) ; 2. PARENT REQUEST - pointer to SDEC APPT REQUEST "RTN","SDEC02",44,0) ;22. SDPARENT - PARENT REQUEST from SDEC APPT REQUEST. Pointer to SDEC APPT REQUEST. ;alb/sat 642 "RTN","SDEC02",45,0) ; "RTN","SDEC02",46,0) N SDECERR,SDECIEN,SDECDEPD,SDECDEPN,SDECRESD,SDECI,SDECJ,SDECRESN,SDECS,SDECAD,SDECZ,SDECQ,SDECNOD,SDECTMP "RTN","SDEC02",47,0) N SDECPAT,SDECNOT,SDECZPCD,SDECPCD,SDDDT,SDAPTYP "RTN","SDEC02",48,0) N SDCNT,SDI ;alb/sat 672 "RTN","SDEC02",49,0) N %DT,X,Y "RTN","SDEC02",50,0) K ^TMP("SDEC02",$J) "RTN","SDEC02",51,0) S SDECERR="" "RTN","SDEC02",52,0) S SDCNT=0 ;alb/sat 672 "RTN","SDEC02",53,0) S SDECY="^TMP(""SDEC02"","_$J_")" "RTN","SDEC02",54,0) ; 1 2 3 4 5 6 "RTN","SDEC02",55,0) S SDECTMP="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^" "RTN","SDEC02",56,0) ; 7 8 9 10 11 12 "RTN","SDEC02",57,0) S SDECTMP=SDECTMP_"T00030PATIENTNAME^T00030RESOURCENAME^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^" "RTN","SDEC02",58,0) ; 13 14 15 16 17 18 "RTN","SDEC02",59,0) S SDECTMP=SDECTMP_"D00030CHECKOUT^I00020VPROVIDER^T00020CANCELLED^T00250NOTE^T00030DAPTDT^T00030APPTREQTYPE^" "RTN","SDEC02",60,0) ;alb/sat 642 added MULT and SDPARENT ;alb/sat 672 added SLAST,SSN,DOB,SENSITIVE "RTN","SDEC02",61,0) S SDECTMP=SDECTMP_"T00030DIEDON^T00030EESTAT^T00250MULT^T00030SDPARENT^T00050SDLAST^T00030SSN^T00030DOB^T00100SENSITIVE" "RTN","SDEC02",62,0) S ^TMP("SDEC02",$J,0)=SDECTMP_$C(30) "RTN","SDEC02",63,0) ; "RTN","SDEC02",64,0) S:SDECSTART["@0000" SDECSTART=$P(SDECSTART,"@") "RTN","SDEC02",65,0) S:SDECEND["@0000" SDECEND=$P(SDECEND,"@") "RTN","SDEC02",66,0) S %DT="T",X=SDECSTART D ^%DT S SDECSTART=Y "RTN","SDEC02",67,0) I SDECSTART=-1 S ^TMP("SDEC02",$J,0)=^TMP("SDEC02",$J,0)_$C(31) Q "RTN","SDEC02",68,0) S %DT="T",X=SDECEND D ^%DT S SDECEND=Y "RTN","SDEC02",69,0) I SDECEND=-1 S ^TMP("SDEC02",$J,0)=^TMP("SDEC02",$J,0)_$C(31) Q "RTN","SDEC02",70,0) S MAXREC=$G(MAXREC) S:'MAXREC MAXREC=9999999 ;alb/sat 672 "RTN","SDEC02",71,0) S LASTSUB=$G(LASTSUB) ;alb/sat 672 "RTN","SDEC02",72,0) ; "RTN","SDEC02",73,0) S SDECI=0 "RTN","SDEC02",74,0) D STRES "RTN","SDEC02",75,0) ; "RTN","SDEC02",76,0) S ^TMP("SDEC02",$J,SDECI)=^TMP("SDEC02",$J,SDECI)_$C(31) "RTN","SDEC02",77,0) Q "RTN","SDEC02",78,0) ; "RTN","SDEC02",79,0) STRES ; "RTN","SDEC02",80,0) S SDI=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1),1:1) ;alb/sat 672 "RTN","SDEC02",81,0) F SDECJ=1:1:$L(SDECRES,"|") S SDECRESN=$P(SDECRES,"|",SDECJ) D "RTN","SDEC02",82,0) . Q:SDECRESN="" "RTN","SDEC02",83,0) . I +SDECRESN Q:'$D(^SDEC(409.831,+SDECRESN,0)) "RTN","SDEC02",84,0) . I +SDECRESN S SDECRESD=SDECRESN "RTN","SDEC02",85,0) . I '+SDECRESN Q:'$D(^SDEC(409.831,"B",SDECRESN)) "RTN","SDEC02",86,0) . I '+SDECRESN S SDECRESD=$O(^SDEC(409.831,"B",SDECRESN,0)) "RTN","SDEC02",87,0) . Q:'+SDECRESD "RTN","SDEC02",88,0) . S SDECRESN=$P($G(^SDEC(409.831,SDECRESD,0)),U,1) "RTN","SDEC02",89,0) . Q:'$D(^SDEC(409.84,"ARSRC",SDECRESD)) "RTN","SDEC02",90,0) . S SDECS=$S($P(LASTSUB,"|",2):$P(LASTSUB,"|",2),1:SDECSTART)-.0001 ;alb/sat 672 "RTN","SDEC02",91,0) . F S SDECS=$O(^SDEC(409.84,"ARSRC",SDECRESD,SDECS)) Q:'+SDECS Q:SDECS>SDECEND D Q:SDCNT'0 S SDECHRN=$P($G(^AUPNPAT(SDECPATD,41,DUZ(2),0)),U,2) ;HRN "RTN","SDEC02",128,0) S $P(SDECZ,"^",10)=SDECHRN "RTN","SDEC02",129,0) S SDECATID=$P(SDECNOD,U,6) "RTN","SDEC02",130,0) S:'+SDECATID SDECATID=0 ;UNKNOWN TYPE "RTN","SDEC02",131,0) S $P(SDECZ,"^",11)=SDECATID "RTN","SDEC02",132,0) S $P(SDECZ,"^",12)=SDECISWK "RTN","SDEC02",133,0) S $P(SDECZ,"^",13)=SDECCO ;CHECKOUT TIME "RTN","SDEC02",134,0) S $P(SDECZ,"^",14)=SDECVPRV ;POINTER TO NEW PERSON "RTN","SDEC02",135,0) S $P(SDECZ,"^",15)=SDECCAN ;CANCELLED "RTN","SDEC02",136,0) ;NOTE [16] "RTN","SDEC02",137,0) S SDECNOT="",SDECQ=0 F S SDECQ=$O(^SDEC(409.84,SDECAD,1,SDECQ)) Q:'+SDECQ D "RTN","SDEC02",138,0) . S SDECNOT=$G(^SDEC(409.84,SDECAD,1,SDECQ,0)) "RTN","SDEC02",139,0) . S:$E(SDECNOT,$L(SDECNOT)-1,$L(SDECNOT))'=" " SDECNOT=SDECNOT_" " "RTN","SDEC02",140,0) . S SDTMP=SDTMP_$S(SDTMP'="":" ",1:"")_$TR(SDECNOT,"^"," ") ;alb/sat 672 "RTN","SDEC02",141,0) . ;S SDECI=SDECI+1 ;alb/sat 672 - removed "RTN","SDEC02",142,0) . ;S ^TMP("SDEC02",$J,SDECI)=$TR(SDECNOT,"^"," ") ;alb/sat 658 ;alb/sat 672 - removed "RTN","SDEC02",143,0) ;S ^TMP("SDEC02",$J,SDECI)=^TMP("SDEC02",$J,SDECI)_"^" ;alb/sat 672 - replaced "RTN","SDEC02",144,0) S $P(SDECZ,"^",16)=SDTMP ;alb/sat 672 "RTN","SDEC02",145,0) ;additional data "RTN","SDEC02",146,0) ;S SDECZ="" ;alb/sat 672 - removed "RTN","SDEC02",147,0) S $P(SDECZ,"^",17)=$S($P(SDECNOD,U,20)'="":$$FMTE^XLFDT($P(SDECNOD,U,20)),1:"") ;alb/sat 672 "RTN","SDEC02",148,0) ;appt request type "RTN","SDEC02",149,0) S SDAPTYP=$P($G(^SDEC(409.84,SDECAD,2)),U,1) "RTN","SDEC02",150,0) S:SDAPTYP'="" SDAPTYP=$S($P(SDAPTYP,";",2)["SDWL":"E",$P(SDAPTYP,";",2)["GMR":"C",$P(SDAPTYP,";",2)="SD(403.5,":"R",$P(SDAPTYP,";",2)="SDEC(409.85,":"A",1:"")_"|"_$P(SDAPTYP,";",1) "RTN","SDEC02",151,0) S $P(SDECZ,"^",18)=SDAPTYP ;[18] ;alb/sat 672 "RTN","SDEC02",152,0) S DIEDON="" D DIEDON^ORWPT(.DIEDON,SDECPATD) "RTN","SDEC02",153,0) S $P(SDECZ,"^",19)=DIEDON ;[19] ;alb/sat 672 "RTN","SDEC02",154,0) S $P(SDECZ,"^",20)=$$GET1^DIQ(409.84,SDECAD_",",.23,"E") ;[20] ;alb/sat 672 "RTN","SDEC02",155,0) I $P(SDAPTYP,"|",1)="A" S $P(SDECZ,"^",21)=$$MULT(SDAPTYP) ;[21] [22] alb/sat 642 ;alb/sat 672 "RTN","SDEC02",156,0) I $P(SDAPTYP,"|",1)="A" S $P(SDECZ,"^",22)=$$GET1^DIQ(409.85,$P(SDAPTYP,"|",2)_",",43.8,"I") ;[21] [22] alb/sat 642 ;alb/sat 672 "RTN","SDEC02",157,0) S $P(SDECZ,"^",24)=$G(SDDEMO("SSN")) ;[24] ;alb/sat 672 - added "RTN","SDEC02",158,0) S $P(SDECZ,"^",25)=$G(SDDEMO("DOB")) ;[25] ;alb/sat 672 - added "RTN","SDEC02",159,0) S SDSENS=$$PTSEC^SDECUTL(SDECPATD) S $P(SDECZ,"^",26)=SDSENS ;[26] ;alb/sat 672 - added "RTN","SDEC02",160,0) S SDCNT=SDCNT+1 I SDCNT'0 D Q:CHECKIN'="" "RTN","SDEC02",171,0) .S SDNOD=$G(^SC(SDCL,"S",SDT,1,SDI,0)) "RTN","SDEC02",172,0) .Q:$P(SDNOD,U,1)'=DFN "RTN","SDEC02",173,0) .I $D(^SC(SDCL,"S",SDT,1,SDI,"C")) D "RTN","SDEC02",174,0) ..S CHECKIN=$P($G(^SC(SDCL,"S",SDT,1,SDI,"C")),U,1) "RTN","SDEC02",175,0) ..S ENTERED=$P($G(^SC(SDCL,"S",SDT,1,SDI,"C")),U,5) "RTN","SDEC02",176,0) ..S:CHECKIN'="" SDFDA(409.84,APPT_",",.03)=CHECKIN "RTN","SDEC02",177,0) ..S:ENTERED'="" SDFDA(409.84,APPT_",",.04)=ENTERED "RTN","SDEC02",178,0) ..D:$D(SDFDA) UPDATE^DIE("","SDFDA") "RTN","SDEC02",179,0) ..S Y=CHECKIN "RTN","SDEC02",180,0) ..X ^DD("DD") S CHECKIN=$TR(Y,"@"," ") "RTN","SDEC02",181,0) ..S Y=ENTERED "RTN","SDEC02",182,0) ..X ^DD("DD") S ENTERED=$TR(Y,"@"," ") "RTN","SDEC02",183,0) Q CHECKIN_U_ENTERED "RTN","SDEC02",184,0) MULT(SDAPTYP) ;get data from MULT APPTS MADE field of SDEC APPT REQUEST file ;alb/sat 642 "RTN","SDEC02",185,0) N ARIEN,SDI,MULT1,MULTL "RTN","SDEC02",186,0) S MULTL="" "RTN","SDEC02",187,0) S ARIEN=$P(SDAPTYP,"|",2) "RTN","SDEC02",188,0) S SDI=0 F S SDI=$O(^SDEC(409.85,ARIEN,2,SDI)) Q:SDI'>0 D "RTN","SDEC02",189,0) .S MULT1=$P($G(^SDEC(409.85,ARIEN,2,SDI,0)),"^",1) "RTN","SDEC02",190,0) .S MULTL=$S(MULTL'="":MULTL_"|",1:"")_MULT1 "RTN","SDEC02",191,0) Q MULTL "RTN","SDEC02",192,0) ; "RTN","SDEC02",193,0) ERR(SDECI,SDECERR) ;Error processing "RTN","SDEC02",194,0) S SDECI=SDECI+1 "RTN","SDEC02",195,0) S ^TMP("SDEC02",$J,SDECI)="0^^^^^^^^^^^"_SDECERR_$C(30) "RTN","SDEC02",196,0) S SDECI=SDECI+1 "RTN","SDEC02",197,0) S ^TMP("SDEC02",$J,SDECI)=$C(31) "RTN","SDEC02",198,0) Q "RTN","SDEC02",199,0) ; "RTN","SDEC02",200,0) ETRAP ;EP Error trap entry "RTN","SDEC02",201,0) D ^%ZTER "RTN","SDEC02",202,0) I '$D(SDECI) N SDECI S SDECI=999999 "RTN","SDEC02",203,0) S SDECI=SDECI+1 "RTN","SDEC02",204,0) D ERR(SDECI,"SDEC31 Error") "RTN","SDEC02",205,0) Q "RTN","SDEC07") 0^7^B193088585^B187944035 "RTN","SDEC07",1,0) SDEC07 ;ALB/SAT - VISTA SCHEDULING RPCS ;10:29 AM 26 Jun 2017 "RTN","SDEC07",2,0) ;;5.3;Scheduling;**627,642,651,658,665,669,671,672**;Aug 13, 1993;Build 9 "RTN","SDEC07",3,0) ;;5.3;Scheduling;**627,642,651,658,665,669,671,672**;Aug 13, 1993;Build 7 "RTN","SDEC07",4,0) ; "RTN","SDEC07",5,0) ;Reference is made to ICR #4837 "RTN","SDEC07",6,0) Q "RTN","SDEC07",7,0) ; "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,EESTAT,OVB,SDPARENT,SDEL) ;ADD NEW APPOINTMENT "RTN","SDEC07",9,0) ; "RTN","SDEC07",10,0) N SDAPPTYP "RTN","SDEC07",11,0) N SDECERR,SDECIEN,SDECDEP,SDECI,SDECJ,SDECAPPTI,SDECDJ,SDECRESD,SDECRNOD,SDECC,SDECERR,SDECWKIN "RTN","SDEC07",12,0) N SDECNOEV,SDECDEV,SDECDERR,SDECTMP,SAVESTRT,SDAREQ0 "RTN","SDEC07",13,0) N %DT,X,Y,DGQUIET,OBM,RET "RTN","SDEC07",14,0) N SDOE ;alb/sat 672 "RTN","SDEC07",15,0) S SDECNOEV=1 ;Don't execute SDEC ADD APPOINTMENT protocol "RTN","SDEC07",16,0) K ^TMP("SDEC07",$J) "RTN","SDEC07",17,0) S SDECERR=0 "RTN","SDEC07",18,0) S SDECI=0 "RTN","SDEC07",19,0) S SDECY="^TMP(""SDEC07"","_$J_")" "RTN","SDEC07",20,0) S ^TMP("SDEC07",$J,SDECI)="I00020APPOINTMENTID^T00020ERRORID"_$C(30) "RTN","SDEC07",21,0) S SDECI=SDECI+1 "RTN","SDEC07",22,0) ;Check input data for errors "RTN","SDEC07",23,0) S SDAREQ0=$G(^SDEC(409.85,+$P(SDAPTYP,"|",2),0)) "RTN","SDEC07",24,0) I $P(SDAREQ0,U,5)="RTC",$P(SDAREQ0,U,17)="C" D ERR(SDECI+1,"SDEC07 Error: This RTC request has been closed.") Q "RTN","SDEC07",25,0) S SAVESTRT=SDECSTART ;MGH save date/time for consult request "RTN","SDEC07",26,0) S:SDECSTART["@0000" SDECSTART=$P(SDECSTART,"@") "RTN","SDEC07",27,0) S:SDECEND["@0000" SDECEND=$P(SDECEND,"@") "RTN","SDEC07",28,0) S %DT="RXT",X=SDECSTART D ^%DT S SDECSTART=Y "RTN","SDEC07",29,0) I SDECSTART=-1 D ERR(SDECI+1,"SDEC07 Error: Invalid Start Time") Q "RTN","SDEC07",30,0) S %DT="RXT",X=SDECEND D ^%DT S SDECEND=Y "RTN","SDEC07",31,0) I SDECEND=-1 D ERR(SDECI+1,"SDEC07 Error: Invalid End Time") Q "RTN","SDEC07",32,0) I $L(SDECEND,".")=1 D ERR(SDECI+1,"SDEC07 Error: Invalid End Time") Q "RTN","SDEC07",33,0) I SDECSTART>SDECEND S SDECTMP=SDECEND,SDECEND=SDECSTART,SDECSTART=SDECTMP "RTN","SDEC07",34,0) S DFN=$G(DFN) "RTN","SDEC07",35,0) I DFN="" D ERR(SDECI+1,"SDEC07: Patient ID required.") Q "RTN","SDEC07",36,0) I '$D(^DPT(DFN,0)) D ERR(SDECI+1,"SDEC07 Error: Invalid Patient ID") Q "RTN","SDEC07",37,0) L +^DPT(DFN):3 I '$T D ERR(SDECI+1,"Patient is being edited. Try again later.") Q ;alb/sat 665 "RTN","SDEC07",38,0) ;Validate Resource "RTN","SDEC07",39,0) S SDECERR=0 K SDECRESD "RTN","SDEC07",40,0) S SDECRES=$G(SDECRES) "RTN","SDEC07",41,0) I +SDECRES,'$D(^SDEC(409.831,SDECRES,0)) D ERR(SDECI+1,"SDEC07 Error: Invalid Resource ID") Q "RTN","SDEC07",42,0) I '+SDECRES,'$D(^SDEC(409.831,"B",SDECRES)) D ERR(SDECI+1,"SDEC07 Error: Invalid Resource ID") Q "RTN","SDEC07",43,0) S SDECRESD=$S(+SDECRES:+SDECRES,1:$O(^SDEC(409.831,"B",SDECRES,0))) "RTN","SDEC07",44,0) S SDECRNOD=$G(^SDEC(409.831,SDECRESD,0)) "RTN","SDEC07",45,0) I SDECRNOD="" D ERR(SDECI+1,"SDEC07 Error: Unable to add appointment -- invalid Resource entry.") Q "RTN","SDEC07",46,0) S SDECWKIN=0 "RTN","SDEC07",47,0) S SDECATID=$G(SDECATID) "RTN","SDEC07",48,0) I SDECATID="WALKIN" S SDECWKIN=1 "RTN","SDEC07",49,0) I SDECATID'?.N&(SDECATID'="WALKIN") S SDECATID="" "RTN","SDEC07",50,0) ;validate appointment length - if passed in, must be 5-120 "RTN","SDEC07",51,0) S SDECLEN=$G(SDECLEN) "RTN","SDEC07",52,0) ;I SDECLEN'="",(+SDECLEN<5)!(SDECLEN>120) D ERR(SDECI+1,"SDEC07 Error: Appointment length must be between 5 - 120.") Q "RTN","SDEC07",53,0) ;validate MTRC flag (optional) "RTN","SDEC07",54,0) S SDMRTC=$$UP^XLFSTR($G(SDMRTC)) "RTN","SDEC07",55,0) S SDMRTC=$S(SDMRTC="TRUE":1,1:0) "RTN","SDEC07",56,0) ;validate desired date of appt (optional) "RTN","SDEC07",57,0) S SDDDT=$G(SDDDT) "RTN","SDEC07",58,0) I SDDDT'="" S %DT="" S X=$P(SDDDT,"@",1) D ^%DT S SDDDT=Y I Y=-1 S SDDDT="" "RTN","SDEC07",59,0) I SDDDT="",SDECATID'="WALKIN" S SDDDT=$P(SDECSTART,".",1) "RTN","SDEC07",60,0) ;validate requested by "RTN","SDEC07",61,0) S SDREQBY=$$UP^XLFSTR($G(SDREQBY)) "RTN","SDEC07",62,0) I SDREQBY'="" S SDREQBY=$S(SDREQBY="PROVIDER":1,SDREQBY="PATIENT":2,1:0) "RTN","SDEC07",63,0) ;validate lab date/time (optional) "RTN","SDEC07",64,0) S SDLAB=$G(SDLAB) "RTN","SDEC07",65,0) I SDLAB'="" S %DT="T" S X=SDLAB D ^%DT S SDLAB=Y I Y=-1 S SDLAB="" "RTN","SDEC07",66,0) ;validate EKG date/time (optional) "RTN","SDEC07",67,0) S SDEKG=$G(SDEKG) "RTN","SDEC07",68,0) I SDEKG'="" S %DT="T" S X=SDEKG D ^%DT S SDEKG=Y I Y=-1 S SDEKG="" "RTN","SDEC07",69,0) ;validate XRAY date/time (optional) "RTN","SDEC07",70,0) S SDXRAY=$G(SDXRAY) "RTN","SDEC07",71,0) I SDXRAY'="" S %DT="T" S X=SDXRAY D ^%DT S SDXRAY=Y I Y=-1 S SDXRAY="" "RTN","SDEC07",72,0) ;validate provider "RTN","SDEC07",73,0) I '$D(^VA(200,+$G(PROVIEN),0)) S PROVIEN="" "RTN","SDEC07",74,0) S SDID=$G(SDID) "RTN","SDEC07",75,0) ;validate clinic "RTN","SDEC07",76,0) S SDCL=$G(SDCL) "RTN","SDEC07",77,0) I SDCL'="" I '$D(^SC(SDCL,0)) S SDCL="" "RTN","SDEC07",78,0) I SDCL="" S SDCL=$$GET1^DIQ(409.831,SDECRESD_",",.04,"I") ;clinic ID ;support for single HOSPITAL LOCATION in SDEC RESOURCE "RTN","SDEC07",79,0) S OVB=+$G(OVB) ;alb/sat 665 "RTN","SDEC07",80,0) I 'OVB S OBM=$$OBM1^SDEC57(SDCL,SDECSTART,SDMRTC,,+SDECWKIN) I OBM'="",+OBM'=1 S SDECAPPTID=0 D ERR(SDECI+1,"OBM"_OBM) Q ;alb/sat 658 check if overbook ;alb/sat 665 clear SDECAPPTID "RTN","SDEC07",81,0) ;validate appt request type (required) "RTN","SDEC07",82,0) S SDAPTYP=$G(SDAPTYP) "RTN","SDEC07",83,0) I SDAPTYP'="" D "RTN","SDEC07",84,0) .I $P(SDAPTYP,"|",1)="E" I '$D(^SDWL(409.3,+$P(SDAPTYP,"|",2),0)) S SDAPTYP="" "RTN","SDEC07",85,0) .I $P(SDAPTYP,"|",1)="R" I '$D(^SD(403.5,+$P(SDAPTYP,"|",2),0)) S SDAPTYP="" "RTN","SDEC07",86,0) .I $P(SDAPTYP,"|",1)="C" I '$D(^GMR(123,+$P(SDAPTYP,"|",2),0)) S SDAPTYP="" ;ICR 4837 "RTN","SDEC07",87,0) .I $P(SDAPTYP,"|",1)="A" I '$D(^SDEC(409.85,+$P(SDAPTYP,"|",2),0)) S SDAPTYP="" "RTN","SDEC07",88,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",89,0) I SDCL="" D "RTN","SDEC07",90,0) .S:$P(SDAPTYP,"|",1)="E" SDCL=$$GET1^DIQ(409.3,$P(SDAPTYP,"|",2)_",",13.2,"I") "RTN","SDEC07",91,0) .S:$P(SDAPTYP,"|",1)="R" SDCL=$$GET1^DIQ(403.5,$P(SDAPTYP,"|",2)_",",4.5,"I") "RTN","SDEC07",92,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",93,0) .S:$P(SDAPTYP,"|",1)="A" SDCL=$$GET1^DIQ(409.85,$P(SDAPTYP,"|",2)_",",8,"I") "RTN","SDEC07",94,0) I SDCL="" D ERR(SDECI+1,"SDEC07 Error: Invalid clinic ID.") Q "RTN","SDEC07",95,0) I $$INACTIVE^SDEC32(SDCL) D ERR(SDECI+1,"SDEC07 Error: "_$$GET1^DIQ(44,SDCL_",",.01)_" is an inactive clinic.") Q "RTN","SDEC07",96,0) ;validate service connected "RTN","SDEC07",97,0) S SDSVCPR=$G(SDSVCPR) "RTN","SDEC07",98,0) I SDSVCPR'="" S:(+SDSVCPR<0)!(+SDSVCPR>100) SDSVCPR="" "RTN","SDEC07",99,0) S SDSVCP=$G(SDSVCP) "RTN","SDEC07",100,0) S SDSVCP=$S(SDSVCP=0:0,SDSVCP="NO":0,SDSVCP=1:1,SDSVCP="YES":1,1:"") "RTN","SDEC07",101,0) ;validate note "RTN","SDEC07",102,0) S SDECNOTE=$G(SDECNOTE) S:SDECNOTE'="" SDECNOTE=$TR($E(SDECNOTE,1,150),"^"," ") ;alb/sat 658 - only use 1st 150 characters "RTN","SDEC07",103,0) ;validate APPTYPE "RTN","SDEC07",104,0) S APPTYPE=$G(APPTYPE) I APPTYPE'="",'$D(^SD(409.1,+APPTYPE,0)) S APPTYPE="" "RTN","SDEC07",105,0) ;validate Patient Status (EESTAT) "RTN","SDEC07",106,0) S EESTAT=$G(EESTAT) "RTN","SDEC07",107,0) I EESTAT="" D "RTN","SDEC07",108,0) .I $P(SDAPTYP,"|",1)="E" S EESTAT=$$GET1^DIQ(409.3,$P(SDAPTYP,"|",2)_",",27,"I") "RTN","SDEC07",109,0) .I $P(SDAPTYP,"|",1)="A" S EESTAT=$$GET1^DIQ(409.3,$P(SDAPTYP,"|",2)_",",.02,"I") "RTN","SDEC07",110,0) S EESTAT=$S(EESTAT="N":"N",EESTAT="NEW":"N",EESTAT="E":"E",EESTAT="ESTABLISHED":"E",1:"") "RTN","SDEC07",111,0) ;validate OVB (overbook) "RTN","SDEC07",112,0) S OVB=+$G(OVB) "RTN","SDEC07",113,0) I 'OVB D "RTN","SDEC07",114,0) .D OVBOOK^SDEC(.RET,SDCL,SDECSTART,SDECRES) "RTN","SDEC07",115,0) D "RTN","SDEC07",116,0) .S SDAPPTYP=+APPTYPE "RTN","SDEC07",117,0) .I 'SDAPPTYP D "RTN","SDEC07",118,0) ..I $P(SDAPTYP,"|",1)="E" S SDAPPTYP=$$GET1^DIQ(409.3,+$P(SDAPTYP,"|",2)_",",8.7,"I") "RTN","SDEC07",119,0) ..I $P(SDAPTYP,"|",1)="A" S SDAPPTYP=$$GET1^DIQ(409.85,+$P(SDAPTYP,"|",2)_",",8.7,"I") "RTN","SDEC07",120,0) ..I $P(SDAPTYP,"|",1)="C",+APPTYPE S SDAPPTYP=+APPTYPE "RTN","SDEC07",121,0) .S:'SDAPPTYP SDAPPTYP=$O(^SD(409.1,"B","REGULAR",0)) "RTN","SDEC07",122,0) ;Lock SDEC node "RTN","SDEC07",123,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",124,0) ; "RTN","SDEC07",125,0) ;TSTART "RTN","SDEC07",126,0) S SDECAPPTID=$$SDECADD(SDECSTART,SDECEND,DFN,SDECRESD,SDECATID,SDDDT,SDID,SDAPTYP,PROVIEN,SDCL,SDECNOTE,SAVESTRT,SDECRES,SDAPPTYP,EESTAT,1,+SDECLEN) ;alb/sat 665 add SDECLEN "RTN","SDEC07",127,0) I 'SDECAPPTID D ERR(SDECI+1,"SDEC07 Error: Unable to add appointment to SDEC APPOINTMENT file.") Q "RTN","SDEC07",128,0) ;Save the Appointment and start a new transaction that will get rolled back if there's an error "RTN","SDEC07",129,0) ;TCOMMIT "RTN","SDEC07",130,0) ;TSTART "RTN","SDEC07",131,0) ; call chart request "RTN","SDEC07",132,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",133,0) I SDECATID="WALKIN",$G(SDECCR),$G(SDECDEV)'="" S DGQUIET=1 D WISD^SDECRT(DFN,$P(SDECSTART,"."),"",SDECDEV) "RTN","SDEC07",134,0) I SDECNOTE]"" D SDECWP(SDECAPPTID,SDECNOTE) "RTN","SDEC07",135,0) ; "RTN","SDEC07",136,0) ;Create Appointment in VistA ;TODO: have this call APPVISTA^SDEC07B "RTN","SDEC07",137,0) I +SDCL,$D(^SC(SDCL,0)) D I +SDECERR D ERR(SDECI+1,$P(SDECERR,U,2)) "RTN","SDEC07",138,0) . S SDECC("PAT")=DFN "RTN","SDEC07",139,0) . S SDECC("CLN")=SDCL "RTN","SDEC07",140,0) . S SDECC("TYP")=$S(+SDECWKIN:4,SDAPPTYP=1:1,1:3) ;3 for scheduled appts, 4 for walkins "RTN","SDEC07",141,0) . S SDECC("COL")=$S(SDAPPTYP=7:1,1:"") ;collateral visit if appointment type is COLLATERAL OF VET. "RTN","SDEC07",142,0) . S SDECC("APT")=SDAPPTYP "RTN","SDEC07",143,0) . S SDECC("ADT")=SDECSTART "RTN","SDEC07",144,0) . S SDECC("LEN")=SDECLEN "RTN","SDEC07",145,0) . S SDECC("OI")=$E($G(SDECNOTE),1,150) ;File 44 has 150 character limit on OTHER field "RTN","SDEC07",146,0) . S SDECC("OI")=$TR(SDECC("OI"),";"," ") ;No semicolons allowed "RTN","SDEC07",147,0) . S SDECC("OI")=$$STRIP(SDECC("OI")) ;Strip control characters from note "RTN","SDEC07",148,0) . S SDECC("RES")=SDECRESD "RTN","SDEC07",149,0) . S SDECC("USR")=DUZ "RTN","SDEC07",150,0) . S SDECC("MTR")=$G(SDMRTC) "RTN","SDEC07",151,0) . S SDECC("DDT")=SDDDT "RTN","SDEC07",152,0) . S SDECC("REQ")=SDREQBY "RTN","SDEC07",153,0) . S SDECC("LAB")=SDLAB "RTN","SDEC07",154,0) . S SDECC("XRA")=SDXRAY "RTN","SDEC07",155,0) . S SDECC("EKG")=SDEKG "RTN","SDEC07",156,0) . S SDECC("OVB")=+OVB "RTN","SDEC07",157,0) . S SDECC("ELG")=SDEL "RTN","SDEC07",158,0) . S:$P(SDAPTYP,"|",1)="C" SDECC("CON")=$P(SDAPTYP,"|",2) "RTN","SDEC07",159,0) . S SDECERR=$$MAKE^SDEC07B(.SDECC) "RTN","SDEC07",160,0) . Q:SDECERR "RTN","SDEC07",161,0) . ;Update Clinic availability "RTN","SDEC07",162,0) . D AVUPDT(SDCL,SDECSTART,SDECLEN) "RTN","SDEC07",163,0) . ;L "RTN","SDEC07",164,0) . Q "RTN","SDEC07",165,0) ;update wait list "RTN","SDEC07",166,0) I $P(SDAPTYP,"|",1)="E" D EWL^SDEC07A($P(SDAPTYP,"|",2),SDECSTART,SDCL,SDSVCPR,SDSVCP,,SDAPPTYP) ;alb/sat 658 do not pass note "RTN","SDEC07",167,0) ;update appt request "RTN","SDEC07",168,0) I $P(SDAPTYP,"|",1)="A" D "RTN","SDEC07",169,0) .D UPDATE^SDECAR2($P(SDAPTYP,"|",2),SDECSTART,SDCL,SDSVCPR,SDSVCP,,SDAPPTYP) ;alb/sat 658 do not pass note "RTN","SDEC07",170,0) .I $G(SDMRTC),$G(SDPARENT) D AR433^SDECAR2(SDPARENT,SDECAPPTID_"~"_$P(SDAPTYP,"|",2)) "RTN","SDEC07",171,0) .D:$G(SDPARENT) AR438^SDECAR2($P(SDAPTYP,"|",2),SDPARENT) "RTN","SDEC07",172,0) N SDT S SDT=SDECSTART "RTN","SDEC07",173,0) ;add entry to OUTPATIENT ENCOUNTER file (#409.68) ;alb/sat 672 "RTN","SDEC07",174,0) I $$NEW^SDPCE(SDT) D "RTN","SDEC07",175,0) .N SDCOED "RTN","SDEC07",176,0) .S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL) "RTN","SDEC07",177,0) ; "RTN","SDEC07",178,0) ;Return Recordset "RTN","SDEC07",179,0) ;TCOMMIT "RTN","SDEC07",180,0) L -^SDEC(409.84,DFN) "RTN","SDEC07",181,0) L -^DPT(DFN) "RTN","SDEC07",182,0) S SDECI=SDECI+1 "RTN","SDEC07",183,0) S ^TMP("SDEC07",$J,SDECI)=SDECAPPTID_"^"_$G(SDECDERR)_$C(30) "RTN","SDEC07",184,0) S SDECI=SDECI+1 "RTN","SDEC07",185,0) S ^TMP("SDEC07",$J,SDECI)=$C(31) "RTN","SDEC07",186,0) Q "RTN","SDEC07",187,0) ; "RTN","SDEC07",188,0) STRIP(SDECZ) ;Replace control characters with spaces "RTN","SDEC07",189,0) N SDECI "RTN","SDEC07",190,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",191,0) Q SDECZ "RTN","SDEC07",192,0) ; "RTN","SDEC07",193,0) ;ADD SDEC APPOINTMENT ENTRY "RTN","SDEC07",194,0) SDECADD(SDECSTART,SDECEND,DFN,SDECRESD,SDECATID,SDDDT,SDID,SDAPTYP,PROVIEN,SDCL,SDECNOTE,SAVESTRT,SDECRES,SDAPPTYP,EESTAT,SDF,SDECLEN) ;alb/sat 665 add SDECLEN "RTN","SDEC07",195,0) ;SDF - (optional) flags "RTN","SDEC07",196,0) ; 1. called from GUI (update consult only if called from GUI) "RTN","SDEC07",197,0) ;Returns ien in SDECAPPT or 0 if failed "RTN","SDEC07",198,0) ;called from SDEC APPADD rpc and from VistA via SDM1A "RTN","SDEC07",199,0) ;Create entry in SDEC APPOINTMENT "RTN","SDEC07",200,0) N SDIEN,SDECAPPTID,SDECFDA,SDECIEN,SDECMSG,SL,X "RTN","SDEC07",201,0) S SDECSTART=$G(SDECSTART) "RTN","SDEC07",202,0) S SAVESTRT=$G(SAVESTRT),SDECRES=$G(SDECRES) ;MGH save date/time for consult request "RTN","SDEC07",203,0) S DFN=$G(DFN) "RTN","SDEC07",204,0) S SDECRESD=$G(SDECRESD) "RTN","SDEC07",205,0) S SDECATID=$G(SDECATID) "RTN","SDEC07",206,0) S SDDDT=$G(SDDDT) "RTN","SDEC07",207,0) S SDID=$G(SDID) "RTN","SDEC07",208,0) S SDAPTYP=$G(SDAPTYP) "RTN","SDEC07",209,0) S SDAPPTYP=$G(SDAPPTYP) "RTN","SDEC07",210,0) S PROVIEN=$G(PROVIEN) "RTN","SDEC07",211,0) S SDCL=$G(SDCL) "RTN","SDEC07",212,0) S SDECEND=$G(SDECEND) "RTN","SDEC07",213,0) ;alb/sat 665 begin modification "RTN","SDEC07",214,0) S SDECLEN=$G(SDECLEN) "RTN","SDEC07",215,0) I SDECLEN="",SDECEND="" S SDECLEN=+$G(^SC(SDCL,"SL")) S:'+SDECLEN SDECLEN=30 S SDECEND=$$FMADD^XLFDT(SDECSTART,,,+SDECLEN) ;no length or end date/time "RTN","SDEC07",216,0) I SDECLEN="",SDECEND'="" S SDECLEN=$$FMDIFF^XLFDT(SDECEND,SDECSTART,2)\60 ;no length "RTN","SDEC07",217,0) I SDECLEN'="",SDECEND="" S SDECEND=$$FMADD^XLFDT(SDECSTART,,,+SDECLEN) ;no end date/time "RTN","SDEC07",218,0) ;alb/sat 665 end modification "RTN","SDEC07",219,0) S SDECNOTE=$G(SDECNOTE) "RTN","SDEC07",220,0) S SDF=$G(SDF,0) "RTN","SDEC07",221,0) I PROVIEN="" D "RTN","SDEC07",222,0) .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I") "RTN","SDEC07",223,0) S SDIEN=$$APPTGET^SDECUTL(DFN,SDECSTART,SDCL) "RTN","SDEC07",224,0) S SDIEN=$S(SDIEN'="":SDIEN_",",1:"+1,") "RTN","SDEC07",225,0) S SDECFDA(409.84,SDIEN,.01)=SDECSTART "RTN","SDEC07",226,0) S SDECFDA(409.84,SDIEN,.02)=SDECEND "RTN","SDEC07",227,0) S SDECFDA(409.84,SDIEN,.05)=DFN "RTN","SDEC07",228,0) S:+SDAPPTYP SDECFDA(409.84,SDIEN,.06)=SDAPPTYP "RTN","SDEC07",229,0) ;S:SDECATID?.N SDECFDA(409.84,SDIEN,.06)=SDECATID "RTN","SDEC07",230,0) S SDECFDA(409.84,SDIEN,.07)=SDECRESD "RTN","SDEC07",231,0) S SDECFDA(409.84,SDIEN,.08)=$G(DUZ) "RTN","SDEC07",232,0) S SDECFDA(409.84,SDIEN,.09)=$P($$NOW^XLFDT,".",1) "RTN","SDEC07",233,0) S SDECFDA(409.84,SDIEN,.1)="" "RTN","SDEC07",234,0) S SDECFDA(409.84,SDIEN,.101)="" "RTN","SDEC07",235,0) S SDECFDA(409.84,SDIEN,.102)="" "RTN","SDEC07",236,0) S SDECFDA(409.84,SDIEN,.11)="" "RTN","SDEC07",237,0) S SDECFDA(409.84,SDIEN,.12)="" "RTN","SDEC07",238,0) S SDECFDA(409.84,SDIEN,.121)="" "RTN","SDEC07",239,0) S SDECFDA(409.84,SDIEN,.122)="" "RTN","SDEC07",240,0) S:SDECATID="WALKIN" SDECFDA(409.84,SDIEN,.13)="y" "RTN","SDEC07",241,0) S:PROVIEN'="" SDECFDA(409.84,SDIEN,.16)=PROVIEN "RTN","SDEC07",242,0) S SDECFDA(409.84,SDIEN,.17)="" "RTN","SDEC07",243,0) S:$G(SDECLEN)'="" SDECFDA(409.84,SDIEN,.18)=SDECLEN "RTN","SDEC07",244,0) S SDECFDA(409.84,SDIEN,.2)=SDDDT "RTN","SDEC07",245,0) S:$G(SDID)'="" SDECFDA(409.84,SDIEN,.21)=SDID "RTN","SDEC07",246,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",247,0) S:$G(EESTAT)'="" SDECFDA(409.84,SDIEN,.23)=EESTAT "RTN","SDEC07",248,0) K SDECIEN,SDECMSG "RTN","SDEC07",249,0) D UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG") "RTN","SDEC07",250,0) S SDECAPPTID=$S(SDIEN'="+1,":+SDIEN,1:+$G(SDECIEN(1))) "RTN","SDEC07",251,0) K SDECMSG "RTN","SDEC07",252,0) I SDECNOTE="" D WP^DIE(409.84,$S(+$G(SDECAPPTID):SDECAPPTID_",",1:SDIEN_","),1,"","@","SDECMSG") "RTN","SDEC07",253,0) I SDECNOTE'="" N ARR D WP^SDECUTL(.ARR,SDECNOTE) D WP^DIE(409.84,$S(+$G(SDECAPPTID):SDECAPPTID_",",1:SDIEN_","),1,"","ARR","SDECMSG") "RTN","SDEC07",254,0) I SDECAPPTID'="" D "RTN","SDEC07",255,0) .I $P(SDAPTYP,"|",1)="C",SDF D "RTN","SDEC07",256,0) ..D REQSET^SDEC07A($P(SDAPTYP,"|",2),PROVIEN,"",1,"",SDECNOTE,SAVESTRT,SDECRES) ;MGH added 3 parameters to this call "RTN","SDEC07",257,0) Q SDECAPPTID "RTN","SDEC07",258,0) ; "RTN","SDEC07",259,0) SDECWP(SDECAPPTID,SDECNOTE) ; "RTN","SDEC07",260,0) ;Add WP field "RTN","SDEC07",261,0) I SDECNOTE]"" S SDECNOTE(.5)=SDECNOTE,SDECNOTE="" "RTN","SDEC07",262,0) I $D(SDECNOTE(0)) S SDECNOTE(.5)=SDECNOTE(0) K SDECNOTE(0) "RTN","SDEC07",263,0) I $D(SDECNOTE(.5)) D "RTN","SDEC07",264,0) . D WP^DIE(409.84,SDECAPPTID_",",1,"","SDECNOTE","SDECMSG") "RTN","SDEC07",265,0) Q "RTN","SDEC07",266,0) ; "RTN","SDEC07",267,0) ADDEVT(DFN,SDECSTART,SDECSC,SDCLA) ;EP "RTN","SDEC07",268,0) ;Called by SDEC ADD APPOINTMENT protocol "RTN","SDEC07",269,0) ;SDECSC=IEN of clinic in ^SC "RTN","SDEC07",270,0) ;SDCLA=IEN for ^SC(SDECSC,"S",SDECSTART,1,SDCLA). Use to get Length & Note "RTN","SDEC07",271,0) ; "RTN","SDEC07",272,0) N SDECNOD,SDECLEN,SDECAPPTID,SDECNODP,SDECWKIN,SDECRES "RTN","SDEC07",273,0) Q:+$G(SDECNOEV) "RTN","SDEC07",274,0) I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) "RTN","SDEC07",275,0) Q:'+$G(SDECRES) "RTN","SDEC07",276,0) S SDECNOD=$G(^SC(SDECSC,"S",SDECSTART,1,SDCLA,0)) "RTN","SDEC07",277,0) Q:SDECNOD="" "RTN","SDEC07",278,0) S SDECNODP=$G(^DPT(DFN,"S",SDECSTART,0)) "RTN","SDEC07",279,0) S SDECWKIN="" "RTN","SDEC07",280,0) S:$P(SDECNODP,U,7)=4 SDECWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile "RTN","SDEC07",281,0) S SDECLEN=$P(SDECNOD,U,2) "RTN","SDEC07",282,0) Q:'+SDECLEN "RTN","SDEC07",283,0) S SDECEND=$$FMADD^XLFDT(SDECSTART,0,0,SDECLEN,0) "RTN","SDEC07",284,0) S SDECAPPTID=$$SDECADD(SDECSTART,SDECEND,DFN,SDECRES,SDECWKIN,,,,,SDECSC,,,,,,1,+SDECLEN) ;alb/sat 665 add SDECLEN "RTN","SDEC07",285,0) Q:'+SDECAPPTID "RTN","SDEC07",286,0) S SDECNOTE=$P(SDECNOD,U,4) "RTN","SDEC07",287,0) I SDECNOTE]"" D SDECWP(SDECAPPTID,SDECNOTE) "RTN","SDEC07",288,0) D ADDEVT3(SDECRES) "RTN","SDEC07",289,0) Q "RTN","SDEC07",290,0) ; "RTN","SDEC07",291,0) ADDEVT3(SDECRES) ; "RTN","SDEC07",292,0) ;Call RaiseEvent to notify GUI clients "RTN","SDEC07",293,0) Q "RTN","SDEC07",294,0) ; "RTN","SDEC07",295,0) ERR(SDECI,SDECERR) ;Error processing "RTN","SDEC07",296,0) S SDECI=SDECI+1 "RTN","SDEC07",297,0) S SDECERR=$TR(SDECERR,"^","~") "RTN","SDEC07",298,0) S ^TMP("SDEC07",$J,SDECI)=$G(SDECAPPTID,0)_"^"_SDECERR_$C(30) "RTN","SDEC07",299,0) S SDECI=SDECI+1 "RTN","SDEC07",300,0) S ^TMP("SDEC07",$J,SDECI)=$C(31) "RTN","SDEC07",301,0) L "RTN","SDEC07",302,0) Q "RTN","SDEC07",303,0) ; "RTN","SDEC07",304,0) ETRAP ;EP Error trap entry "RTN","SDEC07",305,0) D ^%ZTER "RTN","SDEC07",306,0) I '$D(SDECI) N SDECI S SDECI=999999 "RTN","SDEC07",307,0) S SDECI=SDECI+1 "RTN","SDEC07",308,0) D ERR(SDECI,"SDEC07 Error") "RTN","SDEC07",309,0) Q "RTN","SDEC07",310,0) DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR "RTN","SDEC07",311,0) ; "RTN","SDEC07",312,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",313,0) F SDTMP=SDTMP:-1:281 S Y=SDTMP#4=1+1+Y "RTN","SDEC07",314,0) S Y=$E(X,6,7)+Y#7 "RTN","SDEC07",315,0) Q "RTN","SDEC07",316,0) ; "RTN","SDEC07",317,0) AVUPDT(SDCL,SDECSTART,SDECLEN) ;Update Clinic availability "RTN","SDEC07",318,0) ;SEE SDM1 "RTN","SDEC07",319,0) N %,ABORT,SDNOT,Y,DFN,SDVAL "RTN","SDEC07",320,0) N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG "RTN","SDEC07",321,0) N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I,SDECINC "RTN","SDEC07",322,0) S Y=SDCL ;,DFN=DFN ;renamed SDECPATID to DFN "RTN","SDEC07",323,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",324,0) ;Determine maximum days for scheduling "RTN","SDEC07",325,0) S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365 "RTN","SDEC07",326,0) S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1)) "RTN","SDEC07",327,0) S SDDATE=SDECSTART "RTN","SDEC07",328,0) S SDSDATE=SDDATE,SDDATE=SDDATE\1 "RTN","SDEC07",329,0) 1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC "RTN","SDEC07",330,0) ;Q:$D(SDXXX) "RTN","SDEC07",331,0) S CCXN=0 K MXOK,COV,SDPROT Q:$G(DFN)<0 S SC=+SC "RTN","SDEC07",332,0) S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2) "RTN","SDEC07",333,0) S X2=SDEDT D C^%DTC S SDEDT=X "RTN","SDEC07",334,0) S Y=SDECSTART "RTN","SDEC07",335,0) EN1 S (X,SD)=Y,SM=0 D DOW "RTN","SDEC07",336,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",337,0) S S=SDECLEN "RTN","SDEC07",338,0) ;Check if SDECLEN evenly divisible by appointment length "RTN","SDEC07",339,0) S SDVAL=$P(SL,U) "RTN","SDEC07",340,0) I SDECLEN9 "RTN","SDEC07",347,0) L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC "RTN","SDEC07",348,0) S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1) "RTN","SDEC07",349,0) S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST "RTN","SDEC07",350,0) I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q "RTN","SDEC07",351,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",352,0) ; "RTN","SDEC07",353,0) SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP "RTN","SDEC07",354,0) S SDNOT=1 "RTN","SDEC07",355,0) S ABORT=0 "RTN","SDEC07",356,0) F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT "RTN","SDEC07",357,0) . S ST=$E(S,I+1) S:ST="" ST=" " "RTN","SDEC07",358,0) . S Y=$E(STR,$F(STR,ST)-2) "RTN","SDEC07",359,0) . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q "RTN","SDEC07",360,0) . I Y="" S ABORT=1 Q "RTN","SDEC07",361,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",362,0) . Q "RTN","SDEC07",363,0) S ^SC(SC,"ST",$P(SD,"."),1)=S "RTN","SDEC07",364,0) L -^SC(SC,"ST",$P(SD,"."),1) "RTN","SDEC07",365,0) Q "RTN","SDEC07",366,0) ; "RTN","SDEC07",367,0) ERROR ; "RTN","SDEC07",368,0) D ERR1("Error") "RTN","SDEC07",369,0) Q "RTN","SDEC07",370,0) ; "RTN","SDEC07",371,0) ERR1(SDECERR) ;Error processing "RTN","SDEC07",372,0) S SDECI=SDECI+1 "RTN","SDEC07",373,0) S ^TMP("SDEC07",$J,SDECI)=SDECERR_$C(30) "RTN","SDEC07",374,0) S SDECI=SDECI+1 "RTN","SDEC07",375,0) S ^TMP("SDEC07",$J,SDECI)=$C(31) "RTN","SDEC32") 0^6^B114220847^B103453639 "RTN","SDEC32",1,0) SDEC32 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 26, 2017 "RTN","SDEC32",2,0) ;;5.3;Scheduling;**627,643,642,658,665,672**;Aug 13, 1993;Build 9 "RTN","SDEC32",3,0) ; "RTN","SDEC32",4,0) Q "RTN","SDEC32",5,0) ; "RTN","SDEC32",6,0) ; "RTN","SDEC32",7,0) ERROR ; "RTN","SDEC32",8,0) D ERR("VistA Error") "RTN","SDEC32",9,0) Q "RTN","SDEC32",10,0) ; "RTN","SDEC32",11,0) ERR(SDECERR) ;Error processing "RTN","SDEC32",12,0) S SDECI=SDECI+1 "RTN","SDEC32",13,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC32",14,0) Q "RTN","SDEC32",15,0) ; "RTN","SDEC32",16,0) HOSPLOC(SDECY,SDECP,MAXREC,LSUB) ;return HOSPITAL LOCATIONs "RTN","SDEC32",17,0) ;HOSPLOC(SDECY) external parameter tag is in SDEC "RTN","SDEC32",18,0) ;INPUT: "RTN","SDEC32",19,0) ; SDECP - (optional) Partial name text "RTN","SDEC32",20,0) ; MAXREC - (optional) Max number of records to return "RTN","SDEC32",21,0) ; LSUB - (optional) subscripts from last call to pick up where left off "RTN","SDEC32",22,0) ;RETURN: "RTN","SDEC32",23,0) ;Global Array in which each array entry "RTN","SDEC32",24,0) ;contains HOSPITAL LOCATION data separated by ^: "RTN","SDEC32",25,0) ; 1. HOSPITAL_LOCATION_ID "RTN","SDEC32",26,0) ; 2. HOSPITAL_LOCATION "RTN","SDEC32",27,0) ; 3. DEFAULT_PROVIDER "RTN","SDEC32",28,0) ; 4. STOP_CODE_NUMBER "RTN","SDEC32",29,0) ; 5. INACTIVATE_DATE "RTN","SDEC32",30,0) ; 6. REACTIVATE_DATE "RTN","SDEC32",31,0) ; 7. LASTSUB "RTN","SDEC32",32,0) N SDECI,SDECIEN,SDECNOD,SDECNOD1,SDECNAM,SDECINA,SDECREA,SDECSCOD "RTN","SDEC32",33,0) N SDECIEN1,SDECPRV,SDDUP,SDNAM "RTN","SDEC32",34,0) N LASTSUB,X "RTN","SDEC32",35,0) K ^TMP("SDEC",$J) "RTN","SDEC32",36,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC32",37,0) S SDECI=0 "RTN","SDEC32",38,0) S ^TMP("SDEC",$J,SDECI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE^T00030LASTSUB"_$C(30) "RTN","SDEC32",39,0) ; "RTN","SDEC32",40,0) S SDECP=$G(SDECP) "RTN","SDEC32",41,0) S MAXREC=+$G(MAXREC) "RTN","SDEC32",42,0) S LSUB=$G(LSUB) "RTN","SDEC32",43,0) S:LSUB="" SDECNAM=$S(SDECP'="":$$GETSUB^SDEC56(SDECP),1:"") "RTN","SDEC32",44,0) S:LSUB'="" SDECNAM=$$GETSUB^SDEC56($P(LSUB,"|",1)) "RTN","SDEC32",45,0) F S SDECNAM=$O(^SC("B",SDECNAM)) Q:(SDECP'="")&(SDECNAM'[SDECP) Q:SDECNAM="" D Q:(+MAXREC)&(SDECI'0 D Q:(+MAXREC)&(SDECI'0 "RTN","SDEC32",48,0) .. Q:'$D(^SC(+SDECIEN,0)) "RTN","SDEC32",49,0) .. Q:$$INACTIVE(+SDECIEN) "RTN","SDEC32",50,0) .. Q:+$$GET1^DIQ(44,SDECIEN_",",50.01,"I")=1 ;OOS? "RTN","SDEC32",51,0) .. S SDECINA=$$GET1^DIQ(44,SDECIEN_",",2505) ;INACTIVATE "RTN","SDEC32",52,0) .. S SDECREA=$$GET1^DIQ(44,SDECIEN_",",2506) ;REACTIVATE "RTN","SDEC32",53,0) .. S SDECNOD=^SC(SDECIEN,0) "RTN","SDEC32",54,0) .. Q:$D(SDDUP(+SDECIEN)) "RTN","SDEC32",55,0) .. S SDDUP(+SDECIEN)="" "RTN","SDEC32",56,0) .. S SDNAM=$P(SDECNOD,U) "RTN","SDEC32",57,0) .. S SDECSCOD=$$GET1^DIQ(44,SDECIEN_",",8) ;STOP CODE "RTN","SDEC32",58,0) .. ;Calculate default provider "RTN","SDEC32",59,0) .. S SDECPRV="" "RTN","SDEC32",60,0) .. I $D(^SC(SDECIEN,"PR")) D "RTN","SDEC32",61,0) ... S SDECIEN1=0 F S SDECIEN1=$O(^SC(SDECIEN,"PR",SDECIEN1)) Q:'+SDECIEN1 Q:SDECPRV]"" D "RTN","SDEC32",62,0) .... S SDECNOD1=$G(^SC(SDECIEN,"PR",SDECIEN1,0)) "RTN","SDEC32",63,0) .... S:$P(SDECNOD1,U,2)="1" SDECPRV=$$GET1^DIQ(200,$P(SDECNOD1,U),.01) "RTN","SDEC32",64,0) .... Q "RTN","SDEC32",65,0) ... Q "RTN","SDEC32",66,0) .. S LASTSUB=SDECNAM_"|"_SDECIEN "RTN","SDEC32",67,0) .. S SDECI=SDECI+1 "RTN","SDEC32",68,0) .. S ^TMP("SDEC",$J,SDECI)=SDECIEN_U_SDNAM_U_SDECPRV_U_SDECSCOD_U_SDECINA_U_SDECREA_U_LASTSUB_$C(30) "RTN","SDEC32",69,0) .. Q "RTN","SDEC32",70,0) I SDECNAM="",SDECIEN="" S $P(^TMP("SDEC",$J,SDECI),U,7)="" ;clear lastsub for last entry if finished "RTN","SDEC32",71,0) S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31) "RTN","SDEC32",72,0) K SDDUP "RTN","SDEC32",73,0) Q "RTN","SDEC32",74,0) ; "RTN","SDEC32",75,0) CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET,MAXREC) ;Returns CLINIC SETUP PARAMETERS for clinics that are active in the HOSPITAL LOCATION file "RTN","SDEC32",76,0) ;CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET) external parameter tag is in SDEC "RTN","SDEC32",77,0) ;INPUT: "RTN","SDEC32",78,0) ; SDNOSLOT - no slots flag - 0=return availability 1=do not return availability "RTN","SDEC32",79,0) ; SDIENS - IENs for individual hospital locations separated by pipes "RTN","SDEC32",80,0) ; SDNOLET - flag to include clinics with no Recall Letter defined "RTN","SDEC32",81,0) ; in RECALL REMINDERS LETTERS file "RTN","SDEC32",82,0) ; 0 = yes (include all clinics including those with no Recall Letter "RTN","SDEC32",83,0) ; defined) [default] "RTN","SDEC32",84,0) ; 1 = no (only return clinics with a Recall Letter "RTN","SDEC32",85,0) ; defined) "RTN","SDEC32",86,0) ;Returns CLINIC SETUP PARAMETERS file entries for clinics which "RTN","SDEC32",87,0) ;are active in ^SC "RTN","SDEC32",88,0) ;MGH Added SDIENS as input parameter to for hospital location IENs "RTN","SDEC32",89,0) ;MGH Added SDECP for partial name lookup "RTN","SDEC32",90,0) ;RETURN "RTN","SDEC32",91,0) ; Global Array in which each array entry contains the following Clinic data separated by ^: "RTN","SDEC32",92,0) ; 1. HOSPITAL_LOCATION_ID "RTN","SDEC32",93,0) ; 2. HOSPITAL_LOCATION "RTN","SDEC32",94,0) ; 3. CREATE_VISIT "RTN","SDEC32",95,0) ; 4. VISIT_SERVICE_CATEGORY "RTN","SDEC32",96,0) ; 5. MULTIPLE_CLINIC_CODES_USED? "RTN","SDEC32",97,0) ; 6. VISIT_PROVIDER_REQUIRED "RTN","SDEC32",98,0) ; 7. GENERATE_PCCPLUS_FORMS? "RTN","SDEC32",99,0) ; 8. MAX_OVERBOOKS "RTN","SDEC32",100,0) ; 9. SDECDAT "RTN","SDEC32",101,0) ;10. SDECDATN "RTN","SDEC32",102,0) ;11. APPTLEN - 1912 Appointment Length Numeric 10-240 "RTN","SDEC32",103,0) ;12. VAPPTLEN "RTN","SDEC32",104,0) ;13. SLOTS "RTN","SDEC32",105,0) ;14. PRIVUSERPRESENT_BOOL "RTN","SDEC32",106,0) ;15. PROTECTED "RTN","SDEC32",107,0) ;16. HOUR_DISPLAY_BEGIN - 1914 Hour Clinic Display Begins "RTN","SDEC32",108,0) ;17. DISPLAY_INCREMENTS - 1917 Display increments per hour "RTN","SDEC32",109,0) ; 1=60-MIN "RTN","SDEC32",110,0) ; 2=30-MIN "RTN","SDEC32",111,0) ; 4=15-MIN "RTN","SDEC32",112,0) ; 3=20-MIN "RTN","SDEC32",113,0) ; 6=10-MIN "RTN","SDEC32",114,0) ;18. HOLIDAYS - 1918.5 Schedule on Holidays? Y=YES "RTN","SDEC32",115,0) ;19. SPECIAL - 1910 SPECIAL INSTRUCTIONS separated by $C(13,10) "RTN","SDEC32",116,0) ;20. CLINIC_STOP - Stop code Number pointer to CLINIC STOP file 40.7 "RTN","SDEC32",117,0) N SDA,SDAPLEN,SDAR,SDDATA,SDF,SDFIELDS,SDI,SDJ,SDK,SDSLOTS,SDVAPL,SDECI,SDECIEN,SDECNOD,SDECNAM,SDECINA,SDECREA,SDTMP ;alb/sat 665 - add SDF "RTN","SDEC32",118,0) N SDECCRV,SDECDAT,SDECDATN,SDECVSC,SDECMULT,SDECREQ,SDECPCC,SDECMOB,SDECHPRV,SDECPROT,SDECNAM,SDCNT,SDL,SDMAX ;alb/sat 665 - add vars "RTN","SDEC32",119,0) N SDARR1,SDREF,SDXT,SDV ;alb/sat 672 "RTN","SDEC32",120,0) K ^TMP("SDEC",$J) "RTN","SDEC32",121,0) S (SDCNT,SDMAX)=0 "RTN","SDEC32",122,0) S SDF="" "RTN","SDEC32",123,0) S SDV="" ;alb/sat 672 "RTN","SDEC32",124,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC32",125,0) S SDECI=0 "RTN","SDEC32",126,0) ; 1 2 3 4 "RTN","SDEC32",127,0) S SDTMP="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030CREATE_VISIT^T00030VISIT_SERVICE_CATEGORY" "RTN","SDEC32",128,0) ; 5 6 7 "RTN","SDEC32",129,0) S SDTMP=SDTMP_"^T00030MULTIPLE_CLINIC_CODES_USED?^T00030VISIT_PROVIDER_REQUIRED^T00030GENERATE_PCCPLUS_FORMS?" "RTN","SDEC32",130,0) ; 8 9 10 11 12 13 14 "RTN","SDEC32",131,0) S SDTMP=SDTMP_"^T00030MAX_OVERBOOKS^T00030SDECDAT^T00030SDECDATN^T00030APPTLEN^T00030VAPPTLEN^T00030SLOTS^B00001PRIVUSERPRESENT_BOOL" "RTN","SDEC32",132,0) ; 15 16 17 18 "RTN","SDEC32",133,0) S SDTMP=SDTMP_"^B00001PROTECTED^T00030HOUR_DISPLAY_BEGIN^T00030DISPLAY_INCREMENTS^T00030HOLIDAYS^T00030SPECIAL^T00030CLINIC_STOP" "RTN","SDEC32",134,0) ; 21 22 23 "RTN","SDEC32",135,0) S SDTMP=SDTMP_"^T00030ABBR^T00030MORE^T00030DEFAULT_VIEW" ;alb/sat 672 - add DEFAULT_VIEW "RTN","SDEC32",136,0) S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(30) "RTN","SDEC32",137,0) ; "RTN","SDEC32",138,0) S (SDECDAT,SDECDATN)="" "RTN","SDEC32",139,0) S SDNOSLOT=$G(SDNOSLOT) "RTN","SDEC32",140,0) S SDNOLET=$G(SDNOLET) "RTN","SDEC32",141,0) S MAXREC=$G(MAXREC,50) "RTN","SDEC32",142,0) ;MGH change made for individual locations "RTN","SDEC32",143,0) I $G(SDIENS) D "RTN","SDEC32",144,0) .F SDK=1:1:$L(SDIENS,"|") D "RTN","SDEC32",145,0) ..S SDECIEN=$P(SDIENS,"|",SDK) "RTN","SDEC32",146,0) ..D PROCESS(SDECIEN) "RTN","SDEC32",147,0) ;MGH change made for partial name lookup "RTN","SDEC32",148,0) I $G(SDECP)'="" D "RTN","SDEC32",149,0) .;alb/sat 672 - begin modification; separate string and numeric lookup "RTN","SDEC32",150,0) .S (SDECNAM,SDXT)=$$GETSUB^SDECU(SDECP) "RTN","SDEC32",151,0) .;abbreviation as string "RTN","SDEC32",152,0) .S SDF="ABBRSTR" D "RTN","SDEC32",153,0) ..S SDREF="C" D PART Q "RTN","SDEC32",154,0) .;abbreviation as numeric "RTN","SDEC32",155,0) .S SDF="ABBRNUM",SDECNAM=SDXT_" " D "RTN","SDEC32",156,0) ..S SDREF="C" D PART Q "RTN","SDEC32",157,0) .;name as string "RTN","SDEC32",158,0) .S SDF="FULLSTR",SDECNAM=SDXT D "RTN","SDEC32",159,0) ..S SDREF="B" D PART Q "RTN","SDEC32",160,0) .;name as numeric "RTN","SDEC32",161,0) .S SDF="FULLNUM",SDECNAM=SDXT_" " D "RTN","SDEC32",162,0) ..S SDREF="B" D PART Q "RTN","SDEC32",163,0) .;alb/sat 672 - end modification; separate string and numeric lookup "RTN","SDEC32",164,0) I $G(SDIENS)=""&($G(SDECP)="") S SDECIEN=0 F S SDECIEN=$O(^SC(SDECIEN)) Q:SDECIEN'>0 D "RTN","SDEC32",165,0) .D PROCESS(SDECIEN) "RTN","SDEC32",166,0) S SDL=-1 F S SDL=$O(SDAR(SDL)) Q:SDL="" D "RTN","SDEC32",167,0) .S SDI="" F S SDI=$O(SDAR(SDL,SDI)) Q:SDI="" D "RTN","SDEC32",168,0) ..S SDJ="" F S SDJ=$O(SDAR(SDL,SDI,SDJ)) Q:SDJ="" D "RTN","SDEC32",169,0) ...S SDTMP=SDAR(SDL,SDI,SDJ) "RTN","SDEC32",170,0) ...S $P(SDTMP,U,22)=$S(+SDMAX:1,1:0) "RTN","SDEC32",171,0) ...S SDECI=SDECI+1 "RTN","SDEC32",172,0) ...S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(30) "RTN","SDEC32",173,0) S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31) "RTN","SDEC32",174,0) Q "RTN","SDEC32",175,0) PART ;partial name lookup ;alb/sat 672 "RTN","SDEC32",176,0) Q:SDREF="" "RTN","SDEC32",177,0) F S SDECNAM=$O(^SC(SDREF,SDECNAM)) Q:SDECNAM'[SDECP D I SDCNT'0 "RTN","SDEC32",218,0) S SDECPROT=$G(^SC(+SDECIEN,"SDPROT"))="Y" "RTN","SDEC32",219,0) S SDSP="" S SDI=0 F S SDI=$O(^SC(+SDECIEN,"SI",SDI)) Q:SDI'>0 S SDI1=$G(^SC(+SDECIEN,"SI",SDI,0)) S:SDI1'="" SDSP=$S(SDSP'="":SDSP_$C(13,10),1:"")_SDI1 "RTN","SDEC32",220,0) S:SDECNAM'="" SDV=$$GET^XPAR("PKG.SCHEDULING","SDEC VS GUI CLINIC VIEW",SDECNAM,"B") ;alb/sat 672 "RTN","SDEC32",221,0) S SDV=$S(SDV'="":$P(SDV,U,1),1:"W") ;alb/sat 672 "RTN","SDEC32",222,0) ; 1 2 3 4 5 6 7 8 "RTN","SDEC32",223,0) S SDTMP=SDECIEN_U_SDECNAM_U_SDECCRV_U_SDECVSC_U_SDECMULT_U_SDECREQ_U_SDECPCC_U_SDECMOB "RTN","SDEC32",224,0) ; 9 10 11 12 13 14 15 "RTN","SDEC32",225,0) S SDTMP=SDTMP_U_SDECDAT_U_SDECDATN_U_+SDAPLEN_U_SDVAPL_U_SDSLOTS_U_SDECHPRV_U_SDECPROT "RTN","SDEC32",226,0) ; 16 17 18 19 20 21 22 23 "RTN","SDEC32",227,0) S SDTMP=SDTMP_U_SDHDB_U_SDDI_U_SDH_U_SDSP_U_SDSTOP_U_SDECABR_U_U_SDV ;alb/sat 672 - add SDV "RTN","SDEC32",228,0) S SDAR(SDF["FULL",SDECNAM,SDECIEN)=SDTMP "RTN","SDEC32",229,0) S SDCNT=SDCNT+1 "RTN","SDEC32",230,0) Q "RTN","SDEC32",231,0) CHK(SDECP,SDECIEN) ;alb/sat 665 - stop if 'this' record found in abbreviations ;alb/sat 672 - removed "RTN","SDEC32",232,0) Q "RTN","SDEC32",233,0) N FND,SDR,SDX "RTN","SDEC32",234,0) S FND=0 "RTN","SDEC32",235,0) S SDX=$$GETSUB^SDEC56(SDECP) "RTN","SDEC32",236,0) F S SDX=$O(^SC("C",SDX)) Q:SDX="" Q:SDX'[SDECP D Q:+FND "RTN","SDEC32",237,0) .S SDR=0 F S SDR=$O(^SC("C",SDX,SDR)) Q:'+SDR S FND=SDR=SDECIEN Q:+FND "RTN","SDEC32",238,0) Q FND "RTN","SDEC32",239,0) ; "RTN","SDEC32",240,0) ; "RTN","SDEC32",241,0) GETSLOTS(SDDATA) ;get slots - NUMBER OF PATIENTS in the AVAILABILITY multiple of file 44 "RTN","SDEC32",242,0) ;INPUT: "RTN","SDEC32",243,0) ; SDDATA - array from GETS^DIQ against file 44 above to collect timeslots from "RTN","SDEC32",244,0) N SDI,SDDT,SDSLOTS "RTN","SDEC32",245,0) S SDSLOTS="" "RTN","SDEC32",246,0) S SDI="" F S SDI=$O(SDDATA(44.004,SDI)) Q:SDI="" D "RTN","SDEC32",247,0) .S SDDT=$P(SDI,",",2) ;get date "RTN","SDEC32",248,0) .S SDDT=SDDT_"."_SDDATA(44.004,SDI,.01,"I") ;get time "RTN","SDEC32",249,0) .S SDDT=$$FMTE^XLFDT(SDDT) "RTN","SDEC32",250,0) .S SDSLOTS=$S(SDSLOTS'="":SDSLOTS_"|",1:"")_SDDT_";;"_SDDATA(44.004,SDI,1,"E") "RTN","SDEC32",251,0) Q SDSLOTS "RTN","SDEC32",252,0) ; "RTN","SDEC32",253,0) INACTIVE(SDCL,SDDT) ;determine if clinic is active "RTN","SDEC32",254,0) ; X=0=ACTIVE "RTN","SDEC32",255,0) ; X=1=INACTIVE "RTN","SDEC32",256,0) N SDNODI,N21,N25,X "RTN","SDEC32",257,0) S SDDT=$G(SDDT) I SDDT="" S SDDT=DT "RTN","SDEC32",258,0) S SDDT=$P(SDDT,".",1) "RTN","SDEC32",259,0) S X=1 "RTN","SDEC32",260,0) S SDNODI=$G(^SC(SDCL,"I")) "RTN","SDEC32",261,0) Q:SDNODI="" 0 "RTN","SDEC32",262,0) S N21=$P(SDNODI,U,1) ;inactive date/time "RTN","SDEC32",263,0) S N25=$P(SDNODI,U,2) ;reactive date/time "RTN","SDEC32",264,0) I (N21="") S X=0 Q X "RTN","SDEC32",265,0) I (N21'="")&(N21>SDDT) S X=0 Q X "RTN","SDEC32",266,0) I (N25'="")&(N25'>SDDT) S X=0 Q X "RTN","SDEC32",267,0) Q X "RTN","SDEC32",268,0) ; "RTN","SDEC32",269,0) PRIV(SDECY,CLINIEN,USER) ;IS this USER in the PRIVILEGED USER multiple for the clinic "RTN","SDEC32",270,0) ;INPUT: "RTN","SDEC32",271,0) ; CLINIEN - pointer to HOSPITAL LOCATION file 44 "RTN","SDEC32",272,0) ; USER - pointer to NEW PERSON file 200 "RTN","SDEC32",273,0) ;RETURN: "RTN","SDEC32",274,0) ; A single boolean entry indicating that the USER is a PRIVILEGED USER for the clinic. "RTN","SDEC32",275,0) ; RETURNCODE - 0=NO; 1=YES; -1=error "RTN","SDEC32",276,0) ; MESSAGE "RTN","SDEC32",277,0) N SDRET "RTN","SDEC32",278,0) S SDECY="^TMP(""SDEC32"","_$J_",""PRIV"")" "RTN","SDEC32",279,0) K @SDECY "RTN","SDEC32",280,0) S @SDECY@(0)="T00030RETURNCODE^MESSAGE"_$C(30) "RTN","SDEC32",281,0) S CLINIEN=$G(CLINIEN) "RTN","SDEC32",282,0) I (CLINIEN="")!('$D(^SC(CLINIEN,0))) S @SDECY@(1)="-1^Invalid clinic ID."_$C(30,31) Q "RTN","SDEC32",283,0) S USER=$G(USER) "RTN","SDEC32",284,0) I (USER="")!('$D(^VA(200,USER,0))) S @SDECY@(1)="-1^Invalid user ID."_$C(30,31) Q "RTN","SDEC32",285,0) S SDRET=$D(^SC(CLINIEN,"SDPRIV",USER,0)) "RTN","SDEC32",286,0) S $P(SDRET,U,2)=$S(SDRET=1:"YES",1:"NO") "RTN","SDEC32",287,0) S @SDECY@(1)=SDRET_$C(30,31) "RTN","SDEC32",288,0) Q "RTN","SDEC50") 0^5^B102324779^B97773017 "RTN","SDEC50",1,0) SDEC50 ;ALB/SAT/JSM - VISTA SCHEDULING RPCS ;JUL 26, 2017 "RTN","SDEC50",2,0) ;;5.3;Scheduling;**627,658,665,672**;Aug 13, 1993;Build 9 "RTN","SDEC50",3,0) ; "RTN","SDEC50",4,0) Q "RTN","SDEC50",5,0) ; "RTN","SDEC50",6,0) FAPPTGET(SDECY,DFN,SDBEG,SDEND,SDANC) ; GET Future appointments for given patient and date range "RTN","SDEC50",7,0) ;FAPPTGET(SDECY,DFN,SDBEG,SDEND,SDANC) external parameter tag is in SDEC "RTN","SDEC50",8,0) ;INPUT: "RTN","SDEC50",9,0) ; DFN = (required) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates) "RTN","SDEC50",10,0) ; SDBEG = (required) Begin of date range to search for appointments in external format "RTN","SDEC50",11,0) ; SDEND = (required) End of date range to search for appointments in external format "RTN","SDEC50",12,0) ; SDANC = (optional) ancillary flag 0=all appointments; 1=only ancillary appointments "RTN","SDEC50",13,0) ;RETURN: "RTN","SDEC50",14,0) ; Successful Return: "RTN","SDEC50",15,0) ; Global Array in which each array entry contains Appointment Data from the PATIENT file "RTN","SDEC50",16,0) ; Data is separated by ^: "RTN","SDEC50",17,0) ; 1. DFN "RTN","SDEC50",18,0) ; 2. CLINIC_IEN - Clinic IEN "RTN","SDEC50",19,0) ; 3. CLINIC_NAME - Clinic Name "RTN","SDEC50",20,0) ; 4. APPT_DATE - Appointment Date in external format "RTN","SDEC50",21,0) ; 5. STATUS - Status text "RTN","SDEC50",22,0) ; 6. ANCTXT - Ancillary Text "RTN","SDEC50",23,0) ; 7. CONS -Consult Link pointer to REQUEST/CONSULTATION file 123 "RTN","SDEC50",24,0) ; "T00020DFN^T00020CLINIC_IEN^T00030CLINIC_NAME^T00020APPT_DATE^T00020STATUS^T00100ANCTXT^T00030CONS" "RTN","SDEC50",25,0) ; Caught Exception Return: "RTN","SDEC50",26,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",27,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",28,0) ; Unexpected Exception Return: "RTN","SDEC50",29,0) ; Handled by the RPC Broker. "RTN","SDEC50",30,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC50",31,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC50",32,0) ; text back to the client. "RTN","SDEC50",33,0) ; "RTN","SDEC50",34,0) N IEN,SDANCT,SDCL,SDCLN,SDCONS,SDATA,SDDT,SDST,SDT,X,Y,%DT "RTN","SDEC50",35,0) N SDTMP,SDTYP,SDTYPN ;alb/sat 672 "RTN","SDEC50",36,0) S SDECI=0 "RTN","SDEC50",37,0) K ^TMP("SDEC50",$J) "RTN","SDEC50",38,0) S SDECY="^TMP(""SDEC50"","_$J_")" "RTN","SDEC50",39,0) ; data header "RTN","SDEC50",40,0) S SDTMP="T00020DFN^T00020CLINIC_IEN^T00030CLINIC_NAME^T00020APPT_DATE^T00020STATUS^T00100ANCTXT" "RTN","SDEC50",41,0) S SDTMP=SDTMP_"^T00030CONS^T00030IEN^T00030APPTYPE_IEN^T00030APPTYPE_NAME" ;alb/sat 658 add IEN ;alb/sat 672 add APPTYPE "RTN","SDEC50",42,0) S @SDECY@(0)=SDTMP_$C(30) "RTN","SDEC50",43,0) ;validate Patient (required) "RTN","SDEC50",44,0) I '+DFN D ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY) Q "RTN","SDEC50",45,0) I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY) Q "RTN","SDEC50",46,0) ;validate begin date/time (required) "RTN","SDEC50",47,0) S:$G(SDBEG)="" SDBEG=$P($$NOW^XLFDT,".",1) "RTN","SDEC50",48,0) S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y "RTN","SDEC50",49,0) I Y=-1 D ERR1^SDECERR(-1,"Invalid Begin Time.",.SDECI,SDECY) Q "RTN","SDEC50",50,0) ;validate end date/time (required) "RTN","SDEC50",51,0) S:$G(SDEND)="" SDEND=1000000 "RTN","SDEC50",52,0) S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y "RTN","SDEC50",53,0) I Y=-1 D ERR1^SDECERR(-1,"Invalid End Time.",.SDECI,SDECY) Q "RTN","SDEC50",54,0) ;validate ancillary flag (optional) "RTN","SDEC50",55,0) S SDANC=$G(SDANC) "RTN","SDEC50",56,0) S:SDANC'=1 SDANC=0 "RTN","SDEC50",57,0) S SDT=SDBEG F S SDT=$O(^DPT(DFN,"S",SDT)) Q:SDT="" Q:SDT>SDEND D ;fix this with Q:$P(SDT,".",1)>SDEND "RTN","SDEC50",58,0) .S SDST=$$GET1^DIQ(2.98,SDT_","_DFN_",",100) ;current status "RTN","SDEC50",59,0) .;Q:SDST'="FUTURE" "RTN","SDEC50",60,0) .;Q:'("I"[$P(^DPT(DFN,"S",SDT,0),U,2)) ;removed 6/24/2015 "RTN","SDEC50",61,0) .S SDANCT="" "RTN","SDEC50",62,0) .S SDATA=$G(^DPT(DFN,"S",SDT,0)) "RTN","SDEC50",63,0) .S SDANCT=$$ANC^SDAM1 "RTN","SDEC50",64,0) .I +SDANC,SDANCT="" Q ;quit if not ancillary "RTN","SDEC50",65,0) .S SDCL=$$GET1^DIQ(2.98,SDT_","_DFN_",",.01,"I") ;clinic IEN "RTN","SDEC50",66,0) .S SDCLN=$$GET1^DIQ(2.98,SDT_","_DFN_",",.01) ;clinic name "RTN","SDEC50",67,0) .S SDDT=$$GET1^DIQ(2.98,SDT_","_DFN_",",.001) ;appt time "RTN","SDEC50",68,0) .S SDTYP=$$GET1^DIQ(2.98,SDT_","_DFN_",",9.5,"I") ;appt type id ;alb/sat 672 "RTN","SDEC50",69,0) .S SDTYPN=$$GET1^DIQ(2.98,SDT_","_DFN_",",9.5) ;appt type name ;alb/sat 672 "RTN","SDEC50",70,0) .S CONS=$$CONS(SDCL,DFN,SDT) "RTN","SDEC50",71,0) .;S IEN="" "RTN","SDEC50",72,0) .S IEN=$$GETIEN(DFN,SDCL,SDT) ;alb/sat 658 return 409.84 ien "RTN","SDEC50",73,0) .S SDECI=SDECI+1 S @SDECY@(SDECI)=DFN_U_SDCL_U_SDCLN_U_SDDT_U_SDST_U_SDANCT_U_CONS_U_IEN_U_SDTYP_U_SDTYPN_$C(30) ;alb/sat 672 add SDTYP,SDTYPN "RTN","SDEC50",74,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC50",75,0) Q "RTN","SDEC50",76,0) ; "RTN","SDEC50",77,0) GETIEN(DFN,SDCLN,SDDT) ;get SDEC APPOINTMENT id "RTN","SDEC50",78,0) N SDF,SDI,SDNOD,SDR "RTN","SDEC50",79,0) Q:$G(DFN)="" "" "RTN","SDEC50",80,0) Q:$G(SDCLN)="" "" "RTN","SDEC50",81,0) Q:$G(SDDT)="" "" "RTN","SDEC50",82,0) S (SDF,SDI)=0 F S SDI=$O(^SDEC(409.84,"CPAT",DFN,SDI)) Q:SDI="" D Q:SDF=1 "RTN","SDEC50",83,0) .S SDNOD=$G(^SDEC(409.84,SDI,0)) "RTN","SDEC50",84,0) .Q:SDNOD="" "RTN","SDEC50",85,0) .S SDR=$$GETRES^SDECUTL(SDCLN) "RTN","SDEC50",86,0) .I $P(SDNOD,U,1)=SDDT,$P(SDNOD,U,7)=SDR S SDF=1 "RTN","SDEC50",87,0) Q $S(SDI'="":SDI,1:"") "RTN","SDEC50",88,0) ; "RTN","SDEC50",89,0) CONS(SDCL,DFN,SDDT) ;check for consult in file 44 "RTN","SDEC50",90,0) ; SDCL = (required) clinic IEN "RTN","SDEC50",91,0) ; DFN = (required) patient IEN "RTN","SDEC50",92,0) ; SDDT = (required) appointment time in FM format "RTN","SDEC50",93,0) N CONS,CSTAT,SDI,SDJ "RTN","SDEC50",94,0) S CONS="" "RTN","SDEC50",95,0) S SDI=0 F S SDI=$O(^SC(SDCL,"S",SDDT,1,SDI)) Q:SDI'>0 D Q:CONS'="" "RTN","SDEC50",96,0) .I $P($G(^SC(SDCL,"S",SDDT,1,SDI,0)),U,1)=DFN D "RTN","SDEC50",97,0) ..S CONS=$G(^SC(SDCL,"S",SDDT,1,SDI,"CONS")) "RTN","SDEC50",98,0) ..I +CONS D "RTN","SDEC50",99,0) ...S CSTAT=$P($G(^GMR(123,CONS,0)),U,12) "RTN","SDEC50",100,0) ...S:(CSTAT=1!(CSTAT=2)!(CSTAT=13)) CONS="" "RTN","SDEC50",101,0) Q CONS "RTN","SDEC50",102,0) ; "RTN","SDEC50",103,0) PCSTGET(SDECY,DFN,SDCL,SDBEG,SDEND) ;GET patient clinic status for a clinic for a given time frame - has the patient been seen by the given Clinic in the past 24 months "RTN","SDEC50",104,0) ;PCSTGET(SDECY,DFN,SDCL,SDBEG,SDEND) external parameter tag is in SDEC "RTN","SDEC50",105,0) ;INPUT: "RTN","SDEC50",106,0) ; DFN = (required) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates) "RTN","SDEC50",107,0) ; SDCL = (required) Clinic code - Pointer to HOSPITAL LOCATION file "RTN","SDEC50",108,0) ; SDBEG = (optional) Begin date in external format; defaults to 730 days previous (24 months) "RTN","SDEC50",109,0) ; SDEND = (optional) End date in external format; defaults to today "RTN","SDEC50",110,0) ;RETURN: "RTN","SDEC50",111,0) ; Successful Return: "RTN","SDEC50",112,0) ; a single entry in the global array indicating that patient has or has "RTN","SDEC50",113,0) ; not been seen. "RTN","SDEC50",114,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",115,0) ; Caught Exception Return: "RTN","SDEC50",116,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",117,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",118,0) ; Unexpected Exception Return: "RTN","SDEC50",119,0) ; Handled by the RPC Broker. "RTN","SDEC50",120,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC50",121,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC50",122,0) ; text back to the client. "RTN","SDEC50",123,0) N SDASD,SDECI,SDS,STOP,SDYN,SDSCL "RTN","SDEC50",124,0) ;N SDSNOD,SDSD,SDSTP,SDT,SDVSP,SDWL,SDYN alb/jsm 658 commented out since variables not used here "RTN","SDEC50",125,0) N X,Y,%DT,APIEN "RTN","SDEC50",126,0) S SDECI=0 "RTN","SDEC50",127,0) S SDECY="^TMP(""SDEC50"","_$J_",""PCSTGET"")" "RTN","SDEC50",128,0) K @SDECY "RTN","SDEC50",129,0) ; data header "RTN","SDEC50",130,0) S @SDECY@(0)="T00020RETURNCODE^T00100TEXT"_$C(30) "RTN","SDEC50",131,0) ;check for valid Patient "RTN","SDEC50",132,0) I '+DFN D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",133,0) I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",134,0) ;check for valid Clinic "RTN","SDEC50",135,0) I '+SDCL D ERR1^SDECERR(-1,"Invalid Clinic ID.",SDECI,SDECY) Q "RTN","SDEC50",136,0) I '$D(^SC(SDCL,0)) D ERR1^SDECERR(-1,"Invalid Clinic ID.",SDECI,SDECY) Q "RTN","SDEC50",137,0) ;check times "RTN","SDEC50",138,0) I $G(SDBEG)'="" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG="" "RTN","SDEC50",139,0) S:$G(SDBEG)="" SDBEG=$P($$FMADD^XLFDT($$NOW^XLFDT,-730),".",1) "RTN","SDEC50",140,0) I $G(SDEND)'="" S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND="" ;alb/sat 665 - remove Q "RTN","SDEC50",141,0) S:$G(SDEND)="" SDEND=$P($$NOW^XLFDT,".",1) "RTN","SDEC50",142,0) S STOP=$$CLSTOP(SDCL) ;get stop code number alb/jsm 658 updated to use new CLSTOP call "RTN","SDEC50",143,0) I '+STOP D ERR1^SDECERR(-1,"Clinic "_$P($G(^SC(+$G(SDCL),0)),U,1)_" does not have a STOP CODE NUMBER defined.",SDECI,SDECY) Q "RTN","SDEC50",144,0) S SDYN="NO" "RTN","SDEC50",145,0) ;look in SD WAIT LIST file for SDSCN stop code "RTN","SDEC50",146,0) ; alb/jsm 658 removed this block of code "RTN","SDEC50",147,0) ;S SDWL="" F S SDWL=$O(^SDWL(409.3,"B",DFN,SDWL)) Q:SDWL="" D Q:SDYN="YES" "RTN","SDEC50",148,0) ;.S SDSD=$P($G(^SDWL(409.3,SDWL,0)),U,23) "RTN","SDEC50",149,0) ;.I (SDSD'SDEND) D "RTN","SDEC50",150,0) ;..S SDSTP=$P($G(^SDWL(409.3,SDWL,"SDAPT")),U,4) "RTN","SDEC50",151,0) ;..I SDSTP=SDSCN S SDYN="YES" "RTN","SDEC50",152,0) ;.Q:SDYN="YES" "RTN","SDEC50",153,0) ;look in PATIENT Appointments "RTN","SDEC50",154,0) ; alb/jsm 658 updated to look at stop codes and check-out time "RTN","SDEC50",155,0) ;I SDYN'="YES" D "RTN","SDEC50",156,0) ;.S SDS="" F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" "RTN","SDEC50",157,0) ;..S SDSD=$$GET1^DIQ(2.98,SDS_","_DFN_",",.001,"I") "RTN","SDEC50",158,0) ;..I (SDSD'SDEND) D "RTN","SDEC50",159,0) ;...I $P($G(^DPT(DFN,"S",SDS,0)),U,1)=SDCL D "RTN","SDEC50",160,0) ;....S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",161,0) ;....Q:APIEN="" "RTN","SDEC50",162,0) ;....S:$G(^SC(SDCL,"S",SDS,1,+APIEN,"C"))'="" SDYN="YES" "RTN","SDEC50",163,0) ;S (SDS,SDSCL)="" F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" "RTN","SDEC50",164,0) ;.S SDSCL=$P($G(^DPT(DFN,"S",SDS,0)),U,1) "RTN","SDEC50",165,0) ;.I $$CLSTOP(SDSCL)=SDSCN D "RTN","SDEC50",166,0) ;..S APIEN=$$FIND^SDAM2(DFN,SDS,SDSCL) "RTN","SDEC50",167,0) ;..Q:APIEN="" "RTN","SDEC50",168,0) ;..S SDSCO=$P($G(^SC(SDSCL,"S",SDS,1,+APIEN,"C")),U,3) "RTN","SDEC50",169,0) ;..S:(SDSCO'="")&(SDSCO'SDEND) SDYN="YES" "RTN","SDEC50",170,0) D CHKPT "RTN","SDEC50",171,0) ;look in HOSPITAL LOCATION "RTN","SDEC50",172,0) ; alb/jsm 658 removing this block of code since we already loop through patient appointments for evaluation "RTN","SDEC50",173,0) ;I SDYN'="YES" D "RTN","SDEC50",174,0) ;.S SDS=SDBEG F S SDS=$O(^SC(SDCL,"S",SDS)) Q:SDS'>0 Q:SDS>SDEND D Q:SDYN="YES" "RTN","SDEC50",175,0) ;..S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",176,0) ;..Q:APIEN="" "RTN","SDEC50",177,0) ;..S:$P($G(^SC(SDCL,"S",SDS,1,APIEN,"C")),U,1)'="" SDYN="YES" "RTN","SDEC50",178,0) S SDECI=SDECI+1 S @SDECY@(SDECI)="0^"_SDYN_$C(30,31) "RTN","SDEC50",179,0) Q "RTN","SDEC50",180,0) ; "RTN","SDEC50",181,0) CLSTOP(CLINIC) ;Return clinic stop code for clinic "RTN","SDEC50",182,0) Q:$G(CLINIC)="" 0 ;Verify clinic is passed in "RTN","SDEC50",183,0) Q $P($G(^SC(CLINIC,0)),U,7) ;Return the stop code for the clinic "RTN","SDEC50",184,0) ; "RTN","SDEC50",185,0) CHKPT ; alb/jsm 658 added to be used by PCSTGET and PCST2GET "RTN","SDEC50",186,0) N SDSCO "RTN","SDEC50",187,0) S SDS=0 F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" ;alb/sat 665 - start with SDS=0 instead of "" "RTN","SDEC50",188,0) .S SDSCL=$P($G(^DPT(DFN,"S",SDS,0)),U,1) "RTN","SDEC50",189,0) .I $$CLSTOP(SDSCL)=STOP D "RTN","SDEC50",190,0) ..S APIEN=$$FIND^SDAM2(DFN,SDS,SDSCL) "RTN","SDEC50",191,0) ..Q:APIEN="" "RTN","SDEC50",192,0) ..S SDSCO=$P($P($G(^SC(SDSCL,"S",SDS,1,+APIEN,"C")),U,3),".",1) "RTN","SDEC50",193,0) ..S:(SDSCO'="")&(SDSCO'SDEND) SDYN="YES" "RTN","SDEC50",194,0) Q "RTN","SDEC50",195,0) ; "RTN","SDEC50",196,0) PCST2GET(SDECY,DFN,STOP,SDBEG,SDEND) ;GET patient clinic status for a service/specialty (clinic stop) for a given time frame - has the patient been seen any clinics with the given service/specialty (clinic stop) in the past 24 months "RTN","SDEC50",197,0) ;PCST2GET(SDECY,DFN,STOP,SDBEG,SDEND) external parameter tag is in SDEC "RTN","SDEC50",198,0) ;INPUT: "RTN","SDEC50",199,0) ; DFN = (required) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates) "RTN","SDEC50",200,0) ; STOP = (required) CLINIC STOP or Service/Specialty name - NAME from the SD WL SERVICE/SPECIALTY file - looks for 1st active "RTN","SDEC50",201,0) ; OR - Pointer to the CLINIC STOP file "RTN","SDEC50",202,0) ; SDBEG = (optional) Begin date in external format; defaults to 730 days previous (24 months) "RTN","SDEC50",203,0) ; SDEND = (optional) End date in external format; defaults to today "RTN","SDEC50",204,0) ;RETURN: "RTN","SDEC50",205,0) ; Successful Return: "RTN","SDEC50",206,0) ; a single entry in the global array indicating that patient has or has "RTN","SDEC50",207,0) ; not been seen. "RTN","SDEC50",208,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",209,0) ; Caught Exception Return: "RTN","SDEC50",210,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",211,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",212,0) ; Unexpected Exception Return: "RTN","SDEC50",213,0) ; Handled by the RPC Broker. "RTN","SDEC50",214,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC50",215,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC50",216,0) ; text back to the client. "RTN","SDEC50",217,0) N SDASD,SDF,SDSCN,SDECI,SDSNOD,SDSD,SDSTP,SDT,SDVSP,SDWL,SDYN "RTN","SDEC50",218,0) N H,WLSRVSP,X,Y,%DT "RTN","SDEC50",219,0) S WLSRVSP="" "RTN","SDEC50",220,0) S (SDF,SDECI,SDSCN)=0 "RTN","SDEC50",221,0) S SDECY="^TMP(""SDEC50"","_$J_",""PCST2GET"")" "RTN","SDEC50",222,0) K @SDECY "RTN","SDEC50",223,0) ; data header "RTN","SDEC50",224,0) S @SDECY@(0)="T00020RETURNCODE^T00100TEXT"_$C(30) "RTN","SDEC50",225,0) ;check for valid Patient "RTN","SDEC50",226,0) I '+DFN D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",227,0) I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",228,0) ;check for valid Service/Specialty "RTN","SDEC50",229,0) S STOP=$G(STOP) "RTN","SDEC50",230,0) ;I +SDSVSP,$D(^SDWL(409.31,SDSVSP,0)) S SDSCN=$P($G(^SDWL(409.31,SDSVSP,0)),U,1) S SDF=1 "RTN","SDEC50",231,0) I +STOP,'$D(^DIC(40.7,STOP,0)) D ERR1^SDECERR(-1,"Invalid stop code.",SDECI,SDECY) Q "RTN","SDEC50",232,0) I +STOP S SDSCN=$$GET1^DIQ(40.7,STOP_",",.01) S SDF=1 "RTN","SDEC50",233,0) I 'SDF,'+STOP D "RTN","SDEC50",234,0) .S H="" F S H=$O(^DIC(40.7,"B",STOP,H)) Q:H="" D Q:+STOP "RTN","SDEC50",235,0) ..I $P(^DIC(40.7,H,0),U,3)'="",$P(^DIC(40.7,H,0),U,3)<$$NOW^XLFDT() Q "RTN","SDEC50",236,0) ..S STOP=H "RTN","SDEC50",237,0) I '+STOP D ERR1^SDECERR(-1,"Invalid Stop code.",SDECI,SDECY) Q "RTN","SDEC50",238,0) ;check times "RTN","SDEC50",239,0) I $G(SDBEG)'="" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG="" "RTN","SDEC50",240,0) S:$G(SDBEG)="" SDBEG=$P($$FMADD^XLFDT($$NOW^XLFDT,-730),".",1) "RTN","SDEC50",241,0) I $G(SDEND)'="" S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND="" Q "RTN","SDEC50",242,0) S:$G(SDEND)="" SDEND=$P($$NOW^XLFDT,".",1) "RTN","SDEC50",243,0) S SDYN="NO" "RTN","SDEC50",244,0) ;D LOOKWL alb/jsm 658 removed only concerned with patient appts that have a check-out date/time "RTN","SDEC50",245,0) ;I SDYN'="YES" S SDCL=0 F S SDCL=$O(^SC(SDCL)) Q:SDCL'>0 D Q:SDYN="YES" "RTN","SDEC50",246,0) ;.S SDCLN=$$CLSTOP(SDCL) ; alb/jsm 658 updated to use CLSTOP $P($G(^SC(SDCL,0)),U,7) "RTN","SDEC50",247,0) ;.D:SDCLN=STOP LOOK "RTN","SDEC50",248,0) D CHKPT "RTN","SDEC50",249,0) S SDECI=SDECI+1 S @SDECY@(SDECI)="0^"_SDYN_$C(30,31) "RTN","SDEC50",250,0) Q "RTN","SDEC50",251,0) ; "RTN","SDEC50",252,0) LOOK ; "RTN","SDEC50",253,0) ;look in PATIENT Appointments "RTN","SDEC50",254,0) I SDYN'="YES" D "RTN","SDEC50",255,0) .S SDS="" F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" "RTN","SDEC50",256,0) ..S SDSD=$$GET1^DIQ(2.98,SDS_","_DFN_",",.001,"I") "RTN","SDEC50",257,0) ..I (SDSD'SDEND) D "RTN","SDEC50",258,0) ...I $P($G(^DPT(DFN,"S",SDS,0)),U,1)=SDCL D "RTN","SDEC50",259,0) ....S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",260,0) ....I APIEN'="",$G(^SC(SDCL,"S",SDS,1,APIEN,"C"))'="" S SDYN="YES" "RTN","SDEC50",261,0) ;look in HOSPITAL LOCATION "RTN","SDEC50",262,0) I SDYN'="YES" D "RTN","SDEC50",263,0) .S SDS=SDBEG F S SDS=$O(^SC(SDCL,"S",SDS)) Q:SDS'>0 Q:SDS>SDEND D Q:SDYN="YES" "RTN","SDEC50",264,0) ..S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",265,0) ..Q:APIEN="" "RTN","SDEC50",266,0) ..S:$P($G(^SC(SDCL,"S",SDS,1,APIEN,"C")),U,1)'="" SDYN="YES" "RTN","SDEC50",267,0) Q "RTN","SDEC50",268,0) ; "RTN","SDEC50",269,0) LOOKWL ; "RTN","SDEC50",270,0) ;look in SD WAIT LIST file for STOP stop code "RTN","SDEC50",271,0) S SDWL="" F S SDWL=$O(^SDWL(409.3,"B",DFN,SDWL)) Q:SDWL="" D Q:SDYN="YES" "RTN","SDEC50",272,0) .S SDSD=$P($G(^SDWL(409.3,SDWL,0)),U,23) "RTN","SDEC50",273,0) .I (SDSD'SDEND) D "RTN","SDEC50",274,0) ..S SDSTP=$P($G(^SDWL(409.3,SDWL,"SDAPT")),U,4) "RTN","SDEC50",275,0) ..I SDSTP=STOP S SDYN="YES" "RTN","SDEC50",276,0) .Q:SDYN="YES" "RTN","SDEC50",277,0) Q "RTN","SDEC50",278,0) ; "RTN","SDEC50",279,0) PCSGET(SDECY,SDSVSP,SDCL) ;GET clinics for a service/specialty (clinic stop) ;alb/sat 658 add SDCL "RTN","SDEC50",280,0) ;PCSGET(SDECY,SDSVSP) external parameter tag is in SDEC "RTN","SDEC50",281,0) ;INPUT: "RTN","SDEC50",282,0) ; SDSVSP = (required) Service/Specialty name - NAME from the SD WL SERVICE/SPECIALTY file - looks for 1st active "RTN","SDEC50",283,0) ; OR - Pointer to the SD WL SERVICE/SPECIALTY file "RTN","SDEC50",284,0) ;RETURN: "RTN","SDEC50",285,0) ; Successful Return: "RTN","SDEC50",286,0) ; global array containing Clinic IEN and Name of matching Hospital Locations "RTN","SDEC50",287,0) ; CLINSTOP - pointer to CLINIC STOP file 40.7 "RTN","SDEC50",288,0) ; CLINIEN - pointer to the HOSPITAL LOCATION file 44 "RTN","SDEC50",289,0) ; CLINNAME - NAME from the HOSPITAL LOCATION file "RTN","SDEC50",290,0) ; Caught Exception Return: "RTN","SDEC50",291,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",292,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",293,0) ; Unexpected Exception Return: "RTN","SDEC50",294,0) ; Handled by the RPC Broker. "RTN","SDEC50",295,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC50",296,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC50",297,0) ; text back to the client. "RTN","SDEC50",298,0) N SDASD,SDSCN,SDECI,SDSNOD,SDSD,SDSTP,SDT,SDVSP,SDWL "RTN","SDEC50",299,0) N H,WLSRVSP,X,Y "RTN","SDEC50",300,0) S WLSRVSP="" "RTN","SDEC50",301,0) S (SDECI,SDSCN)=0 "RTN","SDEC50",302,0) S SDECY="^TMP(""SDEC50"","_$J_",""PCSGET"")" "RTN","SDEC50",303,0) K @SDECY "RTN","SDEC50",304,0) ; data header "RTN","SDEC50",305,0) S @SDECY@(0)="T00030CLINSTOP^T00030CLINIEN^T00030CLINNAME"_$C(30) "RTN","SDEC50",306,0) ;check clinic ;alb/sat 658 "RTN","SDEC50",307,0) S SDCL=$G(SDCL) "RTN","SDEC50",308,0) I SDCL'="",$D(^SC(SDCL,0)) D "RTN","SDEC50",309,0) .S SDSVSP=$$GET1^DIQ(44,SDCL_",",8,"I") "RTN","SDEC50",310,0) ;check for valid Service/Specialty "RTN","SDEC50",311,0) S SDSVSP=$G(SDSVSP) "RTN","SDEC50",312,0) I SDSVSP="" D ERR1^SDECERR(-1,"Service/Specialty ID required",SDECI,SDECY) Q "RTN","SDEC50",313,0) I +SDSVSP,$D(^SDWL(409.31,+SDSVSP,0)) S SDSCN=$P($G(^SDWL(409.31,SDSVSP,0)),U,1) "RTN","SDEC50",314,0) I '+SDSVSP D "RTN","SDEC50",315,0) .S H=0 F S H=$O(^DIC(40.7,"B",SDSVSP,H)) Q:H="" D Q:SDSCN'=0 "RTN","SDEC50",316,0) ..I $P(^DIC(40.7,H,0),U,3)'="",$P(^DIC(40.7,H,0),U,3)<$$NOW^XLFDT() Q "RTN","SDEC50",317,0) ..S SDSCN=H "RTN","SDEC50",318,0) I '+SDSCN D ERR1^SDECERR(-1,"Invalid Service/Specialty.",SDECI,SDECY) Q "RTN","SDEC50",319,0) S SDCL=0 F S SDCL=$O(^SC(SDCL)) Q:SDCL'>0 D "RTN","SDEC50",320,0) .S SDCLN=$P($G(^SC(SDCL,0)),U,7) "RTN","SDEC50",321,0) .I $$GET1^DIQ(44,SDCL_",",2505,)'="",$$GET1^DIQ(44,SDCL_",",2506)="" Q ;only active "RTN","SDEC50",322,0) .I SDCLN=SDSCN S SDECI=SDECI+1 S @SDECY@(SDECI)=SDSCN_U_SDCL_U_$P($G(^SC(SDCL,0)),U,1)_$C(30) "RTN","SDEC50",323,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC50",324,0) Q "RTN","SDEC54A") 0^4^B86091542^B83794184 "RTN","SDEC54A",1,0) SDEC54A ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 26, 2017 "RTN","SDEC54A",2,0) ;;5.3;Scheduling;**627,642,658,665,672**;Aug 13, 1993;Build 9 "RTN","SDEC54A",3,0) ; "RTN","SDEC54A",4,0) Q "RTN","SDEC54A",5,0) ; "RTN","SDEC54A",6,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","SDEC54A",7,0) ;SUMMAGET(SDECY,SDBEG,SDEND,USER) external parameter tag is in SDEC "RTN","SDEC54A",8,0) ;INPUT: "RTN","SDEC54A",9,0) ; SDBEG = (optional) Filter Begin Date in external form; default to all dates "RTN","SDEC54A",10,0) ; SDEND = (optional) Filter End Date in external form; default to all dates "RTN","SDEC54A",11,0) ; USER = (optional) pointer to new person file - used to filter by user "RTN","SDEC54A",12,0) ; LSUB = (optional) subscripts from previous call "RTN","SDEC54A",13,0) ; MAXREC = (optional) Max records to return "RTN","SDEC54A",14,0) ;RETURN: "RTN","SDEC54A",15,0) ; global array in which each array entry contains data from the SDEC APPOINTMENT file "RTN","SDEC54A",16,0) ; each entry contains the following ^ pieces: "RTN","SDEC54A",17,0) ; 1. APPT - Pointer to SDEC APPOINTMENT file "RTN","SDEC54A",18,0) ; 2. DATE - Appointment Start time in external format from STARTTIME field of SDEC APPOINTMENT file "RTN","SDEC54A",19,0) ; 3. IEN - patient pointer to PATIENT file "RTN","SDEC54A",20,0) ; 4. NAME - patient name from PATIENT file "RTN","SDEC54A",21,0) ; 5. CLINIEN - Clinic pointer to HOSPITAL LOCATION file "RTN","SDEC54A",22,0) ; 6. CLINNAME - Clinic name from HOSPITAL LOCATION file "RTN","SDEC54A",23,0) ; 7. DATE1 - Cancel Date/Time in external format from CANCEL DATETIME field "RTN","SDEC54A",24,0) ; 8. USERIEN - DATA ENTRY CLERK ien pointer to NEW PERSON file "RTN","SDEC54A",25,0) ; 9. USERNAME - DATA ENTRY CLERK name from NEW PERSON file "RTN","SDEC54A",26,0) ; 10. PROVIEN - Provider ien from PROVIDER field pointer to NEW PERSON file "RTN","SDEC54A",27,0) ; 11. PROVNAME - provider name of PROVIDER from NEW PERSON file "RTN","SDEC54A",28,0) ; 12. STATUS - text from STATUS field valid values are: "RTN","SDEC54A",29,0) ; CANCELLED BY CLINIC & AUTO RE-BOOK "RTN","SDEC54A",30,0) ; CANCELLED BY PATIENT "RTN","SDEC54A",31,0) ; CANCELLED BY PATIENT & AUTO-REBOOK "RTN","SDEC54A",32,0) ; 13. EESTAT - Patient Status N=NEW E=ESTABLISHED "RTN","SDEC54A",33,0) ; 14. LASTSUB - Last referenced subscripts used to pass into next call "RTN","SDEC54A",34,0) ; 15. NUMBER - This record is NUMBER ## of TOTAL "RTN","SDEC54A",35,0) ; 16. TOTAL - total number of records returned. Only the last record will contain this data piece "RTN","SDEC54A",36,0) ; This number will accumulate with multiple calls if LSUB is passed in. "RTN","SDEC54A",37,0) N DATE,DATE1,X,Y,%DT "RTN","SDEC54A",38,0) N SDECI,SDCLIN,SDI,SDJ,SDNOD,SDRES,SDSTAT,SDSUB,SDTMP,SDTOT "RTN","SDEC54A",39,0) S SDSUB="" "RTN","SDEC54A",40,0) S SDECY="^TMP(""SDEC54"","_$J_",""SUMMAGET"")" "RTN","SDEC54A",41,0) K @SDECY "RTN","SDEC54A",42,0) S SDECI=0 "RTN","SDEC54A",43,0) ; 1 2 3 4 5 6 "RTN","SDEC54A",44,0) S SDTMP="T00030APPT^T00030DATE^T00030IEN^T00030NAME^T00030CLINIEN^T00030CLINNAME" "RTN","SDEC54A",45,0) ; 7 8 9 10 11 "RTN","SDEC54A",46,0) S SDTMP=SDTMP_"^T00030DATE1^T00030USERIEN^T00030USERNAME^T00030PROVIEN^T00030PROVNAME" "RTN","SDEC54A",47,0) ; 12 13 14 15 16 "RTN","SDEC54A",48,0) S SDTMP=SDTMP_"^T00030STATUS^T00030EESTAT^T00030LASTSUB^T00030NUMBER^T00030TOTAL" "RTN","SDEC54A",49,0) S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDEC54A",50,0) ;check begin date (optional) "RTN","SDEC54A",51,0) I $G(SDBEG)'="" S %DT="" S X=$P($G(SDBEG),"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101 "RTN","SDEC54A",52,0) I $G(SDBEG)="" S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101 "RTN","SDEC54A",53,0) ;check end date (optional) "RTN","SDEC54A",54,0) I $G(SDEND)'="" S %DT="" S X=$P($G(SDEND),"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231 "RTN","SDEC54A",55,0) I $G(SDEND)="" S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231 "RTN","SDEC54A",56,0) ;check user "RTN","SDEC54A",57,0) S USER=$G(USER) "RTN","SDEC54A",58,0) I '$D(^VA(200,+USER,0)) S USER="" "RTN","SDEC54A",59,0) ;check LSUB | ... "RTN","SDEC54A",60,0) S LSUB=$G(LSUB) "RTN","SDEC54A",61,0) S SDTOT=+$P(LSUB,"|",1) "RTN","SDEC54A",62,0) ;check MAXREC "RTN","SDEC54A",63,0) S MAXREC=$G(MAXREC) S:'+MAXREC MAXREC=100 "RTN","SDEC54A",64,0) ; "RTN","SDEC54A",65,0) S SDJ=$S($P(LSUB,"|",2)'="":$P(LSUB,"|",2)-.0001,1:SDBEG) "RTN","SDEC54A",66,0) F S SDJ=$O(^SDEC(409.84,"AD",SDJ)) Q:SDJ'>0 Q:SDJ="" Q:$P(SDJ,".",1)>$P(SDEND,".",1) D I SDECI'0 D I SDECI'0 S SDTMP=$P(@SDECY@(SDECI),$C(30),1) S $P(SDTMP,U,16)=(SDTOT+SDECI) S:SDSUB'="" $P(SDTMP,U,14)=SDSUB S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDEC54A",95,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC54A",96,0) Q "RTN","SDEC54A",97,0) ; "RTN","SDEC54A",98,0) CKDT(DATE,BEG,END) ;check date range "RTN","SDEC54A",99,0) ;RETURN "RTN","SDEC54A",100,0) ; 0=out of range "RTN","SDEC54A",101,0) ; 1=in range "RTN","SDEC54A",102,0) N X,Y,%DT "RTN","SDEC54A",103,0) I $G(BEG)="",$G(END)="" Q 1 "RTN","SDEC54A",104,0) I $G(DATE)="" Q 1 "RTN","SDEC54A",105,0) S %DT="T" S X=$P(DATE,"@",1) D ^%DT S DATE=Y "RTN","SDEC54A",106,0) I DATE=-1 Q 0 "RTN","SDEC54A",107,0) Q:DATEEND 0 "RTN","SDEC54A",109,0) Q 1 "RTN","SDEC54A",110,0) ; "RTN","SDEC54A",111,0) APPO(APPO,SDBEG,SDEND,USER) ;get appointments for date range and user ;alb/sat 642 "RTN","SDEC54A",112,0) N SDCNT,SDI,SDJ,SDNOD,SDNOD2,SDTYP,SDTYPID "RTN","SDEC54A",113,0) K APPO "RTN","SDEC54A",114,0) S USER=$G(USER) "RTN","SDEC54A",115,0) S SDI=SDBEG-1 F S SDI=$O(^SDEC(409.84,"AC",SDI)) Q:SDI="" Q:SDI>SDEND D "RTN","SDEC54A",116,0) .S SDJ="" F S SDJ=$O(^SDEC(409.84,"AC",SDI,SDJ)) Q:SDJ="" D "RTN","SDEC54A",117,0) ..S SDNOD=$G(^SDEC(409.84,SDJ,0)) "RTN","SDEC54A",118,0) ..I +USER,$P(SDNOD,U,8)'=USER Q ;check user match "RTN","SDEC54A",119,0) ..Q:($P(SDNOD,U,12)'="")!($P(SDNOD,U,23)'="") ;don't include cancel or no-show "RTN","SDEC54A",120,0) ..S SDNOD2=$G(^SDEC(409.84,SDJ,2)) "RTN","SDEC54A",121,0) ..S SDTYPID=$P($P(SDNOD2,U,1),";",1) "RTN","SDEC54A",122,0) ..S SDTYP=$P($P(SDNOD2,U,1),";",2) S SDTYP=$S(SDTYP="SDEC(409.85,":"A",SDTYP="GMR(123,":"C",SDTYP="SDWL(409.3,":"E",SDTYP="SD(403.5,":"R",1:"") "RTN","SDEC54A",123,0) ..Q:SDTYP="" "RTN","SDEC54A",124,0) ..S (SDCNT,APPO(SDTYP,$P(SDNOD,U,9),$P(SDNOD,U,8)))=$G(APPO(SDTYP,$P(SDNOD,U,9),$P(SDNOD,U,8)))+1 "RTN","SDEC54A",125,0) ..S APPO(SDTYP,$P(SDNOD,U,9),$P(SDNOD,U,8),SDCNT)=SDTYPID "RTN","SDEC54A",126,0) Q "RTN","SDEC54A",127,0) ; "RTN","SDEC54A",128,0) APPTPC(SDEC54,SDECRET,SDTOT,SDBEG,SDEND,USER,MAXREC,LSUB,SDSUB) ;get APPT patient contacts ;alb/sat 642 "RTN","SDEC54A",129,0) N PARENT,SDARR,SDID,SDIEN,SDATA,SDECY,SDPC,SDT,SDTMP,SDU "RTN","SDEC54A",130,0) S SDEC54=$G(SDEC54,0) "RTN","SDEC54A",131,0) Q:$G(SDECRET)="" "RTN","SDEC54A",132,0) S SDTOT=$G(SDTOT,0) "RTN","SDEC54A",133,0) S SDBEG=$P($G(SDBEG),".",1) S:SDBEG="" SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101 "RTN","SDEC54A",134,0) S SDEND=$P($G(SDEND),".",1) S:SDEND="" SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231 "RTN","SDEC54A",135,0) S USER=$G(USER) "RTN","SDEC54A",136,0) S SDT=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3),1:$P(SDBEG,".",1)) "RTN","SDEC54A",137,0) F S SDT=$O(^SDEC(409.85,"AD",SDT)) Q:SDT="" Q:$P(SDT,".",1)>$P(SDEND,".",1) D I SDEC54'0 D I SDCNT'0)&('+SDMORE) $P(@SDECY@(SDECI),U,32)="" "RTN","SDEC56",113,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC56",114,0) Q "RTN","SDEC56",115,0) PART ;partial name lookup ;alb/sat 672 "RTN","SDEC56",116,0) Q:SDREF="" "RTN","SDEC56",117,0) F S SDECNAM=$O(^SC(SDREF,SDECNAM)) Q:SDECNAM'[PNAME D I SDCNT'0 D "RTN","SDEC56",186,0) .S SDNOD=$G(^SC(SDCL,"PR",SDI,0)) "RTN","SDEC56",187,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",188,0) Q SDRET "RTN","SDEC56",189,0) ; "RTN","SDEC56",190,0) GETSUB(TXT) ; "RTN","SDEC56",191,0) Q $$GETSUB^SDECU(TXT) ;alb/sat 665 "RTN","SDECWL") 0^2^B102048711^B99990256 "RTN","SDECWL",1,0) SDECWL ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 26, 2017 "RTN","SDECWL",2,0) ;;5.3;Scheduling;**627,642,665,672**;Aug 13, 1993;Build 9 "RTN","SDECWL",3,0) ; "RTN","SDECWL",4,0) Q "RTN","SDECWL",5,0) ; "RTN","SDECWL",6,0) ; entry points for Clinical Scheduling/Wait List related Remote Procedures "RTN","SDECWL",7,0) APPTGET(RET,WLIEN) ; EP for SDEC WLGET remote procedure "RTN","SDECWL",8,0) S RET="I00020ERRORID^T00256ERRORTEXT"_$C(30) "RTN","SDECWL",9,0) S RET="-1^Not yet implemented"_$C(30,31) "RTN","SDECWL",10,0) Q "RTN","SDECWL",11,0) ;------------------------------------------------ "RTN","SDECWL",12,0) DEL(RET,INP) ;not used "RTN","SDECWL",13,0) S RET="I00020ERRORID^T00256ERRORTEXT"_$C(30) "RTN","SDECWL",14,0) S RET="-1^Not yet implemented"_$C(30,31) "RTN","SDECWL",15,0) Q "RTN","SDECWL",16,0) ; "RTN","SDECWL",17,0) WLCLOSE(RET,INP) ;Waitlist Close "RTN","SDECWL",18,0) ; INP - Input parameters array "RTN","SDECWL",19,0) ; INP(1) - Waitlist ID - Pointer to SD WAIT LIST file "RTN","SDECWL",20,0) ; INP(2) - Disposition "RTN","SDECWL",21,0) ; INP(3) - User Id - Pointer to NEW PERSON file "RTN","SDECWL",22,0) ; INP(4) - Date Dispositioned in external form "RTN","SDECWL",23,0) N MI,WLDISP,WLDISPBY,WLDISPDT,WLFDA,WLIEN,WLMSG,WLRET "RTN","SDECWL",24,0) S RET="I00020ERRORID^T00256ERRORTEXT"_$C(30) "RTN","SDECWL",25,0) ;validate IEN "RTN","SDECWL",26,0) S WLIEN=$G(INP(1)) I WLIEN="" S RET=RET_"-1^Missing IEN"_$C(30,31) Q "RTN","SDECWL",27,0) ;validate DISPOSITION "RTN","SDECWL",28,0) S WLDISP=$G(INP(2)) "RTN","SDECWL",29,0) I (WLDISP'="D"),(WLDISP'="NC"),(WLDISP'="SA"),(WLDISP'="CC"),(WLDISP'="NN"),(WLDISP'="ER"),(WLDISP'="TR"),(WLDISP'="CL") D "RTN","SDECWL",30,0) .S:WLDISP="DEATH" WLDISP="D" "RTN","SDECWL",31,0) .S:WLDISP="REMOVED/NON-VA CARE" WLDISP="NC" "RTN","SDECWL",32,0) .S:WLDISP="REMOVED/SCHEDULED-ASSIGNED" WLDISP="SA" "RTN","SDECWL",33,0) .S:WLDISP="REMOVED/VA CONTRACT CARE" WLDISP="CC" "RTN","SDECWL",34,0) .S:WLDISP="REMOVED/NO LONGER NECESSARY" WLDISP="NN" "RTN","SDECWL",35,0) .S:WLDISP="ENTERED IN ERROR" WLDISP="ER" "RTN","SDECWL",36,0) .S:WLDISP="TRANSFERRED" WLDISP="TR" "RTN","SDECWL",37,0) .S:WLDISP="CHANGED CLINIC" WLDISP="CL" "RTN","SDECWL",38,0) I WLDISP="" S RET=RET_"-1^Missing value for DISPOSITION"_$C(30,31) Q "RTN","SDECWL",39,0) I (WLDISP'="D"),(WLDISP'="NC"),(WLDISP'="SA"),(WLDISP'="CC"),(WLDISP'="NN"),(WLDISP'="ER"),(WLDISP'="TR"),(WLDISP'="CL") D "RTN","SDECWL",40,0) .S RET=RET_"-1^Invalid value for DISPOSITION"_$C(30,31) Q "RTN","SDECWL",41,0) ;validate DISPOSITIONED BY "RTN","SDECWL",42,0) S WLDISPBY=$G(INP(3),DUZ) "RTN","SDECWL",43,0) I '+WLDISPBY S WLDISPBY=$O(^VA(200,"B",WLDISPBY,0)) "RTN","SDECWL",44,0) I '+WLDISPBY S RET=RET_"-1^Invalid 'DISPOSITIONED BY' user"_$C(30,31) Q "RTN","SDECWL",45,0) ;validate DATE DISPOSITIONED "RTN","SDECWL",46,0) S WLDISPDT=$G(INP(4),DT) I WLDISPDT'="" S %DT="" S X=WLDISPDT D ^%DT S WLDISPDT=Y "RTN","SDECWL",47,0) I Y=-1 S RET=RET_"-1^Invalid 'DATE DISPOSITIONED'"_$C(30,31) Q "RTN","SDECWL",48,0) S WLFDA=$NA(WLFDA($$FNUM,WLIEN_",")) "RTN","SDECWL",49,0) S @WLFDA@(19)=WLDISPDT "RTN","SDECWL",50,0) S @WLFDA@(20)=WLDISPBY "RTN","SDECWL",51,0) S @WLFDA@(21)=WLDISP "RTN","SDECWL",52,0) S @WLFDA@(23)="C" "RTN","SDECWL",53,0) D UPDATE^DIE("","WLFDA","WLRET","WLMSG") "RTN","SDECWL",54,0) I $D(WLMSG("DIERR")) D "RTN","SDECWL",55,0) . F MI=1:1:$G(WLMSG("DIERR")) S RET=RET_"-1^"_$G(WLMSG("DIERR",MI,"TEXT",1))_$C(30) "RTN","SDECWL",56,0) S RET=RET_$C(31) "RTN","SDECWL",57,0) Q "RTN","SDECWL",58,0) ; "RTN","SDECWL",59,0) WLOPEN(RET,WLAPP,WLIEN,WLDDT) ;SET Waitlist Open/re-open "RTN","SDECWL",60,0) ;WLOPEN(RET,WLAPP,WLIEN,WLDDT) external parameter tag in SDEC "RTN","SDECWL",61,0) ;INPUT: "RTN","SDECWL",62,0) ; WLAPP - (required if no WLIEN) Appointment ID pointer to "RTN","SDECWL",63,0) ; SDEC APPOINTMENT file 409.84 "RTN","SDECWL",64,0) ; WLIEN - (required if no WLAPP) Waitlist ID - Pointer to "RTN","SDECWL",65,0) ; SD WAIT LIST file "RTN","SDECWL",66,0) ; WLDDT - (optional) Desired Date of appointment in external format "RTN","SDECWL",67,0) N SDART,SDECI,SDQ,WLFDA,WLMSG,X,Y,%DT "RTN","SDECWL",68,0) S RET="^TMP(""SDECWL"","_$J_",""WLOPEN"")" "RTN","SDECWL",69,0) K @RET "RTN","SDECWL",70,0) S (SDECI,SDQ)=0 "RTN","SDECWL",71,0) S @RET@(SDECI)="T00030ERRORID^T00030ERRTEXT"_$C(30) "RTN","SDECWL",72,0) ;validate WLAPP (required if WLIEN not passed it) "RTN","SDECWL",73,0) S WLAPP=$G(WLAPP) "RTN","SDECWL",74,0) I WLAPP'="" I $D(^SDEC(409.84,WLAPP,0)) D "RTN","SDECWL",75,0) .S SDART=$$GET1^DIQ(409.84,WLAPP_",",.22,"I") "RTN","SDECWL",76,0) .I $P(SDART,";",2)'="SDWL(409.3," S SDECI=SDECI+1 S @RET@(SDECI)="-1^Not an EWL appointment."_$C(30),SDQ=1 Q "RTN","SDECWL",77,0) .I $G(WLIEN)'="",WLIEN'=$P(SDART,";",1) S SDECI=SDECI+1 S @RET@(SDECI)="-1^Appointment EWL does not match passed in EWL."_$C(30),SDQ=1 Q "RTN","SDECWL",78,0) .S WLIEN=$P(SDART,";",1) "RTN","SDECWL",79,0) G:SDQ WLX "RTN","SDECWL",80,0) ;validate WLIEN "RTN","SDECWL",81,0) S WLIEN=$G(WLIEN) "RTN","SDECWL",82,0) I WLIEN="" S SDECI=SDECI+1 S @RET@(SDECI)="-1^Wait List ID or Appointment ID is required."_$C(30,31) Q "RTN","SDECWL",83,0) I '$D(^SDWL(409.3,WLIEN,0)) S SDECI=SDECI+1 S @RET@(SDECI)="-1^Invalid wait list ID."_$C(30,31) Q "RTN","SDECWL",84,0) ;validate WLDDT "RTN","SDECWL",85,0) S WLDDT=$P($G(WLDDT),"@",1) "RTN","SDECWL",86,0) I $G(WLDDT)'="" S %DT="" S X=WLDDT D ^%DT I Y=-1 S SDECI=SDECI+1 S @RET@(SDECI)="-1^Invalid desired date of appointment."_$C(30,31) Q "RTN","SDECWL",87,0) ; "RTN","SDECWL",88,0) S WLFDA=$NA(WLFDA(409.3,WLIEN_",")) "RTN","SDECWL",89,0) S @WLFDA@(19)="" "RTN","SDECWL",90,0) S @WLFDA@(20)="" "RTN","SDECWL",91,0) S @WLFDA@(21)="" "RTN","SDECWL",92,0) S:WLDDT'="" @WLFDA@(22)=WLDDT "RTN","SDECWL",93,0) S @WLFDA@(23)="OPEN" "RTN","SDECWL",94,0) D UPDATE^DIE("E","WLFDA","WLRET","WLMSG") "RTN","SDECWL",95,0) I $D(WLMSG("DIERR")) D "RTN","SDECWL",96,0) . F MI=1:1:$G(WLMSG("DIERR")) S SDECI=SDECI+1 S @RET@(SDECI)="-1^"_$G(WLMSG("DIERR",MI,"TEXT",1))_$C(30) "RTN","SDECWL",97,0) I '$D(WLMSG("DIERR")) S SDECI=SDECI+1 S @RET@(SDECI)="0^"_WLIEN_$C(30) "RTN","SDECWL",98,0) WLX S @RET@(SDECI)=@RET@(SDECI)_$C(31) "RTN","SDECWL",99,0) Q "RTN","SDECWL",100,0) ; "RTN","SDECWL",101,0) FNUM(RET) ;file number "RTN","SDECWL",102,0) S RET=409.3 "RTN","SDECWL",103,0) Q RET "RTN","SDECWL",104,0) ; "RTN","SDECWL",105,0) CLINALL(RET,MAXREC,SDECP) ;Return the IEN and NAME for all entries in the SD WL CLINIC LOCATION file "RTN","SDECWL",106,0) ;CLINALL(RET) external parameter tag is in SDEC "RTN","SDECWL",107,0) N CLINARR,CLINIEN,CLINNAME,COUNT,GLOREF,INACTIVE,LOCIEN,X "RTN","SDECWL",108,0) N CLINABR,SDCNT,SDECIEN,SDECNAM,SDF,SDMAX,SDTMP ;alb/sat 665 "RTN","SDECWL",109,0) N SDARR1,SDREF,SDXT ;alb/sat 672 "RTN","SDECWL",110,0) S SDF="" "RTN","SDECWL",111,0) S (SDCNT,SDMAX)=0 ;alb/sat 665 "RTN","SDECWL",112,0) S RET="^TMP(""SDEC"","_$J_")" "RTN","SDECWL",113,0) K @RET "RTN","SDECWL",114,0) S @RET@(0)="T00020CLINIC_IEN^T00030CLINIC_NAME^T00020HOSPITAL_LOCATION_ID^T00030ABBR^T00030MORE"_$C(30) "RTN","SDECWL",115,0) S MAXREC=$G(MAXREC,50) "RTN","SDECWL",116,0) S SDECP=$G(SDECP) "RTN","SDECWL",117,0) ;Search for entries using partial name "RTN","SDECWL",118,0) I SDECP'="" D "RTN","SDECWL",119,0) .;alb/sat 672 - begin modification; separate string and numeric lookup "RTN","SDECWL",120,0) .S (SDECNAM,SDXT)=$$GETSUB^SDECU(SDECP) "RTN","SDECWL",121,0) .;abbreviation as string "RTN","SDECWL",122,0) .S SDF="ABBRSTR" D "RTN","SDECWL",123,0) ..S SDREF="C" D PART Q "RTN","SDECWL",124,0) .;abbreviation as numeric "RTN","SDECWL",125,0) .S SDF="ABBRNUM",SDECNAM=SDXT_" " D "RTN","SDECWL",126,0) ..S SDREF="C" D PART Q "RTN","SDECWL",127,0) .;name as string "RTN","SDECWL",128,0) .S SDF="FULLSTR",SDECNAM=SDXT D "RTN","SDECWL",129,0) ..S SDREF="B" D PART Q "RTN","SDECWL",130,0) .;name as numeric "RTN","SDECWL",131,0) .S SDF="FULLNUM",SDECNAM=SDXT_" " D "RTN","SDECWL",132,0) ..S SDREF="B" D PART Q "RTN","SDECWL",133,0) .;alb/sat 672 - end modification; separate string and numeric lookup "RTN","SDECWL",134,0) ;Search for all SD WL CLINIC LOCATION entries "RTN","SDECWL",135,0) I SDECP="" S CLINIEN=0 F S CLINIEN=$O(^SDWL(409.32,CLINIEN)) Q:'CLINIEN D PROCESS I SDCNT'$P($$NOW^XLFDT,".",1)) Q "RTN","SDECWL",154,0) S LOCIEN=$P(^SDWL(409.32,CLINIEN,0),U) "RTN","SDECWL",155,0) S CLINNAME=$P($G(^SC(LOCIEN,0)),U) "RTN","SDECWL",156,0) S CLINABR=$P($G(^SC(LOCIEN,0)),U,2) "RTN","SDECWL",157,0) S:SDF["ABBR" CLINNAME=CLINABR_" "_CLINNAME "RTN","SDECWL",158,0) Q:$$GET1^DIQ(44,LOCIEN_",",50.01,"I")=1 ;OOS? "RTN","SDECWL",159,0) Q:$D(SDARR1(CLINIEN)) ;alb/sat 672 - checking for duplicates "RTN","SDECWL",160,0) S SDARR1(CLINIEN)="" ;alb/sat 672 - checking for duplicates "RTN","SDECWL",161,0) I CLINNAME'="" S CLINARR(SDF["FULL",CLINNAME)=CLINIEN_U_LOCIEN_U_CLINABR,SDCNT=SDCNT+1 "RTN","SDECWL",162,0) Q "RTN","SDECWL",163,0) ; "RTN","SDECWL",164,0) SVSPALL(RET) ;return IEN and NAME for all entries in the SD WL SERVICE/SPECIALTY file "RTN","SDECWL",165,0) ;SVSPALL(RET) external parameter tag is in SDEC "RTN","SDECWL",166,0) N COUNT,GLOREF,CLSTPIEN,SVSPARR,SVSPIEN,SVSPNAME,X "RTN","SDECWL",167,0) S RET="^TMP(""SDEC"","_$J_")" "RTN","SDECWL",168,0) K @RET "RTN","SDECWL",169,0) S @RET@(0)="T00020SERVICESPECIALTY_IEN^T00030SERVICESPECIALTY_NAME"_$C(30) "RTN","SDECWL",170,0) S GLOREF=$NA(^SDWL(409.31)) "RTN","SDECWL",171,0) ; Search for all SD WL SERVICE/SPECIALTY entries "RTN","SDECWL",172,0) ; Lookup the CLINIC STOP name "RTN","SDECWL",173,0) ; Save the names in a local array so the return array will be sorted by Name "RTN","SDECWL",174,0) S SVSPIEN=0 "RTN","SDECWL",175,0) F S SVSPIEN=$O(@GLOREF@(SVSPIEN)) Q:'SVSPIEN D "RTN","SDECWL",176,0) . S CLSTPIEN=$P(@GLOREF@(SVSPIEN,0),U) "RTN","SDECWL",177,0) . S SVSPNAME=$P($G(^DIC(40.7,CLSTPIEN,0)),U) "RTN","SDECWL",178,0) . I SVSPNAME'="" S SVSPARR(SVSPNAME)=SVSPIEN "RTN","SDECWL",179,0) S SVSPNAME="",COUNT=0 "RTN","SDECWL",180,0) F S SVSPNAME=$O(SVSPARR(SVSPNAME)) Q:SVSPNAME="" D "RTN","SDECWL",181,0) . S COUNT=COUNT+1,@RET@(COUNT)=SVSPARR(SVSPNAME)_U_SVSPNAME_$C(30) "RTN","SDECWL",182,0) ;S COUNT=COUNT+1,@RET@(COUNT)=$C(31) "RTN","SDECWL",183,0) S @RET@(COUNT)=@RET@(COUNT)_$C(31) "RTN","SDECWL",184,0) Q "RTN","SDECWL",185,0) ; "RTN","SDECWL",186,0) APPTYPES(RET,DFN) ; EP for SDEC APPTYPES "RTN","SDECWL",187,0) ;APPTYPES(RET,DFN) external parameter tag is in SDEC "RTN","SDECWL",188,0) ; Return the different appointment types "RTN","SDECWL",189,0) N APTYDATA,APTYIEN,APTYINAC,APTYNAME,COUNT,GLOREF "RTN","SDECWL",190,0) N ISVET,PTYPE,SDEC,SDI "RTN","SDECWL",191,0) S PTYPE="" "RTN","SDECWL",192,0) S ISVET=1 ;0=not a vet; 1=is a vet "RTN","SDECWL",193,0) S RET=$NA(^TMP("SDEC",$J)),COUNT=0 "RTN","SDECWL",194,0) K @RET "RTN","SDECWL",195,0) S @RET@(0)="T00020APPTTYPE_IEN^T00030APPTTYPE_NAME"_$C(30) "RTN","SDECWL",196,0) S DFN=$G(DFN) I DFN'="" S:'$D(^DPT(+DFN,0)) DFN="" "RTN","SDECWL",197,0) S GLOREF=$NA(^SD(409.1)) "RTN","SDECWL",198,0) I '+DFN D "RTN","SDECWL",199,0) .S APTYNAME="" F S APTYNAME=$O(@GLOREF@("B",APTYNAME)) Q:APTYNAME="" D "RTN","SDECWL",200,0) ..S APTYIEN=0 F S APTYIEN=$O(@GLOREF@("B",APTYNAME,APTYIEN)) Q:'APTYIEN D "RTN","SDECWL",201,0) ...S APTYDATA=$G(@GLOREF@(APTYIEN,0)) "RTN","SDECWL",202,0) ...Q:$P(APTYDATA,U,3) "RTN","SDECWL",203,0) ...S COUNT=COUNT+1,@RET@(COUNT)=APTYIEN_U_APTYNAME_$C(30) "RTN","SDECWL",204,0) ; "RTN","SDECWL",205,0) I +DFN D "RTN","SDECWL",206,0) .N VAEL D ELIG^VADPT "RTN","SDECWL",207,0) .S SDEC=$S($D(^DIC(8,+VAEL(1),0)):$P(^(0),U,5),1:"") "RTN","SDECWL",208,0) .S APTYNAME="" F S APTYNAME=$O(@GLOREF@("B",APTYNAME)) Q:APTYNAME="" D "RTN","SDECWL",209,0) ..S APTYIEN=0 F S APTYIEN=$O(@GLOREF@("B",APTYNAME,APTYIEN)) Q:'APTYIEN D "RTN","SDECWL",210,0) ...S APTYDATA=$G(@GLOREF@(APTYIEN,0)) "RTN","SDECWL",211,0) ...Q:$P(APTYDATA,U,3) "RTN","SDECWL",212,0) ...I $S(SDEC["Y":1,1:$P(APTYDATA,U,5)),$S('$P(APTYDATA,U,6):1,$D(VAEL(1,+$P(APTYDATA,U,6))):1,+VAEL(1)=$P(APTYDATA,U,6):1,1:0) D "RTN","SDECWL",213,0) ....S COUNT=COUNT+1,@RET@(COUNT)=APTYIEN_U_APTYNAME_$C(30) "RTN","SDECWL",214,0) ; "RTN","SDECWL",215,0) S @RET@(COUNT)=@RET@(COUNT)_$C(31) "RTN","SDECWL",216,0) Q "RTN","SDECWL",217,0) ; "RTN","SDECWL",218,0) WLPCSET(SDECY,INP,WLIEN) ;SET update patient contacts in SD WAIT LIST file "RTN","SDECWL",219,0) ;WLSETPC(SDECY,INP,WLIEN) external parameter tag in SDEC "RTN","SDECWL",220,0) ; INP = Patient Contacts separated by :: "RTN","SDECWL",221,0) ; Each :: piece has the following ~~ pieces: (same as they are passed into SDEC WLSET) "RTN","SDECWL",222,0) ; 1) = (required) DATE ENTERED external date/time "RTN","SDECWL",223,0) ; 2) = (optional) PC ENTERED BY USER ID or NAME - Pointer to NEW PERSON file or NAME "RTN","SDECWL",224,0) ; 4) = (optional) ACTION - valid values are: "RTN","SDECWL",225,0) ; CALLED "RTN","SDECWL",226,0) ; MESSAGE LEFT "RTN","SDECWL",227,0) ; LETTER "RTN","SDECWL",228,0) ; 5) = (optional) PATIENT PHONE Free-Text 4-20 characters "RTN","SDECWL",229,0) ; 6) = NOT USED (optional) Comment 1-160 characters "RTN","SDECWL",230,0) ; WLIEN = (required) Wait List Id pointer to SDEC WAIT LIST file 409.3 "RTN","SDECWL",231,0) N SDECI,SDTMP,WLMSG1 "RTN","SDECWL",232,0) S SDECY="^TMP(""SDECWL"","_$J_",""WLSETPC"")" "RTN","SDECWL",233,0) K @SDECY "RTN","SDECWL",234,0) S SDECI=0 "RTN","SDECWL",235,0) S @SDECY@(SDECI)="T00030RETURNCODE^T00030TEXT"_$C(30) "RTN","SDECWL",236,0) S WLIEN=$G(WLIEN) "RTN","SDECWL",237,0) I (WLIEN="")!('$D(^SDWL(409.3,WLIEN,0))) D ERR1^SDECERR(-1,"Invalid wait list ID "_WLIEN_".",SDECI,SDECY) Q "RTN","SDECWL",238,0) D WL23^SDECWL2(INP,WLIEN) "RTN","SDECWL",239,0) I $D(WLMSG1) D ERR1^SDECERR(-1,"Error storing patient contacts.",SDECI,SDECY) Q "RTN","SDECWL",240,0) S SDECI=SDECI+1 S @SDECY@(SDECI)="0^SUCCESS"_$C(30,31) "RTN","SDECWL",241,0) Q "RTN","SDECWL",242,0) ; "RTN","SDECWL",243,0) AUDITGET(SDECY,WLIEN) ;GET entries from VS AUDIT field of SD WAIT LIST file 409.3 "RTN","SDECWL",244,0) N WLDATA,SDECI,SDI,SDTMP,SDX "RTN","SDECWL",245,0) S SDECY="^TMP(""SDECWL"","_$J_",""AUDITGET"")" "RTN","SDECWL",246,0) K @SDECY "RTN","SDECWL",247,0) S SDECI=0 "RTN","SDECWL",248,0) S SDTMP="T00030IEN^T00030ID^T00030DATE^T00030USERIEN^T00030USERNAME" "RTN","SDECWL",249,0) S SDTMP=SDTMP_"^T00030WLCINIEN^T00030WLCINNAME^T00030CLINIEN^T00030CLINNAME" "RTN","SDECWL",250,0) S SDTMP=SDTMP_"^T00030STOPIEN^T00030STOPNAME" "RTN","SDECWL",251,0) S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDECWL",252,0) ;validate WLIEN "RTN","SDECWL",253,0) S WLIEN=$G(WLIEN) "RTN","SDECWL",254,0) I '+$D(^SDWL(409.3,+WLIEN,0)) S @SDECY@(1)="-1^Invalid SD WAIT LIST id."_$C(30,31) Q "RTN","SDECWL",255,0) S SDI=0 F S SDI=$O(^SDWL(409.3,+WLIEN,6,SDI)) Q:SDI'>0 D "RTN","SDECWL",256,0) .K WLDATA "RTN","SDECWL",257,0) .D GETS^DIQ(409.345,SDI_","_WLIEN_",","**","IE","WLDATA") "RTN","SDECWL",258,0) .S SDX="WLDATA(409.345,"""_SDI_","_WLIEN_","")" "RTN","SDECWL",259,0) .S SDTMP=WLIEN_U_SDI_U_@SDX@(.01,"E")_U_@SDX@(1,"I")_U_@SDX@(1,"E") "RTN","SDECWL",260,0) .S SDTMP=SDTMP_U_@SDX@(2,"I")_U_@SDX@(2,"E")_U_@SDX@(3,"I")_U_@SDX@(3,"E") "RTN","SDECWL",261,0) .S SDTMP=SDTMP_U_@SDX@(4,"I")_U_@SDX@(4,"E") "RTN","SDECWL",262,0) .S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDECWL",263,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDECWL",264,0) Q "RTN","SDRRREP") 0^1^B11839336^B9249872 "RTN","SDRRREP",1,0) SDRRREP ;ALB/SAT - RECALL REMINDERS REPORTS ;JUL 26, 2017 "RTN","SDRRREP",2,0) ;;5.3;Scheduling;**643,672**;Aug 13, 1993;Build 9 "RTN","SDRRREP",3,0) ; "RTN","SDRRREP",4,0) LETTER ;REPORT - RECALL REMINDERS where associated Clinic does not have a Recall Letter defined "RTN","SDRRREP",5,0) N SDRRDESC,SDRRRTN,SDTMP "RTN","SDRRREP",6,0) N %ZIS,IO,IOP,IOSL,IOST,POP,ZTDESC,ZTQUEUED,ZTREQ,ZTRTN,ZTSK "RTN","SDRRREP",7,0) D INIT "RTN","SDRRREP",8,0) ; "RTN","SDRRREP",9,0) K %ZIS,IOP S %ZIS="MQ" W ! D ^%ZIS I POP D EXIT Q "RTN","SDRRREP",10,0) ; "RTN","SDRRREP",11,0) I $D(IO("Q")) D Q "RTN","SDRRREP",12,0) . S ZTDESC=SDRRDESC "RTN","SDRRREP",13,0) . S ZTRTN="PROCESS^SDRRREP" "RTN","SDRRREP",14,0) . D TASK "RTN","SDRRREP",15,0) ; "RTN","SDRRREP",16,0) D PROCESS "RTN","SDRRREP",17,0) Q "RTN","SDRRREP",18,0) ; "RTN","SDRRREP",19,0) INIT ; "RTN","SDRRREP",20,0) S SDRRRTN="SDRRREP" "RTN","SDRRREP",21,0) S SDRRDESC="Recall Letter Report" "RTN","SDRRREP",22,0) S SDTMP=$NA(^TMP(SDRRRTN,$J)) "RTN","SDRRREP",23,0) K @SDTMP "RTN","SDRRREP",24,0) Q "RTN","SDRRREP",25,0) ; "RTN","SDRRREP",26,0) PROCESS ; "RTN","SDRRREP",27,0) N SDDTIM,SDQUIT,SDRPAGE,SDTIME,SDTODAY,SDUNDL "RTN","SDRRREP",28,0) D SETUP,SORT,RPT "RTN","SDRRREP",29,0) I '$D(@SDTMP) W !!?26,"* * * NO DATA TO PRINT * * *",!! "RTN","SDRRREP",30,0) D EXIT "RTN","SDRRREP",31,0) Q "RTN","SDRRREP",32,0) ; "RTN","SDRRREP",33,0) SETUP ; "RTN","SDRRREP",34,0) S (SDQUIT,SDRPAGE)=0 "RTN","SDRRREP",35,0) S SDDTIM=$$HTE^XLFDT($H,1) "RTN","SDRRREP",36,0) S SDTIME=$P(SDDTIM,"@",2) "RTN","SDRRREP",37,0) S SDTODAY=$P(SDDTIM,"@")_" "_$E(SDTIME,1,5) "RTN","SDRRREP",38,0) S $P(SDUNDL,"-",78)="-" "RTN","SDRRREP",39,0) Q "RTN","SDRRREP",40,0) ; "RTN","SDRRREP",41,0) SORT ; get recall entries associated to clinics with no recall letter "RTN","SDRRREP",42,0) N DFN,SDC,SDCL,SDATE,SDCLN,SDI,SDNAM,SSN "RTN","SDRRREP",43,0) S SDC=0 "RTN","SDRRREP",44,0) S SDCL=0 F S SDCL=$O(^SD(403.5,"E",SDCL)) Q:SDCL="" D "RTN","SDRRREP",45,0) .Q:$O(^SD(403.52,"B",SDCL,0)) "RTN","SDRRREP",46,0) .S SDCLN=$$GET1^DIQ(44,SDCL_",",.01) "RTN","SDRRREP",47,0) .Q:SDCLN="" ;alb/sat 672 - skip if clinic name not defined "RTN","SDRRREP",48,0) .S SDI=0 F S SDI=$O(^SD(403.5,"E",SDCL,SDI)) Q:SDI="" D "RTN","SDRRREP",49,0) ..S DFN=$$GET1^DIQ(403.5,SDI_",",.01,"I") "RTN","SDRRREP",50,0) ..Q:(DFN="")!('$D(^DPT(+DFN,0))) ;alb/sat 672 - skip if patient not defined "RTN","SDRRREP",51,0) ..S SDNAM=$$GET1^DIQ(2,DFN_",",.01) S:SDNAM="" SDNAM="No Name" ;alb/sat 672 - make sure a value is in SDNAM "RTN","SDRRREP",52,0) ..S SDATE=$$GET1^DIQ(403.5,SDI_",",5) "RTN","SDRRREP",53,0) ..S:SDATE="" SDATE=0 ;alb/sat 672 - make sure a value is in SDATE "RTN","SDRRREP",54,0) ..S SSN=$E($P(^DPT(DFN,0),"^",9),6,9) S:SSN="" SSN=0 "RTN","SDRRREP",55,0) ..S SDC=SDC+1 S @SDTMP@(SDCLN,SDATE,SDNAM,SSN,SDC)="" ;alb/sat 672 - use SDNAM "RTN","SDRRREP",56,0) Q "RTN","SDRRREP",57,0) ; "RTN","SDRRREP",58,0) RPT ; Print the report "RTN","SDRRREP",59,0) N SDATE,SDC,SDCLN,SDNAME,SDSSN "RTN","SDRRREP",60,0) U IO "RTN","SDRRREP",61,0) ; "RTN","SDRRREP",62,0) D HEADER "RTN","SDRRREP",63,0) ; Loop through the Sorted data. "RTN","SDRRREP",64,0) S SDCLN="" F S SDCLN=$O(@SDTMP@(SDCLN)) Q:SDCLN="" D Q:SDQUIT "RTN","SDRRREP",65,0) .S SDATE="" F S SDATE=$O(@SDTMP@(SDCLN,SDATE)) Q:SDATE="" D Q:SDQUIT "RTN","SDRRREP",66,0) ..S SDNAME="" F S SDNAME=$O(@SDTMP@(SDCLN,SDATE,SDNAME)) Q:SDNAME="" D Q:SDQUIT "RTN","SDRRREP",67,0) ...S SDSSN="" F S SDSSN=$O(@SDTMP@(SDCLN,SDATE,SDNAME,SDSSN)) Q:SDSSN="" D Q:SDQUIT "RTN","SDRRREP",68,0) ....S SDC="" F S SDC=$O(@SDTMP@(SDCLN,SDATE,SDNAME,SDSSN,SDC)) Q:SDC="" D Q:SDQUIT "RTN","SDRRREP",69,0) .....I $Y>(IOSL-6) D HEADER Q:SDQUIT "RTN","SDRRREP",70,0) .....W !,SDCLN,?30,SDATE,?43,SDNAME,?74,$S(SDSSN=0:"",1:SDSSN) "RTN","SDRRREP",71,0) Q "RTN","SDRRREP",72,0) ; "RTN","SDRRREP",73,0) HEADER ; "RTN","SDRRREP",74,0) N DIR,Y "RTN","SDRRREP",75,0) S SDRPAGE=SDRPAGE+1 "RTN","SDRRREP",76,0) I SDRPAGE>1 D Q:SDQUIT "RTN","SDRRREP",77,0) . W $C(7) "RTN","SDRRREP",78,0) . I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S SDQUIT=$S(Y'>0:1,1:0) "RTN","SDRRREP",79,0) ; "RTN","SDRRREP",80,0) W:$E(IOST)="C"!(SDRPAGE>1) @IOF "RTN","SDRRREP",81,0) W !,SDRRDESC,?48,SDTODAY,?70,"PAGE ",SDRPAGE "RTN","SDRRREP",82,0) W !,"Clinic",?30,"Recall Date",?43,"Patient Name",?75,"SSN" "RTN","SDRRREP",83,0) W !,SDUNDL "RTN","SDRRREP",84,0) ; "RTN","SDRRREP",85,0) Q "RTN","SDRRREP",86,0) ; "RTN","SDRRREP",87,0) EXIT ; "RTN","SDRRREP",88,0) W ! D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" "RTN","SDRRREP",89,0) K @SDTMP "RTN","SDRRREP",90,0) Q "RTN","SDRRREP",91,0) ; "RTN","SDRRREP",92,0) TASK ;set variables for call to ^%ZTLOAD "RTN","SDRRREP",93,0) D ^%ZTLOAD "RTN","SDRRREP",94,0) I $G(ZTSK) W !,"Task Number: ",ZTSK "RTN","SDRRREP",95,0) Q "VER") 8.0^22.2 "BLD",10319,6) ^560 **END** **END**