KIDS Distribution saved on Sep 29, 2010@11:07:36 WV Clinical Scheduling **KIDS**:BSDX 1.41^ **INSTALL NAME** BSDX 1.41 "BLD",7915,0) BSDX 1.41^IHS Windows Scheduling^^3100929^n "BLD",7915,1,0) ^^1^1^3100929^^^^ "BLD",7915,1,1,0) Clinical Scheduling M Server support routines, files, options and RPCs. "BLD",7915,4,0) ^9.64PA^9002018.5^9 "BLD",7915,4,9002018.1,0) 9002018.1 "BLD",7915,4,9002018.1,222) y^y^f^^n^^n^o^n "BLD",7915,4,9002018.15,0) 9002018.15 "BLD",7915,4,9002018.15,222) y^y^f^^n^^n^o^n "BLD",7915,4,9002018.2,0) 9002018.2 "BLD",7915,4,9002018.2,222) y^y^f^^n^^n^o^n "BLD",7915,4,9002018.3,0) 9002018.3 "BLD",7915,4,9002018.3,222) y^y^f^^n^^n^o^n "BLD",7915,4,9002018.35,0) 9002018.35 "BLD",7915,4,9002018.35,222) y^y^f^^n^^n^o^n "BLD",7915,4,9002018.38,0) 9002018.38 "BLD",7915,4,9002018.38,222) y^y^f^^n^^n^o^n "BLD",7915,4,9002018.39,0) 9002018.39 "BLD",7915,4,9002018.39,222) y^y^f^^n^^n^o^n "BLD",7915,4,9002018.4,0) 9002018.4 "BLD",7915,4,9002018.4,222) y^y^f^^n^^n^o^n "BLD",7915,4,9002018.5,0) 9002018.5 "BLD",7915,4,9002018.5,222) y^y^f^^n^^y^o^n "BLD",7915,4,"B",9002018.1,9002018.1) "BLD",7915,4,"B",9002018.15,9002018.15) "BLD",7915,4,"B",9002018.2,9002018.2) "BLD",7915,4,"B",9002018.3,9002018.3) "BLD",7915,4,"B",9002018.35,9002018.35) "BLD",7915,4,"B",9002018.38,9002018.38) "BLD",7915,4,"B",9002018.39,9002018.39) "BLD",7915,4,"B",9002018.4,9002018.4) "BLD",7915,4,"B",9002018.5,9002018.5) "BLD",7915,6.3) 8 "BLD",7915,"ABPKG") n "BLD",7915,"INIT") V0200^BSDX2E "BLD",7915,"KRN",0) ^9.67PA^779.2^20 "BLD",7915,"KRN",.4,0) .4 "BLD",7915,"KRN",.4,"NM",0) ^9.68A^^ "BLD",7915,"KRN",.401,0) .401 "BLD",7915,"KRN",.402,0) .402 "BLD",7915,"KRN",.403,0) .403 "BLD",7915,"KRN",.5,0) .5 "BLD",7915,"KRN",.84,0) .84 "BLD",7915,"KRN",3.6,0) 3.6 "BLD",7915,"KRN",3.8,0) 3.8 "BLD",7915,"KRN",9.2,0) 9.2 "BLD",7915,"KRN",9.8,0) 9.8 "BLD",7915,"KRN",9.8,"NM",0) ^9.68A^36^36 "BLD",7915,"KRN",9.8,"NM",1,0) BSDX01^^0^B107139484 "BLD",7915,"KRN",9.8,"NM",2,0) BSDX02^^0^B16323271 "BLD",7915,"KRN",9.8,"NM",3,0) BSDX03^^0^B2855259 "BLD",7915,"KRN",9.8,"NM",4,0) BSDX04^^0^B31079316 "BLD",7915,"KRN",9.8,"NM",5,0) BSDX05^^0^B6801706 "BLD",7915,"KRN",9.8,"NM",6,0) BSDX06^^0^B6812445 "BLD",7915,"KRN",9.8,"NM",7,0) BSDX07^^0^B78302774 "BLD",7915,"KRN",9.8,"NM",8,0) BSDX08^^0^B36787520 "BLD",7915,"KRN",9.8,"NM",9,0) BSDX09^^0^B34793207 "BLD",7915,"KRN",9.8,"NM",10,0) BSDX12^^0^B7203579 "BLD",7915,"KRN",9.8,"NM",11,0) BSDX13^^0^B9753753 "BLD",7915,"KRN",9.8,"NM",12,0) BSDX14^^0^B6450810 "BLD",7915,"KRN",9.8,"NM",13,0) BSDX15^^0^B5327807 "BLD",7915,"KRN",9.8,"NM",14,0) BSDX16^^0^B11948965 "BLD",7915,"KRN",9.8,"NM",15,0) BSDX17^^0^B2072173 "BLD",7915,"KRN",9.8,"NM",16,0) BSDX18^^0^B87953431 "BLD",7915,"KRN",9.8,"NM",17,0) BSDX19^^0^B7890401 "BLD",7915,"KRN",9.8,"NM",18,0) BSDX20^^0^B5911607 "BLD",7915,"KRN",9.8,"NM",19,0) BSDX21^^0^B8672065 "BLD",7915,"KRN",9.8,"NM",20,0) BSDX22^^0^B9479861 "BLD",7915,"KRN",9.8,"NM",21,0) BSDX23^^0^B8488013 "BLD",7915,"KRN",9.8,"NM",22,0) BSDX24^^0^B13455014 "BLD",7915,"KRN",9.8,"NM",23,0) BSDX25^^0^B16070744 "BLD",7915,"KRN",9.8,"NM",24,0) BSDX26^^0^B3226136 "BLD",7915,"KRN",9.8,"NM",25,0) BSDX27^^0^B97105556 "BLD",7915,"KRN",9.8,"NM",26,0) BSDX28^^0^B32389827 "BLD",7915,"KRN",9.8,"NM",27,0) BSDX29^^0^B39369778 "BLD",7915,"KRN",9.8,"NM",28,0) BSDX30^^0^B6616255 "BLD",7915,"KRN",9.8,"NM",29,0) BSDX31^^0^B23243257 "BLD",7915,"KRN",9.8,"NM",30,0) BSDX32^^0^B17196738 "BLD",7915,"KRN",9.8,"NM",31,0) BSDX33^^0^B14923306 "BLD",7915,"KRN",9.8,"NM",32,0) BSDX34^^0^B43182525 "BLD",7915,"KRN",9.8,"NM",33,0) BSDX35^^0^B8147998 "BLD",7915,"KRN",9.8,"NM",34,0) BSDX11^^0^B6358791 "BLD",7915,"KRN",9.8,"NM",35,0) BSDXAPI^^0^B85422550 "BLD",7915,"KRN",9.8,"NM",36,0) BSDXGPRV^^0^B6645474 "BLD",7915,"KRN",9.8,"NM","B","BSDX01",1) "BLD",7915,"KRN",9.8,"NM","B","BSDX02",2) "BLD",7915,"KRN",9.8,"NM","B","BSDX03",3) "BLD",7915,"KRN",9.8,"NM","B","BSDX04",4) "BLD",7915,"KRN",9.8,"NM","B","BSDX05",5) "BLD",7915,"KRN",9.8,"NM","B","BSDX06",6) "BLD",7915,"KRN",9.8,"NM","B","BSDX07",7) "BLD",7915,"KRN",9.8,"NM","B","BSDX08",8) "BLD",7915,"KRN",9.8,"NM","B","BSDX09",9) "BLD",7915,"KRN",9.8,"NM","B","BSDX11",34) "BLD",7915,"KRN",9.8,"NM","B","BSDX12",10) "BLD",7915,"KRN",9.8,"NM","B","BSDX13",11) "BLD",7915,"KRN",9.8,"NM","B","BSDX14",12) "BLD",7915,"KRN",9.8,"NM","B","BSDX15",13) "BLD",7915,"KRN",9.8,"NM","B","BSDX16",14) "BLD",7915,"KRN",9.8,"NM","B","BSDX17",15) "BLD",7915,"KRN",9.8,"NM","B","BSDX18",16) "BLD",7915,"KRN",9.8,"NM","B","BSDX19",17) "BLD",7915,"KRN",9.8,"NM","B","BSDX20",18) "BLD",7915,"KRN",9.8,"NM","B","BSDX21",19) "BLD",7915,"KRN",9.8,"NM","B","BSDX22",20) "BLD",7915,"KRN",9.8,"NM","B","BSDX23",21) "BLD",7915,"KRN",9.8,"NM","B","BSDX24",22) "BLD",7915,"KRN",9.8,"NM","B","BSDX25",23) "BLD",7915,"KRN",9.8,"NM","B","BSDX26",24) "BLD",7915,"KRN",9.8,"NM","B","BSDX27",25) "BLD",7915,"KRN",9.8,"NM","B","BSDX28",26) "BLD",7915,"KRN",9.8,"NM","B","BSDX29",27) "BLD",7915,"KRN",9.8,"NM","B","BSDX30",28) "BLD",7915,"KRN",9.8,"NM","B","BSDX31",29) "BLD",7915,"KRN",9.8,"NM","B","BSDX32",30) "BLD",7915,"KRN",9.8,"NM","B","BSDX33",31) "BLD",7915,"KRN",9.8,"NM","B","BSDX34",32) "BLD",7915,"KRN",9.8,"NM","B","BSDX35",33) "BLD",7915,"KRN",9.8,"NM","B","BSDXAPI",35) "BLD",7915,"KRN",9.8,"NM","B","BSDXGPRV",36) "BLD",7915,"KRN",19,0) 19 "BLD",7915,"KRN",19,"NM",0) ^9.68A^1^1 "BLD",7915,"KRN",19,"NM",1,0) BSDXRPC^^0 "BLD",7915,"KRN",19,"NM","B","BSDXRPC",1) "BLD",7915,"KRN",19.1,0) 19.1 "BLD",7915,"KRN",19.1,"NM",0) ^9.68A^2^2 "BLD",7915,"KRN",19.1,"NM",1,0) BSDXZMENU^^0 "BLD",7915,"KRN",19.1,"NM",2,0) BSDXZMGR^^0 "BLD",7915,"KRN",19.1,"NM","B","BSDXZMENU",1) "BLD",7915,"KRN",19.1,"NM","B","BSDXZMGR",2) "BLD",7915,"KRN",101,0) 101 "BLD",7915,"KRN",101,"NM",0) ^9.68A^4^4 "BLD",7915,"KRN",101,"NM",1,0) BSDX ADD APPOINTMENT^^0 "BLD",7915,"KRN",101,"NM",2,0) BSDX CANCEL APPOINTMENT^^0 "BLD",7915,"KRN",101,"NM",3,0) BSDX CHECKIN APPOINTMENT^^0 "BLD",7915,"KRN",101,"NM",4,0) BSDX NOSHOW APPOINTMENT^^0 "BLD",7915,"KRN",101,"NM","B","BSDX ADD APPOINTMENT",1) "BLD",7915,"KRN",101,"NM","B","BSDX CANCEL APPOINTMENT",2) "BLD",7915,"KRN",101,"NM","B","BSDX CHECKIN APPOINTMENT",3) "BLD",7915,"KRN",101,"NM","B","BSDX NOSHOW APPOINTMENT",4) "BLD",7915,"KRN",409.61,0) 409.61 "BLD",7915,"KRN",771,0) 771 "BLD",7915,"KRN",779.2,0) 779.2 "BLD",7915,"KRN",870,0) 870 "BLD",7915,"KRN",8989.51,0) 8989.51 "BLD",7915,"KRN",8989.52,0) 8989.52 "BLD",7915,"KRN",8994,0) 8994 "BLD",7915,"KRN",8994,"NM",0) ^9.68A^59^56 "BLD",7915,"KRN",8994,"NM",1,0) BSDX ADD NEW APPOINTMENT^^0 "BLD",7915,"KRN",8994,"NM",2,0) BSDX ADD NEW AVAILABILITY^^0 "BLD",7915,"KRN",8994,"NM",3,0) BSDX APPT BLOCKS OVERLAP^^0 "BLD",7915,"KRN",8994,"NM",4,0) BSDX CANCEL APPOINTMENT^^0 "BLD",7915,"KRN",8994,"NM",5,0) BSDX CANCEL AVAILABILITY^^0 "BLD",7915,"KRN",8994,"NM",6,0) BSDX CREATE APPT SCHEDULE^^0 "BLD",7915,"KRN",8994,"NM",7,0) BSDX CREATE ASGND SLOT SCHED^^0 "BLD",7915,"KRN",8994,"NM",10,0) BSDX GET BASIC REG INFO^^0 "BLD",7915,"KRN",8994,"NM",12,0) BSDX TYPE BLOCKS OVERLAP^^0 "BLD",7915,"KRN",8994,"NM",13,0) BSDX ADD/EDIT ACCESS TYPE^^0 "BLD",7915,"KRN",8994,"NM",14,0) BSDX GET ACCESS GROUP TYPES^^0 "BLD",7915,"KRN",8994,"NM",15,0) BSDX GROUP RESOURCE^^0 "BLD",7915,"KRN",8994,"NM",16,0) BSDX RESOURCE GROUPS BY USER^^0 "BLD",7915,"KRN",8994,"NM",17,0) BSDX ADD/EDIT RESOURCEUSER^^0 "BLD",7915,"KRN",8994,"NM",18,0) BSDX DELETE RESOURCEUSER^^0 "BLD",7915,"KRN",8994,"NM",19,0) BSDX SCHEDULE USER^^0 "BLD",7915,"KRN",8994,"NM",20,0) BSDX ADD/EDIT RESOURCE^^0 "BLD",7915,"KRN",8994,"NM",21,0) BSDX SCHEDULING USER INFO^^0 "BLD",7915,"KRN",8994,"NM",22,0) BSDX RESOURCES^^0 "BLD",7915,"KRN",8994,"NM",23,0) BSDX ADD/EDIT RESOURCE GROUP^^0 "BLD",7915,"KRN",8994,"NM",24,0) BSDX DELETE RESOURCE GROUP^^0 "BLD",7915,"KRN",8994,"NM",25,0) BSDX DELETE RES GROUP ITEM^^0 "BLD",7915,"KRN",8994,"NM",26,0) BSDX DEPARTMENT RESOURCE^^0 "BLD",7915,"KRN",8994,"NM",27,0) BSDX DEPARTMENTS BY USER^^0 "BLD",7915,"KRN",8994,"NM",28,0) BSDX RESOURCES BY USER^^0 "BLD",7915,"KRN",8994,"NM",29,0) BSDX ADD ACCESS GROUP ITEM^^0 "BLD",7915,"KRN",8994,"NM",30,0) BSDX ADD RES GROUP ITEM^^0 "BLD",7915,"KRN",8994,"NM",31,0) BSDX ADD/EDIT ACCESS GROUP^^0 "BLD",7915,"KRN",8994,"NM",32,0) BSDX DELETE ACCESS GROUP^^0 "BLD",7915,"KRN",8994,"NM",33,0) BSDX DELETE ACCESS GROUP ITEM^^0 "BLD",7915,"KRN",8994,"NM",34,0) BSDX REGISTER EVENT^^0 "BLD",7915,"KRN",8994,"NM",35,0) BSDX UNREGISTER EVENT^^0 "BLD",7915,"KRN",8994,"NM",36,0) BSDX RAISE EVENT^^0 "BLD",7915,"KRN",8994,"NM",37,0) BSDX SEARCH AVAILABILITY^^0 "BLD",7915,"KRN",8994,"NM",38,0) BSDX CHECKIN APPOINTMENT^^0 "BLD",7915,"KRN",8994,"NM",39,0) BSDX EDIT APPOINTMENT^^0 "BLD",7915,"KRN",8994,"NM",40,0) BSDX PATIENT APPT DISPLAY^^0 "BLD",7915,"KRN",8994,"NM",41,0) BSDXPatientLookupRS^^0 "BLD",7915,"KRN",8994,"NM",42,0) BSDX SPACEBAR SET^^0 "BLD",7915,"KRN",8994,"NM",43,0) BSDX COPY APPOINTMENT CANCEL^^0 "BLD",7915,"KRN",8994,"NM",44,0) BSDX COPY APPOINTMENT STATUS^^0 "BLD",7915,"KRN",8994,"NM",45,0) BSDX COPY APPOINTMENTS^^0 "BLD",7915,"KRN",8994,"NM",46,0) BSDX CLINIC LETTERS^^0 "BLD",7915,"KRN",8994,"NM",47,0) BSDX NOSHOW^^0 "BLD",7915,"KRN",8994,"NM",48,0) BSDX IM HERE^^0 "BLD",7915,"KRN",8994,"NM",49,0) BSDX HOSPITAL LOCATION^^0 "BLD",7915,"KRN",8994,"NM",50,0) BSDX CLINIC SETUP^^0 "BLD",7915,"KRN",8994,"NM",51,0) BSDX REBOOK LIST^^0 "BLD",7915,"KRN",8994,"NM",52,0) BSDX REBOOK CLINIC LIST^^0 "BLD",7915,"KRN",8994,"NM",53,0) BSDX REBOOK SET^^0 "BLD",7915,"KRN",8994,"NM",54,0) BSDX RESOURCE LETTERS^^0 "BLD",7915,"KRN",8994,"NM",55,0) BSDX CANCEL CLINIC LIST^^0 "BLD",7915,"KRN",8994,"NM",56,0) BSDX CANCEL AV BY DATE^^0 "BLD",7915,"KRN",8994,"NM",57,0) BSDX REBOOK NEXT BLOCK^^0 "BLD",7915,"KRN",8994,"NM",58,0) BSDX EHR PATIENT^^0 "BLD",7915,"KRN",8994,"NM",59,0) BSDX HOSP LOC PROVIDERS^^0 "BLD",7915,"KRN",8994,"NM","B","BSDX ADD ACCESS GROUP ITEM",29) "BLD",7915,"KRN",8994,"NM","B","BSDX ADD NEW APPOINTMENT",1) "BLD",7915,"KRN",8994,"NM","B","BSDX ADD NEW AVAILABILITY",2) "BLD",7915,"KRN",8994,"NM","B","BSDX ADD RES GROUP ITEM",30) "BLD",7915,"KRN",8994,"NM","B","BSDX ADD/EDIT ACCESS GROUP",31) "BLD",7915,"KRN",8994,"NM","B","BSDX ADD/EDIT ACCESS TYPE",13) "BLD",7915,"KRN",8994,"NM","B","BSDX ADD/EDIT RESOURCE",20) "BLD",7915,"KRN",8994,"NM","B","BSDX ADD/EDIT RESOURCE GROUP",23) "BLD",7915,"KRN",8994,"NM","B","BSDX ADD/EDIT RESOURCEUSER",17) "BLD",7915,"KRN",8994,"NM","B","BSDX APPT BLOCKS OVERLAP",3) "BLD",7915,"KRN",8994,"NM","B","BSDX CANCEL APPOINTMENT",4) "BLD",7915,"KRN",8994,"NM","B","BSDX CANCEL AV BY DATE",56) "BLD",7915,"KRN",8994,"NM","B","BSDX CANCEL AVAILABILITY",5) "BLD",7915,"KRN",8994,"NM","B","BSDX CANCEL CLINIC LIST",55) "BLD",7915,"KRN",8994,"NM","B","BSDX CHECKIN APPOINTMENT",38) "BLD",7915,"KRN",8994,"NM","B","BSDX CLINIC LETTERS",46) "BLD",7915,"KRN",8994,"NM","B","BSDX CLINIC SETUP",50) "BLD",7915,"KRN",8994,"NM","B","BSDX COPY APPOINTMENT CANCEL",43) "BLD",7915,"KRN",8994,"NM","B","BSDX COPY APPOINTMENT STATUS",44) "BLD",7915,"KRN",8994,"NM","B","BSDX COPY APPOINTMENTS",45) "BLD",7915,"KRN",8994,"NM","B","BSDX CREATE APPT SCHEDULE",6) "BLD",7915,"KRN",8994,"NM","B","BSDX CREATE ASGND SLOT SCHED",7) "BLD",7915,"KRN",8994,"NM","B","BSDX DELETE ACCESS GROUP",32) "BLD",7915,"KRN",8994,"NM","B","BSDX DELETE ACCESS GROUP ITEM",33) "BLD",7915,"KRN",8994,"NM","B","BSDX DELETE RES GROUP ITEM",25) "BLD",7915,"KRN",8994,"NM","B","BSDX DELETE RESOURCE GROUP",24) "BLD",7915,"KRN",8994,"NM","B","BSDX DELETE RESOURCEUSER",18) "BLD",7915,"KRN",8994,"NM","B","BSDX DEPARTMENT RESOURCE",26) "BLD",7915,"KRN",8994,"NM","B","BSDX DEPARTMENTS BY USER",27) "BLD",7915,"KRN",8994,"NM","B","BSDX EDIT APPOINTMENT",39) "BLD",7915,"KRN",8994,"NM","B","BSDX EHR PATIENT",58) "BLD",7915,"KRN",8994,"NM","B","BSDX GET ACCESS GROUP TYPES",14) "BLD",7915,"KRN",8994,"NM","B","BSDX GET BASIC REG INFO",10) "BLD",7915,"KRN",8994,"NM","B","BSDX GROUP RESOURCE",15) "BLD",7915,"KRN",8994,"NM","B","BSDX HOSP LOC PROVIDERS",59) "BLD",7915,"KRN",8994,"NM","B","BSDX HOSPITAL LOCATION",49) "BLD",7915,"KRN",8994,"NM","B","BSDX IM HERE",48) "BLD",7915,"KRN",8994,"NM","B","BSDX NOSHOW",47) "BLD",7915,"KRN",8994,"NM","B","BSDX PATIENT APPT DISPLAY",40) "BLD",7915,"KRN",8994,"NM","B","BSDX RAISE EVENT",36) "BLD",7915,"KRN",8994,"NM","B","BSDX REBOOK CLINIC LIST",52) "BLD",7915,"KRN",8994,"NM","B","BSDX REBOOK LIST",51) "BLD",7915,"KRN",8994,"NM","B","BSDX REBOOK NEXT BLOCK",57) "BLD",7915,"KRN",8994,"NM","B","BSDX REBOOK SET",53) "BLD",7915,"KRN",8994,"NM","B","BSDX REGISTER EVENT",34) "BLD",7915,"KRN",8994,"NM","B","BSDX RESOURCE GROUPS BY USER",16) "BLD",7915,"KRN",8994,"NM","B","BSDX RESOURCE LETTERS",54) "BLD",7915,"KRN",8994,"NM","B","BSDX RESOURCES",22) "BLD",7915,"KRN",8994,"NM","B","BSDX RESOURCES BY USER",28) "BLD",7915,"KRN",8994,"NM","B","BSDX SCHEDULE USER",19) "BLD",7915,"KRN",8994,"NM","B","BSDX SCHEDULING USER INFO",21) "BLD",7915,"KRN",8994,"NM","B","BSDX SEARCH AVAILABILITY",37) "BLD",7915,"KRN",8994,"NM","B","BSDX SPACEBAR SET",42) "BLD",7915,"KRN",8994,"NM","B","BSDX TYPE BLOCKS OVERLAP",12) "BLD",7915,"KRN",8994,"NM","B","BSDX UNREGISTER EVENT",35) "BLD",7915,"KRN",8994,"NM","B","BSDXPatientLookupRS",41) "BLD",7915,"KRN","B",.4,.4) "BLD",7915,"KRN","B",.401,.401) "BLD",7915,"KRN","B",.402,.402) "BLD",7915,"KRN","B",.403,.403) "BLD",7915,"KRN","B",.5,.5) "BLD",7915,"KRN","B",.84,.84) "BLD",7915,"KRN","B",3.6,3.6) "BLD",7915,"KRN","B",3.8,3.8) "BLD",7915,"KRN","B",9.2,9.2) "BLD",7915,"KRN","B",9.8,9.8) "BLD",7915,"KRN","B",19,19) "BLD",7915,"KRN","B",19.1,19.1) "BLD",7915,"KRN","B",101,101) "BLD",7915,"KRN","B",409.61,409.61) "BLD",7915,"KRN","B",771,771) "BLD",7915,"KRN","B",779.2,779.2) "BLD",7915,"KRN","B",870,870) "BLD",7915,"KRN","B",8989.51,8989.51) "BLD",7915,"KRN","B",8989.52,8989.52) "BLD",7915,"KRN","B",8994,8994) "BLD",7915,"PRE") BSDX2E "BLD",7915,"QUES",0) ^9.62^^ "BLD",7915,"REQB",0) ^9.611^^ "DATA",9002018.5,1,0) 1^41^3100929.1043 "FIA",9002018.1) BSDX RESOURCE "FIA",9002018.1,0) ^BSDXRES( "FIA",9002018.1,0,0) 9002018.1 "FIA",9002018.1,0,1) y^y^f^^n^^n^o^n "FIA",9002018.1,0,10) "FIA",9002018.1,0,11) "FIA",9002018.1,0,"RLRO") "FIA",9002018.1,0,"VR") 1.41^BSDX "FIA",9002018.1,9002018.1) 0 "FIA",9002018.1,9002018.11) 0 "FIA",9002018.1,9002018.11201) 0 "FIA",9002018.1,9002018.11301) 0 "FIA",9002018.1,9002018.12001) 0 "FIA",9002018.15) BSDX RESOURCE USER "FIA",9002018.15,0) ^BSDXRSU( "FIA",9002018.15,0,0) 9002018.15P "FIA",9002018.15,0,1) y^y^f^^n^^n^o^n "FIA",9002018.15,0,10) "FIA",9002018.15,0,11) "FIA",9002018.15,0,"RLRO") "FIA",9002018.15,0,"VR") 1.41^BSDX "FIA",9002018.15,9002018.15) 0 "FIA",9002018.2) BSDX RESOURCE GROUP "FIA",9002018.2,0) ^BSDXDEPT( "FIA",9002018.2,0,0) 9002018.2 "FIA",9002018.2,0,1) y^y^f^^n^^n^o^n "FIA",9002018.2,0,10) "FIA",9002018.2,0,11) "FIA",9002018.2,0,"RLRO") "FIA",9002018.2,0,"VR") 1.41^BSDX "FIA",9002018.2,9002018.2) 0 "FIA",9002018.2,9002018.21) 0 "FIA",9002018.3) BSDX ACCESS BLOCK "FIA",9002018.3,0) ^BSDXAB( "FIA",9002018.3,0,0) 9002018.3PA "FIA",9002018.3,0,1) y^y^f^^n^^n^o^n "FIA",9002018.3,0,10) "FIA",9002018.3,0,11) "FIA",9002018.3,0,"RLRO") "FIA",9002018.3,0,"VR") 1.41^BSDX "FIA",9002018.3,9002018.3) 0 "FIA",9002018.3,9002018.31) 0 "FIA",9002018.35) BSDX ACCESS TYPE "FIA",9002018.35,0) ^BSDXTYPE( "FIA",9002018.35,0,0) 9002018.35 "FIA",9002018.35,0,1) y^y^f^^n^^n^o^n "FIA",9002018.35,0,10) "FIA",9002018.35,0,11) "FIA",9002018.35,0,"RLRO") "FIA",9002018.35,0,"VR") 1.41^BSDX "FIA",9002018.35,9002018.35) 0 "FIA",9002018.38) BSDX ACCESS GROUP "FIA",9002018.38,0) ^BSDXAGP( "FIA",9002018.38,0,0) 9002018.38 "FIA",9002018.38,0,1) y^y^f^^n^^n^o^n "FIA",9002018.38,0,10) "FIA",9002018.38,0,11) "FIA",9002018.38,0,"RLRO") "FIA",9002018.38,0,"VR") 1.41^BSDX "FIA",9002018.38,9002018.38) 0 "FIA",9002018.39) BSDX ACCESS GROUP TYPE "FIA",9002018.39,0) ^BSDXAGTP( "FIA",9002018.39,0,0) 9002018.39P "FIA",9002018.39,0,1) y^y^f^^n^^n^o^n "FIA",9002018.39,0,10) "FIA",9002018.39,0,11) "FIA",9002018.39,0,"RLRO") "FIA",9002018.39,0,"VR") 1.41^BSDX "FIA",9002018.39,9002018.39) 0 "FIA",9002018.4) BSDX APPOINTMENT "FIA",9002018.4,0) ^BSDXAPPT( "FIA",9002018.4,0,0) 9002018.4DA "FIA",9002018.4,0,1) y^y^f^^n^^n^o^n "FIA",9002018.4,0,10) "FIA",9002018.4,0,11) "FIA",9002018.4,0,"RLRO") "FIA",9002018.4,0,"VR") 1.41^BSDX "FIA",9002018.4,9002018.4) 0 "FIA",9002018.4,9002018.41) 0 "FIA",9002018.5) BSDX APPLICATION "FIA",9002018.5,0) ^BSDXAPPL( "FIA",9002018.5,0,0) 9002018.5 "FIA",9002018.5,0,1) y^y^f^^n^^y^o^n "FIA",9002018.5,0,10) "FIA",9002018.5,0,11) "FIA",9002018.5,0,"RLRO") "FIA",9002018.5,0,"VR") 1.41^BSDX "FIA",9002018.5,9002018.5) 0 "INIT") V0200^BSDX2E "IX",9002018.39,9002018.39,"AC",0) 9002018.39^AC^INDEX OF ACCESS GROUP, ACCESS TYPE^R^^R^IR^I^9002018.39^^^^^S "IX",9002018.39,9002018.39,"AC",1) S ^BSDXAGTP("AC",$E(X(1),1,30),$E(X(2),1,30),DA)="" "IX",9002018.39,9002018.39,"AC",2) K ^BSDXAGTP("AC",$E(X(1),1,30),$E(X(2),1,30),DA) "IX",9002018.39,9002018.39,"AC",2.5) K ^BSDXAGTP("AC") "IX",9002018.39,9002018.39,"AC",11.1,0) ^.114IA^2^2 "IX",9002018.39,9002018.39,"AC",11.1,1,0) 1^F^9002018.39^.01^30^1^F "IX",9002018.39,9002018.39,"AC",11.1,1,3) "IX",9002018.39,9002018.39,"AC",11.1,2,0) 2^F^9002018.39^.02^30^2^F "IX",9002018.39,9002018.39,"AC",11.1,2,3) "KRN",19,11052,-1) 0^1 "KRN",19,11052,0) BSDXRPC^WINDOWS SCHEDULING PROCEDURE CALLS^^B^^^^^^^^IHS Windows Scheduling "KRN",19,11052,1,0) ^19.06^4^4^3100618^^ "KRN",19,11052,1,1,0) This option hosts RPCs in the BSDX namespace. Windows Scheduling users "KRN",19,11052,1,2,0) mustg have access to this option "KRN",19,11052,1,3,0) "KRN",19,11052,1,4,0) in order to use Windows Scheduling. "KRN",19,11052,99.1) 61545,63078 "KRN",19,11052,"RPC",0) ^19.05P^56^56 "KRN",19,11052,"RPC",1,0) BSDX ADD ACCESS GROUP ITEM "KRN",19,11052,"RPC",2,0) BSDX ADD NEW APPOINTMENT "KRN",19,11052,"RPC",3,0) BSDX ADD NEW AVAILABILITY "KRN",19,11052,"RPC",4,0) BSDX ADD RES GROUP ITEM "KRN",19,11052,"RPC",5,0) BSDX ADD/EDIT ACCESS GROUP "KRN",19,11052,"RPC",6,0) BSDX ADD/EDIT ACCESS TYPE "KRN",19,11052,"RPC",7,0) BSDX ADD/EDIT RESOURCE "KRN",19,11052,"RPC",8,0) BSDX ADD/EDIT RESOURCE GROUP "KRN",19,11052,"RPC",9,0) BSDX ADD/EDIT RESOURCEUSER "KRN",19,11052,"RPC",10,0) BSDX APPT BLOCKS OVERLAP "KRN",19,11052,"RPC",11,0) BSDX CANCEL APPOINTMENT "KRN",19,11052,"RPC",12,0) BSDX CANCEL AVAILABILITY "KRN",19,11052,"RPC",13,0) BSDX CHECKIN APPOINTMENT "KRN",19,11052,"RPC",14,0) BSDX CREATE APPT SCHEDULE "KRN",19,11052,"RPC",15,0) BSDX CREATE ASGND SLOT SCHED "KRN",19,11052,"RPC",16,0) BSDX DELETE ACCESS GROUP "KRN",19,11052,"RPC",17,0) BSDX DELETE ACCESS GROUP ITEM "KRN",19,11052,"RPC",18,0) BSDX DELETE RES GROUP ITEM "KRN",19,11052,"RPC",19,0) BSDX DELETE RESOURCE GROUP "KRN",19,11052,"RPC",20,0) BSDX DELETE RESOURCEUSER "KRN",19,11052,"RPC",21,0) BSDX DEPARTMENT RESOURCE "KRN",19,11052,"RPC",22,0) BSDX DEPARTMENTS BY USER "KRN",19,11052,"RPC",23,0) BSDX EDIT APPOINTMENT "KRN",19,11052,"RPC",24,0) BSDX GET ACCESS GROUP TYPES "KRN",19,11052,"RPC",25,0) BSDX GET BASIC REG INFO "KRN",19,11052,"RPC",26,0) BSDX GROUP RESOURCE "KRN",19,11052,"RPC",27,0) BSDX PATIENT APPT DISPLAY "KRN",19,11052,"RPC",28,0) BSDX RAISE EVENT "KRN",19,11052,"RPC",29,0) BSDX REGISTER EVENT "KRN",19,11052,"RPC",30,0) BSDX RESOURCE GROUPS BY USER "KRN",19,11052,"RPC",31,0) BSDX RESOURCES "KRN",19,11052,"RPC",32,0) BSDX RESOURCES BY USER "KRN",19,11052,"RPC",33,0) BSDX SCHEDULE USER "KRN",19,11052,"RPC",34,0) BSDX SCHEDULING USER INFO "KRN",19,11052,"RPC",35,0) BSDX SEARCH AVAILABILITY "KRN",19,11052,"RPC",36,0) BSDX TYPE BLOCKS OVERLAP "KRN",19,11052,"RPC",37,0) BSDX UNREGISTER EVENT "KRN",19,11052,"RPC",38,0) BSDXPatientLookupRS "KRN",19,11052,"RPC",39,0) BSDX SPACEBAR SET "KRN",19,11052,"RPC",40,0) BSDX COPY APPOINTMENTS "KRN",19,11052,"RPC",41,0) BSDX COPY APPOINTMENT CANCEL "KRN",19,11052,"RPC",42,0) BSDX COPY APPOINTMENT STATUS "KRN",19,11052,"RPC",43,0) BSDX CLINIC LETTERS "KRN",19,11052,"RPC",44,0) BSDX NOSHOW "KRN",19,11052,"RPC",45,0) BSDX IM HERE "KRN",19,11052,"RPC",46,0) BSDX HOSPITAL LOCATION "KRN",19,11052,"RPC",47,0) BSDX CLINIC SETUP "KRN",19,11052,"RPC",49,0) BSDX REBOOK LIST "KRN",19,11052,"RPC",50,0) BSDX REBOOK CLINIC LIST "KRN",19,11052,"RPC",51,0) BSDX REBOOK SET "KRN",19,11052,"RPC",52,0) BSDX RESOURCE LETTERS "KRN",19,11052,"RPC",53,0) BSDX CANCEL CLINIC LIST "KRN",19,11052,"RPC",54,0) BSDX CANCEL AV BY DATE "KRN",19,11052,"RPC",55,0) BSDX REBOOK NEXT BLOCK "KRN",19,11052,"RPC",56,0) BSDX HOSP LOC PROVIDERS "KRN",19,11052,"U") WINDOWS SCHEDULING PROCEDURE C "KRN",19.1,488,-1) 0^1 "KRN",19.1,488,0) BSDXZMENU^IHS Windows Scheduling "KRN",19.1,489,-1) 0^2 "KRN",19.1,489,0) BSDXZMGR^IHS Windows Scheduling Manager "KRN",101,4299,-1) 0^2 "KRN",101,4299,0) BSDX CANCEL APPOINTMENT^BSDX CANCEL APPOINTMENT^^A^^^^^^^^ "KRN",101,4299,1,0) ^^4^4^3040915^ "KRN",101,4299,1,1,0) IHS protocol called by the PIMS v5.3 Scheduling Event Driver "KRN",101,4299,1,2,0) (BSDAM APPOINTMENT EVENTS). This protocol will "KRN",101,4299,1,3,0) cancel an appointment in the IHS Windows Scheduling package "KRN",101,4299,1,4,0) when the corresponding appointment in RPMS Scheduling is cancelled. "KRN",101,4299,4) ^^^BSDX CANCEL APPOINTMENT "KRN",101,4299,20) I $G(SDAMEVT)=2,$D(^BSDXAPPL) D CANEVT^BSDX08($G(DFN),$G(SDT),$G(SDCL)) "KRN",101,4299,99) 61997,36371 "KRN",101,4300,-1) 0^1 "KRN",101,4300,0) BSDX ADD APPOINTMENT^BSDX ADD APPOINTMENT^^A^^^^^^^^ "KRN",101,4300,1,0) ^101.06^4^4^3040915^^ "KRN",101,4300,1,1,0) IHS protocol called by the PIMS v5.3 Scheduling Event Driver "KRN",101,4300,1,2,0) (BSDAM APPOINTMENT EVENTS). This protocol will "KRN",101,4300,1,3,0) add an appointment in the IHS Windows Scheduling package "KRN",101,4300,1,4,0) when the corresponding appointment in RPMS Scheduling is added. "KRN",101,4300,4) ^^^BSDX ADD APPOINTMENT "KRN",101,4300,20) I $G(SDAMEVT)=1,$D(^BSDXAPPL) D ADDEVT^BSDX07($G(DFN),$G(SDT),$G(SDCL),$G(SDDA)) "KRN",101,4300,99) 61997,36371 "KRN",101,4301,-1) 0^4 "KRN",101,4301,0) BSDX NOSHOW APPOINTMENT^BSDX NOSHOW APPOINTMENT^^A^^^^^^^^ "KRN",101,4301,1,0) ^101.06^4^4^3040915^^ "KRN",101,4301,1,1,0) IHS protocol called by the PIMS v5.3 Scheduling Event Driver "KRN",101,4301,1,2,0) (BSDAM APPOINTMENT EVENTS). This protocol will "KRN",101,4301,1,3,0) no-show an appointment in the IHS Windows Scheduling package "KRN",101,4301,1,4,0) when the corresponding appointment in RPMS Scheduling is no-showed. "KRN",101,4301,4) ^^^BSDX NOSHOW APPOINTMENT "KRN",101,4301,20) I $G(SDAMEVT)=3,$D(^BSDXAPPL) D NOSEVT^BSDX31($G(DFN),$G(SDT),$G(SDCL)) "KRN",101,4301,99) 61997,36371 "KRN",101,4302,-1) 0^3 "KRN",101,4302,0) BSDX CHECKIN APPOINTMENT^BSDX CHECKIN APPOINTMENT^^A^^^^^^^^ "KRN",101,4302,1,0) ^101.06^4^4^3040915^^^ "KRN",101,4302,1,1,0) IHS protocol called by the PIMS v5.3 Scheduling Event Driver "KRN",101,4302,1,2,0) (BSDAM APPOINTMENT EVENTS). This protocol will "KRN",101,4302,1,3,0) check in an appointment in the IHS Windows Scheduling package "KRN",101,4302,1,4,0) when the corresponding appointment in RPMS Scheduling is checked in. "KRN",101,4302,4) ^^^BSDX CHECKIN APPOINTMENT "KRN",101,4302,20) I $G(SDAMEVT)=4,$D(^BSDXAPPL) D CHKEVT^BSDX25($G(DFN),$G(SDT),$G(SDCL)) "KRN",101,4302,99) 61997,36371 "KRN",8994,2590,-1) 0^16 "KRN",8994,2590,0) BSDX RESOURCE GROUPS BY USER^DEPUSR^BSDX01^4 "KRN",8994,2591,-1) 0^22 "KRN",8994,2591,0) BSDX RESOURCES^RESUSR^BSDX01^4 "KRN",8994,2592,-1) 0^6 "KRN",8994,2592,0) BSDX CREATE APPT SCHEDULE^CRSCH^BSDX02^4 "KRN",8994,2593,-1) 0^1 "KRN",8994,2593,0) BSDX ADD NEW APPOINTMENT^APPADD^BSDX07^4 "KRN",8994,2594,-1) 0^4 "KRN",8994,2594,0) BSDX CANCEL APPOINTMENT^APPDEL^BSDX08^4 "KRN",8994,2595,-1) 0^7 "KRN",8994,2595,0) BSDX CREATE ASGND SLOT SCHED^CASSCH^BSDX04^4 "KRN",8994,2596,-1) 0^2 "KRN",8994,2596,0) BSDX ADD NEW AVAILABILITY^AVADD^BSDX12^4 "KRN",8994,2597,-1) 0^5 "KRN",8994,2597,0) BSDX CANCEL AVAILABILITY^AVDEL^BSDX13^4 "KRN",8994,2598,-1) 0^3 "KRN",8994,2598,0) BSDX APPT BLOCKS OVERLAP^APBLKOV^BSDX05^4 "KRN",8994,2599,-1) 0^12 "KRN",8994,2599,0) BSDX TYPE BLOCKS OVERLAP^TPBLKOV^BSDX06^4 "KRN",8994,2600,-1) 0^10 "KRN",8994,2600,0) BSDX GET BASIC REG INFO^GETREGA^BSDX09^4 "KRN",8994,2601,-1) 0^15 "KRN",8994,2601,0) BSDX GROUP RESOURCE^DEPRES^BSDX01^4 "KRN",8994,2602,-1) 0^13 "KRN",8994,2602,0) BSDX ADD/EDIT ACCESS TYPE^ACCTYP^BSDX14^4 "KRN",8994,2603,-1) 0^14 "KRN",8994,2603,0) BSDX GET ACCESS GROUP TYPES^GRPTYP^BSDX15^4 "KRN",8994,2604,-1) 0^20 "KRN",8994,2604,0) BSDX ADD/EDIT RESOURCE^RSRC^BSDX16^4 "KRN",8994,2605,-1) 0^19 "KRN",8994,2605,0) BSDX SCHEDULE USER^SCHUSR^BSDX17^4 "KRN",8994,2606,-1) 0^18 "KRN",8994,2606,0) BSDX DELETE RESOURCEUSER^DELRU^BSDX18^4 "KRN",8994,2607,-1) 0^17 "KRN",8994,2607,0) BSDX ADD/EDIT RESOURCEUSER^ADDRU^BSDX18^4 "KRN",8994,2608,-1) 0^21 "KRN",8994,2608,0) BSDX SCHEDULING USER INFO^SUINFO^BSDX01^4 "KRN",8994,2609,-1) 0^23 "KRN",8994,2609,0) BSDX ADD/EDIT RESOURCE GROUP^ADDRG^BSDX19^4 "KRN",8994,2610,-1) 0^24 "KRN",8994,2610,0) BSDX DELETE RESOURCE GROUP^DELRG^BSDX19^4 "KRN",8994,2611,-1) 0^27 "KRN",8994,2611,0) BSDX DEPARTMENTS BY USER^DEPUSR^BSDX01^4 "KRN",8994,2612,-1) 0^28 "KRN",8994,2612,0) BSDX RESOURCES BY USER^RESUSR^BSDX01^4 "KRN",8994,2613,-1) 0^26 "KRN",8994,2613,0) BSDX DEPARTMENT RESOURCE^DEPRES^BSDX01^4 "KRN",8994,2614,-1) 0^25 "KRN",8994,2614,0) BSDX DELETE RES GROUP ITEM^DELRGI^BSDX20^4 "KRN",8994,2615,-1) 0^30 "KRN",8994,2615,0) BSDX ADD RES GROUP ITEM^ADDRGI^BSDX20^4 "KRN",8994,2616,-1) 0^31 "KRN",8994,2616,0) BSDX ADD/EDIT ACCESS GROUP^ADDAG^BSDX21^4 "KRN",8994,2617,-1) 0^32 "KRN",8994,2617,0) BSDX DELETE ACCESS GROUP^DELAG^BSDX21^4 "KRN",8994,2618,-1) 0^29 "KRN",8994,2618,0) BSDX ADD ACCESS GROUP ITEM^ADDAGI^BSDX22^4 "KRN",8994,2619,-1) 0^33 "KRN",8994,2619,0) BSDX DELETE ACCESS GROUP ITEM^DELAGI^BSDX22^4 "KRN",8994,2620,-1) 0^34 "KRN",8994,2620,0) BSDX REGISTER EVENT^REGEVNT^BSDX23^4 "KRN",8994,2621,-1) 0^35 "KRN",8994,2621,0) BSDX UNREGISTER EVENT^UNREG^BSDX23^4 "KRN",8994,2622,-1) 0^36 "KRN",8994,2622,0) BSDX RAISE EVENT^RAISEVNT^BSDX23^4 "KRN",8994,2623,-1) 0^37 "KRN",8994,2623,0) BSDX SEARCH AVAILABILITY^SEARCH^BSDX24^4 "KRN",8994,2624,-1) 0^38 "KRN",8994,2624,0) BSDX CHECKIN APPOINTMENT^CHECKIN^BSDX25^4 "KRN",8994,2625,-1) 0^39 "KRN",8994,2625,0) BSDX EDIT APPOINTMENT^EDITAPT^BSDX26^4 "KRN",8994,2626,-1) 0^40 "KRN",8994,2626,0) BSDX PATIENT APPT DISPLAY^PADISP^BSDX27^4 "KRN",8994,2627,-1) 0^41 "KRN",8994,2627,0) BSDXPatientLookupRS^PTLOOKRS^BSDX28^1 "KRN",8994,2628,-1) 0^42 "KRN",8994,2628,0) BSDX SPACEBAR SET^SPACE^BSDX30^4 "KRN",8994,2629,-1) 0^45 "KRN",8994,2629,0) BSDX COPY APPOINTMENTS^BSDXCP^BSDX29^4 "KRN",8994,2630,-1) 0^44 "KRN",8994,2630,0) BSDX COPY APPOINTMENT STATUS^CPSTAT^BSDX29^4 "KRN",8994,2631,-1) 0^43 "KRN",8994,2631,0) BSDX COPY APPOINTMENT CANCEL^CPCANC^BSDX29^4 "KRN",8994,2632,-1) 0^46 "KRN",8994,2632,0) BSDX CLINIC LETTERS^CLDISP^BSDX27^4 "KRN",8994,2633,-1) 0^47 "KRN",8994,2633,0) BSDX NOSHOW^NOSHOW^BSDX31^4 "KRN",8994,2634,-1) 0^48 "KRN",8994,2634,0) BSDX IM HERE^IMHERE^BSDX31^1 "KRN",8994,2634,1,0) ^^2^2^3040304^ "KRN",8994,2634,1,1,0) Returns a simple value to client. Used to establish continued existence "KRN",8994,2634,1,2,0) of the client to the server; resets the server READ timeout. "KRN",8994,2635,-1) 0^49 "KRN",8994,2635,0) BSDX HOSPITAL LOCATION^HOSPLOC^BSDX32^4 "KRN",8994,2636,-1) 0^50 "KRN",8994,2636,0) BSDX CLINIC SETUP^CLNSET^BSDX32^4 "KRN",8994,2637,-1) 0^51 "KRN",8994,2637,0) BSDX REBOOK LIST^RBLETT^BSDX34^4 "KRN",8994,2638,-1) 0^52 "KRN",8994,2638,0) BSDX REBOOK CLINIC LIST^RBCLIN^BSDX34^4 "KRN",8994,2639,-1) 0^53 "KRN",8994,2639,0) BSDX REBOOK SET^SETRBK^BSDX33^4 "KRN",8994,2640,-1) 0^54 "KRN",8994,2640,0) BSDX RESOURCE LETTERS^RSRCLTR^BSDX35^4 "KRN",8994,2641,-1) 0^55 "KRN",8994,2641,0) BSDX CANCEL CLINIC LIST^CANCLIN^BSDX34^4 "KRN",8994,2642,-1) 0^56 "KRN",8994,2642,0) BSDX CANCEL AV BY DATE^AVDELDT^BSDX13^4 "KRN",8994,2643,-1) 0^57 "KRN",8994,2643,0) BSDX REBOOK NEXT BLOCK^RBNEXT^BSDX33^4 "KRN",8994,2644,-1) 0^58 "KRN",8994,2644,0) BSDX EHR PATIENT^EHRPT^BSDX30^4 "KRN",8994,2645,-1) 0^59 "KRN",8994,2645,0) BSDX HOSP LOC PROVIDERS^P^BSDXGPRV^4 "MBREQ") 0 "ORD",3,19.1) 19.1;3;;;KEY^XPDTA1;KEYF1^XPDIA1;KEYE1^XPDIA1;KEYF2^XPDIA1;;KEYDEL^XPDIA1 "ORD",3,19.1,0) SECURITY KEY "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "ORD",16,8994) 8994;16;1;;;;;;;RPCDEL^XPDIA1 "ORD",16,8994,0) REMOTE PROCEDURE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",213,-1) 1^1 "PKG",213,0) IHS Windows Scheduling^BSDX^IHS Windows Scheduling Extensions "PKG",213,20,0) ^9.402P^^ "PKG",213,22,0) ^9.49I^1^1 "PKG",213,22,1,0) 1.41^3100929 "PKG",213,22,1,1,0) ^^1^1^3100929 "PKG",213,22,1,1,1,0) Clinical Scheduling M Server support routines, files, options and RPCs. "PKG",213,"VERSION") 1.41 "PRE") BSDX2E "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") 37 "RTN","BSDX01") 0^1^B107139484 "RTN","BSDX01",1,0) BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/29/10 10:20am "RTN","BSDX01",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX01",3,0) ; "RTN","BSDX01",4,0) SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point "RTN","BSDX01",5,0) ;D DEBUG^%Serenji("SUINFO^BSDX01(.BSDXY,BSDXDUZ)") "RTN","BSDX01",6,0) ; "RTN","BSDX01",7,0) Q "RTN","BSDX01",8,0) ; "RTN","BSDX01",9,0) SUINFO(BSDXY,BSDXDUZ) ;EP "RTN","BSDX01",10,0) ;Called by BSDX SCHEDULING USER INFO "RTN","BSDX01",11,0) ;Returns ADO Recordset having column MANAGER "RTN","BSDX01",12,0) ;MANAGER = YES if user has keys BSDXZMGR or XUPROGMODE "RTN","BSDX01",13,0) ; "RTN","BSDX01",14,0) N BSDXMGR,BSDXERR "RTN","BSDX01",15,0) K ^BSDXTMP($J) "RTN","BSDX01",16,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX01",17,0) S BSDXI=0 "RTN","BSDX01",18,0) S BSDXERR="" "RTN","BSDX01",19,0) S ^BSDXTMP($J,BSDXI)="T00010MANAGER"_$C(30) "RTN","BSDX01",20,0) ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys "RTN","BSDX01",21,0) I '+BSDXDUZ S BSDXDUZ=DUZ "RTN","BSDX01",22,0) S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ) "RTN","BSDX01",23,0) S BSDXMGR=$S(BSDXMGR=1:"YES",1:"NO") "RTN","BSDX01",24,0) S BSDXI=BSDXI+1 "RTN","BSDX01",25,0) S ^BSDXTMP($J,BSDXI)=BSDXMGR_$C(30) "RTN","BSDX01",26,0) S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR "RTN","BSDX01",27,0) Q "RTN","BSDX01",28,0) DEPUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point "RTN","BSDX01",29,0) ; "RTN","BSDX01",30,0) ; "RTN","BSDX01",31,0) ;D DEBUG^%Serenji("DEPUSR^BSDX01(.BSDXY,BSDXDUZ)") "RTN","BSDX01",32,0) ; "RTN","BSDX01",33,0) Q "RTN","BSDX01",34,0) ; "RTN","BSDX01",35,0) DEPUSR(BSDXY,BSDXDUZ) ;EP "RTN","BSDX01",36,0) ;Called by BSDX RESOURCE GROUPS BY USER "RTN","BSDX01",37,0) ;Returns ADO Recordset with all ACTIVE resource group names to which user has access "RTN","BSDX01",38,0) ;based on entries in BSDX RESOURCE USER file (Say this again for myself: Groups ONLY!!) "RTN","BSDX01",39,0) ;If BSDXDUZ=0 then returns all department names for current DUZ "RTN","BSDX01",40,0) ;if not linked, always returned. "RTN","BSDX01",41,0) ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE "RTN","BSDX01",42,0) ;then ALL resource group names are returned regardless of whether any active resources "RTN","BSDX01",43,0) ;are associated with the group or not. "RTN","BSDX01",44,0) ; "RTN","BSDX01",45,0) ; "RTN","BSDX01",46,0) N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI "RTN","BSDX01",47,0) N BSDXMGR,BSDXNOD "RTN","BSDX01",48,0) K ^BSDXTEMP($J) "RTN","BSDX01",49,0) K ^BSDXTMP($J) "RTN","BSDX01",50,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX01",51,0) S BSDXI=0 "RTN","BSDX01",52,0) S BSDXERR="" "RTN","BSDX01",53,0) S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP"_$C(30) "RTN","BSDX01",54,0) I '+BSDXDUZ S BSDXDUZ=DUZ "RTN","BSDX01",55,0) ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys "RTN","BSDX01",56,0) S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ) "RTN","BSDX01",57,0) ; "RTN","BSDX01",58,0) ;User does not have BSDXZMGR or XUPROGMODE keys, so "RTN","BSDX01",59,0) ;$O THRU AC XREF OF BSDX RESOURCE USER "RTN","BSDX01",60,0) I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D "RTN","BSDX01",61,0) . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U) "RTN","BSDX01",62,0) . Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; If not part of a group, quit ("AB" is the whole file index for the resource multiple in Group file) "RTN","BSDX01",63,0) . ; Q:'$$INDIV2(BSDXRES) ; If not in the same division as user, quit "RTN","BSDX01",64,0) . S BSDXRNOD=^BSDXRES(BSDXRES,0) "RTN","BSDX01",65,0) . ;QUIT if the resource is inactive "RTN","BSDX01",66,0) . Q:$P(BSDXRNOD,U,2)=1 "RTN","BSDX01",67,0) . S BSDXDEP=0 F S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP D "RTN","BSDX01",68,0) . . Q:'$D(^BSDXDEPT(BSDXDEP,0)) "RTN","BSDX01",69,0) . . Q:$D(^BSDXTEMP($J,BSDXDEP)) "RTN","BSDX01",70,0) . . S ^BSDXTEMP($J,BSDXDEP)="" "RTN","BSDX01",71,0) . . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U) "RTN","BSDX01",72,0) . . S BSDXI=BSDXI+1 "RTN","BSDX01",73,0) . . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_$C(30) "RTN","BSDX01",74,0) . . Q "RTN","BSDX01",75,0) . Q "RTN","BSDX01",76,0) ; "RTN","BSDX01",77,0) ;User does have BSDXZMGR or XUPROGMODE keys, so "RTN","BSDX01",78,0) ;$O THRU BSDX RESOURCE GROUP file directly "RTN","BSDX01",79,0) I BSDXMGR S BSDXIEN=0 F S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN D "RTN","BSDX01",80,0) . Q:'$D(^BSDXDEPT(BSDXIEN,0)) "RTN","BSDX01",81,0) . S BSDXNOD=^BSDXDEPT(BSDXIEN,0) "RTN","BSDX01",82,0) . S BSDXDEPN=$P(BSDXNOD,U) "RTN","BSDX01",83,0) . S BSDXI=BSDXI+1 "RTN","BSDX01",84,0) . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_$C(30) "RTN","BSDX01",85,0) . Q "RTN","BSDX01",86,0) ; "RTN","BSDX01",87,0) S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR "RTN","BSDX01",88,0) Q "RTN","BSDX01",89,0) ; "RTN","BSDX01",90,0) ; "RTN","BSDX01",91,0) RESUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point "RTN","BSDX01",92,0) ; "RTN","BSDX01",93,0) ; "RTN","BSDX01",94,0) ;D DEBUG^%Serenji("RESUSR^BSDX01(.BSDXY,BSDXDUZ)") "RTN","BSDX01",95,0) ; "RTN","BSDX01",96,0) Q "RTN","BSDX01",97,0) ; "RTN","BSDX01",98,0) RESUSR(BSDXY,BSDXDUZ) ;EP "RTN","BSDX01",99,0) ;Returns ADO Recordset with ALL RESOURCE names "RTN","BSDX01",100,0) ;Inactive RESOURCES are NOT filtered out "RTN","BSDX01",101,0) ;Called by BSDX RESOURCES BY USER "RTN","BSDX01",102,0) ; "RTN","BSDX01",103,0) N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI,BSDX,BSDXLTR "RTN","BSDX01",104,0) N BSDXNOS,BSDXCAN "RTN","BSDX01",105,0) K ^BSDXTMP($J) "RTN","BSDX01",106,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX01",107,0) S BSDXI=0 "RTN","BSDX01",108,0) S BSDXERR="" "RTN","BSDX01",109,0) S ^BSDXTMP($J,BSDXI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00010INACTIVE^I00010TIMESCALE^I00010HOSPITAL_LOCATION_ID^T00030LETTER_TEXT^T00030NO_SHOW_LETTER" "RTN","BSDX01",110,0) S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^T00030CLINIC_CANCELLATION_LETTER^I00010VIEW^I00010OVERBOOK^I00010MODIFY_SCHEDULE^I00010MODIFY_APPOINTMENTS"_$C(30) "RTN","BSDX01",111,0) I '+BSDXDUZ S BSDXDUZ=DUZ "RTN","BSDX01",112,0) ;$O THRU AC XREF OF BSDX RESOURCE USER "RTN","BSDX01",113,0) ;Rmoved these lines in order to just return all resource names "RTN","BSDX01",114,0) ;I $D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D "RTN","BSDX01",115,0) ;. S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U) "RTN","BSDX01",116,0) ; "RTN","BSDX01",117,0) ;$O THRU BSDX RESOURCE File "RTN","BSDX01",118,0) S BSDXRES=0 F S BSDXRES=$O(^BSDXRES(BSDXRES)) Q:'+BSDXRES D "RTN","BSDX01",119,0) . Q:'$D(^BSDXRES(BSDXRES,0)) "RTN","BSDX01",120,0) . S BSDXRNOD=^BSDXRES(BSDXRES,0) "RTN","BSDX01",121,0) . N BSDXSC S BSDXSC=$P(BSDXRNOD,U,4) ; Hospital Location "RTN","BSDX01",122,0) . ;Q:$P(BSDXRNOD,U,2)=1 ;Inactive resources not filtered "RTN","BSDX01",123,0) . ;S BSDXRDAT=$P(BSDXRNOD,U,1,4) "RTN","BSDX01",124,0) . ;I '$$INDIV(BSDXSC) QUIT ; If not in division, quit "RTN","BSDX01",125,0) . K BSDXRDAT "RTN","BSDX01",126,0) . F BSDX=1:1:4 S $P(BSDXRDAT,U,BSDX)=$P(BSDXRNOD,U,BSDX) "RTN","BSDX01",127,0) . S BSDXRDAT=BSDXRES_U_BSDXRDAT "RTN","BSDX01",128,0) . ;Get letter text from wp field "RTN","BSDX01",129,0) . S BSDXLTR="" "RTN","BSDX01",130,0) . I $D(^BSDXRES(BSDXRES,1)) D "RTN","BSDX01",131,0) . . S BSDXIEN=0 "RTN","BSDX01",132,0) . . F S BSDXIEN=$O(^BSDXRES(BSDXRES,1,BSDXIEN)) Q:'+BSDXIEN D "RTN","BSDX01",133,0) . . . S BSDXLTR=BSDXLTR_$G(^BSDXRES(BSDXRES,1,BSDXIEN,0)) "RTN","BSDX01",134,0) . . . S BSDXLTR=BSDXLTR_$C(13)_$C(10) "RTN","BSDX01",135,0) . S BSDXNOS="" "RTN","BSDX01",136,0) . I $D(^BSDXRES(BSDXRES,12)) D "RTN","BSDX01",137,0) . . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,12,BSDXIEN)) Q:'+BSDXIEN D "RTN","BSDX01",138,0) . . . S BSDXNOS=BSDXNOS_$G(^BSDXRES(BSDXRES,12,BSDXIEN,0)) "RTN","BSDX01",139,0) . . . S BSDXNOS=BSDXNOS_$C(13)_$C(10) "RTN","BSDX01",140,0) . S BSDXCAN="" "RTN","BSDX01",141,0) . I $D(^BSDXRES(BSDXRES,13)) D "RTN","BSDX01",142,0) . . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,13,BSDXIEN)) Q:'+BSDXIEN D "RTN","BSDX01",143,0) . . . S BSDXCAN=BSDXCAN_$G(^BSDXRES(BSDXRES,13,BSDXIEN,0)) "RTN","BSDX01",144,0) . . . S BSDXCAN=BSDXCAN_$C(13)_$C(10) "RTN","BSDX01",145,0) . N BSDXACC,BSDXMGR "RTN","BSDX01",146,0) . S BSDXACC="0^0^0^0" "RTN","BSDX01",147,0) . S BSDXMGR=$O(^DIC(19.1,"B","BSDXZMGR",0)) "RTN","BSDX01",148,0) . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1" "RTN","BSDX01",149,0) . S BSDXMGR=$O(^DIC(19.1,"B","XUPROGMODE",0)) "RTN","BSDX01",150,0) . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1" "RTN","BSDX01",151,0) . I BSDXACC="0^0^0^0" D "RTN","BSDX01",152,0) . . N BSDXNOD,BSDXRUID "RTN","BSDX01",153,0) . . S BSDXRUID=0 "RTN","BSDX01",154,0) . . ;Get entry for this user and resource "RTN","BSDX01",155,0) . . F S BSDXRUID=$O(^BSDXRSU("AC",BSDXDUZ,BSDXRUID)) Q:'+BSDXRUID I $D(^BSDXRSU(BSDXRUID,0)),$P(^(0),U)=BSDXRES Q "RTN","BSDX01",156,0) . . Q:'+BSDXRUID "RTN","BSDX01",157,0) . . S $P(BSDXACC,U)=1 "RTN","BSDX01",158,0) . . S BSDXNOD=$G(^BSDXRSU(BSDXRUID,0)) "RTN","BSDX01",159,0) . . S $P(BSDXACC,U,2)=+$P(BSDXNOD,U,3) "RTN","BSDX01",160,0) . . S $P(BSDXACC,U,3)=+$P(BSDXNOD,U,4) "RTN","BSDX01",161,0) . . S $P(BSDXACC,U,4)=+$P(BSDXNOD,U,5) "RTN","BSDX01",162,0) . S BSDXRDAT=BSDXRDAT_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_U_BSDXACC "RTN","BSDX01",163,0) . S BSDXI=BSDXI+1 "RTN","BSDX01",164,0) . S ^BSDXTMP($J,BSDXI)=BSDXRDAT_$C(30) "RTN","BSDX01",165,0) S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR "RTN","BSDX01",166,0) Q "RTN","BSDX01",167,0) ; "RTN","BSDX01",168,0) DEPRESD(BSDXY,BSDXDUZ) ;EP Debugging entry point "RTN","BSDX01",169,0) ; "RTN","BSDX01",170,0) ; "RTN","BSDX01",171,0) ;D DEBUG^%Serenji("DEPRES^BSDX01(.BSDXY,BSDXDUZ)") "RTN","BSDX01",172,0) ; "RTN","BSDX01",173,0) Q "RTN","BSDX01",174,0) ; "RTN","BSDX01",175,0) DEPRES(BSDXY,BSDXDUZ) ;EP "RTN","BSDX01",176,0) ;Called by BSDX GROUP RESOURCE "RTN","BSDX01",177,0) ;Returns ADO Recordset with all ACTIVE GROUP/RESOURCE combinations "RTN","BSDX01",178,0) ;to which user has access based on entries in BSDX RESOURCE USER file "RTN","BSDX01",179,0) ;If BSDXDUZ=0 then returns all ACTIVE GROUP/RESOURCE combinations for current DUZ "RTN","BSDX01",180,0) ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE "RTN","BSDX01",181,0) ;then ALL ACTIVE resource group names are returned "RTN","BSDX01",182,0) ; "RTN","BSDX01",183,0) N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI "RTN","BSDX01",184,0) N BSDXRESN,BSDXMGR,BSDXRESD,BSDXNOD,BSDXSUBID "RTN","BSDX01",185,0) K ^BSDXTEMP($J) "RTN","BSDX01",186,0) K ^BSDXTMP($J) "RTN","BSDX01",187,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX01",188,0) S BSDXI=0 "RTN","BSDX01",189,0) S BSDXERR="" "RTN","BSDX01",190,0) S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$C(30) "RTN","BSDX01",191,0) I '+BSDXDUZ S BSDXDUZ=DUZ "RTN","BSDX01",192,0) ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys "RTN","BSDX01",193,0) S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ) "RTN","BSDX01",194,0) ; "RTN","BSDX01",195,0) ;User does not have BSDXZMGR or XUPROGMODE keys, so "RTN","BSDX01",196,0) ;$O THRU AC XREF OF BSDX RESOURCE USER "RTN","BSDX01",197,0) I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D "RTN","BSDX01",198,0) . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U) "RTN","BSDX01",199,0) . Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; Quit if Resource isn't part of any Group "RTN","BSDX01",200,0) . ;Q:'$$INDIV2(BSDXRES) ; Quit if Resource isn't in same division as user. "RTN","BSDX01",201,0) . S BSDXRNOD=$G(^BSDXRES(BSDXRES,0)) "RTN","BSDX01",202,0) . Q:BSDXRNOD="" "RTN","BSDX01",203,0) . ;QUIT if the resource is inactive "RTN","BSDX01",204,0) . Q:$P(BSDXRNOD,U,2)=1 "RTN","BSDX01",205,0) . S BSDXRESN=$P(BSDXRNOD,U) "RTN","BSDX01",206,0) . S BSDXDEP=0 F S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP D "RTN","BSDX01",207,0) . . Q:'$D(^BSDXDEPT(BSDXDEP,0)) "RTN","BSDX01",208,0) . . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U) "RTN","BSDX01",209,0) . . S BSDXSUBID=$O(^BSDXDEPT(BSDXDEP,1,"B",BSDXRES,0)) "RTN","BSDX01",210,0) . . S BSDXI=BSDXI+1 "RTN","BSDX01",211,0) . . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_U_BSDXSUBID_U_BSDXRESN_U_BSDXRES_$C(30) "RTN","BSDX01",212,0) . Q "RTN","BSDX01",213,0) ; "RTN","BSDX01",214,0) ;User does have BSDXZMGR or XUPROGMODE keys, so "RTN","BSDX01",215,0) ;$O THRU BSDX RESOURCE GROUP file directly "RTN","BSDX01",216,0) I BSDXMGR S BSDXIEN=0 F S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN D "RTN","BSDX01",217,0) . Q:'$D(^BSDXDEPT(BSDXIEN,0)) "RTN","BSDX01",218,0) . S BSDXNOD=^BSDXDEPT(BSDXIEN,0) "RTN","BSDX01",219,0) . S BSDXDEPN=$P(BSDXNOD,U) "RTN","BSDX01",220,0) . S BSDXRES=0 F S BSDXRES=$O(^BSDXDEPT(BSDXIEN,1,BSDXRES)) Q:'+BSDXRES D "RTN","BSDX01",221,0) . . N BSDXRESD "RTN","BSDX01",222,0) . . Q:'$D(^BSDXDEPT(BSDXIEN,1,BSDXRES,0)) ; Quit if zero node is invalid in multiple "RTN","BSDX01",223,0) . . S BSDXRESD=$P(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^") "RTN","BSDX01",224,0) . . Q:'$D(^BSDXRES(BSDXRESD,0)) ; Quit if zero node of resouce file is invalid "RTN","BSDX01",225,0) . . ;Q:'$$INDIV2(BSDXRESD) ; Quit if resource is not in the same division "RTN","BSDX01",226,0) . . S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0)) "RTN","BSDX01",227,0) . . Q:BSDXRNOD="" "RTN","BSDX01",228,0) . . ;QUIT if the resource is inactive "RTN","BSDX01",229,0) . . Q:$P(BSDXRNOD,U,2)=1 "RTN","BSDX01",230,0) . . S BSDXRESN=$P(BSDXRNOD,U) "RTN","BSDX01",231,0) . . S BSDXI=BSDXI+1 "RTN","BSDX01",232,0) . . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_U_BSDXRES_U_BSDXRESN_U_BSDXRESD_$C(30) "RTN","BSDX01",233,0) . . Q "RTN","BSDX01",234,0) . Q "RTN","BSDX01",235,0) ; "RTN","BSDX01",236,0) S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR "RTN","BSDX01",237,0) Q "RTN","BSDX01",238,0) ; "RTN","BSDX01",239,0) APSEC(BSDXKEY,BSDXDUZ) ;EP - Return TRUE (1) if user has keys BSDXKEY or XUPROGMODE, otherwise, returns FALSE (0) "RTN","BSDX01",240,0) ; "RTN","BSDX01",241,0) N BSDXIEN,BSDXPROG,BSDXPKEY "RTN","BSDX01",242,0) I '$G(BSDXDUZ) Q 0 "RTN","BSDX01",243,0) ; "RTN","BSDX01",244,0) ;Test for programmer mode key "RTN","BSDX01",245,0) S BSDXPROG=0 "RTN","BSDX01",246,0) I $D(^DIC(19.1,"B","XUPROGMODE")) D "RTN","BSDX01",247,0) . S BSDXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0)) "RTN","BSDX01",248,0) . I '+BSDXPKEY Q "RTN","BSDX01",249,0) . I '$D(^VA(200,BSDXDUZ,51,BSDXPKEY,0)) Q "RTN","BSDX01",250,0) . S BSDXPROG=1 "RTN","BSDX01",251,0) I BSDXPROG Q 1 "RTN","BSDX01",252,0) ; "RTN","BSDX01",253,0) I BSDXKEY="" Q 0 "RTN","BSDX01",254,0) I '$D(^DIC(19.1,"B",BSDXKEY)) Q 0 "RTN","BSDX01",255,0) S BSDXIEN=$O(^DIC(19.1,"B",BSDXKEY,0)) "RTN","BSDX01",256,0) I '+BSDXIEN Q 0 "RTN","BSDX01",257,0) I '$D(^VA(200,BSDXDUZ,51,BSDXIEN,0)) Q 0 "RTN","BSDX01",258,0) Q 1 "RTN","BSDX01",259,0) INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user? "RTN","BSDX01",260,0) ; Input: BSDXSC - Hospital Location IEN "RTN","BSDX01",261,0) ; Output: True or False "RTN","BSDX01",262,0) I '+BSDXSC QUIT 1 ;If not tied to clinic, yes "RTN","BSDX01",263,0) I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes "RTN","BSDX01",264,0) ; Jump to Division:Medical Center Division:Inst File Pointer for "RTN","BSDX01",265,0) ; Institution IEN (and get its internal value) "RTN","BSDX01",266,0) N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I") "RTN","BSDX01",267,0) I DIV="" Q 1 ; If clinic has no division, consider it avial to user. "RTN","BSDX01",268,0) I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic "RTN","BSDX01",269,0) E Q 0 ; Otherwise, no "RTN","BSDX01",270,0) QUIT "RTN","BSDX01",271,0) INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user? "RTN","BSDX01",272,0) ; Input BSDXRES - BSDX RESOURCE IEN "RTN","BSDX01",273,0) ; Output: True of False "RTN","BSDX01",274,0) Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV "RTN","BSDX01",275,0) UnitTestINDIV "RTN","BSDX01",276,0) W "Testing if they are the same",! "RTN","BSDX01",277,0) S DUZ(2)=67 "RTN","BSDX01",278,0) I '$$INDIV(1) W "ERROR",! "RTN","BSDX01",279,0) I '$$INDIV(2) W "ERROR",! "RTN","BSDX01",280,0) W "Testing if Div not defined in 44, should be true",! "RTN","BSDX01",281,0) I '$$INDIV(3) W "ERROR",! "RTN","BSDX01",282,0) W "Testing empty string. Should be true",! "RTN","BSDX01",283,0) I '$$INDIV("") W "ERROR",! "RTN","BSDX01",284,0) W "Testing if they are different",! "RTN","BSDX01",285,0) S DUZ(2)=899 "RTN","BSDX01",286,0) I $$INDIV(1) W "ERROR",! "RTN","BSDX01",287,0) I $$INDIV(2) W "ERROR",! "RTN","BSDX01",288,0) QUIT "RTN","BSDX01",289,0) UnitTestINDIV2 "RTN","BSDX01",290,0) W "Testing if they are the same",! "RTN","BSDX01",291,0) S DUZ(2)=69 "RTN","BSDX01",292,0) I $$INDIV2(22)'=0 W "ERROR",! "RTN","BSDX01",293,0) I $$INDIV2(25)'=1 W "ERROR",! "RTN","BSDX01",294,0) I $$INDIV2(26)'=1 W "ERROR",! "RTN","BSDX01",295,0) I $$INDIV2(27)'=1 W "ERROR",! "RTN","BSDX01",296,0) QUIT "RTN","BSDX02") 0^2^B16323271 "RTN","BSDX02",1,0) BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:25pm "RTN","BSDX02",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX02",3,0) ; "RTN","BSDX02",4,0) ; Change Log "RTN","BSDX02",5,0) ; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n "RTN","BSDX02",6,0) ; "RTN","BSDX02",7,0) ; "RTN","BSDX02",8,0) CRSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND) ;EP "RTN","BSDX02",9,0) ;Entry point for debugging "RTN","BSDX02",10,0) ; "RTN","BSDX02",11,0) ;D DEBUG^%Serenji("CRSCH^BSDX02(.BSDXY,BSDXRES,BSDXSTART,BSDXEND)") "RTN","BSDX02",12,0) Q "RTN","BSDX02",13,0) ; "RTN","BSDX02",14,0) CRSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXWKIN) ; "RTN","BSDX02",15,0) ;Called by BSDX CREATE APPT SCHEDULE "RTN","BSDX02",16,0) ;Create Resource Appointment Schedule recordset "RTN","BSDX02",17,0) ;On error, returns 0 in APPOINTMENTID field and error text in NOTE field "RTN","BSDX02",18,0) ; "RTN","BSDX02",19,0) ;$O Thru ^BSDXAPPT("ARSRC", RESOURCE, STARTTIME, APPTID) "RTN","BSDX02",20,0) ;BMXRES is a | delimited list of resource names "RTN","BSDX02",21,0) ;BSDXWKIN - If 1, then return walkins, otherwise skip them "RTN","BSDX02",22,0) ;9-27-2004 Added walkin to returned datatable "RTN","BSDX02",23,0) ;TODO: Change BSDXRES from names to IDs "RTN","BSDX02",24,0) ; "RTN","BSDX02",25,0) N BSDXERR,BSDXIEN,BSDXDEPD,BSDXDEPN,BSDXRESD,BSDXI,BSDXJ,BSDXRESN,BSDXS,BSDXAD,BSDXZ,BSDXQ,BSDXNOD "RTN","BSDX02",26,0) N BSDXPAT,BSDXNOT,BSDXZPCD,BSDXPCD "RTN","BSDX02",27,0) K ^BSDXTMP($J) "RTN","BSDX02",28,0) S BSDXERR="" "RTN","BSDX02",29,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX02",30,0) S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE"_$C(30) "RTN","BSDX02",31,0) D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP") "RTN","BSDX02",32,0) ; "RTN","BSDX02",33,0) ; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y "RTN","BSDX02",34,0) ; I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q "RTN","BSDX02",35,0) ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y "RTN","BSDX02",36,0) ; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q "RTN","BSDX02",37,0) ; "RTN","BSDX02",38,0) S BSDXI=0 "RTN","BSDX02",39,0) D STRES "RTN","BSDX02",40,0) ; "RTN","BSDX02",41,0) S BSDXI=BSDXI+1 "RTN","BSDX02",42,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX02",43,0) Q "RTN","BSDX02",44,0) ; "RTN","BSDX02",45,0) STRES ; "RTN","BSDX02",46,0) F BSDXJ=1:1:$L(BSDXRES,"|") S BSDXRESN=$P(BSDXRES,"|",BSDXJ) D "RTN","BSDX02",47,0) . Q:BSDXRESN="" "RTN","BSDX02",48,0) . Q:'$D(^BSDXRES("B",BSDXRESN)) "RTN","BSDX02",49,0) . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0)) "RTN","BSDX02",50,0) . Q:'+BSDXRESD "RTN","BSDX02",51,0) . Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD)) "RTN","BSDX02",52,0) . S BSDXS=BSDXSTART-.0001 "RTN","BSDX02",53,0) . F S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D "RTN","BSDX02",54,0) . . S BSDXAD=0 F S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D STCOMM(BSDXAD,BSDXRESN) "RTN","BSDX02",55,0) Q "RTN","BSDX02",56,0) ; "RTN","BSDX02",57,0) STCOMM(BSDXAD,BSDXRESN) ; "RTN","BSDX02",58,0) ;BSDXAD is the appointment IEN "RTN","BSDX02",59,0) N BSDXC,BSDXQ,BSDXZ,BSDXSUBC,BSDXHRN,BSDXPATD,BSDXATID,BSDXISWK "RTN","BSDX02",60,0) Q:'$D(^BSDXAPPT(BSDXAD,0)) "RTN","BSDX02",61,0) S BSDXNOD=^BSDXAPPT(BSDXAD,0) "RTN","BSDX02",62,0) Q:$P(BSDXNOD,U,12)]"" ;CANCELLED "RTN","BSDX02",63,0) S BSDXISWK=0 "RTN","BSDX02",64,0) S:$P(BSDXNOD,U,13)="y" BSDXISWK=1 "RTN","BSDX02",65,0) I +$G(BSDXWKIN) Q:BSDXISWK ;Don't return walkins if appt is WALKIN and BSDXWKIN is 1 "RTN","BSDX02",66,0) S BSDXZ=BSDXAD_"^" "RTN","BSDX02",67,0) F BSDXQ=1:1:4 D "RTN","BSDX02",68,0) . S Y=$P(BSDXNOD,U,BSDXQ) "RTN","BSDX02",69,0) . X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX02",70,0) . S BSDXZ=BSDXZ_Y_"^" "RTN","BSDX02",71,0) S BSDXPATD=$P(BSDXNOD,U,5) "RTN","BSDX02",72,0) S BSDXZ=BSDXZ_BSDXPATD_"^" ;PATIENT ID "RTN","BSDX02",73,0) S BSDXPAT="" "RTN","BSDX02",74,0) I BSDXPATD]"",$D(^DPT(BSDXPATD,0)) S BSDXPAT=$P(^DPT(BSDXPATD,0),U) "RTN","BSDX02",75,0) S BSDXZ=BSDXZ_BSDXPAT_"^" ;PATIENT NAME "RTN","BSDX02",76,0) S BSDXZ=BSDXZ_BSDXRESN_"^" ;RESOURCENAME "RTN","BSDX02",77,0) S BSDXZ=BSDXZ_+$P(BSDXNOD,U,10)_"^" ;NOSHOW "RTN","BSDX02",78,0) S BSDXHRN="" "RTN","BSDX02",79,0) I $D(DUZ(2)),DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPATD,41,DUZ(2),0)),U,2) ;HRN "RTN","BSDX02",80,0) S BSDXZ=BSDXZ_BSDXHRN_"^" "RTN","BSDX02",81,0) S BSDXATID=$P(BSDXNOD,U,6) "RTN","BSDX02",82,0) S:'+BSDXATID BSDXATID=0 ;UNKNOWN TYPE "RTN","BSDX02",83,0) S BSDXZ=BSDXZ_BSDXATID_"^"_BSDXISWK_"^" "RTN","BSDX02",84,0) S BSDXI=BSDXI+1 "RTN","BSDX02",85,0) S ^BSDXTMP($J,BSDXI)=BSDXZ "RTN","BSDX02",86,0) ;NOTE "RTN","BSDX02",87,0) S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXAD,1,BSDXQ)) Q:'+BSDXQ D "RTN","BSDX02",88,0) . S BSDXNOT=$G(^BSDXAPPT(BSDXAD,1,BSDXQ,0)) "RTN","BSDX02",89,0) . S:$E(BSDXNOT,$L(BSDXNOT)-1,$L(BSDXNOT))'=" " BSDXNOT=BSDXNOT_" " "RTN","BSDX02",90,0) . S BSDXI=BSDXI+1 "RTN","BSDX02",91,0) . S ^BSDXTMP($J,BSDXI)=BSDXNOT "RTN","BSDX02",92,0) S BSDXI=BSDXI+1 "RTN","BSDX02",93,0) S ^BSDXTMP($J,BSDXI)=$C(30) "RTN","BSDX02",94,0) Q "RTN","BSDX02",95,0) ; "RTN","BSDX02",96,0) ERR(BSDXI,BSDXERR) ;Error processing "RTN","BSDX02",97,0) S BSDXI=BSDXI+1 "RTN","BSDX02",98,0) S ^BSDXTMP($J,BSDXI)="0^^^^^^^^^^^"_BSDXERR_$C(30) "RTN","BSDX02",99,0) S BSDXI=BSDXI+1 "RTN","BSDX02",100,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX02",101,0) Q "RTN","BSDX02",102,0) ; "RTN","BSDX02",103,0) ETRAP ;EP Error trap entry "RTN","BSDX02",104,0) D ^%ZTER "RTN","BSDX02",105,0) I '$D(BSDXI) N BSDXI S BSDXI=999999 "RTN","BSDX02",106,0) S BSDXI=BSDXI+1 "RTN","BSDX02",107,0) D ERR(BSDXI,"BSDX31 Error: "_$G(%ZTERROR)) "RTN","BSDX02",108,0) Q "RTN","BSDX03") 0^3^B2855259 "RTN","BSDX03",1,0) BSDX03 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX03",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX03",3,0) ; "RTN","BSDX03",4,0) ; "RTN","BSDX03",5,0) Q "RTN","BSDX03",6,0) ; "RTN","BSDX03",7,0) XR2S(BSDXDA) ;EP "RTN","BSDX03",8,0) ;XR2 is the ARSRC xref for the "RTN","BSDX03",9,0) ;RESOURCE field of the BSDX APPOINTMENT file "RTN","BSDX03",10,0) ;Format is ^BSDXAPPT("ARSRC",RESOURCEID,STARTTIME,APPTID) "RTN","BSDX03",11,0) Q:'$D(^BSDXAPPT(BSDXDA,0)) "RTN","BSDX03",12,0) N BSDXNOD,BSDXAPPID,BSDXRSID,BSDXS "RTN","BSDX03",13,0) S BSDXNOD=^BSDXAPPT(BSDXDA,0) "RTN","BSDX03",14,0) S BSDXAPPID=BSDXDA "RTN","BSDX03",15,0) S BSDXRSID=$P(BSDXNOD,U,7) "RTN","BSDX03",16,0) Q:'+BSDXAPPID>0 "RTN","BSDX03",17,0) Q:'+BSDXRSID>0 "RTN","BSDX03",18,0) S BSDXS=$P(BSDXNOD,U) "RTN","BSDX03",19,0) Q:'+BSDXS "RTN","BSDX03",20,0) S ^BSDXAPPT("ARSRC",BSDXRSID,BSDXS,BSDXAPPID)="" "RTN","BSDX03",21,0) Q "RTN","BSDX03",22,0) ; "RTN","BSDX03",23,0) XR2K(BSDXA) ;EP "RTN","BSDX03",24,0) Q:'$D(^BSDXAPPT(BSDXA,0)) "RTN","BSDX03",25,0) N BSDXNOD,BSDXAPPID,BSDXRSID,BSDXS "RTN","BSDX03",26,0) S BSDXNOD=^BSDXAPPT(BSDXA,0) "RTN","BSDX03",27,0) S BSDXAPPID=BSDXA "RTN","BSDX03",28,0) S BSDXRSID=$P(BSDXNOD,U,7) "RTN","BSDX03",29,0) S BSDXS=$P(BSDXNOD,U) "RTN","BSDX03",30,0) Q:'+BSDXAPPID>0 "RTN","BSDX03",31,0) Q:'+BSDXRSID>0 "RTN","BSDX03",32,0) Q:'+BSDXS>0 "RTN","BSDX03",33,0) K ^BSDXAPPT("ARSRC",BSDXRSID,BSDXS,BSDXAPPID) "RTN","BSDX03",34,0) Q "RTN","BSDX03",35,0) XR4S(BSDXDA) ;EP "RTN","BSDX03",36,0) ;XR4 is the ARSCT xref for the "RTN","BSDX03",37,0) ;STARTTIME field of the BSDX ACCESS BLOCK file "RTN","BSDX03",38,0) ;Format is ^BSDXAB("ARSCT",RESOURCEID,STARTTIME,DA) "RTN","BSDX03",39,0) Q:'$D(^BSDXAB(BSDXDA,0)) "RTN","BSDX03",40,0) N BSDXNOD,BSDXR,BSDXS "RTN","BSDX03",41,0) S BSDXNOD=^BSDXAB(BSDXDA,0) "RTN","BSDX03",42,0) S BSDXR=$P(BSDXNOD,U) "RTN","BSDX03",43,0) S BSDXS=$P(BSDXNOD,U,2) "RTN","BSDX03",44,0) Q:'+BSDXR>0 "RTN","BSDX03",45,0) Q:'+BSDXS>0 "RTN","BSDX03",46,0) S ^BSDXAB("ARSCT",BSDXR,BSDXS,BSDXDA)="" "RTN","BSDX03",47,0) Q "RTN","BSDX03",48,0) ; "RTN","BSDX03",49,0) XR4K(BSDXDA) ;EP "RTN","BSDX03",50,0) Q:'$D(^BSDXAB(BSDXDA,0)) "RTN","BSDX03",51,0) N BSDXNOD,BSDXR,BSDXS "RTN","BSDX03",52,0) S BSDXNOD=^BSDXAB(BSDXDA,0) "RTN","BSDX03",53,0) S BSDXR=$P(BSDXNOD,U) "RTN","BSDX03",54,0) S BSDXS=$P(BSDXNOD,U,2) "RTN","BSDX03",55,0) Q:'+BSDXR>0 "RTN","BSDX03",56,0) Q:'+BSDXS>0 "RTN","BSDX03",57,0) K ^BSDXAB("ARSCT",BSDXR,BSDXS,BSDXDA) "RTN","BSDX03",58,0) Q "RTN","BSDX04") 0^4^B31079316 "RTN","BSDX04",1,0) BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/15/10 12:44pm "RTN","BSDX04",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX04",3,0) ; Change Log: "RTN","BSDX04",4,0) ; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates "RTN","BSDX04",5,0) ; for i18n "RTN","BSDX04",6,0) ; "RTN","BSDX04",7,0) ; "RTN","BSDX04",8,0) CASSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP "RTN","BSDX04",9,0) ; "RTN","BSDX04",10,0) ;D DEBUG^%Serenji("CASSCH^BSDX04(.BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH)") "RTN","BSDX04",11,0) ; "RTN","BSDX04",12,0) Q "RTN","BSDX04",13,0) ; "RTN","BSDX04",14,0) CASSET ;EP "RTN","BSDX04",15,0) ;Error Trap "RTN","BSDX04",16,0) D ^%ZTER "RTN","BSDX04",17,0) I '$D(BSDXI) N BSDXI S BSDXI=99999 "RTN","BSDX04",18,0) S BSDXI=BSDXI+1 "RTN","BSDX04",19,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX04",20,0) Q "RTN","BSDX04",21,0) ; "RTN","BSDX04",22,0) CASSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP "RTN","BSDX04",23,0) ;Called by BSDX CREATE ASGND SLOT SCHED "RTN","BSDX04",24,0) ;Create Assigned Slot Schedule recordset "RTN","BSDX04",25,0) ;This call is used both to create a schedule of availability for the calendar display "RTN","BSDX04",26,0) ;and to search for availability in the Find Appointment function "RTN","BSDX04",27,0) ; "RTN","BSDX04",28,0) ;BSDXRES is resource name "RTN","BSDX04",29,0) ; "RTN","BSDX04",30,0) ;//smh "RTN","BSDX04",31,0) ; BSDXSTART and BSDXEND both passed in FM Format. "RTN","BSDX04",32,0) ; BSDXSTART is the Date Portion of FM Date "RTN","BSDX04",33,0) ; BSDXEND -- pass date and h,m,s as well "RTN","BSDX04",34,0) ;//smh "RTN","BSDX04",35,0) ; "RTN","BSDX04",36,0) ;BSDXTYPES is |-delimited list of Access Type Names "RTN","BSDX04",37,0) ;If BSDXTYPES is "" then the screen passes all types. "RTN","BSDX04",38,0) ; "RTN","BSDX04",39,0) ;BSDXSRCH is |-delimited search info for the Find Appointment function "RTN","BSDX04",40,0) ;First piece is 1 if we are in a Find Appointment call "RTN","BSDX04",41,0) ;Second piece is weekday info in the format MTWHFSU "RTN","BSDX04",42,0) ;Third piece is AM PM info in the form AP "RTN","BSDX04",43,0) ;If 2nd or 3rd pieces are null, the screen for that piece is skipped "RTN","BSDX04",44,0) ; "RTN","BSDX04",45,0) ;Test lines: "RTN","BSDX04",46,0) ;D CASSCH^BSDX04(.RES,"REMILLARD,MIKE","","") ZW RES "RTN","BSDX04",47,0) ;BSDX CREATE ASGND SLOT SCHED^ROGERS,BUCK^^^2 "RTN","BSDX04",48,0) ;S ^HW("BSDX04")=BSDXRES_U_BSDXSTART_U_BSDXEND "RTN","BSDX04",49,0) ; "RTN","BSDX04",50,0) N BSDXERR,BSDXIEN,BSDXDEP,BSDXTYPED,BSDXTYPE,BSDXALO,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXZ,BSDXTMP,BSDXQ,BSDXNOT,BSDXNOD,BSDXAD "RTN","BSDX04",51,0) N BSDXSUBCD "RTN","BSDX04",52,0) S X="CASSET^BSDX04",@^%ZOSF("TRAP") "RTN","BSDX04",53,0) K ^BSDXTMP($J) "RTN","BSDX04",54,0) S BSDXERR="" "RTN","BSDX04",55,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX04",56,0) S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME^I00010SLOTS^T00030RESOURCE^T00010ACCESS_TYPE^T00250NOTE^I00030AVAILABILITYID"_$C(30) "RTN","BSDX04",57,0) S BSDXALO=0,BSDXI=2 "RTN","BSDX04",58,0) ; "RTN","BSDX04",59,0) ;Get Access Type IDs "RTN","BSDX04",60,0) N BSDXK,BSDXTYPED,BSDXL "RTN","BSDX04",61,0) I '+BSDXSRCH S BSDXTYPED="" "RTN","BSDX04",62,0) I +BSDXSRCH F BSDXK=1:1:$L(BSDXTYPES,"|") D "RTN","BSDX04",63,0) . S BSDXL=$P(BSDXTYPES,"|",BSDXK) "RTN","BSDX04",64,0) . I BSDXL="" S $P(BSDXTYPED,"|",BSDXK)=0 Q "RTN","BSDX04",65,0) . I '$D(^BSDXTYPE("B",BSDXL)) S $P(BSDXTYPED,"|",BSDXK)=0 Q "RTN","BSDX04",66,0) . S $P(BSDXTYPED,"|",BSDXK)=$O(^BSDXTYPE("B",BSDXL,0)) "RTN","BSDX04",67,0) ; "RTN","BSDX04",68,0) D "RTN","BSDX04",69,0) . S BSDXBS=0 "RTN","BSDX04",70,0) . S BSDXRESN=BSDXRES "RTN","BSDX04",71,0) . Q:BSDXRESN="" "RTN","BSDX04",72,0) . Q:'$D(^BSDXRES("B",BSDXRESN)) "RTN","BSDX04",73,0) . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0)) Q:'+BSDXRESD "RTN","BSDX04",74,0) . Q:'$D(^BSDXAB("ARSCT",BSDXRESD)) "RTN","BSDX04",75,0) . D STRES(BSDXRESN,BSDXRESD) "RTN","BSDX04",76,0) . Q "RTN","BSDX04",77,0) ; "RTN","BSDX04",78,0) ;start, end, slots, resource, accesstype, note, availabilityid "RTN","BSDX04",79,0) ;I '+BSDXSRCH,BSDXALO D "RTN","BSDX04",80,0) I BSDXALO D "RTN","BSDX04",81,0) . ;If first block start time > input start time then pad with new block "RTN","BSDX04",82,0) . I BSDXBS>BSDXSTART K BSDXTMP D "RTN","BSDX04",83,0) . . S Y=BSDXSTART X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX04",84,0) . . S BSDXTMP=Y "RTN","BSDX04",85,0) . . S Y=BSDXBS X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX04",86,0) . . S BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$C(30) "RTN","BSDX04",87,0) . . S ^BSDXTMP($J,1)=BSDXTMP "RTN","BSDX04",88,0) . ; "RTN","BSDX04",89,0) . ;If first block start time < input start time then trim "RTN","BSDX04",90,0) . I BSDXBSBSDXEND D "RTN","BSDX04",112,0) . S BSDXAD=0 F S BSDXAD=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D STCOMM(BSDXRESN,BSDXRESD,BSDXS,BSDXAD) ;BSDXAD Is the AvailabilityID "RTN","BSDX04",113,0) . Q "RTN","BSDX04",114,0) Q "RTN","BSDX04",115,0) ; "RTN","BSDX04",116,0) STCOMM(BSDXRESN,BSDXRESD,BSDXS,BSDXAD) ; "RTN","BSDX04",117,0) N BSDXNSTART,BSDXNEND,BSDXNOD,Y,BSDXQ,BSDXZ,BSDXATID,BSDXATOK "RTN","BSDX04",118,0) Q:'$D(^BSDXAB(BSDXAD,0)) "RTN","BSDX04",119,0) S BSDXNOD=^BSDXAB(BSDXAD,0) "RTN","BSDX04",120,0) S BSDXATID=$P(BSDXNOD,U,5) "RTN","BSDX04",121,0) ; "RTN","BSDX04",122,0) ;Screen for Access Type "RTN","BSDX04",123,0) ;S BSDXATOK=0 "RTN","BSDX04",124,0) ;I BSDXTYPED="" S BSDXATOK=1 "RTN","BSDX04",125,0) ;E D "RTN","BSDX04",126,0) ;. F J=1:1:$L(BSDXTYPED,"|") I BSDXATID=$P(BSDXTYPED,"|",J) S BSDXATOK=1 Q "RTN","BSDX04",127,0) ;Q:'BSDXATOK "RTN","BSDX04",128,0) ; "RTN","BSDX04",129,0) ;I +BSDXSRCH "RTN","BSDX04",130,0) ;Screen for Weekday "RTN","BSDX04",131,0) ; "RTN","BSDX04",132,0) ;Screen for AM PM "RTN","BSDX04",133,0) ; "RTN","BSDX04",134,0) S BSDXZ="" "RTN","BSDX04",135,0) S BSDXNSTART=$P(BSDXNOD,U,2) "RTN","BSDX04",136,0) S BSDXNEND=$P(BSDXNOD,U,3) "RTN","BSDX04",137,0) I BSDXNEND'>BSDXSTART Q ;End is less than start "RTN","BSDX04",138,0) I +BSDXBS=0 S BSDXBS=$P(BSDXNOD,U,2) ;First block start time "RTN","BSDX04",139,0) F BSDXQ=2:1:3 D ;Start and End times "RTN","BSDX04",140,0) . S Y=$P(BSDXNOD,U,BSDXQ) "RTN","BSDX04",141,0) . X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX04",142,0) . S BSDXZ=BSDXZ_Y_"^" "RTN","BSDX04",143,0) S BSDXZ=BSDXZ_$P(BSDXNOD,U,4)_"^" ;SLOTS "RTN","BSDX04",144,0) S BSDXZ=BSDXZ_BSDXRESN_"^" ;Resource name "RTN","BSDX04",145,0) S BSDXZ=BSDXZ_BSDXATID_"^" ;Access type ID "RTN","BSDX04",146,0) S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAB(BSDXAD,1,BSDXQ)) Q:'+BSDXQ D "RTN","BSDX04",147,0) . S BSDXNOT=BSDXNOT_$G(^BSDXAB(BSDXAD,1,BSDXQ,0))_" " "RTN","BSDX04",148,0) S BSDXZ=BSDXZ_BSDXNOT ;_"^" "RTN","BSDX04",149,0) ;I '+BSDXSRCH,BSDXPEND,BSDXNSTART>BSDXPEND D ;Fill in gap between appointment "RTN","BSDX04",150,0) I BSDXPEND,BSDXNSTART>BSDXPEND D ;Fill in gap between appointment "RTN","BSDX04",151,0) . S Y=BSDXPEND X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX04",152,0) . S BSDXTMP=Y "RTN","BSDX04",153,0) . S Y=BSDXNSTART X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX04",154,0) . S BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$C(30) "RTN","BSDX04",155,0) . S ^BSDXTMP($J,BSDXI-1)=BSDXTMP "RTN","BSDX04",156,0) S BSDXPEND=BSDXNEND "RTN","BSDX04",157,0) S ^BSDXTMP($J,BSDXI)=BSDXZ_"^"_BSDXAD_$C(30) "RTN","BSDX04",158,0) S BSDXI=BSDXI+2 "RTN","BSDX04",159,0) S BSDXALO=1 ;At Least One record will be returned "RTN","BSDX04",160,0) Q "RTN","BSDX05") 0^5^B6801706 "RTN","BSDX05",1,0) BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:51pm "RTN","BSDX05",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX05",3,0) ; "RTN","BSDX05",4,0) ; Change Log: "RTN","BSDX05",5,0) ; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates "RTN","BSDX05",6,0) ; "RTN","BSDX05",7,0) APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES) ;EP "RTN","BSDX05",8,0) ;Called by BSDX APPT BLOCKS OVERLAP "RTN","BSDX05",9,0) ; July 11 2010 - pass FM Dates for Start and End rather than US Dates "RTN","BSDX05",10,0) ;(Duplicates old qryAppointmentBlocksOverlapB) "RTN","BSDX05",11,0) ;BSDXRES is resource name "RTN","BSDX05",12,0) ; "RTN","BSDX05",13,0) ;Test lines: "RTN","BSDX05",14,0) ;D APBLKOV^BSDX05(.RES,"11-8-2000","11-8-2004","WHITT") ZW RES "RTN","BSDX05",15,0) ;BSDX APPT BLOCKS OVERLAP^11-8-2000^11-8-2004^WHITT "RTN","BSDX05",16,0) ;S ^HW("BSDXD05")=BSDXSTART_U_BSDXEND_U_BSDXRES "RTN","BSDX05",17,0) ; "RTN","BSDX05",18,0) N BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXAD,BSDXNOD "RTN","BSDX05",19,0) K ^BSDXTMP($J) "RTN","BSDX05",20,0) S BSDXERR="" "RTN","BSDX05",21,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX05",22,0) S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME"_$C(30) "RTN","BSDX05",23,0) D "RTN","BSDX05",24,0) . S BSDXBS=0 "RTN","BSDX05",25,0) . S BSDXEND=BSDXEND+.9999 ;Go to end of day "RTN","BSDX05",26,0) . S BSDXRESN=BSDXRES "RTN","BSDX05",27,0) . Q:BSDXRESN="" "RTN","BSDX05",28,0) . Q:'$D(^BSDXRES("B",BSDXRESN)) "RTN","BSDX05",29,0) . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0)) "RTN","BSDX05",30,0) . Q:'+BSDXRESD "RTN","BSDX05",31,0) . Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD)) "RTN","BSDX05",32,0) . D STRES(BSDXRESD,BSDXSTART,BSDXEND) "RTN","BSDX05",33,0) . Q "RTN","BSDX05",34,0) ; "RTN","BSDX05",35,0) S BSDXI=$G(BSDXI)+1 "RTN","BSDX05",36,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX05",37,0) Q "RTN","BSDX05",38,0) ; "RTN","BSDX05",39,0) STRES(BSDXRESD,BSDXSTART,BSDXEND) ; "RTN","BSDX05",40,0) ;$O THRU "ARSRC" XREF OF ^BSDXAPPT "RTN","BSDX05",41,0) ;Start at the beginning of the day -- appts can't overlap days "RTN","BSDX05",42,0) S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001 "RTN","BSDX05",43,0) S BSDXI=0 "RTN","BSDX05",44,0) F S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D "RTN","BSDX05",45,0) . S BSDXAD=0 F S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D STCOMM(BSDXAD) ;BSDXAD Is the AppointmentID "RTN","BSDX05",46,0) . Q "RTN","BSDX05",47,0) Q "RTN","BSDX05",48,0) ; "RTN","BSDX05",49,0) STCOMM(BSDXAD) ; "RTN","BSDX05",50,0) S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0 "RTN","BSDX05",51,0) Q:'$D(^BSDXAPPT(BSDXAD,0)) "RTN","BSDX05",52,0) S BSDXNOD=^BSDXAPPT(BSDXAD,0) "RTN","BSDX05",53,0) Q:$P(BSDXNOD,U,10)=1 ;NO-SHOW Flag "RTN","BSDX05",54,0) Q:$P(BSDXNOD,U,12)]"" ;CANCELLED APPT "RTN","BSDX05",55,0) Q:$P(BSDXNOD,U,13)="y" ;WALKIN "RTN","BSDX05",56,0) S BSDXNSTART=$P(BSDXNOD,U) "RTN","BSDX05",57,0) S BSDXNEND=$P(BSDXNOD,U,2) "RTN","BSDX05",58,0) I BSDXNEND'>BSDXSTART Q ;End is less than start "RTN","BSDX05",59,0) S Y=BSDXNSTART X ^DD("DD") S BSDXNSTART=$TR(Y,"@"," ") "RTN","BSDX05",60,0) S Y=BSDXNEND X ^DD("DD") S BSDXNEND=$TR(Y,"@"," ") "RTN","BSDX05",61,0) S BSDXI=BSDXI+1 "RTN","BSDX05",62,0) S ^BSDXTMP($J,BSDXI)=BSDXNSTART_U_BSDXNEND_$C(30) "RTN","BSDX05",63,0) Q "RTN","BSDX06") 0^6^B6812445 "RTN","BSDX06",1,0) BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 4:51pm "RTN","BSDX06",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX06",3,0) ; Change Log: "RTN","BSDX06",4,0) ; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get "RTN","BSDX06",5,0) ; dates in FM format for i18n "RTN","BSDX06",6,0) ; "RTN","BSDX06",7,0) ; "RTN","BSDX06",8,0) TPBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES) ;EP "RTN","BSDX06",9,0) ;Called by BSDXD TYPE BLOCKS OVERLAP "RTN","BSDX06",10,0) ;(Duplicates old qryTypeBlocksOverlapB) "RTN","BSDX06",11,0) ;BSDXRES is resource name "RTN","BSDX06",12,0) ; "RTN","BSDX06",13,0) ;Test lines: "RTN","BSDX06",14,0) ;D TPBLKOV^BSDX06(.RES,"3030513","3030516","REMILLARD,MIKE") ZW RES "RTN","BSDX06",15,0) ;BSDX TYPE BLOCKS OVERLAP^303513^3030516^REMILLARD,MIKE "RTN","BSDX06",16,0) ;S ^HW("BSDXD06")=BSDXSTART_U_BSDXEND_U_BSDXRES "RTN","BSDX06",17,0) ; "RTN","BSDX06",18,0) N BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXTPID,BSDXNOD,BSDXAD "RTN","BSDX06",19,0) K ^BSDXTMP($J) "RTN","BSDX06",20,0) S BSDXERR="" "RTN","BSDX06",21,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX06",22,0) S ^BSDXTMP($J,0)="D00030StartTime^D00030EndTime^I00010AppointmentTypeID^I00010AvailabilityID^T00030ResourceName"_$C(30) "RTN","BSDX06",23,0) S BSDXI=0 "RTN","BSDX06",24,0) D "RTN","BSDX06",25,0) . S BSDXBS=0 "RTN","BSDX06",26,0) . I $L(BSDXEND,".")=1 S BSDXEND=BSDXEND+.9999 ;Go to end of day if only date (not time) is passed "RTN","BSDX06",27,0) . S BSDXRESN=BSDXRES "RTN","BSDX06",28,0) . Q:BSDXRESN="" "RTN","BSDX06",29,0) . Q:'$D(^BSDXRES("B",BSDXRESN)) "RTN","BSDX06",30,0) . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0)) "RTN","BSDX06",31,0) . Q:'+BSDXRESD "RTN","BSDX06",32,0) . D STCOMM(BSDXRESN,BSDXRESD) "RTN","BSDX06",33,0) . Q "RTN","BSDX06",34,0) ; "RTN","BSDX06",35,0) S BSDXI=$G(BSDXI)+1 "RTN","BSDX06",36,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX06",37,0) Q "RTN","BSDX06",38,0) ; "RTN","BSDX06",39,0) STCOMM(BSDXRESN,BSDXRESD) ;EP "RTN","BSDX06",40,0) ; "RTN","BSDX06",41,0) Q:'$D(^BSDXAB("ARSCT",BSDXRESD)) "RTN","BSDX06",42,0) Q:'$D(^BSDXRES(BSDXRESD,0)) "RTN","BSDX06",43,0) ;$O THRU "ARSCT" XREF OF ^BSDXAB "RTN","BSDX06",44,0) S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0 "RTN","BSDX06",45,0) ;Start at the beginning of the day -- AV Blocks can't overlap days "RTN","BSDX06",46,0) S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001 "RTN","BSDX06",47,0) F S BSDXS=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D "RTN","BSDX06",48,0) . S BSDXAD=0 F S BSDXAD=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D "RTN","BSDX06",49,0) . . Q:'$D(^BSDXAB(BSDXAD,0)) "RTN","BSDX06",50,0) . . S BSDXNOD=^BSDXAB(BSDXAD,0) "RTN","BSDX06",51,0) . . S BSDXNSTART=$P(BSDXNOD,U,2) "RTN","BSDX06",52,0) . . S BSDXNEND=$P(BSDXNOD,U,3) "RTN","BSDX06",53,0) . . I BSDXNEND'>BSDXSTART Q "RTN","BSDX06",54,0) . . S Y=BSDXNSTART X ^DD("DD") S BSDXNSTART=$TR(Y,"@"," ") "RTN","BSDX06",55,0) . . S Y=BSDXNEND X ^DD("DD") S BSDXNEND=$TR(Y,"@"," ") "RTN","BSDX06",56,0) . . S BSDXTPID=$P(BSDXNOD,U,5) "RTN","BSDX06",57,0) . . S BSDXI=BSDXI+1 "RTN","BSDX06",58,0) . . S ^BSDXTMP($J,BSDXI)=BSDXNSTART_U_BSDXNEND_U_BSDXTPID_U_BSDXAD_U_BSDXRESN_$C(30) "RTN","BSDX06",59,0) . . Q "RTN","BSDX06",60,0) . Q "RTN","BSDX06",61,0) Q "RTN","BSDX07") 0^7^B78302774 "RTN","BSDX07",1,0) BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/18/10 2:11pm "RTN","BSDX07",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX07",3,0) ; "RTN","BSDX07",4,0) ; Change Log: "RTN","BSDX07",5,0) ; UJO/SMH "RTN","BSDX07",6,0) ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US. "RTN","BSDX07",7,0) ; "RTN","BSDX07",8,0) ; "RTN","BSDX07",9,0) APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP "RTN","BSDX07",10,0) ;Entry point for debugging "RTN","BSDX07",11,0) ; "RTN","BSDX07",12,0) I +$G(^HWDEBUG("BREAK","APPADD")),+$G(^HWDEBUG("BREAK"))=DUZ D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)",$P(^HWDEBUG("BREAK"),U,2)) "RTN","BSDX07",13,0) E G ENDBG "RTN","BSDX07",14,0) Q "RTN","BSDX07",15,0) ; "RTN","BSDX07",16,0) APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP "RTN","BSDX07",17,0) ;Called by BSDX ADD NEW APPOINTMENT "RTN","BSDX07",18,0) ;Add new appointment "RTN","BSDX07",19,0) ;BSDXRES is ResourceName "RTN","BSDX07",20,0) ;BSDXLEN is the appointment duration in minutes "RTN","BSDX07",21,0) ;BSDXATID is used for 2 purposes: "RTN","BSDX07",22,0) ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt. "RTN","BSDX07",23,0) ; if BSDXATID = a number, then it is the access type id (used for rebooking) "RTN","BSDX07",24,0) ; "RTN","BSDX07",25,0) ;Create entry in BSDX APPOINTMENT "RTN","BSDX07",26,0) ;Returns recordset having fields "RTN","BSDX07",27,0) ; AppointmentID and ErrorNumber "RTN","BSDX07",28,0) ; "RTN","BSDX07",29,0) ;Test lines: "RTN","BSDX07",30,0) ENDBG ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^2^PEDIATRICIAN,DEMO^EXAM^SCRATCH NOTE "RTN","BSDX07",31,0) ; "RTN","BSDX07",32,0) N BSDXERR,BSDXIEN,BSDXDEP,BSDXI,BSDXJ,BSDXAPPTI,BSDXDJ,BSDXRESD,BSDXRNOD,BSDXSCD,BSDXC,BSDXERR,BSDXWKIN "RTN","BSDX07",33,0) N BSDXNOEV "RTN","BSDX07",34,0) S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol "RTN","BSDX07",35,0) K ^BSDXTMP($J) "RTN","BSDX07",36,0) S X="ETRAP^BSDX07",@^%ZOSF("TRAP") "RTN","BSDX07",37,0) S BSDXERR=0 "RTN","BSDX07",38,0) S BSDXI=0 "RTN","BSDX07",39,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX07",40,0) S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00020ERRORID"_$C(30) "RTN","BSDX07",41,0) S BSDXI=BSDXI+1 "RTN","BSDX07",42,0) ; "RTN","BSDX07",43,0) ;Lock BSDX node "RTN","BSDX07",44,0) L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI+1,"Another user is working with this patient's record. Please try again later") Q "RTN","BSDX07",45,0) ; "RTN","BSDX07",46,0) TSTART "RTN","BSDX07",47,0) ; v1.3 - date passed in as FM Date, not US date. "RTN","BSDX07",48,0) ;Check input data for errors "RTN","BSDX07",49,0) ; S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@") "RTN","BSDX07",50,0) ; S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@") "RTN","BSDX07",51,0) ; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y "RTN","BSDX07",52,0) ; I BSDXSTART=-1 D ERR(BSDXI+1,"BSDX07 Error: Invalid Start Time") Q "RTN","BSDX07",53,0) ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y "RTN","BSDX07",54,0) ; I BSDXEND=-1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q "RTN","BSDX07",55,0) ; "RTN","BSDX07",56,0) ; If C# sends the dates with extra zeros, remove them "RTN","BSDX07",57,0) S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND "RTN","BSDX07",58,0) ; "RTN","BSDX07",59,0) I $L(BSDXEND,".")=1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q "RTN","BSDX07",60,0) I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP "RTN","BSDX07",61,0) I '+BSDXPATID,'$D(^DPT(BSDXPATID,0)) D ERR(BSDXI+1,"BSDX07 Error: Invalid Patient ID") Q "RTN","BSDX07",62,0) ;Validate Resource entry "RTN","BSDX07",63,0) S BSDXERR=0 K BSDXRESD "RTN","BSDX07",64,0) I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI+1,"BSDX07 Error: Invalid Resource ID") Q "RTN","BSDX07",65,0) S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0)) "RTN","BSDX07",66,0) S BSDXWKIN=0 "RTN","BSDX07",67,0) I BSDXATID="WALKIN" S BSDXWKIN=1 "RTN","BSDX07",68,0) I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID="" "RTN","BSDX07",69,0) ; "RTN","BSDX07",70,0) S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID) "RTN","BSDX07",71,0) I 'BSDXAPPTID D ERR(BSDXI+1,"BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q "RTN","BSDX07",72,0) I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) "RTN","BSDX07",73,0) ; "RTN","BSDX07",74,0) ;Create RPMS Appointment "RTN","BSDX07",75,0) S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0)) "RTN","BSDX07",76,0) ;I BSDXRNOD="" D ERR(BSDXI+1,"BSDX07 Error: Unable to add appointment -- invalid Resource entry."),BSDXDEL(BSDXAPPTID) Q "RTN","BSDX07",77,0) I BSDXRNOD="" D ERR(BSDXI+1,"BSDX07 Error: Unable to add appointment -- invalid Resource entry.") Q "RTN","BSDX07",78,0) S BSDXSCD=$P(BSDXRNOD,U,4) "RTN","BSDX07",79,0) ;I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI+1,"BSDX07 Error: Unable to make appointment. MAKE^BSDAPI returned error code: "_BSDXERR),BSDXDEL(BSDXAPPTID) Q "RTN","BSDX07",80,0) I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI+1,"BSDX07 Error: Unable to make appointment. MAKE^BSDAPI returned error code: "_BSDXERR) Q "RTN","BSDX07",81,0) . S BSDXC("PAT")=BSDXPATID "RTN","BSDX07",82,0) . S BSDXC("CLN")=BSDXSCD "RTN","BSDX07",83,0) . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins "RTN","BSDX07",84,0) . S:BSDXWKIN BSDXC("TYP")=4 "RTN","BSDX07",85,0) . S BSDXC("ADT")=BSDXSTART "RTN","BSDX07",86,0) . S BSDXC("LEN")=BSDXLEN "RTN","BSDX07",87,0) . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field "RTN","BSDX07",88,0) . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDAPI "RTN","BSDX07",89,0) . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note "RTN","BSDX07",90,0) . S BSDXC("USR")=DUZ "RTN","BSDX07",91,0) . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC) "RTN","BSDX07",92,0) . Q:BSDXERR "RTN","BSDX07",93,0) . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) "RTN","BSDX07",94,0) . ;L "RTN","BSDX07",95,0) . Q "RTN","BSDX07",96,0) ; "RTN","BSDX07",97,0) ;Update RPMS Clinic availability "RTN","BSDX07",98,0) ;Return Recordset "RTN","BSDX07",99,0) TCOMMIT "RTN","BSDX07",100,0) L -^BSDXAPPT(BSDXPATID) "RTN","BSDX07",101,0) S BSDXI=BSDXI+1 "RTN","BSDX07",102,0) S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30) "RTN","BSDX07",103,0) S BSDXI=BSDXI+1 "RTN","BSDX07",104,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX07",105,0) Q "RTN","BSDX07",106,0) BSDXDEL(BSDXAPPTID) ;Deletes appointment BSDXAPPTID from BSDXAPPOINTMETN "RTN","BSDX07",107,0) N DA,DIK "RTN","BSDX07",108,0) S DIK="^BSDXAPPT(",DA=BSDXAPPTID "RTN","BSDX07",109,0) D ^DIK "RTN","BSDX07",110,0) Q "RTN","BSDX07",111,0) ; "RTN","BSDX07",112,0) STRIP(BSDXZ) ;Replace control characters with spaces "RTN","BSDX07",113,0) N BSDXI "RTN","BSDX07",114,0) F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999) "RTN","BSDX07",115,0) Q BSDXZ "RTN","BSDX07",116,0) ; "RTN","BSDX07",117,0) BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID) ;ADD BSDX APPOINTMENT ENTRY "RTN","BSDX07",118,0) ;Returns ien in BSDXAPPT or 0 if failed "RTN","BSDX07",119,0) ;Create entry in BSDX APPOINTMENT "RTN","BSDX07",120,0) N BSDXAPPTID "RTN","BSDX07",121,0) S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART "RTN","BSDX07",122,0) S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND "RTN","BSDX07",123,0) S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID "RTN","BSDX07",124,0) S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD "RTN","BSDX07",125,0) S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ) "RTN","BSDX07",126,0) ;S BSDXFDA(9002018.4,"+1,",.09)=$G(DT) ;MJL 1/25/2007 "RTN","BSDX07",127,0) S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT "RTN","BSDX07",128,0) S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y" "RTN","BSDX07",129,0) S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID "RTN","BSDX07",130,0) K BSDXIEN,BSDXMSG "RTN","BSDX07",131,0) D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX07",132,0) S BSDXAPPTID=+$G(BSDXIEN(1)) "RTN","BSDX07",133,0) Q BSDXAPPTID "RTN","BSDX07",134,0) ; "RTN","BSDX07",135,0) BSDXWP(BSDXAPPTID,BSDXNOTE) ; "RTN","BSDX07",136,0) ;Add WP field "RTN","BSDX07",137,0) I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" "RTN","BSDX07",138,0) I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) "RTN","BSDX07",139,0) I $D(BSDXNOTE(.5)) D "RTN","BSDX07",140,0) . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG") "RTN","BSDX07",141,0) Q "RTN","BSDX07",142,0) ; "RTN","BSDX07",143,0) ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP "RTN","BSDX07",144,0) ;Called by BSDX ADD APPOINTMENT protocol "RTN","BSDX07",145,0) ;BSDXSC=IEN of clinic in ^SC "RTN","BSDX07",146,0) ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note "RTN","BSDX07",147,0) ; "RTN","BSDX07",148,0) N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES "RTN","BSDX07",149,0) Q:+$G(BSDXNOEV) "RTN","BSDX07",150,0) I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) "RTN","BSDX07",151,0) E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) "RTN","BSDX07",152,0) Q:'+$G(BSDXRES) "RTN","BSDX07",153,0) S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0)) "RTN","BSDX07",154,0) Q:BSDXNOD="" "RTN","BSDX07",155,0) S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0)) "RTN","BSDX07",156,0) S BSDXWKIN="" "RTN","BSDX07",157,0) S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile "RTN","BSDX07",158,0) S BSDXLEN=$P(BSDXNOD,U,2) "RTN","BSDX07",159,0) Q:'+BSDXLEN "RTN","BSDX07",160,0) S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0) "RTN","BSDX07",161,0) S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN) "RTN","BSDX07",162,0) Q:'+BSDXAPPTID "RTN","BSDX07",163,0) S BSDXNOTE=$P(BSDXNOD,U,4) "RTN","BSDX07",164,0) I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) "RTN","BSDX07",165,0) D ADDEVT3(BSDXRES) "RTN","BSDX07",166,0) Q "RTN","BSDX07",167,0) ; "RTN","BSDX07",168,0) ADDEVT3(BSDXRES) ; "RTN","BSDX07",169,0) ;Call RaiseEvent to notify GUI clients "RTN","BSDX07",170,0) N BSDXRESN "RTN","BSDX07",171,0) S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) "RTN","BSDX07",172,0) Q:BSDXRESN="" "RTN","BSDX07",173,0) S BSDXRESN=$P(BSDXRESN,"^") "RTN","BSDX07",174,0) ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","") "RTN","BSDX07",175,0) D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) "RTN","BSDX07",176,0) Q "RTN","BSDX07",177,0) ; "RTN","BSDX07",178,0) ERR(BSDXI,BSDXERR) ;Error processing "RTN","BSDX07",179,0) D ^%ZTER ;XXX: remove after we figure out the cause of error "RTN","BSDX07",180,0) S BSDXI=BSDXI+1 "RTN","BSDX07",181,0) S BSDXERR=$TR(BSDXERR,"^","~") "RTN","BSDX07",182,0) TROLLBACK "RTN","BSDX07",183,0) S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30) "RTN","BSDX07",184,0) S BSDXI=BSDXI+1 "RTN","BSDX07",185,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX07",186,0) L "RTN","BSDX07",187,0) Q "RTN","BSDX07",188,0) ; "RTN","BSDX07",189,0) ETRAP ;EP Error trap entry "RTN","BSDX07",190,0) D ^%ZTER "RTN","BSDX07",191,0) I '$D(BSDXI) N BSDXI S BSDXI=999999 "RTN","BSDX07",192,0) S BSDXI=BSDXI+1 "RTN","BSDX07",193,0) D ERR(BSDXI,"BSDX07 Error: "_$G(%ZTERROR)) "RTN","BSDX07",194,0) Q "RTN","BSDX07",195,0) ; "RTN","BSDX07",196,0) DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR "RTN","BSDX07",197,0) ; "RTN","BSDX07",198,0) DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y) "RTN","BSDX07",199,0) F %=%:-1:281 S Y=%#4=1+1+Y "RTN","BSDX07",200,0) S Y=$E(X,6,7)+Y#7 "RTN","BSDX07",201,0) Q "RTN","BSDX07",202,0) ; "RTN","BSDX07",203,0) AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update RPMS Clinic availability "RTN","BSDX07",204,0) ;SEE SDM1 "RTN","BSDX07",205,0) N Y,DFN "RTN","BSDX07",206,0) N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG "RTN","BSDX07",207,0) N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I "RTN","BSDX07",208,0) S Y=BSDXSCD,DFN=BSDXPATID "RTN","BSDX07",209,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","BSDX07",210,0) ;Determine maximum days for scheduling "RTN","BSDX07",211,0) S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365 "RTN","BSDX07",212,0) S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1)) "RTN","BSDX07",213,0) S SDDATE=BSDXSTART "RTN","BSDX07",214,0) S SDSDATE=SDDATE,SDDATE=SDDATE\1 "RTN","BSDX07",215,0) 1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC "RTN","BSDX07",216,0) Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC "RTN","BSDX07",217,0) S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2) "RTN","BSDX07",218,0) S X2=SDEDT D C^%DTC S SDEDT=X "RTN","BSDX07",219,0) S Y=BSDXSTART "RTN","BSDX07",220,0) EN1 S (X,SD)=Y,SM=0 D DOW "RTN","BSDX07",221,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","BSDX07",222,0) S S=BSDXLEN "RTN","BSDX07",223,0) ;Check if BSDXLEN evenly divisible by appointment length "RTN","BSDX07",224,0) S RPMSL=$P(SL,U) "RTN","BSDX07",225,0) I BSDXLEN9 "RTN","BSDX07",232,0) L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC "RTN","BSDX07",233,0) S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1) "RTN","BSDX07",234,0) S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST "RTN","BSDX07",235,0) I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q "RTN","BSDX07",236,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","BSDX07",237,0) ; "RTN","BSDX07",238,0) SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP "RTN","BSDX07",239,0) S SDNOT=1 "RTN","BSDX07",240,0) S ABORT=0 "RTN","BSDX07",241,0) F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT "RTN","BSDX07",242,0) . S ST=$E(S,I+1) S:ST="" ST=" " "RTN","BSDX07",243,0) . S Y=$E(STR,$F(STR,ST)-2) "RTN","BSDX07",244,0) . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q "RTN","BSDX07",245,0) . I Y="" S ABORT=1 Q "RTN","BSDX07",246,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","BSDX07",247,0) . Q "RTN","BSDX07",248,0) S ^SC(SC,"ST",$P(SD,"."),1)=S "RTN","BSDX07",249,0) L -^SC(SC,"ST",$P(SD,"."),1) "RTN","BSDX07",250,0) Q "RTN","BSDX08") 0^8^B36787520 "RTN","BSDX08",1,0) BSDX08 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/15/10 8:21pm "RTN","BSDX08",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX08",3,0) ; "RTN","BSDX08",4,0) ; "RTN","BSDX08",5,0) APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP "RTN","BSDX08",6,0) ;Entry point for debugging "RTN","BSDX08",7,0) ; "RTN","BSDX08",8,0) ;D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)") "RTN","BSDX08",9,0) Q "RTN","BSDX08",10,0) ; "RTN","BSDX08",11,0) APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP "RTN","BSDX08",12,0) ;Called by BSDX CANCEL APPOINTMENT "RTN","BSDX08",13,0) ;Cancels appointment "RTN","BSDX08",14,0) ;BSDXAPTID is entry number in BSDX APPOINTMENT file "RTN","BSDX08",15,0) ;BSDXTYP is C for clinic-cancelled and PC for patient cancelled "RTN","BSDX08",16,0) ;BSDXCR is pointer to CANCELLATION REASON File (409.2) "RTN","BSDX08",17,0) ;BSDXNOT is user note "RTN","BSDX08",18,0) ;Returns error code in recordset field ERRORID "RTN","BSDX08",19,0) ; "RTN","BSDX08",20,0) ; "RTN","BSDX08",21,0) N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXZ,BSDXERR "RTN","BSDX08",22,0) N BSDXLOC,BSDXLEN,BSDXSCIEN "RTN","BSDX08",23,0) N BSDXNOEV "RTN","BSDX08",24,0) S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol "RTN","BSDX08",25,0) ; "RTN","BSDX08",26,0) D ^XBKVAR S X="ETRAP^BSDX08",@^%ZOSF("TRAP") "RTN","BSDX08",27,0) S BSDXI=0 "RTN","BSDX08",28,0) K ^BSDXTMP($J) "RTN","BSDX08",29,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX08",30,0) S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30) "RTN","BSDX08",31,0) S BSDXI=BSDXI+1 "RTN","BSDX08",32,0) TSTART "RTN","BSDX08",33,0) I '+BSDXAPTID D ERR(BSDXI,"BSDX08: Invalid Appointment ID") Q "RTN","BSDX08",34,0) I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"BSDX08: Invalid Appointment ID") Q "RTN","BSDX08",35,0) ; "RTN","BSDX08",36,0) ;Delete APPOINTMENT entries "RTN","BSDX08",37,0) S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) "RTN","BSDX08",38,0) S BSDXPATID=$P(BSDXNOD,U,5) "RTN","BSDX08",39,0) S BSDXSTART=$P(BSDXNOD,U) "RTN","BSDX08",40,0) ; "RTN","BSDX08",41,0) ;Lock BSDX node "RTN","BSDX08",42,0) L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI+1,"Another user is working with this patient's record. Please try again later") TROLLBACK Q "RTN","BSDX08",43,0) ; "RTN","BSDX08",44,0) D BSDXCAN(BSDXAPTID) "RTN","BSDX08",45,0) ; "RTN","BSDX08",46,0) S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID "RTN","BSDX08",47,0) I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I +$G(BSDXZ) S BSDXERR=BSDXERR_$P(BSDXZ,U,2) D ERR(BSDXI,BSDXERR) Q "RTN","BSDX08",48,0) . S BSDXNOD=^BSDXRES(BSDXSC1,0) "RTN","BSDX08",49,0) . S BSDXLOC=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION "RTN","BSDX08",50,0) . Q:'+BSDXLOC "RTN","BSDX08",51,0) . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) I BSDXSCIEN="" D I 'BSDXZ Q ;Q:BSDXZ "RTN","BSDX08",52,0) . . S BSDXERR="BSDX08: Unable to find associated RPMS appointment for this patient. " "RTN","BSDX08",53,0) . . S BSDXZ=1 "RTN","BSDX08",54,0) . . I '$D(^BSDXRES(BSDXSC1,20)) S BSDXZ=0 Q "RTN","BSDX08",55,0) . . N BSDX1 "RTN","BSDX08",56,0) . . S BSDX1=0 "RTN","BSDX08",57,0) . . F S BSDX1=$O(^BSDXRES(BSDXSC1,20,BSDX1)) Q:'+BSDX1 Q:BSDXZ=0 D "RTN","BSDX08",58,0) . . . Q:'$D(^BSDXRES(BSDXSC1,20,BSDX1,0)) "RTN","BSDX08",59,0) . . . S BSDXLOC=$P(^BSDXRES(BSDXSC1,20,BSDX1,0),U) "RTN","BSDX08",60,0) . . . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) I +BSDXSCIEN S BSDXZ=0 Q "RTN","BSDX08",61,0) . S BSDXERR="BSDX08: CANCEL^BSDXAPI Returned " "RTN","BSDX08",62,0) . I BSDXLOC']"" S BSDXZ="0^Unable to find associated RPMS appointment for this patient." Q "RTN","BSDX08",63,0) . I '$D(^SC(BSDXLOC,0)) S BSDXZ="0^Unable to find associated RPMS appointment for this patient." Q "RTN","BSDX08",64,0) . S BSDXNOD=$G(^SC(BSDXLOC,"S",BSDXSTART,1,BSDXSCIEN,0)) "RTN","BSDX08",65,0) . I BSDXNOD="" S BSDXZ="0^Unable to find associated RPMS appointment for this patient." Q "RTN","BSDX08",66,0) . S BSDXLEN=$P(BSDXNOD,U,2) "RTN","BSDX08",67,0) . D APCAN(.BSDXZ,BSDXLOC,BSDXPATID,BSDXSTART) "RTN","BSDX08",68,0) . Q:+$G(BSDXZ) "RTN","BSDX08",69,0) . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN) "RTN","BSDX08",70,0) . ;L "RTN","BSDX08",71,0) ; "RTN","BSDX08",72,0) TCOMMIT "RTN","BSDX08",73,0) L -^BSDXAPPT(BSDXPATID) "RTN","BSDX08",74,0) S BSDXI=BSDXI+1 "RTN","BSDX08",75,0) S ^BSDXTMP($J,BSDXI)=""_$C(30) "RTN","BSDX08",76,0) S BSDXI=BSDXI+1 "RTN","BSDX08",77,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX08",78,0) Q "RTN","BSDX08",79,0) ; "RTN","BSDX08",80,0) AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update RPMS Clinic availability "RTN","BSDX08",81,0) ;See SDCNP0 "RTN","BSDX08",82,0) S (SD,S)=BSDXSTART "RTN","BSDX08",83,0) S I=BSDXSCD "RTN","BSDX08",84,0) Q:'$D(^SC(I,"ST",SD\1,1)) "RTN","BSDX08",85,0) S SL=^SC(I,"SL"),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y "RTN","BSDX08",86,0) S SL=BSDXLEN "RTN","BSDX08",87,0) S S=^SC(I,"ST",SD\1,1),Y=SD#1-SB*100,ST=Y#1*SI\.6+(Y\1*SI),SS=SL*HSI/60 "RTN","BSDX08",88,0) I Y'<1 F I=ST+ST:SDDIF S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" S S=$E(S,1,I)_Y_$E(S,I+2,999),SS=SS-1 Q:SS'>0 "RTN","BSDX08",89,0) S ^SC(BSDXSCD,"ST",SD\1,1)=S "RTN","BSDX08",90,0) Q "RTN","BSDX08",91,0) ; "RTN","BSDX08",92,0) APCAN(BSDXZ,BSDXLOC,BSDXDFN,BSDXSD) ; "RTN","BSDX08",93,0) ;Cancel appointment for patient BSDXDFN in clinic BSDXSC1 "RTN","BSDX08",94,0) ;at time BSDXSD "RTN","BSDX08",95,0) N BSDXC,%H "RTN","BSDX08",96,0) S BSDXC("PAT")=BSDXPATID "RTN","BSDX08",97,0) S BSDXC("CLN")=BSDXLOC "RTN","BSDX08",98,0) S BSDXC("TYP")=BSDXTYP "RTN","BSDX08",99,0) S BSDXC("ADT")=BSDXSD "RTN","BSDX08",100,0) S %H=$H D YMD^%DTC "RTN","BSDX08",101,0) S BSDXC("CDT")=X+% "RTN","BSDX08",102,0) S BSDXC("NOT")=BSDXNOT "RTN","BSDX08",103,0) S:'+$G(BSDXCR) BSDXCR=11 ;Other "RTN","BSDX08",104,0) S BSDXC("CR")=BSDXCR "RTN","BSDX08",105,0) S BSDXC("USR")=DUZ "RTN","BSDX08",106,0) ; "RTN","BSDX08",107,0) S BSDXZ=$$CANCEL^BSDXAPI(.BSDXC) "RTN","BSDX08",108,0) Q "RTN","BSDX08",109,0) ; "RTN","BSDX08",110,0) BSDXCAN(BSDXAPTID) ; "RTN","BSDX08",111,0) ;Cancel BSDX APPOINTMENT entry "RTN","BSDX08",112,0) N %DT,X,BSDXDATE,Y,BSDXIENS,BSDXFDA,BSDXMSG "RTN","BSDX08",113,0) S %DT="XT",X="NOW" D ^%DT ; X ^DD("DD") "RTN","BSDX08",114,0) S BSDXDATE=Y "RTN","BSDX08",115,0) S BSDXIENS=BSDXAPTID_"," "RTN","BSDX08",116,0) S BSDXFDA(9002018.4,BSDXIENS,.12)=BSDXDATE "RTN","BSDX08",117,0) K BSDXMSG "RTN","BSDX08",118,0) D FILE^DIE("","BSDXFDA","BSDXMSG") "RTN","BSDX08",119,0) Q "RTN","BSDX08",120,0) ; "RTN","BSDX08",121,0) CANEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CANCEL APPOINTMENT event "RTN","BSDX08",122,0) ;when appointments cancelled via PIMS interface. "RTN","BSDX08",123,0) ;Propagates cancellation to BSDXAPPT and raises refresh event to running GUI clients "RTN","BSDX08",124,0) N BSDXFOUND,BSDXRES "RTN","BSDX08",125,0) Q:+$G(BSDXNOEV) "RTN","BSDX08",126,0) Q:'+$G(BSDXSC) "RTN","BSDX08",127,0) S BSDXFOUND=0 "RTN","BSDX08",128,0) I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$CANEVT1(BSDXRES,BSDXSTART,BSDXPAT) "RTN","BSDX08",129,0) I BSDXFOUND D CANEVT3(BSDXRES) Q "RTN","BSDX08",130,0) I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$CANEVT1(BSDXRES,BSDXSTART,BSDXPAT) "RTN","BSDX08",131,0) I BSDXFOUND D CANEVT3(BSDXRES) "RTN","BSDX08",132,0) Q "RTN","BSDX08",133,0) ; "RTN","BSDX08",134,0) CANEVT1(BSDXRES,BSDXSTART,BSDXPAT) ; "RTN","BSDX08",135,0) ;Get appointment id in BSDXAPT "RTN","BSDX08",136,0) ;If found, call BSDXCAN(BSDXAPPT) and return 1 "RTN","BSDX08",137,0) ;else return 0 "RTN","BSDX08",138,0) N BSDXFOUND,BSDXAPPT "RTN","BSDX08",139,0) S BSDXFOUND=0 "RTN","BSDX08",140,0) Q:'+BSDXRES BSDXFOUND "RTN","BSDX08",141,0) Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND "RTN","BSDX08",142,0) S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND "RTN","BSDX08",143,0) . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" "RTN","BSDX08",144,0) . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q "RTN","BSDX08",145,0) I BSDXFOUND,+$G(BSDXAPPT) D BSDXCAN(BSDXAPPT) "RTN","BSDX08",146,0) Q BSDXFOUND "RTN","BSDX08",147,0) ; "RTN","BSDX08",148,0) CANEVT3(BSDXRES) ; "RTN","BSDX08",149,0) ;Call RaiseEvent to notify GUI clients "RTN","BSDX08",150,0) ; "RTN","BSDX08",151,0) N BSDXRESN "RTN","BSDX08",152,0) S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) "RTN","BSDX08",153,0) Q:BSDXRESN="" "RTN","BSDX08",154,0) S BSDXRESN=$P(BSDXRESN,"^") "RTN","BSDX08",155,0) ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","") "RTN","BSDX08",156,0) D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) "RTN","BSDX08",157,0) Q "RTN","BSDX08",158,0) ; "RTN","BSDX08",159,0) ERR(BSDXI,BSDXERR) ;Error processing "RTN","BSDX08",160,0) S BSDXI=BSDXI+1 "RTN","BSDX08",161,0) S BSDXERR=$TR(BSDXERR,"^","~") "RTN","BSDX08",162,0) TROLLBACK "RTN","BSDX08",163,0) S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) "RTN","BSDX08",164,0) S BSDXI=BSDXI+1 "RTN","BSDX08",165,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX08",166,0) L "RTN","BSDX08",167,0) Q "RTN","BSDX08",168,0) ; "RTN","BSDX08",169,0) ETRAP ;EP Error trap entry "RTN","BSDX08",170,0) D ^%ZTER "RTN","BSDX08",171,0) I '$D(BSDXI) N BSDXI S BSDXI=999999 "RTN","BSDX08",172,0) S BSDXI=BSDXI+1 "RTN","BSDX08",173,0) D ERR(BSDXI,"BSDX08 Error: "_$G(%ZTERROR)) "RTN","BSDX08",174,0) Q "RTN","BSDX09") 0^9^B34793207 "RTN","BSDX09",1,0) BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 8/16/10 4:28pm "RTN","BSDX09",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX09",3,0) ; "RTN","BSDX09",4,0) ; Change Log: "RTN","BSDX09",5,0) ; UJO/TH - v 1.3 on 3100714 - Extra Demographics: "RTN","BSDX09",6,0) ; - Email "RTN","BSDX09",7,0) ; - Cell Phone "RTN","BSDX09",8,0) ; - Country "RTN","BSDX09",9,0) ; - + refactoring of routine "RTN","BSDX09",10,0) ; "RTN","BSDX09",11,0) ; UJO/TH - v 1.3 on 3100715 - Change SSN to PID and get PID field instead "RTN","BSDX09",12,0) ; "RTN","BSDX09",13,0) GETREGA(BSDXRET,BSDXPAT) ;EP "RTN","BSDX09",14,0) ; "RTN","BSDX09",15,0) ; See below for the returned fields "RTN","BSDX09",16,0) ; "RTN","BSDX09",17,0) ;For patient with ien BSDXPAT "RTN","BSDX09",18,0) ;K ^BSDXTMP($J) "RTN","BSDX09",19,0) S BSDXERR="" "RTN","BSDX09",20,0) S BSDXRET="^BSDXTMP("_$J_")" "RTN","BSDX09",21,0) ; "RTN","BSDX09",22,0) N OUT S OUT=$NA(^BSDXTMP($J,0)) "RTN","BSDX09",23,0) S $P(@OUT,U,1)="T00030IEN" "RTN","BSDX09",24,0) S $P(@OUT,U,2)="T00030STREET" "RTN","BSDX09",25,0) S $P(@OUT,U,3)="T00030CITY" "RTN","BSDX09",26,0) S $P(@OUT,U,4)="T00030STATE" "RTN","BSDX09",27,0) S $P(@OUT,U,5)="T00030ZIP" "RTN","BSDX09",28,0) S $P(@OUT,U,6)="T00030NAME" "RTN","BSDX09",29,0) S $P(@OUT,U,7)="D00030DOB" "RTN","BSDX09",30,0) S $P(@OUT,U,8)="T00030PID" "RTN","BSDX09",31,0) S $P(@OUT,U,9)="T00030HRN" "RTN","BSDX09",32,0) S $P(@OUT,U,10)="T00030HOMEPHONE" "RTN","BSDX09",33,0) S $P(@OUT,U,11)="T00030OFCPHONE" "RTN","BSDX09",34,0) S $P(@OUT,U,12)="T00030MSGPHONE" "RTN","BSDX09",35,0) S $P(@OUT,U,13)="T00030NOK NAME" "RTN","BSDX09",36,0) S $P(@OUT,U,14)="T00030RELATIONSHIP" "RTN","BSDX09",37,0) S $P(@OUT,U,15)="T00030PHONE" "RTN","BSDX09",38,0) S $P(@OUT,U,16)="T00030STREET" "RTN","BSDX09",39,0) S $P(@OUT,U,17)="T00030CITY" "RTN","BSDX09",40,0) S $P(@OUT,U,18)="T00030STATE" "RTN","BSDX09",41,0) S $P(@OUT,U,19)="T00030ZIP" "RTN","BSDX09",42,0) S $P(@OUT,U,20)="D00030DATAREVIEWED" "RTN","BSDX09",43,0) S $P(@OUT,U,21)="T00030RegistrationComments" "RTN","BSDX09",44,0) S $P(@OUT,U,22)="T00050EMAIL ADDRESS" "RTN","BSDX09",45,0) S $P(@OUT,U,23)="T00020PHONE NUMBER [CELLULAR]" "RTN","BSDX09",46,0) S $P(@OUT,U,24)="T00030COUNTRY" "RTN","BSDX09",47,0) S $E(@OUT,$L(@OUT)+1)=$C(30) "RTN","BSDX09",48,0) ; "RTN","BSDX09",49,0) ; "RTN","BSDX09",50,0) N BSDXNOD,BSDXNAM,Y,U "RTN","BSDX09",51,0) S U="^" "RTN","BSDX09",52,0) S BSDXY="ERROR" "RTN","BSDX09",53,0) K NAME "RTN","BSDX09",54,0) I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q "RTN","BSDX09",55,0) I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q "RTN","BSDX09",56,0) S BSDXY="" "RTN","BSDX09",57,0) S $P(BSDXY,U)=BSDXPAT "RTN","BSDX09",58,0) ;//smh S $P(BSDXY,U,23)="" "RTN","BSDX09",59,0) S $P(BSDXY,U,21)="" "RTN","BSDX09",60,0) S BSDXNOD=^DPT(+BSDXPAT,0) "RTN","BSDX09",61,0) S $P(BSDXY,"^",6)=$P(BSDXNOD,U) ;NAME "RTN","BSDX09",62,0) S $P(BSDXY,"^",8)=$$GET1^DIQ(2,BSDXPAT,"PRIMARY LONG ID") ;PID "RTN","BSDX09",63,0) S Y=$P(BSDXNOD,U,3) I Y]"" X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX09",64,0) S $P(BSDXY,"^",7)=Y ;DOB "RTN","BSDX09",65,0) S $P(BSDXY,"^",9)="" "RTN","BSDX09",66,0) I $D(DUZ(2)) I DUZ(2)>0 S $P(BSDXY,"^",9)=$P($G(^AUPNPAT(BSDXPAT,41,DUZ(2),0)),U,2) ;HRN "RTN","BSDX09",67,0) D MAIL "RTN","BSDX09",68,0) D PHONE "RTN","BSDX09",69,0) D NOK "RTN","BSDX09",70,0) D DATAREV "RTN","BSDX09",71,0) ;/smh D MEDICARE "RTN","BSDX09",72,0) D REGCMT "RTN","BSDX09",73,0) S $P(BSDXY,"^",22)=$$GET1^DIQ(2,BSDXPAT,"EMAIL ADDRESS") "RTN","BSDX09",74,0) S $P(BSDXY,"^",23)=$$GET1^DIQ(2,BSDXPAT,"PHONE NUMBER [CELLULAR]") "RTN","BSDX09",75,0) S $P(BSDXY,"^",24)=$$GET1^DIQ(2,BSDXPAT,"COUNTRY:DESCRIPTION") "RTN","BSDX09",76,0) N BSDXBEG,BSDXEND,BSDXLEN,BSDXI "RTN","BSDX09",77,0) S BSDXLEN=$L(BSDXY) "RTN","BSDX09",78,0) S BSDXBEG=0,BSDXI=2 "RTN","BSDX09",79,0) F D Q:BSDXEND=BSDXLEN "RTN","BSDX09",80,0) . S BSDXEND=BSDXBEG+100 "RTN","BSDX09",81,0) . S:BSDXEND>BSDXLEN BSDXEND=BSDXLEN "RTN","BSDX09",82,0) . S BSDXI=BSDXI+1 "RTN","BSDX09",83,0) . S ^BSDXTMP($J,BSDXI)=$E(BSDXY,BSDXBEG,BSDXEND) "RTN","BSDX09",84,0) . S BSDXBEG=BSDXBEG+101 "RTN","BSDX09",85,0) S ^BSDXTMP($J,BSDXI+1)=$C(30)_$C(31) "RTN","BSDX09",86,0) Q "RTN","BSDX09",87,0) ; "RTN","BSDX09",88,0) MAIL N BSDXST "RTN","BSDX09",89,0) Q:'$D(^DPT(+BSDXPAT,.11)) "RTN","BSDX09",90,0) S BSDXNOD=^DPT(+BSDXPAT,.11) "RTN","BSDX09",91,0) Q:BSDXNOD="" "RTN","BSDX09",92,0) S $P(BSDXY,"^",2)=$E($P(BSDXNOD,U),1,50) ;STREET "RTN","BSDX09",93,0) S $P(BSDXY,"^",3)=$P(BSDXNOD,U,4) ;CITY "RTN","BSDX09",94,0) S BSDXST=$P(BSDXNOD,U,5) "RTN","BSDX09",95,0) I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2) "RTN","BSDX09",96,0) S $P(BSDXY,"^",4)=BSDXST ;STATE "RTN","BSDX09",97,0) S $P(BSDXY,"^",5)=$P(BSDXNOD,U,6) ;ZIP "RTN","BSDX09",98,0) Q "RTN","BSDX09",99,0) ; "RTN","BSDX09",100,0) PHONE ;PHONE 10,11,12 HOME,OFC,MSG "RTN","BSDX09",101,0) I $D(^DPT(+BSDXPAT,.13)) D "RTN","BSDX09",102,0) . S BSDXNOD=^DPT(+BSDXPAT,.13) "RTN","BSDX09",103,0) . S $P(BSDXY,U,10)=$P(BSDXNOD,U,1) "RTN","BSDX09",104,0) . S $P(BSDXY,U,11)=$P(BSDXNOD,U,2) "RTN","BSDX09",105,0) I $D(^DPT(+BSDXPAT,.121)) D "RTN","BSDX09",106,0) . S BSDXNOD=^DPT(+BSDXPAT,.121) "RTN","BSDX09",107,0) . S $P(BSDXY,U,12)=$P(BSDXNOD,U,10) "RTN","BSDX09",108,0) Q "RTN","BSDX09",109,0) ; "RTN","BSDX09",110,0) NOK ;NOK "RTN","BSDX09",111,0) ; 13 NOK NAME^RELATIONSHIP^PHONE^STREET^CITY^STATE^ZIP "RTN","BSDX09",112,0) N Y,BSDXST "RTN","BSDX09",113,0) I $D(^DPT(+BSDXPAT,.21)) D "RTN","BSDX09",114,0) . S BSDXNOD=^DPT(+BSDXPAT,.21) "RTN","BSDX09",115,0) . S $P(BSDXY,U,13)=$P(BSDXNOD,U,1) "RTN","BSDX09",116,0) . S $P(BSDXY,U,14)=$$VAL^XBDIQ1(9000001,BSDXPAT,2802) "RTN","BSDX09",117,0) . S $P(BSDXY,U,15)=$P(BSDXNOD,U,9) "RTN","BSDX09",118,0) . S $P(BSDXY,U,16)=$P(BSDXNOD,U,3) "RTN","BSDX09",119,0) . S $P(BSDXY,U,17)=$P(BSDXNOD,U,6) "RTN","BSDX09",120,0) . S BSDXST=$P(BSDXNOD,U,7) "RTN","BSDX09",121,0) . I +BSDXST D "RTN","BSDX09",122,0) . . I $D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2),$P(BSDXY,U,18)=BSDXST "RTN","BSDX09",123,0) . S $P(BSDXY,U,19)=$P(BSDXNOD,U,8) "RTN","BSDX09",124,0) Q "RTN","BSDX09",125,0) ; "RTN","BSDX09",126,0) DATAREV S $P(BSDXY,U,20)=$P($$VAL^XBDIQ1(9000001,BSDXPAT,16651),"@") "RTN","BSDX09",127,0) Q "RTN","BSDX09",128,0) ; "RTN","BSDX09",129,0) REGCMT N BSDXI,BSDXM,BSDXR "RTN","BSDX09",130,0) S BSDXR="" "RTN","BSDX09",131,0) D ENP^XBDIQ1(9000001,BSDXPAT,1301,"BSDXM(") "RTN","BSDX09",132,0) S BSDXI=0 F S BSDXI=$O(BSDXM(1301,BSDXI)) Q:'+BSDXI D "RTN","BSDX09",133,0) . S BSDXR=BSDXR_" "_BSDXM(1301,BSDXI) "RTN","BSDX09",134,0) ; S $P(BSDXY,U,23)=$TR($E(BSDXR,1,1024),U," ") ; MJL 1/17/2007 //smh "RTN","BSDX09",135,0) S $P(BSDXY,U,21)=$TR($E(BSDXR,1,1024),U," ") ; "RTN","BSDX09",136,0) Q "RTN","BSDX09",137,0) ; "RTN","BSDX09",138,0) GETMCAID(BSDXY,BSDXPAT) ; not in wv "RTN","BSDX09",139,0) ;Returns PATIENTIEN^ENTRY#^MEDICAID#^SUBENTRY#^ELIG.BEGIN^ELIG.END | "RTN","BSDX09",140,0) ;File is not dinum "RTN","BSDX09",141,0) N C,N,ASDGX,BSDXM,BSDXBLD,BSDXCNT "RTN","BSDX09",142,0) N BSDXIEN "RTN","BSDX09",143,0) S BSDXBLD="" "RTN","BSDX09",144,0) S BSDXIEN=0 "RTN","BSDX09",145,0) S BSDXCNT=1 "RTN","BSDX09",146,0) F S BSDXIEN=$O(^AUPNMCD("B",BSDXPAT,BSDXIEN)) Q:'+BSDXIEN D "RTN","BSDX09",147,0) . S BSDXNUM=$$VAL^XBDIQ1(9000004,BSDXIEN,.03) ;MCAID# "RTN","BSDX09",148,0) . D ENPM^XBDIQ1(9000004.11,BSDXIEN_",0",".01:.02","ASDGX(") "RTN","BSDX09",149,0) . S C=1,N=0,BSDXM="" "RTN","BSDX09",150,0) . F S N=$O(ASDGX(N)) Q:'N D "RTN","BSDX09",151,0) . . S $P(BSDXY,"|",C)=BSDXPAT_U_BSDXIEN_U_BSDXNUM_U_N_U_ASDGX(N,.01)_U_ASDGX(N,.02) "RTN","BSDX09",152,0) . . S C=C+1 "RTN","BSDX09",153,0) . . Q "RTN","BSDX09",154,0) . Q "RTN","BSDX09",155,0) Q "RTN","BSDX09",156,0) ; "RTN","BSDX09",157,0) MEDICARE ; not in WV "RTN","BSDX09",158,0) S $P(BSDXY,U,21)=$$VAL^XBDIQ1(9000003,BSDXPAT,.03) "RTN","BSDX09",159,0) S $P(BSDXY,U,22)=$$VAL^XBDIQ1(9000003,BSDXPAT,.04) "RTN","BSDX09",160,0) Q "RTN","BSDX09",161,0) ; "RTN","BSDX09",162,0) GETMCARE(BSDXY,BSDXPAT) ; "RTN","BSDX09",163,0) ;Returns IEN^MEDICARE#^SUFFIX^SUBENTRY#^TYPE^ELIG.BEGIN^ELIG.END | "RTN","BSDX09",164,0) ;File is dinum "RTN","BSDX09",165,0) ; "RTN","BSDX09",166,0) N ASDGX,C,N,BSDXNUM,BSDXSUF,BSDXBLD "RTN","BSDX09",167,0) S BSDXNUM=$$VAL^XBDIQ1(9000003,BSDXPAT,.03) "RTN","BSDX09",168,0) S BSDXSUF=$$VAL^XBDIQ1(9000003,BSDXPAT,.04) "RTN","BSDX09",169,0) D ENPM^XBDIQ1(9000003.11,BSDXPAT_",0",".01:.03","ASDGX(") "RTN","BSDX09",170,0) S C=1,N=0,BSDXBLD="" "RTN","BSDX09",171,0) F S N=$O(ASDGX(N)) Q:'N D "RTN","BSDX09",172,0) . S $P(BSDXY,"|",C)=BSDXPAT_U_BSDXNUM_U_BSDXSUF_U_N_U_ASDGX(N,.03)_U_ASDGX(N,.01)_U_ASDGX(N,.02) "RTN","BSDX09",173,0) . S C=C+1 "RTN","BSDX09",174,0) . Q "RTN","BSDX09",175,0) Q "RTN","BSDX09",176,0) ; "RTN","BSDX09",177,0) GETPVTIN(BSDXY,BSDXPAT) ; "RTN","BSDX09",178,0) ;Returns IEN^SUBENTRY^INSURER^POLICYNUMBER^ELIG.BEGIN^ELIG.END|... "RTN","BSDX09",179,0) ;File is dinum "RTN","BSDX09",180,0) ; "RTN","BSDX09",181,0) N ASDGX,C,N "RTN","BSDX09",182,0) D ENPM^XBDIQ1(9000006.11,BSDXPAT_",0",".01;.02;.06;.07","ASDGX(") "RTN","BSDX09",183,0) S C=1,N=0 "RTN","BSDX09",184,0) F S N=$O(ASDGX(N)) Q:'N D "RTN","BSDX09",185,0) . S $P(BSDXY,"|",C)=BSDXPAT_U_N_U_ASDGX(N,.01)_U_ASDGX(N,.02)_U_ASDGX(N,.06)_U_ASDGX(N,.07) "RTN","BSDX09",186,0) . S C=C+1 "RTN","BSDX09",187,0) . Q "RTN","BSDX09",188,0) Q "RTN","BSDX09",189,0) ; "RTN","BSDX09",190,0) DFN(FILE,BSDXPAT) ; -- returns ien for file "RTN","BSDX09",191,0) I FILE'[9000004 Q BSDXPAT "RTN","BSDX09",192,0) Q +$O(^AUPNMCD("B",BSDXPAT,0)) "RTN","BSDX11") 0^34^B6358791 "RTN","BSDX11",1,0) BSDX11 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX11",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX11",3,0) ; "RTN","BSDX11",4,0) ENV0100 ;EP Version 1.0 Environment check "RTN","BSDX11",5,0) I '$G(IOM) D HOME^%ZIS "RTN","BSDX11",6,0) I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q "RTN","BSDX11",7,0) I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q "RTN","BSDX11",8,0) I '(DUZ(0)["@") W:'$D(ZTQUEUED) !,"DUZ(0) DOES NOT CONTAIN AN '@'." D SORRY(2) Q "RTN","BSDX11",9,0) S X=$$GET1^DIQ(200,DUZ,.01) "RTN","BSDX11",10,0) W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM) "RTN","BSDX11",11,0) W !!,$$CJ^XLFSTR("Checking Environment...",IOM) "RTN","BSDX11",12,0) ; "RTN","BSDX11",13,0) ;is the PIMS requirement present? "RTN","BSDX11",14,0) I '$$INSTALLD("PIMS*5.3*1003") D "RTN","BSDX11",15,0) .D BMES^XPDUTL("Version 1.0 of the BSDX Package") "RTN","BSDX11",16,0) . D BMES^XPDUTL("Cannot Be Installed Unless") "RTN","BSDX11",17,0) . D BMES^XPDUTL("Patch 1003 of version 5.3 of the PIMS Package has been installed.") "RTN","BSDX11",18,0) . D SORRY(2) "RTN","BSDX11",19,0) . Q "RTN","BSDX11",20,0) ;is the BMX requirement present? "RTN","BSDX11",21,0) I '$$INSTALLD("BMX 1.0") D "RTN","BSDX11",22,0) .D BMES^XPDUTL("Version 1.0 of the BSDX Package") "RTN","BSDX11",23,0) . D BMES^XPDUTL("Cannot Be Installed Unless") "RTN","BSDX11",24,0) . D BMES^XPDUTL("version 1.0 of the BMX Package has been installed.") "RTN","BSDX11",25,0) . D SORRY(2) "RTN","BSDX11",26,0) . Q "RTN","BSDX11",27,0) Q "RTN","BSDX11",28,0) ;End Environment check "RTN","BSDX11",29,0) ; "RTN","BSDX11",30,0) V0100 ;EP Version 1.0 PostInit "RTN","BSDX11",31,0) ;Add Protocol items to BSDAM APPOINTMENT EVENTS protocol "RTN","BSDX11",32,0) ; "RTN","BSDX11",33,0) N BSDXDA,BSDXFDA,BSDXDA1,BSDXSEQ,BSDXDAT,BSDXNOD,BSDXIEN,BSDXMSG "RTN","BSDX11",34,0) S BSDXDA=$O(^ORD(101,"B","BSDAM APPOINTMENT EVENTS",0)) "RTN","BSDX11",35,0) Q:'+BSDXDA "RTN","BSDX11",36,0) S BSDXDAT="BSDX ADD APPOINTMENT;10.2^BSDX CANCEL APPOINTMENT;10.4^BSDX CHECKIN APPOINTMENT;10.6^BSDX NOSHOW APPOINTMENT;10.8" "RTN","BSDX11",37,0) F J=1:1:$L(BSDXDAT,U) D "RTN","BSDX11",38,0) . K BSDXIEN,BSDXMSG,BSDXFDA "RTN","BSDX11",39,0) . S BSDXNOD=$P(BSDXDAT,U,J) "RTN","BSDX11",40,0) . S BSDXDA1=$P(BSDXNOD,";") "RTN","BSDX11",41,0) . S BSDXSEQ=$P(BSDXNOD,";",2) "RTN","BSDX11",42,0) . S BSDXDA1=$O(^ORD(101,"B",BSDXDA1,0)) "RTN","BSDX11",43,0) . Q:'+BSDXDA1 "RTN","BSDX11",44,0) . Q:$D(^ORD(101,BSDXDA,10,"B",BSDXDA1)) "RTN","BSDX11",45,0) . S BSDXFDA(101.01,"+1,"_BSDXDA_",",".01")=BSDXDA1 "RTN","BSDX11",46,0) . S BSDXFDA(101.01,"+1,"_BSDXDA_",","3")=BSDXSEQ "RTN","BSDX11",47,0) . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX11",48,0) . Q "RTN","BSDX11",49,0) Q "RTN","BSDX11",50,0) ; "RTN","BSDX11",51,0) SORRY(X) ; "RTN","BSDX11",52,0) KILL DIFQ "RTN","BSDX11",53,0) S XPDQUIT=X "RTN","BSDX11",54,0) W *7,!,$$CJ^XLFSTR("Sorry....Please fix it.",IOM) "RTN","BSDX11",55,0) Q "RTN","BSDX11",56,0) ; "RTN","BSDX11",57,0) INSTALLD(BMXPKG) ; "RTN","BSDX11",58,0) ;Determine if BMXPKG is present. "RTN","BSDX11",59,0) Q 1 "RTN","BSDX11",60,0) ;S BSDXFIN=$O(^XPD(9.7,"B","PIMS*5.3*1003","")) "RTN","BSDX11",61,0) S BSDXFIN=$O(^XPD(9.7,"B",BMXPKG,"")) "RTN","BSDX11",62,0) I $G(BSDXFIN)="" Q 0 "RTN","BSDX11",63,0) S BSDXSTAT=$P($G(^XPD(9.7,BSDXFIN,0)),U,9) "RTN","BSDX11",64,0) ;'0' Loaded from Distribution "RTN","BSDX11",65,0) ;'1' Queued for Install "RTN","BSDX11",66,0) ;'2' Start of Install "RTN","BSDX11",67,0) ;'3' Install Completed "RTN","BSDX11",68,0) ;'4' FOR De-Installed; "RTN","BSDX11",69,0) ; "RTN","BSDX11",70,0) I BSDXSTAT'=3 Q 0 "RTN","BSDX11",71,0) Q 1 "RTN","BSDX12") 0^10^B7203579 "RTN","BSDX12",1,0) BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:14pm "RTN","BSDX12",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX12",3,0) ; "RTN","BSDX12",4,0) ; Change Log: "RTN","BSDX12",5,0) ; v 1.3 - i18n support - 3100718 "RTN","BSDX12",6,0) ; BSDXSTART and BSDXEND passed in FM Dates, not US dates "RTN","BSDX12",7,0) ; "RTN","BSDX12",8,0) ; "RTN","BSDX12",9,0) AVADD(BSDXY,BSDXSTART,BSDXEND,BSDXTYPID,BSDXRES,BSDXSLOTS,BSDXNOTE) ;EP "RTN","BSDX12",10,0) ;Called by BSDX ADD NEW AVAILABILITY "RTN","BSDX12",11,0) ;Create entry in BSDX ACCESS BLOCK "RTN","BSDX12",12,0) ; "RTN","BSDX12",13,0) ;BSDXRES is Resource Name "RTN","BSDX12",14,0) ;Returns recordset having fields "RTN","BSDX12",15,0) ; AvailabilityID and ErrorNumber "RTN","BSDX12",16,0) ; "RTN","BSDX12",17,0) ;Test lines: "RTN","BSDX12",18,0) ;D AVADD^BSDX12(.RES,"3091227.09","3091227.0930","1","WHITT",2,"SCRATCH AV NOTE") ZW RES "RTN","BSDX12",19,0) ;BSDX ADD NEW AVAILABILITY^3091227.09^3091227.0930^1^WHITT^2^SCRATCH AVAILABILITY NOTE "RTN","BSDX12",20,0) ; "RTN","BSDX12",21,0) N BSDXERR,BSDXIEN,BSDXDEP,BSDXI,BSDXAVID,BSDXI,BSDXERR,BSDXFDA,BSDXMSG,BSDXRESD "RTN","BSDX12",22,0) K ^BSDXTMP($J) "RTN","BSDX12",23,0) S BSDXERR=0 "RTN","BSDX12",24,0) S BSDXI=0 "RTN","BSDX12",25,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX12",26,0) S ^BSDXTMP($J,0)="I00020AVAILABILITYID^I00020ERRORID"_$C(30) "RTN","BSDX12",27,0) ;Check input data for errors "RTN","BSDX12",28,0) ; i18n - FM Dates passed in "RTN","BSDX12",29,0) ; S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@") "RTN","BSDX12",30,0) ; S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@") "RTN","BSDX12",31,0) ; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y "RTN","BSDX12",32,0) ; I BSDXSTART=-1 D ERR(70) Q "RTN","BSDX12",33,0) ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y "RTN","BSDX12",34,0) ; I BSDXEND=-1 D ERR(70) Q "RTN","BSDX12",35,0) ; Make sure dates are canonical and don't contain extra zeros "RTN","BSDX12",36,0) S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND "RTN","BSDX12",37,0) ; "RTN","BSDX12",38,0) I $L(BSDXEND,".")=1 D ERR(70) Q "RTN","BSDX12",39,0) I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP "RTN","BSDX12",40,0) ;Validate Access Type "RTN","BSDX12",41,0) I '+BSDXTYPID,'$D(^BSDXTYPE(BSDXTYPID,0)) D ERR(70) Q "RTN","BSDX12",42,0) ;Validate Resource "RTN","BSDX12",43,0) I '$D(^BSDXRES("B",BSDXRES)) S BSDXERR=70 D ERR(BSDXERR) Q "RTN","BSDX12",44,0) S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0)) I '+BSDXRESD S BSDXERR=70 D ERR(BSDXERR) Q "RTN","BSDX12",45,0) ; "RTN","BSDX12",46,0) ;Create entry in BSDX ACCESS BLOCK "RTN","BSDX12",47,0) S BSDXFDA(9002018.3,"+1,",.01)=BSDXRESD "RTN","BSDX12",48,0) S BSDXFDA(9002018.3,"+1,",.02)=BSDXSTART "RTN","BSDX12",49,0) S BSDXFDA(9002018.3,"+1,",.03)=BSDXEND "RTN","BSDX12",50,0) S BSDXFDA(9002018.3,"+1,",.04)=BSDXSLOTS "RTN","BSDX12",51,0) S BSDXFDA(9002018.3,"+1,",.05)=BSDXTYPID "RTN","BSDX12",52,0) K BSDXIEN,BSDXMSG "RTN","BSDX12",53,0) D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX12",54,0) S BSDXAVID=+$G(BSDXIEN(1)) "RTN","BSDX12",55,0) I 'BSDXAVID D ERR(70) Q "RTN","BSDX12",56,0) ; "RTN","BSDX12",57,0) ;Add WP field "RTN","BSDX12",58,0) I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" "RTN","BSDX12",59,0) I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) "RTN","BSDX12",60,0) I $D(BSDXNOTE(.5)) D "RTN","BSDX12",61,0) . D WP^DIE(9002018.3,BSDXAVID_",",1,"","BSDXNOTE","BSDXMSG") "RTN","BSDX12",62,0) ; "RTN","BSDX12",63,0) ;Return Recordset "RTN","BSDX12",64,0) S BSDXI=BSDXI+1 "RTN","BSDX12",65,0) S ^BSDXTMP($J,BSDXI)=BSDXAVID_"^-1"_$C(30) "RTN","BSDX12",66,0) S BSDXI=BSDXI+1 "RTN","BSDX12",67,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX12",68,0) Q "RTN","BSDX12",69,0) ; "RTN","BSDX12",70,0) ERR(ERRNO) ;Error processing "RTN","BSDX12",71,0) S BSDXERR=ERRNO+134234112 ;vbObjectError "RTN","BSDX12",72,0) S BSDXI=BSDXI+1 "RTN","BSDX12",73,0) S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30) "RTN","BSDX12",74,0) S BSDXI=BSDXI+1 "RTN","BSDX12",75,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX12",76,0) Q "RTN","BSDX13") 0^11^B9753753 "RTN","BSDX13",1,0) BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:17pm "RTN","BSDX13",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX13",3,0) ; "RTN","BSDX13",4,0) ; Change Log: "RTN","BSDX13",5,0) ; V 1.3 - i18n support - Dates passed to Routine as FM Date - WV/SMH "RTN","BSDX13",6,0) Q "RTN","BSDX13",7,0) AVDELDTD(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP "RTN","BSDX13",8,0) ;Entry point for debugging "RTN","BSDX13",9,0) ; "RTN","BSDX13",10,0) ;D DEBUG^%Serenji("AVDELDT^BSDX13(.BSDXY,BSDXRESD,BSDXSTART,BSDXEND)") "RTN","BSDX13",11,0) Q "RTN","BSDX13",12,0) ; "RTN","BSDX13",13,0) AVDELDT(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP "RTN","BSDX13",14,0) ;Cancel availability in a date range "RTN","BSDX13",15,0) ;Called by BSDX CANCEL AV BY DATE "RTN","BSDX13",16,0) ; "RTN","BSDX13",17,0) ;BSDXRESD is BSDX RESOURCE ien "RTN","BSDX13",18,0) ;BSDXSTART and BSDXEND are FM dates (change in v 1.3) "RTN","BSDX13",19,0) ; "RTN","BSDX13",20,0) S X="ERROR^BSDX13",@^%ZOSF("TRAP") "RTN","BSDX13",21,0) N BMXIEN,BSDXI "RTN","BSDX13",22,0) S BSDXI=0 "RTN","BSDX13",23,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX13",24,0) K ^BSDXTMP($J) "RTN","BSDX13",25,0) S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30) "RTN","BSDX13",26,0) ; S X=BSDXSTART ; commented out *v1.3 "RTN","BSDX13",27,0) ; S %DT="X" D ^%DT "RTN","BSDX13",28,0) ; I Y=-1 D ERR(0,"AVDELDT-BSDX13: Invalid Start Date") Q "RTN","BSDX13",29,0) ; S BSDXSTART=$P(Y,".") "RTN","BSDX13",30,0) ; S X=BSDXEND "RTN","BSDX13",31,0) ; S %DT="X" D ^%DT "RTN","BSDX13",32,0) ; I Y=-1 D ERR(0,"AVDELDT-BSDX13: Invalid End Date") Q "RTN","BSDX13",33,0) S BSDXEND=$P(Y,".")_".99999" "RTN","BSDX13",34,0) I '+BSDXRESD D ERR(0,"AVDELDT-BSDX13: Invalid Resource ID") Q "RTN","BSDX13",35,0) ; "RTN","BSDX13",36,0) F S BSDXSTART=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXSTART)) Q:'+BSDXSTART Q:BSDXSTART>BSDXEND D "RTN","BSDX13",37,0) . S BMXIEN=0 "RTN","BSDX13",38,0) . F S BMXIEN=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXSTART,BMXIEN)) Q:'+BMXIEN D "RTN","BSDX13",39,0) . . D CALLDIK(BMXIEN) "RTN","BSDX13",40,0) ; "RTN","BSDX13",41,0) S BSDXI=BSDXI+1 "RTN","BSDX13",42,0) S ^BSDXTMP($J,BSDXI)="-1^"_$C(30)_$C(31) "RTN","BSDX13",43,0) Q "RTN","BSDX13",44,0) ERROR ; "RTN","BSDX13",45,0) D ^%ZTER "RTN","BSDX13",46,0) I '+$G(BSDXI) N BSDXI S BSDXI=999999 "RTN","BSDX13",47,0) S BSDXI=BSDXI+1 "RTN","BSDX13",48,0) D ERR(0,"BSDX13 M Error: <"_$G(%ZTERROR)_">") "RTN","BSDX13",49,0) Q "RTN","BSDX13",50,0) ; "RTN","BSDX13",51,0) ERR(BSDXERID,ERRTXT) ;Error processing "RTN","BSDX13",52,0) S:'+$G(BSDXI) BSDXI=999999 "RTN","BSDX13",53,0) S BSDXI=BSDXI+1 "RTN","BSDX13",54,0) S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) "RTN","BSDX13",55,0) S BSDXI=BSDXI+1 "RTN","BSDX13",56,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX13",57,0) Q "RTN","BSDX13",58,0) ; "RTN","BSDX13",59,0) AVDEL(BSDXY,BSDXAVID) ;EP "RTN","BSDX13",60,0) ;Called by BSDX CANCEL AVAILABILITY "RTN","BSDX13",61,0) ;Deletes Access block "RTN","BSDX13",62,0) ;BSDXAVID is entry number in BSDX AVAILABILITY file "RTN","BSDX13",63,0) ;Returns error code in recordset field ERRORID "RTN","BSDX13",64,0) ; "RTN","BSDX13",65,0) S X="ERROR^BSDX13",@^%ZOSF("TRAP") "RTN","BSDX13",66,0) N BSDXNOD,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXEND,BSDXRSID "RTN","BSDX13",67,0) ; "RTN","BSDX13",68,0) S BSDXI=0 "RTN","BSDX13",69,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX13",70,0) K ^BSDXTMP($J) "RTN","BSDX13",71,0) S ^BSDXTMP($J,0)="I00020ERRORID^T00030ERRORTEXT"_$C(30) "RTN","BSDX13",72,0) I '+BSDXAVID D ERR(70) Q "RTN","BSDX13",73,0) I '$D(^BSDXAB(BSDXAVID,0)) D ERR(70) Q "RTN","BSDX13",74,0) ; "RTN","BSDX13",75,0) ; "RTN","BSDX13",76,0) ;TODO: Test for existing appointments in availability block "RTN","BSDX13",77,0) ; (corresponds to old qryAppointmentBlocksOverlapC "RTN","BSDX13",78,0) ; and AVBlockHasAppointments) "RTN","BSDX13",79,0) ; "RTN","BSDX13",80,0) ;I $$APTINBLK(BSDXAVID) D ERR(20) Q "RTN","BSDX13",81,0) ; "RTN","BSDX13",82,0) ;Delete AVAILABILITY entries "RTN","BSDX13",83,0) D CALLDIK(BSDXAVID) "RTN","BSDX13",84,0) ; "RTN","BSDX13",85,0) S BSDXI=BSDXI+1 "RTN","BSDX13",86,0) S ^BSDXTMP($J,BSDXI)="-1^"_$C(30)_$C(31) "RTN","BSDX13",87,0) Q "RTN","BSDX13",88,0) ; "RTN","BSDX13",89,0) CALLDIK(BSDXAVID) ; "RTN","BSDX13",90,0) ;Delete AVAILABILITY entries "RTN","BSDX13",91,0) ; "RTN","BSDX13",92,0) S DIK="^BSDXAB(" "RTN","BSDX13",93,0) S DA=BSDXAVID "RTN","BSDX13",94,0) D ^DIK "RTN","BSDX13",95,0) ; "RTN","BSDX13",96,0) Q "RTN","BSDX13",97,0) ; "RTN","BSDX13",98,0) APTINBLK(BSDXAVID) ; "RTN","BSDX13",99,0) ; "RTN","BSDX13",100,0) ;NOTE: This Subroutine Not called in current version. Keep code for later use. "RTN","BSDX13",101,0) ; "RTN","BSDX13",102,0) ;N BSDXS,BSDXID,BSDXHIT,BSDXNOD,BSDXE,BSDXSTART,BSDXEND,BSDXRSID "RTN","BSDX13",103,0) ;S BSDXNOD=^BSDXAB(BSDXAVID,0) "RTN","BSDX13",104,0) ;S BSDXSTART=$P(BSDXNOD,U,3) "RTN","BSDX13",105,0) ;S BSDXEND=$P(BSDXNOD,U,4) "RTN","BSDX13",106,0) ;S BSDXRSID=$P(BSDXNOD,U,1) "RTN","BSDX13",107,0) ;I '$D(^BSDXDAPRS("ARSRC",BSDXRSID)) Q 0 "RTN","BSDX13",108,0) ;;If any appointments start at the AV block start time: "RTN","BSDX13",109,0) ;I $D(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXSTART)) Q 1 "RTN","BSDX13",110,0) ;;Find the first appt time BSDXS on the same day as the av block "RTN","BSDX13",111,0) ;S BSDXS=$O(^BSDXDAPRS("ARSRC",BSDXRSID,$P(BSDXSTART,"."))) "RTN","BSDX13",112,0) ;I BSDXS>BSDXEND Q 0 "RTN","BSDX13",113,0) ;;For all the appts that day with start times less "RTN","BSDX13",114,0) ;;than the av block's end time, find any whose end time is "RTN","BSDX13",115,0) ;;greater than the av block's start time "RTN","BSDX13",116,0) ;S BSDXHIT=0 "RTN","BSDX13",117,0) ;S BSDXS=BSDXS-.0001 "RTN","BSDX13",118,0) ;F S BSDXS=$O(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXS)) Q:'+BSDXS Q:BSDXS'BSDXSTART S BSDXHIT=1 Q "RTN","BSDX13",124,0) ;; "RTN","BSDX13",125,0) ;I BSDXHIT Q 1 "RTN","BSDX13",126,0) Q 0 "RTN","BSDX13",127,0) ; "RTN","BSDX13",128,0) ;ERR(ERRNO) ;Error processing "RTN","BSDX13",129,0) ;N BSDXERR "RTN","BSDX13",130,0) ;S BSDXERR=ERRNO+134234112 ;vbObjectError "RTN","BSDX13",131,0) ;S BSDXI=BSDXI+1 "RTN","BSDX13",132,0) ;S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) "RTN","BSDX13",133,0) ;S BSDXI=BSDXI+1 "RTN","BSDX13",134,0) ;S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX13",135,0) ;Q "RTN","BSDX14") 0^12^B6450810 "RTN","BSDX14",1,0) BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX14",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX14",3,0) ; "RTN","BSDX14",4,0) ; "RTN","BSDX14",5,0) ACCTYPD(BSDXY,BSDXVAL) ;EP "RTN","BSDX14",6,0) ;Entry point for debugging "RTN","BSDX14",7,0) ; "RTN","BSDX14",8,0) ;D DEBUG^%Serenji("ACCTYP^BSDX14(.BSDXY,BSDXVAL)") "RTN","BSDX14",9,0) Q "RTN","BSDX14",10,0) ; "RTN","BSDX14",11,0) ACCTYP(BSDXY,BSDXVAL) ;EP "RTN","BSDX14",12,0) ;Called by BSDX ADD/EDIT ACCESS TYPE "RTN","BSDX14",13,0) ;Add/Edit ACCESS TYPE entry "RTN","BSDX14",14,0) ;BSDXVAL is IEN|NAME|INACTIVE|COLOR|RED|GREEN|BLUE "RTN","BSDX14",15,0) ;If IEN=0 Then this is a new ACCTYPE "RTN","BSDX14",16,0) ;Test Line: "RTN","BSDX14",17,0) ;D ACCTYP^BSDX14(.RES,"0|ORAL HYGIENE|false|Red") "RTN","BSDX14",18,0) ; "RTN","BSDX14",19,0) S X="ERROR^BSDX14",@^%ZOSF("TRAP") "RTN","BSDX14",20,0) N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXNAM "RTN","BSDX14",21,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX14",22,0) S ^BSDXTMP($J,0)="I00020ACCESSTYPEID^T00030ERRORTEXT"_$C(30) "RTN","BSDX14",23,0) I BSDXVAL="" D ERR(0,"BSDX14: Invalid null input Parameter") Q "RTN","BSDX14",24,0) S BSDXIEN=$P(BSDXVAL,"|") "RTN","BSDX14",25,0) I +BSDXIEN D "RTN","BSDX14",26,0) . S BSDX="EDIT" "RTN","BSDX14",27,0) . S BSDXIENS=BSDXIEN_"," "RTN","BSDX14",28,0) E D "RTN","BSDX14",29,0) . S BSDX="ADD" "RTN","BSDX14",30,0) . S BSDXIENS="+1," "RTN","BSDX14",31,0) ; "RTN","BSDX14",32,0) S BSDXNAM=$P(BSDXVAL,"|",2) "RTN","BSDX14",33,0) I BSDXNAM="" D ERR(0,"BSDX14: Invalid null Access Type name.") Q "RTN","BSDX14",34,0) ; "RTN","BSDX14",35,0) ;Prevent adding entry with duplicate name "RTN","BSDX14",36,0) I $D(^BSDXTYPE("B",BSDXNAM)),$O(^BSDXTYPE("B",BSDXNAM,0))'=BSDXIEN D Q "RTN","BSDX14",37,0) . D ERR(0,"BSDX14: Cannot have two Access Types with the same name.") "RTN","BSDX14",38,0) . Q "RTN","BSDX14",39,0) ; "RTN","BSDX14",40,0) S BSDXINA=$P(BSDXVAL,"|",3) "RTN","BSDX14",41,0) S BSDXINA=$S(BSDXINA="YES":1,1:0) "RTN","BSDX14",42,0) ; "RTN","BSDX14",43,0) S BSDXFDA(9002018.35,BSDXIENS,.01)=$P(BSDXVAL,"|",2) ;NAME "RTN","BSDX14",44,0) S BSDXFDA(9002018.35,BSDXIENS,.02)=BSDXINA ;INACTIVE "RTN","BSDX14",45,0) S BSDXFDA(9002018.35,BSDXIENS,.04)=$P(BSDXVAL,"|",4) ;COLOR "RTN","BSDX14",46,0) S BSDXFDA(9002018.35,BSDXIENS,.05)=$P(BSDXVAL,"|",5) ;RED "RTN","BSDX14",47,0) S BSDXFDA(9002018.35,BSDXIENS,.06)=$P(BSDXVAL,"|",6) ;GREEN "RTN","BSDX14",48,0) S BSDXFDA(9002018.35,BSDXIENS,.07)=$P(BSDXVAL,"|",7) ;BLUE "RTN","BSDX14",49,0) K BSDXMSG "RTN","BSDX14",50,0) I BSDX="ADD" D "RTN","BSDX14",51,0) . K BSDXIEN "RTN","BSDX14",52,0) . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX14",53,0) . S BSDXIEN=+$G(BSDXIEN(1)) "RTN","BSDX14",54,0) E D "RTN","BSDX14",55,0) . D FILE^DIE("","BSDXFDA","BSDXMSG") "RTN","BSDX14",56,0) S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^-1"_$C(30)_$C(31) "RTN","BSDX14",57,0) Q "RTN","BSDX14",58,0) ; "RTN","BSDX14",59,0) ERR(BSDXERID,ERRTXT) ;Error processing "RTN","BSDX14",60,0) S:'+$G(BSDXI) BSDXI=999999 "RTN","BSDX14",61,0) S BSDXI=BSDXI+1 "RTN","BSDX14",62,0) S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) "RTN","BSDX14",63,0) S BSDXI=BSDXI+1 "RTN","BSDX14",64,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX14",65,0) Q "RTN","BSDX14",66,0) ; "RTN","BSDX14",67,0) ERROR ; "RTN","BSDX14",68,0) D ^%ZTER "RTN","BSDX14",69,0) I '+$G(BSDXI) N BSDXI S BSDXI=999999 "RTN","BSDX14",70,0) S BSDXI=BSDXI+1 "RTN","BSDX14",71,0) D ERR(0,"BSDX14 M Error: <"_$G(%ZTERROR)_">") "RTN","BSDX14",72,0) Q "RTN","BSDX15") 0^13^B5327807 "RTN","BSDX15",1,0) BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX15",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX15",3,0) ; "RTN","BSDX15",4,0) ; "RTN","BSDX15",5,0) GRPTYP(BSDXY) ;EP "RTN","BSDX15",6,0) ;Called by BSDX GET ACCESS GROUP TYPES "RTN","BSDX15",7,0) ;Returns ADO recordset containing ACTIVE Access types ordered alphabetically "RTN","BSDX15",8,0) ;by Access Group "RTN","BSDX15",9,0) ;AccessGroupID, AccessGroup, AccessTypeID, AccessType "RTN","BSDX15",10,0) ; "RTN","BSDX15",11,0) ;Test Code: "RTN","BSDX15",12,0) ;D GRPTYP^BSDX15(.RES) ZW RES "RTN","BSDX15",13,0) ; "RTN","BSDX15",14,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX15",15,0) N BSDX1 "RTN","BSDX15",16,0) S BSDXI=0 "RTN","BSDX15",17,0) S X="ETRAP^BSDX15",@^%ZOSF("TRAP") "RTN","BSDX15",18,0) S ^BSDXTMP($J,BSDXI)="I00020ACCESS_GROUP_TYPEID^I00020ACCESS_GROUP_ID^T00030ACCESS_GROUP^I00020ACCESS_TYPE_ID^T00030ACCESS_TYPE"_$C(30) "RTN","BSDX15",19,0) ; "RTN","BSDX15",20,0) ;N BSDX0,BSDX1,BSDXNOD,BSDXGPN,BSDXTN "RTN","BSDX15",21,0) ;$O Through "B" x-ref of BSDX ACCESS GROUP file "RTN","BSDX15",22,0) ;S BSDXGPN=0 F S BSDXGPN=$O(^BSDXAGP("B",BSDXGPN)) Q:BSDXGPN="" D "RTN","BSDX15",23,0) ;. S BSDX0=$O(^BSDXAGP("B",BSDXGPN,0)) "RTN","BSDX15",24,0) ;. Q:'+BSDX0 "RTN","BSDX15",25,0) ;. Q:'$D(^BSDXAGP(BSDX0,0)) ;INDEX VALIDITY CHECK "RTN","BSDX15",26,0) ;. Q:'$D(^BSDXAGTP("B",BSDX0)) "RTN","BSDX15",27,0) ;. ;$O through "B" x-ref of BSDX ACCESS GROUP TYPE "RTN","BSDX15",28,0) ;. S BSDX1=0 F S BSDX1=$O(^BSDXAGTP("B",BSDX0,BSDX1)) Q:'+BSDX1 D "RTN","BSDX15",29,0) ;. . Q:'$D(^BSDXAGTP(BSDX1,0)) "RTN","BSDX15",30,0) ;. . S BSDX2=$P(^BSDXAGTP(BSDX1,0),U,2) "RTN","BSDX15",31,0) ;. . Q:'+BSDX2 "RTN","BSDX15",32,0) ;. . Q:'$D(^BSDXTYPE(BSDX2,0)) "RTN","BSDX15",33,0) ;. . S BSDXNOD=^BSDXTYPE(BSDX2,0) "RTN","BSDX15",34,0) ;. . Q:$P(BSDXNOD,U,2)=1 ;INACTIVE "RTN","BSDX15",35,0) ;. . S BSDXTN=$P(BSDXNOD,U) "RTN","BSDX15",36,0) ;. . S BSDXI=BSDXI+1 "RTN","BSDX15",37,0) ;. . S ^BSDXTMP($J,BSDXI)=BSDX1_U_BSDX0_U_BSDXGPN_U_BSDX2_U_BSDXTN_$C(30) "RTN","BSDX15",38,0) ;. . Q "RTN","BSDX15",39,0) ;. Q "RTN","BSDX15",40,0) ; "RTN","BSDX15",41,0) ;$O Through "AC" x-ref of BSDX ACCESS GROUP TYPE file "RTN","BSDX15",42,0) N BSDXAGID,BSDXAGN,BSDXATID,BSDXATN,BSDXAGTID "RTN","BSDX15",43,0) S BSDXAGID=0 "RTN","BSDX15",44,0) F S BSDXAGID=$O(^BSDXAGTP("AC",BSDXAGID)) Q:'+BSDXAGID D "RTN","BSDX15",45,0) . I '$D(^BSDXAGP(BSDXAGID,0)) Q "RTN","BSDX15",46,0) . S BSDXAGN=$P(^BSDXAGP(BSDXAGID,0),U) "RTN","BSDX15",47,0) . S BSDXATID=0 F S BSDXATID=$O(^BSDXAGTP("AC",BSDXAGID,BSDXATID)) Q:'+BSDXATID D "RTN","BSDX15",48,0) . . S BSDXNOD=$G(^BSDXTYPE(BSDXATID,0)) "RTN","BSDX15",49,0) . . I BSDXNOD="" Q "RTN","BSDX15",50,0) . . I $P(BSDXNOD,U,2)=1 Q ;Inactive "RTN","BSDX15",51,0) . . S BSDXATN=$P(BSDXNOD,U) "RTN","BSDX15",52,0) . . S BSDXAGTID=$O(^BSDXAGTP("AC",BSDXAGID,BSDXATID,0)) "RTN","BSDX15",53,0) . . I '+BSDXAGTID Q "RTN","BSDX15",54,0) . . I '$D(^BSDXAGTP(BSDXAGTID,0)) Q "RTN","BSDX15",55,0) . . S BSDXI=BSDXI+1 "RTN","BSDX15",56,0) . . S ^BSDXTMP($J,BSDXI)=BSDXAGTID_U_BSDXAGID_U_BSDXAGN_U_BSDXATID_U_BSDXATN_$C(30) "RTN","BSDX15",57,0) . . Q "RTN","BSDX15",58,0) . Q "RTN","BSDX15",59,0) ; "RTN","BSDX15",60,0) S BSDXI=BSDXI+1 "RTN","BSDX15",61,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX15",62,0) Q "RTN","BSDX15",63,0) ; "RTN","BSDX15",64,0) ERR(BSDXI,BSDXID,BSDXERR) ;Error processing "RTN","BSDX15",65,0) S BSDXI=BSDXI+1 "RTN","BSDX15",66,0) S ^BSDXTMP($J,BSDXI)=BSDXERR_"^^^^"_$C(30) "RTN","BSDX15",67,0) S BSDXI=BSDXI+1 "RTN","BSDX15",68,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX15",69,0) Q "RTN","BSDX15",70,0) ; "RTN","BSDX15",71,0) ETRAP ;EP Error trap entry "RTN","BSDX15",72,0) I '$D(BSDXI) N BSDXI S BSDXI=999 "RTN","BSDX15",73,0) S BSDXI=BSDXI+1 "RTN","BSDX15",74,0) D ERR(BSDXI,99,70) "RTN","BSDX15",75,0) Q "RTN","BSDX16") 0^14^B11948965 "RTN","BSDX16",1,0) BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX16",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX16",3,0) ; "RTN","BSDX16",4,0) ; "RTN","BSDX16",5,0) RSRCD(BSDXY,BSDXVAL) ;EP "RTN","BSDX16",6,0) ;Entry point for debugging "RTN","BSDX16",7,0) ; "RTN","BSDX16",8,0) ;D DEBUG^%Serenji("RSRC^BSDX16(.BSDXY,BSDXVAL)") "RTN","BSDX16",9,0) Q "RTN","BSDX16",10,0) ; "RTN","BSDX16",11,0) RSRC(BSDXY,BSDXVAL) ;EP "RTN","BSDX16",12,0) ; "RTN","BSDX16",13,0) ;Called by BSDX ADD/EDIT RESOURCE "RTN","BSDX16",14,0) ;Add/Edit BSDX RESOURCE entry "RTN","BSDX16",15,0) ;BSDXVAL is sResourceID|sResourceName|sInactive|sHospLocID|TIME_SCALE|LETTER_TEXT|NO_SHOW_LETTER|CANCELLATION_LETTER "RTN","BSDX16",16,0) ;If IEN=0 Then this is a new Resource "RTN","BSDX16",17,0) ;Test Line: "RTN","BSDX16",18,0) ;D RSRC^BSDX16(.RES,"sResourceID|sResourceName|sInactive|sHospLocID") "RTN","BSDX16",19,0) ; "RTN","BSDX16",20,0) S X="ERROR^BSDX16",@^%ZOSF("TRAP") "RTN","BSDX16",21,0) N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXINA,BSDXNOTE,BSDXNAM "RTN","BSDX16",22,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX16",23,0) K ^BSDXTMP($J) "RTN","BSDX16",24,0) S ^BSDXTMP($J,0)="I00020RESOURCEID^T00030ERRORTEXT"_$C(30) "RTN","BSDX16",25,0) ; Changed following from a $G = "" to $D check: $G didn't work since BSDXVAL is an array. MJL 10/18/2006 "RTN","BSDX16",26,0) I BSDXVAL="",$D(BSDXVAL)<2 D ERR(0,"BSDX16: Invalid null input Parameter") Q "RTN","BSDX16",27,0) ;Unpack array at @XWBARY "RTN","BSDX16",28,0) I BSDXVAL="" D "RTN","BSDX16",29,0) . N BSDXC S BSDXC=0 F S BSDXC=$O(BSDXVAL(BSDXC)) Q:'BSDXC D "RTN","BSDX16",30,0) . . S BSDXVAL=BSDXVAL_BSDXVAL(BSDXC) "RTN","BSDX16",31,0) S BSDXIEN=$P(BSDXVAL,"|") "RTN","BSDX16",32,0) I +BSDXIEN D "RTN","BSDX16",33,0) . S BSDX="EDIT" "RTN","BSDX16",34,0) . S BSDXIENS=BSDXIEN_"," "RTN","BSDX16",35,0) E D "RTN","BSDX16",36,0) . S BSDX="ADD" "RTN","BSDX16",37,0) . S BSDXIENS="+1," "RTN","BSDX16",38,0) ; "RTN","BSDX16",39,0) S BSDXNAM=$P(BSDXVAL,"|",2) "RTN","BSDX16",40,0) ;Prevent adding entry with duplicate name "RTN","BSDX16",41,0) I $D(^BSDXRES("B",BSDXNAM)),$O(^BSDXRES("B",BSDXNAM,0))'=BSDXIEN D Q "RTN","BSDX16",42,0) . D ERR(0,"BSDX16: Cannot have two Resources with the same name.") "RTN","BSDX16",43,0) . Q "RTN","BSDX16",44,0) ; "RTN","BSDX16",45,0) S BSDXINA=$P(BSDXVAL,"|",3) "RTN","BSDX16",46,0) S BSDXINA=$S(BSDXINA="YES":1,1:0) "RTN","BSDX16",47,0) ; "RTN","BSDX16",48,0) S BSDXFDA(9002018.1,BSDXIENS,.01)=$P(BSDXVAL,"|",2) ;NAME "RTN","BSDX16",49,0) S BSDXFDA(9002018.1,BSDXIENS,.02)=BSDXINA ;INACTIVE "RTN","BSDX16",50,0) I +$P(BSDXVAL,"|",5) S BSDXFDA(9002018.1,BSDXIENS,.03)=+$P(BSDXVAL,"|",5) ;TIME SCALE "RTN","BSDX16",51,0) I +$P(BSDXVAL,"|",4) S BSDXFDA(9002018.1,BSDXIENS,.04)=$P(BSDXVAL,"|",4) ;HOSPITAL LOCATION "RTN","BSDX16",52,0) K BSDXMSG "RTN","BSDX16",53,0) I BSDX="ADD" D ;TODO: Check for error "RTN","BSDX16",54,0) . K BSDXIEN "RTN","BSDX16",55,0) . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX16",56,0) . S BSDXIEN=+$G(BSDXIEN(1)) "RTN","BSDX16",57,0) E D "RTN","BSDX16",58,0) . D FILE^DIE("","BSDXFDA","BSDXMSG") "RTN","BSDX16",59,0) ; "RTN","BSDX16",60,0) ;LETTER TEXT wp field "RTN","BSDX16",61,0) S BSDXNOTE=$P(BSDXVAL,"|",6) "RTN","BSDX16",62,0) ; "RTN","BSDX16",63,0) I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" "RTN","BSDX16",64,0) I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) "RTN","BSDX16",65,0) ; "RTN","BSDX16",66,0) I $D(BSDXNOTE(.5)) D "RTN","BSDX16",67,0) . D WP^DIE(9002018.1,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG") "RTN","BSDX16",68,0) ; "RTN","BSDX16",69,0) ;NO SHOW LETTER wp fields "RTN","BSDX16",70,0) K BSDXNOTE "RTN","BSDX16",71,0) S BSDXNOTE=$P(BSDXVAL,"|",7) "RTN","BSDX16",72,0) ; "RTN","BSDX16",73,0) I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" "RTN","BSDX16",74,0) I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) "RTN","BSDX16",75,0) ; "RTN","BSDX16",76,0) I $D(BSDXNOTE(.5)) D "RTN","BSDX16",77,0) . D WP^DIE(9002018.1,BSDXIEN_",",1201,"","BSDXNOTE","BSDXMSG") "RTN","BSDX16",78,0) ; "RTN","BSDX16",79,0) ;CANCELLATION LETTER wp field "RTN","BSDX16",80,0) K BSDXNOTE "RTN","BSDX16",81,0) S BSDXNOTE=$P(BSDXVAL,"|",8) "RTN","BSDX16",82,0) ; "RTN","BSDX16",83,0) I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" "RTN","BSDX16",84,0) I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) "RTN","BSDX16",85,0) ; "RTN","BSDX16",86,0) I $D(BSDXNOTE(.5)) D "RTN","BSDX16",87,0) . D WP^DIE(9002018.1,BSDXIEN_",",1301,"","BSDXNOTE","BSDXMSG") "RTN","BSDX16",88,0) ; "RTN","BSDX16",89,0) S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^"_$C(30)_$C(31) "RTN","BSDX16",90,0) Q "RTN","BSDX16",91,0) ; "RTN","BSDX16",92,0) ERROR ; "RTN","BSDX16",93,0) D ^%ZTER "RTN","BSDX16",94,0) I '+$G(BSDXI) N BSDXI S BSDXI=999999 "RTN","BSDX16",95,0) S BSDXI=BSDXI+1 "RTN","BSDX16",96,0) D ERR(0,"BSDX16 M Error: <"_$G(%ZTERROR)_">") "RTN","BSDX16",97,0) Q "RTN","BSDX16",98,0) ; "RTN","BSDX16",99,0) ERR(BSDXERID,ERRTXT) ;Error processing "RTN","BSDX16",100,0) S:'+$G(BSDXI) BSDXI=999999 "RTN","BSDX16",101,0) S BSDXI=BSDXI+1 "RTN","BSDX16",102,0) S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) "RTN","BSDX16",103,0) S BSDXI=BSDXI+1 "RTN","BSDX16",104,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX16",105,0) Q "RTN","BSDX17") 0^15^B2072173 "RTN","BSDX17",1,0) BSDX17 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX17",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX17",3,0) ; "RTN","BSDX17",4,0) ; "RTN","BSDX17",5,0) SCHUSRD(BSDXY) ;EP "RTN","BSDX17",6,0) ;Entry point for debugging "RTN","BSDX17",7,0) ; "RTN","BSDX17",8,0) ;D DEBUG^%Serenji("SCHUSR^BSDX17(.BSDXY)") "RTN","BSDX17",9,0) Q "RTN","BSDX17",10,0) ; "RTN","BSDX17",11,0) SCHUSR(BSDXY) ;EP "RTN","BSDX17",12,0) ;Return recordset of all users in NEW PERSON having BSDXZMENU key "RTN","BSDX17",13,0) ;Called by BSDX SCHEDULE USER "RTN","BSDX17",14,0) ;Test Line: "RTN","BSDX17",15,0) ;D SCHUSR^BSDX17(.RES) "RTN","BSDX17",16,0) ; "RTN","BSDX17",17,0) N BSDXDUZ,BSDXKEY,BSDXI,BSDXNAM,BSDXKEYN "RTN","BSDX17",18,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX17",19,0) K ^TEMP($J,"BSDX17") "RTN","BSDX17",20,0) S BSDXI=0 "RTN","BSDX17",21,0) S ^BSDXTMP($J,0)="I00020USERID^T00030USERNAME"_$C(30) "RTN","BSDX17",22,0) ;$O Through ^VA(200,"AB", "RTN","BSDX17",23,0) F BSDXKEYN="BSDXZMENU","BSDXZMGR","XUPROGMODE" S BSDXKEY=+$O(^DIC(19.1,"B",BSDXKEYN,0)) D "RTN","BSDX17",24,0) . Q:'+BSDXKEY S BSDXDUZ=0 F S BSDXDUZ=$O(^VA(200,"AB",BSDXKEY,BSDXDUZ)) Q:'+BSDXDUZ D "RTN","BSDX17",25,0) . . Q:BSDXDUZ<1 ;IHS/HMW **1** "RTN","BSDX17",26,0) . . Q:'$D(^VA(200,BSDXDUZ,0)) "RTN","BSDX17",27,0) . . Q:$D(^TEMP($J,"BSDX17",BSDXDUZ)) "RTN","BSDX17",28,0) . . S BSDXNAM=$P(^VA(200,BSDXDUZ,0),U) "RTN","BSDX17",29,0) . . S BSDXI=BSDXI+1 "RTN","BSDX17",30,0) . . S ^TEMP($J,"BSDX17",BSDXDUZ)="" "RTN","BSDX17",31,0) . . S ^BSDXTMP($J,BSDXI)=BSDXDUZ_"^"_BSDXNAM_$C(30) "RTN","BSDX17",32,0) . . Q "RTN","BSDX17",33,0) . Q "RTN","BSDX17",34,0) ; "RTN","BSDX17",35,0) S BSDXI=BSDXI+1 "RTN","BSDX17",36,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX17",37,0) Q "RTN","BSDX18") 0^16^B87953431 "RTN","BSDX18",1,0) BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX18",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX18",3,0) ; "RTN","BSDX18",4,0) ; "RTN","BSDX18",5,0) DELRUD(BSDXY,BSDXIEN) ;EP "RTN","BSDX18",6,0) ;Entry point for debugging "RTN","BSDX18",7,0) ; "RTN","BSDX18",8,0) ;D DEBUG^%Serenji("DELRU^BSDX18(.BSDXY,BSDXIEN)") "RTN","BSDX18",9,0) Q "RTN","BSDX18",10,0) ; "RTN","BSDX18",11,0) DELRU(BSDXY,BSDXIEN) ;EP "RTN","BSDX18",12,0) ;Deletes entry BSDXIEN from RESOURCE USERS file "RTN","BSDX18",13,0) ;Return recordset containing error message or "" if no error "RTN","BSDX18",14,0) ;Called by BSDX DELETE RESOURCEUSER "RTN","BSDX18",15,0) ;Test Line: "RTN","BSDX18",16,0) ;D DELRU^BSDX18(.RES,99) "RTN","BSDX18",17,0) ; "RTN","BSDX18",18,0) N BSDXI,DIK,DA "RTN","BSDX18",19,0) S BSDXI=0 "RTN","BSDX18",20,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX18",21,0) S ^BSDXTMP($J,0)="I00020RESOURCEUSERID^I00020ERRORID"_$C(30) "RTN","BSDX18",22,0) I '+BSDXIEN D ERR(BSDXI,BSDXIEN,70) Q "RTN","BSDX18",23,0) I '$D(^BSDXRSU(BSDXIEN,0)) D ERR(BSDXI,BSDXIEN,70) Q "RTN","BSDX18",24,0) ;Delete entry BSDXIEN "RTN","BSDX18",25,0) S DIK="^BSDXRSU(" "RTN","BSDX18",26,0) S DA=BSDXIEN "RTN","BSDX18",27,0) D ^DIK "RTN","BSDX18",28,0) ; "RTN","BSDX18",29,0) S BSDXI=BSDXI+1 "RTN","BSDX18",30,0) S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_"-1"_$C(30)_$C(31) "RTN","BSDX18",31,0) Q "RTN","BSDX18",32,0) ; "RTN","BSDX18",33,0) ADDRUD(BSDXY,BSDXVAL) ;EP "RTN","BSDX18",34,0) ;Entry point for debugging "RTN","BSDX18",35,0) ; "RTN","BSDX18",36,0) ;D DEBUG^%Serenji("ADDRU^BSDX18(.BSDXY,BSDXVAL)") "RTN","BSDX18",37,0) Q "RTN","BSDX18",38,0) ; "RTN","BSDX18",39,0) ADDRU(BSDXY,BSDXVAL) ;EP "RTN","BSDX18",40,0) ; "RTN","BSDX18",41,0) ;Called by BSDX ADD/EDIT RESOURCEUSER "RTN","BSDX18",42,0) ;Add/Edit BSDX RESOURCEUSER entry "RTN","BSDX18",43,0) ;BSDXVAL is sResourceUserID|sOverbook|sModifySchedule|ResourceID|UserID|sModifyAppointments "RTN","BSDX18",44,0) ;If IEN=0 Then this is a new ResourceUser entry "RTN","BSDX18",45,0) ;Test Line: "RTN","BSDX18",46,0) ;D ADDRU^BSDX18(.RES,"sResourceUserID|sOverbook|sModifySchedule|sResourceID|sUserID|sModifyAppointments") "RTN","BSDX18",47,0) ; "RTN","BSDX18",48,0) N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXOVB,BSDXMOD,BSDXI,BSDXUID,BSDXRID "RTN","BSDX18",49,0) N BSDXRES,BSDXRSU,BSDXF,BSDXAPPT "RTN","BSDX18",50,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX18",51,0) S BSDXI=0 "RTN","BSDX18",52,0) S ^BSDXTMP($J,BSDXI)="I00020RESOURCEID^I00020ERRORID"_$C(30) "RTN","BSDX18",53,0) S BSDXIEN=$P(BSDXVAL,"|") "RTN","BSDX18",54,0) I +BSDXIEN D "RTN","BSDX18",55,0) . S BSDX="EDIT" "RTN","BSDX18",56,0) . S BSDXIENS=BSDXIEN_"," "RTN","BSDX18",57,0) E D "RTN","BSDX18",58,0) . S BSDX="ADD" "RTN","BSDX18",59,0) . S BSDXIENS="+1," "RTN","BSDX18",60,0) ; "RTN","BSDX18",61,0) I '+$P(BSDXVAL,"|",4) D ERR(BSDXI,BSDXIEN,70) Q "RTN","BSDX18",62,0) I '+$P(BSDXVAL,"|",5) D ERR(BSDXI,BSDXIEN,70) Q "RTN","BSDX18",63,0) ; "RTN","BSDX18",64,0) S BSDXRID=$P(BSDXVAL,"|",4) ;ResourceID "RTN","BSDX18",65,0) S BSDXUID=$P(BSDXVAL,"|",5) ;UserID "RTN","BSDX18",66,0) S BSDXRSU=0 ;ResourceUserID "RTN","BSDX18",67,0) S BSDXF=0 ;flag "RTN","BSDX18",68,0) ;If this is an add, check if the user is already assigned to the resource. "RTN","BSDX18",69,0) ;If so, then change to an edit "RTN","BSDX18",70,0) I BSDX="ADD" F S BSDXRSU=$O(^BSDXRSU("AC",BSDXUID,BSDXRSU)) Q:'+BSDXRSU D Q:BSDXF "RTN","BSDX18",71,0) . S BSDXRES=$G(^BSDXRSU(BSDXRSU,0)) "RTN","BSDX18",72,0) . S BSDXRES=$P(BSDXRES,U) ;ResourceID "RTN","BSDX18",73,0) . S:BSDXRES=BSDXRID BSDXF=1 "RTN","BSDX18",74,0) I BSDXF S BSDX="EDIT",BSDXIEN=BSDXRSU,BSDXIENS=BSDXIEN_"," "RTN","BSDX18",75,0) ; "RTN","BSDX18",76,0) S BSDXOVB=$P(BSDXVAL,"|",2) "RTN","BSDX18",77,0) S BSDXOVB=$S(BSDXOVB="YES":1,1:0) "RTN","BSDX18",78,0) S BSDXMOD=$P(BSDXVAL,"|",3) "RTN","BSDX18",79,0) S BSDXMOD=$S(BSDXMOD="YES":1,1:0) "RTN","BSDX18",80,0) S BSDXAPPT=$P(BSDXVAL,"|",6) "RTN","BSDX18",81,0) S BSDXAPPT=$S(BSDXAPPT="YES":1,1:0) "RTN","BSDX18",82,0) ; "RTN","BSDX18",83,0) S BSDXFDA(9002018.15,BSDXIENS,.01)=$P(BSDXVAL,"|",4) ;RESOURCE ID "RTN","BSDX18",84,0) S BSDXFDA(9002018.15,BSDXIENS,.02)=$P(BSDXVAL,"|",5) ;USERID "RTN","BSDX18",85,0) S BSDXFDA(9002018.15,BSDXIENS,.03)=BSDXOVB ;OVERBOOK "RTN","BSDX18",86,0) S BSDXFDA(9002018.15,BSDXIENS,.04)=BSDXMOD ;MODIFY SCHEDULE "RTN","BSDX18",87,0) S BSDXFDA(9002018.15,BSDXIENS,.05)=BSDXAPPT ;ADD, EDIT, DELETE APPOINMENTS "RTN","BSDX18",88,0) K BSDXMSG "RTN","BSDX18",89,0) I BSDX="ADD" D "RTN","BSDX18",90,0) . K BSDXIEN "RTN","BSDX18",91,0) . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX18",92,0) . S BSDXIEN=+$G(BSDXIEN(1)) "RTN","BSDX18",93,0) E D "RTN","BSDX18",94,0) . D FILE^DIE("","BSDXFDA","BSDXMSG") "RTN","BSDX18",95,0) S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^-1"_$C(31) "RTN","BSDX18",96,0) Q "RTN","BSDX18",97,0) ; "RTN","BSDX18",98,0) ERR(BSDXI,BSDXID,BSDXERR) ;Error processing "RTN","BSDX18",99,0) S BSDXERR=BSDXERR+134234112 ;vbObjectError "RTN","BSDX18",100,0) S BSDXI=BSDXI+1 "RTN","BSDX18",101,0) S ^BSDXTMP($J,BSDXI)=BSDXID_"^"_BSDXERR_$C(30) "RTN","BSDX18",102,0) S BSDXI=BSDXI+1 "RTN","BSDX18",103,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX18",104,0) Q "RTN","BSDX18",105,0) ; "RTN","BSDX18",106,0) MADERR(BSDXMSG) ; "RTN","BSDX18",107,0) W !,BSDXMSG "RTN","BSDX18",108,0) Q "RTN","BSDX18",109,0) ; "RTN","BSDX18",110,0) MADSCR(BSDXDUZ,BSDXZMGR,BSDXZMENU,BSDXZPROG) ;EP - File 200 screening code for MADDRU "RTN","BSDX18",111,0) ;Called from DIR to screen for scheduling users "RTN","BSDX18",112,0) I $D(^VA(200,BSDXDUZ,51,"B",BSDXZMENU)) Q 1 "RTN","BSDX18",113,0) I $D(^VA(200,BSDXDUZ,51,"B",BSDXZMGR)) Q 1 "RTN","BSDX18",114,0) I $D(^VA(200,BSDXDUZ,51,"B",BSDXZPROG)) Q 1 "RTN","BSDX18",115,0) Q 0 "RTN","BSDX18",116,0) ; "RTN","BSDX18",117,0) MADDRU ;EP -Command line utility to bulk-add users and set access rights IHS/HMW 20060420 **1** "RTN","BSDX18",118,0) ;Main entry point "RTN","BSDX18",119,0) ; "RTN","BSDX18",120,0) N BSDX,BSDXZMENU,BSDXZMGR,BSDXZPROG,DIR "RTN","BSDX18",121,0) ; "RTN","BSDX18",122,0) ;INIT "RTN","BSDX18",123,0) K ^TMP($J) "RTN","BSDX18",124,0) S BSDXZMENU=$O(^DIC(19.1,"B","BSDXZMENU",0)) I '+BSDXZMENU D MADERR("Error: BSDXZMENU KEY NOT FOUND.") Q "RTN","BSDX18",125,0) S BSDXZMGR=$O(^DIC(19.1,"B","BSDXZMGR",0)) I '+BSDXZMGR D MADERR("Error: BSDXZMGR KEY NOT FOUND.") Q "RTN","BSDX18",126,0) S BSDXZPROG=$O(^DIC(19.1,"B","XUPROGMODE",0)) I '+BSDXZPROG D MADERR("Error: XUPROGMODE KEY NOT FOUND.") Q "RTN","BSDX18",127,0) ; "RTN","BSDX18",128,0) D MADUSR "RTN","BSDX18",129,0) I '$D(^TMP($J,"BSDX MADDRU","USER")) D MADERR("Cancelled: No Users selected.") Q "RTN","BSDX18",130,0) D MADRES "RTN","BSDX18",131,0) I '$D(^TMP($J,"BSDX MADDRU","RESOURCE")) D MADERR("Cancelled: No Resources selected.") Q "RTN","BSDX18",132,0) I '$$MADACC(.BSDX) ;D MADERR("Selected users will have no access to the selected clinics.") "RTN","BSDX18",133,0) I '$$MADCONF(.BSDX) W ! D MADERR("--Cancelled") Q "RTN","BSDX18",134,0) D MADASS(.BSDX) "RTN","BSDX18",135,0) W ! D MADERR("--Done") "RTN","BSDX18",136,0) ; "RTN","BSDX18",137,0) Q "RTN","BSDX18",138,0) ; "RTN","BSDX18",139,0) MADUSR ;Prompt for users from file 200 who have BSDXUSER key "RTN","BSDX18",140,0) ;Store results in ^TMP($J,"BSDX MADDRU","USER",DUZ) array "RTN","BSDX18",141,0) N DIRUT,Y,DIR "RTN","BSDX18",142,0) S DIR(0)="PO^200:EMZ",DIR("S")="I $$MADSCR^BSDX18(Y,BSDXZMGR,BSDXZMENU,BSDXZPROG)" "RTN","BSDX18",143,0) S Y=0 "RTN","BSDX18",144,0) K ^TMP($J,"BSDX MADDRU","USER") "RTN","BSDX18",145,0) W !!,"-------Select Users-------" "RTN","BSDX18",146,0) F D ^DIR Q:$G(DIRUT) Q:'Y D "RTN","BSDX18",147,0) . S ^TMP($J,"BSDX MADDRU","USER",+Y)="" "RTN","BSDX18",148,0) Q "RTN","BSDX18",149,0) ; "RTN","BSDX18",150,0) MADRES ;Prompt for Resources "RTN","BSDX18",151,0) ;Store results in ^TMP($J,"BSDX MADDRU","RESOURCE",ResourceID) array "RTN","BSDX18",152,0) N DIRUT,Y,DIR "RTN","BSDX18",153,0) S DIR(0)="PO^9002018.1:EMZ" "RTN","BSDX18",154,0) S Y=0 "RTN","BSDX18",155,0) K ^TMP($J,"BSDX MADDRU","RESOURCE") "RTN","BSDX18",156,0) W !!,"-------Select Resources-------" "RTN","BSDX18",157,0) F D ^DIR Q:$G(DIRUT) Q:'Y D "RTN","BSDX18",158,0) . S ^TMP($J,"BSDX MADDRU","RESOURCE",+Y)="" "RTN","BSDX18",159,0) Q "RTN","BSDX18",160,0) ; "RTN","BSDX18",161,0) MADACC(BSDX) ;Prompt for access level. "RTN","BSDX18",162,0) ;Start with Overbook and go to read-only access. "RTN","BSDX18",163,0) ;Store results in variables for: "RTN","BSDX18",164,0) ;sOverbook, sModifySchedule, sModifyAppointments "RTN","BSDX18",165,0) ; "RTN","BSDX18",166,0) N DIRUT,Y,DIR,J "RTN","BSDX18",167,0) W !!,"-------Select Access Level-------" "RTN","BSDX18",168,0) S Y=0 "RTN","BSDX18",169,0) F J="MODIFY","OVERBOOK","WRITE","READ" S BSDX(J)=1 "RTN","BSDX18",170,0) S DIR(0)="Y" "RTN","BSDX18",171,0) ; "RTN","BSDX18",172,0) S DIR("A")="Allow users to Modify Clinic Availability" "RTN","BSDX18",173,0) D ^DIR "RTN","BSDX18",174,0) Q:$G(DIRUT) 0 "RTN","BSDX18",175,0) Q:Y 1 "RTN","BSDX18",176,0) S BSDX("MODIFY")=0 "RTN","BSDX18",177,0) ; "RTN","BSDX18",178,0) S DIR("A")="Allow users to Overbook the selected clinics" "RTN","BSDX18",179,0) D ^DIR "RTN","BSDX18",180,0) Q:$G(DIRUT) 0 "RTN","BSDX18",181,0) Q:Y 1 "RTN","BSDX18",182,0) S BSDX("OVERBOOK")=0 "RTN","BSDX18",183,0) ; "RTN","BSDX18",184,0) S DIR("A")="Allow users to Add, Edit and Delete appointments in the selected resources" "RTN","BSDX18",185,0) D ^DIR "RTN","BSDX18",186,0) Q:$G(DIRUT) "RTN","BSDX18",187,0) Q:Y 1 "RTN","BSDX18",188,0) S BSDX("WRITE")=0 "RTN","BSDX18",189,0) ; "RTN","BSDX18",190,0) S DIR("A")="Allow users to View appointments in the selected resources" "RTN","BSDX18",191,0) D ^DIR "RTN","BSDX18",192,0) Q:$G(DIRUT) "RTN","BSDX18",193,0) Q:Y 1 "RTN","BSDX18",194,0) S BSDX("READ")=0 "RTN","BSDX18",195,0) ; "RTN","BSDX18",196,0) Q 0 "RTN","BSDX18",197,0) ; "RTN","BSDX18",198,0) MADCONF(BSDX) ;Confirm selections "RTN","BSDX18",199,0) N DIR,DIRUT,Y "RTN","BSDX18",200,0) S DIR(0)="Y" "RTN","BSDX18",201,0) W !!,"-------Confirm Selections-------" "RTN","BSDX18",202,0) I BSDX("READ")=0 D "RTN","BSDX18",203,0) . S DIR("A")="Are you sure you want to remove all access to these clinics for these users" "RTN","BSDX18",204,0) E D "RTN","BSDX18",205,0) . W !,"Selected users will be assigned the following access:" "RTN","BSDX18",206,0) . W !,"Modify clinic availability: ",?50,BSDX("MODIFY") "RTN","BSDX18",207,0) . W !,"Overbook Appointments: ",?50,BSDX("OVERBOOK") "RTN","BSDX18",208,0) . W !,"Add, Edit and Delete Appointments: ",?50,BSDX("WRITE") "RTN","BSDX18",209,0) . W !,"View Clinic Appointments: ",?50,BSDX("READ") "RTN","BSDX18",210,0) . S DIR("A")="Are you sure you want to assign these access rights to the selected users" "RTN","BSDX18",211,0) D ^DIR "RTN","BSDX18",212,0) Q:$G(DIRUT) 0 "RTN","BSDX18",213,0) Q:$G(Y) 1 "RTN","BSDX18",214,0) Q 0 "RTN","BSDX18",215,0) ; "RTN","BSDX18",216,0) MADASS(BSDX) ; "RTN","BSDX18",217,0) ;Assign access level to selected users and resources "RTN","BSDX18",218,0) ;Loop through selected users "RTN","BSDX18",219,0) ;. Loop through selected resources "RTN","BSDX18",220,0) ; . . If an entry in ^BSDXRSU for this user/resource combination exists, then "RTN","BSDX18",221,0) ; . . . S sResourceUserID = to it "RTN","BSDX18",222,0) ; . . Else "RTN","BSDX18",223,0) ; . . . S sResourceUserID = 0 "RTN","BSDX18",224,0) ; . . Call MADFILE "RTN","BSDX18",225,0) N BSDXU,BSDXR,BSDXRUID,BSDXVAL "RTN","BSDX18",226,0) S BSDXU=0 "RTN","BSDX18",227,0) F S BSDXU=$O(^TMP($J,"BSDX MADDRU","USER",BSDXU)) Q:'+BSDXU D "RTN","BSDX18",228,0) . S BSDXR=0 F S BSDXR=$O(^TMP($J,"BSDX MADDRU","RESOURCE",BSDXR)) Q:'+BSDXR D "RTN","BSDX18",229,0) . . S BSDXRUID=$$MADEXST(BSDXU,BSDXR) "RTN","BSDX18",230,0) . . S BSDXVAL=BSDXRUID_"|"_BSDX("OVERBOOK")_"|"_BSDX("MODIFY")_"|"_BSDXR_"|"_BSDXU_"|"_BSDX("WRITE") "RTN","BSDX18",231,0) . . I +BSDXRUID,BSDX("READ")=0 D MADDEL(BSDXRUID) "RTN","BSDX18",232,0) . . Q:BSDX("READ")=0 "RTN","BSDX18",233,0) . . D MADFILE(BSDXVAL) "RTN","BSDX18",234,0) . . Q "RTN","BSDX18",235,0) . Q "RTN","BSDX18",236,0) Q "RTN","BSDX18",237,0) ; "RTN","BSDX18",238,0) MADDEL(BSDXRUID) ; "RTN","BSDX18",239,0) ;Delete entry BSDXRUID from BSDX RESOURCE USER file "RTN","BSDX18",240,0) N DIK,DA "RTN","BSDX18",241,0) Q:'+BSDXRUID "RTN","BSDX18",242,0) Q:'$D(^BSDXRSU(BSDXRUID)) "RTN","BSDX18",243,0) S DIK="^BSDXRSU(" "RTN","BSDX18",244,0) S DA=BSDXRUID "RTN","BSDX18",245,0) D ^DIK "RTN","BSDX18",246,0) Q "RTN","BSDX18",247,0) ; "RTN","BSDX18",248,0) MADFILE(BSDXVAL) ; "RTN","BSDX18",249,0) ; "RTN","BSDX18",250,0) ;Add/Edit BSDX RESOURCEUSER entry "RTN","BSDX18",251,0) ;BSDXVAL is sResourceUserID|sOverbook|sModifySchedule|ResourceID|UserID|sModifyAppointments "RTN","BSDX18",252,0) ;If sResourceUserID=0 Then this is a new ResourceUser entry "RTN","BSDX18",253,0) ; "RTN","BSDX18",254,0) N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXOVB,BSDXMOD,BSDXI,BSDXUID,BSDXRID "RTN","BSDX18",255,0) N BSDXRES,BSDXRSU,BSDXF,BSDXAPPT "RTN","BSDX18",256,0) S BSDXIEN=$P(BSDXVAL,"|") "RTN","BSDX18",257,0) I +BSDXIEN D "RTN","BSDX18",258,0) . S BSDX="EDIT" "RTN","BSDX18",259,0) . S BSDXIENS=BSDXIEN_"," "RTN","BSDX18",260,0) E D "RTN","BSDX18",261,0) . S BSDX="ADD" "RTN","BSDX18",262,0) . S BSDXIENS="+1," "RTN","BSDX18",263,0) ; "RTN","BSDX18",264,0) I '+$P(BSDXVAL,"|",4) D MADERR("Error in MADFILE^BSDX18: No Resource ID") Q "RTN","BSDX18",265,0) I '+$P(BSDXVAL,"|",5) D MADERR("Error in MADFILE^BSDX18: No User ID") Q "RTN","BSDX18",266,0) ; "RTN","BSDX18",267,0) S BSDXRID=$P(BSDXVAL,"|",4) ;ResourceID "RTN","BSDX18",268,0) S BSDXUID=$P(BSDXVAL,"|",5) ;UserID "RTN","BSDX18",269,0) S BSDXRSU=0 ;ResourceUserID "RTN","BSDX18",270,0) S BSDXF=0 ;flag "RTN","BSDX18",271,0) ;If this is an add, check if the user is already assigned to the resource. "RTN","BSDX18",272,0) ;If so, then change to an edit "RTN","BSDX18",273,0) I BSDX="ADD" F S BSDXRSU=$O(^BSDXRSU("AC",BSDXUID,BSDXRSU)) Q:'+BSDXRSU D Q:BSDXF "RTN","BSDX18",274,0) . S BSDXRES=$G(^BSDXRSU(BSDXRSU,0)) "RTN","BSDX18",275,0) . S BSDXRES=$P(BSDXRES,U) ;ResourceID "RTN","BSDX18",276,0) . S:BSDXRES=BSDXRID BSDXF=1 "RTN","BSDX18",277,0) I BSDXF S BSDX="EDIT",BSDXIEN=BSDXRSU,BSDXIENS=BSDXIEN_"," "RTN","BSDX18",278,0) ; "RTN","BSDX18",279,0) S BSDXOVB=$P(BSDXVAL,"|",2) "RTN","BSDX18",280,0) S BSDXMOD=$P(BSDXVAL,"|",3) "RTN","BSDX18",281,0) S BSDXAPPT=$P(BSDXVAL,"|",6) "RTN","BSDX18",282,0) ; "RTN","BSDX18",283,0) S BSDXFDA(9002018.15,BSDXIENS,.01)=$P(BSDXVAL,"|",4) ;RESOURCE ID "RTN","BSDX18",284,0) S BSDXFDA(9002018.15,BSDXIENS,.02)=$P(BSDXVAL,"|",5) ;USERID "RTN","BSDX18",285,0) S BSDXFDA(9002018.15,BSDXIENS,.03)=BSDXOVB ;OVERBOOK "RTN","BSDX18",286,0) S BSDXFDA(9002018.15,BSDXIENS,.04)=BSDXMOD ;MODIFY SCHEDULE "RTN","BSDX18",287,0) S BSDXFDA(9002018.15,BSDXIENS,.05)=BSDXAPPT ;ADD, EDIT, DELETE APPOINMENTS "RTN","BSDX18",288,0) K BSDXMSG "RTN","BSDX18",289,0) I BSDX="ADD" D "RTN","BSDX18",290,0) . K BSDXIEN "RTN","BSDX18",291,0) . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX18",292,0) . S BSDXIEN=+$G(BSDXIEN(1)) "RTN","BSDX18",293,0) E D "RTN","BSDX18",294,0) . D FILE^DIE("","BSDXFDA","BSDXMSG") "RTN","BSDX18",295,0) Q "RTN","BSDX18",296,0) ; "RTN","BSDX18",297,0) MADEXST(BSDXU,BSDXR) ; "RTN","BSDX18",298,0) ;Returns BSDX RESOURCE USER ID "RTN","BSDX18",299,0) ;if there is a BSDX RESOURCE USER entry for "RTN","BSDX18",300,0) ;user BSDXU and resource BSDXR "RTN","BSDX18",301,0) ;Otherwise, returns 0 "RTN","BSDX18",302,0) ; "RTN","BSDX18",303,0) N BSDXID,BSDXFOUND,BSDXNOD "RTN","BSDX18",304,0) I '$D(^BSDXRSU("AC",BSDXU)) Q 0 "RTN","BSDX18",305,0) S BSDXID=0,BSDXFOUND=0 "RTN","BSDX18",306,0) F S BSDXID=$O(^BSDXRSU("AC",BSDXU,BSDXID)) Q:'+BSDXID D Q:BSDXFOUND "RTN","BSDX18",307,0) . S BSDXNOD=$G(^BSDXRSU(BSDXID,0)) "RTN","BSDX18",308,0) . I +BSDXNOD=BSDXR S BSDXFOUND=BSDXID "RTN","BSDX18",309,0) . Q "RTN","BSDX18",310,0) Q BSDXFOUND "RTN","BSDX19") 0^17^B7890401 "RTN","BSDX19",1,0) BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX19",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX19",3,0) ; "RTN","BSDX19",4,0) ; "RTN","BSDX19",5,0) ADDRGD(BSDXY,BSDXVAL) ;EP "RTN","BSDX19",6,0) ;Entry point for debugging "RTN","BSDX19",7,0) ; "RTN","BSDX19",8,0) ;D DEBUG^%Serenji("ADDRG^BSDX19(.BSDXY,BSDXVAL)") "RTN","BSDX19",9,0) Q "RTN","BSDX19",10,0) ; "RTN","BSDX19",11,0) ADDRG(BSDXY,BSDXVAL) ;EP "RTN","BSDX19",12,0) ;Called by BSDX ADD/EDIT RESOURCE GROUP "RTN","BSDX19",13,0) ;Add a new BSDX RESOURCE GROUP entry "RTN","BSDX19",14,0) ;BSDXVAL is IEN|NAME of the entry "RTN","BSDX19",15,0) ;Returns IEN of added/edited entry or 0 if error "RTN","BSDX19",16,0) ; "RTN","BSDX19",17,0) S X="ERROR^BSDX19",@^%ZOSF("TRAP") "RTN","BSDX19",18,0) N BSDXIENS,BSDXFDA,BSDXMSG,BSDXIEN,BSDX,BSDXNAM "RTN","BSDX19",19,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX19",20,0) S ^BSDXTMP($J,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$C(30) "RTN","BSDX19",21,0) I BSDXVAL="" D ERR(0,"BSDX16: Invalid null input Parameter") Q "RTN","BSDX19",22,0) S BSDXIEN=$P(BSDXVAL,"|") "RTN","BSDX19",23,0) S BSDXNAM=$P(BSDXVAL,"|",2) "RTN","BSDX19",24,0) I +BSDXIEN D "RTN","BSDX19",25,0) . S BSDX="EDIT" "RTN","BSDX19",26,0) . S BSDXIENS=BSDXIEN_"," "RTN","BSDX19",27,0) E D "RTN","BSDX19",28,0) . S BSDX="ADD" "RTN","BSDX19",29,0) . S BSDXIENS="+1," "RTN","BSDX19",30,0) ; "RTN","BSDX19",31,0) ;Prevent adding entry with duplicate name "RTN","BSDX19",32,0) I $D(^BSDXDEPT("B",BSDXNAM)),$O(^BSDXDEPT("B",BSDXNAM,0))'=BSDXIEN D Q "RTN","BSDX19",33,0) . D ERR(0,"BSDX19: Cannot have two Resource Groups with the same name.") "RTN","BSDX19",34,0) . Q "RTN","BSDX19",35,0) ; "RTN","BSDX19",36,0) S BSDXFDA(9002018.2,BSDXIENS,.01)=BSDXNAM ;NAME "RTN","BSDX19",37,0) I BSDX="ADD" D "RTN","BSDX19",38,0) . K BSDXIEN "RTN","BSDX19",39,0) . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX19",40,0) . S BSDXIEN=+$G(BSDXIEN(1)) "RTN","BSDX19",41,0) E D "RTN","BSDX19",42,0) . D FILE^DIE("","BSDXFDA","BSDXMSG") "RTN","BSDX19",43,0) S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^"_$C(30)_$C(31) "RTN","BSDX19",44,0) Q "RTN","BSDX19",45,0) ; "RTN","BSDX19",46,0) DELRGD(BSDXY,BSDXGRP) ;EP "RTN","BSDX19",47,0) ;Entry point for debugging "RTN","BSDX19",48,0) ; "RTN","BSDX19",49,0) ;D DEBUG^%Serenji("DELRG^BSDX19(.BSDXY,BSDXGRP)") "RTN","BSDX19",50,0) Q "RTN","BSDX19",51,0) ; "RTN","BSDX19",52,0) DELRG(BSDXY,BSDXGRP) ;EP "RTN","BSDX19",53,0) ;Deletes entry name BSDXGRP from BSDX RESOURCE GROUP file "RTN","BSDX19",54,0) ;Return recordset containing error message or "" if no error "RTN","BSDX19",55,0) ;Called by BSDX DELETE RESOURCE GROUP "RTN","BSDX19",56,0) ;Test Line: "RTN","BSDX19",57,0) ;D DELRU^BSDX18(.RES,99) "RTN","BSDX19",58,0) ; "RTN","BSDX19",59,0) N BSDXI,DIK,DA,BSDXIEN "RTN","BSDX19",60,0) S BSDXI=0 "RTN","BSDX19",61,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX19",62,0) S ^BSDXTMP($J,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$C(30) "RTN","BSDX19",63,0) I BSDXGRP="" D ERR(0,"DELRG~BSDX19: Invalid null Resource Group Name") Q "RTN","BSDX19",64,0) S BSDXIEN=$O(^BSDXDEPT("B",BSDXGRP,0)) "RTN","BSDX19",65,0) I '+BSDXIEN D ERR(0,"DELRG~BSDX19: Invalid Resource Group Name") Q "RTN","BSDX19",66,0) I '$D(^BSDXDEPT(BSDXIEN,0)) D ERR(0,"DELRG~BSDX19: Invalid Resource Group IEN") Q "RTN","BSDX19",67,0) ;Delete entry BSDXIEN "RTN","BSDX19",68,0) S DIK="^BSDXDEPT(" "RTN","BSDX19",69,0) S DA=BSDXIEN "RTN","BSDX19",70,0) D ^DIK "RTN","BSDX19",71,0) ; "RTN","BSDX19",72,0) S BSDXI=BSDXI+1 "RTN","BSDX19",73,0) S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_$C(30)_$C(31) "RTN","BSDX19",74,0) Q "RTN","BSDX19",75,0) ; "RTN","BSDX19",76,0) ERR(BSDXERID,ERRTXT) ;Error processing "RTN","BSDX19",77,0) S:'+$G(BSDXI) BSDXI=999999 "RTN","BSDX19",78,0) S BSDXI=BSDXI+1 "RTN","BSDX19",79,0) S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) "RTN","BSDX19",80,0) S BSDXI=BSDXI+1 "RTN","BSDX19",81,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX19",82,0) Q "RTN","BSDX19",83,0) ; "RTN","BSDX19",84,0) ERROR ; "RTN","BSDX19",85,0) D ^%ZTER "RTN","BSDX19",86,0) I '+$G(BSDXI) N BSDXI S BSDXI=999999 "RTN","BSDX19",87,0) S BSDXI=BSDXI+1 "RTN","BSDX19",88,0) D ERR(0,"BSDX19 M Error: <"_$G(%ZTERROR)_">") "RTN","BSDX19",89,0) Q "RTN","BSDX20") 0^18^B5911607 "RTN","BSDX20",1,0) BSDX20 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX20",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX20",3,0) ; "RTN","BSDX20",4,0) ; "RTN","BSDX20",5,0) DELRGID(BSDXY,BSDXIEN) ;EP "RTN","BSDX20",6,0) ;Entry point for debugging "RTN","BSDX20",7,0) ; "RTN","BSDX20",8,0) ;D DEBUG^%Serenji("DELRGI^BSDX20(.BSDXY,BSDXIEN)") "RTN","BSDX20",9,0) Q "RTN","BSDX20",10,0) ; "RTN","BSDX20",11,0) DELRGI(BSDXY,BSDXIEN,BSDXIEN1) ;EP "RTN","BSDX20",12,0) ;Deletes entry BSDXIEN1 from entry BSDXIEN in the RESOURCE GROUP file "RTN","BSDX20",13,0) ;Return recordset containing error message or "" if no error "RTN","BSDX20",14,0) ;Called by BSDX DELETE RES GROUP ITEM "RTN","BSDX20",15,0) ;Test Line: "RTN","BSDX20",16,0) ;D DELRU^BSDX18(.RES,99) "RTN","BSDX20",17,0) ; "RTN","BSDX20",18,0) N BSDXI,DIK,DA "RTN","BSDX20",19,0) S BSDXI=0 "RTN","BSDX20",20,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX20",21,0) S ^BSDXTMP($J,0)="I00020RESOURCEGROUPID^I00020ERRORID"_$C(30) "RTN","BSDX20",22,0) I '+BSDXIEN D ERR(BSDXI,BSDXIEN,70) Q "RTN","BSDX20",23,0) I '+BSDXIEN1 D ERR(BSDXI,BSDXIEN,70) Q "RTN","BSDX20",24,0) I '$D(^BSDXDEPT(BSDXIEN,1,BSDXIEN1,0)) D ERR(BSDXI,BSDXIEN,70) Q "RTN","BSDX20",25,0) ; "RTN","BSDX20",26,0) ;Delete entry BSDXIEN1 "RTN","BSDX20",27,0) S DIK="^BSDXDEPT("_BSDXIEN_",1," "RTN","BSDX20",28,0) S DA=BSDXIEN1,DA(1)=BSDXIEN "RTN","BSDX20",29,0) D ^DIK "RTN","BSDX20",30,0) ; "RTN","BSDX20",31,0) S BSDXI=BSDXI+1 "RTN","BSDX20",32,0) S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_"-1"_$C(30)_$C(31) "RTN","BSDX20",33,0) Q "RTN","BSDX20",34,0) ; "RTN","BSDX20",35,0) ADDRGID(BSDXY,BSDXIEN,BSDXIEN1) ;EP "RTN","BSDX20",36,0) ;Entry point for debugging "RTN","BSDX20",37,0) ; "RTN","BSDX20",38,0) ;D DEBUG^%Serenji("ADDRGI^BSDX20(.BSDXY,BSDXIEN,BSDXIEN1)") "RTN","BSDX20",39,0) Q "RTN","BSDX20",40,0) ; "RTN","BSDX20",41,0) ADDRGI(BSDXY,BSDXIEN,BSDXIEN1) ;EP "RTN","BSDX20",42,0) ;Adds RESOURCEID BSEDXIEN1 to RESOURCE GROUP entry BSDXIEN "RTN","BSDX20",43,0) ;Return recordset containing added subentry number error message or "" if no error "RTN","BSDX20",44,0) ;Called by BSDX ADD RES GROUP ITEM "RTN","BSDX20",45,0) ;Test Line: "RTN","BSDX20",46,0) ;D ADDRGI^BSDX20(.RES,1,1) "RTN","BSDX20",47,0) ; "RTN","BSDX20",48,0) N BSDXI,BSDXIENS,BSDXMSG,BSDXFDA "RTN","BSDX20",49,0) S X="ETRAP^BSDX20",@^%ZOSF("TRAP") "RTN","BSDX20",50,0) S BSDXI=0 "RTN","BSDX20",51,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX20",52,0) S ^BSDXTMP($J,0)="I00020RESOURCEGROUPITEMID^I00020ERRORID"_$C(30) "RTN","BSDX20",53,0) I '+BSDXIEN D ERR(BSDXI,BSDXIEN,70) Q "RTN","BSDX20",54,0) I '+BSDXIEN1 D ERR(BSDXI,BSDXIEN,70) Q "RTN","BSDX20",55,0) I '$D(^BSDXDEPT(BSDXIEN,0)) D ERR(BSDXI,BSDXIEN,70) Q "RTN","BSDX20",56,0) I '$D(^BSDXRES(BSDXIEN1,0)) D ERR(BSDXI,BSDXIEN1,70) Q "RTN","BSDX20",57,0) I $D(^BSDXDEPT(BSDXIEN,1,"B",BSDXIEN1)) D ERR(BSDXI,0,0) Q "RTN","BSDX20",58,0) ;^BSDXDEPT(3,1,"B",3,1)= "RTN","BSDX20",59,0) ; "RTN","BSDX20",60,0) S BSDXIENS="+1,"_BSDXIEN_"," "RTN","BSDX20",61,0) S BSDXFDA(9002018.21,BSDXIENS,.01)=BSDXIEN1 ;RESOURCEID "RTN","BSDX20",62,0) K BSDXIEN "RTN","BSDX20",63,0) D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX20",64,0) S BSDXI=BSDXI+1 "RTN","BSDX20",65,0) S ^BSDXTMP($J,BSDXI)=+$G(BSDXIEN(1))_"^"_"-1"_$C(30)_$C(31) "RTN","BSDX20",66,0) Q "RTN","BSDX20",67,0) ; "RTN","BSDX20",68,0) ERR(BSDXI,BSDXID,BSDXERR) ;Error processing "RTN","BSDX20",69,0) S BSDXI=BSDXI+1 "RTN","BSDX20",70,0) S ^BSDXTMP($J,BSDXI)=BSDXID_"^"_BSDXERR_$C(30) "RTN","BSDX20",71,0) S BSDXI=BSDXI+1 "RTN","BSDX20",72,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX20",73,0) Q "RTN","BSDX20",74,0) ; "RTN","BSDX20",75,0) ETRAP ;EP Error trap entry "RTN","BSDX20",76,0) I '$D(BSDXI) N BSDXI S BSDXI=999 "RTN","BSDX20",77,0) S BSDXI=BSDXI+1 "RTN","BSDX20",78,0) D ERR(BSDXI,99,70) "RTN","BSDX20",79,0) Q "RTN","BSDX21") 0^19^B8672065 "RTN","BSDX21",1,0) BSDX21 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/21/10 9:42pm "RTN","BSDX21",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX21",3,0) ; "RTN","BSDX21",4,0) ; "RTN","BSDX21",5,0) ADDAGD(BSDXY,BSDXVAL) ;EP "RTN","BSDX21",6,0) ;Entry point for debugging "RTN","BSDX21",7,0) ; "RTN","BSDX21",8,0) ;D DEBUG^%Serenji("ADDAG^BSDX21(.BSDXY,BSDXVAL)") "RTN","BSDX21",9,0) Q "RTN","BSDX21",10,0) ; "RTN","BSDX21",11,0) ADDAG(BSDXY,BSDXVAL) ;EP "RTN","BSDX21",12,0) ;Called by BSDX ADD/EDIT ACCESS GROUP "RTN","BSDX21",13,0) ;Add a new BSDX ACCESS GROUP entry "RTN","BSDX21",14,0) ;BSDXVAL is NAME of the entry "RTN","BSDX21",15,0) ; "RTN","BSDX21",16,0) S X="ERROR^BSDX21",@^%ZOSF("TRAP") "RTN","BSDX21",17,0) N BSDXIENS,BSDXFDA,BSDXMSG,BSDXIEN,BSDX,BSDXNAM "RTN","BSDX21",18,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX21",19,0) S ^BSDXTMP($J,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$C(30) "RTN","BSDX21",20,0) I BSDXVAL="" D ERR(0,"BSDX21: Invalid null input Parameter") Q "RTN","BSDX21",21,0) S BSDXIEN=$P(BSDXVAL,"|") "RTN","BSDX21",22,0) S BSDXNAM=$P(BSDXVAL,"|",2) "RTN","BSDX21",23,0) I +BSDXIEN D "RTN","BSDX21",24,0) . S BSDX="EDIT" "RTN","BSDX21",25,0) . S BSDXIENS=BSDXIEN_"," "RTN","BSDX21",26,0) E D "RTN","BSDX21",27,0) . S BSDX="ADD" "RTN","BSDX21",28,0) . S BSDXIENS="+1," "RTN","BSDX21",29,0) ; "RTN","BSDX21",30,0) S BSDXNAM=$P(BSDXVAL,"|",2) "RTN","BSDX21",31,0) I BSDXNAM="" D ERR(0,"BSDX14: Invalid null Access Type name.") Q "RTN","BSDX21",32,0) ; "RTN","BSDX21",33,0) ;Prevent adding entry with duplicate name "RTN","BSDX21",34,0) I $D(^BSDXAGP("B",BSDXNAM)),$O(^BSDXAGP("B",BSDXNAM,0))'=BSDXIEN D Q "RTN","BSDX21",35,0) . D ERR(0,"BSDX21: Cannot have two Access Groups with the same name.") "RTN","BSDX21",36,0) . Q "RTN","BSDX21",37,0) ; "RTN","BSDX21",38,0) S BSDXFDA(9002018.38,BSDXIENS,.01)=BSDXNAM ;NAME "RTN","BSDX21",39,0) I BSDX="ADD" D "RTN","BSDX21",40,0) . K BSDXIEN "RTN","BSDX21",41,0) . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX21",42,0) . S BSDXIEN=+$G(BSDXIEN(1)) "RTN","BSDX21",43,0) E D "RTN","BSDX21",44,0) . D FILE^DIE("","BSDXFDA","BSDXMSG") "RTN","BSDX21",45,0) S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^"_$C(30)_$C(31) "RTN","BSDX21",46,0) Q "RTN","BSDX21",47,0) ; "RTN","BSDX21",48,0) DELAGD(BSDXY,BSDXGRP) ;EP "RTN","BSDX21",49,0) ;Entry point for debugging "RTN","BSDX21",50,0) ; "RTN","BSDX21",51,0) ;D DEBUG^%Serenji("DELAG^BSDX21(.BSDXY,BSDXGRP)") "RTN","BSDX21",52,0) Q "RTN","BSDX21",53,0) ; "RTN","BSDX21",54,0) DELAG(BSDXY,BSDXGRP) ;EP "RTN","BSDX21",55,0) ;Deletes entry having IEN BSDXGRP from BSDX ACCESS GROUP file "RTN","BSDX21",56,0) ;Also deletes all entries in BSDX ACCESS GROUP TYPE that point to this group "RTN","BSDX21",57,0) ;Return recordset containing error message or "" if no error "RTN","BSDX21",58,0) ;Called by BSDX DELETE ACCESS GROUP "RTN","BSDX21",59,0) ;Test Line: "RTN","BSDX21",60,0) ;D DELAG^BSDX21(.RES,99) "RTN","BSDX21",61,0) ; "RTN","BSDX21",62,0) S X="ERROR^BSDX21",@^%ZOSF("TRAP") "RTN","BSDX21",63,0) N BSDXI,DIK,DA,BSDXIEN,BSDXIEN1 "RTN","BSDX21",64,0) S BSDXI=0 "RTN","BSDX21",65,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX21",66,0) S ^BSDXTMP($J,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$C(30) "RTN","BSDX21",67,0) S BSDXIEN=BSDXGRP "RTN","BSDX21",68,0) ;I '$D(^BSDXAGP("B",BSDXGRP)) D ERR(BSDXI,0,0) Q "RTN","BSDX21",69,0) ;S BSDXIEN=$O(^BSDXAGP("B",BSDXGRP,0)) "RTN","BSDX21",70,0) I '+BSDXIEN D ERR(BSDXI,BSDXIEN) Q "RTN","BSDX21",71,0) I '$D(^BSDXAGP(BSDXIEN,0)) D ERR(0,"BSDX14: Invalid Access Group ID name.") Q "RTN","BSDX21",72,0) ; "RTN","BSDX21",73,0) ;Delete BSDXACCESS GROUP TYPE entries "RTN","BSDX21",74,0) ; "RTN","BSDX21",75,0) S BSDXIEN1=0 F S BSDXIEN1=$O(^BSDXAGTP("B",BSDXIEN,BSDXIEN1)) Q:'BSDXIEN1 D "RTN","BSDX21",76,0) . S DIK="^BSDXAGTP(" "RTN","BSDX21",77,0) . S DA=BSDXIEN1 "RTN","BSDX21",78,0) . D ^DIK "RTN","BSDX21",79,0) . Q "RTN","BSDX21",80,0) ; "RTN","BSDX21",81,0) ;Delete entry BSDXIEN in BSDX ACCESS GROUP "RTN","BSDX21",82,0) S DIK="^BSDXAGP(" "RTN","BSDX21",83,0) S DA=BSDXIEN "RTN","BSDX21",84,0) D ^DIK "RTN","BSDX21",85,0) ; "RTN","BSDX21",86,0) S BSDXI=BSDXI+1 "RTN","BSDX21",87,0) S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_""_$C(30)_$C(31) "RTN","BSDX21",88,0) Q "RTN","BSDX21",89,0) ; "RTN","BSDX21",90,0) ERR(BSDXERID,ERRTXT) ;Error processing "RTN","BSDX21",91,0) S:'+$G(BSDXI) BSDXI=999999 "RTN","BSDX21",92,0) S BSDXI=BSDXI+1 "RTN","BSDX21",93,0) S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) "RTN","BSDX21",94,0) S BSDXI=BSDXI+1 "RTN","BSDX21",95,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX21",96,0) Q "RTN","BSDX21",97,0) ; "RTN","BSDX21",98,0) ERROR ; "RTN","BSDX21",99,0) D ^%ZTER "RTN","BSDX21",100,0) I '+$G(BSDXI) N BSDXI S BSDXI=999999 "RTN","BSDX21",101,0) S BSDXI=BSDXI+1 "RTN","BSDX21",102,0) D ERR(0,"BSDX21 M Error: <"_$G(%ZTERROR)_">") "RTN","BSDX21",103,0) Q "RTN","BSDX22") 0^20^B9479861 "RTN","BSDX22",1,0) BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX22",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX22",3,0) ; "RTN","BSDX22",4,0) ; "RTN","BSDX22",5,0) DELAGID(BSDXY,BSDXIEN,BSDXIEN1) ;EP "RTN","BSDX22",6,0) ;Entry point for debugging "RTN","BSDX22",7,0) ; "RTN","BSDX22",8,0) ;D DEBUG^%Serenji("DELAGI^BSDX22(.BSDXY,BSDXIEN,BSDXIEN1)") "RTN","BSDX22",9,0) Q "RTN","BSDX22",10,0) ; "RTN","BSDX22",11,0) DELAGI(BSDXY,BSDXIEN,BSDXIEN1) ;EP "RTN","BSDX22",12,0) ;Deletes entry having Access Group BSDXIEN and Access Type BSDXIEN1 the ACCESS GROUP TYPE file "RTN","BSDX22",13,0) ;Return recordset containing error message or "" if no error "RTN","BSDX22",14,0) ;Called by BSDX DELETE ACCESS GROUP ITEM "RTN","BSDX22",15,0) ;Test Line: "RTN","BSDX22",16,0) ;D DELAGI^BSDX22(.RES,99) "RTN","BSDX22",17,0) ; "RTN","BSDX22",18,0) S X="ERROR^BSDX22",@^%ZOSF("TRAP") "RTN","BSDX22",19,0) N BSDXI,DIK,DA,BSDXIEN2 "RTN","BSDX22",20,0) S BSDXI=0 "RTN","BSDX22",21,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX22",22,0) S ^BSDXTMP($J,0)="I00020ACCESSGROUPTYPEID^T00030ERRORTEXT"_$C(30) "RTN","BSDX22",23,0) I '+BSDXIEN D ERR(0,"BSDX22: Invalid null Access Group ID") Q "RTN","BSDX22",24,0) I '+BSDXIEN1 D ERR(0,"BSDX22: Invalid null Access Type ID") Q "RTN","BSDX22",25,0) I '$D(^BSDXAGTP("AC",BSDXIEN,BSDXIEN1)) D Q "RTN","BSDX22",26,0) . D ERR(0,"BSDX22: Invalid null Access Group Type ID") "RTN","BSDX22",27,0) . Q "RTN","BSDX22",28,0) S BSDXIEN2=$O(^BSDXAGTP("AC",BSDXIEN,BSDXIEN1,0)) "RTN","BSDX22",29,0) I '+BSDXIEN2 D ERR(0,"BSDX22: Invalid null Access Group Type ID") Q "RTN","BSDX22",30,0) ; "RTN","BSDX22",31,0) ;Delete entry "RTN","BSDX22",32,0) S DIK="^BSDXAGTP(" "RTN","BSDX22",33,0) S DA=BSDXIEN2 "RTN","BSDX22",34,0) D ^DIK "RTN","BSDX22",35,0) ; "RTN","BSDX22",36,0) S BSDXI=BSDXI+1 "RTN","BSDX22",37,0) S ^BSDXTMP($J,BSDXI)=BSDXIEN2_"^"_"-1"_$C(30)_$C(31) "RTN","BSDX22",38,0) Q "RTN","BSDX22",39,0) ; "RTN","BSDX22",40,0) ADDAGID(BSDXY,BSDXIEN,BSDXIEN1) ;EP "RTN","BSDX22",41,0) ;Entry point for debugging "RTN","BSDX22",42,0) ; "RTN","BSDX22",43,0) ;D DEBUG^%Serenji("ADDAGI^BSDX22(.BSDXY,BSDXIEN,BSDXIEN1)") "RTN","BSDX22",44,0) Q "RTN","BSDX22",45,0) ; "RTN","BSDX22",46,0) ADDAGI(BSDXY,BSDXIEN,BSDXIEN1) ;EP "RTN","BSDX22",47,0) ;Adds ACCESS GROUP TYPE file entry having access group BSDXIEN and access type BSDXIEN1 "RTN","BSDX22",48,0) ;Return recordset containing added entry number error message or "" if no error "RTN","BSDX22",49,0) ;Called by BSDX ADD ACCESS GROUP ITEM "RTN","BSDX22",50,0) ;Test Line: "RTN","BSDX22",51,0) ;D ADDAGI^BSDX22(.RES,1,1) "RTN","BSDX22",52,0) ; "RTN","BSDX22",53,0) S X="ERROR^BSDX22",@^%ZOSF("TRAP") "RTN","BSDX22",54,0) N BSDXI,BSDXIENS,BSDXMSG,BSDXFDA "RTN","BSDX22",55,0) S BSDXI=0 "RTN","BSDX22",56,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX22",57,0) ;S ^BSDXTMP($J,0)="I00020ACCESSGROUPTYPEID^I00020ERRORID"_$C(30) "RTN","BSDX22",58,0) S ^BSDXTMP($J,0)="I00020ACCESSGROUPTYPEID^T00030ERRORTEXT"_$C(30) "RTN","BSDX22",59,0) I '+BSDXIEN D ERR(0,"BSDX22: Invalid null Access Group ID") Q "RTN","BSDX22",60,0) I '+BSDXIEN1 D ERR(0,"BSDX22: Invalid null Access Type ID") Q "RTN","BSDX22",61,0) I '$D(^BSDXAGP(BSDXIEN,0)) D ERR(0,"BSDX22: Invalid Access Group ID") Q "RTN","BSDX22",62,0) I '$D(^BSDXTYPE(BSDXIEN1,0)) D ERR(0,"BSDX22: Invalid Access Type ID") Q "RTN","BSDX22",63,0) I $D(^BSDXAGTP("AC",BSDXIEN,BSDXIEN1)) D Q "RTN","BSDX22",64,0) . S BSDXIENS=$O(^BSDXAGTP("AC",BSDXIEN,BSDXIEN1,0)) "RTN","BSDX22",65,0) . S ^BSDXTMP($J,BSDXI+1)=+BSDXIENS_"^"_$C(30)_$C(31) "RTN","BSDX22",66,0) . Q "RTN","BSDX22",67,0) ; "RTN","BSDX22",68,0) S BSDXIENS="+1," "RTN","BSDX22",69,0) S BSDXFDA(9002018.39,BSDXIENS,.01)=BSDXIEN ;ACCESS GROUP ID "RTN","BSDX22",70,0) S BSDXFDA(9002018.39,BSDXIENS,.02)=BSDXIEN1 ;ACCESS TYPE ID "RTN","BSDX22",71,0) K BSDXIEN "RTN","BSDX22",72,0) D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX22",73,0) S BSDXI=BSDXI+1 "RTN","BSDX22",74,0) S ^BSDXTMP($J,BSDXI)=+$G(BSDXIEN(1))_"^"_$C(30)_$C(31) "RTN","BSDX22",75,0) Q "RTN","BSDX22",76,0) ; "RTN","BSDX22",77,0) ERR(BSDXERID,ERRTXT) ;Error processing "RTN","BSDX22",78,0) S:'+$G(BSDXI) BSDXI=999999 "RTN","BSDX22",79,0) S BSDXI=BSDXI+1 "RTN","BSDX22",80,0) S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) "RTN","BSDX22",81,0) S BSDXI=BSDXI+1 "RTN","BSDX22",82,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX22",83,0) Q "RTN","BSDX22",84,0) ; "RTN","BSDX22",85,0) ERROR ; "RTN","BSDX22",86,0) D ^%ZTER "RTN","BSDX22",87,0) I '+$G(BSDXI) N BSDXI S BSDXI=999999 "RTN","BSDX22",88,0) S BSDXI=BSDXI+1 "RTN","BSDX22",89,0) D ERR(0,"BSDX22 M Error: <"_$G(%ZTERROR)_">") "RTN","BSDX22",90,0) Q "RTN","BSDX23") 0^21^B8488013 "RTN","BSDX23",1,0) BSDX23 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX23",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX23",3,0) ; "RTN","BSDX23",4,0) ; "RTN","BSDX23",5,0) EVENT(BSDXEVENT,BSDXPARAM,BSDXSIP,BSDXSPT) ;EP "RTN","BSDX23",6,0) ;Raise event to interested clients "RTN","BSDX23",7,0) ;Clients are listed in ^BSDXTMP("EVENT",EVENT_NAME,IP,PORT) "RTN","BSDX23",8,0) ;BSDXSIP and BSDXSPT represent the sender's IP and PORT. "RTN","BSDX23",9,0) ;The event will not be raised back to the sender if these are non-null "RTN","BSDX23",10,0) ; "RTN","BSDX23",11,0) Q:'$D(^BSDXTMP("EVENT",BSDXEVENT)) "RTN","BSDX23",12,0) S BSDXIP=0 F S BSDXIP=$O(^BSDXTMP("EVENT",BSDXEVENT,BSDXIP)) Q:BSDXIP="" D "RTN","BSDX23",13,0) . S BSDXPORT=0 F S BSDXPORT=$O(^BSDXTMP("EVENT",BSDXEVENT,BSDXIP,BSDXPORT)) Q:'+BSDXPORT D "RTN","BSDX23",14,0) . . I BSDXIP=BSDXSIP Q ;,BSDXPORT=BSDXSPT Q "RTN","BSDX23",15,0) . . D CALL^%ZISTCP(BSDXIP,BSDXPORT,5) "RTN","BSDX23",16,0) . . I POP K ^BSDXTMP("EVENT",BSDXEVENT,BSDXIP,BSDXPORT) Q "RTN","BSDX23",17,0) . . ;U IO R X#3:5 "RTN","BSDX23",18,0) . . I X'="ACK" K ^BSDXTMP("EVENT",BSDXEVENT,BSDXIP,BSDXPORT) Q "RTN","BSDX23",19,0) . . S BSDXPARAM=$S(BSDXPARAM="":"",1:U_BSDXPARAM) "RTN","BSDX23",20,0) . . U IO W BSDXEVENT,BSDXPARAM,! "RTN","BSDX23",21,0) . . D ^%ZISC "RTN","BSDX23",22,0) . . Q "RTN","BSDX23",23,0) . Q "RTN","BSDX23",24,0) Q "RTN","BSDX23",25,0) ; "RTN","BSDX23",26,0) EVERR(BSDXEVENT,BSDXIP,BSDXPORT) ; "RTN","BSDX23",27,0) ; "RTN","BSDX23",28,0) Q:$G(BSDXEVENT)="" "RTN","BSDX23",29,0) Q:$G(BSDXIP)="" "RTN","BSDX23",30,0) Q:$G(BSDXIP)="" "RTN","BSDX23",31,0) K ^BSDXTMP("EVENT",BSDXEVENT,BSDXIP,BSDXPORT) "RTN","BSDX23",32,0) Q "RTN","BSDX23",33,0) ; "RTN","BSDX23",34,0) REGET ;EP "RTN","BSDX23",35,0) ;Error trap from REGEVNT "RTN","BSDX23",36,0) ; "RTN","BSDX23",37,0) I '$D(BSDXI) N BSDXI S BSDXI=999 "RTN","BSDX23",38,0) S BSDXI=BSDXI+1 "RTN","BSDX23",39,0) D REGERR(BSDXI,99) "RTN","BSDX23",40,0) Q "RTN","BSDX23",41,0) ; "RTN","BSDX23",42,0) REGERR(BSDXI,BSDXERID) ;Error processing "RTN","BSDX23",43,0) S BSDXI=BSDXI+1 "RTN","BSDX23",44,0) S ^BSDXTMP($J,BSDXI)=BSDXERID_$C(30) "RTN","BSDX23",45,0) S BSDXI=BSDXI+1 "RTN","BSDX23",46,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX23",47,0) Q "RTN","BSDX23",48,0) ; "RTN","BSDX23",49,0) ; "RTN","BSDX23",50,0) REGEVNT(BSDXY,BSDXEVENT,BSDXIP,BSDXPORT) ;EP "RTN","BSDX23",51,0) ;RPC Called by client to inform RPMS server of client's interest in BSDXEVENT "RTN","BSDX23",52,0) ;Returns RECORDSET with field ERRORID. "RTN","BSDX23",53,0) ;If everything ok then ERRORID = 0; "RTN","BSDX23",54,0) ; "RTN","BSDX23",55,0) N BSDXI "RTN","BSDX23",56,0) S BSDXI=0 "RTN","BSDX23",57,0) S X="REGET^BSDX23",@^%ZOSF("TRAP") "RTN","BSDX23",58,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX23",59,0) S ^BSDXTMP($J,0)="I00020ERRORID"_$C(30) "RTN","BSDX23",60,0) I '+BSDXPORT D REGERR(BSDXI,1) Q "RTN","BSDX23",61,0) I BSDXIP="" D REGERR(BSDXI,2) Q "RTN","BSDX23",62,0) S ^BSDXTMP("EVENT",BSDXEVENT,BSDXIP,BSDXPORT)="" "RTN","BSDX23",63,0) ; "RTN","BSDX23",64,0) S BSDXI=BSDXI+1 "RTN","BSDX23",65,0) S ^BSDXTMP($J,BSDXI)="0"_$C(30)_$C(31) "RTN","BSDX23",66,0) Q "RTN","BSDX23",67,0) ; "RTN","BSDX23",68,0) UNREG(BSDXY,BSDXEVENT,BSDXIP,BSDXPORT) ;EP "RTN","BSDX23",69,0) ;RPC Called by client to Unregister client's interest in BSDXEVENT "RTN","BSDX23",70,0) ;Returns RECORDSET with field ERRORID. "RTN","BSDX23",71,0) ;If everything ok then ERRORID = 0; "RTN","BSDX23",72,0) ; "RTN","BSDX23",73,0) N BSDXI "RTN","BSDX23",74,0) S BSDXI=0 "RTN","BSDX23",75,0) S X="REGET^BSDX23",@^%ZOSF("TRAP") "RTN","BSDX23",76,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX23",77,0) S ^BSDXTMP($J,0)="I00020ERRORID"_$C(30) "RTN","BSDX23",78,0) I '+BSDXPORT D REGERR(BSDXI,1) Q "RTN","BSDX23",79,0) I BSDXIP="" D REGERR(BSDXI,2) Q "RTN","BSDX23",80,0) K ^BSDXTMP("EVENT",BSDXEVENT,BSDXIP,BSDXPORT) "RTN","BSDX23",81,0) ; "RTN","BSDX23",82,0) S BSDXI=BSDXI+1 "RTN","BSDX23",83,0) S ^BSDXTMP($J,BSDXI)="0"_$C(30)_$C(31) "RTN","BSDX23",84,0) Q "RTN","BSDX23",85,0) ; "RTN","BSDX23",86,0) RAISEVNT(BSDXY,BSDXEVENT,BSDXPARAM,BSDXSIP,BSDXSPT) ;EP "RTN","BSDX23",87,0) ;RPC Called to raise event BSDXEVENT with parameter BSDXPARAM "RTN","BSDX23",88,0) ;BSDXSIP and BSDXSPT represent the sender's IP and PORT. "RTN","BSDX23",89,0) ;If not null, these will prevent the event from being raised back "RTN","BSDX23",90,0) ;to the sender. "RTN","BSDX23",91,0) ;Returns a RECORDSET wit the field ERRORID. "RTN","BSDX23",92,0) ;If everything ok then ERRORID = 0; "RTN","BSDX23",93,0) ; "RTN","BSDX23",94,0) N BSDXI "RTN","BSDX23",95,0) S BSDXI=0 "RTN","BSDX23",96,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX23",97,0) S ^BSDXTMP($J,0)="I00020ERRORID"_$C(30) "RTN","BSDX23",98,0) S X="REGET^BSDX23",@^%ZOSF("TRAP") "RTN","BSDX23",99,0) ; "RTN","BSDX23",100,0) D EVENT(BSDXEVENT,BSDXPARAM,BSDXSIP,BSDXSPT) "RTN","BSDX23",101,0) ; "RTN","BSDX23",102,0) S BSDXI=BSDXI+1 "RTN","BSDX23",103,0) S ^BSDXTMP($J,BSDXI)="0"_$C(30)_$C(31) "RTN","BSDX23",104,0) Q "RTN","BSDX24") 0^22^B13455014 "RTN","BSDX24",1,0) BSDX24 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX24",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX24",3,0) ; "RTN","BSDX24",4,0) ; "RTN","BSDX24",5,0) Q "RTN","BSDX24",6,0) CRCONTXT(RESULT,OPTION) ;EP "RTN","BSDX24",7,0) ;Entry point for debugging XWBSEC "RTN","BSDX24",8,0) ; "RTN","BSDX24",9,0) ;D DEBUG^%Serenji("CRCONTXT^XWBSEC(.RESULT,OPTION)") "RTN","BSDX24",10,0) ;;H .5 "RTN","BSDX24",11,0) ;;D CRCONTXT^XWBSEC(.RESULT,OPTION) "RTN","BSDX24",12,0) ;;S BSDX="^BSDXTMP($J," "RTN","BSDX24",13,0) ;;S ^BSDXTMP($J,0)=RESULT "RTN","BSDX24",14,0) ;;S RESULT=1 "RTN","BSDX24",15,0) Q "RTN","BSDX24",16,0) TEST0(BSDX) ;EP Delete user from 200 "RTN","BSDX24",17,0) S DIK="^VA(200," "RTN","BSDX24",18,0) S DA=BSDX "RTN","BSDX24",19,0) D ^DIK "RTN","BSDX24",20,0) ; "RTN","BSDX24",21,0) Q "RTN","BSDX24",22,0) KILLM ;EP Delete BMXMENU entry "RTN","BSDX24",23,0) S DIK="^DIC(19," "RTN","BSDX24",24,0) S DA=$O(^DIC(19,"B","BMXMENU",0)) "RTN","BSDX24",25,0) Q:'+DA "RTN","BSDX24",26,0) D ^DIK "RTN","BSDX24",27,0) Q "RTN","BSDX24",28,0) ; "RTN","BSDX24",29,0) TEST1 ;EP Adding an entry to 200 "RTN","BSDX24",30,0) ; "RTN","BSDX24",31,0) S BSDXFDA(200,"+1,",.01)="BMXNET,APPLICATION" "RTN","BSDX24",32,0) K BSDXIEN,BSDXMSG "RTN","BSDX24",33,0) S DIC(0)="" "RTN","BSDX24",34,0) D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX24",35,0) ; "RTN","BSDX24",36,0) Q "RTN","BSDX24",37,0) TEST2 ;EP "RTN","BSDX24",38,0) ;How to change the ACCESS CODE, VERIFY CODE, DATE VERIFY CODE LAST CHANGED field "RTN","BSDX24",39,0) ;ACCESS CODE BSDXXX1^1_(a>yr}:3x3ja9\8vbH "RTN","BSDX24",40,0) ;VERIFY CODE BSDXXX2^$;HOSs|:3w25lLD}Be= "RTN","BSDX24",41,0) N BSDXFDA "RTN","BSDX24",42,0) S BSDXFDA(200,"36,",2)="1_(a>yr}:3x3ja9\8vbH" "RTN","BSDX24",43,0) S BSDXFDA(200,"36,",11)="$;HOSs|:3w25lLD}Be=" "RTN","BSDX24",44,0) S BSDXFDA(200,"36,",11.2)="88888,88888" "RTN","BSDX24",45,0) S BSDXFDA(200,"36,",201)="BMXRPC" "RTN","BSDX24",46,0) D FILE^DIE("","BSDXFDA","BSDXMSG") "RTN","BSDX24",47,0) Q "RTN","BSDX24",48,0) ; "RTN","BSDX24",49,0) ; "RTN","BSDX24",50,0) SEARCHD(BSDXY,BSDXRES,BSDXSTRT,BSDXEND,BSDXTYPES,BSDXAMPM,BSDXWKDY) ;EP "RTN","BSDX24",51,0) ;Entry point for debugging "RTN","BSDX24",52,0) ; "RTN","BSDX24",53,0) ;D DEBUG^%Serenji("SEARCH^BSDX24(.RES,""ROGERS,BUCK|FUNAKOSHI,GICHIN"","""","""","""","""","""")") "RTN","BSDX24",54,0) ;D DEBUG^%Serenji("SEARCH^BSDX24(.BSDXY,BSDXRES,BSDXSTRT,BSDXEND,BSDXTYPES,BSDXAMPM,BSDXWKDY)") "RTN","BSDX24",55,0) Q "RTN","BSDX24",56,0) ; "RTN","BSDX24",57,0) SEARCH(BSDXY,BSDXRES,BSDXSTRT,BSDXEND,BSDXTYPES,BSDXAMPM,BSDXWKDY) ;EP "RTN","BSDX24",58,0) ;Searches availability database for availability blocks between "RTN","BSDX24",59,0) ;BSDXSTRT and BSDXEND for each of the resources in BSDXRES. "RTN","BSDX24",60,0) ;The av blocks must be one of the types in BSDXTYPES, must be "RTN","BSDX24",61,0) ;AM or PM depending on value in BSDXAMPM and "RTN","BSDX24",62,0) ;must be on one of the weekdays listed in BSDXWKDY. "RTN","BSDX24",63,0) ; "RTN","BSDX24",64,0) ;Return recordset containing the start times of availability blocks "RTN","BSDX24",65,0) ;meeting the search criteria. "RTN","BSDX24",66,0) ; "RTN","BSDX24",67,0) ;Variables: "RTN","BSDX24",68,0) ;BSDXRES |-Delimited list of resource names "RTN","BSDX24",69,0) ;BSDXSTRT FM-formatted beginning date of search "RTN","BSDX24",70,0) ;BSDXEND FM-Formatted ending date of search "RTN","BSDX24",71,0) ;BSDXTYPES |-Delimited list of access type IENs "RTN","BSDX24",72,0) ;BSDXAMPM "AM" for am-only, "PM" for pm-only, "BOTH" for both "RTN","BSDX24",73,0) ;BSDXWKDY "" if any weekday, else |-delimited list of weekdays "RTN","BSDX24",74,0) ; "RTN","BSDX24",75,0) ;NOTE: If BSDXEND="" Then: "RTN","BSDX24",76,0) ; either ONE record is returned matching the first available block "RTN","BSDX24",77,0) ; -or- NO record is returned indicating no available block exists "RTN","BSDX24",78,0) ; "RTN","BSDX24",79,0) ;Called by BSDX SEARCH AVAILABILITY "RTN","BSDX24",80,0) ;Test Line: "RTN","BSDX24",81,0) ;D SEARCH^BSDX24(.RES,"ROGERS,BUCK|FUNAKOSHI,GICHIN","","","","","") ZW RES "RTN","BSDX24",82,0) ; "RTN","BSDX24",83,0) ; "RTN","BSDX24",84,0) S X=BSDXSTRT,%DT="X" D ^%DT S BSDXSTRT=$P(Y,".") "RTN","BSDX24",85,0) S:+BSDXSTRT<0 BSDXSTRT=DT "RTN","BSDX24",86,0) S X=BSDXEND,%DT="X" D ^%DT S BSDXEND=$P(Y,".") "RTN","BSDX24",87,0) S:+BSDXEND<0 BSDXEND=9990101 "RTN","BSDX24",88,0) S BSDXEND=BSDXEND_".99" "RTN","BSDX24",89,0) N BSDXRESN,BSDXRESD,BSDXDATE,BSDXI,BSDXABD,BSDXNOD,BSDXATD,BSDXATN "RTN","BSDX24",90,0) N BSDXTYPE "RTN","BSDX24",91,0) ; "RTN","BSDX24",92,0) ;Set up access types array "RTN","BSDX24",93,0) F BSDX=1:1:$L(BSDXTYPES,"|") D "RTN","BSDX24",94,0) . S BSDXATD=$P(BSDXTYPES,"|",BSDX) "RTN","BSDX24",95,0) . S:+BSDXATD BSDXTYPE(BSDXTYPD)="" "RTN","BSDX24",96,0) ; "RTN","BSDX24",97,0) S BSDXI=0 "RTN","BSDX24",98,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX24",99,0) S ^BSDXTMP($J,0)="T00030RESOURCENAME^D00030DATE^T00030ACCESSTYPE^T00030COMMENT"_$C(30) "RTN","BSDX24",100,0) F BSDX=1:1:$L(BSDXRES,"|") S BSDXRESN=$P(BSDXRES,"|",BSDX) D "RTN","BSDX24",101,0) . Q:'$D(^BSDXRES("B",BSDXRESN)) "RTN","BSDX24",102,0) . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0)) "RTN","BSDX24",103,0) . Q:'+BSDXRESD "RTN","BSDX24",104,0) . Q:'$D(^BSDXRES(BSDXRESD,0)) "RTN","BSDX24",105,0) . Q:'$D(^BSDXAB("ARSCT",BSDXRESD)) "RTN","BSDX24",106,0) . S BSDXDATE=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXSTRT)) "RTN","BSDX24",107,0) . Q:BSDXDATE="" "RTN","BSDX24",108,0) . Q:BSDXDATE>BSDXEND "RTN","BSDX24",109,0) . ;TODO: Screen for AMPM "RTN","BSDX24",110,0) . ;TODO: Screen for Weekday "RTN","BSDX24",111,0) . ; "RTN","BSDX24",112,0) . S BSDXI=BSDXI+1 "RTN","BSDX24",113,0) . S BSDXABD=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE,0)) "RTN","BSDX24",114,0) . S BSDXNOD=$G(^BSDXAB(BSDXABD,0)) "RTN","BSDX24",115,0) . Q:BSDXNOD="" "RTN","BSDX24",116,0) . S Y=$P(BSDXDATE,".") "RTN","BSDX24",117,0) . D DD^%DT "RTN","BSDX24",118,0) . S BSDXATD=$P(BSDXNOD,U,5) ;ACCESS TYPE POINTER "RTN","BSDX24",119,0) . S BSDXATD=$G(^BSDXTYPE(+BSDXATD,0)) "RTN","BSDX24",120,0) . S BSDXATN=$P(BSDXATD,U) "RTN","BSDX24",121,0) . I +BSDXATD,BSDXTYPES]"" Q:'$D(BSDXTYPES(BSDXATD)) "RTN","BSDX24",122,0) . ;TODO: Screen for TYPE ----DONE! "RTN","BSDX24",123,0) . ;TODO: Comment "RTN","BSDX24",124,0) . S ^BSDXTMP($J,BSDXI)=BSDXRESN_U_Y_U_BSDXATN_U_$C(30) "RTN","BSDX24",125,0) S BSDXI=BSDXI+1 "RTN","BSDX24",126,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX24",127,0) Q "RTN","BSDX25") 0^23^B16070744 "RTN","BSDX25",1,0) BSDX25 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX25",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX25",3,0) ; "RTN","BSDX25",4,0) ; "RTN","BSDX25",5,0) CHECKIND(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP "RTN","BSDX25",6,0) ;Entry point for debugging "RTN","BSDX25",7,0) ; "RTN","BSDX25",8,0) ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2)) "RTN","BSDX25",9,0) ;E G ENDBG "RTN","BSDX25",10,0) Q "RTN","BSDX25",11,0) ; "RTN","BSDX25",12,0) CHECKIN(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP Check in appointment "RTN","BSDX25",13,0) ; "RTN","BSDX25",14,0) ENDBG ; "RTN","BSDX25",15,0) N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXZ,BSDXIENS,BSDXVEN "RTN","BSDX25",16,0) N BSDXNOEV "RTN","BSDX25",17,0) S BSDXNOEV=1 ;Don't execute protocol "RTN","BSDX25",18,0) ; "RTN","BSDX25",19,0) D ^XBKVAR S X="ERROR^BSDX25",@^%ZOSF("TRAP") "RTN","BSDX25",20,0) S BSDXI=0 "RTN","BSDX25",21,0) K ^BSDXTMP($J) "RTN","BSDX25",22,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX25",23,0) S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30) "RTN","BSDX25",24,0) I '+BSDXAPTID D ERR("BSDX25: Invalid Appointment ID") Q "RTN","BSDX25",25,0) I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR("BSDX08: Invalid Appointment ID") Q "RTN","BSDX25",26,0) ; "RTN","BSDX25",27,0) S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@") "RTN","BSDX25",28,0) S %DT="T",X=BSDXCDT D ^%DT S BSDXCDT=Y "RTN","BSDX25",29,0) I BSDXCDT=-1 D ERR(70) Q "RTN","BSDX25",30,0) I BSDXCDT>$$NOW^XLFDT S BSDXCDT=$$NOW^XLFDT "RTN","BSDX25",31,0) ;Checkin BSDX APPOINTMENT entry "RTN","BSDX25",32,0) D BSDXCHK(BSDXAPTID,BSDXCDT) "RTN","BSDX25",33,0) S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) "RTN","BSDX25",34,0) S BSDXPATID=$P(BSDXNOD,U,5) "RTN","BSDX25",35,0) S BSDXSTART=$P(BSDXNOD,U) "RTN","BSDX25",36,0) ; "RTN","BSDX25",37,0) S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID "RTN","BSDX25",38,0) I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I +$G(BSDXZ) D ERR($P(BSDXZ,U,2)) Q "RTN","BSDX25",39,0) . S BSDXNOD=^BSDXRES(BSDXSC1,0) "RTN","BSDX25",40,0) . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION "RTN","BSDX25",41,0) . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APCHK(.BSDXZ,BSDXSC1,BSDXPATID,BSDXCDT,BSDXSTART) "RTN","BSDX25",42,0) ; "RTN","BSDX25",43,0) S BSDXI=BSDXI+1 "RTN","BSDX25",44,0) ;S ^BSDXTMP($J,BSDXI)="-1"_$C(30) "RTN","BSDX25",45,0) S ^BSDXTMP($J,BSDXI)="0"_$C(30) "RTN","BSDX25",46,0) S BSDXI=BSDXI+1 "RTN","BSDX25",47,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX25",48,0) Q "RTN","BSDX25",49,0) ; "RTN","BSDX25",50,0) BSDXCHK(BSDXAPTID,BSDXCDT) ; "RTN","BSDX25",51,0) ; "RTN","BSDX25",52,0) S BSDXIENS=BSDXAPTID_"," "RTN","BSDX25",53,0) S BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT "RTN","BSDX25",54,0) D FILE^DIE("","BSDXFDA","BSDXMSG") "RTN","BSDX25",55,0) Q "RTN","BSDX25",56,0) ; "RTN","BSDX25",57,0) APCHK(BSDXZ,BSDXSC1,BSDXDFN,BSDXCDT,BSDXSTART) ; "RTN","BSDX25",58,0) ;Checkin appointment for patient BSDXDFN in clinic BSDXSC1 "RTN","BSDX25",59,0) ;at time BSDXSTART "RTN","BSDX25",60,0) S BSDXZ=$$CHECKIN1^BSDXAPI(BSDXDFN,BSDXSC1,BSDXSTART) "RTN","BSDX25",61,0) Q "RTN","BSDX25",62,0) ; "RTN","BSDX25",63,0) CHKEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CHECKIN APPOINTMENT event "RTN","BSDX25",64,0) ;when appointments CHECKIN via PIMS interface. "RTN","BSDX25",65,0) ;Propagates CHECKIN to BSDXAPPT and raises refresh event to running GUI clients "RTN","BSDX25",66,0) ; "RTN","BSDX25",67,0) Q:+$G(BSDXNOEV) "RTN","BSDX25",68,0) Q:'+$G(BSDXSC) "RTN","BSDX25",69,0) N BSDXSTAT,BSDXFOUND,BSDXRES "RTN","BSDX25",70,0) S BSDXSTAT="" "RTN","BSDX25",71,0) S:$G(SDATA("AFTER","STATUS"))["CHECKED IN" BSDXSTAT=$P(SDATA("AFTER","STATUS"),"^",4) "RTN","BSDX25",72,0) S BSDXFOUND=0 "RTN","BSDX25",73,0) I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) "RTN","BSDX25",74,0) I BSDXFOUND D CHKEVT3(BSDXRES) Q "RTN","BSDX25",75,0) I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) "RTN","BSDX25",76,0) I BSDXFOUND D CHKEVT3(BSDXRES) "RTN","BSDX25",77,0) Q "RTN","BSDX25",78,0) ; "RTN","BSDX25",79,0) CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ; "RTN","BSDX25",80,0) ;Get appointment id in BSDXAPT "RTN","BSDX25",81,0) ;If found, call BSDXNOS(BSDXAPPT) and return 1 "RTN","BSDX25",82,0) ;else return 0 "RTN","BSDX25",83,0) N BSDXFOUND,BSDXAPPT "RTN","BSDX25",84,0) S BSDXFOUND=0 "RTN","BSDX25",85,0) Q:'+$G(BSDXRES) BSDXFOUND "RTN","BSDX25",86,0) Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND "RTN","BSDX25",87,0) S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND "RTN","BSDX25",88,0) . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" "RTN","BSDX25",89,0) . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q "RTN","BSDX25",90,0) I BSDXFOUND,+$G(BSDXAPPT) D BSDXCHK(BSDXAPPT,BSDXSTAT) "RTN","BSDX25",91,0) Q BSDXFOUND "RTN","BSDX25",92,0) ; "RTN","BSDX25",93,0) CHKEVT3(BSDXRES) ; "RTN","BSDX25",94,0) ;Call RaiseEvent to notify GUI clients "RTN","BSDX25",95,0) ; "RTN","BSDX25",96,0) N BSDXRESN "RTN","BSDX25",97,0) S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) "RTN","BSDX25",98,0) Q:BSDXRESN="" "RTN","BSDX25",99,0) S BSDXRESN=$P(BSDXRESN,"^") "RTN","BSDX25",100,0) ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","") "RTN","BSDX25",101,0) D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) "RTN","BSDX25",102,0) Q "RTN","BSDX25",103,0) ; "RTN","BSDX25",104,0) ERROR ; "RTN","BSDX25",105,0) D ERR("RPMS Error") "RTN","BSDX25",106,0) Q "RTN","BSDX25",107,0) ; "RTN","BSDX25",108,0) ERR(ERRNO) ;Error processing "RTN","BSDX25",109,0) I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError "RTN","BSDX25",110,0) E S BSDXERR=ERRNO "RTN","BSDX25",111,0) S BSDXI=BSDXI+1 "RTN","BSDX25",112,0) S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) "RTN","BSDX25",113,0) S BSDXI=BSDXI+1 "RTN","BSDX25",114,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX25",115,0) Q "RTN","BSDX26") 0^24^B3226136 "RTN","BSDX26",1,0) BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX26",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX26",3,0) ; "RTN","BSDX26",4,0) ; "RTN","BSDX26",5,0) EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP "RTN","BSDX26",6,0) ;Entry point for debugging "RTN","BSDX26",7,0) ; "RTN","BSDX26",8,0) ;D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)") "RTN","BSDX26",9,0) Q "RTN","BSDX26",10,0) ; "RTN","BSDX26",11,0) EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be edited) "RTN","BSDX26",12,0) ; "RTN","BSDX26",13,0) N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXZ,BSDXIENS "RTN","BSDX26",14,0) ; "RTN","BSDX26",15,0) D ^XBKVAR "RTN","BSDX26",16,0) S X="ETRAP^BSDX26",@^%ZOSF("TRAP") "RTN","BSDX26",17,0) S BSDXI=0 "RTN","BSDX26",18,0) K ^BSDXTMP($J) "RTN","BSDX26",19,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX26",20,0) S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30) "RTN","BSDX26",21,0) S BSDXI=BSDXI+1 "RTN","BSDX26",22,0) TSTART "RTN","BSDX26",23,0) I '+BSDXAPTID D ERR(BSDXI,"BSDX26: Invalid Appointment ID") Q "RTN","BSDX26",24,0) I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"BSDX26: Invalid Appointment ID") Q "RTN","BSDX26",25,0) ;Add WP field "RTN","BSDX26",26,0) ;I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" "RTN","BSDX26",27,0) S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" "RTN","BSDX26",28,0) I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) "RTN","BSDX26",29,0) I $D(BSDXNOTE(.5)) D "RTN","BSDX26",30,0) . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG") "RTN","BSDX26",31,0) ; "RTN","BSDX26",32,0) ;Return Recordset "RTN","BSDX26",33,0) TCOMMIT "RTN","BSDX26",34,0) S BSDXI=BSDXI+1 "RTN","BSDX26",35,0) S ^BSDXTMP($J,BSDXI)="-1"_$C(30) "RTN","BSDX26",36,0) S BSDXI=BSDXI+1 "RTN","BSDX26",37,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX26",38,0) Q "RTN","BSDX26",39,0) ; "RTN","BSDX26",40,0) ; "RTN","BSDX26",41,0) ERR(BSDXI,BSDXERR) ;Error processing "RTN","BSDX26",42,0) S BSDXI=BSDXI+1 "RTN","BSDX26",43,0) TROLLBACK "RTN","BSDX26",44,0) S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) "RTN","BSDX26",45,0) S BSDXI=BSDXI+1 "RTN","BSDX26",46,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX26",47,0) Q "RTN","BSDX26",48,0) ; "RTN","BSDX26",49,0) ETRAP ;EP Error trap entry "RTN","BSDX26",50,0) TROLLBACK "RTN","BSDX26",51,0) D ^%ZTER "RTN","BSDX26",52,0) I '$D(BSDXI) N BSDXI S BSDXI=999999 "RTN","BSDX26",53,0) S BSDXI=BSDXI+1 "RTN","BSDX26",54,0) D ERR(BSDXI,"BSDX26 Error: "_$G(%ZTERROR)) "RTN","BSDX26",55,0) Q "RTN","BSDX27") 0^25^B97105556 "RTN","BSDX27",1,0) BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:22pm "RTN","BSDX27",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX27",3,0) ; "RTN","BSDX27",4,0) ; Change Log: July 15, 2010 "RTN","BSDX27",5,0) ; UJO/SMH - i18n: FM Dates passed into routine for Clinic Letters - CLDISP tag "RTN","BSDX27",6,0) ; "RTN","BSDX27",7,0) ; "RTN","BSDX27",8,0) Q "RTN","BSDX27",9,0) ; "RTN","BSDX27",10,0) PADISPD(BSDXY,BSDXPAT) ;EP "RTN","BSDX27",11,0) ;Entry point for debugging "RTN","BSDX27",12,0) ; "RTN","BSDX27",13,0) ;D DEBUG^%Serenji("PADISP^BSDX27(.BSDXY,BSDXPAT)") "RTN","BSDX27",14,0) Q "RTN","BSDX27",15,0) ; "RTN","BSDX27",16,0) PADISP(BSDXY,BSDXPAT) ;EP "RTN","BSDX27",17,0) ;Return recordset of patient appointments used in listing "RTN","BSDX27",18,0) ;a patient's appointments and generating patient letters. "RTN","BSDX27",19,0) ;Called by rpc BSDX PATIENT APPT DISPLAY "RTN","BSDX27",20,0) ; "RTN","BSDX27",21,0) N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ "RTN","BSDX27",22,0) N BSDXSTRT "RTN","BSDX27",23,0) N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON "RTN","BSDX27",24,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX27",25,0) S BSDXI=0 "RTN","BSDX27",26,0) S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus" "RTN","BSDX27",27,0) S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30) "RTN","BSDX27",28,0) S X="ERROR^BSDX27",@^%ZOSF("TRAP") "RTN","BSDX27",29,0) ;Get patient info "RTN","BSDX27",30,0) ; "RTN","BSDX27",31,0) I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q "RTN","BSDX27",32,0) I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q "RTN","BSDX27",33,0) S BSDXNOD=$$PATINFO(BSDXPAT) "RTN","BSDX27",34,0) S BSDXNAM=$P(BSDXNOD,U) ;NAME "RTN","BSDX27",35,0) S BSDXSEX=$P(BSDXNOD,U,2) ;SEX "RTN","BSDX27",36,0) S BSDXDOB=$P(BSDXNOD,U,3) ;DOB "RTN","BSDX27",37,0) S BSDXHRN=$P(BSDXNOD,U,4) ;Health Record Number for location DUZ(2) "RTN","BSDX27",38,0) S BSDXSTRE=$P(BSDXNOD,U,5) ;Street "RTN","BSDX27",39,0) S BSDXCITY=$P(BSDXNOD,U,6) ;City "RTN","BSDX27",40,0) S BSDXST=$P(BSDXNOD,U,7) ;State "RTN","BSDX27",41,0) S BSDXZIP=$P(BSDXNOD,U,8) ;zip "RTN","BSDX27",42,0) S BSDXPHON=$P(BSDXNOD,U,9) ;homephone "RTN","BSDX27",43,0) ; "RTN","BSDX27",44,0) ;Organize ^DPT(BSDXPAT,"S," nodes "RTN","BSDX27",45,0) ; into BSDXDPT(CLINIC,DATE) "RTN","BSDX27",46,0) ; "RTN","BSDX27",47,0) I $D(^DPT(BSDXPAT,"S")) S BSDXDT=0 F S BSDXDT=$O(^DPT(BSDXPAT,"S",BSDXDT)) Q:'+BSDXDT D "RTN","BSDX27",48,0) . S BSDXNOD=$G(^DPT(BSDXPAT,"S",BSDXDT,0)) "RTN","BSDX27",49,0) . S BSDXCID=$P(BSDXNOD,U) "RTN","BSDX27",50,0) . Q:'+BSDXCID "RTN","BSDX27",51,0) . Q:'$D(^SC(BSDXCID,0)) "RTN","BSDX27",52,0) . S BSDXDPT(BSDXCID,BSDXDT)=BSDXNOD "RTN","BSDX27",53,0) ; "RTN","BSDX27",54,0) ;$O Through ^BSDX("CPAT", "RTN","BSDX27",55,0) S BSDXIEN=0 "RTN","BSDX27",56,0) I $D(^BSDXAPPT("CPAT",BSDXPAT)) F S BSDXIEN=$O(^BSDXAPPT("CPAT",BSDXPAT,BSDXIEN)) Q:'BSDXIEN D "RTN","BSDX27",57,0) . N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN "RTN","BSDX27",58,0) . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0)) "RTN","BSDX27",59,0) . Q:BSDXNOD="" "RTN","BSDX27",60,0) . Q:$P(BSDXNOD,U,12)]"" ;CANCELLED "RTN","BSDX27",61,0) . S Y=$P(BSDXNOD,U) "RTN","BSDX27",62,0) . Q:'+Y "RTN","BSDX27",63,0) . X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX27",64,0) . S BSDXAPT=Y ;Appointment date time "RTN","BSDX27",65,0) . S BSDXCLRK=$P(BSDXNOD,U,8) ;Appointment made by "RTN","BSDX27",66,0) . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U) "RTN","BSDX27",67,0) . S Y=$P(BSDXNOD,U,9) ;Date Appointment Made "RTN","BSDX27",68,0) . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX27",69,0) . S BSDXMADE=Y "RTN","BSDX27",70,0) . ;NOTE "RTN","BSDX27",71,0) . S BSDXNOT="" "RTN","BSDX27",72,0) . I $D(^BSDXAPPT(BSDXIEN,1,0)) S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXIEN,1,BSDXQ)) Q:'+BSDXQ D "RTN","BSDX27",73,0) . . S BSDXLIN=$G(^BSDXAPPT(BSDXIEN,1,BSDXQ,0)) "RTN","BSDX27",74,0) . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" " "RTN","BSDX27",75,0) . . S BSDXNOT=BSDXNOT_BSDXLIN "RTN","BSDX27",76,0) . ;Resource "RTN","BSDX27",77,0) . S BSDXCID=$P(BSDXNOD,U,7) ;IEN of BSDX RESOURCE "RTN","BSDX27",78,0) . Q:'+BSDXCID "RTN","BSDX27",79,0) . Q:'$D(^BSDXRES(BSDXCID,0)) "RTN","BSDX27",80,0) . S BSDXCNOD=$G(^BSDXRES(BSDXCID,0)) ;BSDX RESOURCE node "RTN","BSDX27",81,0) . Q:BSDXCNOD="" "RTN","BSDX27",82,0) . S BSDXCLN=$P(BSDXCNOD,U) ;Text name of BSDX Resource "RTN","BSDX27",83,0) . S BSDX44=$P(BSDXCNOD,U,4) ;File 44 pointer "RTN","BSDX27",84,0) . ;If appt entry in ^DPT(PAT,"S" exists for this clinic, get the TYPE/STATUS info from "RTN","BSDX27",85,0) . ;the BSDXDPT array and delete the BSDXDPT node "RTN","BSDX27",86,0) . S BSDXTYPE="" "RTN","BSDX27",87,0) . I +BSDX44,$D(BSDXDPT(BSDX44,$P(BSDXNOD,U))) D ;BSDXNOD is the BSDX APPOINTMENT node "RTN","BSDX27",88,0) . . S BSDXDNOD=BSDXDPT(BSDX44,$P(BSDXNOD,U)) ;BSDXDNOD is a copy of the ^DPT(PAT,"S" node "RTN","BSDX27",89,0) . . S BSDXTYPE=$$STATUS(BSDXPAT,$P(BSDXNOD,U),BSDXDNOD) ;IHS/OIT/HMW 20050208 Added "RTN","BSDX27",90,0) . . K BSDXDPT(BSDX44,$P(BSDXNOD,U)) "RTN","BSDX27",91,0) . S BSDXI=BSDXI+1 "RTN","BSDX27",92,0) . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30) "RTN","BSDX27",93,0) . Q "RTN","BSDX27",94,0) ; "RTN","BSDX27",95,0) ;Go through remaining BSDXDPT( entries "RTN","BSDX27",96,0) I $D(BSDXDPT) S BSDX44=0 D "RTN","BSDX27",97,0) . F S BSDX44=$O(BSDXDPT(BSDX44)) Q:'+BSDX44 S BSDXDT=0 D "RTN","BSDX27",98,0) . . F S BSDXDT=$O(BSDXDPT(BSDX44,BSDXDT)) Q:'+BSDXDT D "RTN","BSDX27",99,0) . . . S BSDXDNOD=BSDXDPT(BSDX44,BSDXDT) "RTN","BSDX27",100,0) . . . S Y=BSDXDT "RTN","BSDX27",101,0) . . . Q:'+Y "RTN","BSDX27",102,0) . . . X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX27",103,0) . . . S BSDXAPT=Y "RTN","BSDX27",104,0) . . . S BSDXTYPE=$$STATUS(BSDXPAT,BSDXDT,BSDXDNOD) ;IHS/OIT/HMW 20050208 Added "RTN","BSDX27",105,0) . . . S BSDXCLN=$P($G(^SC(BSDX44,0)),U) "RTN","BSDX27",106,0) . . . S BSDXCLRK=$P(BSDXDNOD,U,18) "RTN","BSDX27",107,0) . . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U) "RTN","BSDX27",108,0) . . . S Y=$P(BSDXDNOD,U,19) "RTN","BSDX27",109,0) . . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX27",110,0) . . . S BSDXMADE=Y "RTN","BSDX27",111,0) . . . S BSDXNOT="" "RTN","BSDX27",112,0) . . . S BSDXI=BSDXI+1 "RTN","BSDX27",113,0) . . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30) "RTN","BSDX27",114,0) . . . K BSDXDPT(BSDX44,BSDXDT) "RTN","BSDX27",115,0) ; "RTN","BSDX27",116,0) S BSDXI=BSDXI+1 "RTN","BSDX27",117,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX27",118,0) Q "RTN","BSDX27",119,0) ; "RTN","BSDX27",120,0) STATUS(PAT,DATE,NODE) ; returns appt status "RTN","BSDX27",121,0) ;IHS/OIT/HMW 20050208 Added from BSDDPA "RTN","BSDX27",122,0) NEW TYP "RTN","BSDX27",123,0) S TYP=$$APPTYP^BSDXAPI(PAT,DATE) ;sched vs. walkin "RTN","BSDX27",124,0) I $P(NODE,U,2)["C" Q TYP_" - CANCELLED" "RTN","BSDX27",125,0) I $P(NODE,U,2)'="NT",$P(NODE,U,2)["N" Q TYP_" - NO SHOW" "RTN","BSDX27",126,0) I $$CO^BSDXAPI(PAT,+NODE,DATE) Q TYP_" - CHECKED OUT" "RTN","BSDX27",127,0) I $$CI^BSDXAPI(PAT,+NODE,DATE) Q TYP_" - CHECKED IN" "RTN","BSDX27",128,0) Q TYP "RTN","BSDX27",129,0) ; "RTN","BSDX27",130,0) ERROR ; "RTN","BSDX27",131,0) D ERR(BSDXI,"RPMS Error") "RTN","BSDX27",132,0) Q "RTN","BSDX27",133,0) ; "RTN","BSDX27",134,0) ERR(BSDXI,ERRNO,MSG) ;Error processing "RTN","BSDX27",135,0) S:'$D(BSDXI) BSDXI=999 "RTN","BSDX27",136,0) I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError "RTN","BSDX27",137,0) E S BSDXERR=ERRNO "RTN","BSDX27",138,0) S BSDXI=BSDXI+1 "RTN","BSDX27",139,0) S ^BSDXTMP($J,BSDXI)=MSG_"^^^^^^^^^^^^^^^"_$C(30) "RTN","BSDX27",140,0) S BSDXI=BSDXI+1 "RTN","BSDX27",141,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX27",142,0) Q "RTN","BSDX27",143,0) PATINFO(BSDXPAT) ;EP "RTN","BSDX27",144,0) ;Intrisic Function returns NAME^SEX^DOB^HRN^STREET^CITY^STATE^ZIP^PHONE for patient ien BSDXPAT "RTN","BSDX27",145,0) ;DOB is in external format "RTN","BSDX27",146,0) ;HRN depends on existence of DUZ(2) "RTN","BSDX27",147,0) ; "RTN","BSDX27",148,0) N BSDXNOD,BSDXNAM,BSDXSEX,BSDXDOB,BSDXHRN,BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON "RTN","BSDX27",149,0) S BSDXNOD=^DPT(+BSDXPAT,0) "RTN","BSDX27",150,0) S BSDXNAM=$P(BSDXNOD,U) ;NAME "RTN","BSDX27",151,0) S BSDXSEX=$P(BSDXNOD,U,2) "RTN","BSDX27",152,0) S BSDXSEX=$S(BSDXSEX="F":"FEMALE",BSDXSEX="M":"MALE",1:"") "RTN","BSDX27",153,0) S Y=$P(BSDXNOD,U,3) I Y]"" X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX27",154,0) S BSDXDOB=Y ;DOB "RTN","BSDX27",155,0) S BSDXHRN="" "RTN","BSDX27",156,0) I $D(DUZ(2)) I DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPAT,41,DUZ(2),0)),U,2) ;HRN "RTN","BSDX27",157,0) ; "RTN","BSDX27",158,0) S BSDXNOD=$G(^DPT(+BSDXPAT,.11)) "RTN","BSDX27",159,0) S (BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP)="" "RTN","BSDX27",160,0) I BSDXNOD]"" D "RTN","BSDX27",161,0) . S BSDXSTRT=$E($P(BSDXNOD,U),1,50) ;STREET "RTN","BSDX27",162,0) . S BSDXCITY=$P(BSDXNOD,U,4) ;CITY "RTN","BSDX27",163,0) . S BSDXST=$P(BSDXNOD,U,5) ;STATE "RTN","BSDX27",164,0) . I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2) "RTN","BSDX27",165,0) . S BSDXZIP=$P(BSDXNOD,U,6) ;ZIP "RTN","BSDX27",166,0) ; "RTN","BSDX27",167,0) S BSDXNOD=$G(^DPT(+BSDXPAT,.13)) ;PHONE "RTN","BSDX27",168,0) S BSDXPHON=$P(BSDXNOD,U) "RTN","BSDX27",169,0) ; "RTN","BSDX27",170,0) Q BSDXNAM_U_BSDXSEX_U_BSDXDOB_U_BSDXHRN_U_BSDXSTRT_U_BSDXCITY_U_BSDXST_U_BSDXZIP_U_BSDXPHON "RTN","BSDX27",171,0) ; "RTN","BSDX27",172,0) CLDISPD(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP "RTN","BSDX27",173,0) ;Entry point for debugging "RTN","BSDX27",174,0) ; "RTN","BSDX27",175,0) ;D DEBUG^%Serenji("CLDISP^BSDX27(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)") "RTN","BSDX27",176,0) Q "RTN","BSDX27",177,0) ; "RTN","BSDX27",178,0) CLDISP(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP "RTN","BSDX27",179,0) ; "RTN","BSDX27",180,0) ;Return recordset of patient appointments "RTN","BSDX27",181,0) ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST. "RTN","BSDX27",182,0) ;Used in listing a patient's appointments and generating patient letters. "RTN","BSDX27",183,0) ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.) "RTN","BSDX27",184,0) ;BSDXBEG and BSDXEND are in external date form. "RTN","BSDX27",185,0) ;Called by BSDX CLINIC LETTERS "RTN","BSDX27",186,0) ; "RTN","BSDX27",187,0) ; July 10, 2010 -- to support i18n, we pass dates from client in "RTN","BSDX27",188,0) ; locale-neutral Fileman format. No need to convert it. "RTN","BSDX27",189,0) N BSDXI,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCID,BSDXCNOD,BSDXDT "RTN","BSDX27",190,0) N BSDXJ,BSDXAID,BSDXPAT,BSDXPNOD,BSDXCLN,BSDXCLRK,BSDXMADE,BSDXNOT,BSDXLIN "RTN","BSDX27",191,0) N BSDXSTRT "RTN","BSDX27",192,0) N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON "RTN","BSDX27",193,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX27",194,0) K ^BSDXTMP($J) "RTN","BSDX27",195,0) S BSDXI=0 "RTN","BSDX27",196,0) S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus" "RTN","BSDX27",197,0) S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30) "RTN","BSDX27",198,0) S X="ERROR^BSDX27",@^%ZOSF("TRAP") "RTN","BSDX27",199,0) ; "RTN","BSDX27",200,0) ;Convert beginning and ending dates "RTN","BSDX27",201,0) ; "RTN","BSDX27",202,0) S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999" "RTN","BSDX27",203,0) S BSDXEND=BSDXEND_".9999" "RTN","BSDX27",204,0) I BSDXCLST="" D ERR(BSDXI,0,"Routine: BSDX27, Error: Null clinic list") Q "RTN","BSDX27",205,0) ; "RTN","BSDX27",206,0) ;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN) "RTN","BSDX27",207,0) ; "RTN","BSDX27",208,0) F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D "RTN","BSDX27",209,0) . S BSDXCLN=$G(^BSDXRES(BSDXCID,0)) S BSDXCLN=$P(BSDXCLN,U) Q:BSDXCLN="" "RTN","BSDX27",210,0) . S BSDXSTRT=BSDXBEG F S BSDXSTRT=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT)) Q:'+BSDXSTRT Q:BSDXSTRT>BSDXEND D "RTN","BSDX27",211,0) . . S BSDXAID=0 F S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID D "RTN","BSDX27",212,0) . . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0)) "RTN","BSDX27",213,0) . . . Q:BSDXNOD="" "RTN","BSDX27",214,0) . . . Q:$P(BSDXNOD,U,12)]"" ;CANCELLED "RTN","BSDX27",215,0) . . . Q:$P(BSDXNOD,U,13)="y" ;WALKIN "RTN","BSDX27",216,0) . . . S Y=$P(BSDXNOD,U) "RTN","BSDX27",217,0) . . . Q:'+Y "RTN","BSDX27",218,0) . . . X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX27",219,0) . . . S BSDXAPT=Y ;Appointment date time "RTN","BSDX27",220,0) . . . ; "RTN","BSDX27",221,0) . . . ;NOTE "RTN","BSDX27",222,0) . . . S BSDXNOT="" "RTN","BSDX27",223,0) . . . I $D(^BSDXAPPT(BSDXAID,1,0)) S BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXAID,1,BSDXQ)) Q:'+BSDXQ D "RTN","BSDX27",224,0) . . . . S BSDXLIN=$G(^BSDXAPPT(BSDXAID,1,BSDXQ,0)) "RTN","BSDX27",225,0) . . . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" " "RTN","BSDX27",226,0) . . . . S BSDXNOT=BSDXNOT_BSDXLIN "RTN","BSDX27",227,0) . . . ; "RTN","BSDX27",228,0) . . . S BSDXPAT=$P(BSDXNOD,U,5) "RTN","BSDX27",229,0) . . . S BSDXPNOD=$$PATINFO(BSDXPAT) "RTN","BSDX27",230,0) . . . S BSDXNAM=$P(BSDXPNOD,U) ;NAME "RTN","BSDX27",231,0) . . . S BSDXSEX=$P(BSDXPNOD,U,2) ;SEX "RTN","BSDX27",232,0) . . . S BSDXDOB=$P(BSDXPNOD,U,3) ;DOB "RTN","BSDX27",233,0) . . . S BSDXHRN=$P(BSDXPNOD,U,4) ;Health Record Number for location DUZ(2) "RTN","BSDX27",234,0) . . . S BSDXSTRE=$P(BSDXPNOD,U,5) ;Street "RTN","BSDX27",235,0) . . . S BSDXCITY=$P(BSDXPNOD,U,6) ;City "RTN","BSDX27",236,0) . . . S BSDXST=$P(BSDXPNOD,U,7) ;State "RTN","BSDX27",237,0) . . . S BSDXZIP=$P(BSDXPNOD,U,8) ;zip "RTN","BSDX27",238,0) . . . S BSDXPHON=$P(BSDXPNOD,U,9) ;homephone "RTN","BSDX27",239,0) . . . S BSDXTYPE="" ;Type/status doesn't exist for BSDX APPT clinics and it's not needed for clinic letters "RTN","BSDX27",240,0) . . . S BSDXCLRK=$P(BSDXNOD,U,8) "RTN","BSDX27",241,0) . . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U) "RTN","BSDX27",242,0) . . . S Y=$P(BSDXNOD,U,9) "RTN","BSDX27",243,0) . . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX27",244,0) . . . S BSDXMADE=Y "RTN","BSDX27",245,0) . . . S BSDXI=BSDXI+1 "RTN","BSDX27",246,0) . . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30) "RTN","BSDX27",247,0) ; "RTN","BSDX27",248,0) S BSDXI=BSDXI+1 "RTN","BSDX27",249,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX27",250,0) Q "RTN","BSDX28") 0^26^B32389827 "RTN","BSDX28",1,0) BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:30pm "RTN","BSDX28",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX28",3,0) ; "RTN","BSDX28",4,0) ; Change Log: "RTN","BSDX28",5,0) ; HMW 3050721 Added test for inactivated record "RTN","BSDX28",6,0) ; V1.3 WV/SMH 3100714 "RTN","BSDX28",7,0) ; - add PID search "RTN","BSDX28",8,0) ; - return PID instead of SSN (change header and logic) "RTN","BSDX28",9,0) ; - Change Error trap to new style. "RTN","BSDX28",10,0) ; "RTN","BSDX28",11,0) PTLOOKRS(BSDXY,BSDXP,BSDXC) ;EP Patient Lookup "RTN","BSDX28",12,0) ; "RTN","BSDX28",13,0) ;Find up to BSDXC patients matching BSDXP* "RTN","BSDX28",14,0) ;Supports DOB Lookup, Primary Long ID lookup "RTN","BSDX28",15,0) ; "RTN","BSDX28",16,0) N $ET S $ET="G ERROR^BSDX28" "RTN","BSDX28",17,0) ; rm ctrl chars "RTN","BSDX28",18,0) S BSDXP=$TR(BSDXP,$C(13),"") "RTN","BSDX28",19,0) S BSDXP=$TR(BSDXP,$C(10),"") "RTN","BSDX28",20,0) S BSDXP=$TR(BSDXP,$C(9),"") "RTN","BSDX28",21,0) ; num of pts to find "RTN","BSDX28",22,0) S:BSDXC="" BSDXC=10 "RTN","BSDX28",23,0) N BSDXHRN,BSDXZ,BSDXDLIM,BSDXRET,BSDXDPT,BSDXRET,BSDXIEN,BSDXFILE "RTN","BSDX28",24,0) N BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN "RTN","BSDX28",25,0) N BSDXTARG,BSDXMSG,BSDXRSLT "RTN","BSDX28",26,0) S BSDXDLIM="^" "RTN","BSDX28",27,0) S BSDXRET="T00030NAME^T00030HRN^T00030PID^D00030DOB^T00030IEN"_$C(30) "RTN","BSDX28",28,0) I '+$G(DUZ) S BSDXY=BSDXRET_$C(31) Q "RTN","BSDX28",29,0) I '$D(DUZ(2)) S BSDXY=BSDXRET_$C(31) Q "RTN","BSDX28",30,0) "RTN","BSDX28",31,0) PID ;PID Lookup "RTN","BSDX28",32,0) ; If this ID exists, go get it. If "UJOPID" index doesn't exist, "RTN","BSDX28",33,0) ; won't work anyways. "RTN","BSDX28",34,0) I $D(^DPT("UJOPID",BSDXP)) DO SET BSDXY=BSDXRET_$C(31) QUIT "RTN","BSDX28",35,0) . S BSDXIEN=$O(^DPT("UJOPID",BSDXP,"")) "RTN","BSDX28",36,0) . Q:'$D(^DPT(BSDXIEN,0)) "RTN","BSDX28",37,0) . S BSDXDPT=$G(^DPT(BSDXIEN,0)) "RTN","BSDX28",38,0) . S BSDXZ=$P(BSDXDPT,U) ;NAME "RTN","BSDX28",39,0) . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART "RTN","BSDX28",40,0) . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2 "RTN","BSDX28",41,0) . ; Inactivated Chart get an * "RTN","BSDX28",42,0) . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q "RTN","BSDX28",43,0) . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN "RTN","BSDX28",44,0) . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID "RTN","BSDX28",45,0) . S Y=$P(BSDXDPT,U,3) X ^DD("DD") "RTN","BSDX28",46,0) . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB "RTN","BSDX28",47,0) . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN "RTN","BSDX28",48,0) . S BSDXRET=BSDXRET_BSDXZ_$C(30) "RTN","BSDX28",49,0) ; "RTN","BSDX28",50,0) DOB ;DOB Lookup "RTN","BSDX28",51,0) I +DUZ(2),((BSDXP?1.2N1"/"1.2N1"/"1.4N)!(BSDXP?1.2N1" "1.2N1" "1.4N)!(BSDXP?1.2N1"-"1.2N1"-"1.4N)) D S BSDXY=BSDXRET_$C(31) Q "RTN","BSDX28",52,0) . S X=BSDXP S %DT="P" D ^%DT S BSDXP=Y Q:'+Y "RTN","BSDX28",53,0) . Q:'$D(^DPT("ADOB",BSDXP)) "RTN","BSDX28",54,0) . S BSDXIEN=0 F S BSDXIEN=$O(^DPT("ADOB",BSDXP,BSDXIEN)) Q:'+BSDXIEN D "RTN","BSDX28",55,0) . . Q:'$D(^DPT(BSDXIEN,0)) "RTN","BSDX28",56,0) . . S BSDXDPT=$G(^DPT(BSDXIEN,0)) "RTN","BSDX28",57,0) . . S BSDXZ=$P(BSDXDPT,U) ;NAME "RTN","BSDX28",58,0) . . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART "RTN","BSDX28",59,0) . . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2 "RTN","BSDX28",60,0) . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated "RTN","BSDX28",61,0) . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN "RTN","BSDX28",62,0) . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID "RTN","BSDX28",63,0) . . S Y=$P(BSDXDPT,U,3) X ^DD("DD") "RTN","BSDX28",64,0) . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB "RTN","BSDX28",65,0) . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN "RTN","BSDX28",66,0) . . S BSDXRET=BSDXRET_BSDXZ_$C(30) "RTN","BSDX28",67,0) . . Q "RTN","BSDX28",68,0) . Q "RTN","BSDX28",69,0) ; "RTN","BSDX28",70,0) CHART "RTN","BSDX28",71,0) ;Chart# Lookup "RTN","BSDX28",72,0) I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q "RTN","BSDX28",73,0) . S BSDXIEN=0 F S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D Q "RTN","BSDX28",74,0) . . Q:'$D(^DPT(BSDXIEN,0)) "RTN","BSDX28",75,0) . . S BSDXDPT=$G(^DPT(BSDXIEN,0)) "RTN","BSDX28",76,0) . . S BSDXZ=$P(BSDXDPT,U) ;NAME "RTN","BSDX28",77,0) . . S BSDXHRN=BSDXP ;CHART "RTN","BSDX28",78,0) . . I $D(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated "RTN","BSDX28",79,0) . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN "RTN","BSDX28",80,0) . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID "RTN","BSDX28",81,0) . . S Y=$P(BSDXDPT,U,3) X ^DD("DD") "RTN","BSDX28",82,0) . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB "RTN","BSDX28",83,0) . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN "RTN","BSDX28",84,0) . . S BSDXRET=BSDXRET_BSDXZ_$C(30) "RTN","BSDX28",85,0) . . Q "RTN","BSDX28",86,0) . Q "RTN","BSDX28",87,0) ; "RTN","BSDX28",88,0) SSN ;SSN Lookup "RTN","BSDX28",89,0) I (BSDXP?9N)!(BSDXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q "RTN","BSDX28",90,0) . S BSDXIEN=0 F S BSDXIEN=$O(^DPT("SSN",BSDXP,BSDXIEN)) Q:'+BSDXIEN D Q "RTN","BSDX28",91,0) . . Q:'$D(^DPT(BSDXIEN,0)) "RTN","BSDX28",92,0) . . S BSDXDPT=$G(^DPT(BSDXIEN,0)) "RTN","BSDX28",93,0) . . S BSDXZ=$P(BSDXDPT,U) ;NAME "RTN","BSDX28",94,0) . . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART "RTN","BSDX28",95,0) . . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2 "RTN","BSDX28",96,0) . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated "RTN","BSDX28",97,0) . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN "RTN","BSDX28",98,0) . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID "RTN","BSDX28",99,0) . . S Y=$P(BSDXDPT,U,3) X ^DD("DD") "RTN","BSDX28",100,0) . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB "RTN","BSDX28",101,0) . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN "RTN","BSDX28",102,0) . . S BSDXRET=BSDXRET_BSDXZ_$C(30) "RTN","BSDX28",103,0) . . Q "RTN","BSDX28",104,0) . Q "RTN","BSDX28",105,0) ; "RTN","BSDX28",106,0) S BSDXFILE=9000001 "RTN","BSDX28",107,0) S BSDXIENS="" "RTN","BSDX28",108,0) S BSDXFIELDS=".01" "RTN","BSDX28",109,0) S BSDXFLAGS="M" "RTN","BSDX28",110,0) S BSDXVALUE=BSDXP "RTN","BSDX28",111,0) S BSDXNUMBER=BSDXC "RTN","BSDX28",112,0) S BSDXINDEXES="" "RTN","BSDX28",113,0) S BSDXSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"") "RTN","BSDX28",114,0) S BSDXIDEN="" "RTN","BSDX28",115,0) S BSDXTARG="BSDXRSLT" "RTN","BSDX28",116,0) S BSDXMSG="" "RTN","BSDX28",117,0) D FIND^DIC(BSDXFILE,BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN,BSDXIDEN,BSDXTARG,BSDXMSG) "RTN","BSDX28",118,0) I '+$G(BSDXRSLT("DILIST",0)) S BSDXY=BSDXRET_$C(31) Q "RTN","BSDX28",119,0) N BSDXCNT S BSDXCNT=2 "RTN","BSDX28",120,0) F BSDXX=1:1:$P(BSDXRSLT("DILIST",0),U) D "RTN","BSDX28",121,0) . S BSDXIEN=BSDXRSLT("DILIST",2,BSDXX) "RTN","BSDX28",122,0) . S BSDXZ=BSDXRSLT("DILIST","ID",BSDXX,.01) ;NAME "RTN","BSDX28",123,0) . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART "RTN","BSDX28",124,0) . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2 "RTN","BSDX28",125,0) . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated "RTN","BSDX28",126,0) . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN "RTN","BSDX28",127,0) . S BSDXDPT=$G(^DPT(BSDXIEN,0)) "RTN","BSDX28",128,0) . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID "RTN","BSDX28",129,0) . S Y=$P(BSDXDPT,U,3) X ^DD("DD") "RTN","BSDX28",130,0) . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB "RTN","BSDX28",131,0) . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN "RTN","BSDX28",132,0) . S $P(BSDXRET,$C(30),BSDXCNT)=BSDXZ "RTN","BSDX28",133,0) . S BSDXCNT=BSDXCNT+1 "RTN","BSDX28",134,0) . Q "RTN","BSDX28",135,0) S BSDXY=BSDXRET_$C(30)_$C(31) "RTN","BSDX28",136,0) Q "RTN","BSDX28",137,0) ; "RTN","BSDX28",138,0) ERROR ; "RTN","BSDX28",139,0) D ERR("RPMS Error") "RTN","BSDX28",140,0) Q "RTN","BSDX28",141,0) ; "RTN","BSDX28",142,0) ERR(ERRNO) ;Error processing "RTN","BSDX28",143,0) S BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)_"^^^^"_$C(30)_$C(31) "RTN","BSDX28",144,0) Q "RTN","BSDX29") 0^27^B39369778 "RTN","BSDX29",1,0) BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:03pm "RTN","BSDX29",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX29",3,0) ; "RTN","BSDX29",4,0) ; Change Log: "RTN","BSDX29",5,0) ; v1.3 by WV/SMH on 3100713 "RTN","BSDX29",6,0) ; - Beginning and Ending dates passed as FM Dates "RTN","BSDX29",7,0) ; "RTN","BSDX29",8,0) BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP "RTN","BSDX29",9,0) ;Entry point for debugging "RTN","BSDX29",10,0) ; "RTN","BSDX29",11,0) ;D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)") "RTN","BSDX29",12,0) Q "RTN","BSDX29",13,0) ; "RTN","BSDX29",14,0) BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP "RTN","BSDX29",15,0) ;Copy appointments from HOSPITAL LOCATION entry BSDX44 to BSDX RESOURCE entry BSDXRES "RTN","BSDX29",16,0) ;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive "RTN","BSDX29",17,0) ; "RTN","BSDX29",18,0) ;Returns ADO Recordset formatted fields containing count of records copied and error message: "RTN","BSDX29",19,0) ; "RTN","BSDX29",20,0) ; July 13 2010: D dates (BEG and END) from US format to FM Dates for i18n "RTN","BSDX29",21,0) ; "RTN","BSDX29",22,0) ; "RTN","BSDX29",23,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX29",24,0) N BSDXI,BSDXST,ZTSK "RTN","BSDX29",25,0) S BSDXI=0 "RTN","BSDX29",26,0) S X="ETRAP^BSDX29",@^%ZOSF("TRAP") "RTN","BSDX29",27,0) S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00020ERRORID"_$C(30) "RTN","BSDX29",28,0) ; "RTN","BSDX29",29,0) ;Convert beginning and ending dates "RTN","BSDX29",30,0) ; "RTN","BSDX29",31,0) ;TODO:Validate FM Dates coming through "RTN","BSDX29",32,0) ; "RTN","BSDX29",33,0) S BSDXBEG=BSDXBEG-1 "RTN","BSDX29",34,0) S BSDXEND=BSDXEND+1 "RTN","BSDX29",35,0) ; "RTN","BSDX29",36,0) S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS" "RTN","BSDX29",37,0) S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")="" "RTN","BSDX29",38,0) D ^%ZTLOAD "RTN","BSDX29",39,0) ; "RTN","BSDX29",40,0) S BSDXI=BSDXI+1 "RTN","BSDX29",41,0) S BSDXST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.") "RTN","BSDX29",42,0) S ^BSDXTMP($J,BSDXI)=$G(ZTSK)_"^"_BSDXST_$C(30)_$C(31) "RTN","BSDX29",43,0) Q "RTN","BSDX29",44,0) ; "RTN","BSDX29",45,0) ZTMTST ; "RTN","BSDX29",46,0) ; "RTN","BSDX29",47,0) S %DT="AE" D ^%DT S BSDXBEG=Y "RTN","BSDX29",48,0) S %DT="AE" D ^%DT S BSDXEND=Y "RTN","BSDX29",49,0) S BSDX44=3,BSDXSRES=1,ZTSK=3380 "RTN","BSDX29",50,0) D ZTM "RTN","BSDX29",51,0) Q "RTN","BSDX29",52,0) ; "RTN","BSDX29",53,0) ZTMD ;EP - Debug entry point "RTN","BSDX29",54,0) ;D DEBUG^%Serenji("ZTM^BSDX29") "RTN","BSDX29",55,0) Q "RTN","BSDX29",56,0) ; "RTN","BSDX29",57,0) ZTM ;EP "RTN","BSDX29",58,0) ;Taskman entry point "RTN","BSDX29",59,0) S X="ZTMERR^BSDX29",@^%ZOSF("TRAP") "RTN","BSDX29",60,0) ;$O through ^SC(BSDX44,"S", "RTN","BSDX29",61,0) Q:'$D(ZTSK) "RTN","BSDX29",62,0) N BSDXCNT,BSDXIEN,BSDXNOD,BSDXNOTE,BSDXCAN,BSDXPAT,BSDXLEN,BSDXMADE,BSDXCLRK,BSDXPAT,BSDXQUIT "RTN","BSDX29",63,0) S BSDXCNT=0,BSDXQUIT=0 "RTN","BSDX29",64,0) S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT "RTN","BSDX29",65,0) TSTART "RTN","BSDX29",66,0) F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D "RTN","BSDX29",67,0) . S BSDXIEN=0 F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D "RTN","BSDX29",68,0) . . S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) "RTN","BSDX29",69,0) . . Q:'+BSDXNOD "RTN","BSDX29",70,0) . . S BSDXCAN=$P(BSDXNOD,U,9) "RTN","BSDX29",71,0) . . Q:BSDXCAN="C" "RTN","BSDX29",72,0) . . S BSDXPAT=$P(BSDXNOD,U) "RTN","BSDX29",73,0) . . S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes "RTN","BSDX29",74,0) . . S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk) "RTN","BSDX29",75,0) . . S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made "RTN","BSDX29",76,0) . . S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note "RTN","BSDX29",77,0) . . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) "RTN","BSDX29",78,0) . . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record "RTN","BSDX29",79,0) . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag "RTN","BSDX29",80,0) . . Q "RTN","BSDX29",81,0) . Q "RTN","BSDX29",82,0) I 'BSDXQUIT TCOMMIT "RTN","BSDX29",83,0) E TROLLBACK "RTN","BSDX29",84,0) S ^BSDXTMP("BSDXCOPY",ZTSK)=$S(BSDXQUIT:"Cancelled. No records copied.",1:"Finished. "_BSDXCNT_" records copied.") "RTN","BSDX29",85,0) Q "RTN","BSDX29",86,0) ; "RTN","BSDX29",87,0) ZTMERR ; "RTN","BSDX29",88,0) TROLLBACK "RTN","BSDX29",89,0) D ^%ZTER "RTN","BSDX29",90,0) Q "RTN","BSDX29",91,0) ; "RTN","BSDX29",92,0) XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP "RTN","BSDX29",93,0) ; "RTN","BSDX29",94,0) ;Copy record to BSDX APPOINTMENT file "RTN","BSDX29",95,0) ;Return 1 if record copied, otherwise 0 "RTN","BSDX29",96,0) ; "RTN","BSDX29",97,0) ;$O Thru ^BSDXAPPT to determine if this appt already added "RTN","BSDX29",98,0) N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2 "RTN","BSDX29",99,0) S BSDXIEN=0,BSDXFND=0 "RTN","BSDX29",100,0) F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND "RTN","BSDX29",101,0) . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0)) "RTN","BSDX29",102,0) . Q:'+BSDXNOD "RTN","BSDX29",103,0) . S BSDXPAT2=$P(BSDXNOD,U,5) "RTN","BSDX29",104,0) . S BSDXFND=0 "RTN","BSDX29",105,0) . I BSDXPAT2=BSDXPAT S BSDXFND=1 "RTN","BSDX29",106,0) . Q "RTN","BSDX29",107,0) Q:BSDXFND 0 "RTN","BSDX29",108,0) ; "RTN","BSDX29",109,0) ;Add to BSDX APPOINTMENT "RTN","BSDX29",110,0) S BSDXEND=BSDXBEG "RTN","BSDX29",111,0) ;Calculate ending time from beginning time and duration. "RTN","BSDX29",112,0) S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN) "RTN","BSDX29",113,0) S BSDXIENS="+1," "RTN","BSDX29",114,0) S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG "RTN","BSDX29",115,0) S BSDXFDA(9002018.4,BSDXIENS,.02)=BSDXEND "RTN","BSDX29",116,0) S BSDXFDA(9002018.4,BSDXIENS,.05)=BSDXPAT "RTN","BSDX29",117,0) S BSDXFDA(9002018.4,BSDXIENS,.07)=BSDXRES "RTN","BSDX29",118,0) S BSDXFDA(9002018.4,BSDXIENS,.08)=BSDXCLRK "RTN","BSDX29",119,0) S BSDXFDA(9002018.4,BSDXIENS,.09)=BSDXMADE "RTN","BSDX29",120,0) ; "RTN","BSDX29",121,0) K BSDXIEN "RTN","BSDX29",122,0) D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX29",123,0) S BSDXIEN=+$G(BSDXIEN(1)) "RTN","BSDX29",124,0) I '+BSDXIEN Q 0 "RTN","BSDX29",125,0) ; "RTN","BSDX29",126,0) ;Add WP field "RTN","BSDX29",127,0) I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D "RTN","BSDX29",128,0) . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG") "RTN","BSDX29",129,0) ; "RTN","BSDX29",130,0) Q 1 "RTN","BSDX29",131,0) ; "RTN","BSDX29",132,0) ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing "RTN","BSDX29",133,0) S BSDXI=BSDXI+1 "RTN","BSDX29",134,0) S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30) "RTN","BSDX29",135,0) S BSDXI=BSDXI+1 "RTN","BSDX29",136,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX29",137,0) Q "RTN","BSDX29",138,0) ; "RTN","BSDX29",139,0) ETRAP ;EP Error trap entry "RTN","BSDX29",140,0) D ^%ZTER "RTN","BSDX29",141,0) I '$D(BSDXI) N BSDXI S BSDXI=999 "RTN","BSDX29",142,0) S BSDXI=BSDXI+1 "RTN","BSDX29",143,0) D ERR(BSDXI,$G(BSDXCNT),"Routine: BSDX29, Error: "_$G(%ZTERROR)) "RTN","BSDX29",144,0) Q "RTN","BSDX29",145,0) ; "RTN","BSDX29",146,0) CPSTAT(BSDXY,BSDXTSK) ;EP "RTN","BSDX29",147,0) ;Return status (copied record count) of tasked job having ZTSK=BSDXTSK "RTN","BSDX29",148,0) ; "RTN","BSDX29",149,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX29",150,0) N BSDXI,BSDXCNT "RTN","BSDX29",151,0) S BSDXI=0 "RTN","BSDX29",152,0) S X="ETRAP^BSDX29",@^%ZOSF("TRAP") "RTN","BSDX29",153,0) S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30) "RTN","BSDX29",154,0) S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK)) "RTN","BSDX29",155,0) I BSDXCNT["Finished" K ^BSDXTMP("BSDXCOPY",BSDXTSK) "RTN","BSDX29",156,0) I BSDXCNT["Cancelled" K ^BSDXTMP("BSDXCOPY",BSDXTSK) "RTN","BSDX29",157,0) ;I $D(^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")) K ^BSDXTMP("BSDXCOPY",BSDXTSK) "RTN","BSDX29",158,0) S BSDXI=BSDXI+1 "RTN","BSDX29",159,0) S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31) "RTN","BSDX29",160,0) Q "RTN","BSDX29",161,0) ; "RTN","BSDX29",162,0) CPCANC(BSDXY,BSDXTSK) ;EP "RTN","BSDX29",163,0) ;Signal tasked job having ZTSK=BSDXTSK to cancel "RTN","BSDX29",164,0) ;Returns current record count of copy process "RTN","BSDX29",165,0) ; "RTN","BSDX29",166,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX29",167,0) N BSDXI,BSDXCNT "RTN","BSDX29",168,0) S BSDXI=0 "RTN","BSDX29",169,0) S X="ETRAP^BSDX29",@^%ZOSF("TRAP") "RTN","BSDX29",170,0) S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30) "RTN","BSDX29",171,0) S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK)) "RTN","BSDX29",172,0) I BSDXCNT["FINISHED" K ^BSDXTMP("BSDXCOPY",BSDXTSK) "RTN","BSDX29",173,0) E S ^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")="" "RTN","BSDX29",174,0) S BSDXI=BSDXI+1 "RTN","BSDX29",175,0) S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31) "RTN","BSDX29",176,0) Q "RTN","BSDX29",177,0) ; "RTN","BSDX29",178,0) ADDMIN(BSDXSTRT,BSDXLEN) ; "RTN","BSDX29",179,0) ; "RTN","BSDX29",180,0) ;Add BSDXLEN minutes to time BSDXSTRT and return end time "RTN","BSDX29",181,0) N BSDXEND,BSDXH,BSDXM,BSDXSTIM,BSDXETIM "RTN","BSDX29",182,0) S BSDXEND=$P(BSDXSTRT,".") "RTN","BSDX29",183,0) ; "RTN","BSDX29",184,0) ;Convert start time to minutes past midnight "RTN","BSDX29",185,0) S BSDXSTIM=$P(BSDXSTRT,".",2) "RTN","BSDX29",186,0) S BSDXSTIM=BSDXSTIM_"0000" "RTN","BSDX29",187,0) S BSDXSTIM=$E(BSDXSTIM,1,4) "RTN","BSDX29",188,0) S BSDXH=$E(BSDXSTIM,1,2) "RTN","BSDX29",189,0) S BSDXH=BSDXH*60 "RTN","BSDX29",190,0) S BSDXH=BSDXH+$E(BSDXSTIM,3,4) "RTN","BSDX29",191,0) ; "RTN","BSDX29",192,0) ;Add duration to find minutes past midnight of end time "RTN","BSDX29",193,0) S BSDXETIM=BSDXH+BSDXLEN "RTN","BSDX29",194,0) ; "RTN","BSDX29",195,0) ;Convert back to a time "RTN","BSDX29",196,0) S BSDXH=BSDXETIM\60 "RTN","BSDX29",197,0) S BSDXH="00"_BSDXH "RTN","BSDX29",198,0) S BSDXH=$E(BSDXH,$L(BSDXH)-1,$L(BSDXH)) "RTN","BSDX29",199,0) S BSDXM=BSDXETIM#60 "RTN","BSDX29",200,0) S BSDXM="00"_BSDXM "RTN","BSDX29",201,0) S BSDXM=$E(BSDXM,$L(BSDXM)-1,$L(BSDXM)) "RTN","BSDX29",202,0) S BSDXETIM=BSDXH_BSDXM "RTN","BSDX29",203,0) I BSDXETIM>2400 S BSDXETIM=2400 "RTN","BSDX29",204,0) S $P(BSDXEND,".",2)=BSDXETIM "RTN","BSDX29",205,0) Q BSDXEND "RTN","BSDX2E") 0^^B27292304 "RTN","BSDX2E",1,0) BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/18/10 4:30pm] "RTN","BSDX2E",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX2E",3,0) ; "RTN","BSDX2E",4,0) S LINE="",$P(LINE,"*",81)="" "RTN","BSDX2E",5,0) S XPDNOQUE="NO QUE" ;NO QUEUING ALLOWED "RTN","BSDX2E",6,0) S XPDABORT=0 "RTN","BSDX2E",7,0) I '$G(DUZ) D SORRY("DUZ UNDEFINED OR 0") Q "RTN","BSDX2E",8,0) ; "RTN","BSDX2E",9,0) I '$L($G(DUZ(0))) D SORRY("DUZ(0) UNDEFINED OR NULL") Q "RTN","BSDX2E",10,0) ; "RTN","BSDX2E",11,0) D HOME^%ZIS,DT^DICRW "RTN","BSDX2E",12,0) S X=$P($G(^VA(200,DUZ,0)),U) "RTN","BSDX2E",13,0) I $G(X)="" W !,$$C^XBFUNC("Who are you????") D SORRY("Unknown User") Q "RTN","BSDX2E",14,0) ; "RTN","BSDX2E",15,0) VERSION ; "RTN","BSDX2E",16,0) W !,$$C^XBFUNC("Hello, "_$P(X,",",2)_" "_$P(X,",")) "RTN","BSDX2E",17,0) W !!,$$C^XBFUNC("Checking Environment for Install of Version "_$P($T(+2),";",3)_" of "_$P($T(+2),";",4)_".") "RTN","BSDX2E",18,0) ; "RTN","BSDX2E",19,0) Q:'$$VERCHK("VA FILEMAN",22) "RTN","BSDX2E",20,0) Q:'$$VERCHK("KERNEL",8) "RTN","BSDX2E",21,0) Q:'$$VERCHK("XB",3) "RTN","BSDX2E",22,0) ;Is the PIMS requirement present? "RTN","BSDX2E",23,0) Q:'$$VERCHK("SD",5.3) "RTN","BSDX2E",24,0) ; Q:'$$PATCHCK("PIMS*5.3*1003") D "RTN","BSDX2E",25,0) Q:'$$VERCHK("BMX",2) "RTN","BSDX2E",26,0) ; "RTN","BSDX2E",27,0) OTHER ; "RTN","BSDX2E",28,0) ;Other checks "RTN","BSDX2E",29,0) ; "RTN","BSDX2E",30,0) ENVOK ; If this is just an environ check, end here. "RTN","BSDX2E",31,0) W !!,$$C^XBFUNC("ENVIRONMENT OK.") "RTN","BSDX2E",32,0) ; "RTN","BSDX2E",33,0) ; The following line prevents the "Disable Options..." and "Move "RTN","BSDX2E",34,0) ; Routines..." questions from being asked during the install. "RTN","BSDX2E",35,0) I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0 "RTN","BSDX2E",36,0) ; "RTN","BSDX2E",37,0) ; "RTN","BSDX2E",38,0) ;VERIFY BACKUPS HAVE BEEN DONE "RTN","BSDX2E",39,0) ;W !! "RTN","BSDX2E",40,0) ;S DIR(0)="Y" "RTN","BSDX2E",41,0) ;S DIR("B")="NO" "RTN","BSDX2E",42,0) ;S DIR("A")="Has a SUCCESSFUL system backup been performed??" "RTN","BSDX2E",43,0) ;D ^DIR "RTN","BSDX2E",44,0) ;I $D(DIRUT)!($G(Y)=0) S XPDABORT=1 S XPX="BACKUP" D SORRY Q "RTN","BSDX2E",45,0) ;S ^TMP("BPCPRE",$J,"BACKUPS CONFIRMED BY "_DUZ)=$H "RTN","BSDX2E",46,0) ; "RTN","BSDX2E",47,0) Q "RTN","BSDX2E",48,0) ; "RTN","BSDX2E",49,0) VERCHK(XPXPKG,XVRMIN) ; "RTN","BSDX2E",50,0) S X=$$VERSION^XPDUTL(XPXPKG) "RTN","BSDX2E",51,0) W !!,$$C^XBFUNC("Need at least "_XPXPKG_" "_XVRMIN_"....."_XPXPKG_" "_$S(X'="":X,1:"Is Not")_" Present") "RTN","BSDX2E",52,0) I X0 BSDXFDA(101.01,ORUIEN_SDEVTIENS,.01)="@" "RTN","BSDX2E",104,0) S:DVBAIEN>0 BSDXFDA(101.01,DVBAIEN_SDEVTIENS,.01)="@" "RTN","BSDX2E",105,0) D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG") "RTN","BSDX2E",106,0) ; If error "RTN","BSDX2E",107,0) I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1) "RTN","BSDX2E",108,0) QUIT "RTN","BSDX2E",109,0) ; "RTN","BSDX2E",110,0) SORRY(XPX) ; "RTN","BSDX2E",111,0) K DIFQ "RTN","BSDX2E",112,0) S XPDABORT=1 "RTN","BSDX2E",113,0) W !,$$C^XBFUNC($P($T(+2),";",3)_" of "_$P($T(+2),";",4)_" Cannot Be Installed!") "RTN","BSDX2E",114,0) W !,$$C^XBFUNC("Reason: "_XPX_".") "RTN","BSDX2E",115,0) W *7,!!!,$$C^XBFUNC("Sorry....something is wrong with your environment") "RTN","BSDX2E",116,0) W !,$$C^XBFUNC("Aborting "_XPDNM_" install!") "RTN","BSDX2E",117,0) W !,$$C^XBFUNC("Correct error and reinstall otherwise") "RTN","BSDX2E",118,0) W !,$$C^XBFUNC("please print/capture this screen and notify") "RTN","BSDX2E",119,0) W !,$$C^XBFUNC("technical support") "RTN","BSDX2E",120,0) W !!,LINE "RTN","BSDX2E",121,0) D BMES^XPDUTL("Sorry....something is wrong with your environment") "RTN","BSDX2E",122,0) D BMES^XPDUTL("Enviroment ERROR "_$G(XPX)) "RTN","BSDX2E",123,0) D BMES^XPDUTL("Aborting "_XPDNM_" install!") "RTN","BSDX2E",124,0) D BMES^XPDUTL("Correct error and reinstall otherwise") "RTN","BSDX2E",125,0) D BMES^XPDUTL("please print/capture this screen and notify") "RTN","BSDX2E",126,0) D BMES^XPDUTL("technical support") "RTN","BSDX2E",127,0) Q "RTN","BSDX2E",128,0) ; "RTN","BSDX30") 0^28^B6616255 "RTN","BSDX30",1,0) BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [ 09/12/2007 1:54 PM ] "RTN","BSDX30",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX30",3,0) ; "RTN","BSDX30",4,0) ; "RTN","BSDX30",5,0) SPACED(BSDXY,BSDXDIC,BSDXVAL) ;EP "RTN","BSDX30",6,0) ;Entry point for debugging "RTN","BSDX30",7,0) ; "RTN","BSDX30",8,0) D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)") "RTN","BSDX30",9,0) Q "RTN","BSDX30",10,0) ; "RTN","BSDX30",11,0) SPACE(BSDXY,BSDXDIC,BSDXVAL) ;EP "RTN","BSDX30",12,0) ;Update ^DISV with most recent lookup value BSDXVAL from file BSDXDIC "RTN","BSDX30",13,0) ;BSDXDIC is the data global in the form GLOBAL( "RTN","BSDX30",14,0) ;BSDXVAL is the entry number (IEN) in the file "RTN","BSDX30",15,0) ; "RTN","BSDX30",16,0) ;Return Status = 1 if success, 0 if fail "RTN","BSDX30",17,0) ; "RTN","BSDX30",18,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX30",19,0) N BSDX1,BSDXRES "RTN","BSDX30",20,0) S BSDXI=0 "RTN","BSDX30",21,0) S X="ETRAP^BSDX30",@^%ZOSF("TRAP") "RTN","BSDX30",22,0) I (BSDXDIC="")!('+$G(BSDXVAL)) D ERR(BSDXI+1,99) Q "RTN","BSDX30",23,0) S BSDXDIC="^"_BSDXDIC "RTN","BSDX30",24,0) S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30) "RTN","BSDX30",25,0) ;Note: Naked reference below is immediately preceded "RTN","BSDX30",26,0) ;by the full global reference per SAC 2.2.2.8 "RTN","BSDX30",27,0) I $D(@(BSDXDIC_"BSDXVAL,0)")),'$D(^(-9)) D "RTN","BSDX30",28,0) . S ^DISV(DUZ,BSDXDIC)=BSDXVAL "RTN","BSDX30",29,0) . S BSDXRES=1 "RTN","BSDX30",30,0) E S BSDXRES=0 "RTN","BSDX30",31,0) S BSDXI=BSDXI+1 "RTN","BSDX30",32,0) S ^BSDXTMP($J,BSDXI)=BSDXRES_$C(30)_$C(31) "RTN","BSDX30",33,0) Q "RTN","BSDX30",34,0) ; "RTN","BSDX30",35,0) ERR(BSDXI,BSDXERR) ;Error processing "RTN","BSDX30",36,0) S BSDXI=BSDXI+1 "RTN","BSDX30",37,0) S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) "RTN","BSDX30",38,0) S BSDXI=BSDXI+1 "RTN","BSDX30",39,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX30",40,0) Q "RTN","BSDX30",41,0) ; "RTN","BSDX30",42,0) ETRAP ;EP Error trap entry "RTN","BSDX30",43,0) I '$D(BSDXI) N BSDXI S BSDXI=999 "RTN","BSDX30",44,0) S BSDXI=BSDXI+1 "RTN","BSDX30",45,0) D ERR(99,0) "RTN","BSDX30",46,0) Q "RTN","BSDX30",47,0) ; "RTN","BSDX30",48,0) EHRPTD(BSDXY,BSDXWID,BSDXDFN) ; "RTN","BSDX30",49,0) ; "RTN","BSDX30",50,0) D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)") "RTN","BSDX30",51,0) Q "RTN","BSDX30",52,0) ; "RTN","BSDX30",53,0) EHRPT(BSDXY,BSDXWID,BSDXDFN) ; "RTN","BSDX30",54,0) ; "RTN","BSDX30",55,0) ;Return Status = 1 if success, 0 if error "RTN","BSDX30",56,0) ; "RTN","BSDX30",57,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX30",58,0) N BSDX1,BSDXRES "RTN","BSDX30",59,0) S BSDXI=0,BSDXRES=1 "RTN","BSDX30",60,0) S X="ETRAP^BSDX30",@^%ZOSF("TRAP") "RTN","BSDX30",61,0) S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30) "RTN","BSDX30",62,0) I '+BSDXDFN D ERR(BSDXI+1,0) Q "RTN","BSDX30",63,0) ; "RTN","BSDX30",64,0) D PEVENT(BSDXWID,BSDXDFN) ;Raise patient selected event "RTN","BSDX30",65,0) ; "RTN","BSDX30",66,0) S BSDXI=BSDXI+1 "RTN","BSDX30",67,0) S ^BSDXTMP($J,BSDXI)=BSDXRES_$C(30)_$C(31) "RTN","BSDX30",68,0) Q "RTN","BSDX30",69,0) ; "RTN","BSDX30",70,0) PEVENT(BSDXWID,DFN) ;EP - Raise patient selection event to EHR "RTN","BSDX30",71,0) ; "RTN","BSDX30",72,0) ;Change patient context to patient DFN "RTN","BSDX30",73,0) ;on all EHR client sessions associated with user DUZ "RTN","BSDX30",74,0) ;and workstation BSDXWID. "RTN","BSDX30",75,0) ; "RTN","BSDX30",76,0) ;If BSDXWID is "", the context change is sent to "RTN","BSDX30",77,0) ;all EHR client sessions belonging to user DUZ. "RTN","BSDX30",78,0) ; "RTN","BSDX30",79,0) Q:'$G(DUZ) "RTN","BSDX30",80,0) ;N X "RTN","BSDX30",81,0) ;S X="CIANBUTL" X ^%ZOSF("TEST") Q:'$T "RTN","BSDX30",82,0) ;S X="CIANBEVT" X ^%ZOSF("TEST") Q:'$T "RTN","BSDX30",83,0) N UID,BRET "RTN","BSDX30",84,0) S BRET=0,UID=0 "RTN","BSDX30",85,0) F S BRET=$$NXTUID^CIANBUTL(.UID,1) Q:'UID D "RTN","BSDX30",86,0) . Q:DUZ'=$$GETVAR^CIANBUTL("DUZ",,,UID) "RTN","BSDX30",87,0) . I BSDXWID'="" Q:BSDXWID'=$TR($$GETVAR^CIANBUTL("WID",,,UID),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","BSDX30",88,0) . D QUEUE^CIANBEVT("CONTEXT.PATIENT",+DFN,UID) "RTN","BSDX30",89,0) Q "RTN","BSDX31") 0^29^B23243257 "RTN","BSDX31",1,0) BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX31",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX31",3,0) ; "RTN","BSDX31",4,0) ; "RTN","BSDX31",5,0) NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP "RTN","BSDX31",6,0) ;Entry point for debugging "RTN","BSDX31",7,0) ; "RTN","BSDX31",8,0) ;D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)") "RTN","BSDX31",9,0) Q "RTN","BSDX31",10,0) ; "RTN","BSDX31",11,0) NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP "RTN","BSDX31",12,0) ;Called by BSDX NOSHOW "RTN","BSDX31",13,0) ;Sets appointment noshow flag in BSDX APPOINTMENT file "RTN","BSDX31",14,0) ;BSDXAPTID is entry number in BSDX APPOINTMENT file "RTN","BSDX31",15,0) ;BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO "RTN","BSDX31",16,0) ;Calls CANCEL^BSDAPI to set noshow data in ^DPT "RTN","BSDX31",17,0) ;Returns error code in recordset field ERRORID "RTN","BSDX31",18,0) ; "RTN","BSDX31",19,0) N BSDXNOD,BSDXPATID,BSDXSTART,BSDXID,BSDXI,BSDXZ,BSDXERR,BSDXMSG,BSDXFDA,BSDXIENS "RTN","BSDX31",20,0) N BSDXNOEV "RTN","BSDX31",21,0) S BSDXNOEV=1 ;Don't execute protocol "RTN","BSDX31",22,0) ; "RTN","BSDX31",23,0) D ^XBKVAR S X="ETRAP^BSDX31",@^%ZOSF("TRAP") "RTN","BSDX31",24,0) S BSDXI=0 "RTN","BSDX31",25,0) K ^BSDXTMP($J) "RTN","BSDX31",26,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX31",27,0) S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30) "RTN","BSDX31",28,0) S BSDXI=BSDXI+1 "RTN","BSDX31",29,0) TSTART "RTN","BSDX31",30,0) I '+BSDXAPTID D ERR(0,"BSDX31: Invalid Appointment ID") Q "RTN","BSDX31",31,0) I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(0,"BSDX31: Invalid Appointment ID") Q "RTN","BSDX31",32,0) S BSDXNS=+BSDXNS "RTN","BSDX31",33,0) I BSDXNS'=1&(BSDXNS'=0) D ERR(0,"BSDX31: Invalid No Show value") Q "RTN","BSDX31",34,0) ; "RTN","BSDX31",35,0) ;Edit BSDX APPOINTMENT entry NOSHOW field "RTN","BSDX31",36,0) S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) "RTN","BSDX31",37,0) I BSDXNOD="" D ERR(0,"BSDX31: Invalid Appointment ID") Q "RTN","BSDX31",38,0) S BSDXPATID=$P(BSDXNOD,U,5) "RTN","BSDX31",39,0) S BSDXSTART=$P(BSDXNOD,U) "RTN","BSDX31",40,0) ; "RTN","BSDX31",41,0) D BSDXNOS(BSDXAPTID,BSDXNS) "RTN","BSDX31",42,0) I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(0,"BSDX31: "_BSDXMSG) Q "RTN","BSDX31",43,0) ; "RTN","BSDX31",44,0) S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID "RTN","BSDX31",45,0) I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(0,BSDXERR) Q "RTN","BSDX31",46,0) . S BSDXNOD=^BSDXRES(BSDXSC1,0) "RTN","BSDX31",47,0) . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION "RTN","BSDX31",48,0) . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS) "RTN","BSDX31",49,0) ; "RTN","BSDX31",50,0) TCOMMIT "RTN","BSDX31",51,0) S BSDXI=BSDXI+1 "RTN","BSDX31",52,0) S ^BSDXTMP($J,BSDXI)="1^"_$C(30) "RTN","BSDX31",53,0) S BSDXI=BSDXI+1 "RTN","BSDX31",54,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX31",55,0) Q "RTN","BSDX31",56,0) ; "RTN","BSDX31",57,0) APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS) ; "RTN","BSDX31",58,0) ; update file 2 info "RTN","BSDX31",59,0) ;Set noshow for patient BSDXDFN in clinic BSDXSC1 "RTN","BSDX31",60,0) ;at time BSDXSD "RTN","BSDX31",61,0) N BSDXC,%H,BSDXCDT,BSDXIEN "RTN","BSDX31",62,0) N BSDXIENS,BSDXFDA,BSDXMSG "RTN","BSDX31",63,0) S %H=$H D YMD^%DTC "RTN","BSDX31",64,0) S BSDXCDT=X+% "RTN","BSDX31",65,0) ; "RTN","BSDX31",66,0) S BSDXIENS=BSDXSD_","_BSDXDFN_"," "RTN","BSDX31",67,0) I +BSDXNS D "RTN","BSDX31",68,0) . S BSDXFDA(2.98,BSDXIENS,3)="N" "RTN","BSDX31",69,0) . S BSDXFDA(2.98,BSDXIENS,14)=DUZ "RTN","BSDX31",70,0) . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT "RTN","BSDX31",71,0) E D "RTN","BSDX31",72,0) . S BSDXFDA(2.98,BSDXIENS,3)="" "RTN","BSDX31",73,0) . S BSDXFDA(2.98,BSDXIENS,14)="" "RTN","BSDX31",74,0) . S BSDXFDA(2.98,BSDXIENS,15)="" "RTN","BSDX31",75,0) K BSDXIEN "RTN","BSDX31",76,0) D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") "RTN","BSDX31",77,0) S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1)) "RTN","BSDX31",78,0) Q "RTN","BSDX31",79,0) ; "RTN","BSDX31",80,0) BSDXNOS(BSDXAPTID,BSDXNS) ; "RTN","BSDX31",81,0) ; "RTN","BSDX31",82,0) N BSDXFDA,BSDXIENS "RTN","BSDX31",83,0) S BSDXIENS=BSDXAPTID_"," "RTN","BSDX31",84,0) S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW "RTN","BSDX31",85,0) D FILE^DIE("","BSDXFDA","BSDXMSG") "RTN","BSDX31",86,0) ; "RTN","BSDX31",87,0) Q "RTN","BSDX31",88,0) ; "RTN","BSDX31",89,0) NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event "RTN","BSDX31",90,0) ;when appointments NOSHOW via PIMS interface. "RTN","BSDX31",91,0) ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients "RTN","BSDX31",92,0) ; "RTN","BSDX31",93,0) Q:+$G(BSDXNOEV) "RTN","BSDX31",94,0) Q:'+$G(BSDXSC) "RTN","BSDX31",95,0) Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK" "RTN","BSDX31",96,0) N BSDXSTAT,BSDXFOUND,BSDXRES "RTN","BSDX31",97,0) S BSDXSTAT=1 "RTN","BSDX31",98,0) S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0 "RTN","BSDX31",99,0) S BSDXFOUND=0 "RTN","BSDX31",100,0) I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) "RTN","BSDX31",101,0) I BSDXFOUND D NOSEVT3(BSDXRES) Q "RTN","BSDX31",102,0) I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) "RTN","BSDX31",103,0) I BSDXFOUND D NOSEVT3(BSDXRES) "RTN","BSDX31",104,0) Q "RTN","BSDX31",105,0) ; "RTN","BSDX31",106,0) NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ; "RTN","BSDX31",107,0) ;Get appointment id in BSDXAPT "RTN","BSDX31",108,0) ;If found, call BSDXNOS(BSDXAPPT) and return 1 "RTN","BSDX31",109,0) ;else return 0 "RTN","BSDX31",110,0) N BSDXFOUND,BSDXAPPT "RTN","BSDX31",111,0) S BSDXFOUND=0 "RTN","BSDX31",112,0) Q:'+$G(BSDXRES) BSDXFOUND "RTN","BSDX31",113,0) Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND "RTN","BSDX31",114,0) S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND "RTN","BSDX31",115,0) . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" "RTN","BSDX31",116,0) . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q "RTN","BSDX31",117,0) I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT) "RTN","BSDX31",118,0) Q BSDXFOUND "RTN","BSDX31",119,0) ; "RTN","BSDX31",120,0) NOSEVT3(BSDXRES) ; "RTN","BSDX31",121,0) ;Call RaiseEvent to notify GUI clients "RTN","BSDX31",122,0) ; "RTN","BSDX31",123,0) N BSDXRESN "RTN","BSDX31",124,0) S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) "RTN","BSDX31",125,0) Q:BSDXRESN="" "RTN","BSDX31",126,0) S BSDXRESN=$P(BSDXRESN,"^") "RTN","BSDX31",127,0) D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) "RTN","BSDX31",128,0) Q "RTN","BSDX31",129,0) ; "RTN","BSDX31",130,0) ; "RTN","BSDX31",131,0) ERR(BSDXERID,ERRTXT) ;Error processing "RTN","BSDX31",132,0) S:'+$G(BSDXI) BSDXI=999999 "RTN","BSDX31",133,0) S BSDXI=BSDXI+1 "RTN","BSDX31",134,0) TROLLBACK "RTN","BSDX31",135,0) S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) "RTN","BSDX31",136,0) S BSDXI=BSDXI+1 "RTN","BSDX31",137,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX31",138,0) Q "RTN","BSDX31",139,0) ; "RTN","BSDX31",140,0) ETRAP ;EP Error trap entry "RTN","BSDX31",141,0) D ^%ZTER "RTN","BSDX31",142,0) I '$D(BSDXI) N BSDXI S BSDXI=999999 "RTN","BSDX31",143,0) S BSDXI=BSDXI+1 "RTN","BSDX31",144,0) D ERR(0,"BSDX31 Error: "_$G(%ZTERROR)) "RTN","BSDX31",145,0) Q "RTN","BSDX31",146,0) ; "RTN","BSDX31",147,0) IMHERE(BSDXRES) ;EP "RTN","BSDX31",148,0) ;Entry point for BSDX IM HERE remote procedure "RTN","BSDX31",149,0) S BSDXRES=1 "RTN","BSDX31",150,0) Q "RTN","BSDX31",151,0) ; "RTN","BSDX32") 0^30^B17196738 "RTN","BSDX32",1,0) BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/29/10 10:21am "RTN","BSDX32",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX32",3,0) ; "RTN","BSDX32",4,0) ; "RTN","BSDX32",5,0) ERROR ; "RTN","BSDX32",6,0) D ERR("RPMS Error") "RTN","BSDX32",7,0) Q "RTN","BSDX32",8,0) ; "RTN","BSDX32",9,0) ERR(BSDXERR) ;Error processing "RTN","BSDX32",10,0) S BSDXI=BSDXI+1 "RTN","BSDX32",11,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX32",12,0) Q "RTN","BSDX32",13,0) ; "RTN","BSDX32",14,0) HOSPLOCD(BSDXY) ;EP Debugging entry point "RTN","BSDX32",15,0) ; "RTN","BSDX32",16,0) ;D DEBUG^%Serenji("HOSPLOC^BSDX32(.BSDXY)") "RTN","BSDX32",17,0) ; "RTN","BSDX32",18,0) Q "RTN","BSDX32",19,0) ; "RTN","BSDX32",20,0) HOSPLOC(BSDXY) ;EP "RTN","BSDX32",21,0) ;Called by BSDX HOSPITAL LOCATION "RTN","BSDX32",22,0) ;Returns all hospital locations that are active "RTN","BSDX32",23,0) ; "RTN","BSDX32",24,0) N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXINA,BSDXREA,BSDXSCOD "RTN","BSDX32",25,0) D ^XBKVAR S X="ERROR^BSDX32",@^%ZOSF("TRAP") "RTN","BSDX32",26,0) K ^BSDXTMP($J) "RTN","BSDX32",27,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX32",28,0) S BSDXI=0 "RTN","BSDX32",29,0) ;"SELECT BSDXIEN 'HOSPITAL_LOCATION_ID', NAME 'HOSPITAL_LOCATION', DEFAULT_PROVIDER, STOP_CODE_NUMBER, INACTIVATE_DATE, REACTIVATE_DATE FROM HOSPITAL_LOCATION"; "RTN","BSDX32",30,0) S ^BSDXTMP($J,BSDXI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE"_$C(30) "RTN","BSDX32",31,0) ; "RTN","BSDX32",32,0) S BSDXNAM="" F S BSDXNAM=$O(^SC("B",BSDXNAM)) Q:BSDXNAM="" D "RTN","BSDX32",33,0) . S BSDXIEN=$O(^SC("B",BSDXNAM,0)) "RTN","BSDX32",34,0) . Q:'+BSDXIEN>0 "RTN","BSDX32",35,0) . Q:'$D(^SC(+BSDXIEN,0)) "RTN","BSDX32",36,0) . ;Q:'$$INDIV^BSDX01(+BSDXIEN) ; if not in the same division, quit "RTN","BSDX32",37,0) . S BSDXINA=$$GET1^DIQ(44,BSDXIEN_",",2505) ;INACTIVATE "RTN","BSDX32",38,0) . S BSDXREA=$$GET1^DIQ(44,BSDXIEN_",",2506) ;REACTIVATE "RTN","BSDX32",39,0) . I BSDXINA]""&(BSDXREA="") Q ;Clinic is inactivated and has no reactivate date "RTN","BSDX32",40,0) . S BSDXNOD=^SC(BSDXIEN,0) "RTN","BSDX32",41,0) . S BSDXNAM=$P(BSDXNOD,U) "RTN","BSDX32",42,0) . S BSDXSCOD=$$GET1^DIQ(44,BSDXIEN_",",8) ;STOP CODE "RTN","BSDX32",43,0) . ;Calculate default provider "RTN","BSDX32",44,0) . S BSDXPRV="" "RTN","BSDX32",45,0) . I $D(^SC(BSDXIEN,"PR")) D "RTN","BSDX32",46,0) . . S BSDXIEN1=0 F S BSDXIEN1=$O(^SC(BSDXIEN,"PR",BSDXIEN1)) Q:'+BSDXIEN1 Q:BSDXPRV]"" D "RTN","BSDX32",47,0) . . . S BSDXNOD1=$G(^SC(BSDXIEN,"PR",BSDXIEN1,0)) "RTN","BSDX32",48,0) . . . S:$P(BSDXNOD1,U,2)="1" BSDXPRV=$$GET1^DIQ(200,$P(BSDXNOD1,U),.01) "RTN","BSDX32",49,0) . . . Q "RTN","BSDX32",50,0) . . Q "RTN","BSDX32",51,0) . S BSDXI=BSDXI+1 "RTN","BSDX32",52,0) . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXPRV_U_BSDXSCOD_U_BSDXINA_U_BSDXREA_$C(30) "RTN","BSDX32",53,0) . Q "RTN","BSDX32",54,0) S BSDXI=BSDXI+1 "RTN","BSDX32",55,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX32",56,0) Q "RTN","BSDX32",57,0) ; "RTN","BSDX32",58,0) CLNSETD(BSDXY) ;EP Debugging entry point "RTN","BSDX32",59,0) ; "RTN","BSDX32",60,0) ;D DEBUG^%Serenji("CLNSET^BSDX32(.BSDXY)") "RTN","BSDX32",61,0) ; "RTN","BSDX32",62,0) Q "RTN","BSDX32",63,0) ; "RTN","BSDX32",64,0) CLNSET(BSDXY) ;EP "RTN","BSDX32",65,0) ;Called by BSDX CLINIC SETUP "RTN","BSDX32",66,0) ;Returns CLINIC SETUP file entries for clinics which "RTN","BSDX32",67,0) ;are active in ^SC "RTN","BSDX32",68,0) N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXINA,BSDXREA "RTN","BSDX32",69,0) N BSDXCRV,BSDXVSC,BSDXMULT,BSDXREQ,BSDXPCC "RTN","BSDX32",70,0) D ^XBKVAR S X="ERROR^BSDX32",@^%ZOSF("TRAP") "RTN","BSDX32",71,0) K ^BSDXTMP($J) "RTN","BSDX32",72,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX32",73,0) S BSDXI=0 "RTN","BSDX32",74,0) ;SELECT BMXIEN 'HOSPITAL_LOCATION_ID', CLINIC_NAME 'HOSPITAL_LOCATION', CREATE_VISIT_AT_CHECK-IN? 'CREATE_VISIT', VISIT_SERVICE_CATEGORY, MULTIPLE_CLINIC_CODES_USED?, VISIT_PROVIDER_REQUIRED, "RTN","BSDX32",75,0) ;GENERATE_PCCPLUS_FORMS? FROM CLINIC_SETUP_PARAMETERS "RTN","BSDX32",76,0) S ^BSDXTMP($J,BSDXI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030CREATE_VISIT^T00030VISIT_SERVICE_CATEGORY^T00030MULTIPLE_CLINIC_CODES_USED?^T00030VISIT_PROVIDER_REQUIRED^T00030GENERATE_PCCPLUS_FORMS?"_$C(30) "RTN","BSDX32",77,0) ; "RTN","BSDX32",78,0) S BSDXIEN=0 F S BSDXIEN=$O(^BSDSC(BSDXIEN)) Q:'+BSDXIEN D "RTN","BSDX32",79,0) . Q:'$D(^SC(+BSDXIEN,0)) "RTN","BSDX32",80,0) . Q:'$D(^BSDSC(+BSDXIEN,0)) "RTN","BSDX32",81,0) . S BSDXINA=$$GET1^DIQ(44,BSDXIEN_",",2505) ;INACTIVATE "RTN","BSDX32",82,0) . S BSDXREA=$$GET1^DIQ(44,BSDXIEN_",",2506) ;REACTIVATE "RTN","BSDX32",83,0) . I BSDXINA]""&(BSDXREA="") Q ;Clinic is inactivated and has no reactivate date "RTN","BSDX32",84,0) . S BSDXNOD=^BSDSC(BSDXIEN,0) "RTN","BSDX32",85,0) . S BSDXNAM=$$GET1^DIQ(44,BSDXIEN_",",.01) "RTN","BSDX32",86,0) . S BSDXCRV=$$GET1^DIQ(9009017.2,BSDXIEN_",",.09) "RTN","BSDX32",87,0) . S BSDXVSC=$$GET1^DIQ(9009017.2,BSDXIEN_",",.12) "RTN","BSDX32",88,0) . S BSDXMULT=$$GET1^DIQ(9009017.2,BSDXIEN_",",.13) "RTN","BSDX32",89,0) . S BSDXREQ=$$GET1^DIQ(9009017.2,BSDXIEN_",",.14) "RTN","BSDX32",90,0) . S BSDXPCC=$$GET1^DIQ(9009017.2,BSDXIEN_",",.15) "RTN","BSDX32",91,0) . S BSDXI=BSDXI+1 "RTN","BSDX32",92,0) . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXCRV_U_BSDXVSC_U_BSDXMULT_U_BSDXREQ_U_BSDXPCC_$C(30) "RTN","BSDX32",93,0) . Q "RTN","BSDX32",94,0) S BSDXI=BSDXI+1 "RTN","BSDX32",95,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX32",96,0) Q "RTN","BSDX33") 0^31^B14923306 "RTN","BSDX33",1,0) BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:33pm "RTN","BSDX33",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX33",3,0) ; Mods by WV/STAR "RTN","BSDX33",4,0) ; "RTN","BSDX33",5,0) ; Change Log: "RTN","BSDX33",6,0) ; July 13, 2010 "RTN","BSDX33",7,0) ; v 1.3 adds fixes Rebooking behavior in application (see RBNEXT) "RTN","BSDX33",8,0) ; also adds i18 support - Dates passed in FM format from application "RTN","BSDX33",9,0) ; in tag SETRBK and RBNEXT "RTN","BSDX33",10,0) ; "RTN","BSDX33",11,0) ; "RTN","BSDX33",12,0) Q "RTN","BSDX33",13,0) RBNEXTD(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP "RTN","BSDX33",14,0) ;Entry point for debugging "RTN","BSDX33",15,0) ; "RTN","BSDX33",16,0) ;D DEBUG^%Serenji("RBNEXT^BSDX33(.BSDXY,BSDXDATE,BSDXRES,BSDXTPID)") "RTN","BSDX33",17,0) Q "RTN","BSDX33",18,0) ; "RTN","BSDX33",19,0) RBNEXT(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP "RTN","BSDX33",20,0) ;Called by BSDX REBOOK NEXT BLOCK to find "RTN","BSDX33",21,0) ;the next ACCESS BLOCK in resource BSDXRES after BSDXDATE "RTN","BSDX33",22,0) ;Returns 1 in ERRORID and date in NEXTBLOCK if a block was found or NULL in NEXTBLOCK of no date found "RTN","BSDX33",23,0) ;Otherwise, returns 0 and error message in ERRORTEXT "RTN","BSDX33",24,0) ;If BSDXTPID = 0 then any access type match "RTN","BSDX33",25,0) ; "RTN","BSDX33",26,0) S X="ERROR2^BSDX33",@^%ZOSF("TRAP") "RTN","BSDX33",27,0) N BSDXI,BSDXIENS,%DT,BSDXMSG,Y,BSDXRESD,BSDXFND,BSDXIEN,BSDXNOD,BSDXATID "RTN","BSDX33",28,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX33",29,0) S BSDXI=0 "RTN","BSDX33",30,0) S ^BSDXTMP($J,BSDXI)="I00020ERRORID^D00010NEXTBLOCK^T00030ERRORTEXT"_$C(30) "RTN","BSDX33",31,0) ; "RTN","BSDX33",32,0) I BSDXRES="" D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q "RTN","BSDX33",33,0) I '$D(^BSDXRES("B",BSDXRES)) D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q "RTN","BSDX33",34,0) S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0)) "RTN","BSDX33",35,0) I '+BSDXRESD D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q "RTN","BSDX33",36,0) ; "RTN","BSDX33",37,0) ; i18n fix "RTN","BSDX33",38,0) ; S X=BSDXDATE,%DT="XT" D ^%DT "RTN","BSDX33",39,0) ; I Y=-1 D ERR2(1,"BSDX REBOOK NEXT BLOCK: Invalid datetime") Q "RTN","BSDX33",40,0) ; "RTN","BSDX33",41,0) ; S BSDXDATE=$P(Y,".") "RTN","BSDX33",42,0) ; "RTN","BSDX33",43,0) S BSDXFND=0 "RTN","BSDX33",44,0) F S BSDXDATE=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE)) Q:'+BSDXDATE D Q:BSDXFND "RTN","BSDX33",45,0) . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND "RTN","BSDX33",46,0) . . Q:'$D(^BSDXAB(BSDXIEN,0)) "RTN","BSDX33",47,0) . . S BSDXNOD=^BSDXAB(BSDXIEN,0) "RTN","BSDX33",48,0) . . Q:+$P(BSDXNOD,U,4)=0 ;Slots "RTN","BSDX33",49,0) . . S BSDXATID=$P(BSDXNOD,U,5) "RTN","BSDX33",50,0) . . I BSDXTPID=0!(BSDXATID=BSDXTPID) S BSDXFND=$P(BSDXNOD,U,2) Q "RTN","BSDX33",51,0) ; "RTN","BSDX33",52,0) I BSDXFND=0 S BSDXFND="" "RTN","BSDX33",53,0) E S Y=BSDXFND X ^DD("DD") S BSDXFND=Y "RTN","BSDX33",54,0) S BSDXI=BSDXI+1 "RTN","BSDX33",55,0) ;//smh - bug (V 1.3): Need to replace @ in FM date for C# to recognize it "RTN","BSDX33",56,0) S BSDXFND=$TR(BSDXFND,"@"," ") "RTN","BSDX33",57,0) ;//smh end fix "RTN","BSDX33",58,0) S ^BSDXTMP($J,BSDXI)="1^"_BSDXFND_"^"_$C(30)_$C(31) "RTN","BSDX33",59,0) Q "RTN","BSDX33",60,0) SETRBKD(BSDXY,BSDXAPPT,BSDXDATE) ;EP "RTN","BSDX33",61,0) ;Entry point for debugging "RTN","BSDX33",62,0) ; "RTN","BSDX33",63,0) ;D DEBUG^%Serenji("SETRBK^BSDX33(.BSDXY,BSDXAPPT,BSDXDATE)") "RTN","BSDX33",64,0) Q "RTN","BSDX33",65,0) ; "RTN","BSDX33",66,0) SETRBK(BSDXY,BSDXAPPT,BSDXDATE) ;EP "RTN","BSDX33",67,0) ; "RTN","BSDX33",68,0) ;Sets rebook date into appointment "RTN","BSDX33",69,0) ;BSDXAPPT - Appointment ID "RTN","BSDX33",70,0) ;BSDXDATE - Rebook Datetime in internal format "RTN","BSDX33",71,0) ;Called by BSDX REBOOK SET "RTN","BSDX33",72,0) ; "RTN","BSDX33",73,0) ;ErrorID: "RTN","BSDX33",74,0) ; 0 if a problem. Message in ERRORTEXT "RTN","BSDX33",75,0) ; 1 if OK "RTN","BSDX33",76,0) ; "RTN","BSDX33",77,0) S X="ERROR^BSDX33",@^%ZOSF("TRAP") "RTN","BSDX33",78,0) N BSDXI,BSDXIENS,%DT,BSDXMSG,Y "RTN","BSDX33",79,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX33",80,0) S BSDXI=0 "RTN","BSDX33",81,0) S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30) "RTN","BSDX33",82,0) ; "RTN","BSDX33",83,0) I '+BSDXAPPT "RTN","BSDX33",84,0) I '$D(^BSDXAPPT(BSDXAPPT,0)) D ERR(1,"BSDX REBOOK SET: Invalid appointment ID") Q "RTN","BSDX33",85,0) ; i18n (v 1.3) "RTN","BSDX33",86,0) ;S X=BSDXDATE,%DT="XT" D ^%DT "RTN","BSDX33",87,0) ;I Y=-1 D ERR(1,"BSDX REBOOK SET: Invalid rebook datetime") Q "RTN","BSDX33",88,0) ;S BSDXDATE=Y "RTN","BSDX33",89,0) S BSDXIENS=BSDXAPPT_"," "RTN","BSDX33",90,0) S BSDXFDA(9002018.4,BSDXIENS,.11)=+BSDXDATE "RTN","BSDX33",91,0) ; "RTN","BSDX33",92,0) K BSDXMSG "RTN","BSDX33",93,0) D FILE^DIE("","BSDXFDA","BSDXMSG") "RTN","BSDX33",94,0) S BSDXI=BSDXI+1 "RTN","BSDX33",95,0) S ^BSDXTMP($J,BSDXI)="1^"_$C(31) "RTN","BSDX33",96,0) ; "RTN","BSDX33",97,0) Q "RTN","BSDX33",98,0) ; "RTN","BSDX33",99,0) ERR(BSDXERID,ERRTXT) ;Error processing "RTN","BSDX33",100,0) S:'+$G(BSDXI) BSDXI=999999 "RTN","BSDX33",101,0) S BSDXI=BSDXI+1 "RTN","BSDX33",102,0) S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) "RTN","BSDX33",103,0) S BSDXI=BSDXI+1 "RTN","BSDX33",104,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX33",105,0) Q "RTN","BSDX33",106,0) ; "RTN","BSDX33",107,0) ERROR ; "RTN","BSDX33",108,0) D ^%ZTER "RTN","BSDX33",109,0) I '+$G(BSDXI) N BSDXI S BSDXI=999999 "RTN","BSDX33",110,0) S BSDXI=BSDXI+1 "RTN","BSDX33",111,0) D ERR(0,"BSDX33 M Error: <"_$G(%ZTERROR)_">") "RTN","BSDX33",112,0) Q "RTN","BSDX33",113,0) ; "RTN","BSDX33",114,0) ERR2(BSDXERID,ERRTXT) ;Error processing "RTN","BSDX33",115,0) S:'+$G(BSDXI) BSDXI=999999 "RTN","BSDX33",116,0) S BSDXI=BSDXI+1 "RTN","BSDX33",117,0) S ^BSDXTMP($J,BSDXI)=BSDXERID_"^^"_ERRTXT_$C(30) "RTN","BSDX33",118,0) S BSDXI=BSDXI+1 "RTN","BSDX33",119,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX33",120,0) Q "RTN","BSDX33",121,0) ; "RTN","BSDX33",122,0) ERROR2 ; "RTN","BSDX33",123,0) D ^%ZTER "RTN","BSDX33",124,0) I '+$G(BSDXI) N BSDXI S BSDXI=999999 "RTN","BSDX33",125,0) S BSDXI=BSDXI+1 "RTN","BSDX33",126,0) D ERR2(0,"BSDX33 M Error: <"_$G(%ZTERROR)_">") "RTN","BSDX33",127,0) Q "RTN","BSDX34") 0^32^B43182525 "RTN","BSDX34",1,0) BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:37pm "RTN","BSDX34",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX34",3,0) ; "RTN","BSDX34",4,0) ; Change Log: "RTN","BSDX34",5,0) ; July 10 2010: "RTN","BSDX34",6,0) ; CANCLIN AND RBCLIN: Dates passed in FM format for i18n "RTN","BSDX34",7,0) ; "RTN","BSDX34",8,0) Q "RTN","BSDX34",9,0) ; "RTN","BSDX34",10,0) RBCLIND(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP "RTN","BSDX34",11,0) ;Entry point for debugging "RTN","BSDX34",12,0) ; "RTN","BSDX34",13,0) ;D DEBUG^%Serenji("RBCLIN^BSDX34(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)") "RTN","BSDX34",14,0) Q "RTN","BSDX34",15,0) ; "RTN","BSDX34",16,0) RBERR ; "RTN","BSDX34",17,0) ;Called from RBCLIN on error to set up header "RTN","BSDX34",18,0) K ^BSDXTMP($J) "RTN","BSDX34",19,0) S ^BSDXTMP($J,0)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus^I00010RESOURCEID" "RTN","BSDX34",20,0) S ^BSDXTMP($J,0)=^(0)_"^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30) "RTN","BSDX34",21,0) D ERR(999) "RTN","BSDX34",22,0) Q "RTN","BSDX34",23,0) ; "RTN","BSDX34",24,0) CANCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP "RTN","BSDX34",25,0) ; "RTN","BSDX34",26,0) ;Return recordset of CANCELLED patient appointments "RTN","BSDX34",27,0) ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST. "RTN","BSDX34",28,0) ;Used in generating cancellation letters for a clinic "RTN","BSDX34",29,0) ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.) "RTN","BSDX34",30,0) ;v 1.3 BSDXBEG and BSDXEND are in fm format "RTN","BSDX34",31,0) ;Called by BSDX CANCEL CLINIC LIST "RTN","BSDX34",32,0) N BSDXCAN "RTN","BSDX34",33,0) S BSDXCAN=1 "RTN","BSDX34",34,0) D RBCLIN(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND) "RTN","BSDX34",35,0) ; "RTN","BSDX34",36,0) Q "RTN","BSDX34",37,0) ; "RTN","BSDX34",38,0) RBCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP "RTN","BSDX34",39,0) ; "RTN","BSDX34",40,0) ;Return recordset of rebooked patient appointments "RTN","BSDX34",41,0) ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST. "RTN","BSDX34",42,0) ;Used in generating rebook letters for a clinic "RTN","BSDX34",43,0) ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.) "RTN","BSDX34",44,0) ;Called by BSDX REBOOK CLINIC LIST and BSDX CANCEL CLINIC LIST via entry point CANCLIN above "RTN","BSDX34",45,0) ;Jul 11 2010 (smh): "RTN","BSDX34",46,0) ;for i18n, pass BSDXBEG and BSDXEND in FM format. "RTN","BSDX34",47,0) ; "RTN","BSDX34",48,0) S X="RBERR^BSDX34",@^%ZOSF("TRAP") "RTN","BSDX34",49,0) ; "RTN","BSDX34",50,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX34",51,0) N %DT,Y,BSDXJ,BSDXCID,BSDXCLN,BSDXSTRT,BSDXAID,BSDXNOD,BSDXLIST,BSDX,BSDY "RTN","BSDX34",52,0) ;Convert beginning and ending dates "RTN","BSDX34",53,0) ;TODO: Validation of date to make sure it's a right FM Date "RTN","BSDX34",54,0) S BSDXBEG=$P(BSDXBEG,".") "RTN","BSDX34",55,0) S BSDXEND=$P(BSDXEND,".") "RTN","BSDX34",56,0) S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999" "RTN","BSDX34",57,0) S BSDXEND=BSDXEND_".9999" "RTN","BSDX34",58,0) ; "RTN","BSDX34",59,0) I BSDXCLST="" D RBERR Q "RTN","BSDX34",60,0) ; "RTN","BSDX34",61,0) ; "RTN","BSDX34",62,0) ;If BSDXCLST is a list of resource NAMES, look up each name and convert to IEN "RTN","BSDX34",63,0) F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDX=$P(BSDXCLST,"|",BSDXJ) D S $P(BSDXCLST,"|",BSDXJ)=BSDY "RTN","BSDX34",64,0) . S BSDY="" "RTN","BSDX34",65,0) . I BSDX]"",$D(^BSDXRES(BSDX,0)) S BSDY=BSDX Q "RTN","BSDX34",66,0) . I BSDX]"",$D(^BSDXRES("B",BSDX)) S BSDY=$O(^BSDXRES("B",BSDX,0)) Q "RTN","BSDX34",67,0) . Q "RTN","BSDX34",68,0) ; "RTN","BSDX34",69,0) ;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN) "RTN","BSDX34",70,0) ; "RTN","BSDX34",71,0) S BSDXLIST="" "RTN","BSDX34",72,0) F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D:+BSDXCID "RTN","BSDX34",73,0) . S BSDXCLN=$G(^BSDXRES(BSDXCID,0)) S BSDXCLN=$P(BSDXCLN,U) Q:BSDXCLN="" "RTN","BSDX34",74,0) . S BSDXSTRT=BSDXBEG F S BSDXSTRT=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT)) Q:'+BSDXSTRT Q:BSDXSTRT>BSDXEND D "RTN","BSDX34",75,0) . . S BSDXAID=0 F S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID D "RTN","BSDX34",76,0) . . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0)) "RTN","BSDX34",77,0) . . . I $D(BSDXCAN) D Q "RTN","BSDX34",78,0) . . . . I $P(BSDXNOD,U,12) S BSDXLIST=BSDXLIST_BSDXAID_"|" ;Cancelled appt "RTN","BSDX34",79,0) . . . I $P(BSDXNOD,U,11) S BSDXLIST=BSDXLIST_BSDXAID_"|" ;Rebooked appt "RTN","BSDX34",80,0) D RBLETT(.BSDXY,BSDXLIST) "RTN","BSDX34",81,0) Q "RTN","BSDX34",82,0) ; "RTN","BSDX34",83,0) RBLETTD(BSDXY,BSDXLIST) ;EP "RTN","BSDX34",84,0) ;Entry point for debugging "RTN","BSDX34",85,0) ; "RTN","BSDX34",86,0) ;D DEBUG^%Serenji("RBLETT^BSDX34(.BSDXY,BSDXLIST)") "RTN","BSDX34",87,0) Q "RTN","BSDX34",88,0) ; "RTN","BSDX34",89,0) RBLETT(BSDXY,BSDXLIST) ;EP "RTN","BSDX34",90,0) ;Return recordset of patient appointments used in listing "RTN","BSDX34",91,0) ;REBOOKED appointments for a list of appointmentIDs. "RTN","BSDX34",92,0) ;Called by rpc BSDX REBOOK LIST "RTN","BSDX34",93,0) ;BSDXLIST is a |-delimited list of BSDX APPOINTMENT iens (the last |-piece is null) "RTN","BSDX34",94,0) ; "RTN","BSDX34",95,0) N BSDXI,BSDXIEN,BSDXNOD,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ,BSDX "RTN","BSDX34",96,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX34",97,0) S BSDXI=0 "RTN","BSDX34",98,0) S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus" "RTN","BSDX34",99,0) S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30) "RTN","BSDX34",100,0) S X="ERROR^BSDX34",@^%ZOSF("TRAP") "RTN","BSDX34",101,0) ; "RTN","BSDX34",102,0) ;Iterate through BSDXLIST "RTN","BSDX34",103,0) S BSDXIEN=0 "RTN","BSDX34",104,0) F BSDX=1:1:$L(BSDXLIST,"|")-1 S BSDXIEN=$P(BSDXLIST,"|",BSDX) D "RTN","BSDX34",105,0) . N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN,BSDXPAT "RTN","BSDX34",106,0) . N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON "RTN","BSDX34",107,0) . N BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX "RTN","BSDX34",108,0) . N BSDXREBK "RTN","BSDX34",109,0) . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0)) "RTN","BSDX34",110,0) . Q:BSDXNOD="" "RTN","BSDX34",111,0) . S BSDXPAT=$P(BSDXNOD,U,5) ;PATIENT ien "RTN","BSDX34",112,0) . Q:'+BSDXPAT "RTN","BSDX34",113,0) . Q:'$D(^DPT(BSDXPAT)) "RTN","BSDX34",114,0) . D PINFO(BSDXPAT) "RTN","BSDX34",115,0) . S Y=$P(BSDXNOD,U) "RTN","BSDX34",116,0) . Q:'+Y "RTN","BSDX34",117,0) . X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX34",118,0) . S BSDXAPT=Y ;Appointment date time "RTN","BSDX34",119,0) . S BSDXREBK="" "RTN","BSDX34",120,0) . S Y=$P(BSDXNOD,U,11) "RTN","BSDX34",121,0) . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") S BSDXREBK=Y ;Rebook date time "RTN","BSDX34",122,0) . S BSDXCLRK=$P(BSDXNOD,U,8) ;Appointment made by "RTN","BSDX34",123,0) . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U) "RTN","BSDX34",124,0) . S Y=$P(BSDXNOD,U,9) ;Date Appointment Made "RTN","BSDX34",125,0) . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") "RTN","BSDX34",126,0) . S BSDXMADE=Y "RTN","BSDX34",127,0) . ;NOTE "RTN","BSDX34",128,0) . S BSDXNOT="" "RTN","BSDX34",129,0) . I $D(^BSDXAPPT(BSDXIEN,1,0)) S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXIEN,1,BSDXQ)) Q:'+BSDXQ D "RTN","BSDX34",130,0) . . S BSDXLIN=$G(^BSDXAPPT(BSDXIEN,1,BSDXQ,0)) "RTN","BSDX34",131,0) . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" " "RTN","BSDX34",132,0) . . S BSDXNOT=BSDXNOT_BSDXLIN "RTN","BSDX34",133,0) . ;Resource "RTN","BSDX34",134,0) . S BSDXCID=$P(BSDXNOD,U,7) ;IEN of BSDX RESOURCE "RTN","BSDX34",135,0) . Q:'+BSDXCID "RTN","BSDX34",136,0) . Q:'$D(^BSDXRES(BSDXCID,0)) "RTN","BSDX34",137,0) . S BSDXCNOD=$G(^BSDXRES(BSDXCID,0)) ;BSDX RESOURCE node "RTN","BSDX34",138,0) . Q:BSDXCNOD="" "RTN","BSDX34",139,0) . S BSDXCLN=$P(BSDXCNOD,U) ;Text name of BSDX Resource "RTN","BSDX34",140,0) . S BSDXTYPE="" ;Unused in this recordset "RTN","BSDX34",141,0) . S BSDXI=BSDXI+1 "RTN","BSDX34",142,0) . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXREBK_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_"^"_BSDXAPT_$C(30) "RTN","BSDX34",143,0) . Q "RTN","BSDX34",144,0) ; "RTN","BSDX34",145,0) S BSDXI=BSDXI+1 "RTN","BSDX34",146,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX34",147,0) Q "RTN","BSDX34",148,0) ; "RTN","BSDX34",149,0) PINFO(BSDXPAT) ; "RTN","BSDX34",150,0) ;Get patient info "RTN","BSDX34",151,0) N BSDXNOD "RTN","BSDX34",152,0) S BSDXNOD=$$PATINFO^BSDX27(BSDXPAT) "RTN","BSDX34",153,0) S BSDXNAM=$P(BSDXNOD,U) ;NAME "RTN","BSDX34",154,0) S BSDXSEX=$P(BSDXNOD,U,2) ;SEX "RTN","BSDX34",155,0) S BSDXDOB=$P(BSDXNOD,U,3) ;DOB "RTN","BSDX34",156,0) S BSDXHRN=$P(BSDXNOD,U,4) ;Health Record Number for location DUZ(2) "RTN","BSDX34",157,0) S BSDXSTRE=$P(BSDXNOD,U,5) ;Street "RTN","BSDX34",158,0) S BSDXCITY=$P(BSDXNOD,U,6) ;City "RTN","BSDX34",159,0) S BSDXST=$P(BSDXNOD,U,7) ;State "RTN","BSDX34",160,0) S BSDXZIP=$P(BSDXNOD,U,8) ;zip "RTN","BSDX34",161,0) S BSDXPHON=$P(BSDXNOD,U,9) ;homephone "RTN","BSDX34",162,0) Q "RTN","BSDX34",163,0) ; "RTN","BSDX34",164,0) ERROR ; "RTN","BSDX34",165,0) D ERR("RPMS Error") "RTN","BSDX34",166,0) Q "RTN","BSDX34",167,0) ; "RTN","BSDX34",168,0) ERR(ERRNO) ;Error processing "RTN","BSDX34",169,0) S:'$D(BSDXI) BSDXI=999 "RTN","BSDX34",170,0) I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError "RTN","BSDX34",171,0) E S BSDXERR=ERRNO "RTN","BSDX34",172,0) S BSDXI=BSDXI+1 "RTN","BSDX34",173,0) S ^BSDXTMP($J,BSDXI)="^^^^^^^^^^^^^^^^"_$C(30) "RTN","BSDX34",174,0) S BSDXI=BSDXI+1 "RTN","BSDX34",175,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX34",176,0) Q "RTN","BSDX35") 0^33^B8147998 "RTN","BSDX35",1,0) BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; "RTN","BSDX35",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDX35",3,0) ; "RTN","BSDX35",4,0) ; "RTN","BSDX35",5,0) Q "RTN","BSDX35",6,0) ; "RTN","BSDX35",7,0) RSRCLTRD(BSDXY,BSDXLIST) ;EP "RTN","BSDX35",8,0) ;Entry point for debugging "RTN","BSDX35",9,0) ; "RTN","BSDX35",10,0) ;D DEBUG^%Serenji("RSRCLTR^BSDX35(.BSDXY,BSDXLIST)") "RTN","BSDX35",11,0) Q "RTN","BSDX35",12,0) ; "RTN","BSDX35",13,0) RSRCLTR(BSDXY,BSDXLIST) ;EP "RTN","BSDX35",14,0) ; "RTN","BSDX35",15,0) ;Return recordset of RESOURCES and associated LETTERS "RTN","BSDX35",16,0) ;Used in generating rebook letters for a clinic "RTN","BSDX35",17,0) ;BSDXLIST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.) "RTN","BSDX35",18,0) ;Called by BSDX RESOURCE LETTERS "RTN","BSDX35",19,0) ; "RTN","BSDX35",20,0) ; "RTN","BSDX35",21,0) S X="ERROR^BSDX35",@^%ZOSF("TRAP") "RTN","BSDX35",22,0) S BSDXY="^BSDXTMP("_$J_")" "RTN","BSDX35",23,0) N BSDXIEN,BSDX,BSDXLTR,BSDXNOS,BSDXCAN,BSDXIEN1 "RTN","BSDX35",24,0) S BSDXI=0 "RTN","BSDX35",25,0) S ^BSDXTMP($J,BSDXI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00030LETTER_TEXT^T00030NO_SHOW_LETTER^T00030CLINIC_CANCELLATION_LETTER"_$C(30) "RTN","BSDX35",26,0) ; "RTN","BSDX35",27,0) ; "RTN","BSDX35",28,0) ;If BSDXLIST is a list of resource NAMES, look up each name and convert to IEN "RTN","BSDX35",29,0) F BSDXJ=1:1:$L(BSDXLIST,"|")-1 S BSDX=$P(BSDXLIST,"|",BSDXJ) D S $P(BSDXLIST,"|",BSDXJ)=BSDY "RTN","BSDX35",30,0) . S BSDY="" "RTN","BSDX35",31,0) . I BSDX]"",$D(^BSDXRES(BSDX,0)) S BSDY=BSDX Q "RTN","BSDX35",32,0) . I BSDX]"",$D(^BSDXRES("B",BSDX)) S BSDY=$O(^BSDXRES("B",BSDX,0)) Q "RTN","BSDX35",33,0) . Q "RTN","BSDX35",34,0) ; "RTN","BSDX35",35,0) ;Get letter text from wp fields "RTN","BSDX35",36,0) S BSDXIEN=0 "RTN","BSDX35",37,0) F BSDX=1:1:$L(BSDXLIST,"|")-1 S BSDXIEN=$P(BSDXLIST,"|",BSDX) D "RTN","BSDX35",38,0) . Q:'$D(^BSDXRES(BSDXIEN)) "RTN","BSDX35",39,0) . S BSDXNAM=$P(^BSDXRES(BSDXIEN,0),U) "RTN","BSDX35",40,0) . S BSDXLTR="" "RTN","BSDX35",41,0) . I $D(^BSDXRES(BSDXIEN,1)) D "RTN","BSDX35",42,0) . . S BSDXIEN1=0 F S BSDXIEN1=$O(^BSDXRES(BSDXIEN,1,BSDXIEN1)) Q:'+BSDXIEN1 D "RTN","BSDX35",43,0) . . . S BSDXLTR=BSDXLTR_$G(^BSDXRES(BSDXIEN,1,BSDXIEN1,0)) "RTN","BSDX35",44,0) . . . S BSDXLTR=BSDXLTR_$C(13)_$C(10) "RTN","BSDX35",45,0) . S BSDXNOS="" "RTN","BSDX35",46,0) . I $D(^BSDXRES(BSDXIEN,12)) D "RTN","BSDX35",47,0) . . S BSDXIEN1=0 F S BSDXIEN1=$O(^BSDXRES(BSDXIEN,12,BSDXIEN1)) Q:'+BSDXIEN1 D "RTN","BSDX35",48,0) . . . S BSDXNOS=BSDXNOS_$G(^BSDXRES(BSDXIEN,12,BSDXIEN1,0)) "RTN","BSDX35",49,0) . . . S BSDXNOS=BSDXNOS_$C(13)_$C(10) "RTN","BSDX35",50,0) . S BSDXCAN="" "RTN","BSDX35",51,0) . I $D(^BSDXRES(BSDXIEN,13)) D "RTN","BSDX35",52,0) . . S BSDXIEN1=0 F S BSDXIEN1=$O(^BSDXRES(BSDXIEN,13,BSDXIEN1)) Q:'+BSDXIEN1 D "RTN","BSDX35",53,0) . . . S BSDXCAN=BSDXCAN_$G(^BSDXRES(BSDXIEN,13,BSDXIEN1,0)) "RTN","BSDX35",54,0) . . . S BSDXCAN=BSDXCAN_$C(13)_$C(10) "RTN","BSDX35",55,0) . S BSDXI=BSDXI+1 "RTN","BSDX35",56,0) . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_$C(30) "RTN","BSDX35",57,0) ; "RTN","BSDX35",58,0) S BSDXI=BSDXI+1 "RTN","BSDX35",59,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX35",60,0) Q "RTN","BSDX35",61,0) ; "RTN","BSDX35",62,0) ERROR ; "RTN","BSDX35",63,0) D ERR("RPMS Error") "RTN","BSDX35",64,0) Q "RTN","BSDX35",65,0) ; "RTN","BSDX35",66,0) ERR(ERRNO) ;Error processing "RTN","BSDX35",67,0) S:'$D(BSDXI) BSDXI=999 "RTN","BSDX35",68,0) I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError "RTN","BSDX35",69,0) E S BSDXERR=ERRNO "RTN","BSDX35",70,0) S BSDXI=BSDXI+1 "RTN","BSDX35",71,0) S ^BSDXTMP($J,BSDXI)="^^^^"_$C(30) "RTN","BSDX35",72,0) S BSDXI=BSDXI+1 "RTN","BSDX35",73,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDX35",74,0) Q "RTN","BSDXAPI") 0^35^B85422550 "RTN","BSDXAPI",1,0) BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 9/28/10 12:36pm "RTN","BSDXAPI",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDXAPI",3,0) ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW "RTN","BSDXAPI",4,0) ;local mods (many) by WV/SMH "RTN","BSDXAPI",5,0) ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH "RTN","BSDXAPI",6,0) ; Change History: "RTN","BSDXAPI",7,0) ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment. "RTN","BSDXAPI",8,0) ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API. "RTN","BSDXAPI",9,0) ; "RTN","BSDXAPI",10,0) MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment "RTN","BSDXAPI",11,0) ; Call like this for DFN 23435 having an appointment at Hospital Location 33 "RTN","BSDXAPI",12,0) ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt "RTN","BSDXAPI",13,0) ; for Baby foxes hallucinations. "RTN","BSDXAPI",14,0) ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes") "RTN","BSDXAPI",15,0) S BSDR("PAT")=DFN ;DFN "RTN","BSDXAPI",16,0) S BSDR("CLN")=CLIN ;Hosp Loc IEN "RTN","BSDXAPI",17,0) S BSDR("TYP")=TYP ;3 sched or 4 walkin "RTN","BSDXAPI",18,0) S BSDR("ADT")=DATE ;Appointment date in FM format "RTN","BSDXAPI",19,0) S BSDR("LEN")=LEN ;Appt len upto 240 (min) "RTN","BSDXAPI",20,0) S BSDR("INFO")=INFO ;Reason for appt - up to 150 char "RTN","BSDXAPI",21,0) S BSDR("USR")=DUZ ;Person who made appt - current user "RTN","BSDXAPI",22,0) Q $$MAKE(.BSDR) "RTN","BSDXAPI",23,0) ; "RTN","BSDXAPI",24,0) MAKE(BSDR) ;PEP; call to store appt made "RTN","BSDXAPI",25,0) ; "RTN","BSDXAPI",26,0) ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY) "RTN","BSDXAPI",27,0) ; "RTN","BSDXAPI",28,0) ; Input Array - "RTN","BSDXAPI",29,0) ; BSDR("PAT") = ien of patient in file 2 "RTN","BSDXAPI",30,0) ; BSDR("CLN") = ien of clinic in file 44 "RTN","BSDXAPI",31,0) ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins "RTN","BSDXAPI",32,0) ; BSDR("ADT") = appointment date and time "RTN","BSDXAPI",33,0) ; BSDR("LEN") = appointment length in minutes (5-120) "RTN","BSDXAPI",34,0) ; BSDR("OI") = reason for appt - up to 150 characters "RTN","BSDXAPI",35,0) ; BSDR("USR") = user who made appt "RTN","BSDXAPI",36,0) ; "RTN","BSDXAPI",37,0) ;Output: error status and message "RTN","BSDXAPI",38,0) ; = 0 or null: everything okay "RTN","BSDXAPI",39,0) ; = 1^message: error and reason "RTN","BSDXAPI",40,0) ; "RTN","BSDXAPI",41,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","BSDXAPI",42,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","BSDXAPI",43,0) I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP")) "RTN","BSDXAPI",44,0) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds "RTN","BSDXAPI",45,0) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) "RTN","BSDXAPI",46,0) ; "RTN","BSDXAPI",47,0) I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) "RTN","BSDXAPI",48,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) "RTN","BSDXAPI",49,0) I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT") "RTN","BSDXAPI",50,0) ; "RTN","BSDXAPI",51,0) NEW DIC,DA,Y,X,DD,DO,DLAYGO "RTN","BSDXAPI",52,0) ; "RTN","BSDXAPI",53,0) I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D "RTN","BSDXAPI",54,0) . ; "un-cancel" existing appt in file 2 "RTN","BSDXAPI",55,0) . N BSDXFDA,BSDXIENS,BSDXMSG "RTN","BSDXAPI",56,0) . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," "RTN","BSDXAPI",57,0) . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN") "RTN","BSDXAPI",58,0) . S BSDXFDA(2.98,BSDXIENS,"3")="" "RTN","BSDXAPI",59,0) . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") "RTN","BSDXAPI",60,0) . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 "RTN","BSDXAPI",61,0) . S BSDXFDA(2.98,BSDXIENS,"14")="" "RTN","BSDXAPI",62,0) . S BSDXFDA(2.98,BSDXIENS,"15")="" "RTN","BSDXAPI",63,0) . S BSDXFDA(2.98,BSDXIENS,"16")="" "RTN","BSDXAPI",64,0) . S BSDXFDA(2.98,BSDXIENS,"19")="" "RTN","BSDXAPI",65,0) . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT "RTN","BSDXAPI",66,0) . D FILE^DIE("","BSDXFDA","BSDXMSG") "RTN","BSDXAPI",67,0) . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG) "RTN","BSDXAPI",68,0) E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") "RTN","BSDXAPI",69,0) . N BSDXFDA,BSDXIENS,BSDXMSG "RTN","BSDXAPI",70,0) . S BSDXIENS="?+2,"_BSDR("PAT")_"," "RTN","BSDXAPI",71,0) . S BSDXIENS(2)=BSDR("ADT") "RTN","BSDXAPI",72,0) . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN") "RTN","BSDXAPI",73,0) . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") "RTN","BSDXAPI",74,0) . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 "RTN","BSDXAPI",75,0) . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT "RTN","BSDXAPI",76,0) . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)") "RTN","BSDXAPI",77,0) ; add appt to file 44 "RTN","BSDXAPI",78,0) K DIC,DA,X,Y,DLAYGO,DD,DO "RTN","BSDXAPI",79,0) I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^" "RTN","BSDXAPI",80,0) I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT") "RTN","BSDXAPI",81,0) . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT") "RTN","BSDXAPI",82,0) . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 "RTN","BSDXAPI",83,0) . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN "RTN","BSDXAPI",84,0) ; "RTN","BSDXAPI",85,0) ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh "RTN","BSDXAPI",86,0) ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM "RTN","BSDXAPI",87,0) ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," "RTN","BSDXAPI",88,0) ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT") "RTN","BSDXAPI",89,0) ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".") "RTN","BSDXAPI",90,0) ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003 "RTN","BSDXAPI",91,0) ;D FILE^DICN "RTN","BSDXAPI",92,0) ; "RTN","BSDXAPI",93,0) N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_"," "RTN","BSDXAPI",94,0) N BSDXFDA "RTN","BSDXAPI",95,0) S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT") "RTN","BSDXAPI",96,0) S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN") "RTN","BSDXAPI",97,0) S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150) "RTN","BSDXAPI",98,0) S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR") "RTN","BSDXAPI",99,0) S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".") "RTN","BSDXAPI",100,0) N BSDXERR "RTN","BSDXAPI",101,0) D UPDATE^DIE("","BSDXFDA","","BSDXERR") "RTN","BSDXAPI",102,0) ; "RTN","BSDXAPI",103,0) I $D(BSDXERR) Q 1_U_"Error adding appt to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")_" Patient="_BSDR("PAT")_" Error: "_BSDXERR("DIERR",1,"TEXT",1) "RTN","BSDXAPI",104,0) ; "RTN","BSDXAPI",105,0) ; call event driver "RTN","BSDXAPI",106,0) NEW DFN,SDT,SDCL,SDDA,SDMODE "RTN","BSDXAPI",107,0) S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2 "RTN","BSDXAPI",108,0) S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) "RTN","BSDXAPI",109,0) D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE) "RTN","BSDXAPI",110,0) Q 0 "RTN","BSDXAPI",111,0) ; "RTN","BSDXAPI",112,0) CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in "RTN","BSDXAPI",113,0) ; Call like this for DFN 23435 checking in now at Hospital Location 33 "RTN","BSDXAPI",114,0) ; for appt at Dec 20, 2009 @ 10:11:59 "RTN","BSDXAPI",115,0) ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159) "RTN","BSDXAPI",116,0) S BSDR("PAT")=DFN ;DFN "RTN","BSDXAPI",117,0) S BSDR("CLN")=CLIN ;Hosp Loc IEN "RTN","BSDXAPI",118,0) S BSDR("ADT")=APDATE ;Appt Date "RTN","BSDXAPI",119,0) S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now "RTN","BSDXAPI",120,0) S BSDR("USR")=DUZ ;Check-in user defaults to current "RTN","BSDXAPI",121,0) Q $$CHECKIN(.BSDR) "RTN","BSDXAPI",122,0) ; "RTN","BSDXAPI",123,0) CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002 "RTN","BSDXAPI",124,0) ; "RTN","BSDXAPI",125,0) ; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY) "RTN","BSDXAPI",126,0) ; "RTN","BSDXAPI",127,0) ; Input array - "RTN","BSDXAPI",128,0) ; BSDR("PAT") = ien of patient in file 2 "RTN","BSDXAPI",129,0) ; BSDR("CLN") = ien of clinic in file 44 "RTN","BSDXAPI",130,0) ; BSDR("ADT") = appt date/time "RTN","BSDXAPI",131,0) ; BSDR("CDT") = checkin date/time "RTN","BSDXAPI",132,0) ; BSDR("USR") = checkin user "RTN","BSDXAPI",133,0) ; "RTN","BSDXAPI",134,0) ; Output value - "RTN","BSDXAPI",135,0) ; = 0 means everything worked "RTN","BSDXAPI",136,0) ; = 1^message means error with reason message "RTN","BSDXAPI",137,0) ; "RTN","BSDXAPI",138,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","BSDXAPI",139,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","BSDXAPI",140,0) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds "RTN","BSDXAPI",141,0) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) "RTN","BSDXAPI",142,0) I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds "RTN","BSDXAPI",143,0) I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT")) "RTN","BSDXAPI",144,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) "RTN","BSDXAPI",145,0) ; "RTN","BSDXAPI",146,0) ; find ien for appt in file 44 "RTN","BSDXAPI",147,0) NEW IEN,DIE,DA,DR "RTN","BSDXAPI",148,0) S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) "RTN","BSDXAPI",149,0) I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") "RTN","BSDXAPI",150,0) ; "RTN","BSDXAPI",151,0) ; remember before status "RTN","BSDXAPI",152,0) NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL "RTN","BSDXAPI",153,0) S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN "RTN","BSDXAPI",154,0) S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL "RTN","BSDXAPI",155,0) D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) "RTN","BSDXAPI",156,0) ; "RTN","BSDXAPI",157,0) ; set checkin "RTN","BSDXAPI",158,0) S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," "RTN","BSDXAPI",159,0) S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN "RTN","BSDXAPI",160,0) S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT "RTN","BSDXAPI",161,0) D ^DIE "RTN","BSDXAPI",162,0) ; "RTN","BSDXAPI",163,0) ; set after status "RTN","BSDXAPI",164,0) S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) "RTN","BSDXAPI",165,0) S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL "RTN","BSDXAPI",166,0) D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) "RTN","BSDXAPI",167,0) ; "RTN","BSDXAPI",168,0) ; call event driver "RTN","BSDXAPI",169,0) D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) "RTN","BSDXAPI",170,0) Q 0 "RTN","BSDXAPI",171,0) ; "RTN","BSDXAPI",172,0) CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment "RTN","BSDXAPI",173,0) ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33, "RTN","BSDXAPI",174,0) ; cancellation initiated by patient ("PC" rather than clinic "C"), "RTN","BSDXAPI",175,0) ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather) "RTN","BSDXAPI",176,0) ; because foxes come out during bad weather. "RTN","BSDXAPI",177,0) ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes") "RTN","BSDXAPI",178,0) S BSDR("PAT")=DFN "RTN","BSDXAPI",179,0) S BSDR("CLN")=CLIN "RTN","BSDXAPI",180,0) S BSDR("TYP")=TYP "RTN","BSDXAPI",181,0) S BSDR("ADT")=APDATE "RTN","BSDXAPI",182,0) S BSDR("CDT")=$$NOW^XLFDT "RTN","BSDXAPI",183,0) S BSDR("USR")=DUZ "RTN","BSDXAPI",184,0) S BSDR("CR")=REASON "RTN","BSDXAPI",185,0) S BSDR("NOT")=INFO "RTN","BSDXAPI",186,0) Q $$CANCEL(.BSDR) "RTN","BSDXAPI",187,0) ; "RTN","BSDXAPI",188,0) CANCEL(BSDR) ;PEP; called to cancel appt "RTN","BSDXAPI",189,0) ; "RTN","BSDXAPI",190,0) ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY) "RTN","BSDXAPI",191,0) ; "RTN","BSDXAPI",192,0) ; Input Array - "RTN","BSDXAPI",193,0) ; BSDR("PAT") = ien of patient in file 2 "RTN","BSDXAPI",194,0) ; BSDR("CLN") = ien of clinic in file 44 "RTN","BSDXAPI",195,0) ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled "RTN","BSDXAPI",196,0) ; BSDR("ADT") = appointment date and time "RTN","BSDXAPI",197,0) ; BSDR("CDT") = cancel date and time "RTN","BSDXAPI",198,0) ; BSDR("USR") = user who canceled appt "RTN","BSDXAPI",199,0) ; BSDR("CR") = cancel reason - pointer to file 409.2 "RTN","BSDXAPI",200,0) ; BSDR("NOT") = cancel remarks - optional notes to 160 characters "RTN","BSDXAPI",201,0) ; "RTN","BSDXAPI",202,0) ;Output: error status and message "RTN","BSDXAPI",203,0) ; = 0 or null: everything okay "RTN","BSDXAPI",204,0) ; = 1^message: error and reason "RTN","BSDXAPI",205,0) ; "RTN","BSDXAPI",206,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","BSDXAPI",207,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","BSDXAPI",208,0) I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP")) "RTN","BSDXAPI",209,0) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds "RTN","BSDXAPI",210,0) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) "RTN","BSDXAPI",211,0) I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds "RTN","BSDXAPI",212,0) I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT")) "RTN","BSDXAPI",213,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) "RTN","BSDXAPI",214,0) I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) "RTN","BSDXAPI",215,0) ; "RTN","BSDXAPI",216,0) NEW IEN,DIE,DA,DR "RTN","BSDXAPI",217,0) S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) "RTN","BSDXAPI",218,0) I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") "RTN","BSDXAPI",219,0) ; "RTN","BSDXAPI",220,0) I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") "RTN","BSDXAPI",221,0) ; "RTN","BSDXAPI",222,0) ; remember before status "RTN","BSDXAPI",223,0) NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL "RTN","BSDXAPI",224,0) S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN "RTN","BSDXAPI",225,0) S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL "RTN","BSDXAPI",226,0) D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) "RTN","BSDXAPI",227,0) ; "RTN","BSDXAPI",228,0) ; get user who made appt and date appt made from ^SC "RTN","BSDXAPI",229,0) ; because data in ^SC will be deleted "RTN","BSDXAPI",230,0) NEW USER,DATE "RTN","BSDXAPI",231,0) S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) "RTN","BSDXAPI",232,0) S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) "RTN","BSDXAPI",233,0) ; "RTN","BSDXAPI",234,0) ; update file 2 info "RTN","BSDXAPI",235,0) NEW DIE,DA,DR "RTN","BSDXAPI",236,0) S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT "RTN","BSDXAPI",237,0) S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE "RTN","BSDXAPI",238,0) S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160) "RTN","BSDXAPI",239,0) D ^DIE "RTN","BSDXAPI",240,0) ; "RTN","BSDXAPI",241,0) ; delete data in ^SC "RTN","BSDXAPI",242,0) NEW DIK,DA "RTN","BSDXAPI",243,0) S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," "RTN","BSDXAPI",244,0) S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN "RTN","BSDXAPI",245,0) D ^DIK "RTN","BSDXAPI",246,0) ; "RTN","BSDXAPI",247,0) ; call event driver "RTN","BSDXAPI",248,0) D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) "RTN","BSDXAPI",249,0) Q 0 "RTN","BSDXAPI",250,0) ; "RTN","BSDXAPI",251,0) CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in "RTN","BSDXAPI",252,0) NEW X "RTN","BSDXAPI",253,0) S X=$G(SDIEN) ;ien sent in call "RTN","BSDXAPI",254,0) I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 "RTN","BSDXAPI",255,0) S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U) "RTN","BSDXAPI",256,0) Q $S(X:1,1:0) "RTN","BSDXAPI",257,0) ; "RTN","BSDXAPI",258,0) SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC "RTN","BSDXAPI",259,0) NEW X,IEN "RTN","BSDXAPI",260,0) S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D "RTN","BSDXAPI",261,0) . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C" ;cancelled "RTN","BSDXAPI",262,0) . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X "RTN","BSDXAPI",263,0) Q $G(IEN) "RTN","BSDXAPI",264,0) ; "RTN","BSDXAPI",265,0) APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in) "RTN","BSDXAPI",266,0) NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7) "RTN","BSDXAPI",267,0) Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??") "RTN","BSDXAPI",268,0) ; "RTN","BSDXAPI",269,0) CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out "RTN","BSDXAPI",270,0) NEW X "RTN","BSDXAPI",271,0) S X=$G(SDIEN) ;ien sent in call "RTN","BSDXAPI",272,0) I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 "RTN","BSDXAPI",273,0) S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3) "RTN","BSDXAPI",274,0) Q $S(X:1,1:0) "RTN","BSDXAPI",275,0) ; "RTN","BSDXGPRV") 0^36^B6645474 "RTN","BSDXGPRV",1,0) BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 9/7/10 7:59am "RTN","BSDXGPRV",2,0) ;;1.41;BSDX;;Sep 29, 2010;Build 8 "RTN","BSDXGPRV",3,0) ; "RTN","BSDXGPRV",4,0) ; "RTN","BSDXGPRV",5,0) ERROR ; "RTN","BSDXGPRV",6,0) D ERR("RPMS Error") "RTN","BSDXGPRV",7,0) Q "RTN","BSDXGPRV",8,0) ; "RTN","BSDXGPRV",9,0) ERR(BSDXERR) ;Error processing "RTN","BSDXGPRV",10,0) D ^%ZTER "RTN","BSDXGPRV",11,0) S BSDXI=BSDXI+1 "RTN","BSDXGPRV",12,0) S ^BSDXTMP($J,BSDXI)=BSDXERR "RTN","BSDXGPRV",13,0) S BSDXI=BSDXI+1 "RTN","BSDXGPRV",14,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDXGPRV",15,0) Q "RTN","BSDXGPRV",16,0) ; "RTN","BSDXGPRV",17,0) PD(BSDXY,HLIEN) ;EP Debugging entry point "RTN","BSDXGPRV",18,0) ; "RTN","BSDXGPRV",19,0) D DEBUG^%Serenji("P^BSDXGPRV(.BSDXY,HLIEN)","192.168.254.130") "RTN","BSDXGPRV",20,0) ; "RTN","BSDXGPRV",21,0) Q "RTN","BSDXGPRV",22,0) ; "RTN","BSDXGPRV",23,0) P(BSDXY,HLIEN) ; Public Entry point; Get Providers for Hosp Location "RTN","BSDXGPRV",24,0) ; Input: HLIEN - Hospital Location IEN "RTN","BSDXGPRV",25,0) ; Output: ADO Datatable with columns: "RTN","BSDXGPRV",26,0) ; - HOSPITAL_LOCATION_ID, BMXIEN, PROV_NAME, DEFAULT "RTN","BSDXGPRV",27,0) ; If there are providers in the PROVIDER multiple of file 44 "RTN","BSDXGPRV",28,0) ; (Hospital Location) return them; "RTN","BSDXGPRV",29,0) ; If no providers in PROVIDER multiple of file 44, return nothing "RTN","BSDXGPRV",30,0) ; Called by BSDX HOSP LOC PROVIDERS "RTN","BSDXGPRV",31,0) ; "RTN","BSDXGPRV",32,0) S BSDXI=0 "RTN","BSDXGPRV",33,0) I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT "RTN","BSDXGPRV",34,0) D ^XBKVAR "RTN","BSDXGPRV",35,0) N $ET S $ET="G ERROR^BSDXGPRV" "RTN","BSDXGPRV",36,0) K ^BSDXTMP($J) "RTN","BSDXGPRV",37,0) S BSDXY=$NA(^BSDXTMP($J)) "RTN","BSDXGPRV",38,0) S $P(^BSDXTMP($J,BSDXI),U,1)="I00020HOSPITAL_LOCATION_ID" "RTN","BSDXGPRV",39,0) S $P(^BSDXTMP($J,BSDXI),U,2)="I00020BMXIEN" "RTN","BSDXGPRV",40,0) S $P(^BSDXTMP($J,BSDXI),U,3)="T00030NAME" "RTN","BSDXGPRV",41,0) S $P(^BSDXTMP($J,BSDXI),U,4)="T00005DEFAULT" "RTN","BSDXGPRV",42,0) S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30) "RTN","BSDXGPRV",43,0) ; "RTN","BSDXGPRV",44,0) N OUTPUT "RTN","BSDXGPRV",45,0) D GETS^DIQ(44,HLIEN_",","2600*","IE","OUTPUT") ; Provider Multiple "RTN","BSDXGPRV",46,0) ; No results "RTN","BSDXGPRV",47,0) I '$D(OUTPUT) S ^BSDXTMP($J,BSDXI+1)=$C(31) QUIT "RTN","BSDXGPRV",48,0) ; if results, get them "RTN","BSDXGPRV",49,0) N I S I="" "RTN","BSDXGPRV",50,0) F S I=$O(OUTPUT(44.1,I)) Q:I="" D "RTN","BSDXGPRV",51,0) . S BSDXI=BSDXI+1 "RTN","BSDXGPRV",52,0) . S $P(^BSDXTMP($J,BSDXI),U,1)=HLIEN ; HL IEN "RTN","BSDXGPRV",53,0) . S $P(^BSDXTMP($J,BSDXI),U,2)=$P(OUTPUT(44.1,I,.01,"I"),",") ; PROV IEN "RTN","BSDXGPRV",54,0) . S $P(^BSDXTMP($J,BSDXI),U,3)=$E(OUTPUT(44.1,I,.01,"E"),1,30) ; PROV NAME "RTN","BSDXGPRV",55,0) . S $P(^BSDXTMP($J,BSDXI),U,4)=OUTPUT(44.1,I,.02,"E") ; Default - YES, NO "RTN","BSDXGPRV",56,0) . S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30) "RTN","BSDXGPRV",57,0) S BSDXI=BSDXI+1 "RTN","BSDXGPRV",58,0) S ^BSDXTMP($J,BSDXI)=$C(31) "RTN","BSDXGPRV",59,0) QUIT "SEC","^DIC",9002018.1,9002018.1,0,"AUDIT") @ "SEC","^DIC",9002018.1,9002018.1,0,"DD") @ "SEC","^DIC",9002018.1,9002018.1,0,"DEL") @ "SEC","^DIC",9002018.1,9002018.1,0,"LAYGO") @ "SEC","^DIC",9002018.1,9002018.1,0,"RD") @ "SEC","^DIC",9002018.1,9002018.1,0,"WR") @ "SEC","^DIC",9002018.15,9002018.15,0,"AUDIT") @ "SEC","^DIC",9002018.15,9002018.15,0,"DD") @ "SEC","^DIC",9002018.15,9002018.15,0,"DEL") @ "SEC","^DIC",9002018.15,9002018.15,0,"LAYGO") @ "SEC","^DIC",9002018.15,9002018.15,0,"RD") @ "SEC","^DIC",9002018.15,9002018.15,0,"WR") @ "SEC","^DIC",9002018.2,9002018.2,0,"AUDIT") @ "SEC","^DIC",9002018.2,9002018.2,0,"DD") @ "SEC","^DIC",9002018.2,9002018.2,0,"DEL") @ "SEC","^DIC",9002018.2,9002018.2,0,"LAYGO") @ "SEC","^DIC",9002018.2,9002018.2,0,"RD") @ "SEC","^DIC",9002018.2,9002018.2,0,"WR") @ "SEC","^DIC",9002018.3,9002018.3,0,"AUDIT") @ "SEC","^DIC",9002018.3,9002018.3,0,"DD") @ "SEC","^DIC",9002018.3,9002018.3,0,"DEL") @ "SEC","^DIC",9002018.3,9002018.3,0,"LAYGO") @ "SEC","^DIC",9002018.3,9002018.3,0,"RD") @ "SEC","^DIC",9002018.3,9002018.3,0,"WR") @ "SEC","^DIC",9002018.35,9002018.35,0,"AUDIT") @ "SEC","^DIC",9002018.35,9002018.35,0,"DD") @ "SEC","^DIC",9002018.35,9002018.35,0,"DEL") @ "SEC","^DIC",9002018.35,9002018.35,0,"LAYGO") @ "SEC","^DIC",9002018.35,9002018.35,0,"RD") @ "SEC","^DIC",9002018.35,9002018.35,0,"WR") @ "SEC","^DIC",9002018.38,9002018.38,0,"AUDIT") @ "SEC","^DIC",9002018.38,9002018.38,0,"DD") @ "SEC","^DIC",9002018.38,9002018.38,0,"DEL") @ "SEC","^DIC",9002018.38,9002018.38,0,"LAYGO") @ "SEC","^DIC",9002018.38,9002018.38,0,"RD") @ "SEC","^DIC",9002018.38,9002018.38,0,"WR") @ "SEC","^DIC",9002018.39,9002018.39,0,"AUDIT") @ "SEC","^DIC",9002018.39,9002018.39,0,"DD") @ "SEC","^DIC",9002018.39,9002018.39,0,"DEL") @ "SEC","^DIC",9002018.39,9002018.39,0,"LAYGO") @ "SEC","^DIC",9002018.39,9002018.39,0,"RD") @ "SEC","^DIC",9002018.39,9002018.39,0,"WR") @ "SEC","^DIC",9002018.4,9002018.4,0,"AUDIT") @ "SEC","^DIC",9002018.4,9002018.4,0,"DD") @ "SEC","^DIC",9002018.4,9002018.4,0,"DEL") @ "SEC","^DIC",9002018.4,9002018.4,0,"LAYGO") @ "SEC","^DIC",9002018.4,9002018.4,0,"RD") @ "SEC","^DIC",9002018.4,9002018.4,0,"WR") @ "SEC","^DIC",9002018.5,9002018.5,0,"AUDIT") @ "SEC","^DIC",9002018.5,9002018.5,0,"DD") @ "SEC","^DIC",9002018.5,9002018.5,0,"DEL") @ "SEC","^DIC",9002018.5,9002018.5,0,"LAYGO") @ "SEC","^DIC",9002018.5,9002018.5,0,"RD") @ "SEC","^DIC",9002018.5,9002018.5,0,"WR") @ "VER") 8.0^22.0 "^DD",9002018.1,9002018.1,0) FIELD^^2001^8 "^DD",9002018.1,9002018.1,0,"DT") 3040820 "^DD",9002018.1,9002018.1,0,"IX","ALOC",9002018.1,.04) "^DD",9002018.1,9002018.1,0,"IX","ASSOC",9002018.12001,.01) "^DD",9002018.1,9002018.1,0,"IX","B",9002018.1,.01) "^DD",9002018.1,9002018.1,0,"NM","BSDX RESOURCE") "^DD",9002018.1,9002018.1,0,"PT",9002018.15,.01) "^DD",9002018.1,9002018.1,0,"PT",9002018.21,.01) "^DD",9002018.1,9002018.1,0,"PT",9002018.3,.01) "^DD",9002018.1,9002018.1,0,"PT",9002018.4,.07) "^DD",9002018.1,9002018.1,0,"VRPK") BSDX "^DD",9002018.1,9002018.1,.01,0) NAME^RF^^0;1^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X "^DD",9002018.1,9002018.1,.01,1,0) ^.1 "^DD",9002018.1,9002018.1,.01,1,1,0) 9002018.1^B "^DD",9002018.1,9002018.1,.01,1,1,1) S ^BSDXRES("B",$E(X,1,30),DA)="" "^DD",9002018.1,9002018.1,.01,1,1,2) K ^BSDXRES("B",$E(X,1,30),DA) "^DD",9002018.1,9002018.1,.01,3) Answer must be 1-30 characters in length. "^DD",9002018.1,9002018.1,.01,"DT") 3040719 "^DD",9002018.1,9002018.1,.02,0) INACTIVE^S^1:YES;0:NO;^0;2^Q "^DD",9002018.1,9002018.1,.02,3) "^DD",9002018.1,9002018.1,.02,"DT") 3030520 "^DD",9002018.1,9002018.1,.03,0) TIME SCALE^S^5:5;10:10;15:15;20:20;30:30;60:60;^0;3^Q "^DD",9002018.1,9002018.1,.03,"DT") 3040212 "^DD",9002018.1,9002018.1,.04,0) HOSPITAL LOCATION^P44'^SC(^0;4^Q "^DD",9002018.1,9002018.1,.04,1,0) ^.1 "^DD",9002018.1,9002018.1,.04,1,1,0) 9002018.1^ALOC "^DD",9002018.1,9002018.1,.04,1,1,1) S ^BSDXRES("ALOC",$E(X,1,30),DA)="" "^DD",9002018.1,9002018.1,.04,1,1,2) K ^BSDXRES("ALOC",$E(X,1,30),DA) "^DD",9002018.1,9002018.1,.04,1,1,"%D",0) ^^1^1^3040915^ "^DD",9002018.1,9002018.1,.04,1,1,"%D",1,0) Cross reference on hospital location. "^DD",9002018.1,9002018.1,.04,1,1,"DT") 3040915 "^DD",9002018.1,9002018.1,.04,"DT") 3040915 "^DD",9002018.1,9002018.1,1,0) LETTER TEXT^9002018.11^^1;0 "^DD",9002018.1,9002018.1,1201,0) NO SHOW LETTER^9002018.11201^^12;0 "^DD",9002018.1,9002018.1,1301,0) CLINIC CANCELLATION LETTER^9002018.11301^^13;0 "^DD",9002018.1,9002018.1,2001,0) ASSOCIATED RPMS CLINICS^9002018.12001P^^20;0 "^DD",9002018.1,9002018.11,0) LETTER TEXT SUB-FIELD^^.01^1 "^DD",9002018.1,9002018.11,0,"DT") 3040212 "^DD",9002018.1,9002018.11,0,"NM","LETTER TEXT") "^DD",9002018.1,9002018.11,0,"UP") 9002018.1 "^DD",9002018.1,9002018.11,.01,0) LETTER TEXT^W^^0;1^Q "^DD",9002018.1,9002018.11,.01,3) Enter the text of reminder letters sent to patients with appointments with this resource. "^DD",9002018.1,9002018.11,.01,"DT") 3040212 "^DD",9002018.1,9002018.11201,0) NO SHOW LETTER SUB-FIELD^^.01^1 "^DD",9002018.1,9002018.11201,0,"DT") 3040613 "^DD",9002018.1,9002018.11201,0,"NM","NO SHOW LETTER") "^DD",9002018.1,9002018.11201,0,"UP") 9002018.1 "^DD",9002018.1,9002018.11201,.01,0) NO SHOW LETTER^W^^0;1^Q "^DD",9002018.1,9002018.11201,.01,"DT") 3040613 "^DD",9002018.1,9002018.11301,0) CLINIC CANCELLATION LETTER SUB-FIELD^^.01^1 "^DD",9002018.1,9002018.11301,0,"DT") 3040613 "^DD",9002018.1,9002018.11301,0,"NM","CLINIC CANCELLATION LETTER") "^DD",9002018.1,9002018.11301,0,"UP") 9002018.1 "^DD",9002018.1,9002018.11301,.01,0) CLINIC CANCELLATION LETTER^W^^0;1^Q "^DD",9002018.1,9002018.11301,.01,"DT") 3040613 "^DD",9002018.1,9002018.12001,0) ASSOCIATED RPMS CLINICS SUB-FIELD^^.01^1 "^DD",9002018.1,9002018.12001,0,"DT") 3040820 "^DD",9002018.1,9002018.12001,0,"IX","B",9002018.12001,.01) "^DD",9002018.1,9002018.12001,0,"NM","ASSOCIATED RPMS CLINICS") "^DD",9002018.1,9002018.12001,0,"UP") 9002018.1 "^DD",9002018.1,9002018.12001,.01,0) ASSOCIATED RPMS CLINICS^MP44'^SC(^0;1^Q "^DD",9002018.1,9002018.12001,.01,1,0) ^.1 "^DD",9002018.1,9002018.12001,.01,1,1,0) 9002018.12001^B "^DD",9002018.1,9002018.12001,.01,1,1,1) S ^BSDXRES(DA(1),20,"B",$E(X,1,30),DA)="" "^DD",9002018.1,9002018.12001,.01,1,1,2) K ^BSDXRES(DA(1),20,"B",$E(X,1,30),DA) "^DD",9002018.1,9002018.12001,.01,1,2,0) 9002018.1^ASSOC "^DD",9002018.1,9002018.12001,.01,1,2,1) S ^BSDXRES("ASSOC",$E(X,1,30),DA(1),DA)="" "^DD",9002018.1,9002018.12001,.01,1,2,2) K ^BSDXRES("ASSOC",$E(X,1,30),DA(1),DA) "^DD",9002018.1,9002018.12001,.01,1,2,"%D",0) ^^1^1^3040915^ "^DD",9002018.1,9002018.12001,.01,1,2,"%D",1,0) Cross reference on ASSOCIATED RPMS CLINICS "^DD",9002018.1,9002018.12001,.01,1,2,"DT") 3040915 "^DD",9002018.1,9002018.12001,.01,3) ENTER ASSOCIATED RPMS CLINIC "^DD",9002018.1,9002018.12001,.01,"DT") 3040915 "^DD",9002018.15,9002018.15,0) FIELD^^.05^5 "^DD",9002018.15,9002018.15,0,"DT") 3100928 "^DD",9002018.15,9002018.15,0,"IX","AC",9002018.15,.02) "^DD",9002018.15,9002018.15,0,"IX","B",9002018.15,.01) "^DD",9002018.15,9002018.15,0,"NM","BSDX RESOURCE USER") "^DD",9002018.15,9002018.15,0,"VRPK") BSDX "^DD",9002018.15,9002018.15,.01,0) RESOURCENAME^RP9002018.1'^BSDXRES(^0;1^Q "^DD",9002018.15,9002018.15,.01,1,0) ^.1 "^DD",9002018.15,9002018.15,.01,1,1,0) 9002018.15^B "^DD",9002018.15,9002018.15,.01,1,1,1) S ^BSDXRSU("B",$E(X,1,30),DA)="" "^DD",9002018.15,9002018.15,.01,1,1,2) K ^BSDXRSU("B",$E(X,1,30),DA) "^DD",9002018.15,9002018.15,.01,3) "^DD",9002018.15,9002018.15,.01,"DT") 3030508 "^DD",9002018.15,9002018.15,.02,0) USERNAME^P200'^VA(200,^0;2^Q "^DD",9002018.15,9002018.15,.02,1,0) ^.1 "^DD",9002018.15,9002018.15,.02,1,1,0) 9002018.15^AC "^DD",9002018.15,9002018.15,.02,1,1,1) S ^BSDXRSU("AC",$E(X,1,30),DA)="" "^DD",9002018.15,9002018.15,.02,1,1,2) K ^BSDXRSU("AC",$E(X,1,30),DA) "^DD",9002018.15,9002018.15,.02,1,1,"DT") 3030508 "^DD",9002018.15,9002018.15,.02,"DT") 3030508 "^DD",9002018.15,9002018.15,.03,0) OVERBOOK^S^1:YES;0:NO;^0;3^Q "^DD",9002018.15,9002018.15,.03,3) "^DD",9002018.15,9002018.15,.03,"DT") 3030703 "^DD",9002018.15,9002018.15,.04,0) MODIFY SCHEDULE^S^1:YES;0:NO;^0;4^Q "^DD",9002018.15,9002018.15,.04,"DT") 3030701 "^DD",9002018.15,9002018.15,.05,0) MODIFY APPOINTMENTS^S^1:YES;0:NO;^0;5^Q "^DD",9002018.15,9002018.15,.05,3) "^DD",9002018.15,9002018.15,.05,"DT") 3040722 "^DD",9002018.2,9002018.2,0) FIELD^^1^3 "^DD",9002018.2,9002018.2,0,"DDA") N "^DD",9002018.2,9002018.2,0,"DT") 3100928 "^DD",9002018.2,9002018.2,0,"IX","AB",9002018.21,.01) "^DD",9002018.2,9002018.2,0,"IX","B",9002018.2,.01) "^DD",9002018.2,9002018.2,0,"NM","BSDX RESOURCE GROUP") "^DD",9002018.2,9002018.2,0,"PT",9002018.25,.01) "^DD",9002018.2,9002018.2,0,"PT",9002018.35,.03) "^DD",9002018.2,9002018.2,0,"VRPK") BSDX "^DD",9002018.2,9002018.2,.01,0) NAME^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X "^DD",9002018.2,9002018.2,.01,1,0) ^.1 "^DD",9002018.2,9002018.2,.01,1,1,0) 9002018.2^B "^DD",9002018.2,9002018.2,.01,1,1,1) S ^BSDXDEPT("B",$E(X,1,30),DA)="" "^DD",9002018.2,9002018.2,.01,1,1,2) K ^BSDXDEPT("B",$E(X,1,30),DA) "^DD",9002018.2,9002018.2,.01,3) NAME MUST BE 3-30 CHARACTERS, NOT NUMERIC OR STARTING WITH PUNCTUATION "^DD",9002018.2,9002018.2,.02,0) INACTIVATION DATE^D^^0;2^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",9002018.2,9002018.2,.02,"DT") 3030508 "^DD",9002018.2,9002018.2,1,0) RESOURCE^9002018.21P^^1;0 "^DD",9002018.2,9002018.21,0) RESOURCE SUB-FIELD^^.01^1 "^DD",9002018.2,9002018.21,0,"DT") 3100928 "^DD",9002018.2,9002018.21,0,"IX","B",9002018.21,.01) "^DD",9002018.2,9002018.21,0,"NM","RESOURCE") "^DD",9002018.2,9002018.21,0,"UP") 9002018.2 "^DD",9002018.2,9002018.21,.01,0) RESOURCE^MP9002018.1'^BSDXRES(^0;1^Q "^DD",9002018.2,9002018.21,.01,1,0) ^.1 "^DD",9002018.2,9002018.21,.01,1,1,0) 9002018.21^B "^DD",9002018.2,9002018.21,.01,1,1,1) S ^BSDXDEPT(DA(1),1,"B",$E(X,1,30),DA)="" "^DD",9002018.2,9002018.21,.01,1,1,2) K ^BSDXDEPT(DA(1),1,"B",$E(X,1,30),DA) "^DD",9002018.2,9002018.21,.01,1,2,0) 9002018.2^AB "^DD",9002018.2,9002018.21,.01,1,2,1) S ^BSDXDEPT("AB",$E(X,1,30),DA(1),DA)="" "^DD",9002018.2,9002018.21,.01,1,2,2) K ^BSDXDEPT("AB",$E(X,1,30),DA(1),DA) "^DD",9002018.2,9002018.21,.01,1,2,"DT") 3030508 "^DD",9002018.2,9002018.21,.01,"DT") 3030508 "^DD",9002018.3,9002018.3,0) FIELD^^1^6 "^DD",9002018.3,9002018.3,0,"DT") 3030508 "^DD",9002018.3,9002018.3,0,"IX","ARSCT",9002018.3,.02) "^DD",9002018.3,9002018.3,0,"IX","B",9002018.3,.01) "^DD",9002018.3,9002018.3,0,"NM","BSDX ACCESS BLOCK") "^DD",9002018.3,9002018.3,0,"VRPK") BSDX "^DD",9002018.3,9002018.3,.01,0) RESOURCE^RP9002018.1'^BSDXRES(^0;1^Q "^DD",9002018.3,9002018.3,.01,1,0) ^.1 "^DD",9002018.3,9002018.3,.01,1,1,0) 9002018.3^B "^DD",9002018.3,9002018.3,.01,1,1,1) S ^BSDXAB("B",$E(X,1,30),DA)="" "^DD",9002018.3,9002018.3,.01,1,1,2) K ^BSDXAB("B",$E(X,1,30),DA) "^DD",9002018.3,9002018.3,.01,3) "^DD",9002018.3,9002018.3,.01,"DT") 3030508 "^DD",9002018.3,9002018.3,.02,0) STARTTIME^D^^0;2^S %DT="ET" D ^%DT S X=Y K:Y<1 X "^DD",9002018.3,9002018.3,.02,1,0) ^.1 "^DD",9002018.3,9002018.3,.02,1,1,0) 9002018.3^ARSCT^MUMPS "^DD",9002018.3,9002018.3,.02,1,1,1) D XR4S^BSDX03(DA) "^DD",9002018.3,9002018.3,.02,1,1,2) D XR4K^BSDX03(DA) "^DD",9002018.3,9002018.3,.02,1,1,"%D",0) ^^1^1^3030512^ "^DD",9002018.3,9002018.3,.02,1,1,"%D",1,0) Supports lookup of all access blocks for a given resource during a given time period "^DD",9002018.3,9002018.3,.02,1,1,"DT") 3030512 "^DD",9002018.3,9002018.3,.02,"DT") 3030512 "^DD",9002018.3,9002018.3,.03,0) ENDTIME^D^^0;3^S %DT="ET" D ^%DT S X=Y K:Y<1 X "^DD",9002018.3,9002018.3,.03,3) "^DD",9002018.3,9002018.3,.03,"DT") 3030508 "^DD",9002018.3,9002018.3,.04,0) SLOTS^NJ2,0^^0;4^K:+X'=X!(X>99)!(X<0)!(X?.E1"."1N.N) X "^DD",9002018.3,9002018.3,.04,3) Type a Number between 0 and 99, 0 Decimal Digits "^DD",9002018.3,9002018.3,.04,"DT") 3030508 "^DD",9002018.3,9002018.3,.05,0) ACCESS TYPE^P9002018.35'^BSDXTYPE(^0;5^Q "^DD",9002018.3,9002018.3,.05,"DT") 3030508 "^DD",9002018.3,9002018.3,1,0) NOTE^9002018.31^^1;0 "^DD",9002018.3,9002018.31,0) NOTE SUB-FIELD^^.01^1 "^DD",9002018.3,9002018.31,0,"DT") 3030508 "^DD",9002018.3,9002018.31,0,"NM","NOTE") "^DD",9002018.3,9002018.31,0,"UP") 9002018.3 "^DD",9002018.3,9002018.31,.01,0) NOTE^W^^0;1^Q "^DD",9002018.3,9002018.31,.01,"DT") 3030508 "^DD",9002018.35,9002018.35,0) FIELD^^.07^7 "^DD",9002018.35,9002018.35,0,"DT") 3030521 "^DD",9002018.35,9002018.35,0,"IX","B",9002018.35,.01) "^DD",9002018.35,9002018.35,0,"NM","BSDX ACCESS TYPE") "^DD",9002018.35,9002018.35,0,"PT",9002018.3,.05) "^DD",9002018.35,9002018.35,0,"PT",9002018.381,.01) "^DD",9002018.35,9002018.35,0,"PT",9002018.39,.02) "^DD",9002018.35,9002018.35,0,"PT",9002018.4,.06) "^DD",9002018.35,9002018.35,0,"VRPK") BSDX "^DD",9002018.35,9002018.35,.01,0) ACCESS TYPE NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X "^DD",9002018.35,9002018.35,.01,1,0) ^.1 "^DD",9002018.35,9002018.35,.01,1,1,0) 9002018.35^B "^DD",9002018.35,9002018.35,.01,1,1,1) S ^BSDXTYPE("B",$E(X,1,30),DA)="" "^DD",9002018.35,9002018.35,.01,1,1,2) K ^BSDXTYPE("B",$E(X,1,30),DA) "^DD",9002018.35,9002018.35,.01,3) Answer must be 3-30 characters in length. "^DD",9002018.35,9002018.35,.01,"DT") 3030508 "^DD",9002018.35,9002018.35,.02,0) INACTIVE^S^1:YES;0:NO;^0;2^Q "^DD",9002018.35,9002018.35,.02,3) "^DD",9002018.35,9002018.35,.02,"DT") 3030520 "^DD",9002018.35,9002018.35,.03,0) DEPARTMENT NAME^P9002018.2'^BSDXDEPT(^0;3^Q "^DD",9002018.35,9002018.35,.03,"DT") 3030508 "^DD",9002018.35,9002018.35,.04,0) DISPLAY COLOR^F^^0;4^K:$L(X)>30!($L(X)<1) X "^DD",9002018.35,9002018.35,.04,3) Answer must be 1-30 characters in length. "^DD",9002018.35,9002018.35,.04,"DT") 3030508 "^DD",9002018.35,9002018.35,.05,0) RED^NJ3,0^^0;5^K:+X'=X!(X>255)!(X<0)!(X?.E1"."1N.N) X "^DD",9002018.35,9002018.35,.05,3) Type a Number between 0 and 255, 0 Decimal Digits "^DD",9002018.35,9002018.35,.05,"DT") 3030521 "^DD",9002018.35,9002018.35,.06,0) GREEN^NJ3,0^^0;6^K:+X'=X!(X>255)!(X<0)!(X?.E1"."1N.N) X "^DD",9002018.35,9002018.35,.06,3) Type a Number between 0 and 255, 0 Decimal Digits "^DD",9002018.35,9002018.35,.06,"DT") 3030521 "^DD",9002018.35,9002018.35,.07,0) BLUE^NJ3,0^^0;7^K:+X'=X!(X>255)!(X<0)!(X?.E1"."1N.N) X "^DD",9002018.35,9002018.35,.07,3) Type a Number between 0 and 255, 0 Decimal Digits "^DD",9002018.35,9002018.35,.07,"DT") 3030521 "^DD",9002018.38,9002018.38,0) FIELD^^.01^1 "^DD",9002018.38,9002018.38,0,"DT") 3030527 "^DD",9002018.38,9002018.38,0,"IX","B",9002018.38,.01) "^DD",9002018.38,9002018.38,0,"NM","BSDX ACCESS GROUP") "^DD",9002018.38,9002018.38,0,"PT",9002018.39,.01) "^DD",9002018.38,9002018.38,0,"VRPK") BSDX "^DD",9002018.38,9002018.38,.01,0) ACCESS GROUP^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X "^DD",9002018.38,9002018.38,.01,1,0) ^.1 "^DD",9002018.38,9002018.38,.01,1,1,0) 9002018.38^B "^DD",9002018.38,9002018.38,.01,1,1,1) S ^BSDXAGP("B",$E(X,1,30),DA)="" "^DD",9002018.38,9002018.38,.01,1,1,2) K ^BSDXAGP("B",$E(X,1,30),DA) "^DD",9002018.38,9002018.38,.01,3) Answer must be 3-30 characters in length. "^DD",9002018.38,9002018.38,.01,"DT") 3030527 "^DD",9002018.39,9002018.39,0) FIELD^^.02^2 "^DD",9002018.39,9002018.39,0,"DDA") N "^DD",9002018.39,9002018.39,0,"DT") 3030527 "^DD",9002018.39,9002018.39,0,"IX","B",9002018.39,.01) "^DD",9002018.39,9002018.39,0,"NM","BSDX ACCESS GROUP TYPE") "^DD",9002018.39,9002018.39,0,"VRPK") BSDX "^DD",9002018.39,9002018.39,.01,0) ACCESS GROUP^RP9002018.38'^BSDXAGP(^0;1^Q "^DD",9002018.39,9002018.39,.01,1,0) ^.1 "^DD",9002018.39,9002018.39,.01,1,1,0) 9002018.39^B "^DD",9002018.39,9002018.39,.01,1,1,1) S ^BSDXAGTP("B",$E(X,1,30),DA)="" "^DD",9002018.39,9002018.39,.01,1,1,2) K ^BSDXAGTP("B",$E(X,1,30),DA) "^DD",9002018.39,9002018.39,.01,3) "^DD",9002018.39,9002018.39,.01,"DT") 3030720 "^DD",9002018.39,9002018.39,.02,0) ACCESS TYPE^P9002018.35'^BSDXTYPE(^0;2^Q "^DD",9002018.39,9002018.39,.02,"DT") 3030720 "^DD",9002018.4,9002018.4,0) FIELD^^1^14 "^DD",9002018.4,9002018.4,0,"DT") 3040615 "^DD",9002018.4,9002018.4,0,"IX","ARSRC",9002018.4,.07) "^DD",9002018.4,9002018.4,0,"IX","B",9002018.4,.01) "^DD",9002018.4,9002018.4,0,"IX","CPAT",9002018.4,.05) "^DD",9002018.4,9002018.4,0,"NM","BSDX APPOINTMENT") "^DD",9002018.4,9002018.4,0,"VRPK") BSDX "^DD",9002018.4,9002018.4,.01,0) STARTTIME^RD^^0;1^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X "^DD",9002018.4,9002018.4,.01,1,0) ^.1 "^DD",9002018.4,9002018.4,.01,1,1,0) 9002018.4^B "^DD",9002018.4,9002018.4,.01,1,1,1) S ^BSDXAPPT("B",$E(X,1,30),DA)="" "^DD",9002018.4,9002018.4,.01,1,1,2) K ^BSDXAPPT("B",$E(X,1,30),DA) "^DD",9002018.4,9002018.4,.01,3) "^DD",9002018.4,9002018.4,.01,"DT") 3030508 "^DD",9002018.4,9002018.4,.02,0) ENDTIME^RD^^0;2^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X "^DD",9002018.4,9002018.4,.02,3) "^DD",9002018.4,9002018.4,.02,"DT") 3030508 "^DD",9002018.4,9002018.4,.03,0) CHECKIN^RD^^0;3^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X "^DD",9002018.4,9002018.4,.03,3) "^DD",9002018.4,9002018.4,.03,"DT") 3030508 "^DD",9002018.4,9002018.4,.04,0) AUXTIME^RD^^0;4^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X "^DD",9002018.4,9002018.4,.04,3) "^DD",9002018.4,9002018.4,.04,"DT") 3030508 "^DD",9002018.4,9002018.4,.05,0) PATIENT^P9000001'^AUPNPAT(^0;5^Q "^DD",9002018.4,9002018.4,.05,1,0) ^.1 "^DD",9002018.4,9002018.4,.05,1,1,0) 9002018.4^CPAT "^DD",9002018.4,9002018.4,.05,1,1,1) S ^BSDXAPPT("CPAT",$E(X,1,30),DA)="" "^DD",9002018.4,9002018.4,.05,1,1,2) K ^BSDXAPPT("CPAT",$E(X,1,30),DA) "^DD",9002018.4,9002018.4,.05,1,1,"%D",0) ^^1^1^3040109^ "^DD",9002018.4,9002018.4,.05,1,1,"%D",1,0) Cross reference of PATIENT field for lookup and sorting "^DD",9002018.4,9002018.4,.05,1,1,"DT") 3040109 "^DD",9002018.4,9002018.4,.05,"DT") 3040109 "^DD",9002018.4,9002018.4,.06,0) ACCESS TYPE ID^NJ6,0^^0;6^K:+X'=X!(X>999999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002018.4,9002018.4,.06,3) Type a Number between 1 and 999999, 0 Decimal Digits "^DD",9002018.4,9002018.4,.06,"DT") 3040614 "^DD",9002018.4,9002018.4,.07,0) RESOURCE^P9002018.1'^BSDXRES(^0;7^Q "^DD",9002018.4,9002018.4,.07,1,0) ^.1 "^DD",9002018.4,9002018.4,.07,1,1,0) 9002018.4^ARSRC^MUMPS "^DD",9002018.4,9002018.4,.07,1,1,1) D XR2S^BSDX03(DA) "^DD",9002018.4,9002018.4,.07,1,1,2) D XR2K^BSDX03(DA) "^DD",9002018.4,9002018.4,.07,1,1,"%D",0) ^^1^1^3030512^ "^DD",9002018.4,9002018.4,.07,1,1,"%D",1,0) This index is used to find all appointments for a given resource during a given time period "^DD",9002018.4,9002018.4,.07,1,1,"DT") 3030512 "^DD",9002018.4,9002018.4,.07,"DT") 3030512 "^DD",9002018.4,9002018.4,.08,0) DATA ENTRY CLERK^P200'^VA(200,^0;8^Q "^DD",9002018.4,9002018.4,.08,3) Enter the name of the clerk who made the appointment. "^DD",9002018.4,9002018.4,.08,21,0) ^^1^1^3040214^ "^DD",9002018.4,9002018.4,.08,21,1,0) Field contains the name of the clerk who made the appointment. "^DD",9002018.4,9002018.4,.08,"DT") 3040214 "^DD",9002018.4,9002018.4,.09,0) DATE APPT MADE^D^^0;9^S %DT="ETX" D ^%DT S X=Y K:X<1 X "^DD",9002018.4,9002018.4,.09,3) Enter the date the appointment was made. "^DD",9002018.4,9002018.4,.09,21,0) ^^1^1^3040214^ "^DD",9002018.4,9002018.4,.09,21,1,0) Field contains the date the appointment was made. "^DD",9002018.4,9002018.4,.09,"DT") 3040214 "^DD",9002018.4,9002018.4,.1,0) NOSHOW^S^1:YES;0:NO;^0;10^Q "^DD",9002018.4,9002018.4,.1,"DT") 3040223 "^DD",9002018.4,9002018.4,.11,0) REBOOK DATETIME^D^^0;11^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X "^DD",9002018.4,9002018.4,.11,"DT") 3040613 "^DD",9002018.4,9002018.4,.12,0) CANCEL DATETIME^D^^0;12^S %DT="ET" D ^%DT S X=Y K:Y<1 X "^DD",9002018.4,9002018.4,.12,"DT") 3040613 "^DD",9002018.4,9002018.4,.13,0) WALKIN^S^y:YES;n:NO;^0;13^Q "^DD",9002018.4,9002018.4,.13,"DT") 3040615 "^DD",9002018.4,9002018.4,1,0) NOTE^9002018.41^^1;0 "^DD",9002018.4,9002018.41,0) NOTE SUB-FIELD^^.01^1 "^DD",9002018.4,9002018.41,0,"DT") 3030508 "^DD",9002018.4,9002018.41,0,"NM","NOTE") "^DD",9002018.4,9002018.41,0,"UP") 9002018.4 "^DD",9002018.4,9002018.41,.01,0) NOTE^W^^0;1^Q "^DD",9002018.4,9002018.41,.01,"DT") 3030508 "^DD",9002018.5,9002018.5,0) FIELD^^.03^3 "^DD",9002018.5,9002018.5,0,"DT") 3040226 "^DD",9002018.5,9002018.5,0,"IX","B",9002018.5,.01) "^DD",9002018.5,9002018.5,0,"NM","BSDX APPLICATION") "^DD",9002018.5,9002018.5,0,"VRPK") BSDX "^DD",9002018.5,9002018.5,.01,0) MAJOR VERSION^RF^^0;1^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X "^DD",9002018.5,9002018.5,.01,1,0) ^.1 "^DD",9002018.5,9002018.5,.01,1,1,0) 9002018.5^B "^DD",9002018.5,9002018.5,.01,1,1,1) S ^BSDXAPPL("B",$E(X,1,30),DA)="" "^DD",9002018.5,9002018.5,.01,1,1,2) K ^BSDXAPPL("B",$E(X,1,30),DA) "^DD",9002018.5,9002018.5,.01,3) Answer must be 1-30 characters in length. "^DD",9002018.5,9002018.5,.01,"DT") 3040226 "^DD",9002018.5,9002018.5,.02,0) MINOR VERSION^RF^^0;2^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X "^DD",9002018.5,9002018.5,.02,3) Answer must be 1-30 characters in length. "^DD",9002018.5,9002018.5,.02,"DT") 3040226 "^DD",9002018.5,9002018.5,.03,0) BUILD^D^^0;3^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X "^DD",9002018.5,9002018.5,.03,"DT") 3040226 "^DIC",9002018.1,9002018.1,0) BSDX RESOURCE^9002018.1 "^DIC",9002018.1,9002018.1,0,"GL") ^BSDXRES( "^DIC",9002018.1,"B","BSDX RESOURCE",9002018.1) "^DIC",9002018.15,9002018.15,0) BSDX RESOURCE USER^9002018.15 "^DIC",9002018.15,9002018.15,0,"GL") ^BSDXRSU( "^DIC",9002018.15,"B","BSDX RESOURCE USER",9002018.15) "^DIC",9002018.2,9002018.2,0) BSDX RESOURCE GROUP^9002018.2 "^DIC",9002018.2,9002018.2,0,"GL") ^BSDXDEPT( "^DIC",9002018.2,"B","BSDX RESOURCE GROUP",9002018.2) "^DIC",9002018.3,9002018.3,0) BSDX ACCESS BLOCK^9002018.3 "^DIC",9002018.3,9002018.3,0,"GL") ^BSDXAB( "^DIC",9002018.3,"B","BSDX ACCESS BLOCK",9002018.3) "^DIC",9002018.35,9002018.35,0) BSDX ACCESS TYPE^9002018.35 "^DIC",9002018.35,9002018.35,0,"GL") ^BSDXTYPE( "^DIC",9002018.35,"B","BSDX ACCESS TYPE",9002018.35) "^DIC",9002018.38,9002018.38,0) BSDX ACCESS GROUP^9002018.38 "^DIC",9002018.38,9002018.38,0,"GL") ^BSDXAGP( "^DIC",9002018.38,"B","BSDX ACCESS GROUP",9002018.38) "^DIC",9002018.39,9002018.39,0) BSDX ACCESS GROUP TYPE^9002018.39 "^DIC",9002018.39,9002018.39,0,"GL") ^BSDXAGTP( "^DIC",9002018.39,"B","BSDX ACCESS GROUP TYPE",9002018.39) "^DIC",9002018.4,9002018.4,0) BSDX APPOINTMENT^9002018.4 "^DIC",9002018.4,9002018.4,0,"GL") ^BSDXAPPT( "^DIC",9002018.4,"B","BSDX APPOINTMENT",9002018.4) "^DIC",9002018.5,9002018.5,0) BSDX APPLICATION^9002018.5 "^DIC",9002018.5,9002018.5,0,"GL") ^BSDXAPPL( "^DIC",9002018.5,"B","BSDX APPLICATION",9002018.5) **END** **END**