iSharkFly-Open
/
VistA-Scheduling
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
VistA-Scheduling/kids/BSDX_0142.k

12677 lines
339 KiB
Plaintext
Raw Blame History

KIDS Distribution saved on Dec 07, 2010@01:24:23
Scheduling GUI v 1.42
**KIDS**:BSDX 1.42^
**INSTALL NAME**
BSDX 1.42
"BLD",7653,0)
BSDX 1.42^IHS Windows Scheduling^^3101207^n
"BLD",7653,1,0)
^^1^1^3101207^^^^
"BLD",7653,1,1,0)
Clinical Scheduling M Server support routines, files, options and RPCs.
"BLD",7653,4,0)
^9.64PA^9002018.5^9
"BLD",7653,4,9002018.1,0)
9002018.1
"BLD",7653,4,9002018.1,222)
y^y^f^^n^^n^o^n
"BLD",7653,4,9002018.15,0)
9002018.15
"BLD",7653,4,9002018.15,222)
y^y^f^^n^^n^o^n
"BLD",7653,4,9002018.2,0)
9002018.2
"BLD",7653,4,9002018.2,222)
y^y^f^^n^^n^o^n
"BLD",7653,4,9002018.3,0)
9002018.3
"BLD",7653,4,9002018.3,222)
y^y^f^^n^^n^o^n
"BLD",7653,4,9002018.35,0)
9002018.35
"BLD",7653,4,9002018.35,222)
y^y^f^^n^^n^o^n
"BLD",7653,4,9002018.38,0)
9002018.38
"BLD",7653,4,9002018.38,222)
y^y^f^^n^^n^o^n
"BLD",7653,4,9002018.39,0)
9002018.39
"BLD",7653,4,9002018.39,222)
y^y^f^^n^^n^o^n
"BLD",7653,4,9002018.4,0)
9002018.4
"BLD",7653,4,9002018.4,222)
y^y^f^^n^^n^o^n
"BLD",7653,4,9002018.5,0)
9002018.5
"BLD",7653,4,9002018.5,222)
y^y^f^^n^^y^o^n
"BLD",7653,4,"B",9002018.1,9002018.1)
"BLD",7653,4,"B",9002018.15,9002018.15)
"BLD",7653,4,"B",9002018.2,9002018.2)
"BLD",7653,4,"B",9002018.3,9002018.3)
"BLD",7653,4,"B",9002018.35,9002018.35)
"BLD",7653,4,"B",9002018.38,9002018.38)
"BLD",7653,4,"B",9002018.39,9002018.39)
"BLD",7653,4,"B",9002018.4,9002018.4)
"BLD",7653,4,"B",9002018.5,9002018.5)
"BLD",7653,6.3)
9
"BLD",7653,"ABPKG")
n
"BLD",7653,"INIT")
V0200^BSDX2E
"BLD",7653,"KRN",0)
^9.67PA^8989.52^19
"BLD",7653,"KRN",.4,0)
.4
"BLD",7653,"KRN",.4,"NM",0)
^9.68A^^
"BLD",7653,"KRN",.401,0)
.401
"BLD",7653,"KRN",.402,0)
.402
"BLD",7653,"KRN",.403,0)
.403
"BLD",7653,"KRN",.5,0)
.5
"BLD",7653,"KRN",.84,0)
.84
"BLD",7653,"KRN",3.6,0)
3.6
"BLD",7653,"KRN",3.8,0)
3.8
"BLD",7653,"KRN",9.2,0)
9.2
"BLD",7653,"KRN",9.8,0)
9.8
"BLD",7653,"KRN",9.8,"NM",0)
^9.68A^36^36
"BLD",7653,"KRN",9.8,"NM",1,0)
BSDX01^^0^B107139484
"BLD",7653,"KRN",9.8,"NM",2,0)
BSDX02^^0^B16323271
"BLD",7653,"KRN",9.8,"NM",3,0)
BSDX03^^0^B2855259
"BLD",7653,"KRN",9.8,"NM",4,0)
BSDX04^^0^B31079316
"BLD",7653,"KRN",9.8,"NM",5,0)
BSDX05^^0^B10878471
"BLD",7653,"KRN",9.8,"NM",6,0)
BSDX06^^0^B6812445
"BLD",7653,"KRN",9.8,"NM",7,0)
BSDX07^^0^B188811791
"BLD",7653,"KRN",9.8,"NM",8,0)
BSDX08^^0^B140041473
"BLD",7653,"KRN",9.8,"NM",9,0)
BSDX09^^0^B35707298
"BLD",7653,"KRN",9.8,"NM",10,0)
BSDX12^^0^B7203579
"BLD",7653,"KRN",9.8,"NM",11,0)
BSDX13^^0^B9772451
"BLD",7653,"KRN",9.8,"NM",12,0)
BSDX14^^0^B6450810
"BLD",7653,"KRN",9.8,"NM",13,0)
BSDX15^^0^B5327807
"BLD",7653,"KRN",9.8,"NM",14,0)
BSDX16^^0^B11948965
"BLD",7653,"KRN",9.8,"NM",15,0)
BSDX17^^0^B2072173
"BLD",7653,"KRN",9.8,"NM",16,0)
BSDX18^^0^B87953431
"BLD",7653,"KRN",9.8,"NM",17,0)
BSDX19^^0^B7890401
"BLD",7653,"KRN",9.8,"NM",18,0)
BSDX20^^0^B5911607
"BLD",7653,"KRN",9.8,"NM",19,0)
BSDX21^^0^B8672065
"BLD",7653,"KRN",9.8,"NM",20,0)
BSDX22^^0^B9479861
"BLD",7653,"KRN",9.8,"NM",21,0)
BSDX23^^0^B8488013
"BLD",7653,"KRN",9.8,"NM",22,0)
BSDX24^^0^B13455014
"BLD",7653,"KRN",9.8,"NM",23,0)
BSDX25^^0^B16070744
"BLD",7653,"KRN",9.8,"NM",24,0)
BSDX26^^0^B30714245
"BLD",7653,"KRN",9.8,"NM",25,0)
BSDX27^^0^B133007616
"BLD",7653,"KRN",9.8,"NM",26,0)
BSDX28^^0^B32389827
"BLD",7653,"KRN",9.8,"NM",27,0)
BSDX29^^0^B51424449
"BLD",7653,"KRN",9.8,"NM",28,0)
BSDX30^^0^B6616255
"BLD",7653,"KRN",9.8,"NM",29,0)
BSDX31^^0^B67823338
"BLD",7653,"KRN",9.8,"NM",30,0)
BSDX32^^0^B17196738
"BLD",7653,"KRN",9.8,"NM",31,0)
BSDX33^^0^B14923306
"BLD",7653,"KRN",9.8,"NM",32,0)
BSDX34^^0^B43182525
"BLD",7653,"KRN",9.8,"NM",33,0)
BSDX35^^0^B8147998
"BLD",7653,"KRN",9.8,"NM",34,0)
BSDX11^^0^B6358791
"BLD",7653,"KRN",9.8,"NM",35,0)
BSDXAPI^^0^B105784370
"BLD",7653,"KRN",9.8,"NM",36,0)
BSDXGPRV^^0^B4804670
"BLD",7653,"KRN",9.8,"NM","B","BSDX01",1)
"BLD",7653,"KRN",9.8,"NM","B","BSDX02",2)
"BLD",7653,"KRN",9.8,"NM","B","BSDX03",3)
"BLD",7653,"KRN",9.8,"NM","B","BSDX04",4)
"BLD",7653,"KRN",9.8,"NM","B","BSDX05",5)
"BLD",7653,"KRN",9.8,"NM","B","BSDX06",6)
"BLD",7653,"KRN",9.8,"NM","B","BSDX07",7)
"BLD",7653,"KRN",9.8,"NM","B","BSDX08",8)
"BLD",7653,"KRN",9.8,"NM","B","BSDX09",9)
"BLD",7653,"KRN",9.8,"NM","B","BSDX11",34)
"BLD",7653,"KRN",9.8,"NM","B","BSDX12",10)
"BLD",7653,"KRN",9.8,"NM","B","BSDX13",11)
"BLD",7653,"KRN",9.8,"NM","B","BSDX14",12)
"BLD",7653,"KRN",9.8,"NM","B","BSDX15",13)
"BLD",7653,"KRN",9.8,"NM","B","BSDX16",14)
"BLD",7653,"KRN",9.8,"NM","B","BSDX17",15)
"BLD",7653,"KRN",9.8,"NM","B","BSDX18",16)
"BLD",7653,"KRN",9.8,"NM","B","BSDX19",17)
"BLD",7653,"KRN",9.8,"NM","B","BSDX20",18)
"BLD",7653,"KRN",9.8,"NM","B","BSDX21",19)
"BLD",7653,"KRN",9.8,"NM","B","BSDX22",20)
"BLD",7653,"KRN",9.8,"NM","B","BSDX23",21)
"BLD",7653,"KRN",9.8,"NM","B","BSDX24",22)
"BLD",7653,"KRN",9.8,"NM","B","BSDX25",23)
"BLD",7653,"KRN",9.8,"NM","B","BSDX26",24)
"BLD",7653,"KRN",9.8,"NM","B","BSDX27",25)
"BLD",7653,"KRN",9.8,"NM","B","BSDX28",26)
"BLD",7653,"KRN",9.8,"NM","B","BSDX29",27)
"BLD",7653,"KRN",9.8,"NM","B","BSDX30",28)
"BLD",7653,"KRN",9.8,"NM","B","BSDX31",29)
"BLD",7653,"KRN",9.8,"NM","B","BSDX32",30)
"BLD",7653,"KRN",9.8,"NM","B","BSDX33",31)
"BLD",7653,"KRN",9.8,"NM","B","BSDX34",32)
"BLD",7653,"KRN",9.8,"NM","B","BSDX35",33)
"BLD",7653,"KRN",9.8,"NM","B","BSDXAPI",35)
"BLD",7653,"KRN",9.8,"NM","B","BSDXGPRV",36)
"BLD",7653,"KRN",19,0)
19
"BLD",7653,"KRN",19,"NM",0)
^9.68A^1^1
"BLD",7653,"KRN",19,"NM",1,0)
BSDXRPC^^0
"BLD",7653,"KRN",19,"NM","B","BSDXRPC",1)
"BLD",7653,"KRN",19.1,0)
19.1
"BLD",7653,"KRN",19.1,"NM",0)
^9.68A^2^2
"BLD",7653,"KRN",19.1,"NM",1,0)
BSDXZMENU^^0
"BLD",7653,"KRN",19.1,"NM",2,0)
BSDXZMGR^^0
"BLD",7653,"KRN",19.1,"NM","B","BSDXZMENU",1)
"BLD",7653,"KRN",19.1,"NM","B","BSDXZMGR",2)
"BLD",7653,"KRN",101,0)
101
"BLD",7653,"KRN",101,"NM",0)
^9.68A^4^4
"BLD",7653,"KRN",101,"NM",1,0)
BSDX ADD APPOINTMENT^^0
"BLD",7653,"KRN",101,"NM",2,0)
BSDX CANCEL APPOINTMENT^^0
"BLD",7653,"KRN",101,"NM",3,0)
BSDX CHECKIN APPOINTMENT^^0
"BLD",7653,"KRN",101,"NM",4,0)
BSDX NOSHOW APPOINTMENT^^0
"BLD",7653,"KRN",101,"NM","B","BSDX ADD APPOINTMENT",1)
"BLD",7653,"KRN",101,"NM","B","BSDX CANCEL APPOINTMENT",2)
"BLD",7653,"KRN",101,"NM","B","BSDX CHECKIN APPOINTMENT",3)
"BLD",7653,"KRN",101,"NM","B","BSDX NOSHOW APPOINTMENT",4)
"BLD",7653,"KRN",409.61,0)
409.61
"BLD",7653,"KRN",771,0)
771
"BLD",7653,"KRN",870,0)
870
"BLD",7653,"KRN",8989.51,0)
8989.51
"BLD",7653,"KRN",8989.52,0)
8989.52
"BLD",7653,"KRN",8994,0)
8994
"BLD",7653,"KRN",8994,"NM",0)
^9.68A^59^56
"BLD",7653,"KRN",8994,"NM",1,0)
BSDX ADD NEW APPOINTMENT^^0
"BLD",7653,"KRN",8994,"NM",2,0)
BSDX ADD NEW AVAILABILITY^^0
"BLD",7653,"KRN",8994,"NM",3,0)
BSDX APPT BLOCKS OVERLAP^^0
"BLD",7653,"KRN",8994,"NM",4,0)
BSDX CANCEL APPOINTMENT^^0
"BLD",7653,"KRN",8994,"NM",5,0)
BSDX CANCEL AVAILABILITY^^0
"BLD",7653,"KRN",8994,"NM",6,0)
BSDX CREATE APPT SCHEDULE^^0
"BLD",7653,"KRN",8994,"NM",7,0)
BSDX CREATE ASGND SLOT SCHED^^0
"BLD",7653,"KRN",8994,"NM",10,0)
BSDX GET BASIC REG INFO^^0
"BLD",7653,"KRN",8994,"NM",12,0)
BSDX TYPE BLOCKS OVERLAP^^0
"BLD",7653,"KRN",8994,"NM",13,0)
BSDX ADD/EDIT ACCESS TYPE^^0
"BLD",7653,"KRN",8994,"NM",14,0)
BSDX GET ACCESS GROUP TYPES^^0
"BLD",7653,"KRN",8994,"NM",15,0)
BSDX GROUP RESOURCE^^0
"BLD",7653,"KRN",8994,"NM",16,0)
BSDX RESOURCE GROUPS BY USER^^0
"BLD",7653,"KRN",8994,"NM",17,0)
BSDX ADD/EDIT RESOURCEUSER^^0
"BLD",7653,"KRN",8994,"NM",18,0)
BSDX DELETE RESOURCEUSER^^0
"BLD",7653,"KRN",8994,"NM",19,0)
BSDX SCHEDULE USER^^0
"BLD",7653,"KRN",8994,"NM",20,0)
BSDX ADD/EDIT RESOURCE^^0
"BLD",7653,"KRN",8994,"NM",21,0)
BSDX SCHEDULING USER INFO^^0
"BLD",7653,"KRN",8994,"NM",22,0)
BSDX RESOURCES^^0
"BLD",7653,"KRN",8994,"NM",23,0)
BSDX ADD/EDIT RESOURCE GROUP^^0
"BLD",7653,"KRN",8994,"NM",24,0)
BSDX DELETE RESOURCE GROUP^^0
"BLD",7653,"KRN",8994,"NM",25,0)
BSDX DELETE RES GROUP ITEM^^0
"BLD",7653,"KRN",8994,"NM",26,0)
BSDX DEPARTMENT RESOURCE^^0
"BLD",7653,"KRN",8994,"NM",27,0)
BSDX DEPARTMENTS BY USER^^0
"BLD",7653,"KRN",8994,"NM",28,0)
BSDX RESOURCES BY USER^^0
"BLD",7653,"KRN",8994,"NM",29,0)
BSDX ADD ACCESS GROUP ITEM^^0
"BLD",7653,"KRN",8994,"NM",30,0)
BSDX ADD RES GROUP ITEM^^0
"BLD",7653,"KRN",8994,"NM",31,0)
BSDX ADD/EDIT ACCESS GROUP^^0
"BLD",7653,"KRN",8994,"NM",32,0)
BSDX DELETE ACCESS GROUP^^0
"BLD",7653,"KRN",8994,"NM",33,0)
BSDX DELETE ACCESS GROUP ITEM^^0
"BLD",7653,"KRN",8994,"NM",34,0)
BSDX REGISTER EVENT^^0
"BLD",7653,"KRN",8994,"NM",35,0)
BSDX UNREGISTER EVENT^^0
"BLD",7653,"KRN",8994,"NM",36,0)
BSDX RAISE EVENT^^0
"BLD",7653,"KRN",8994,"NM",37,0)
BSDX SEARCH AVAILABILITY^^0
"BLD",7653,"KRN",8994,"NM",38,0)
BSDX CHECKIN APPOINTMENT^^0
"BLD",7653,"KRN",8994,"NM",39,0)
BSDX EDIT APPOINTMENT^^0
"BLD",7653,"KRN",8994,"NM",40,0)
BSDX PATIENT APPT DISPLAY^^0
"BLD",7653,"KRN",8994,"NM",41,0)
BSDXPatientLookupRS^^0
"BLD",7653,"KRN",8994,"NM",42,0)
BSDX SPACEBAR SET^^0
"BLD",7653,"KRN",8994,"NM",43,0)
BSDX COPY APPOINTMENT CANCEL^^0
"BLD",7653,"KRN",8994,"NM",44,0)
BSDX COPY APPOINTMENT STATUS^^0
"BLD",7653,"KRN",8994,"NM",45,0)
BSDX COPY APPOINTMENTS^^0
"BLD",7653,"KRN",8994,"NM",46,0)
BSDX CLINIC LETTERS^^0
"BLD",7653,"KRN",8994,"NM",47,0)
BSDX NOSHOW^^0
"BLD",7653,"KRN",8994,"NM",48,0)
BSDX IM HERE^^0
"BLD",7653,"KRN",8994,"NM",49,0)
BSDX HOSPITAL LOCATION^^0
"BLD",7653,"KRN",8994,"NM",50,0)
BSDX CLINIC SETUP^^0
"BLD",7653,"KRN",8994,"NM",51,0)
BSDX REBOOK LIST^^0
"BLD",7653,"KRN",8994,"NM",52,0)
BSDX REBOOK CLINIC LIST^^0
"BLD",7653,"KRN",8994,"NM",53,0)
BSDX REBOOK SET^^0
"BLD",7653,"KRN",8994,"NM",54,0)
BSDX RESOURCE LETTERS^^0
"BLD",7653,"KRN",8994,"NM",55,0)
BSDX CANCEL CLINIC LIST^^0
"BLD",7653,"KRN",8994,"NM",56,0)
BSDX CANCEL AV BY DATE^^0
"BLD",7653,"KRN",8994,"NM",57,0)
BSDX REBOOK NEXT BLOCK^^0
"BLD",7653,"KRN",8994,"NM",58,0)
BSDX EHR PATIENT^^0
"BLD",7653,"KRN",8994,"NM",59,0)
BSDX HOSP LOC PROVIDERS^^0
"BLD",7653,"KRN",8994,"NM","B","BSDX ADD ACCESS GROUP ITEM",29)
"BLD",7653,"KRN",8994,"NM","B","BSDX ADD NEW APPOINTMENT",1)
"BLD",7653,"KRN",8994,"NM","B","BSDX ADD NEW AVAILABILITY",2)
"BLD",7653,"KRN",8994,"NM","B","BSDX ADD RES GROUP ITEM",30)
"BLD",7653,"KRN",8994,"NM","B","BSDX ADD/EDIT ACCESS GROUP",31)
"BLD",7653,"KRN",8994,"NM","B","BSDX ADD/EDIT ACCESS TYPE",13)
"BLD",7653,"KRN",8994,"NM","B","BSDX ADD/EDIT RESOURCE",20)
"BLD",7653,"KRN",8994,"NM","B","BSDX ADD/EDIT RESOURCE GROUP",23)
"BLD",7653,"KRN",8994,"NM","B","BSDX ADD/EDIT RESOURCEUSER",17)
"BLD",7653,"KRN",8994,"NM","B","BSDX APPT BLOCKS OVERLAP",3)
"BLD",7653,"KRN",8994,"NM","B","BSDX CANCEL APPOINTMENT",4)
"BLD",7653,"KRN",8994,"NM","B","BSDX CANCEL AV BY DATE",56)
"BLD",7653,"KRN",8994,"NM","B","BSDX CANCEL AVAILABILITY",5)
"BLD",7653,"KRN",8994,"NM","B","BSDX CANCEL CLINIC LIST",55)
"BLD",7653,"KRN",8994,"NM","B","BSDX CHECKIN APPOINTMENT",38)
"BLD",7653,"KRN",8994,"NM","B","BSDX CLINIC LETTERS",46)
"BLD",7653,"KRN",8994,"NM","B","BSDX CLINIC SETUP",50)
"BLD",7653,"KRN",8994,"NM","B","BSDX COPY APPOINTMENT CANCEL",43)
"BLD",7653,"KRN",8994,"NM","B","BSDX COPY APPOINTMENT STATUS",44)
"BLD",7653,"KRN",8994,"NM","B","BSDX COPY APPOINTMENTS",45)
"BLD",7653,"KRN",8994,"NM","B","BSDX CREATE APPT SCHEDULE",6)
"BLD",7653,"KRN",8994,"NM","B","BSDX CREATE ASGND SLOT SCHED",7)
"BLD",7653,"KRN",8994,"NM","B","BSDX DELETE ACCESS GROUP",32)
"BLD",7653,"KRN",8994,"NM","B","BSDX DELETE ACCESS GROUP ITEM",33)
"BLD",7653,"KRN",8994,"NM","B","BSDX DELETE RES GROUP ITEM",25)
"BLD",7653,"KRN",8994,"NM","B","BSDX DELETE RESOURCE GROUP",24)
"BLD",7653,"KRN",8994,"NM","B","BSDX DELETE RESOURCEUSER",18)
"BLD",7653,"KRN",8994,"NM","B","BSDX DEPARTMENT RESOURCE",26)
"BLD",7653,"KRN",8994,"NM","B","BSDX DEPARTMENTS BY USER",27)
"BLD",7653,"KRN",8994,"NM","B","BSDX EDIT APPOINTMENT",39)
"BLD",7653,"KRN",8994,"NM","B","BSDX EHR PATIENT",58)
"BLD",7653,"KRN",8994,"NM","B","BSDX GET ACCESS GROUP TYPES",14)
"BLD",7653,"KRN",8994,"NM","B","BSDX GET BASIC REG INFO",10)
"BLD",7653,"KRN",8994,"NM","B","BSDX GROUP RESOURCE",15)
"BLD",7653,"KRN",8994,"NM","B","BSDX HOSP LOC PROVIDERS",59)
"BLD",7653,"KRN",8994,"NM","B","BSDX HOSPITAL LOCATION",49)
"BLD",7653,"KRN",8994,"NM","B","BSDX IM HERE",48)
"BLD",7653,"KRN",8994,"NM","B","BSDX NOSHOW",47)
"BLD",7653,"KRN",8994,"NM","B","BSDX PATIENT APPT DISPLAY",40)
"BLD",7653,"KRN",8994,"NM","B","BSDX RAISE EVENT",36)
"BLD",7653,"KRN",8994,"NM","B","BSDX REBOOK CLINIC LIST",52)
"BLD",7653,"KRN",8994,"NM","B","BSDX REBOOK LIST",51)
"BLD",7653,"KRN",8994,"NM","B","BSDX REBOOK NEXT BLOCK",57)
"BLD",7653,"KRN",8994,"NM","B","BSDX REBOOK SET",53)
"BLD",7653,"KRN",8994,"NM","B","BSDX REGISTER EVENT",34)
"BLD",7653,"KRN",8994,"NM","B","BSDX RESOURCE GROUPS BY USER",16)
"BLD",7653,"KRN",8994,"NM","B","BSDX RESOURCE LETTERS",54)
"BLD",7653,"KRN",8994,"NM","B","BSDX RESOURCES",22)
"BLD",7653,"KRN",8994,"NM","B","BSDX RESOURCES BY USER",28)
"BLD",7653,"KRN",8994,"NM","B","BSDX SCHEDULE USER",19)
"BLD",7653,"KRN",8994,"NM","B","BSDX SCHEDULING USER INFO",21)
"BLD",7653,"KRN",8994,"NM","B","BSDX SEARCH AVAILABILITY",37)
"BLD",7653,"KRN",8994,"NM","B","BSDX SPACEBAR SET",42)
"BLD",7653,"KRN",8994,"NM","B","BSDX TYPE BLOCKS OVERLAP",12)
"BLD",7653,"KRN",8994,"NM","B","BSDX UNREGISTER EVENT",35)
"BLD",7653,"KRN",8994,"NM","B","BSDXPatientLookupRS",41)
"BLD",7653,"KRN","B",.4,.4)
"BLD",7653,"KRN","B",.401,.401)
"BLD",7653,"KRN","B",.402,.402)
"BLD",7653,"KRN","B",.403,.403)
"BLD",7653,"KRN","B",.5,.5)
"BLD",7653,"KRN","B",.84,.84)
"BLD",7653,"KRN","B",3.6,3.6)
"BLD",7653,"KRN","B",3.8,3.8)
"BLD",7653,"KRN","B",9.2,9.2)
"BLD",7653,"KRN","B",9.8,9.8)
"BLD",7653,"KRN","B",19,19)
"BLD",7653,"KRN","B",19.1,19.1)
"BLD",7653,"KRN","B",101,101)
"BLD",7653,"KRN","B",409.61,409.61)
"BLD",7653,"KRN","B",771,771)
"BLD",7653,"KRN","B",870,870)
"BLD",7653,"KRN","B",8989.51,8989.51)
"BLD",7653,"KRN","B",8989.52,8989.52)
"BLD",7653,"KRN","B",8994,8994)
"BLD",7653,"PRE")
BSDX2E
"BLD",7653,"QUES",0)
^9.62^^
"BLD",7653,"REQB",0)
^9.611^^
"DATA",9002018.5,1,0)
1^42^3101207.0043
"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.42^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.42^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.42^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.42^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.42^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.42^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.42^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.42^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.42^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,10987,-1)
0^1
"KRN",19,10987,0)
BSDXRPC^WINDOWS SCHEDULING PROCEDURE CALLS^^B^^^^^^^^IHS Windows Scheduling
"KRN",19,10987,1,0)
^19.06^4^4^3100618^^
"KRN",19,10987,1,1,0)
This option hosts RPCs in the BSDX namespace. Windows Scheduling users
"KRN",19,10987,1,2,0)
mustg have access to this option
"KRN",19,10987,1,3,0)
"KRN",19,10987,1,4,0)
in order to use Windows Scheduling.
"KRN",19,10987,99.1)
61545,63078
"KRN",19,10987,"RPC",0)
^19.05P^56^56
"KRN",19,10987,"RPC",1,0)
BSDX ADD ACCESS GROUP ITEM
"KRN",19,10987,"RPC",2,0)
BSDX ADD NEW APPOINTMENT
"KRN",19,10987,"RPC",3,0)
BSDX ADD NEW AVAILABILITY
"KRN",19,10987,"RPC",4,0)
BSDX ADD RES GROUP ITEM
"KRN",19,10987,"RPC",5,0)
BSDX ADD/EDIT ACCESS GROUP
"KRN",19,10987,"RPC",6,0)
BSDX ADD/EDIT ACCESS TYPE
"KRN",19,10987,"RPC",7,0)
BSDX ADD/EDIT RESOURCE
"KRN",19,10987,"RPC",8,0)
BSDX ADD/EDIT RESOURCE GROUP
"KRN",19,10987,"RPC",9,0)
BSDX ADD/EDIT RESOURCEUSER
"KRN",19,10987,"RPC",10,0)
BSDX APPT BLOCKS OVERLAP
"KRN",19,10987,"RPC",11,0)
BSDX CANCEL APPOINTMENT
"KRN",19,10987,"RPC",12,0)
BSDX CANCEL AVAILABILITY
"KRN",19,10987,"RPC",13,0)
BSDX CHECKIN APPOINTMENT
"KRN",19,10987,"RPC",14,0)
BSDX CREATE APPT SCHEDULE
"KRN",19,10987,"RPC",15,0)
BSDX CREATE ASGND SLOT SCHED
"KRN",19,10987,"RPC",16,0)
BSDX DELETE ACCESS GROUP
"KRN",19,10987,"RPC",17,0)
BSDX DELETE ACCESS GROUP ITEM
"KRN",19,10987,"RPC",18,0)
BSDX DELETE RES GROUP ITEM
"KRN",19,10987,"RPC",19,0)
BSDX DELETE RESOURCE GROUP
"KRN",19,10987,"RPC",20,0)
BSDX DELETE RESOURCEUSER
"KRN",19,10987,"RPC",21,0)
BSDX DEPARTMENT RESOURCE
"KRN",19,10987,"RPC",22,0)
BSDX DEPARTMENTS BY USER
"KRN",19,10987,"RPC",23,0)
BSDX EDIT APPOINTMENT
"KRN",19,10987,"RPC",24,0)
BSDX GET ACCESS GROUP TYPES
"KRN",19,10987,"RPC",25,0)
BSDX GET BASIC REG INFO
"KRN",19,10987,"RPC",26,0)
BSDX GROUP RESOURCE
"KRN",19,10987,"RPC",27,0)
BSDX PATIENT APPT DISPLAY
"KRN",19,10987,"RPC",28,0)
BSDX RAISE EVENT
"KRN",19,10987,"RPC",29,0)
BSDX REGISTER EVENT
"KRN",19,10987,"RPC",30,0)
BSDX RESOURCE GROUPS BY USER
"KRN",19,10987,"RPC",31,0)
BSDX RESOURCES
"KRN",19,10987,"RPC",32,0)
BSDX RESOURCES BY USER
"KRN",19,10987,"RPC",33,0)
BSDX SCHEDULE USER
"KRN",19,10987,"RPC",34,0)
BSDX SCHEDULING USER INFO
"KRN",19,10987,"RPC",35,0)
BSDX SEARCH AVAILABILITY
"KRN",19,10987,"RPC",36,0)
BSDX TYPE BLOCKS OVERLAP
"KRN",19,10987,"RPC",37,0)
BSDX UNREGISTER EVENT
"KRN",19,10987,"RPC",38,0)
BSDXPatientLookupRS
"KRN",19,10987,"RPC",39,0)
BSDX SPACEBAR SET
"KRN",19,10987,"RPC",40,0)
BSDX COPY APPOINTMENTS
"KRN",19,10987,"RPC",41,0)
BSDX COPY APPOINTMENT CANCEL
"KRN",19,10987,"RPC",42,0)
BSDX COPY APPOINTMENT STATUS
"KRN",19,10987,"RPC",43,0)
BSDX CLINIC LETTERS
"KRN",19,10987,"RPC",44,0)
BSDX NOSHOW
"KRN",19,10987,"RPC",45,0)
BSDX IM HERE
"KRN",19,10987,"RPC",46,0)
BSDX HOSPITAL LOCATION
"KRN",19,10987,"RPC",47,0)
BSDX CLINIC SETUP
"KRN",19,10987,"RPC",49,0)
BSDX REBOOK LIST
"KRN",19,10987,"RPC",50,0)
BSDX REBOOK CLINIC LIST
"KRN",19,10987,"RPC",51,0)
BSDX REBOOK SET
"KRN",19,10987,"RPC",52,0)
BSDX RESOURCE LETTERS
"KRN",19,10987,"RPC",53,0)
BSDX CANCEL CLINIC LIST
"KRN",19,10987,"RPC",54,0)
BSDX CANCEL AV BY DATE
"KRN",19,10987,"RPC",55,0)
BSDX REBOOK NEXT BLOCK
"KRN",19,10987,"RPC",56,0)
BSDX HOSP LOC PROVIDERS
"KRN",19,10987,"U")
WINDOWS SCHEDULING PROCEDURE C
"KRN",19.1,480,-1)
0^1
"KRN",19.1,480,0)
BSDXZMENU^IHS Windows Scheduling
"KRN",19.1,481,-1)
0^2
"KRN",19.1,481,0)
BSDXZMGR^IHS Windows Scheduling Manager
"KRN",101,4262,-1)
0^2
"KRN",101,4262,0)
BSDX CANCEL APPOINTMENT^BSDX CANCEL APPOINTMENT^^A^^^^^^^^
"KRN",101,4262,1,0)
^^4^4^3040915^
"KRN",101,4262,1,1,0)
IHS protocol called by the PIMS v5.3 Scheduling Event Driver
"KRN",101,4262,1,2,0)
(BSDAM APPOINTMENT EVENTS). This protocol will
"KRN",101,4262,1,3,0)
cancel an appointment in the IHS Windows Scheduling package
"KRN",101,4262,1,4,0)
when the corresponding appointment in RPMS Scheduling is cancelled.
"KRN",101,4262,4)
^^^BSDX CANCEL APPOINTMENT
"KRN",101,4262,20)
I $G(SDAMEVT)=2,$D(^BSDXAPPL) D CANEVT^BSDX08($G(DFN),$G(SDT),$G(SDCL))
"KRN",101,4262,99)
61598,46412
"KRN",101,4263,-1)
0^1
"KRN",101,4263,0)
BSDX ADD APPOINTMENT^BSDX ADD APPOINTMENT^^A^^^^^^^^
"KRN",101,4263,1,0)
^101.06^4^4^3040915^^
"KRN",101,4263,1,1,0)
IHS protocol called by the PIMS v5.3 Scheduling Event Driver
"KRN",101,4263,1,2,0)
(BSDAM APPOINTMENT EVENTS). This protocol will
"KRN",101,4263,1,3,0)
add an appointment in the IHS Windows Scheduling package
"KRN",101,4263,1,4,0)
when the corresponding appointment in RPMS Scheduling is added.
"KRN",101,4263,4)
^^^BSDX ADD APPOINTMENT
"KRN",101,4263,20)
I $G(SDAMEVT)=1,$D(^BSDXAPPL) D ADDEVT^BSDX07($G(DFN),$G(SDT),$G(SDCL),$G(SDDA))
"KRN",101,4263,99)
61598,46412
"KRN",101,4264,-1)
0^4
"KRN",101,4264,0)
BSDX NOSHOW APPOINTMENT^BSDX NOSHOW APPOINTMENT^^A^^^^^^^^
"KRN",101,4264,1,0)
^101.06^4^4^3040915^^
"KRN",101,4264,1,1,0)
IHS protocol called by the PIMS v5.3 Scheduling Event Driver
"KRN",101,4264,1,2,0)
(BSDAM APPOINTMENT EVENTS). This protocol will
"KRN",101,4264,1,3,0)
no-show an appointment in the IHS Windows Scheduling package
"KRN",101,4264,1,4,0)
when the corresponding appointment in RPMS Scheduling is no-showed.
"KRN",101,4264,4)
^^^BSDX NOSHOW APPOINTMENT
"KRN",101,4264,20)
I $G(SDAMEVT)=3,$D(^BSDXAPPL) D NOSEVT^BSDX31($G(DFN),$G(SDT),$G(SDCL))
"KRN",101,4264,99)
61598,46412
"KRN",101,4265,-1)
0^3
"KRN",101,4265,0)
BSDX CHECKIN APPOINTMENT^BSDX CHECKIN APPOINTMENT^^A^^^^^^^^
"KRN",101,4265,1,0)
^101.06^4^4^3040915^^^
"KRN",101,4265,1,1,0)
IHS protocol called by the PIMS v5.3 Scheduling Event Driver
"KRN",101,4265,1,2,0)
(BSDAM APPOINTMENT EVENTS). This protocol will
"KRN",101,4265,1,3,0)
check in an appointment in the IHS Windows Scheduling package
"KRN",101,4265,1,4,0)
when the corresponding appointment in RPMS Scheduling is checked in.
"KRN",101,4265,4)
^^^BSDX CHECKIN APPOINTMENT
"KRN",101,4265,20)
I $G(SDAMEVT)=4,$D(^BSDXAPPL) D CHKEVT^BSDX25($G(DFN),$G(SDT),$G(SDCL))
"KRN",101,4265,99)
61598,46412
"KRN",8994,2440,-1)
0^16
"KRN",8994,2440,0)
BSDX RESOURCE GROUPS BY USER^DEPUSR^BSDX01^4
"KRN",8994,2441,-1)
0^22
"KRN",8994,2441,0)
BSDX RESOURCES^RESUSR^BSDX01^4
"KRN",8994,2442,-1)
0^6
"KRN",8994,2442,0)
BSDX CREATE APPT SCHEDULE^CRSCH^BSDX02^4
"KRN",8994,2443,-1)
0^1
"KRN",8994,2443,0)
BSDX ADD NEW APPOINTMENT^APPADD^BSDX07^4
"KRN",8994,2444,-1)
0^4
"KRN",8994,2444,0)
BSDX CANCEL APPOINTMENT^APPDEL^BSDX08^4
"KRN",8994,2445,-1)
0^7
"KRN",8994,2445,0)
BSDX CREATE ASGND SLOT SCHED^CASSCH^BSDX04^4
"KRN",8994,2446,-1)
0^2
"KRN",8994,2446,0)
BSDX ADD NEW AVAILABILITY^AVADD^BSDX12^4
"KRN",8994,2447,-1)
0^5
"KRN",8994,2447,0)
BSDX CANCEL AVAILABILITY^AVDEL^BSDX13^4
"KRN",8994,2448,-1)
0^3
"KRN",8994,2448,0)
BSDX APPT BLOCKS OVERLAP^APBLKOV^BSDX05^4
"KRN",8994,2449,-1)
0^12
"KRN",8994,2449,0)
BSDX TYPE BLOCKS OVERLAP^TPBLKOV^BSDX06^4
"KRN",8994,2450,-1)
0^10
"KRN",8994,2450,0)
BSDX GET BASIC REG INFO^GETREGA^BSDX09^4
"KRN",8994,2451,-1)
0^15
"KRN",8994,2451,0)
BSDX GROUP RESOURCE^DEPRES^BSDX01^4
"KRN",8994,2452,-1)
0^13
"KRN",8994,2452,0)
BSDX ADD/EDIT ACCESS TYPE^ACCTYP^BSDX14^4
"KRN",8994,2453,-1)
0^14
"KRN",8994,2453,0)
BSDX GET ACCESS GROUP TYPES^GRPTYP^BSDX15^4
"KRN",8994,2454,-1)
0^20
"KRN",8994,2454,0)
BSDX ADD/EDIT RESOURCE^RSRC^BSDX16^4
"KRN",8994,2455,-1)
0^19
"KRN",8994,2455,0)
BSDX SCHEDULE USER^SCHUSR^BSDX17^4
"KRN",8994,2456,-1)
0^18
"KRN",8994,2456,0)
BSDX DELETE RESOURCEUSER^DELRU^BSDX18^4
"KRN",8994,2457,-1)
0^17
"KRN",8994,2457,0)
BSDX ADD/EDIT RESOURCEUSER^ADDRU^BSDX18^4
"KRN",8994,2458,-1)
0^21
"KRN",8994,2458,0)
BSDX SCHEDULING USER INFO^SUINFO^BSDX01^4
"KRN",8994,2459,-1)
0^23
"KRN",8994,2459,0)
BSDX ADD/EDIT RESOURCE GROUP^ADDRG^BSDX19^4
"KRN",8994,2460,-1)
0^24
"KRN",8994,2460,0)
BSDX DELETE RESOURCE GROUP^DELRG^BSDX19^4
"KRN",8994,2461,-1)
0^27
"KRN",8994,2461,0)
BSDX DEPARTMENTS BY USER^DEPUSR^BSDX01^4
"KRN",8994,2462,-1)
0^28
"KRN",8994,2462,0)
BSDX RESOURCES BY USER^RESUSR^BSDX01^4
"KRN",8994,2463,-1)
0^26
"KRN",8994,2463,0)
BSDX DEPARTMENT RESOURCE^DEPRES^BSDX01^4
"KRN",8994,2464,-1)
0^25
"KRN",8994,2464,0)
BSDX DELETE RES GROUP ITEM^DELRGI^BSDX20^4
"KRN",8994,2465,-1)
0^30
"KRN",8994,2465,0)
BSDX ADD RES GROUP ITEM^ADDRGI^BSDX20^4
"KRN",8994,2466,-1)
0^31
"KRN",8994,2466,0)
BSDX ADD/EDIT ACCESS GROUP^ADDAG^BSDX21^4
"KRN",8994,2467,-1)
0^32
"KRN",8994,2467,0)
BSDX DELETE ACCESS GROUP^DELAG^BSDX21^4
"KRN",8994,2468,-1)
0^29
"KRN",8994,2468,0)
BSDX ADD ACCESS GROUP ITEM^ADDAGI^BSDX22^4
"KRN",8994,2469,-1)
0^33
"KRN",8994,2469,0)
BSDX DELETE ACCESS GROUP ITEM^DELAGI^BSDX22^4
"KRN",8994,2470,-1)
0^34
"KRN",8994,2470,0)
BSDX REGISTER EVENT^REGEVNT^BSDX23^4
"KRN",8994,2471,-1)
0^35
"KRN",8994,2471,0)
BSDX UNREGISTER EVENT^UNREG^BSDX23^4
"KRN",8994,2472,-1)
0^36
"KRN",8994,2472,0)
BSDX RAISE EVENT^RAISEVNT^BSDX23^4
"KRN",8994,2473,-1)
0^37
"KRN",8994,2473,0)
BSDX SEARCH AVAILABILITY^SEARCH^BSDX24^4
"KRN",8994,2474,-1)
0^38
"KRN",8994,2474,0)
BSDX CHECKIN APPOINTMENT^CHECKIN^BSDX25^4
"KRN",8994,2475,-1)
0^39
"KRN",8994,2475,0)
BSDX EDIT APPOINTMENT^EDITAPT^BSDX26^4
"KRN",8994,2476,-1)
0^40
"KRN",8994,2476,0)
BSDX PATIENT APPT DISPLAY^PADISP^BSDX27^4
"KRN",8994,2477,-1)
0^41
"KRN",8994,2477,0)
BSDXPatientLookupRS^PTLOOKRS^BSDX28^1
"KRN",8994,2478,-1)
0^42
"KRN",8994,2478,0)
BSDX SPACEBAR SET^SPACE^BSDX30^4
"KRN",8994,2479,-1)
0^45
"KRN",8994,2479,0)
BSDX COPY APPOINTMENTS^BSDXCP^BSDX29^4
"KRN",8994,2480,-1)
0^44
"KRN",8994,2480,0)
BSDX COPY APPOINTMENT STATUS^CPSTAT^BSDX29^4
"KRN",8994,2481,-1)
0^43
"KRN",8994,2481,0)
BSDX COPY APPOINTMENT CANCEL^CPCANC^BSDX29^4
"KRN",8994,2482,-1)
0^46
"KRN",8994,2482,0)
BSDX CLINIC LETTERS^CLDISP^BSDX27^4
"KRN",8994,2483,-1)
0^47
"KRN",8994,2483,0)
BSDX NOSHOW^NOSHOW^BSDX31^4
"KRN",8994,2484,-1)
0^48
"KRN",8994,2484,0)
BSDX IM HERE^IMHERE^BSDX31^1
"KRN",8994,2484,1,0)
^^2^2^3040304^
"KRN",8994,2484,1,1,0)
Returns a simple value to client. Used to establish continued existence
"KRN",8994,2484,1,2,0)
of the client to the server; resets the server READ timeout.
"KRN",8994,2485,-1)
0^49
"KRN",8994,2485,0)
BSDX HOSPITAL LOCATION^HOSPLOC^BSDX32^4
"KRN",8994,2486,-1)
0^50
"KRN",8994,2486,0)
BSDX CLINIC SETUP^CLNSET^BSDX32^4
"KRN",8994,2487,-1)
0^51
"KRN",8994,2487,0)
BSDX REBOOK LIST^RBLETT^BSDX34^4
"KRN",8994,2488,-1)
0^52
"KRN",8994,2488,0)
BSDX REBOOK CLINIC LIST^RBCLIN^BSDX34^4
"KRN",8994,2489,-1)
0^53
"KRN",8994,2489,0)
BSDX REBOOK SET^SETRBK^BSDX33^4
"KRN",8994,2490,-1)
0^54
"KRN",8994,2490,0)
BSDX RESOURCE LETTERS^RSRCLTR^BSDX35^4
"KRN",8994,2491,-1)
0^55
"KRN",8994,2491,0)
BSDX CANCEL CLINIC LIST^CANCLIN^BSDX34^4
"KRN",8994,2492,-1)
0^56
"KRN",8994,2492,0)
BSDX CANCEL AV BY DATE^AVDELDT^BSDX13^4
"KRN",8994,2493,-1)
0^57
"KRN",8994,2493,0)
BSDX REBOOK NEXT BLOCK^RBNEXT^BSDX33^4
"KRN",8994,2494,-1)
0^58
"KRN",8994,2494,0)
BSDX EHR PATIENT^EHRPT^BSDX30^4
"KRN",8994,2501,-1)
0^59
"KRN",8994,2501,0)
BSDX HOSP LOC PROVIDERS^P^BSDXGPRV^4
"MBREQ")
0
"ORD",3,19.1)
19.1;3;1;;KEY^XPDTA1;;;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",211,-1)
1^1
"PKG",211,0)
IHS Windows Scheduling^BSDX^IHS Windows Scheduling Extensions
"PKG",211,20,0)
^9.402P^^
"PKG",211,22,0)
^9.49I^1^1
"PKG",211,22,1,0)
1.42^3101207
"PKG",211,22,1,1,0)
^^1^1^3101207
"PKG",211,22,1,1,1,0)
Clinical Scheduling M Server support routines, files, options and RPCs.
"PKG",211,"VERSION")
1.42
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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","<fmdate>","<fmdate>") ZW RES
"RTN","BSDX04",47,0)
;BSDX CREATE ASGND SLOT SCHED^ROGERS,BUCK^<fmdate>^<fmdate>^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 BSDXBS<BSDXSTART D
"RTN","BSDX04",91,0)
. . S Y=BSDXSTART
"RTN","BSDX04",92,0)
. . X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX04",93,0)
. . S $P(^BSDXTMP($J,2),U,1)=Y
"RTN","BSDX04",94,0)
. ;
"RTN","BSDX04",95,0)
. ;If last block end time < input end time then pad end with new block
"RTN","BSDX04",96,0)
. I BSDXPEND<BSDXEND D
"RTN","BSDX04",97,0)
. . S Y=BSDXPEND X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX04",98,0)
. . S BSDXTMP=Y
"RTN","BSDX04",99,0)
. . S Y=BSDXEND X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX04",100,0)
. . S BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$C(30)
"RTN","BSDX04",101,0)
. . S ^BSDXTMP($J,BSDXI-1)=BSDXTMP
"RTN","BSDX04",102,0)
. ;
"RTN","BSDX04",103,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX04",104,0)
Q
"RTN","BSDX04",105,0)
;
"RTN","BSDX04",106,0)
STRES(BSDXRESN,BSDXRESD) ;
"RTN","BSDX04",107,0)
;BSDXRESD is a Resource ID
"RTN","BSDX04",108,0)
;$O THRU "ARSCT" XREF OF ^BSDXAB
"RTN","BSDX04",109,0)
S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
"RTN","BSDX04",110,0)
S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
"RTN","BSDX04",111,0)
F S BSDXS=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND 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^B10878471
"RTN","BSDX05",1,0)
BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 5:36pm
"RTN","BSDX05",2,0)
;;1.42;BSDX;;Dec 07, 2010;Build 9
"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)
; UJO/SMH - Dec 8 2010: In STCOMM, the logic was that an appointment
"RTN","BSDX05",7,0)
; that was a walk-in didn't count towards slot calculations.
"RTN","BSDX05",8,0)
; I checked PIMS, and Walk-ins do indeed count towards slot calculations.
"RTN","BSDX05",9,0)
; Therefore, I commented this line out:
"RTN","BSDX05",10,0)
; ;Q:$P(BSDXNOD,U,13)="y" ;WALKIN
"RTN","BSDX05",11,0)
;
"RTN","BSDX05",12,0)
APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES) ;EP
"RTN","BSDX05",13,0)
;Called by BSDX APPT BLOCKS OVERLAP
"RTN","BSDX05",14,0)
; July 11 2010 - pass FM Dates for Start and End rather than US Dates
"RTN","BSDX05",15,0)
;(Duplicates old qryAppointmentBlocksOverlapB)
"RTN","BSDX05",16,0)
;BSDXRES is resource name
"RTN","BSDX05",17,0)
;
"RTN","BSDX05",18,0)
;Test lines:
"RTN","BSDX05",19,0)
;D APBLKOV^BSDX05(.RES,"11-8-2000","11-8-2004","WHITT") ZW RES
"RTN","BSDX05",20,0)
;BSDX APPT BLOCKS OVERLAP^11-8-2000^11-8-2004^WHITT
"RTN","BSDX05",21,0)
;S ^HW("BSDXD05")=BSDXSTART_U_BSDXEND_U_BSDXRES
"RTN","BSDX05",22,0)
;
"RTN","BSDX05",23,0)
N BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXAD,BSDXNOD
"RTN","BSDX05",24,0)
K ^BSDXTMP($J)
"RTN","BSDX05",25,0)
S BSDXERR=""
"RTN","BSDX05",26,0)
S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX05",27,0)
S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME"_$C(30)
"RTN","BSDX05",28,0)
D
"RTN","BSDX05",29,0)
. S BSDXBS=0
"RTN","BSDX05",30,0)
. S BSDXEND=BSDXEND+.9999 ;Go to end of day
"RTN","BSDX05",31,0)
. S BSDXRESN=BSDXRES
"RTN","BSDX05",32,0)
. Q:BSDXRESN=""
"RTN","BSDX05",33,0)
. Q:'$D(^BSDXRES("B",BSDXRESN))
"RTN","BSDX05",34,0)
. S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
"RTN","BSDX05",35,0)
. Q:'+BSDXRESD
"RTN","BSDX05",36,0)
. Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD))
"RTN","BSDX05",37,0)
. D STRES(BSDXRESD,BSDXSTART,BSDXEND)
"RTN","BSDX05",38,0)
. Q
"RTN","BSDX05",39,0)
;
"RTN","BSDX05",40,0)
S BSDXI=$G(BSDXI)+1
"RTN","BSDX05",41,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX05",42,0)
Q
"RTN","BSDX05",43,0)
;
"RTN","BSDX05",44,0)
STRES(BSDXRESD,BSDXSTART,BSDXEND) ;
"RTN","BSDX05",45,0)
;$O THRU "ARSRC" XREF OF ^BSDXAPPT
"RTN","BSDX05",46,0)
;Start at the beginning of the day -- appts can't overlap days
"RTN","BSDX05",47,0)
S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
"RTN","BSDX05",48,0)
S BSDXI=0
"RTN","BSDX05",49,0)
F S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D
"RTN","BSDX05",50,0)
. S BSDXAD=0 F S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D STCOMM(BSDXAD) ;BSDXAD Is the AppointmentID
"RTN","BSDX05",51,0)
. Q
"RTN","BSDX05",52,0)
Q
"RTN","BSDX05",53,0)
;
"RTN","BSDX05",54,0)
STCOMM(BSDXAD) ;
"RTN","BSDX05",55,0)
S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
"RTN","BSDX05",56,0)
Q:'$D(^BSDXAPPT(BSDXAD,0))
"RTN","BSDX05",57,0)
S BSDXNOD=^BSDXAPPT(BSDXAD,0)
"RTN","BSDX05",58,0)
Q:$P(BSDXNOD,U,10)=1 ;NO-SHOW Flag
"RTN","BSDX05",59,0)
Q:$P(BSDXNOD,U,12)]"" ;CANCELLED APPT
"RTN","BSDX05",60,0)
; Q:$P(BSDXNOD,U,13)="y" ;WALKIN -- new in V 1.42. See top comments.
"RTN","BSDX05",61,0)
S BSDXNSTART=$P(BSDXNOD,U)
"RTN","BSDX05",62,0)
S BSDXNEND=$P(BSDXNOD,U,2)
"RTN","BSDX05",63,0)
I BSDXNEND'>BSDXSTART Q ;End is less than start
"RTN","BSDX05",64,0)
S Y=BSDXNSTART X ^DD("DD") S BSDXNSTART=$TR(Y,"@"," ")
"RTN","BSDX05",65,0)
S Y=BSDXNEND X ^DD("DD") S BSDXNEND=$TR(Y,"@"," ")
"RTN","BSDX05",66,0)
S BSDXI=BSDXI+1
"RTN","BSDX05",67,0)
S ^BSDXTMP($J,BSDXI)=BSDXNSTART_U_BSDXNEND_$C(30)
"RTN","BSDX05",68,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.42;BSDX;;Dec 07, 2010;Build 9
"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^B188811791
"RTN","BSDX07",1,0)
BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:31pm
"RTN","BSDX07",2,0)
;;1.42;BSDX;;Dec 07, 2010;Build 9
"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)
; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments
"RTN","BSDX07",8,0)
; thanks to Rick Marshall and Zach Gonzalez at Oroville.
"RTN","BSDX07",9,0)
; v1.42 Oct 30 2010 - Extensive refactoring.
"RTN","BSDX07",10,0)
;
"RTN","BSDX07",11,0)
; Error Reference:
"RTN","BSDX07",12,0)
; -1: Patient Record is locked. This means something is wrong!!!!
"RTN","BSDX07",13,0)
; -2: Start Time is not a valid Fileman date
"RTN","BSDX07",14,0)
; -3: End Time is not a valid Fileman date
"RTN","BSDX07",15,0)
; -4: End Time does not have time inside of it.
"RTN","BSDX07",16,0)
; -5: BSDXPATID is not numeric
"RTN","BSDX07",17,0)
; -6: Patient Does not exist in ^DPT
"RTN","BSDX07",18,0)
; -7: Resource Name does not exist in B index of BSDX RESOURCE
"RTN","BSDX07",19,0)
; -8: Resouce doesn't exist in ^BSDXRES
"RTN","BSDX07",20,0)
; -9: Couldn't add appointment to BSDX APPOINTMENT
"RTN","BSDX07",21,0)
; -10: Couldn't add appointment to files 2 and/or 44
"RTN","BSDX07",22,0)
; -100: Mumps Error
"RTN","BSDX07",23,0)
"RTN","BSDX07",24,0)
APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP
"RTN","BSDX07",25,0)
;Entry point for debugging
"RTN","BSDX07",26,0)
D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
"RTN","BSDX07",27,0)
Q
"RTN","BSDX07",28,0)
;
"RTN","BSDX07",29,0)
UT ; Unit Tests
"RTN","BSDX07",30,0)
N ZZZ
"RTN","BSDX07",31,0)
; Test for bad start date
"RTN","BSDX07",32,0)
D APPADD(.ZZZ,2100123,3100123.3,2,"Dr Office",30,"Sam's Note",1)
"RTN","BSDX07",33,0)
I +$P(^BSDXTMP($J,1),U,2)'=-2 W "Error in -2",!
"RTN","BSDX07",34,0)
; Test for bad end date
"RTN","BSDX07",35,0)
D APPADD(.ZZZ,3100123,2100123.3,2,"Dr Office",30,"Sam's Note",1)
"RTN","BSDX07",36,0)
I +$P(^BSDXTMP($J,1),U,2)'=-3 W "Error in -3",!
"RTN","BSDX07",37,0)
; Test for end date without time
"RTN","BSDX07",38,0)
D APPADD(.ZZZ,3100123.1,3100123,2,"Dr Office",30,"Sam's Note",1)
"RTN","BSDX07",39,0)
I +$P(^BSDXTMP($J,1),U,2)'=-4 W "Error in -4",!
"RTN","BSDX07",40,0)
; Test for mumps error
"RTN","BSDX07",41,0)
S bsdxdie=1
"RTN","BSDX07",42,0)
D APPADD(.ZZZ,3100123.09,3100123.093,2,"Dr Office",30,"Sam's Note",1)
"RTN","BSDX07",43,0)
I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",!
"RTN","BSDX07",44,0)
K bsdxdie
"RTN","BSDX07",45,0)
; Test for TRESTART
"RTN","BSDX07",46,0)
s bsdxrestart=1
"RTN","BSDX07",47,0)
D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
"RTN","BSDX07",48,0)
I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",!
"RTN","BSDX07",49,0)
k bsdxrestart
"RTN","BSDX07",50,0)
; Test for non-numeric patient
"RTN","BSDX07",51,0)
D APPADD(.ZZZ,3100123.09,3100123.093,"CAT,DOG","Dr Office",30,"Sam's Note",1)
"RTN","BSDX07",52,0)
I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",!
"RTN","BSDX07",53,0)
; Test for a non-existent patient
"RTN","BSDX07",54,0)
D APPADD(.ZZZ,3100123.09,3100123.093,8989898989,"Dr Office",30,"Sam's Note",1)
"RTN","BSDX07",55,0)
I +$P(^BSDXTMP($J,1),U,2)'=-6 W "Error in -6",!
"RTN","BSDX07",56,0)
; Test for a non-existent resource name
"RTN","BSDX07",57,0)
D APPADD(.ZZZ,3100123.09,3100123.093,3,"lkajsflkjsadf",30,"Sam's Note",1)
"RTN","BSDX07",58,0)
I +$P(^BSDXTMP($J,1),U,2)'=-7 W "Error in -7",!
"RTN","BSDX07",59,0)
; Test for corrupted resource
"RTN","BSDX07",60,0)
; Can't test for -8 since it requires DB corruption
"RTN","BSDX07",61,0)
; Test for inability to add appointment to BSDX Appointment
"RTN","BSDX07",62,0)
; Also requires something wrong in the DB
"RTN","BSDX07",63,0)
; Test for inability to add appointment to 2,44
"RTN","BSDX07",64,0)
; Test by creating a duplicate appointment
"RTN","BSDX07",65,0)
D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
"RTN","BSDX07",66,0)
D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
"RTN","BSDX07",67,0)
I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",!
"RTN","BSDX07",68,0)
; Test for normality:
"RTN","BSDX07",69,0)
D APPADD(.ZZZ,3110123.09,3110123.093,3,"Dr Office",30,"Sam's Note",1)
"RTN","BSDX07",70,0)
; Does Appt exist?
"RTN","BSDX07",71,0)
N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDX07",72,0)
I 'APPID W "Error Making Appt-1" QUIT
"RTN","BSDX07",73,0)
I +^BSDXAPPT(APPID,0)'=3110123.09 W "Error Making Appt-2"
"RTN","BSDX07",74,0)
I '$D(^DPT(3,"S",3110123.09)) W "Error Making Appt-3"
"RTN","BSDX07",75,0)
I '$D(^SC(2,"S",3110123.09)) W "Error Making Appt-4"
"RTN","BSDX07",76,0)
QUIT
"RTN","BSDX07",77,0)
;
"RTN","BSDX07",78,0)
APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP
"RTN","BSDX07",79,0)
;Called by RPC: BSDX ADD NEW APPOINTMENT
"RTN","BSDX07",80,0)
;
"RTN","BSDX07",81,0)
;Add new appointment to 3 files
"RTN","BSDX07",82,0)
; - BSDX APPOINTMENT
"RTN","BSDX07",83,0)
; - Hosp Location Appointment SubSubfile if Resource is linked to clinic
"RTN","BSDX07",84,0)
; - Patient Appointment Subfile if Resource is linked to clinic
"RTN","BSDX07",85,0)
;
"RTN","BSDX07",86,0)
;Paramters:
"RTN","BSDX07",87,0)
;BSDXY: Global Return (RPC must be set to Global Array)
"RTN","BSDX07",88,0)
;BSDXSTART: FM Start Date
"RTN","BSDX07",89,0)
;BSDXEND: FM End Date
"RTN","BSDX07",90,0)
;BSDXPATID: Patient DFN
"RTN","BSDX07",91,0)
;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN)
"RTN","BSDX07",92,0)
;BSDXLEN is the appointment duration in minutes
"RTN","BSDX07",93,0)
;BSDXNOTE is the Appiontment Note
"RTN","BSDX07",94,0)
;BSDXATID is used for 2 purposes:
"RTN","BSDX07",95,0)
; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
"RTN","BSDX07",96,0)
; if BSDXATID = a number, then it is the access type id (used for rebooking)
"RTN","BSDX07",97,0)
;
"RTN","BSDX07",98,0)
;Return:
"RTN","BSDX07",99,0)
; ADO.net Recordset having fields:
"RTN","BSDX07",100,0)
; AppointmentID and ErrorNumber
"RTN","BSDX07",101,0)
;
"RTN","BSDX07",102,0)
;Test lines:
"RTN","BSDX07",103,0)
;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
"RTN","BSDX07",104,0)
;
"RTN","BSDX07",105,0)
; Return Array; set Return and clear array
"RTN","BSDX07",106,0)
S BSDXY=$NA(^BSDXTMP($J))
"RTN","BSDX07",107,0)
K ^BSDXTMP($J)
"RTN","BSDX07",108,0)
; $ET
"RTN","BSDX07",109,0)
N $ET S $ET="G ETRAP^BSDX07"
"RTN","BSDX07",110,0)
; Counter
"RTN","BSDX07",111,0)
N BSDXI S BSDXI=0
"RTN","BSDX07",112,0)
; Lock BSDX node, only to synchronize access to the globals.
"RTN","BSDX07",113,0)
; It's not expected that the error will ever happen as no filing
"RTN","BSDX07",114,0)
; is supposed to take 5 seconds.
"RTN","BSDX07",115,0)
L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
"RTN","BSDX07",116,0)
; Header Node
"RTN","BSDX07",117,0)
S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30)
"RTN","BSDX07",118,0)
;Restartable Transaction; restore paramters when starting.
"RTN","BSDX07",119,0)
; (Params restored are what's passed here + BSDXI)
"RTN","BSDX07",120,0)
TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXI):T="BSDX ADD NEW APPOINTMENT^BSDX07"
"RTN","BSDX07",121,0)
;
"RTN","BSDX07",122,0)
; Turn off SDAM APPT PROTOCOL BSDX Entries
"RTN","BSDX07",123,0)
N BSDXNOEV
"RTN","BSDX07",124,0)
S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
"RTN","BSDX07",125,0)
;
"RTN","BSDX07",126,0)
; Set Error Message to be empty
"RTN","BSDX07",127,0)
N BSDXERR S BSDXERR=0
"RTN","BSDX07",128,0)
;
"RTN","BSDX07",129,0)
;;;test for error inside transaction. See if %ZTER works
"RTN","BSDX07",130,0)
I $G(bsdxdie) S X=1/0
"RTN","BSDX07",131,0)
;;;test
"RTN","BSDX07",132,0)
;;;test for TRESTART
"RTN","BSDX07",133,0)
I $G(bsdxrestart) K bsdxrestart TRESTART
"RTN","BSDX07",134,0)
;;;test
"RTN","BSDX07",135,0)
;
"RTN","BSDX07",136,0)
; -- Start and End Date Processing --
"RTN","BSDX07",137,0)
; If C# sends the dates with extra zeros, remove them
"RTN","BSDX07",138,0)
S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
"RTN","BSDX07",139,0)
; Are the dates valid? Must be FM Dates > than 2010
"RTN","BSDX07",140,0)
I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q
"RTN","BSDX07",141,0)
I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q
"RTN","BSDX07",142,0)
; If Ending date doesn't have a time, this is an error
"RTN","BSDX07",143,0)
I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q
"RTN","BSDX07",144,0)
; If the Start Date is greater than the end date, swap dates
"RTN","BSDX07",145,0)
N BSDXTMP
"RTN","BSDX07",146,0)
I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
"RTN","BSDX07",147,0)
;
"RTN","BSDX07",148,0)
; Check if the patient exists:
"RTN","BSDX07",149,0)
; - DFN valid number?
"RTN","BSDX07",150,0)
; - Valid Patient in file 2?
"RTN","BSDX07",151,0)
I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q
"RTN","BSDX07",152,0)
I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q
"RTN","BSDX07",153,0)
;
"RTN","BSDX07",154,0)
;Validate Resource entry
"RTN","BSDX07",155,0)
I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q
"RTN","BSDX07",156,0)
N BSDXRESD ; Resource IEN
"RTN","BSDX07",157,0)
S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
"RTN","BSDX07",158,0)
N BSDXRNOD ; Resouce zero node
"RTN","BSDX07",159,0)
S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
"RTN","BSDX07",160,0)
I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q
"RTN","BSDX07",161,0)
;
"RTN","BSDX07",162,0)
; Walk-in (Unscheduled) Appointment?
"RTN","BSDX07",163,0)
N BSDXWKIN S BSDXWKIN=0
"RTN","BSDX07",164,0)
I BSDXATID="WALKIN" S BSDXWKIN=1
"RTN","BSDX07",165,0)
; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number
"RTN","BSDX07",166,0)
I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID=""
"RTN","BSDX07",167,0)
;
"RTN","BSDX07",168,0)
; Done with all checks, let's make appointment in BSDX APPOINTMENT
"RTN","BSDX07",169,0)
N BSDXAPPTID
"RTN","BSDX07",170,0)
S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID)
"RTN","BSDX07",171,0)
I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q
"RTN","BSDX07",172,0)
I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
"RTN","BSDX07",173,0)
;
"RTN","BSDX07",174,0)
; Then Create Subfiles in 2/44 Appointment
"RTN","BSDX07",175,0)
N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4) ; Hosp Location IEN
"RTN","BSDX07",176,0)
; Only if we have a valid Hosp Loc can we make an appointment
"RTN","BSDX07",177,0)
I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: ~MAKE^BSDAPI returned error code: "_BSDXERR) Q
"RTN","BSDX07",178,0)
. N BSDXC
"RTN","BSDX07",179,0)
. S BSDXC("PAT")=BSDXPATID
"RTN","BSDX07",180,0)
. S BSDXC("CLN")=BSDXSCD
"RTN","BSDX07",181,0)
. S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins
"RTN","BSDX07",182,0)
. S:BSDXWKIN BSDXC("TYP")=4
"RTN","BSDX07",183,0)
. S BSDXC("ADT")=BSDXSTART
"RTN","BSDX07",184,0)
. S BSDXC("LEN")=BSDXLEN
"RTN","BSDX07",185,0)
. S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field
"RTN","BSDX07",186,0)
. S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI
"RTN","BSDX07",187,0)
. S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note
"RTN","BSDX07",188,0)
. S BSDXC("USR")=DUZ
"RTN","BSDX07",189,0)
. S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
"RTN","BSDX07",190,0)
. Q:BSDXERR
"RTN","BSDX07",191,0)
. ;Update RPMS Clinic availability
"RTN","BSDX07",192,0)
. D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)
"RTN","BSDX07",193,0)
. Q
"RTN","BSDX07",194,0)
;
"RTN","BSDX07",195,0)
;Return Recordset
"RTN","BSDX07",196,0)
TCOMMIT
"RTN","BSDX07",197,0)
L -^BSDXAPPT(BSDXPATID)
"RTN","BSDX07",198,0)
S BSDXI=BSDXI+1
"RTN","BSDX07",199,0)
S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
"RTN","BSDX07",200,0)
S BSDXI=BSDXI+1
"RTN","BSDX07",201,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX07",202,0)
Q
"RTN","BSDX07",203,0)
BSDXDEL(BSDXAPPTID) ;Deletes appointment BSDXAPPTID from BSDXAPPOINTMETN
"RTN","BSDX07",204,0)
N DA,DIK
"RTN","BSDX07",205,0)
S DIK="^BSDXAPPT(",DA=BSDXAPPTID
"RTN","BSDX07",206,0)
D ^DIK
"RTN","BSDX07",207,0)
Q
"RTN","BSDX07",208,0)
;
"RTN","BSDX07",209,0)
STRIP(BSDXZ) ;Replace control characters with spaces
"RTN","BSDX07",210,0)
N BSDXI
"RTN","BSDX07",211,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",212,0)
Q BSDXZ
"RTN","BSDX07",213,0)
;
"RTN","BSDX07",214,0)
BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID) ;ADD BSDX APPOINTMENT ENTRY
"RTN","BSDX07",215,0)
;Returns ien in BSDXAPPT or 0 if failed
"RTN","BSDX07",216,0)
;Create entry in BSDX APPOINTMENT
"RTN","BSDX07",217,0)
N BSDXAPPTID
"RTN","BSDX07",218,0)
S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
"RTN","BSDX07",219,0)
S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
"RTN","BSDX07",220,0)
S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
"RTN","BSDX07",221,0)
S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
"RTN","BSDX07",222,0)
S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
"RTN","BSDX07",223,0)
S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
"RTN","BSDX07",224,0)
S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
"RTN","BSDX07",225,0)
S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
"RTN","BSDX07",226,0)
N BSDXIEN,BSDXMSG
"RTN","BSDX07",227,0)
D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX07",228,0)
S BSDXAPPTID=+$G(BSDXIEN(1))
"RTN","BSDX07",229,0)
Q BSDXAPPTID
"RTN","BSDX07",230,0)
;
"RTN","BSDX07",231,0)
BSDXWP(BSDXAPPTID,BSDXNOTE) ;
"RTN","BSDX07",232,0)
;Add WP field
"RTN","BSDX07",233,0)
I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
"RTN","BSDX07",234,0)
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
"RTN","BSDX07",235,0)
I $D(BSDXNOTE(.5)) D
"RTN","BSDX07",236,0)
. D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG")
"RTN","BSDX07",237,0)
Q
"RTN","BSDX07",238,0)
;
"RTN","BSDX07",239,0)
ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP
"RTN","BSDX07",240,0)
;Called by BSDX ADD APPOINTMENT protocol
"RTN","BSDX07",241,0)
;BSDXSC=IEN of clinic in ^SC
"RTN","BSDX07",242,0)
;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
"RTN","BSDX07",243,0)
;
"RTN","BSDX07",244,0)
N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES
"RTN","BSDX07",245,0)
Q:+$G(BSDXNOEV)
"RTN","BSDX07",246,0)
I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
"RTN","BSDX07",247,0)
E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0))
"RTN","BSDX07",248,0)
Q:'+$G(BSDXRES)
"RTN","BSDX07",249,0)
S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0))
"RTN","BSDX07",250,0)
Q:BSDXNOD=""
"RTN","BSDX07",251,0)
S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0))
"RTN","BSDX07",252,0)
S BSDXWKIN=""
"RTN","BSDX07",253,0)
S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile
"RTN","BSDX07",254,0)
S BSDXLEN=$P(BSDXNOD,U,2)
"RTN","BSDX07",255,0)
Q:'+BSDXLEN
"RTN","BSDX07",256,0)
S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0)
"RTN","BSDX07",257,0)
S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN)
"RTN","BSDX07",258,0)
Q:'+BSDXAPPTID
"RTN","BSDX07",259,0)
S BSDXNOTE=$P(BSDXNOD,U,4)
"RTN","BSDX07",260,0)
I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
"RTN","BSDX07",261,0)
D ADDEVT3(BSDXRES)
"RTN","BSDX07",262,0)
Q
"RTN","BSDX07",263,0)
;
"RTN","BSDX07",264,0)
ADDEVT3(BSDXRES) ;
"RTN","BSDX07",265,0)
;Call RaiseEvent to notify GUI clients
"RTN","BSDX07",266,0)
N BSDXRESN
"RTN","BSDX07",267,0)
S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
"RTN","BSDX07",268,0)
Q:BSDXRESN=""
"RTN","BSDX07",269,0)
S BSDXRESN=$P(BSDXRESN,"^")
"RTN","BSDX07",270,0)
;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
"RTN","BSDX07",271,0)
D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
"RTN","BSDX07",272,0)
Q
"RTN","BSDX07",273,0)
;
"RTN","BSDX07",274,0)
ERR(BSDXI,BSDXERR) ;Error processing
"RTN","BSDX07",275,0)
S BSDXI=BSDXI+1
"RTN","BSDX07",276,0)
S BSDXERR=$TR(BSDXERR,"^","~")
"RTN","BSDX07",277,0)
I $TL>0 TROLLBACK
"RTN","BSDX07",278,0)
S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
"RTN","BSDX07",279,0)
S BSDXI=BSDXI+1
"RTN","BSDX07",280,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX07",281,0)
L -^BSDXAPPT(BSDXPATID)
"RTN","BSDX07",282,0)
Q
"RTN","BSDX07",283,0)
;
"RTN","BSDX07",284,0)
ETRAP ;EP Error trap entry
"RTN","BSDX07",285,0)
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
"RTN","BSDX07",286,0)
; Rollback, otherwise ^XTER will be empty from future rollback
"RTN","BSDX07",287,0)
I $TL>0 TROLLBACK
"RTN","BSDX07",288,0)
D ^%ZTER
"RTN","BSDX07",289,0)
S $EC="" ; Clear Error
"RTN","BSDX07",290,0)
; Log error message and send to client
"RTN","BSDX07",291,0)
I '$D(BSDXI) N BSDXI S BSDXI=0
"RTN","BSDX07",292,0)
D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
"RTN","BSDX07",293,0)
Q
"RTN","BSDX07",294,0)
;
"RTN","BSDX07",295,0)
DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
"RTN","BSDX07",296,0)
;
"RTN","BSDX07",297,0)
DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y)
"RTN","BSDX07",298,0)
F %=%:-1:281 S Y=%#4=1+1+Y
"RTN","BSDX07",299,0)
S Y=$E(X,6,7)+Y#7
"RTN","BSDX07",300,0)
Q
"RTN","BSDX07",301,0)
;
"RTN","BSDX07",302,0)
AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update RPMS Clinic availability
"RTN","BSDX07",303,0)
;SEE SDM1
"RTN","BSDX07",304,0)
N Y,DFN
"RTN","BSDX07",305,0)
N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG
"RTN","BSDX07",306,0)
N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I
"RTN","BSDX07",307,0)
S Y=BSDXSCD,DFN=BSDXPATID
"RTN","BSDX07",308,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",309,0)
;Determine maximum days for scheduling
"RTN","BSDX07",310,0)
S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365
"RTN","BSDX07",311,0)
S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1))
"RTN","BSDX07",312,0)
S SDDATE=BSDXSTART
"RTN","BSDX07",313,0)
S SDSDATE=SDDATE,SDDATE=SDDATE\1
"RTN","BSDX07",314,0)
1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC
"RTN","BSDX07",315,0)
Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC
"RTN","BSDX07",316,0)
S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2)
"RTN","BSDX07",317,0)
S X2=SDEDT D C^%DTC S SDEDT=X
"RTN","BSDX07",318,0)
S Y=BSDXSTART
"RTN","BSDX07",319,0)
EN1 S (X,SD)=Y,SM=0 D DOW
"RTN","BSDX07",320,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",321,0)
S S=BSDXLEN
"RTN","BSDX07",322,0)
;Check if BSDXLEN evenly divisible by appointment length
"RTN","BSDX07",323,0)
S RPMSL=$P(SL,U)
"RTN","BSDX07",324,0)
I BSDXLEN<RPMSL S BSDXLEN=RPMSL
"RTN","BSDX07",325,0)
I BSDXLEN#RPMSL'=0 D
"RTN","BSDX07",326,0)
. S BSDXINC=BSDXLEN\RPMSL
"RTN","BSDX07",327,0)
. S BSDXINC=BSDXINC+1
"RTN","BSDX07",328,0)
. S BSDXLEN=RPMSL*BSDXINC
"RTN","BSDX07",329,0)
S SL=S_U_$P(SL,U,2,99)
"RTN","BSDX07",330,0)
SC S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9
"RTN","BSDX07",331,0)
L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC
"RTN","BSDX07",332,0)
S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1)
"RTN","BSDX07",333,0)
S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST
"RTN","BSDX07",334,0)
I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q
"RTN","BSDX07",335,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",336,0)
;
"RTN","BSDX07",337,0)
SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP
"RTN","BSDX07",338,0)
S SDNOT=1
"RTN","BSDX07",339,0)
S ABORT=0
"RTN","BSDX07",340,0)
F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT
"RTN","BSDX07",341,0)
. S ST=$E(S,I+1) S:ST="" ST=" "
"RTN","BSDX07",342,0)
. S Y=$E(STR,$F(STR,ST)-2)
"RTN","BSDX07",343,0)
. I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q
"RTN","BSDX07",344,0)
. I Y="" S ABORT=1 Q
"RTN","BSDX07",345,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",346,0)
. Q
"RTN","BSDX07",347,0)
S ^SC(SC,"ST",$P(SD,"."),1)=S
"RTN","BSDX07",348,0)
L -^SC(SC,"ST",$P(SD,"."),1)
"RTN","BSDX07",349,0)
Q
"RTN","BSDX08")
0^8^B140041473
"RTN","BSDX08",1,0)
BSDX08 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:35pm
"RTN","BSDX08",2,0)
;;1.42;BSDX;;Dec 07, 2010;Build 9
"RTN","BSDX08",3,0)
;
"RTN","BSDX08",4,0)
; Original by HMW. New Written by Sam Habiel. Licensed under LGPL.
"RTN","BSDX08",5,0)
;
"RTN","BSDX08",6,0)
; Change History
"RTN","BSDX08",7,0)
; 3101022 UJO/SMH v1.42
"RTN","BSDX08",8,0)
; - Transaction now restartable. Thanks to
"RTN","BSDX08",9,0)
; --> Zach Gonzalez and Rick Marshall for fix.
"RTN","BSDX08",10,0)
; - Extra TROLLBACK in Lock Statement when lock fails.
"RTN","BSDX08",11,0)
; --> Removed--Rollback is already in ERR tag.
"RTN","BSDX08",12,0)
; - Added new statements to old SD code in AVUPDT to obviate
"RTN","BSDX08",13,0)
; --> need to restore variables in transaction
"RTN","BSDX08",14,0)
; - Refactored this chunk of code. Don't really know whether it
"RTN","BSDX08",15,0)
; --> worked in the first place. Waiting for bug report to know.
"RTN","BSDX08",16,0)
; - Refactored all of APPDEL.
"RTN","BSDX08",17,0)
;
"RTN","BSDX08",18,0)
; Error Reference:
"RTN","BSDX08",19,0)
; -1~BSDX08: Appt record is locked. Please contact technical support.
"RTN","BSDX08",20,0)
; -2~BSDX08: Invalid Appointment ID
"RTN","BSDX08",21,0)
; -3~BSDX08: Invalid Appointment ID
"RTN","BSDX08",22,0)
; -4~BSDX08: Cancelled appointment does not have a Resouce ID
"RTN","BSDX08",23,0)
; -5~BSDX08: Resouce ID does not exist in BSDX RESOURCE
"RTN","BSDX08",24,0)
; -6~BSDX08: Invalid Hosp Location stored in Database
"RTN","BSDX08",25,0)
; -7~BSDX08: Patient does not have an appointment in PIMS Clinic
"RTN","BSDX08",26,0)
; -8^BSDX08: Unable to find associated PIMS appointment for this patient
"RTN","BSDX08",27,0)
; -9^BSDX08: BSDXAPI returned an error: (error)
"RTN","BSDX08",28,0)
; -100~BSDX08 Error: (Mumps Error)
"RTN","BSDX08",29,0)
;
"RTN","BSDX08",30,0)
APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
"RTN","BSDX08",31,0)
;Entry point for debugging
"RTN","BSDX08",32,0)
D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)")
"RTN","BSDX08",33,0)
Q
"RTN","BSDX08",34,0)
;
"RTN","BSDX08",35,0)
UT ; Unit Tests
"RTN","BSDX08",36,0)
; Test 1: Make normal appointment and cancel it. See if every thing works
"RTN","BSDX08",37,0)
N ZZZ
"RTN","BSDX08",38,0)
D APPADD^BSDX07(.ZZZ,3110123.2,3110123.3,4,"Dr Office",10,"Sam's Note",1)
"RTN","BSDX08",39,0)
S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDX08",40,0)
D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
"RTN","BSDX08",41,0)
I $P(^BSDXAPPT(APPID,0),U,12)'>0 W "Error in Cancellation-1"
"RTN","BSDX08",42,0)
I $O(^SC(2,"S",3110123.2,1,0))]"" W "Error in Cancellation-2"
"RTN","BSDX08",43,0)
I $P(^DPT(4,"S",3110123.2,0),U,2)'="PC" W "Error in Cancellation-3"
"RTN","BSDX08",44,0)
I ^DPT(4,"S",3110123.2,"R")'="Sam's Cancel Note" W "Error in Cancellation-4"
"RTN","BSDX08",45,0)
;
"RTN","BSDX08",46,0)
; Test 2: Check for -1
"RTN","BSDX08",47,0)
; Make appt
"RTN","BSDX08",48,0)
D APPADD^BSDX07(.ZZZ,3110125.2,3110125.3,4,"Dr Office",10,"Sam's Note",1)
"RTN","BSDX08",49,0)
; Lock the node in another job
"RTN","BSDX08",50,0)
S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDX08",51,0)
; W "Lock ^BSDXAPPT("_APPID_") in another session. You have 10 seconds." H 10
"RTN","BSDX08",52,0)
D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
"RTN","BSDX08",53,0)
;
"RTN","BSDX08",54,0)
; Test 3: Check for -100
"RTN","BSDX08",55,0)
S bsdxdie=1
"RTN","BSDX08",56,0)
D APPADD^BSDX07(.ZZZ,3110126.2,3110126.3,4,"Dr Office",10,"Sam's Note",1)
"RTN","BSDX08",57,0)
S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDX08",58,0)
D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
"RTN","BSDX08",59,0)
I $P(^BSDXTMP($J,1),"~")'=-100 W "Error in -100",!
"RTN","BSDX08",60,0)
K bsdxdie
"RTN","BSDX08",61,0)
;
"RTN","BSDX08",62,0)
; Test 4: Restartable transaction
"RTN","BSDX08",63,0)
S bsdxrestart=1
"RTN","BSDX08",64,0)
D APPADD^BSDX07(.ZZZ,3110128.2,3110128.3,4,"Dr Office",10,"Sam's Note",1)
"RTN","BSDX08",65,0)
S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDX08",66,0)
D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
"RTN","BSDX08",67,0)
I $P(^DPT(4,"S",3110128.2,0),U,2)'="PC" W "Error in Restartable Transaction",!
"RTN","BSDX08",68,0)
;
"RTN","BSDX08",69,0)
; Test 5: for invalid Appointment ID (-2 and -3)
"RTN","BSDX08",70,0)
D APPDEL^BSDX08(.ZZZ,0,"PC",1,"Reasons")
"RTN","BSDX08",71,0)
I $P(^BSDXTMP($J,1),"~")'=-2 W "Error in -2",!
"RTN","BSDX08",72,0)
D APPDEL^BSDX08(.ZZZ,999999,"PC",1,"Reasons")
"RTN","BSDX08",73,0)
I $P(^BSDXTMP($J,1),"~")'=-3 W "Error in -3",!
"RTN","BSDX08",74,0)
QUIT
"RTN","BSDX08",75,0)
; Lock the node in another job for testing.
"RTN","BSDX08",76,0)
UTL(APPID) L +^BSDXAPPT(APPID) HANG 10 QUIT
"RTN","BSDX08",77,0)
;
"RTN","BSDX08",78,0)
APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
"RTN","BSDX08",79,0)
;Called by RPC: BSDX CANCEL APPOINTMENT
"RTN","BSDX08",80,0)
;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles
"RTN","BSDX08",81,0)
;Input Parameters:
"RTN","BSDX08",82,0)
; - BSDXAPTID is entry number in BSDX APPOINTMENT file
"RTN","BSDX08",83,0)
; - BSDXTYP is C for clinic-cancelled and PC for patient cancelled
"RTN","BSDX08",84,0)
; - BSDXCR is pointer to CANCELLATION REASON File (409.2)
"RTN","BSDX08",85,0)
; - BSDXNOT is user note
"RTN","BSDX08",86,0)
;
"RTN","BSDX08",87,0)
; Returns error code in recordset field ERRORID. Zero is success.
"RTN","BSDX08",88,0)
; Returns Global Array. Must use this type in RPC.
"RTN","BSDX08",89,0)
;
"RTN","BSDX08",90,0)
; Return Array: set Return and clear array
"RTN","BSDX08",91,0)
S BSDXY=$NA(^BSDXTMP($J))
"RTN","BSDX08",92,0)
K ^BSDXTMP($J)
"RTN","BSDX08",93,0)
;
"RTN","BSDX08",94,0)
; Set min DUZ vars if they don't exist
"RTN","BSDX08",95,0)
D ^XBKVAR
"RTN","BSDX08",96,0)
;
"RTN","BSDX08",97,0)
; $ET
"RTN","BSDX08",98,0)
N $ET S $ET="G ETRAP^BSDX08"
"RTN","BSDX08",99,0)
;
"RTN","BSDX08",100,0)
; Counter
"RTN","BSDX08",101,0)
N BSDXI S BSDXI=0
"RTN","BSDX08",102,0)
; Header Node
"RTN","BSDX08",103,0)
S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
"RTN","BSDX08",104,0)
;
"RTN","BSDX08",105,0)
; Lock BSDX node, only to synchronize access to the globals.
"RTN","BSDX08",106,0)
; It's not expected that the error will ever happen as no filing
"RTN","BSDX08",107,0)
; is supposed to take 5 seconds.
"RTN","BSDX08",108,0)
L +^BSDXAPPT(BSDXAPTID):5 I '$T D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q
"RTN","BSDX08",109,0)
;
"RTN","BSDX08",110,0)
;Restartable Transaction; restore paramters when starting.
"RTN","BSDX08",111,0)
; (Params restored are what's passed here + BSDXI)
"RTN","BSDX08",112,0)
TSTART (BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT,BSDXI):T="BSDX CANCEL APPOINTEMENT^BSDX08"
"RTN","BSDX08",113,0)
;
"RTN","BSDX08",114,0)
; Turn off SDAM APPT PROTOCOL BSDX Entries
"RTN","BSDX08",115,0)
N BSDXNOEV
"RTN","BSDX08",116,0)
S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol
"RTN","BSDX08",117,0)
;
"RTN","BSDX08",118,0)
;;;test for error inside transaction. See if %ZTER works
"RTN","BSDX08",119,0)
I $G(bsdxdie) S X=1/0
"RTN","BSDX08",120,0)
;;;test
"RTN","BSDX08",121,0)
;;;test for TRESTART
"RTN","BSDX08",122,0)
I $G(bsdxrestart) K bsdxrestart TRESTART
"RTN","BSDX08",123,0)
;;;test
"RTN","BSDX08",124,0)
;
"RTN","BSDX08",125,0)
; Check appointment ID and whether it exists
"RTN","BSDX08",126,0)
I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q
"RTN","BSDX08",127,0)
I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-3~BSDX08: Invalid Appointment ID") Q
"RTN","BSDX08",128,0)
;
"RTN","BSDX08",129,0)
; Start Processing:
"RTN","BSDX08",130,0)
; First, add cancellation date to appt entry in BSDX APPOINTMENT
"RTN","BSDX08",131,0)
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; BSDX Appt Node
"RTN","BSDX08",132,0)
N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; Patient ID
"RTN","BSDX08",133,0)
N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Time
"RTN","BSDX08",134,0)
D BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT
"RTN","BSDX08",135,0)
;
"RTN","BSDX08",136,0)
; Second, cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
"RTN","BSDX08",137,0)
N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
"RTN","BSDX08",138,0)
; If the resouce id doesn't exist...
"RTN","BSDX08",139,0)
I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT
"RTN","BSDX08",140,0)
I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT
"RTN","BSDX08",141,0)
; Get zero node of resouce
"RTN","BSDX08",142,0)
S BSDXNOD=^BSDXRES(BSDXSC1,0)
"RTN","BSDX08",143,0)
; Get Hosp location
"RTN","BSDX08",144,0)
N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4)
"RTN","BSDX08",145,0)
; Error indicator for Hosp Location filing for getting out of routine
"RTN","BSDX08",146,0)
N BSDXERR S BSDXERR=0
"RTN","BSDX08",147,0)
; Only file in 2/44 if there is an associated hospital location
"RTN","BSDX08",148,0)
I BSDXLOC D QUIT:BSDXERR
"RTN","BSDX08",149,0)
. I '$D(^SC(BSDXLOC,0)) S BSDXERR=1 D ERR(BSDXI,"-6~BSDX08: Invalid Hosp Location stored in Database") QUIT
"RTN","BSDX08",150,0)
. ; Get the IEN of the appointment in the "S" node of ^SC
"RTN","BSDX08",151,0)
. N BSDXSCIEN
"RTN","BSDX08",152,0)
. S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART)
"RTN","BSDX08",153,0)
. I BSDXSCIEN="" S BSDXERR=1 D ERR(BSDXI,"-7~BSDX08: Patient does not have an appointment in PIMS Clinic") QUIT
"RTN","BSDX08",154,0)
. ; Get the appointment node
"RTN","BSDX08",155,0)
. S BSDXNOD=$G(^SC(BSDXLOC,"S",BSDXSTART,1,BSDXSCIEN,0))
"RTN","BSDX08",156,0)
. I BSDXNOD="" S BSDXERR=1 D ERR(BSDXI,"-8^BSDX08: Unable to find associated PIMS appointment for this patient") QUIT
"RTN","BSDX08",157,0)
. N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2)
"RTN","BSDX08",158,0)
. ; Cancel through BSDXAPI
"RTN","BSDX08",159,0)
. N BSDXZ
"RTN","BSDX08",160,0)
. D APCAN(.BSDXZ,BSDXLOC,BSDXPATID,BSDXSTART)
"RTN","BSDX08",161,0)
. I +BSDXZ>0 S BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT
"RTN","BSDX08",162,0)
. ; Update Legacy PIMS clinic Availability
"RTN","BSDX08",163,0)
. D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN)
"RTN","BSDX08",164,0)
;
"RTN","BSDX08",165,0)
TCOMMIT
"RTN","BSDX08",166,0)
L -^BSDXAPPT(BSDXAPTID)
"RTN","BSDX08",167,0)
S BSDXI=BSDXI+1
"RTN","BSDX08",168,0)
S ^BSDXTMP($J,BSDXI)=""_$C(30)
"RTN","BSDX08",169,0)
S BSDXI=BSDXI+1
"RTN","BSDX08",170,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX08",171,0)
Q
"RTN","BSDX08",172,0)
;
"RTN","BSDX08",173,0)
AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update Legacy PIMS Clinic availability
"RTN","BSDX08",174,0)
;See SDCNP0
"RTN","BSDX08",175,0)
N SD,S ; Start Date
"RTN","BSDX08",176,0)
S (SD,S)=BSDXSTART
"RTN","BSDX08",177,0)
N I ; Clinic IEN in 44
"RTN","BSDX08",178,0)
S I=BSDXSCD
"RTN","BSDX08",179,0)
; if day has no schedule in legacy PIMS, forget about this update.
"RTN","BSDX08",180,0)
Q:'$D(^SC(I,"ST",SD\1,1))
"RTN","BSDX08",181,0)
N SL ; Clinic characteristics node (length of appt, when appts start etc)
"RTN","BSDX08",182,0)
S SL=^SC(I,"SL")
"RTN","BSDX08",183,0)
N X ; Hour Clinic Display Begins
"RTN","BSDX08",184,0)
S X=$P(SL,U,3)
"RTN","BSDX08",185,0)
N STARTDAY ; When does the day start?
"RTN","BSDX08",186,0)
S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am
"RTN","BSDX08",187,0)
N SB ; ?? Who knows? Day Start - 1 divided by 100.
"RTN","BSDX08",188,0)
S SB=STARTDAY-1/100
"RTN","BSDX08",189,0)
S X=$P(SL,U,6) ; Now X is Display increments per hour
"RTN","BSDX08",190,0)
N HSI ; Slots per hour, try 1
"RTN","BSDX08",191,0)
S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4
"RTN","BSDX08",192,0)
N SI ; Slots per hour, try 2
"RTN","BSDX08",193,0)
S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4
"RTN","BSDX08",194,0)
N STR ; ??
"RTN","BSDX08",195,0)
S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
"RTN","BSDX08",196,0)
N SDDIF ; Slots per hour diff??
"RTN","BSDX08",197,0)
S SDDIF=$S(HSI<3:8/HSI,1:2)
"RTN","BSDX08",198,0)
S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI
"RTN","BSDX08",199,0)
S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS
"RTN","BSDX08",200,0)
N Y ; Hours since start of Date
"RTN","BSDX08",201,0)
S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs
"RTN","BSDX08",202,0)
N ST ; ??
"RTN","BSDX08",203,0)
; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour
"RTN","BSDX08",204,0)
; Y\1 -> Hours since start of day; * SI: * slots
"RTN","BSDX08",205,0)
S ST=Y#1*SI\.6+(Y\1*SI)
"RTN","BSDX08",206,0)
N SS ; how many slots are supposed to be taken by appointment
"RTN","BSDX08",207,0)
S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots)
"RTN","BSDX08",208,0)
N I
"RTN","BSDX08",209,0)
I Y'<1 D ; If Hours since start of Date is greater than 1
"RTN","BSDX08",210,0)
. ; loop through pattern. Tired of documenting.
"RTN","BSDX08",211,0)
. F I=ST+ST:SDDIF D Q:Y="" Q:SS'>0
"RTN","BSDX08",212,0)
. . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y=""
"RTN","BSDX08",213,0)
. . S S=$E(S,1,I)_Y_$E(S,I+2,999)
"RTN","BSDX08",214,0)
. . S SS=SS-1
"RTN","BSDX08",215,0)
. . Q:SS'>0
"RTN","BSDX08",216,0)
S ^SC(BSDXSCD,"ST",SD\1,1)=S ; new pattern; global set
"RTN","BSDX08",217,0)
Q
"RTN","BSDX08",218,0)
;
"RTN","BSDX08",219,0)
APCAN(BSDXZ,BSDXLOC,BSDXDFN,BSDXSD) ;
"RTN","BSDX08",220,0)
;Cancel appointment for patient BSDXDFN in clinic BSDXSC1
"RTN","BSDX08",221,0)
;at time BSDXSD
"RTN","BSDX08",222,0)
N BSDXC,%H
"RTN","BSDX08",223,0)
S BSDXC("PAT")=BSDXPATID
"RTN","BSDX08",224,0)
S BSDXC("CLN")=BSDXLOC
"RTN","BSDX08",225,0)
S BSDXC("TYP")=BSDXTYP
"RTN","BSDX08",226,0)
S BSDXC("ADT")=BSDXSD
"RTN","BSDX08",227,0)
S %H=$H D YMD^%DTC
"RTN","BSDX08",228,0)
S BSDXC("CDT")=X+%
"RTN","BSDX08",229,0)
S BSDXC("NOT")=BSDXNOT
"RTN","BSDX08",230,0)
S:'+$G(BSDXCR) BSDXCR=11 ;Other
"RTN","BSDX08",231,0)
S BSDXC("CR")=BSDXCR
"RTN","BSDX08",232,0)
S BSDXC("USR")=DUZ
"RTN","BSDX08",233,0)
;
"RTN","BSDX08",234,0)
S BSDXZ=$$CANCEL^BSDXAPI(.BSDXC)
"RTN","BSDX08",235,0)
Q
"RTN","BSDX08",236,0)
;
"RTN","BSDX08",237,0)
BSDXCAN(BSDXAPTID) ;
"RTN","BSDX08",238,0)
;Cancel BSDX APPOINTMENT entry
"RTN","BSDX08",239,0)
N %DT,X,BSDXDATE,Y,BSDXIENS,BSDXFDA,BSDXMSG
"RTN","BSDX08",240,0)
S %DT="XT",X="NOW" D ^%DT ; X ^DD("DD")
"RTN","BSDX08",241,0)
S BSDXDATE=Y
"RTN","BSDX08",242,0)
S BSDXIENS=BSDXAPTID_","
"RTN","BSDX08",243,0)
S BSDXFDA(9002018.4,BSDXIENS,.12)=BSDXDATE
"RTN","BSDX08",244,0)
K BSDXMSG
"RTN","BSDX08",245,0)
D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX08",246,0)
Q
"RTN","BSDX08",247,0)
;
"RTN","BSDX08",248,0)
CANEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CANCEL APPOINTMENT event
"RTN","BSDX08",249,0)
;when appointments cancelled via PIMS interface.
"RTN","BSDX08",250,0)
;Propagates cancellation to BSDXAPPT and raises refresh event to running GUI clients
"RTN","BSDX08",251,0)
N BSDXFOUND,BSDXRES
"RTN","BSDX08",252,0)
Q:+$G(BSDXNOEV)
"RTN","BSDX08",253,0)
Q:'+$G(BSDXSC)
"RTN","BSDX08",254,0)
S BSDXFOUND=0
"RTN","BSDX08",255,0)
I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$CANEVT1(BSDXRES,BSDXSTART,BSDXPAT)
"RTN","BSDX08",256,0)
I BSDXFOUND D CANEVT3(BSDXRES) Q
"RTN","BSDX08",257,0)
I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$CANEVT1(BSDXRES,BSDXSTART,BSDXPAT)
"RTN","BSDX08",258,0)
I BSDXFOUND D CANEVT3(BSDXRES)
"RTN","BSDX08",259,0)
Q
"RTN","BSDX08",260,0)
;
"RTN","BSDX08",261,0)
CANEVT1(BSDXRES,BSDXSTART,BSDXPAT) ;
"RTN","BSDX08",262,0)
;Get appointment id in BSDXAPT
"RTN","BSDX08",263,0)
;If found, call BSDXCAN(BSDXAPPT) and return 1
"RTN","BSDX08",264,0)
;else return 0
"RTN","BSDX08",265,0)
N BSDXFOUND,BSDXAPPT
"RTN","BSDX08",266,0)
S BSDXFOUND=0
"RTN","BSDX08",267,0)
Q:'+BSDXRES BSDXFOUND
"RTN","BSDX08",268,0)
Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
"RTN","BSDX08",269,0)
S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND
"RTN","BSDX08",270,0)
. S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
"RTN","BSDX08",271,0)
. I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
"RTN","BSDX08",272,0)
I BSDXFOUND,+$G(BSDXAPPT) D BSDXCAN(BSDXAPPT)
"RTN","BSDX08",273,0)
Q BSDXFOUND
"RTN","BSDX08",274,0)
;
"RTN","BSDX08",275,0)
CANEVT3(BSDXRES) ;
"RTN","BSDX08",276,0)
;Call RaiseEvent to notify GUI clients
"RTN","BSDX08",277,0)
;
"RTN","BSDX08",278,0)
N BSDXRESN
"RTN","BSDX08",279,0)
S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
"RTN","BSDX08",280,0)
Q:BSDXRESN=""
"RTN","BSDX08",281,0)
S BSDXRESN=$P(BSDXRESN,"^")
"RTN","BSDX08",282,0)
;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
"RTN","BSDX08",283,0)
D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
"RTN","BSDX08",284,0)
Q
"RTN","BSDX08",285,0)
;
"RTN","BSDX08",286,0)
ERR(BSDXI,BSDXERR) ;Error processing
"RTN","BSDX08",287,0)
S BSDXI=BSDXI+1
"RTN","BSDX08",288,0)
S BSDXERR=$TR(BSDXERR,"^","~")
"RTN","BSDX08",289,0)
I $TL>0 TROLLBACK
"RTN","BSDX08",290,0)
S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
"RTN","BSDX08",291,0)
S BSDXI=BSDXI+1
"RTN","BSDX08",292,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX08",293,0)
L -^BSDXAPPT(BSDXAPTID)
"RTN","BSDX08",294,0)
QUIT
"RTN","BSDX08",295,0)
;
"RTN","BSDX08",296,0)
ETRAP ;EP Error trap entry
"RTN","BSDX08",297,0)
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
"RTN","BSDX08",298,0)
; Rollback, otherwise ^XTER will be empty from future rollback
"RTN","BSDX08",299,0)
I $TL>0 TROLLBACK
"RTN","BSDX08",300,0)
D ^%ZTER
"RTN","BSDX08",301,0)
S $EC="" ; Clear Error
"RTN","BSDX08",302,0)
; Log error message and send to client
"RTN","BSDX08",303,0)
I '$D(BSDXI) N BSDXI S BSDXI=0
"RTN","BSDX08",304,0)
D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE))
"RTN","BSDX08",305,0)
QUIT
"RTN","BSDX08",306,0)
;
"RTN","BSDX08",307,0)
;;;NB: This is code that is unused in both original and port.
"RTN","BSDX08",308,0)
; ; If not appt in the "S" node is found in ^SC then check associated RPMS Clinic Multiple
"RTN","BSDX08",309,0)
; I BSDXSCIEN="" D I 'BSDXZ Q ;Q:BSDXZ
"RTN","BSDX08",310,0)
; . S BSDXERR="BSDX08: Unable to find associated RPMS appointment for this patient. "
"RTN","BSDX08",311,0)
; . S BSDXZ=1
"RTN","BSDX08",312,0)
; . ; Check if there are associated RPMS clinics. (not currently used) Does the multiple exist? No, then quit
"RTN","BSDX08",313,0)
; . I '$D(^BSDXRES(BSDXSC1,20)) S BSDXZ=0 QUIT
"RTN","BSDX08",314,0)
; . ; Loop through the multiple. Get Location and then the ^SC "S" node IEN.
"RTN","BSDX08",315,0)
; . N BSDX1 S BSDX1=0
"RTN","BSDX08",316,0)
; . F S BSDX1=$O(^BSDXRES(BSDXSC1,20,BSDX1)) Q:'+BSDX1 Q:BSDXZ=0 D
"RTN","BSDX08",317,0)
; . . Q:'$D(^BSDXRES(BSDXSC1,20,BSDX1,0))
"RTN","BSDX08",318,0)
; . . S BSDXLOC=$P(^BSDXRES(BSDXSC1,20,BSDX1,0),U)
"RTN","BSDX08",319,0)
. ; . . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) I +BSDXSCIEN S BSDXZ=0 Q
"RTN","BSDX09")
0^9^B35707298
"RTN","BSDX09",1,0)
BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 10/20/10 4:16pm
"RTN","BSDX09",2,0)
;;1.42;BSDX;;Dec 07, 2010;Build 9
"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)
; UJO/TH - v 1.42 on 3101020 - Add Sex field.
"RTN","BSDX09",14,0)
;
"RTN","BSDX09",15,0)
GETREGA(BSDXRET,BSDXPAT) ;EP
"RTN","BSDX09",16,0)
;
"RTN","BSDX09",17,0)
; See below for the returned fields
"RTN","BSDX09",18,0)
;
"RTN","BSDX09",19,0)
;For patient with ien BSDXPAT
"RTN","BSDX09",20,0)
;K ^BSDXTMP($J)
"RTN","BSDX09",21,0)
S BSDXERR=""
"RTN","BSDX09",22,0)
S BSDXRET="^BSDXTMP("_$J_")"
"RTN","BSDX09",23,0)
;
"RTN","BSDX09",24,0)
N OUT S OUT=$NA(^BSDXTMP($J,0))
"RTN","BSDX09",25,0)
S $P(@OUT,U,1)="T00030IEN"
"RTN","BSDX09",26,0)
S $P(@OUT,U,2)="T00030STREET"
"RTN","BSDX09",27,0)
S $P(@OUT,U,3)="T00030CITY"
"RTN","BSDX09",28,0)
S $P(@OUT,U,4)="T00030STATE"
"RTN","BSDX09",29,0)
S $P(@OUT,U,5)="T00030ZIP"
"RTN","BSDX09",30,0)
S $P(@OUT,U,6)="T00030NAME"
"RTN","BSDX09",31,0)
S $P(@OUT,U,7)="D00030DOB"
"RTN","BSDX09",32,0)
S $P(@OUT,U,8)="T00030PID"
"RTN","BSDX09",33,0)
S $P(@OUT,U,9)="T00030HRN"
"RTN","BSDX09",34,0)
S $P(@OUT,U,10)="T00030HOMEPHONE"
"RTN","BSDX09",35,0)
S $P(@OUT,U,11)="T00030OFCPHONE"
"RTN","BSDX09",36,0)
S $P(@OUT,U,12)="T00030MSGPHONE"
"RTN","BSDX09",37,0)
S $P(@OUT,U,13)="T00030NOK NAME"
"RTN","BSDX09",38,0)
S $P(@OUT,U,14)="T00030RELATIONSHIP"
"RTN","BSDX09",39,0)
S $P(@OUT,U,15)="T00030PHONE"
"RTN","BSDX09",40,0)
S $P(@OUT,U,16)="T00030STREET"
"RTN","BSDX09",41,0)
S $P(@OUT,U,17)="T00030CITY"
"RTN","BSDX09",42,0)
S $P(@OUT,U,18)="T00030STATE"
"RTN","BSDX09",43,0)
S $P(@OUT,U,19)="T00030ZIP"
"RTN","BSDX09",44,0)
S $P(@OUT,U,20)="D00030DATAREVIEWED"
"RTN","BSDX09",45,0)
S $P(@OUT,U,21)="T00030RegistrationComments"
"RTN","BSDX09",46,0)
S $P(@OUT,U,22)="T00050EMAIL ADDRESS"
"RTN","BSDX09",47,0)
S $P(@OUT,U,23)="T00020PHONE NUMBER [CELLULAR]"
"RTN","BSDX09",48,0)
S $P(@OUT,U,24)="T00030COUNTRY"
"RTN","BSDX09",49,0)
S $P(@OUT,U,25)="T00030SEX"
"RTN","BSDX09",50,0)
S $E(@OUT,$L(@OUT)+1)=$C(30)
"RTN","BSDX09",51,0)
;
"RTN","BSDX09",52,0)
;
"RTN","BSDX09",53,0)
N BSDXNOD,BSDXNAM,Y,U
"RTN","BSDX09",54,0)
S U="^"
"RTN","BSDX09",55,0)
S BSDXY="ERROR"
"RTN","BSDX09",56,0)
K NAME
"RTN","BSDX09",57,0)
I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q
"RTN","BSDX09",58,0)
I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q
"RTN","BSDX09",59,0)
S BSDXY=""
"RTN","BSDX09",60,0)
S $P(BSDXY,U)=BSDXPAT
"RTN","BSDX09",61,0)
;//smh S $P(BSDXY,U,23)=""
"RTN","BSDX09",62,0)
S $P(BSDXY,U,21)=""
"RTN","BSDX09",63,0)
S BSDXNOD=^DPT(+BSDXPAT,0)
"RTN","BSDX09",64,0)
S $P(BSDXY,"^",6)=$P(BSDXNOD,U) ;NAME
"RTN","BSDX09",65,0)
S $P(BSDXY,"^",8)=$$GET1^DIQ(2,BSDXPAT,"PRIMARY LONG ID") ;PID
"RTN","BSDX09",66,0)
S Y=$P(BSDXNOD,U,3) I Y]"" X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX09",67,0)
S $P(BSDXY,"^",7)=Y ;DOB
"RTN","BSDX09",68,0)
S $P(BSDXY,"^",9)=""
"RTN","BSDX09",69,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",70,0)
D MAIL
"RTN","BSDX09",71,0)
D PHONE
"RTN","BSDX09",72,0)
D NOK
"RTN","BSDX09",73,0)
D DATAREV
"RTN","BSDX09",74,0)
;/smh D MEDICARE
"RTN","BSDX09",75,0)
D REGCMT
"RTN","BSDX09",76,0)
S $P(BSDXY,"^",22)=$$GET1^DIQ(2,BSDXPAT,"EMAIL ADDRESS")
"RTN","BSDX09",77,0)
S $P(BSDXY,"^",23)=$$GET1^DIQ(2,BSDXPAT,"PHONE NUMBER [CELLULAR]")
"RTN","BSDX09",78,0)
S $P(BSDXY,"^",24)=$$GET1^DIQ(2,BSDXPAT,"COUNTRY:DESCRIPTION")
"RTN","BSDX09",79,0)
S $P(BSDXY,"^",25)=$$GET1^DIQ(2,BSDXPAT,"SEX")
"RTN","BSDX09",80,0)
N BSDXBEG,BSDXEND,BSDXLEN,BSDXI
"RTN","BSDX09",81,0)
S BSDXLEN=$L(BSDXY)
"RTN","BSDX09",82,0)
S BSDXBEG=0,BSDXI=2
"RTN","BSDX09",83,0)
F D Q:BSDXEND=BSDXLEN
"RTN","BSDX09",84,0)
. S BSDXEND=BSDXBEG+100
"RTN","BSDX09",85,0)
. S:BSDXEND>BSDXLEN BSDXEND=BSDXLEN
"RTN","BSDX09",86,0)
. S BSDXI=BSDXI+1
"RTN","BSDX09",87,0)
. S ^BSDXTMP($J,BSDXI)=$E(BSDXY,BSDXBEG,BSDXEND)
"RTN","BSDX09",88,0)
. S BSDXBEG=BSDXBEG+101
"RTN","BSDX09",89,0)
S ^BSDXTMP($J,BSDXI+1)=$C(30)_$C(31)
"RTN","BSDX09",90,0)
Q
"RTN","BSDX09",91,0)
;
"RTN","BSDX09",92,0)
MAIL N BSDXST
"RTN","BSDX09",93,0)
Q:'$D(^DPT(+BSDXPAT,.11))
"RTN","BSDX09",94,0)
S BSDXNOD=^DPT(+BSDXPAT,.11)
"RTN","BSDX09",95,0)
Q:BSDXNOD=""
"RTN","BSDX09",96,0)
S $P(BSDXY,"^",2)=$E($P(BSDXNOD,U),1,50) ;STREET
"RTN","BSDX09",97,0)
S $P(BSDXY,"^",3)=$P(BSDXNOD,U,4) ;CITY
"RTN","BSDX09",98,0)
S BSDXST=$P(BSDXNOD,U,5)
"RTN","BSDX09",99,0)
I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2)
"RTN","BSDX09",100,0)
S $P(BSDXY,"^",4)=BSDXST ;STATE
"RTN","BSDX09",101,0)
S $P(BSDXY,"^",5)=$P(BSDXNOD,U,6) ;ZIP
"RTN","BSDX09",102,0)
Q
"RTN","BSDX09",103,0)
;
"RTN","BSDX09",104,0)
PHONE ;PHONE 10,11,12 HOME,OFC,MSG
"RTN","BSDX09",105,0)
I $D(^DPT(+BSDXPAT,.13)) D
"RTN","BSDX09",106,0)
. S BSDXNOD=^DPT(+BSDXPAT,.13)
"RTN","BSDX09",107,0)
. S $P(BSDXY,U,10)=$P(BSDXNOD,U,1)
"RTN","BSDX09",108,0)
. S $P(BSDXY,U,11)=$P(BSDXNOD,U,2)
"RTN","BSDX09",109,0)
I $D(^DPT(+BSDXPAT,.121)) D
"RTN","BSDX09",110,0)
. S BSDXNOD=^DPT(+BSDXPAT,.121)
"RTN","BSDX09",111,0)
. S $P(BSDXY,U,12)=$P(BSDXNOD,U,10)
"RTN","BSDX09",112,0)
Q
"RTN","BSDX09",113,0)
;
"RTN","BSDX09",114,0)
NOK ;NOK
"RTN","BSDX09",115,0)
; 13 NOK NAME^RELATIONSHIP^PHONE^STREET^CITY^STATE^ZIP
"RTN","BSDX09",116,0)
N Y,BSDXST
"RTN","BSDX09",117,0)
I $D(^DPT(+BSDXPAT,.21)) D
"RTN","BSDX09",118,0)
. S BSDXNOD=^DPT(+BSDXPAT,.21)
"RTN","BSDX09",119,0)
. S $P(BSDXY,U,13)=$P(BSDXNOD,U,1)
"RTN","BSDX09",120,0)
. S $P(BSDXY,U,14)=$$VAL^XBDIQ1(9000001,BSDXPAT,2802)
"RTN","BSDX09",121,0)
. S $P(BSDXY,U,15)=$P(BSDXNOD,U,9)
"RTN","BSDX09",122,0)
. S $P(BSDXY,U,16)=$P(BSDXNOD,U,3)
"RTN","BSDX09",123,0)
. S $P(BSDXY,U,17)=$P(BSDXNOD,U,6)
"RTN","BSDX09",124,0)
. S BSDXST=$P(BSDXNOD,U,7)
"RTN","BSDX09",125,0)
. I +BSDXST D
"RTN","BSDX09",126,0)
. . I $D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2),$P(BSDXY,U,18)=BSDXST
"RTN","BSDX09",127,0)
. S $P(BSDXY,U,19)=$P(BSDXNOD,U,8)
"RTN","BSDX09",128,0)
Q
"RTN","BSDX09",129,0)
;
"RTN","BSDX09",130,0)
DATAREV S $P(BSDXY,U,20)=$P($$VAL^XBDIQ1(9000001,BSDXPAT,16651),"@")
"RTN","BSDX09",131,0)
Q
"RTN","BSDX09",132,0)
;
"RTN","BSDX09",133,0)
REGCMT N BSDXI,BSDXM,BSDXR
"RTN","BSDX09",134,0)
S BSDXR=""
"RTN","BSDX09",135,0)
D ENP^XBDIQ1(9000001,BSDXPAT,1301,"BSDXM(")
"RTN","BSDX09",136,0)
S BSDXI=0 F S BSDXI=$O(BSDXM(1301,BSDXI)) Q:'+BSDXI D
"RTN","BSDX09",137,0)
. S BSDXR=BSDXR_" "_BSDXM(1301,BSDXI)
"RTN","BSDX09",138,0)
; S $P(BSDXY,U,23)=$TR($E(BSDXR,1,1024),U," ") ; MJL 1/17/2007 //smh
"RTN","BSDX09",139,0)
S $P(BSDXY,U,21)=$TR($E(BSDXR,1,1024),U," ") ;
"RTN","BSDX09",140,0)
Q
"RTN","BSDX09",141,0)
;
"RTN","BSDX09",142,0)
GETMCAID(BSDXY,BSDXPAT) ; not in wv
"RTN","BSDX09",143,0)
;Returns PATIENTIEN^ENTRY#^MEDICAID#^SUBENTRY#^ELIG.BEGIN^ELIG.END |
"RTN","BSDX09",144,0)
;File is not dinum
"RTN","BSDX09",145,0)
N C,N,ASDGX,BSDXM,BSDXBLD,BSDXCNT
"RTN","BSDX09",146,0)
N BSDXIEN
"RTN","BSDX09",147,0)
S BSDXBLD=""
"RTN","BSDX09",148,0)
S BSDXIEN=0
"RTN","BSDX09",149,0)
S BSDXCNT=1
"RTN","BSDX09",150,0)
F S BSDXIEN=$O(^AUPNMCD("B",BSDXPAT,BSDXIEN)) Q:'+BSDXIEN D
"RTN","BSDX09",151,0)
. S BSDXNUM=$$VAL^XBDIQ1(9000004,BSDXIEN,.03) ;MCAID#
"RTN","BSDX09",152,0)
. D ENPM^XBDIQ1(9000004.11,BSDXIEN_",0",".01:.02","ASDGX(")
"RTN","BSDX09",153,0)
. S C=1,N=0,BSDXM=""
"RTN","BSDX09",154,0)
. F S N=$O(ASDGX(N)) Q:'N D
"RTN","BSDX09",155,0)
. . S $P(BSDXY,"|",C)=BSDXPAT_U_BSDXIEN_U_BSDXNUM_U_N_U_ASDGX(N,.01)_U_ASDGX(N,.02)
"RTN","BSDX09",156,0)
. . S C=C+1
"RTN","BSDX09",157,0)
. . Q
"RTN","BSDX09",158,0)
. Q
"RTN","BSDX09",159,0)
Q
"RTN","BSDX09",160,0)
;
"RTN","BSDX09",161,0)
MEDICARE ; not in WV
"RTN","BSDX09",162,0)
S $P(BSDXY,U,21)=$$VAL^XBDIQ1(9000003,BSDXPAT,.03)
"RTN","BSDX09",163,0)
S $P(BSDXY,U,22)=$$VAL^XBDIQ1(9000003,BSDXPAT,.04)
"RTN","BSDX09",164,0)
Q
"RTN","BSDX09",165,0)
;
"RTN","BSDX09",166,0)
GETMCARE(BSDXY,BSDXPAT) ;
"RTN","BSDX09",167,0)
;Returns IEN^MEDICARE#^SUFFIX^SUBENTRY#^TYPE^ELIG.BEGIN^ELIG.END |
"RTN","BSDX09",168,0)
;File is dinum
"RTN","BSDX09",169,0)
;
"RTN","BSDX09",170,0)
N ASDGX,C,N,BSDXNUM,BSDXSUF,BSDXBLD
"RTN","BSDX09",171,0)
S BSDXNUM=$$VAL^XBDIQ1(9000003,BSDXPAT,.03)
"RTN","BSDX09",172,0)
S BSDXSUF=$$VAL^XBDIQ1(9000003,BSDXPAT,.04)
"RTN","BSDX09",173,0)
D ENPM^XBDIQ1(9000003.11,BSDXPAT_",0",".01:.03","ASDGX(")
"RTN","BSDX09",174,0)
S C=1,N=0,BSDXBLD=""
"RTN","BSDX09",175,0)
F S N=$O(ASDGX(N)) Q:'N D
"RTN","BSDX09",176,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",177,0)
. S C=C+1
"RTN","BSDX09",178,0)
. Q
"RTN","BSDX09",179,0)
Q
"RTN","BSDX09",180,0)
;
"RTN","BSDX09",181,0)
GETPVTIN(BSDXY,BSDXPAT) ;
"RTN","BSDX09",182,0)
;Returns IEN^SUBENTRY^INSURER^POLICYNUMBER^ELIG.BEGIN^ELIG.END|...
"RTN","BSDX09",183,0)
;File is dinum
"RTN","BSDX09",184,0)
;
"RTN","BSDX09",185,0)
N ASDGX,C,N
"RTN","BSDX09",186,0)
D ENPM^XBDIQ1(9000006.11,BSDXPAT_",0",".01;.02;.06;.07","ASDGX(")
"RTN","BSDX09",187,0)
S C=1,N=0
"RTN","BSDX09",188,0)
F S N=$O(ASDGX(N)) Q:'N D
"RTN","BSDX09",189,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",190,0)
. S C=C+1
"RTN","BSDX09",191,0)
. Q
"RTN","BSDX09",192,0)
Q
"RTN","BSDX09",193,0)
;
"RTN","BSDX09",194,0)
DFN(FILE,BSDXPAT) ; -- returns ien for file
"RTN","BSDX09",195,0)
I FILE'[9000004 Q BSDXPAT
"RTN","BSDX09",196,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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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^B9772451
"RTN","BSDX13",1,0)
BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 6:05pm
"RTN","BSDX13",2,0)
;;1.42;BSDX;;Dec 07, 2010;Build 9
"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(BSDXEND,".")_".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(%ZTERZE)_">")
"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'<BSDXEND D Q:BSDXHIT
"RTN","BSDX13",119,0)
;. S BSDXID=0 F S BSDXID=$O(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXS,BSDXID)) Q:'+BSDXID D Q:BSDXHIT
"RTN","BSDX13",120,0)
;. . Q:'$D(^BSDXDAPT(BSDXID,0))
"RTN","BSDX13",121,0)
;. . S BSDXNOD=^BSDXDAPT(BSDXID,0)
"RTN","BSDX13",122,0)
;. . S BSDXE=$P(BSDXNOD,U,2)
"RTN","BSDX13",123,0)
;. . I BSDXE>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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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^B30714245
"RTN","BSDX26",1,0)
BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:38pm
"RTN","BSDX26",2,0)
;;1.42;BSDX;;Dec 07, 2010;Build 9
"RTN","BSDX26",3,0)
; Change History:
"RTN","BSDX26",4,0)
; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx.
"RTN","BSDX26",5,0)
; --> Thanks to Zach Gonzalez and Rick Marshall
"RTN","BSDX26",6,0)
; 3101205 - UJO/SMH - Extensive refactoring.
"RTN","BSDX26",7,0)
;
"RTN","BSDX26",8,0)
; Error Reference:
"RTN","BSDX26",9,0)
; -1: Appt ID is not a number
"RTN","BSDX26",10,0)
; -2: Appt IEN is not in ^BSDXAPPT
"RTN","BSDX26",11,0)
; -3: FM Failure to file WP field in ^BSDXAPPT
"RTN","BSDX26",12,0)
;
"RTN","BSDX26",13,0)
EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP
"RTN","BSDX26",14,0)
;Entry point for debugging
"RTN","BSDX26",15,0)
;
"RTN","BSDX26",16,0)
D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
"RTN","BSDX26",17,0)
Q
"RTN","BSDX26",18,0)
UT ; Unit Tests
"RTN","BSDX26",19,0)
; Test 1: Make sure this damn thing works
"RTN","BSDX26",20,0)
N ZZZ
"RTN","BSDX26",21,0)
N %H S %H=$H
"RTN","BSDX26",22,0)
N NOTE S NOTE="New Note "_%H
"RTN","BSDX26",23,0)
D EDITAPT(.ZZZ,188,NOTE)
"RTN","BSDX26",24,0)
I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR",! B
"RTN","BSDX26",25,0)
; Test 2: Test Errors -1 and -2
"RTN","BSDX26",26,0)
N ZZZ
"RTN","BSDX26",27,0)
N NOTE S NOTE="Nothing important"
"RTN","BSDX26",28,0)
D EDITAPT(.ZZZ,"BLAHBLAH",NOTE)
"RTN","BSDX26",29,0)
I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",! B
"RTN","BSDX26",30,0)
D EDITAPT(.ZZZ,298734322,NOTE)
"RTN","BSDX26",31,0)
I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",! B
"RTN","BSDX26",32,0)
; Test 4: M Error
"RTN","BSDX26",33,0)
N bsdxdie S bsdxdie=1
"RTN","BSDX26",34,0)
D EDITAPT(.ZZZ,188,NOTE)
"RTN","BSDX26",35,0)
I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",! B
"RTN","BSDX26",36,0)
k bsdxdie
"RTN","BSDX26",37,0)
; Test 5: Trestart
"RTN","BSDX26",38,0)
N bsdxrestart S bsdxrestart=1
"RTN","BSDX26",39,0)
N %H S %H=$H
"RTN","BSDX26",40,0)
N NOTE S NOTE="New Note "_%H
"RTN","BSDX26",41,0)
D EDITAPT(.ZZZ,188,NOTE)
"RTN","BSDX26",42,0)
I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR in TRESTART",! B
"RTN","BSDX26",43,0)
; Test 6: for Hosp Location Update
"RTN","BSDX26",44,0)
N DATE S DATE=$$NOW^XLFDT()
"RTN","BSDX26",45,0)
S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform
"RTN","BSDX26",46,0)
D APPADD^BSDX07(.ZZZ,DATE,DATE+.001,3,"Dr Office",30,"Old Note",1)
"RTN","BSDX26",47,0)
N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDX26",48,0)
D EDITAPT(.ZZZ,APPID,"New Note")
"RTN","BSDX26",49,0)
I ^BSDXAPPT(APTID,1,1,0)'="New Note" W "Error in HL Section",! B
"RTN","BSDX26",50,0)
I $P(^SC(2,"S",DATE,1,1,0),U,4)'="New Note" W "Error in HL Section",! B
"RTN","BSDX26",51,0)
QUIT
"RTN","BSDX26",52,0)
;
"RTN","BSDX26",53,0)
EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be edited)
"RTN","BSDX26",54,0)
; Called by RPC: BSDX EDIT APPOINTMENT
"RTN","BSDX26",55,0)
;
"RTN","BSDX26",56,0)
; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file
"RTN","BSDX26",57,0)
;
"RTN","BSDX26",58,0)
; Parameters:
"RTN","BSDX26",59,0)
; - BSDXY: Global Return (RPC must be set to Global Array)
"RTN","BSDX26",60,0)
; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT
"RTN","BSDX26",61,0)
; - BSDXNOTE: New note
"RTN","BSDX26",62,0)
;
"RTN","BSDX26",63,0)
; Return:
"RTN","BSDX26",64,0)
; ADO.net Recordset having 1 field: ERRORID
"RTN","BSDX26",65,0)
; If Okay: -1; otherwise, positive integer with message
"RTN","BSDX26",66,0)
;
"RTN","BSDX26",67,0)
; Return Array; set Return and clear array
"RTN","BSDX26",68,0)
S BSDXY=$NA(^BSDXTMP($J))
"RTN","BSDX26",69,0)
K ^BSDXTMP($J)
"RTN","BSDX26",70,0)
; ET
"RTN","BSDX26",71,0)
N $ET S $ET="G ETRAP^BSDX26"
"RTN","BSDX26",72,0)
; Set up basic DUZ variables
"RTN","BSDX26",73,0)
D ^XBKVAR
"RTN","BSDX26",74,0)
; Counter
"RTN","BSDX26",75,0)
N BSDXI S BSDXI=0
"RTN","BSDX26",76,0)
; Header Node
"RTN","BSDX26",77,0)
S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
"RTN","BSDX26",78,0)
; Restartable txn for GT.M. Restored vars are Params + BSDXI.
"RTN","BSDX26",79,0)
TSTART (BSDXY,BSDXAPTID,BSDXNOTE,BSDXI):T="BSDX EDIT APPOINTMENT^BSDX26"
"RTN","BSDX26",80,0)
;
"RTN","BSDX26",81,0)
;;;test for error inside transaction. See if %ZTER works
"RTN","BSDX26",82,0)
I $G(bsdxdie) S X=1/0
"RTN","BSDX26",83,0)
;;;test
"RTN","BSDX26",84,0)
;;;test for TRESTART
"RTN","BSDX26",85,0)
I $G(bsdxrestart) K bsdxrestart TRESTART
"RTN","BSDX26",86,0)
;;;test
"RTN","BSDX26",87,0)
;
"RTN","BSDX26",88,0)
; Validate Appointment ID
"RTN","BSDX26",89,0)
I '+BSDXAPTID D ERR(BSDXI,"-1~BSDX26: Invalid Appointment ID") QUIT
"RTN","BSDX26",90,0)
I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-2~BSDX26: Invalid Appointment ID") QUIT
"RTN","BSDX26",91,0)
; Put the WP in decendant fields from the root to file as a WP field
"RTN","BSDX26",92,0)
S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
"RTN","BSDX26",93,0)
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
"RTN","BSDX26",94,0)
N BSDXMSG ; Message in case of error in filing.
"RTN","BSDX26",95,0)
I $D(BSDXNOTE(.5)) D
"RTN","BSDX26",96,0)
. D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG")
"RTN","BSDX26",97,0)
I $D(BSDXMSG) D ERR(BSDXI,"-3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
"RTN","BSDX26",98,0)
;
"RTN","BSDX26",99,0)
; Now file in file 44:
"RTN","BSDX26",100,0)
N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN
"RTN","BSDX26",101,0)
N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID
"RTN","BSDX26",102,0)
N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT
"RTN","BSDX26",103,0)
N BSDXRES S BSDXRES=0 ; Result
"RTN","BSDX26",104,0)
; Update Note only if we have a linked hospital location.
"RTN","BSDX26",105,0)
I HLIEN S BSDXRES=$$UPDATENOTE^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
"RTN","BSDX26",106,0)
; If we get an error (denoted by -1 in BSDXRES), return error to client
"RTN","BSDX26",107,0)
I BSDXRES<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES) QUIT
"RTN","BSDX26",108,0)
;Return Recordset
"RTN","BSDX26",109,0)
TCOMMIT
"RTN","BSDX26",110,0)
S BSDXI=BSDXI+1
"RTN","BSDX26",111,0)
S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
"RTN","BSDX26",112,0)
S BSDXI=BSDXI+1
"RTN","BSDX26",113,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX26",114,0)
QUIT
"RTN","BSDX26",115,0)
;
"RTN","BSDX26",116,0)
ERR(BSDXI,BSDXERR) ;Error processing
"RTN","BSDX26",117,0)
S BSDXI=BSDXI+1
"RTN","BSDX26",118,0)
S BSDXERR=$TR(BSDXERR,"^","~")
"RTN","BSDX26",119,0)
I $TL>0 TROLLBACK
"RTN","BSDX26",120,0)
S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
"RTN","BSDX26",121,0)
S BSDXI=BSDXI+1
"RTN","BSDX26",122,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX26",123,0)
QUIT
"RTN","BSDX26",124,0)
;
"RTN","BSDX26",125,0)
ETRAP ;EP Error trap entry
"RTN","BSDX26",126,0)
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
"RTN","BSDX26",127,0)
I $TL>0 TROLLBACK
"RTN","BSDX26",128,0)
D ^%ZTER
"RTN","BSDX26",129,0)
S $EC=""
"RTN","BSDX26",130,0)
I '$D(BSDXI) N BSDXI S BSDXI=0
"RTN","BSDX26",131,0)
D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE))
"RTN","BSDX26",132,0)
Q
"RTN","BSDX27")
0^25^B133007616
"RTN","BSDX27",1,0)
BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 4:52pm
"RTN","BSDX27",2,0)
;;1.42;BSDX;;Dec 07, 2010;Build 9
"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 ta
"RTN","BSDX27",6,0)
; v 1.42 - 3101208 - SMH
"RTN","BSDX27",7,0)
; - Added check to skip cancelled appointments. Check was forgotten
"RTN","BSDX27",8,0)
; in original code.
"RTN","BSDX27",9,0)
; . N BSDXFLAGS S BSDXFLAGS=$P(BSDXNOD,U,2) ; No show and Cancel Flags
"RTN","BSDX27",10,0)
; . Q:BSDXFLAGS["C" ; if appt is cancelled, quit
"RTN","BSDX27",11,0)
;
"RTN","BSDX27",12,0)
Q
"RTN","BSDX27",13,0)
;
"RTN","BSDX27",14,0)
PADISPD(BSDXY,BSDXPAT) ;EP
"RTN","BSDX27",15,0)
;Entry point for debugging
"RTN","BSDX27",16,0)
;
"RTN","BSDX27",17,0)
;D DEBUG^%Serenji("PADISP^BSDX27(.BSDXY,BSDXPAT)")
"RTN","BSDX27",18,0)
Q
"RTN","BSDX27",19,0)
;
"RTN","BSDX27",20,0)
PADISP(BSDXY,BSDXPAT) ;EP
"RTN","BSDX27",21,0)
;Return recordset of patient appointments used in listing
"RTN","BSDX27",22,0)
;a patient's appointments and generating patient letters.
"RTN","BSDX27",23,0)
;Called by rpc BSDX PATIENT APPT DISPLAY
"RTN","BSDX27",24,0)
;
"RTN","BSDX27",25,0)
; Sam's Notes:
"RTN","BSDX27",26,0)
; Relatively complex algorithm.
"RTN","BSDX27",27,0)
; 1. First, loop through ^DPT(DA,"S", and get all appointments.
"RTN","BSDX27",28,0)
; Exclude cancelled appts. Store in BSDXDPT array.
"RTN","BSDX27",29,0)
; 2. Go through ^BSDXAPPT("CPAT", (patient index) .
"RTN","BSDX27",30,0)
; Get the info from there and compar with BSDXDPT array. If
"RTN","BSDX27",31,0)
; they are the same, get all info, and rm entry from BSDXDPT array.
"RTN","BSDX27",32,0)
; 3. If there are any remaining entries in BSDXDPT (PIMS leftovers),
"RTN","BSDX27",33,0)
; Get the data from file 2 and 44.
"RTN","BSDX27",34,0)
;
"RTN","BSDX27",35,0)
N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ
"RTN","BSDX27",36,0)
N BSDXSTRT
"RTN","BSDX27",37,0)
N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
"RTN","BSDX27",38,0)
S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX27",39,0)
S BSDXI=0
"RTN","BSDX27",40,0)
S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
"RTN","BSDX27",41,0)
S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30)
"RTN","BSDX27",42,0)
S X="ERROR^BSDX27",@^%ZOSF("TRAP")
"RTN","BSDX27",43,0)
;Get patient info
"RTN","BSDX27",44,0)
;
"RTN","BSDX27",45,0)
I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q
"RTN","BSDX27",46,0)
I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q
"RTN","BSDX27",47,0)
S BSDXNOD=$$PATINFO(BSDXPAT)
"RTN","BSDX27",48,0)
S BSDXNAM=$P(BSDXNOD,U) ;NAME
"RTN","BSDX27",49,0)
S BSDXSEX=$P(BSDXNOD,U,2) ;SEX
"RTN","BSDX27",50,0)
S BSDXDOB=$P(BSDXNOD,U,3) ;DOB
"RTN","BSDX27",51,0)
S BSDXHRN=$P(BSDXNOD,U,4) ;Health Record Number for location DUZ(2)
"RTN","BSDX27",52,0)
S BSDXSTRE=$P(BSDXNOD,U,5) ;Street
"RTN","BSDX27",53,0)
S BSDXCITY=$P(BSDXNOD,U,6) ;City
"RTN","BSDX27",54,0)
S BSDXST=$P(BSDXNOD,U,7) ;State
"RTN","BSDX27",55,0)
S BSDXZIP=$P(BSDXNOD,U,8) ;zip
"RTN","BSDX27",56,0)
S BSDXPHON=$P(BSDXNOD,U,9) ;homephone
"RTN","BSDX27",57,0)
;
"RTN","BSDX27",58,0)
;Organize ^DPT(BSDXPAT,"S," nodes
"RTN","BSDX27",59,0)
; into BSDXDPT(CLINIC,DATE)
"RTN","BSDX27",60,0)
;
"RTN","BSDX27",61,0)
I $D(^DPT(BSDXPAT,"S")) S BSDXDT=0 F S BSDXDT=$O(^DPT(BSDXPAT,"S",BSDXDT)) Q:'+BSDXDT D
"RTN","BSDX27",62,0)
. S BSDXNOD=$G(^DPT(BSDXPAT,"S",BSDXDT,0))
"RTN","BSDX27",63,0)
. S BSDXCID=$P(BSDXNOD,U)
"RTN","BSDX27",64,0)
. Q:'+BSDXCID
"RTN","BSDX27",65,0)
. Q:'$D(^SC(BSDXCID,0))
"RTN","BSDX27",66,0)
. N BSDXFLAGS S BSDXFLAGS=$P(BSDXNOD,U,2) ; No show and Cancel Flags
"RTN","BSDX27",67,0)
. Q:BSDXFLAGS["C" ; if appt is cancelled, quit
"RTN","BSDX27",68,0)
. S BSDXDPT(BSDXCID,BSDXDT)=BSDXNOD
"RTN","BSDX27",69,0)
;
"RTN","BSDX27",70,0)
;$O Through ^BSDX("CPAT",
"RTN","BSDX27",71,0)
S BSDXIEN=0
"RTN","BSDX27",72,0)
I $D(^BSDXAPPT("CPAT",BSDXPAT)) F S BSDXIEN=$O(^BSDXAPPT("CPAT",BSDXPAT,BSDXIEN)) Q:'BSDXIEN D
"RTN","BSDX27",73,0)
. N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN
"RTN","BSDX27",74,0)
. S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
"RTN","BSDX27",75,0)
. Q:BSDXNOD=""
"RTN","BSDX27",76,0)
. Q:$P(BSDXNOD,U,12)]"" ;CANCELLED
"RTN","BSDX27",77,0)
. S Y=$P(BSDXNOD,U)
"RTN","BSDX27",78,0)
. Q:'+Y
"RTN","BSDX27",79,0)
. X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",80,0)
. S BSDXAPT=Y ;Appointment date time
"RTN","BSDX27",81,0)
. S BSDXCLRK=$P(BSDXNOD,U,8) ;Appointment made by
"RTN","BSDX27",82,0)
. S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
"RTN","BSDX27",83,0)
. S Y=$P(BSDXNOD,U,9) ;Date Appointment Made
"RTN","BSDX27",84,0)
. I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",85,0)
. S BSDXMADE=Y
"RTN","BSDX27",86,0)
. ;NOTE
"RTN","BSDX27",87,0)
. S BSDXNOT=""
"RTN","BSDX27",88,0)
. I $D(^BSDXAPPT(BSDXIEN,1,0)) S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXIEN,1,BSDXQ)) Q:'+BSDXQ D
"RTN","BSDX27",89,0)
. . S BSDXLIN=$G(^BSDXAPPT(BSDXIEN,1,BSDXQ,0))
"RTN","BSDX27",90,0)
. . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
"RTN","BSDX27",91,0)
. . S BSDXNOT=BSDXNOT_BSDXLIN
"RTN","BSDX27",92,0)
. ;Resource
"RTN","BSDX27",93,0)
. S BSDXCID=$P(BSDXNOD,U,7) ;IEN of BSDX RESOURCE
"RTN","BSDX27",94,0)
. Q:'+BSDXCID
"RTN","BSDX27",95,0)
. Q:'$D(^BSDXRES(BSDXCID,0))
"RTN","BSDX27",96,0)
. S BSDXCNOD=$G(^BSDXRES(BSDXCID,0)) ;BSDX RESOURCE node
"RTN","BSDX27",97,0)
. Q:BSDXCNOD=""
"RTN","BSDX27",98,0)
. S BSDXCLN=$P(BSDXCNOD,U) ;Text name of BSDX Resource
"RTN","BSDX27",99,0)
. S BSDX44=$P(BSDXCNOD,U,4) ;File 44 pointer
"RTN","BSDX27",100,0)
. ;If appt entry in ^DPT(PAT,"S" exists for this clinic, get the TYPE/STATUS info from
"RTN","BSDX27",101,0)
. ;the BSDXDPT array and delete the BSDXDPT node
"RTN","BSDX27",102,0)
. S BSDXTYPE=""
"RTN","BSDX27",103,0)
. I +BSDX44,$D(BSDXDPT(BSDX44,$P(BSDXNOD,U))) D ;BSDXNOD is the BSDX APPOINTMENT node
"RTN","BSDX27",104,0)
. . S BSDXDNOD=BSDXDPT(BSDX44,$P(BSDXNOD,U)) ;BSDXDNOD is a copy of the ^DPT(PAT,"S" node
"RTN","BSDX27",105,0)
. . S BSDXTYPE=$$STATUS(BSDXPAT,$P(BSDXNOD,U),BSDXDNOD) ;IHS/OIT/HMW 20050208 Added
"RTN","BSDX27",106,0)
. . K BSDXDPT(BSDX44,$P(BSDXNOD,U))
"RTN","BSDX27",107,0)
. S BSDXI=BSDXI+1
"RTN","BSDX27",108,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",109,0)
. Q
"RTN","BSDX27",110,0)
;
"RTN","BSDX27",111,0)
;Go through remaining BSDXDPT( entries
"RTN","BSDX27",112,0)
I $D(BSDXDPT) S BSDX44=0 D
"RTN","BSDX27",113,0)
. F S BSDX44=$O(BSDXDPT(BSDX44)) Q:'+BSDX44 S BSDXDT=0 D
"RTN","BSDX27",114,0)
. . F S BSDXDT=$O(BSDXDPT(BSDX44,BSDXDT)) Q:'+BSDXDT D
"RTN","BSDX27",115,0)
. . . S BSDXDNOD=BSDXDPT(BSDX44,BSDXDT)
"RTN","BSDX27",116,0)
. . . S Y=BSDXDT
"RTN","BSDX27",117,0)
. . . Q:'+Y
"RTN","BSDX27",118,0)
. . . X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",119,0)
. . . S BSDXAPT=Y
"RTN","BSDX27",120,0)
. . . S BSDXTYPE=$$STATUS(BSDXPAT,BSDXDT,BSDXDNOD) ;IHS/OIT/HMW 20050208 Added
"RTN","BSDX27",121,0)
. . . S BSDXCLN=$P($G(^SC(BSDX44,0)),U)
"RTN","BSDX27",122,0)
. . . S BSDXCLRK=$P(BSDXDNOD,U,18)
"RTN","BSDX27",123,0)
. . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
"RTN","BSDX27",124,0)
. . . S Y=$P(BSDXDNOD,U,19)
"RTN","BSDX27",125,0)
. . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",126,0)
. . . S BSDXMADE=Y
"RTN","BSDX27",127,0)
. . . S BSDXNOT=""
"RTN","BSDX27",128,0)
. . . S BSDXI=BSDXI+1
"RTN","BSDX27",129,0)
. . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30)
"RTN","BSDX27",130,0)
. . . K BSDXDPT(BSDX44,BSDXDT)
"RTN","BSDX27",131,0)
;
"RTN","BSDX27",132,0)
S BSDXI=BSDXI+1
"RTN","BSDX27",133,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX27",134,0)
Q
"RTN","BSDX27",135,0)
;
"RTN","BSDX27",136,0)
STATUS(PAT,DATE,NODE) ; returns appt status
"RTN","BSDX27",137,0)
;IHS/OIT/HMW 20050208 Added from BSDDPA
"RTN","BSDX27",138,0)
NEW TYP
"RTN","BSDX27",139,0)
S TYP=$$APPTYP^BSDXAPI(PAT,DATE) ;sched vs. walkin
"RTN","BSDX27",140,0)
I $P(NODE,U,2)["C" Q TYP_" - CANCELLED"
"RTN","BSDX27",141,0)
I $P(NODE,U,2)'="NT",$P(NODE,U,2)["N" Q TYP_" - NO SHOW"
"RTN","BSDX27",142,0)
I $$CO^BSDXAPI(PAT,+NODE,DATE) Q TYP_" - CHECKED OUT"
"RTN","BSDX27",143,0)
I $$CI^BSDXAPI(PAT,+NODE,DATE) Q TYP_" - CHECKED IN"
"RTN","BSDX27",144,0)
Q TYP
"RTN","BSDX27",145,0)
;
"RTN","BSDX27",146,0)
ERROR ;
"RTN","BSDX27",147,0)
D ERR(BSDXI,"RPMS Error")
"RTN","BSDX27",148,0)
Q
"RTN","BSDX27",149,0)
;
"RTN","BSDX27",150,0)
ERR(BSDXI,ERRNO,MSG) ;Error processing
"RTN","BSDX27",151,0)
S:'$D(BSDXI) BSDXI=999
"RTN","BSDX27",152,0)
I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
"RTN","BSDX27",153,0)
E S BSDXERR=ERRNO
"RTN","BSDX27",154,0)
S BSDXI=BSDXI+1
"RTN","BSDX27",155,0)
S ^BSDXTMP($J,BSDXI)=MSG_"^^^^^^^^^^^^^^^"_$C(30)
"RTN","BSDX27",156,0)
S BSDXI=BSDXI+1
"RTN","BSDX27",157,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX27",158,0)
Q
"RTN","BSDX27",159,0)
PATINFO(BSDXPAT) ;EP
"RTN","BSDX27",160,0)
;Intrisic Function returns NAME^SEX^DOB^HRN^STREET^CITY^STATE^ZIP^PHONE for patient ien BSDXPAT
"RTN","BSDX27",161,0)
;DOB is in external format
"RTN","BSDX27",162,0)
;HRN depends on existence of DUZ(2)
"RTN","BSDX27",163,0)
;
"RTN","BSDX27",164,0)
N BSDXNOD,BSDXNAM,BSDXSEX,BSDXDOB,BSDXHRN,BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
"RTN","BSDX27",165,0)
S BSDXNOD=^DPT(+BSDXPAT,0)
"RTN","BSDX27",166,0)
S BSDXNAM=$P(BSDXNOD,U) ;NAME
"RTN","BSDX27",167,0)
S BSDXSEX=$P(BSDXNOD,U,2)
"RTN","BSDX27",168,0)
S BSDXSEX=$S(BSDXSEX="F":"FEMALE",BSDXSEX="M":"MALE",1:"")
"RTN","BSDX27",169,0)
S Y=$P(BSDXNOD,U,3) I Y]"" X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",170,0)
S BSDXDOB=Y ;DOB
"RTN","BSDX27",171,0)
S BSDXHRN=""
"RTN","BSDX27",172,0)
I $D(DUZ(2)) I DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPAT,41,DUZ(2),0)),U,2) ;HRN
"RTN","BSDX27",173,0)
;
"RTN","BSDX27",174,0)
S BSDXNOD=$G(^DPT(+BSDXPAT,.11))
"RTN","BSDX27",175,0)
S (BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP)=""
"RTN","BSDX27",176,0)
I BSDXNOD]"" D
"RTN","BSDX27",177,0)
. S BSDXSTRT=$E($P(BSDXNOD,U),1,50) ;STREET
"RTN","BSDX27",178,0)
. S BSDXCITY=$P(BSDXNOD,U,4) ;CITY
"RTN","BSDX27",179,0)
. S BSDXST=$P(BSDXNOD,U,5) ;STATE
"RTN","BSDX27",180,0)
. I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2)
"RTN","BSDX27",181,0)
. S BSDXZIP=$P(BSDXNOD,U,6) ;ZIP
"RTN","BSDX27",182,0)
;
"RTN","BSDX27",183,0)
S BSDXNOD=$G(^DPT(+BSDXPAT,.13)) ;PHONE
"RTN","BSDX27",184,0)
S BSDXPHON=$P(BSDXNOD,U)
"RTN","BSDX27",185,0)
;
"RTN","BSDX27",186,0)
Q BSDXNAM_U_BSDXSEX_U_BSDXDOB_U_BSDXHRN_U_BSDXSTRT_U_BSDXCITY_U_BSDXST_U_BSDXZIP_U_BSDXPHON
"RTN","BSDX27",187,0)
;
"RTN","BSDX27",188,0)
CLDISPD(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
"RTN","BSDX27",189,0)
;Entry point for debugging
"RTN","BSDX27",190,0)
;
"RTN","BSDX27",191,0)
;D DEBUG^%Serenji("CLDISP^BSDX27(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")
"RTN","BSDX27",192,0)
Q
"RTN","BSDX27",193,0)
;
"RTN","BSDX27",194,0)
CLDISP(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
"RTN","BSDX27",195,0)
;
"RTN","BSDX27",196,0)
;Return recordset of patient appointments
"RTN","BSDX27",197,0)
;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
"RTN","BSDX27",198,0)
;Used in listing a patient's appointments and generating patient letters.
"RTN","BSDX27",199,0)
;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
"RTN","BSDX27",200,0)
;BSDXBEG and BSDXEND are in external date form.
"RTN","BSDX27",201,0)
;Called by BSDX CLINIC LETTERS
"RTN","BSDX27",202,0)
;
"RTN","BSDX27",203,0)
; July 10, 2010 -- to support i18n, we pass dates from client in
"RTN","BSDX27",204,0)
; locale-neutral Fileman format. No need to convert it.
"RTN","BSDX27",205,0)
N BSDXI,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCID,BSDXCNOD,BSDXDT
"RTN","BSDX27",206,0)
N BSDXJ,BSDXAID,BSDXPAT,BSDXPNOD,BSDXCLN,BSDXCLRK,BSDXMADE,BSDXNOT,BSDXLIN
"RTN","BSDX27",207,0)
N BSDXSTRT
"RTN","BSDX27",208,0)
N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
"RTN","BSDX27",209,0)
S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX27",210,0)
K ^BSDXTMP($J)
"RTN","BSDX27",211,0)
S BSDXI=0
"RTN","BSDX27",212,0)
S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
"RTN","BSDX27",213,0)
S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30)
"RTN","BSDX27",214,0)
S X="ERROR^BSDX27",@^%ZOSF("TRAP")
"RTN","BSDX27",215,0)
;
"RTN","BSDX27",216,0)
;Convert beginning and ending dates
"RTN","BSDX27",217,0)
;
"RTN","BSDX27",218,0)
S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"
"RTN","BSDX27",219,0)
S BSDXEND=BSDXEND_".9999"
"RTN","BSDX27",220,0)
I BSDXCLST="" D ERR(BSDXI,0,"Routine: BSDX27, Error: Null clinic list") Q
"RTN","BSDX27",221,0)
;
"RTN","BSDX27",222,0)
;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN)
"RTN","BSDX27",223,0)
;
"RTN","BSDX27",224,0)
F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D
"RTN","BSDX27",225,0)
. S BSDXCLN=$G(^BSDXRES(BSDXCID,0)) S BSDXCLN=$P(BSDXCLN,U) Q:BSDXCLN=""
"RTN","BSDX27",226,0)
. S BSDXSTRT=BSDXBEG F S BSDXSTRT=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT)) Q:'+BSDXSTRT Q:BSDXSTRT>BSDXEND D
"RTN","BSDX27",227,0)
. . S BSDXAID=0 F S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID D
"RTN","BSDX27",228,0)
. . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0))
"RTN","BSDX27",229,0)
. . . Q:BSDXNOD=""
"RTN","BSDX27",230,0)
. . . Q:$P(BSDXNOD,U,12)]"" ;CANCELLED
"RTN","BSDX27",231,0)
. . . Q:$P(BSDXNOD,U,13)="y" ;WALKIN
"RTN","BSDX27",232,0)
. . . S Y=$P(BSDXNOD,U)
"RTN","BSDX27",233,0)
. . . Q:'+Y
"RTN","BSDX27",234,0)
. . . X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",235,0)
. . . S BSDXAPT=Y ;Appointment date time
"RTN","BSDX27",236,0)
. . . ;
"RTN","BSDX27",237,0)
. . . ;NOTE
"RTN","BSDX27",238,0)
. . . S BSDXNOT=""
"RTN","BSDX27",239,0)
. . . I $D(^BSDXAPPT(BSDXAID,1,0)) S BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXAID,1,BSDXQ)) Q:'+BSDXQ D
"RTN","BSDX27",240,0)
. . . . S BSDXLIN=$G(^BSDXAPPT(BSDXAID,1,BSDXQ,0))
"RTN","BSDX27",241,0)
. . . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
"RTN","BSDX27",242,0)
. . . . S BSDXNOT=BSDXNOT_BSDXLIN
"RTN","BSDX27",243,0)
. . . ;
"RTN","BSDX27",244,0)
. . . S BSDXPAT=$P(BSDXNOD,U,5)
"RTN","BSDX27",245,0)
. . . S BSDXPNOD=$$PATINFO(BSDXPAT)
"RTN","BSDX27",246,0)
. . . S BSDXNAM=$P(BSDXPNOD,U) ;NAME
"RTN","BSDX27",247,0)
. . . S BSDXSEX=$P(BSDXPNOD,U,2) ;SEX
"RTN","BSDX27",248,0)
. . . S BSDXDOB=$P(BSDXPNOD,U,3) ;DOB
"RTN","BSDX27",249,0)
. . . S BSDXHRN=$P(BSDXPNOD,U,4) ;Health Record Number for location DUZ(2)
"RTN","BSDX27",250,0)
. . . S BSDXSTRE=$P(BSDXPNOD,U,5) ;Street
"RTN","BSDX27",251,0)
. . . S BSDXCITY=$P(BSDXPNOD,U,6) ;City
"RTN","BSDX27",252,0)
. . . S BSDXST=$P(BSDXPNOD,U,7) ;State
"RTN","BSDX27",253,0)
. . . S BSDXZIP=$P(BSDXPNOD,U,8) ;zip
"RTN","BSDX27",254,0)
. . . S BSDXPHON=$P(BSDXPNOD,U,9) ;homephone
"RTN","BSDX27",255,0)
. . . S BSDXTYPE="" ;Type/status doesn't exist for BSDX APPT clinics and it's not needed for clinic letters
"RTN","BSDX27",256,0)
. . . S BSDXCLRK=$P(BSDXNOD,U,8)
"RTN","BSDX27",257,0)
. . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
"RTN","BSDX27",258,0)
. . . S Y=$P(BSDXNOD,U,9)
"RTN","BSDX27",259,0)
. . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",260,0)
. . . S BSDXMADE=Y
"RTN","BSDX27",261,0)
. . . S BSDXI=BSDXI+1
"RTN","BSDX27",262,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",263,0)
;
"RTN","BSDX27",264,0)
S BSDXI=BSDXI+1
"RTN","BSDX27",265,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX27",266,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.42;BSDX;;Dec 07, 2010;Build 9
"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^B51424449
"RTN","BSDX29",1,0)
BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:39pm
"RTN","BSDX29",2,0)
;;1.42;BSDX;;Dec 07, 2010;Build 9
"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)
; v1.42 by WV/SMH on 3101023
"RTN","BSDX29",8,0)
; - Transaction moved; now restartable too.
"RTN","BSDX29",9,0)
; --> Thanks to Zach Gonzalez and Rick Marshall.
"RTN","BSDX29",10,0)
; - Refactoring of major portions of routine
"RTN","BSDX29",11,0)
;
"RTN","BSDX29",12,0)
BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
"RTN","BSDX29",13,0)
;Entry point for debugging
"RTN","BSDX29",14,0)
;
"RTN","BSDX29",15,0)
D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")
"RTN","BSDX29",16,0)
Q
"RTN","BSDX29",17,0)
;
"RTN","BSDX29",18,0)
BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
"RTN","BSDX29",19,0)
;Copy appointments from HOSPITAL LOCATION entry BSDX44 to BSDX RESOURCE entry BSDXRES
"RTN","BSDX29",20,0)
;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive
"RTN","BSDX29",21,0)
;Called by RPC: BSDX COPY APPOINTMENTS
"RTN","BSDX29",22,0)
;
"RTN","BSDX29",23,0)
; Parameters:
"RTN","BSDX29",24,0)
; - BSDXY: Global Return
"RTN","BSDX29",25,0)
; - BSDXRES: BSDX RESOURCE to copy appointments to
"RTN","BSDX29",26,0)
; - BSDX44: Hospital Location IEN to copy appointments from
"RTN","BSDX29",27,0)
; - BSDXBEG: Beginning Date in FM Format
"RTN","BSDX29",28,0)
; - BSDXEND: End Date in FM Format
"RTN","BSDX29",29,0)
;
"RTN","BSDX29",30,0)
;Returns ADO Recordset containing TASK_NUMBER and ERRORID
"RTN","BSDX29",31,0)
;
"RTN","BSDX29",32,0)
; Return Array
"RTN","BSDX29",33,0)
S BSDXY=$NA(^BSDXTMP($J))
"RTN","BSDX29",34,0)
K ^BSDXTMP($J)
"RTN","BSDX29",35,0)
; $ET
"RTN","BSDX29",36,0)
N $ET S $ET="G ETRAP^BSDX29"
"RTN","BSDX29",37,0)
; Counter
"RTN","BSDX29",38,0)
N BSDXI S BSDXI=0
"RTN","BSDX29",39,0)
; Header Node
"RTN","BSDX29",40,0)
S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30)
"RTN","BSDX29",41,0)
;
"RTN","BSDX29",42,0)
; Make dates inclusive; add 1 to FM dates
"RTN","BSDX29",43,0)
S BSDXBEG=BSDXBEG-1
"RTN","BSDX29",44,0)
S BSDXEND=BSDXEND+1
"RTN","BSDX29",45,0)
;
"RTN","BSDX29",46,0)
; Taskman variables
"RTN","BSDX29",47,0)
N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
"RTN","BSDX29",48,0)
; Task Load
"RTN","BSDX29",49,0)
S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS"
"RTN","BSDX29",50,0)
S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")=""
"RTN","BSDX29",51,0)
D ^%ZTLOAD
"RTN","BSDX29",52,0)
; Set up return ADO.net dataset
"RTN","BSDX29",53,0)
N BSDXST S BSDXST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.")
"RTN","BSDX29",54,0)
S BSDXI=BSDXI+1
"RTN","BSDX29",55,0)
S ^BSDXTMP($J,BSDXI)=$G(ZTSK)_"^"_BSDXST_$C(30)_$C(31)
"RTN","BSDX29",56,0)
QUIT
"RTN","BSDX29",57,0)
;
"RTN","BSDX29",58,0)
ZTMD ;EP - Debug entry point
"RTN","BSDX29",59,0)
;D DEBUG^%Serenji("ZTM^BSDX29")
"RTN","BSDX29",60,0)
Q
"RTN","BSDX29",61,0)
;
"RTN","BSDX29",62,0)
ZTM ;EP - Taskman entry point
"RTN","BSDX29",63,0)
; Variables set up in ZTSAVE above
"RTN","BSDX29",64,0)
;
"RTN","BSDX29",65,0)
Q:'$D(ZTSK)
"RTN","BSDX29",66,0)
; $ET
"RTN","BSDX29",67,0)
N $ET S $ET="G ZTMERR^BSDX29"
"RTN","BSDX29",68,0)
; Txn
"RTN","BSDX29",69,0)
TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29"
"RTN","BSDX29",70,0)
;$O through ^SC(BSDX44,"S",
"RTN","BSDX29",71,0)
N BSDXCNT S BSDXCNT=0 ; Count of Copied Appointments
"RTN","BSDX29",72,0)
N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc
"RTN","BSDX29",73,0)
; Set Count
"RTN","BSDX29",74,0)
S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
"RTN","BSDX29",75,0)
; Loop through dates here.
"RTN","BSDX29",76,0)
F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D
"RTN","BSDX29",77,0)
. ; Loop through Entries in each date in the subsubfile.
"RTN","BSDX29",78,0)
. ; Quit if we are at the end or if a remote process requests a quit.
"RTN","BSDX29",79,0)
. N BSDXIEN S BSDXIEN=0
"RTN","BSDX29",80,0)
. F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D
"RTN","BSDX29",81,0)
. . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node
"RTN","BSDX29",82,0)
. . Q:'+BSDXNOD ; Quit if no node
"RTN","BSDX29",83,0)
. . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag
"RTN","BSDX29",84,0)
. . Q:BSDXCAN="C" ; Quit if appt cancelled
"RTN","BSDX29",85,0)
. . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient
"RTN","BSDX29",86,0)
. . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
"RTN","BSDX29",87,0)
. . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk)
"RTN","BSDX29",88,0)
. . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made
"RTN","BSDX29",89,0)
. . N BSDXNOTE S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note
"RTN","BSDX29",90,0)
. . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE)
"RTN","BSDX29",91,0)
. . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record
"RTN","BSDX29",92,0)
. . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag
"RTN","BSDX29",93,0)
. . Q
"RTN","BSDX29",94,0)
. Q
"RTN","BSDX29",95,0)
I 'BSDXQUIT TCOMMIT
"RTN","BSDX29",96,0)
E TROLLBACK
"RTN","BSDX29",97,0)
S ^BSDXTMP("BSDXCOPY",ZTSK)=$S(BSDXQUIT:"Cancelled. No records copied.",1:"Finished. "_BSDXCNT_" records copied.")
"RTN","BSDX29",98,0)
Q
"RTN","BSDX29",99,0)
;
"RTN","BSDX29",100,0)
ZTMERR ; For now, error from TM is only in trap; not returned to client.
"RTN","BSDX29",101,0)
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
"RTN","BSDX29",102,0)
; Rollback before logging the error
"RTN","BSDX29",103,0)
I $TL>0 TROLLBACK
"RTN","BSDX29",104,0)
D ^%ZTER
"RTN","BSDX29",105,0)
S $EC="" ; Clear Error
"RTN","BSDX29",106,0)
QUIT
"RTN","BSDX29",107,0)
;
"RTN","BSDX29",108,0)
XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
"RTN","BSDX29",109,0)
;
"RTN","BSDX29",110,0)
;Copy record to BSDX APPOINTMENT file
"RTN","BSDX29",111,0)
;Return 1 if record copied, otherwise 0
"RTN","BSDX29",112,0)
;
"RTN","BSDX29",113,0)
;$O Thru ^BSDXAPPT to determine if this appt already added
"RTN","BSDX29",114,0)
N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2
"RTN","BSDX29",115,0)
S BSDXIEN=0,BSDXFND=0
"RTN","BSDX29",116,0)
F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND
"RTN","BSDX29",117,0)
. S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
"RTN","BSDX29",118,0)
. Q:'+BSDXNOD
"RTN","BSDX29",119,0)
. S BSDXPAT2=$P(BSDXNOD,U,5)
"RTN","BSDX29",120,0)
. S BSDXFND=0
"RTN","BSDX29",121,0)
. I BSDXPAT2=BSDXPAT S BSDXFND=1
"RTN","BSDX29",122,0)
. Q
"RTN","BSDX29",123,0)
Q:BSDXFND 0
"RTN","BSDX29",124,0)
;
"RTN","BSDX29",125,0)
;Add to BSDX APPOINTMENT
"RTN","BSDX29",126,0)
S BSDXEND=BSDXBEG
"RTN","BSDX29",127,0)
;Calculate ending time from beginning time and duration.
"RTN","BSDX29",128,0)
S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN)
"RTN","BSDX29",129,0)
S BSDXIENS="+1,"
"RTN","BSDX29",130,0)
S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG
"RTN","BSDX29",131,0)
S BSDXFDA(9002018.4,BSDXIENS,.02)=BSDXEND
"RTN","BSDX29",132,0)
S BSDXFDA(9002018.4,BSDXIENS,.05)=BSDXPAT
"RTN","BSDX29",133,0)
S BSDXFDA(9002018.4,BSDXIENS,.07)=BSDXRES
"RTN","BSDX29",134,0)
S BSDXFDA(9002018.4,BSDXIENS,.08)=BSDXCLRK
"RTN","BSDX29",135,0)
S BSDXFDA(9002018.4,BSDXIENS,.09)=BSDXMADE
"RTN","BSDX29",136,0)
;
"RTN","BSDX29",137,0)
K BSDXIEN
"RTN","BSDX29",138,0)
D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX29",139,0)
S BSDXIEN=+$G(BSDXIEN(1))
"RTN","BSDX29",140,0)
I '+BSDXIEN Q 0
"RTN","BSDX29",141,0)
;
"RTN","BSDX29",142,0)
;Add WP field
"RTN","BSDX29",143,0)
I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D
"RTN","BSDX29",144,0)
. D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
"RTN","BSDX29",145,0)
;
"RTN","BSDX29",146,0)
Q 1
"RTN","BSDX29",147,0)
;
"RTN","BSDX29",148,0)
ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing
"RTN","BSDX29",149,0)
S BSDXI=BSDXI+1
"RTN","BSDX29",150,0)
S BSDXERR=$TR(BSDXERR,"^","~")
"RTN","BSDX29",151,0)
S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)
"RTN","BSDX29",152,0)
S BSDXI=BSDXI+1
"RTN","BSDX29",153,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX29",154,0)
Q
"RTN","BSDX29",155,0)
;
"RTN","BSDX29",156,0)
ETRAP ;EP Error trap entry
"RTN","BSDX29",157,0)
; No Txn here. So don't rollback anything
"RTN","BSDX29",158,0)
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
"RTN","BSDX29",159,0)
D ^%ZTER
"RTN","BSDX29",160,0)
S $EC="" ; Clear error
"RTN","BSDX29",161,0)
I '$D(BSDXI) N BSDXI S BSDXI=0
"RTN","BSDX29",162,0)
D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
"RTN","BSDX29",163,0)
Q
"RTN","BSDX29",164,0)
;
"RTN","BSDX29",165,0)
CPSTAT(BSDXY,BSDXTSK) ;EP - Note: As of Dec 6 2010: Inactive Code
"RTN","BSDX29",166,0)
;Return status (copied record count) of tasked job having ZTSK=BSDXTSK
"RTN","BSDX29",167,0)
;
"RTN","BSDX29",168,0)
S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX29",169,0)
N BSDXI,BSDXCNT
"RTN","BSDX29",170,0)
S BSDXI=0
"RTN","BSDX29",171,0)
S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
"RTN","BSDX29",172,0)
S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
"RTN","BSDX29",173,0)
S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK))
"RTN","BSDX29",174,0)
I BSDXCNT["Finished" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
"RTN","BSDX29",175,0)
I BSDXCNT["Cancelled" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
"RTN","BSDX29",176,0)
;I $D(^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")) K ^BSDXTMP("BSDXCOPY",BSDXTSK)
"RTN","BSDX29",177,0)
S BSDXI=BSDXI+1
"RTN","BSDX29",178,0)
S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31)
"RTN","BSDX29",179,0)
Q
"RTN","BSDX29",180,0)
;
"RTN","BSDX29",181,0)
CPCANC(BSDXY,BSDXTSK) ;EP Note: As of Dec 6 2010: Inactive code.
"RTN","BSDX29",182,0)
;Signal tasked job having ZTSK=BSDXTSK to cancel
"RTN","BSDX29",183,0)
;Returns current record count of copy process
"RTN","BSDX29",184,0)
;
"RTN","BSDX29",185,0)
S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX29",186,0)
N BSDXI,BSDXCNT
"RTN","BSDX29",187,0)
S BSDXI=0
"RTN","BSDX29",188,0)
S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
"RTN","BSDX29",189,0)
S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
"RTN","BSDX29",190,0)
S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK))
"RTN","BSDX29",191,0)
I BSDXCNT["FINISHED" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
"RTN","BSDX29",192,0)
E S ^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")=""
"RTN","BSDX29",193,0)
S BSDXI=BSDXI+1
"RTN","BSDX29",194,0)
S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31)
"RTN","BSDX29",195,0)
Q
"RTN","BSDX29",196,0)
;
"RTN","BSDX29",197,0)
ADDMIN(BSDXSTRT,BSDXLEN) ;
"RTN","BSDX29",198,0)
;
"RTN","BSDX29",199,0)
;Add BSDXLEN minutes to time BSDXSTRT and return end time
"RTN","BSDX29",200,0)
N BSDXEND,BSDXH,BSDXM,BSDXSTIM,BSDXETIM
"RTN","BSDX29",201,0)
S BSDXEND=$P(BSDXSTRT,".")
"RTN","BSDX29",202,0)
;
"RTN","BSDX29",203,0)
;Convert start time to minutes past midnight
"RTN","BSDX29",204,0)
S BSDXSTIM=$P(BSDXSTRT,".",2)
"RTN","BSDX29",205,0)
S BSDXSTIM=BSDXSTIM_"0000"
"RTN","BSDX29",206,0)
S BSDXSTIM=$E(BSDXSTIM,1,4)
"RTN","BSDX29",207,0)
S BSDXH=$E(BSDXSTIM,1,2)
"RTN","BSDX29",208,0)
S BSDXH=BSDXH*60
"RTN","BSDX29",209,0)
S BSDXH=BSDXH+$E(BSDXSTIM,3,4)
"RTN","BSDX29",210,0)
;
"RTN","BSDX29",211,0)
;Add duration to find minutes past midnight of end time
"RTN","BSDX29",212,0)
S BSDXETIM=BSDXH+BSDXLEN
"RTN","BSDX29",213,0)
;
"RTN","BSDX29",214,0)
;Convert back to a time
"RTN","BSDX29",215,0)
S BSDXH=BSDXETIM\60
"RTN","BSDX29",216,0)
S BSDXH="00"_BSDXH
"RTN","BSDX29",217,0)
S BSDXH=$E(BSDXH,$L(BSDXH)-1,$L(BSDXH))
"RTN","BSDX29",218,0)
S BSDXM=BSDXETIM#60
"RTN","BSDX29",219,0)
S BSDXM="00"_BSDXM
"RTN","BSDX29",220,0)
S BSDXM=$E(BSDXM,$L(BSDXM)-1,$L(BSDXM))
"RTN","BSDX29",221,0)
S BSDXETIM=BSDXH_BSDXM
"RTN","BSDX29",222,0)
I BSDXETIM>2400 S BSDXETIM=2400
"RTN","BSDX29",223,0)
S $P(BSDXEND,".",2)=BSDXETIM
"RTN","BSDX29",224,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.42;BSDX;;Dec 07, 2010;Build 9
"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 X<XVRMIN D SORRY(XPXPKG_" "_XVRMIN_" Is Not Installed") Q 0
"RTN","BSDX2E",53,0)
Q 1
"RTN","BSDX2E",54,0)
;
"RTN","BSDX2E",55,0)
PATCHCK(XPXPCH) ;
"RTN","BSDX2E",56,0)
S X=$$PATCH^XPDUTL(XPXPCH)
"RTN","BSDX2E",57,0)
W !!,$$C^XBFUNC("Need "_XPXPCH_"....."_XPXPCH_" "_$S(X:"Is",1:"Is Not")_" Present")
"RTN","BSDX2E",58,0)
Q X
"RTN","BSDX2E",59,0)
;
"RTN","BSDX2E",60,0)
V0200 ;EP Version 1.3 PostInit
"RTN","BSDX2E",61,0)
;Add Protocol items to SDAM APPOINTMENT EVENTS protocol
"RTN","BSDX2E",62,0)
;Remove protocols known to cause problems from SDAM APPOINTMENT EVENTS
"RTN","BSDX2E",63,0)
;
"RTN","BSDX2E",64,0)
N BSDXDA,BSDXFDA,BSDXDA1,BSDXSEQ,BSDXDAT,BSDXNOD,BSDXIEN,BSDXMSG
"RTN","BSDX2E",65,0)
;
"RTN","BSDX2E",66,0)
; 1st, add the BSDX event protocols
"RTN","BSDX2E",67,0)
; Get SDAM APPOINTMENT EVENTS IEN in 101
"RTN","BSDX2E",68,0)
S BSDXDA=$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))
"RTN","BSDX2E",69,0)
Q:'+BSDXDA
"RTN","BSDX2E",70,0)
; Add each of those protocols unless they already exist.
"RTN","BSDX2E",71,0)
S BSDXDAT="BSDX ADD APPOINTMENT;10.2^BSDX CANCEL APPOINTMENT;10.4^BSDX CHECKIN APPOINTMENT;10.6^BSDX NOSHOW APPOINTMENT;10.8"
"RTN","BSDX2E",72,0)
; For each
"RTN","BSDX2E",73,0)
F J=1:1:$L(BSDXDAT,U) D
"RTN","BSDX2E",74,0)
. K BSDXIEN,BSDXMSG,BSDXFDA
"RTN","BSDX2E",75,0)
. ; Get Item
"RTN","BSDX2E",76,0)
. S BSDXNOD=$P(BSDXDAT,U,J)
"RTN","BSDX2E",77,0)
. ; Get Item Name (BSDX ADD APPOINTMENT)
"RTN","BSDX2E",78,0)
. S BSDXDA1=$P(BSDXNOD,";")
"RTN","BSDX2E",79,0)
. ; Get Item Sequence (10.2)
"RTN","BSDX2E",80,0)
. S BSDXSEQ=$P(BSDXNOD,";",2)
"RTN","BSDX2E",81,0)
. ; Get Item Reference (Item is already in the protocol file)
"RTN","BSDX2E",82,0)
. S BSDXDA1=$O(^ORD(101,"B",BSDXDA1,0))
"RTN","BSDX2E",83,0)
. ; Quit if not found
"RTN","BSDX2E",84,0)
. Q:'+BSDXDA1
"RTN","BSDX2E",85,0)
. ; Quit if already exists in the SDAM protocol
"RTN","BSDX2E",86,0)
. Q:$D(^ORD(101,BSDXDA,10,"B",BSDXDA1))
"RTN","BSDX2E",87,0)
. ; Go ahead and save it.
"RTN","BSDX2E",88,0)
. S BSDXFDA(101.01,"+1,"_BSDXDA_",",".01")=BSDXDA1
"RTN","BSDX2E",89,0)
. S BSDXFDA(101.01,"+1,"_BSDXDA_",","3")=BSDXSEQ
"RTN","BSDX2E",90,0)
. D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX2E",91,0)
. ; Error message
"RTN","BSDX2E",92,0)
. I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
"RTN","BSDX2E",93,0)
;
"RTN","BSDX2E",94,0)
; Remove nassssty protocols ORU PATIENT MOVMT and DVBA C&P SCHD EVENT
"RTN","BSDX2E",95,0)
; SDAM APPOINTMENT EVENTS IENS for use in FIND1^DIC
"RTN","BSDX2E",96,0)
N SDEVTIENS S SDEVTIENS=","_BSDXDA_","
"RTN","BSDX2E",97,0)
; Subfile entry for ORU...
"RTN","BSDX2E",98,0)
N ORUIEN S ORUIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","ORU PATIENT MOVMT")
"RTN","BSDX2E",99,0)
; Subfile entry for DVBA...
"RTN","BSDX2E",100,0)
N DVBAIEN S DVBAIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","DVBA C&P SCHD EVENT")
"RTN","BSDX2E",101,0)
; Deletion code
"RTN","BSDX2E",102,0)
N BSDXFDA,BSDXMSG
"RTN","BSDX2E",103,0)
S:ORUIEN>0 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.42;BSDX;;Dec 07, 2010;Build 9
"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^B67823338
"RTN","BSDX31",1,0)
BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:39pm
"RTN","BSDX31",2,0)
;;1.42;BSDX;;Dec 07, 2010;Build 9
"RTN","BSDX31",3,0)
; Change Log:
"RTN","BSDX31",4,0)
; v1.42 Oct 23 2010 WV/SMH
"RTN","BSDX31",5,0)
; - Change transaction to restartable. Thanks to Zach Gonzalez
"RTN","BSDX31",6,0)
; --> and Rick Marshall for their help.
"RTN","BSDX31",7,0)
; v1.42 Dec 6 2010: Extensive refactoring
"RTN","BSDX31",8,0)
;
"RTN","BSDX31",9,0)
; Error Reference:
"RTN","BSDX31",10,0)
; -1: zero or null Appt ID
"RTN","BSDX31",11,0)
; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT)
"RTN","BSDX31",12,0)
; -3: No-show flag is invalid
"RTN","BSDX31",13,0)
; -4: Filing of No-show in ^BSDXAPPT failed
"RTN","BSDX31",14,0)
; -5: Filing of No-show in ^DPT failed (BSDXAPI error)
"RTN","BSDX31",15,0)
; -100: M Error
"RTN","BSDX31",16,0)
;
"RTN","BSDX31",17,0)
;
"RTN","BSDX31",18,0)
NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP
"RTN","BSDX31",19,0)
;Entry point for debugging
"RTN","BSDX31",20,0)
;
"RTN","BSDX31",21,0)
D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")
"RTN","BSDX31",22,0)
Q
"RTN","BSDX31",23,0)
;
"RTN","BSDX31",24,0)
UT ; Unit Tests
"RTN","BSDX31",25,0)
; Test 1: Sanity Check
"RTN","BSDX31",26,0)
N ZZZ ; Garbage return variable
"RTN","BSDX31",27,0)
N DATE S DATE=$$NOW^XLFDT()
"RTN","BSDX31",28,0)
S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform
"RTN","BSDX31",29,0)
D APPADD^BSDX07(.ZZZ,DATE,DATE+.0001,3,"Dr Office",30,"Old Note",1)
"RTN","BSDX31",30,0)
N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDX31",31,0)
D NOSHOW(.ZZZ,APPID,1)
"RTN","BSDX31",32,0)
I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",! B
"RTN","BSDX31",33,0)
I $P(^DPT(3,"S",DATE,0),U,2)'="N" W "ERROR T1",! B
"RTN","BSDX31",34,0)
; Test 2: Undo noshow
"RTN","BSDX31",35,0)
D NOSHOW(.ZZZ,APPID,0)
"RTN","BSDX31",36,0)
I $P(^BSDXAPPT(APPID,0),U,10)'="0" W "ERROR T2",! B
"RTN","BSDX31",37,0)
I $P(^DPT(3,"S",DATE,0),U,2)'="" W "ERROR T2",! B
"RTN","BSDX31",38,0)
; Test 3: -1
"RTN","BSDX31",39,0)
D NOSHOW(.ZZZ,"",0)
"RTN","BSDX31",40,0)
I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",! B
"RTN","BSDX31",41,0)
; Test 4: -2
"RTN","BSDX31",42,0)
D NOSHOW(.ZZZ,2938748233,0)
"RTN","BSDX31",43,0)
I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",! B
"RTN","BSDX31",44,0)
; Test 5: -3
"RTN","BSDX31",45,0)
D NOSHOW(.ZZZ,APPID,3)
"RTN","BSDX31",46,0)
I $P(^BSDXTMP($J,1),U)'=-3 W "ERROR T5",! B
"RTN","BSDX31",47,0)
; Test 6: Mumps error (-100)
"RTN","BSDX31",48,0)
s bsdxdie=1
"RTN","BSDX31",49,0)
D NOSHOW(.ZZZ,APPID,1)
"RTN","BSDX31",50,0)
I $P(^BSDXTMP($J,1),U)'=-100 W "ERROR T6",! B
"RTN","BSDX31",51,0)
k bsdxdie
"RTN","BSDX31",52,0)
; Test 7: Restartable transaction
"RTN","BSDX31",53,0)
s bsdxrestart=1
"RTN","BSDX31",54,0)
D NOSHOW(.ZZZ,APPID,1)
"RTN","BSDX31",55,0)
I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T7",! B
"RTN","BSDX31",56,0)
QUIT
"RTN","BSDX31",57,0)
NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP - No show a patient
"RTN","BSDX31",58,0)
; Called by RPC: BSDX NOSHOW
"RTN","BSDX31",59,0)
; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2
"RTN","BSDX31",60,0)
;
"RTN","BSDX31",61,0)
; Parameters:
"RTN","BSDX31",62,0)
; BSDXY: Global Return
"RTN","BSDX31",63,0)
; BSDXAPTID is entry number in BSDX APPOINTMENT file
"RTN","BSDX31",64,0)
; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO
"RTN","BSDX31",65,0)
;
"RTN","BSDX31",66,0)
; Returns ADO.net record set with fields
"RTN","BSDX31",67,0)
; - ERRORID; ERRORTEXT
"RTN","BSDX31",68,0)
; ERRORID of 1 is okay
"RTN","BSDX31",69,0)
; Anything else is an error.
"RTN","BSDX31",70,0)
;
"RTN","BSDX31",71,0)
; Return Array; set and clear
"RTN","BSDX31",72,0)
S BSDXY=$NA(^BSDXTMP($J))
"RTN","BSDX31",73,0)
K ^BSDXTMP($J)
"RTN","BSDX31",74,0)
; $ET
"RTN","BSDX31",75,0)
N $ET S $ET="G ETRAP^BSDX31"
"RTN","BSDX31",76,0)
; Basline vars
"RTN","BSDX31",77,0)
D ^XBKVAR ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist
"RTN","BSDX31",78,0)
; Counter
"RTN","BSDX31",79,0)
N BSDXI S BSDXI=0
"RTN","BSDX31",80,0)
; Header Node
"RTN","BSDX31",81,0)
S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30)
"RTN","BSDX31",82,0)
; Begin transaction
"RTN","BSDX31",83,0)
TSTART (BSDXI,BSDXY,BSDXAPTID,BSDXNS):T="BSDX NOSHOW CANCEL^BSDX29"
"RTN","BSDX31",84,0)
;;;test for error inside transaction. See if %ZTER works
"RTN","BSDX31",85,0)
I $G(bsdxdie) S X=1/0
"RTN","BSDX31",86,0)
;;;TEST
"RTN","BSDX31",87,0)
;;;test for TRESTART
"RTN","BSDX31",88,0)
I $G(bsdxrestart) K bsdxrestart TRESTART
"RTN","BSDX31",89,0)
;;;test
"RTN","BSDX31",90,0)
; Turn off SDAM APPT PROTOCOL BSDX Entries
"RTN","BSDX31",91,0)
N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
"RTN","BSDX31",92,0)
; Appointment ID check
"RTN","BSDX31",93,0)
I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q
"RTN","BSDX31",94,0)
I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q
"RTN","BSDX31",95,0)
; Noshow value check - Must be 1 or 0
"RTN","BSDX31",96,0)
S BSDXNS=+BSDXNS
"RTN","BSDX31",97,0)
I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q
"RTN","BSDX31",98,0)
; Get Some data
"RTN","BSDX31",99,0)
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node
"RTN","BSDX31",100,0)
N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
"RTN","BSDX31",101,0)
N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date/Time
"RTN","BSDX31",102,0)
; Edit BSDX APPOINTMENT entry
"RTN","BSDX31",103,0)
N BSDXMSG ;
"RTN","BSDX31",104,0)
D BSDXNOS(BSDXAPTID,BSDXNS,.BSDXMSG) ;Edit BSDX APPOINTMENT entry NOSHOW field
"RTN","BSDX31",105,0)
I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(-4,"BSDX31: "_BSDXMSG) Q
"RTN","BSDX31",106,0)
; Edit File 2 "S" node entry
"RTN","BSDX31",107,0)
N BSDXZ,BSDXERR ; Error variables to control looping
"RTN","BSDX31",108,0)
S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
"RTN","BSDX31",109,0)
; If Resource ID exists, and HL exists (means that Resource is linked), No show in File 2
"RTN","BSDX31",110,0)
I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(-5,BSDXERR) Q
"RTN","BSDX31",111,0)
. S BSDXNOD=^BSDXRES(BSDXSC1,0)
"RTN","BSDX31",112,0)
. S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
"RTN","BSDX31",113,0)
. I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS)
"RTN","BSDX31",114,0)
;
"RTN","BSDX31",115,0)
TCOMMIT
"RTN","BSDX31",116,0)
S BSDXI=BSDXI+1
"RTN","BSDX31",117,0)
S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay
"RTN","BSDX31",118,0)
S BSDXI=BSDXI+1
"RTN","BSDX31",119,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX31",120,0)
QUIT
"RTN","BSDX31",121,0)
;
"RTN","BSDX31",122,0)
APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS) ;
"RTN","BSDX31",123,0)
; update file 2 info
"RTN","BSDX31",124,0)
;Set noshow for patient BSDXDFN in clinic BSDXSC1
"RTN","BSDX31",125,0)
;at time BSDXSD
"RTN","BSDX31",126,0)
N BSDXC,%H,BSDXCDT,BSDXIEN
"RTN","BSDX31",127,0)
N BSDXIENS,BSDXFDA,BSDXMSG
"RTN","BSDX31",128,0)
S %H=$H D YMD^%DTC
"RTN","BSDX31",129,0)
S BSDXCDT=X+%
"RTN","BSDX31",130,0)
;
"RTN","BSDX31",131,0)
S BSDXIENS=BSDXSD_","_BSDXDFN_","
"RTN","BSDX31",132,0)
I +BSDXNS D
"RTN","BSDX31",133,0)
. S BSDXFDA(2.98,BSDXIENS,3)="N"
"RTN","BSDX31",134,0)
. S BSDXFDA(2.98,BSDXIENS,14)=DUZ
"RTN","BSDX31",135,0)
. S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT
"RTN","BSDX31",136,0)
E D
"RTN","BSDX31",137,0)
. S BSDXFDA(2.98,BSDXIENS,3)=""
"RTN","BSDX31",138,0)
. S BSDXFDA(2.98,BSDXIENS,14)=""
"RTN","BSDX31",139,0)
. S BSDXFDA(2.98,BSDXIENS,15)=""
"RTN","BSDX31",140,0)
K BSDXIEN
"RTN","BSDX31",141,0)
D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX31",142,0)
S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1))
"RTN","BSDX31",143,0)
Q
"RTN","BSDX31",144,0)
;
"RTN","BSDX31",145,0)
BSDXNOS(BSDXAPTID,BSDXNS,BSDXMSG) ;
"RTN","BSDX31",146,0)
;
"RTN","BSDX31",147,0)
N BSDXFDA,BSDXIENS
"RTN","BSDX31",148,0)
S BSDXIENS=BSDXAPTID_","
"RTN","BSDX31",149,0)
S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW
"RTN","BSDX31",150,0)
D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX31",151,0)
QUIT
"RTN","BSDX31",152,0)
;
"RTN","BSDX31",153,0)
NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event
"RTN","BSDX31",154,0)
;when appointments NOSHOW via PIMS interface.
"RTN","BSDX31",155,0)
;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients
"RTN","BSDX31",156,0)
;
"RTN","BSDX31",157,0)
Q:+$G(BSDXNOEV)
"RTN","BSDX31",158,0)
Q:'+$G(BSDXSC)
"RTN","BSDX31",159,0)
Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
"RTN","BSDX31",160,0)
N BSDXSTAT,BSDXFOUND,BSDXRES
"RTN","BSDX31",161,0)
S BSDXSTAT=1
"RTN","BSDX31",162,0)
S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0
"RTN","BSDX31",163,0)
S BSDXFOUND=0
"RTN","BSDX31",164,0)
I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
"RTN","BSDX31",165,0)
I BSDXFOUND D NOSEVT3(BSDXRES) Q
"RTN","BSDX31",166,0)
I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
"RTN","BSDX31",167,0)
I BSDXFOUND D NOSEVT3(BSDXRES)
"RTN","BSDX31",168,0)
Q
"RTN","BSDX31",169,0)
;
"RTN","BSDX31",170,0)
NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
"RTN","BSDX31",171,0)
;Get appointment id in BSDXAPT
"RTN","BSDX31",172,0)
;If found, call BSDXNOS(BSDXAPPT) and return 1
"RTN","BSDX31",173,0)
;else return 0
"RTN","BSDX31",174,0)
N BSDXFOUND,BSDXAPPT
"RTN","BSDX31",175,0)
S BSDXFOUND=0
"RTN","BSDX31",176,0)
Q:'+$G(BSDXRES) BSDXFOUND
"RTN","BSDX31",177,0)
Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
"RTN","BSDX31",178,0)
S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND
"RTN","BSDX31",179,0)
. S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
"RTN","BSDX31",180,0)
. I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
"RTN","BSDX31",181,0)
I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT)
"RTN","BSDX31",182,0)
Q BSDXFOUND
"RTN","BSDX31",183,0)
;
"RTN","BSDX31",184,0)
NOSEVT3(BSDXRES) ;
"RTN","BSDX31",185,0)
;Call RaiseEvent to notify GUI clients
"RTN","BSDX31",186,0)
;
"RTN","BSDX31",187,0)
N BSDXRESN
"RTN","BSDX31",188,0)
S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
"RTN","BSDX31",189,0)
Q:BSDXRESN=""
"RTN","BSDX31",190,0)
S BSDXRESN=$P(BSDXRESN,"^")
"RTN","BSDX31",191,0)
D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
"RTN","BSDX31",192,0)
Q
"RTN","BSDX31",193,0)
;
"RTN","BSDX31",194,0)
;
"RTN","BSDX31",195,0)
ERR(BSDXERID,ERRTXT) ;Error processing
"RTN","BSDX31",196,0)
S BSDXI=BSDXI+1
"RTN","BSDX31",197,0)
S ERRTXT=$TR(ERRTXT,"^","~")
"RTN","BSDX31",198,0)
I $TL>0 TROLLBACK
"RTN","BSDX31",199,0)
S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
"RTN","BSDX31",200,0)
S BSDXI=BSDXI+1
"RTN","BSDX31",201,0)
S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX31",202,0)
QUIT
"RTN","BSDX31",203,0)
;
"RTN","BSDX31",204,0)
ETRAP ;EP Error trap entry
"RTN","BSDX31",205,0)
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
"RTN","BSDX31",206,0)
; Rollback, otherwise ^XTER will be empty from future rollback
"RTN","BSDX31",207,0)
I $TL>0 TROLLBACK
"RTN","BSDX31",208,0)
D ^%ZTER
"RTN","BSDX31",209,0)
S $EC="" ; Clear Error
"RTN","BSDX31",210,0)
; Send to client
"RTN","BSDX31",211,0)
I '$D(BSDXI) N BSDXI S BSDXI=0
"RTN","BSDX31",212,0)
D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE))
"RTN","BSDX31",213,0)
QUIT
"RTN","BSDX31",214,0)
;
"RTN","BSDX31",215,0)
IMHERE(BSDXRES) ;EP
"RTN","BSDX31",216,0)
;Entry point for BSDX IM HERE remote procedure
"RTN","BSDX31",217,0)
S BSDXRES=1
"RTN","BSDX31",218,0)
Q
"RTN","BSDX31",219,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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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.42;BSDX;;Dec 07, 2010;Build 9
"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^B105784370
"RTN","BSDXAPI",1,0)
BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 12/6/10 5:50pm
"RTN","BSDXAPI",2,0)
;;1.42;BSDX;;Dec 07, 2010;Build 9
"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)
; 2010-11-5:
"RTN","BSDXAPI",8,0)
; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment.
"RTN","BSDXAPI",9,0)
; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API.
"RTN","BSDXAPI",10,0)
; 2010-11-12:
"RTN","BSDXAPI",11,0)
; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well.
"RTN","BSDXAPI",12,0)
; 2010-12-5
"RTN","BSDXAPI",13,0)
; Added an entry point to update the patient note in file 44.
"RTN","BSDXAPI",14,0)
; 2010-12-6
"RTN","BSDXAPI",15,0)
; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI")
"RTN","BSDXAPI",16,0)
; 2010-12-8
"RTN","BSDXAPI",17,0)
; Removed restriction on max appt length. Even though this restriction
"RTN","BSDXAPI",18,0)
; exists in fileman (120 minutes), PIMS ignores it. Therefore, I
"RTN","BSDXAPI",19,0)
; will ignore it here too.
"RTN","BSDXAPI",20,0)
;
"RTN","BSDXAPI",21,0)
MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
"RTN","BSDXAPI",22,0)
; Call like this for DFN 23435 having an appointment at Hospital Location 33
"RTN","BSDXAPI",23,0)
; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
"RTN","BSDXAPI",24,0)
; for Baby foxes hallucinations.
"RTN","BSDXAPI",25,0)
; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
"RTN","BSDXAPI",26,0)
S BSDR("PAT")=DFN ;DFN
"RTN","BSDXAPI",27,0)
S BSDR("CLN")=CLIN ;Hosp Loc IEN
"RTN","BSDXAPI",28,0)
S BSDR("TYP")=TYP ;3 sched or 4 walkin
"RTN","BSDXAPI",29,0)
S BSDR("ADT")=DATE ;Appointment date in FM format
"RTN","BSDXAPI",30,0)
S BSDR("LEN")=LEN ;Appt len upto 240 (min)
"RTN","BSDXAPI",31,0)
S BSDR("OI")=INFO ;Reason for appt - up to 150 char
"RTN","BSDXAPI",32,0)
S BSDR("USR")=DUZ ;Person who made appt - current user
"RTN","BSDXAPI",33,0)
Q $$MAKE(.BSDR)
"RTN","BSDXAPI",34,0)
;
"RTN","BSDXAPI",35,0)
MAKE(BSDR) ;PEP; call to store appt made
"RTN","BSDXAPI",36,0)
;
"RTN","BSDXAPI",37,0)
; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
"RTN","BSDXAPI",38,0)
;
"RTN","BSDXAPI",39,0)
; Input Array -
"RTN","BSDXAPI",40,0)
; BSDR("PAT") = ien of patient in file 2
"RTN","BSDXAPI",41,0)
; BSDR("CLN") = ien of clinic in file 44
"RTN","BSDXAPI",42,0)
; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
"RTN","BSDXAPI",43,0)
; BSDR("ADT") = appointment date and time
"RTN","BSDXAPI",44,0)
; BSDR("LEN") = appointment length in minutes (5-120)
"RTN","BSDXAPI",45,0)
; BSDR("OI") = reason for appt - up to 150 characters
"RTN","BSDXAPI",46,0)
; BSDR("USR") = user who made appt
"RTN","BSDXAPI",47,0)
;
"RTN","BSDXAPI",48,0)
;Output: error status and message
"RTN","BSDXAPI",49,0)
; = 0 or null: everything okay
"RTN","BSDXAPI",50,0)
; = 1^message: error and reason
"RTN","BSDXAPI",51,0)
;
"RTN","BSDXAPI",52,0)
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
"RTN","BSDXAPI",53,0)
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
"RTN","BSDXAPI",54,0)
I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
"RTN","BSDXAPI",55,0)
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
"RTN","BSDXAPI",56,0)
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
"RTN","BSDXAPI",57,0)
;
"RTN","BSDXAPI",58,0)
;I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) ; v 1.42 - no check on length is done anymore. see top comments for details.
"RTN","BSDXAPI",59,0)
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
"RTN","BSDXAPI",60,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",61,0)
;
"RTN","BSDXAPI",62,0)
NEW DIC,DA,Y,X,DD,DO,DLAYGO
"RTN","BSDXAPI",63,0)
;
"RTN","BSDXAPI",64,0)
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
"RTN","BSDXAPI",65,0)
. ; "un-cancel" existing appt in file 2
"RTN","BSDXAPI",66,0)
. N BSDXFDA,BSDXIENS,BSDXMSG
"RTN","BSDXAPI",67,0)
. S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
"RTN","BSDXAPI",68,0)
. S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
"RTN","BSDXAPI",69,0)
. S BSDXFDA(2.98,BSDXIENS,"3")=""
"RTN","BSDXAPI",70,0)
. S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
"RTN","BSDXAPI",71,0)
. S BSDXFDA(2.98,BSDXIENS,"9.5")=9
"RTN","BSDXAPI",72,0)
. S BSDXFDA(2.98,BSDXIENS,"14")=""
"RTN","BSDXAPI",73,0)
. S BSDXFDA(2.98,BSDXIENS,"15")=""
"RTN","BSDXAPI",74,0)
. S BSDXFDA(2.98,BSDXIENS,"16")=""
"RTN","BSDXAPI",75,0)
. S BSDXFDA(2.98,BSDXIENS,"19")=""
"RTN","BSDXAPI",76,0)
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
"RTN","BSDXAPI",77,0)
. D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDXAPI",78,0)
. N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
"RTN","BSDXAPI",79,0)
E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
"RTN","BSDXAPI",80,0)
. N BSDXFDA,BSDXIENS,BSDXMSG
"RTN","BSDXAPI",81,0)
. S BSDXIENS="?+2,"_BSDR("PAT")_","
"RTN","BSDXAPI",82,0)
. S BSDXIENS(2)=BSDR("ADT")
"RTN","BSDXAPI",83,0)
. S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
"RTN","BSDXAPI",84,0)
. S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
"RTN","BSDXAPI",85,0)
. S BSDXFDA(2.98,BSDXIENS,"9.5")=9
"RTN","BSDXAPI",86,0)
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
"RTN","BSDXAPI",87,0)
. D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
"RTN","BSDXAPI",88,0)
; add appt to file 44
"RTN","BSDXAPI",89,0)
K DIC,DA,X,Y,DLAYGO,DD,DO
"RTN","BSDXAPI",90,0)
I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
"RTN","BSDXAPI",91,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",92,0)
. S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
"RTN","BSDXAPI",93,0)
. S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
"RTN","BSDXAPI",94,0)
. S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
"RTN","BSDXAPI",95,0)
;
"RTN","BSDXAPI",96,0)
; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
"RTN","BSDXAPI",97,0)
;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
"RTN","BSDXAPI",98,0)
;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
"RTN","BSDXAPI",99,0)
;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
"RTN","BSDXAPI",100,0)
;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
"RTN","BSDXAPI",101,0)
;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
"RTN","BSDXAPI",102,0)
;D FILE^DICN
"RTN","BSDXAPI",103,0)
;
"RTN","BSDXAPI",104,0)
N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_","
"RTN","BSDXAPI",105,0)
N BSDXFDA
"RTN","BSDXAPI",106,0)
S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT")
"RTN","BSDXAPI",107,0)
S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN")
"RTN","BSDXAPI",108,0)
S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150)
"RTN","BSDXAPI",109,0)
S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR")
"RTN","BSDXAPI",110,0)
S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".")
"RTN","BSDXAPI",111,0)
N BSDXERR
"RTN","BSDXAPI",112,0)
D UPDATE^DIE("","BSDXFDA","","BSDXERR")
"RTN","BSDXAPI",113,0)
;
"RTN","BSDXAPI",114,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",115,0)
;
"RTN","BSDXAPI",116,0)
; call event driver
"RTN","BSDXAPI",117,0)
NEW DFN,SDT,SDCL,SDDA,SDMODE
"RTN","BSDXAPI",118,0)
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
"RTN","BSDXAPI",119,0)
S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
"RTN","BSDXAPI",120,0)
D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
"RTN","BSDXAPI",121,0)
Q 0
"RTN","BSDXAPI",122,0)
;
"RTN","BSDXAPI",123,0)
CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
"RTN","BSDXAPI",124,0)
; Call like this for DFN 23435 checking in now at Hospital Location 33
"RTN","BSDXAPI",125,0)
; for appt at Dec 20, 2009 @ 10:11:59
"RTN","BSDXAPI",126,0)
; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
"RTN","BSDXAPI",127,0)
S BSDR("PAT")=DFN ;DFN
"RTN","BSDXAPI",128,0)
S BSDR("CLN")=CLIN ;Hosp Loc IEN
"RTN","BSDXAPI",129,0)
S BSDR("ADT")=APDATE ;Appt Date
"RTN","BSDXAPI",130,0)
S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now
"RTN","BSDXAPI",131,0)
S BSDR("USR")=DUZ ;Check-in user defaults to current
"RTN","BSDXAPI",132,0)
Q $$CHECKIN(.BSDR)
"RTN","BSDXAPI",133,0)
;
"RTN","BSDXAPI",134,0)
CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
"RTN","BSDXAPI",135,0)
;
"RTN","BSDXAPI",136,0)
; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
"RTN","BSDXAPI",137,0)
;
"RTN","BSDXAPI",138,0)
; Input array -
"RTN","BSDXAPI",139,0)
; BSDR("PAT") = ien of patient in file 2
"RTN","BSDXAPI",140,0)
; BSDR("CLN") = ien of clinic in file 44
"RTN","BSDXAPI",141,0)
; BSDR("ADT") = appt date/time
"RTN","BSDXAPI",142,0)
; BSDR("CDT") = checkin date/time
"RTN","BSDXAPI",143,0)
; BSDR("USR") = checkin user
"RTN","BSDXAPI",144,0)
;
"RTN","BSDXAPI",145,0)
; Output value -
"RTN","BSDXAPI",146,0)
; = 0 means everything worked
"RTN","BSDXAPI",147,0)
; = 1^message means error with reason message
"RTN","BSDXAPI",148,0)
;
"RTN","BSDXAPI",149,0)
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
"RTN","BSDXAPI",150,0)
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
"RTN","BSDXAPI",151,0)
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
"RTN","BSDXAPI",152,0)
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
"RTN","BSDXAPI",153,0)
I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
"RTN","BSDXAPI",154,0)
I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
"RTN","BSDXAPI",155,0)
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
"RTN","BSDXAPI",156,0)
;
"RTN","BSDXAPI",157,0)
; find ien for appt in file 44
"RTN","BSDXAPI",158,0)
NEW IEN,DIE,DA,DR
"RTN","BSDXAPI",159,0)
S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
"RTN","BSDXAPI",160,0)
I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
"RTN","BSDXAPI",161,0)
;
"RTN","BSDXAPI",162,0)
; remember before status
"RTN","BSDXAPI",163,0)
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
"RTN","BSDXAPI",164,0)
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
"RTN","BSDXAPI",165,0)
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
"RTN","BSDXAPI",166,0)
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
"RTN","BSDXAPI",167,0)
;
"RTN","BSDXAPI",168,0)
; set checkin
"RTN","BSDXAPI",169,0)
S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
"RTN","BSDXAPI",170,0)
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
"RTN","BSDXAPI",171,0)
S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
"RTN","BSDXAPI",172,0)
D ^DIE
"RTN","BSDXAPI",173,0)
;
"RTN","BSDXAPI",174,0)
; set after status
"RTN","BSDXAPI",175,0)
S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
"RTN","BSDXAPI",176,0)
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
"RTN","BSDXAPI",177,0)
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
"RTN","BSDXAPI",178,0)
;
"RTN","BSDXAPI",179,0)
; call event driver
"RTN","BSDXAPI",180,0)
D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
"RTN","BSDXAPI",181,0)
Q 0
"RTN","BSDXAPI",182,0)
;
"RTN","BSDXAPI",183,0)
CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
"RTN","BSDXAPI",184,0)
; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
"RTN","BSDXAPI",185,0)
; cancellation initiated by patient ("PC" rather than clinic "C"),
"RTN","BSDXAPI",186,0)
; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
"RTN","BSDXAPI",187,0)
; because foxes come out during bad weather.
"RTN","BSDXAPI",188,0)
; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
"RTN","BSDXAPI",189,0)
S BSDR("PAT")=DFN
"RTN","BSDXAPI",190,0)
S BSDR("CLN")=CLIN
"RTN","BSDXAPI",191,0)
S BSDR("TYP")=TYP
"RTN","BSDXAPI",192,0)
S BSDR("ADT")=APDATE
"RTN","BSDXAPI",193,0)
S BSDR("CDT")=$$NOW^XLFDT
"RTN","BSDXAPI",194,0)
S BSDR("USR")=DUZ
"RTN","BSDXAPI",195,0)
S BSDR("CR")=REASON
"RTN","BSDXAPI",196,0)
S BSDR("NOT")=INFO
"RTN","BSDXAPI",197,0)
Q $$CANCEL(.BSDR)
"RTN","BSDXAPI",198,0)
;
"RTN","BSDXAPI",199,0)
CANCEL(BSDR) ;PEP; called to cancel appt
"RTN","BSDXAPI",200,0)
;
"RTN","BSDXAPI",201,0)
; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
"RTN","BSDXAPI",202,0)
;
"RTN","BSDXAPI",203,0)
; Input Array -
"RTN","BSDXAPI",204,0)
; BSDR("PAT") = ien of patient in file 2
"RTN","BSDXAPI",205,0)
; BSDR("CLN") = ien of clinic in file 44
"RTN","BSDXAPI",206,0)
; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
"RTN","BSDXAPI",207,0)
; BSDR("ADT") = appointment date and time
"RTN","BSDXAPI",208,0)
; BSDR("CDT") = cancel date and time
"RTN","BSDXAPI",209,0)
; BSDR("USR") = user who canceled appt
"RTN","BSDXAPI",210,0)
; BSDR("CR") = cancel reason - pointer to file 409.2
"RTN","BSDXAPI",211,0)
; BSDR("NOT") = cancel remarks - optional notes to 160 characters
"RTN","BSDXAPI",212,0)
;
"RTN","BSDXAPI",213,0)
;Output: error status and message
"RTN","BSDXAPI",214,0)
; = 0 or null: everything okay
"RTN","BSDXAPI",215,0)
; = 1^message: error and reason
"RTN","BSDXAPI",216,0)
;
"RTN","BSDXAPI",217,0)
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
"RTN","BSDXAPI",218,0)
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
"RTN","BSDXAPI",219,0)
I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
"RTN","BSDXAPI",220,0)
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
"RTN","BSDXAPI",221,0)
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
"RTN","BSDXAPI",222,0)
I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
"RTN","BSDXAPI",223,0)
I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
"RTN","BSDXAPI",224,0)
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
"RTN","BSDXAPI",225,0)
I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
"RTN","BSDXAPI",226,0)
;
"RTN","BSDXAPI",227,0)
NEW IEN,DIE,DA,DR
"RTN","BSDXAPI",228,0)
S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
"RTN","BSDXAPI",229,0)
I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
"RTN","BSDXAPI",230,0)
;
"RTN","BSDXAPI",231,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",232,0)
;
"RTN","BSDXAPI",233,0)
; remember before status
"RTN","BSDXAPI",234,0)
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
"RTN","BSDXAPI",235,0)
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
"RTN","BSDXAPI",236,0)
S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
"RTN","BSDXAPI",237,0)
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
"RTN","BSDXAPI",238,0)
;
"RTN","BSDXAPI",239,0)
; get user who made appt and date appt made from ^SC
"RTN","BSDXAPI",240,0)
; because data in ^SC will be deleted
"RTN","BSDXAPI",241,0)
NEW USER,DATE
"RTN","BSDXAPI",242,0)
S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
"RTN","BSDXAPI",243,0)
S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
"RTN","BSDXAPI",244,0)
;
"RTN","BSDXAPI",245,0)
; update file 2 info
"RTN","BSDXAPI",246,0)
NEW DIE,DA,DR
"RTN","BSDXAPI",247,0)
S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
"RTN","BSDXAPI",248,0)
S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
"RTN","BSDXAPI",249,0)
S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
"RTN","BSDXAPI",250,0)
D ^DIE
"RTN","BSDXAPI",251,0)
;
"RTN","BSDXAPI",252,0)
; delete data in ^SC
"RTN","BSDXAPI",253,0)
NEW DIK,DA
"RTN","BSDXAPI",254,0)
S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
"RTN","BSDXAPI",255,0)
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
"RTN","BSDXAPI",256,0)
D ^DIK
"RTN","BSDXAPI",257,0)
;
"RTN","BSDXAPI",258,0)
; call event driver
"RTN","BSDXAPI",259,0)
D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
"RTN","BSDXAPI",260,0)
Q 0
"RTN","BSDXAPI",261,0)
;
"RTN","BSDXAPI",262,0)
CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
"RTN","BSDXAPI",263,0)
NEW X
"RTN","BSDXAPI",264,0)
S X=$G(SDIEN) ;ien sent in call
"RTN","BSDXAPI",265,0)
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
"RTN","BSDXAPI",266,0)
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
"RTN","BSDXAPI",267,0)
Q $S(X:1,1:0)
"RTN","BSDXAPI",268,0)
;
"RTN","BSDXAPI",269,0)
SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
"RTN","BSDXAPI",270,0)
NEW X,IEN
"RTN","BSDXAPI",271,0)
S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
"RTN","BSDXAPI",272,0)
. Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)["C" ;cancelled
"RTN","BSDXAPI",273,0)
. I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
"RTN","BSDXAPI",274,0)
Q $G(IEN)
"RTN","BSDXAPI",275,0)
;
"RTN","BSDXAPI",276,0)
APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
"RTN","BSDXAPI",277,0)
NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
"RTN","BSDXAPI",278,0)
Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
"RTN","BSDXAPI",279,0)
;
"RTN","BSDXAPI",280,0)
CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
"RTN","BSDXAPI",281,0)
NEW X
"RTN","BSDXAPI",282,0)
S X=$G(SDIEN) ;ien sent in call
"RTN","BSDXAPI",283,0)
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
"RTN","BSDXAPI",284,0)
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
"RTN","BSDXAPI",285,0)
Q $S(X:1,1:0)
"RTN","BSDXAPI",286,0)
;
"RTN","BSDXAPI",287,0)
UPDATENOTE(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
"RTN","BSDXAPI",288,0)
; PAT = DFN
"RTN","BSDXAPI",289,0)
; CLINIC = SC IEN
"RTN","BSDXAPI",290,0)
; DATE = FM Date/Time of Appointment
"RTN","BSDXAPI",291,0)
;
"RTN","BSDXAPI",292,0)
; Returns:
"RTN","BSDXAPI",293,0)
; 0 if okay
"RTN","BSDXAPI",294,0)
; -1 if failure
"RTN","BSDXAPI",295,0)
N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
"RTN","BSDXAPI",296,0)
I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
"RTN","BSDXAPI",297,0)
N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
"RTN","BSDXAPI",298,0)
S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
"RTN","BSDXAPI",299,0)
N BSDXERR
"RTN","BSDXAPI",300,0)
D FILE^DIE("","BSDXFDA","BSDXERR")
"RTN","BSDXAPI",301,0)
I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1)
"RTN","BSDXAPI",302,0)
QUIT 0
"RTN","BSDXGPRV")
0^36^B4804670
"RTN","BSDXGPRV",1,0)
BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 11/2/10 4:27pm
"RTN","BSDXGPRV",2,0)
;;1.42;BSDX;;Dec 07, 2010;Build 9
"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.25,.02)
"^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")
3030703
"^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")
3030508
"^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")
3030508
"^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**
Reference in New Issue View Git Blame Copy Permalink