KIDS Distribution saved on Jun 01, 2013@19:35:37
BSDX 1.7
**KIDS**:BSDX 1.7^

**INSTALL NAME**
BSDX 1.7
"BLD",8037,0)
BSDX 1.7^IHS Windows Scheduling^^3130601^n
"BLD",8037,1,0)
^^33^33^3120711^^^
"BLD",8037,1,1,0)
IHS Clinical Scheduling modified for VISTA v 1.7.
"BLD",8037,1,2,0)
Documentation:
"BLD",8037,1,3,0)
https://trac.opensourcevista.net/wiki/SchedulingGUI
"BLD",8037,1,4,0)
 
"BLD",8037,1,5,0)
Program originally written by Horace Whitt for IHS.
"BLD",8037,1,6,0)
Port to VISTA and Maintenance done by Sam Habiel for various clients.
"BLD",8037,1,7,0)
Electronic Health Solutions (EHS) has funded most of the work for the 
"BLD",8037,1,8,0)
quality assurance of the Scheduling GUI.
"BLD",8037,1,9,0)
 
"BLD",8037,1,10,0)
Feature List
"BLD",8037,1,11,0)
    Make and cancel appointments (Future appointments and Walk-ins)
"BLD",8037,1,12,0)
    Check-in and undo check-in's.
"BLD",8037,1,13,0)
    No-show and undo No-shows.
"BLD",8037,1,14,0)
    Make slots (i.e. how many patients will a provider see)
"BLD",8037,1,15,0)
    Set Overbook permissions to Clerks
"BLD",8037,1,16,0)
    Print Schedule List for Providers
"BLD",8037,1,17,0)
    Print Appointment List for Patients
"BLD",8037,1,18,0)
    Print Appointment Reminder Letters
"BLD",8037,1,19,0)
    Auto-Rebook appointments (along with Rebook letters)
"BLD",8037,1,20,0)
    Search for appointments in the future (you can limit to specific slot 
"BLD",8037,1,21,0)
type or day)
"BLD",8037,1,22,0)
    Integration with the Radiology Package to make Radiology Appointments 
"BLD",8037,1,23,0)
(v 1.6)
"BLD",8037,1,24,0)
    Dynamic view of Schedules:
"BLD",8037,1,25,0)
        Can open multiple schedules for a Clinic Group
"BLD",8037,1,26,0)
        Can view a single schedule in 1, 5 or 7 day view
"BLD",8037,1,27,0)
        Can change the time scale as long as it isn't less the minimum 
"BLD",8037,1,28,0)
appointment length 
"BLD",8037,1,29,0)
    Bi-directional communication with PIMS Scheduling Module.
"BLD",8037,1,30,0)
    Appointment Clipboard Functionality
"BLD",8037,1,31,0)
    Drag and drop for appointments
"BLD",8037,1,32,0)
    Full UTF-8 support if the Mumps Database supports it.
"BLD",8037,1,33,0)
    L18N for Arabic 
"BLD",8037,4,0)
^9.64PA^9002018.5^9
"BLD",8037,4,9002018.1,0)
9002018.1
"BLD",8037,4,9002018.1,222)
y^y^f^^n^^n^o^n
"BLD",8037,4,9002018.15,0)
9002018.15
"BLD",8037,4,9002018.15,222)
y^y^f^^n^^n^o^n
"BLD",8037,4,9002018.2,0)
9002018.2
"BLD",8037,4,9002018.2,222)
y^y^f^^n^^n^o^n
"BLD",8037,4,9002018.3,0)
9002018.3
"BLD",8037,4,9002018.3,222)
y^y^f^^n^^n^o^n
"BLD",8037,4,9002018.35,0)
9002018.35
"BLD",8037,4,9002018.35,222)
y^y^f^^n^^n^o^n
"BLD",8037,4,9002018.38,0)
9002018.38
"BLD",8037,4,9002018.38,222)
y^y^f^^n^^n^o^n
"BLD",8037,4,9002018.39,0)
9002018.39
"BLD",8037,4,9002018.39,222)
y^y^f^^n^^n^o^n
"BLD",8037,4,9002018.4,0)
9002018.4
"BLD",8037,4,9002018.4,222)
y^y^f^^n^^n^o^n
"BLD",8037,4,9002018.5,0)
9002018.5
"BLD",8037,4,9002018.5,222)
y^y^f^^n^^y^o^n
"BLD",8037,4,"B",9002018.1,9002018.1)

"BLD",8037,4,"B",9002018.15,9002018.15)

"BLD",8037,4,"B",9002018.2,9002018.2)

"BLD",8037,4,"B",9002018.3,9002018.3)

"BLD",8037,4,"B",9002018.35,9002018.35)

"BLD",8037,4,"B",9002018.38,9002018.38)

"BLD",8037,4,"B",9002018.39,9002018.39)

"BLD",8037,4,"B",9002018.4,9002018.4)

"BLD",8037,4,"B",9002018.5,9002018.5)

"BLD",8037,6.3)
25
"BLD",8037,"ABPKG")
n
"BLD",8037,"INIT")
V0200^BSDX2E
"BLD",8037,"KRN",0)
^9.67PA^779.2^20
"BLD",8037,"KRN",.4,0)
.4
"BLD",8037,"KRN",.4,"NM",0)
^9.68A^^
"BLD",8037,"KRN",.401,0)
.401
"BLD",8037,"KRN",.402,0)
.402
"BLD",8037,"KRN",.403,0)
.403
"BLD",8037,"KRN",.5,0)
.5
"BLD",8037,"KRN",.84,0)
.84
"BLD",8037,"KRN",3.6,0)
3.6
"BLD",8037,"KRN",3.8,0)
3.8
"BLD",8037,"KRN",9.2,0)
9.2
"BLD",8037,"KRN",9.8,0)
9.8
"BLD",8037,"KRN",9.8,"NM",0)
^9.68A^40^40
"BLD",8037,"KRN",9.8,"NM",1,0)
BSDX01^^0^B172528150
"BLD",8037,"KRN",9.8,"NM",2,0)
BSDX02^^0^B19587814
"BLD",8037,"KRN",9.8,"NM",3,0)
BSDX03^^0^B2916424
"BLD",8037,"KRN",9.8,"NM",4,0)
BSDX04^^0^B24529408
"BLD",8037,"KRN",9.8,"NM",5,0)
BSDX05^^0^B11080417
"BLD",8037,"KRN",9.8,"NM",6,0)
BSDX06^^0^B6651946
"BLD",8037,"KRN",9.8,"NM",7,0)
BSDX07^^0^B81183501
"BLD",8037,"KRN",9.8,"NM",8,0)
BSDX08^^0^B46874843
"BLD",8037,"KRN",9.8,"NM",9,0)
BSDX09^^0^B35856892
"BLD",8037,"KRN",9.8,"NM",10,0)
BSDX12^^0^B7048487
"BLD",8037,"KRN",9.8,"NM",11,0)
BSDX13^^0^B9627754
"BLD",8037,"KRN",9.8,"NM",12,0)
BSDX14^^0^B6549711
"BLD",8037,"KRN",9.8,"NM",13,0)
BSDX15^^0^B5399368
"BLD",8037,"KRN",9.8,"NM",14,0)
BSDX16^^0^B12093707
"BLD",8037,"KRN",9.8,"NM",15,0)
BSDX17^^0^B2113933
"BLD",8037,"KRN",9.8,"NM",16,0)
BSDX18^^0^B88409544
"BLD",8037,"KRN",9.8,"NM",17,0)
BSDX19^^0^B7998622
"BLD",8037,"KRN",9.8,"NM",18,0)
BSDX20^^0^B5998854
"BLD",8037,"KRN",9.8,"NM",19,0)
BSDX21^^0^B8787000
"BLD",8037,"KRN",9.8,"NM",20,0)
BSDX22^^0^B9604631
"BLD",8037,"KRN",9.8,"NM",21,0)
BSDX23^^0^B8607717
"BLD",8037,"KRN",9.8,"NM",22,0)
BSDX24^^0^B13588210
"BLD",8037,"KRN",9.8,"NM",23,0)
BSDX25^^0^B75573201
"BLD",8037,"KRN",9.8,"NM",24,0)
BSDX26^^0^B15866028
"BLD",8037,"KRN",9.8,"NM",25,0)
BSDX27^^0^B133802805
"BLD",8037,"KRN",9.8,"NM",26,0)
BSDX28^^0^B34678667
"BLD",8037,"KRN",9.8,"NM",27,0)
BSDX29^^0^B52386520
"BLD",8037,"KRN",9.8,"NM",28,0)
BSDX30^^0^B3691453
"BLD",8037,"KRN",9.8,"NM",29,0)
BSDX31^^0^B45572120
"BLD",8037,"KRN",9.8,"NM",30,0)
BSDX32^^0^B20186652
"BLD",8037,"KRN",9.8,"NM",31,0)
BSDX33^^0^B14422341
"BLD",8037,"KRN",9.8,"NM",32,0)
BSDX34^^0^B43456861
"BLD",8037,"KRN",9.8,"NM",33,0)
BSDX35^^0^B8259199
"BLD",8037,"KRN",9.8,"NM",34,0)
BSDX11^^0^B6468379
"BLD",8037,"KRN",9.8,"NM",35,0)
BSDXAPI^^0^B171938499
"BLD",8037,"KRN",9.8,"NM",36,0)
BSDXGPRV^^0^B4677493
"BLD",8037,"KRN",9.8,"NM",37,0)
BSDXAPI1^^0^B99176581
"BLD",8037,"KRN",9.8,"NM",38,0)
BSDXUT^^0^B130401979
"BLD",8037,"KRN",9.8,"NM",39,0)
BSDXUT1^^0^B193374796
"BLD",8037,"KRN",9.8,"NM",40,0)
BSDXUT2^^0^B91305617
"BLD",8037,"KRN",9.8,"NM","B","BSDX01",1)

"BLD",8037,"KRN",9.8,"NM","B","BSDX02",2)

"BLD",8037,"KRN",9.8,"NM","B","BSDX03",3)

"BLD",8037,"KRN",9.8,"NM","B","BSDX04",4)

"BLD",8037,"KRN",9.8,"NM","B","BSDX05",5)

"BLD",8037,"KRN",9.8,"NM","B","BSDX06",6)

"BLD",8037,"KRN",9.8,"NM","B","BSDX07",7)

"BLD",8037,"KRN",9.8,"NM","B","BSDX08",8)

"BLD",8037,"KRN",9.8,"NM","B","BSDX09",9)

"BLD",8037,"KRN",9.8,"NM","B","BSDX11",34)

"BLD",8037,"KRN",9.8,"NM","B","BSDX12",10)

"BLD",8037,"KRN",9.8,"NM","B","BSDX13",11)

"BLD",8037,"KRN",9.8,"NM","B","BSDX14",12)

"BLD",8037,"KRN",9.8,"NM","B","BSDX15",13)

"BLD",8037,"KRN",9.8,"NM","B","BSDX16",14)

"BLD",8037,"KRN",9.8,"NM","B","BSDX17",15)

"BLD",8037,"KRN",9.8,"NM","B","BSDX18",16)

"BLD",8037,"KRN",9.8,"NM","B","BSDX19",17)

"BLD",8037,"KRN",9.8,"NM","B","BSDX20",18)

"BLD",8037,"KRN",9.8,"NM","B","BSDX21",19)

"BLD",8037,"KRN",9.8,"NM","B","BSDX22",20)

"BLD",8037,"KRN",9.8,"NM","B","BSDX23",21)

"BLD",8037,"KRN",9.8,"NM","B","BSDX24",22)

"BLD",8037,"KRN",9.8,"NM","B","BSDX25",23)

"BLD",8037,"KRN",9.8,"NM","B","BSDX26",24)

"BLD",8037,"KRN",9.8,"NM","B","BSDX27",25)

"BLD",8037,"KRN",9.8,"NM","B","BSDX28",26)

"BLD",8037,"KRN",9.8,"NM","B","BSDX29",27)

"BLD",8037,"KRN",9.8,"NM","B","BSDX30",28)

"BLD",8037,"KRN",9.8,"NM","B","BSDX31",29)

"BLD",8037,"KRN",9.8,"NM","B","BSDX32",30)

"BLD",8037,"KRN",9.8,"NM","B","BSDX33",31)

"BLD",8037,"KRN",9.8,"NM","B","BSDX34",32)

"BLD",8037,"KRN",9.8,"NM","B","BSDX35",33)

"BLD",8037,"KRN",9.8,"NM","B","BSDXAPI",35)

"BLD",8037,"KRN",9.8,"NM","B","BSDXAPI1",37)

"BLD",8037,"KRN",9.8,"NM","B","BSDXGPRV",36)

"BLD",8037,"KRN",9.8,"NM","B","BSDXUT",38)

"BLD",8037,"KRN",9.8,"NM","B","BSDXUT1",39)

"BLD",8037,"KRN",9.8,"NM","B","BSDXUT2",40)

"BLD",8037,"KRN",19,0)
19
"BLD",8037,"KRN",19,"NM",0)
^9.68A^1^1
"BLD",8037,"KRN",19,"NM",1,0)
BSDXRPC^^0
"BLD",8037,"KRN",19,"NM","B","BSDXRPC",1)

"BLD",8037,"KRN",19.1,0)
19.1
"BLD",8037,"KRN",19.1,"NM",0)
^9.68A^2^2
"BLD",8037,"KRN",19.1,"NM",1,0)
BSDXZMENU^^0
"BLD",8037,"KRN",19.1,"NM",2,0)
BSDXZMGR^^0
"BLD",8037,"KRN",19.1,"NM","B","BSDXZMENU",1)

"BLD",8037,"KRN",19.1,"NM","B","BSDXZMGR",2)

"BLD",8037,"KRN",101,0)
101
"BLD",8037,"KRN",101,"NM",0)
^9.68A^4^4
"BLD",8037,"KRN",101,"NM",1,0)
BSDX ADD APPOINTMENT^^0
"BLD",8037,"KRN",101,"NM",2,0)
BSDX CANCEL APPOINTMENT^^0
"BLD",8037,"KRN",101,"NM",3,0)
BSDX CHECKIN APPOINTMENT^^0
"BLD",8037,"KRN",101,"NM",4,0)
BSDX NOSHOW APPOINTMENT^^0
"BLD",8037,"KRN",101,"NM","B","BSDX ADD APPOINTMENT",1)

"BLD",8037,"KRN",101,"NM","B","BSDX CANCEL APPOINTMENT",2)

"BLD",8037,"KRN",101,"NM","B","BSDX CHECKIN APPOINTMENT",3)

"BLD",8037,"KRN",101,"NM","B","BSDX NOSHOW APPOINTMENT",4)

"BLD",8037,"KRN",409.61,0)
409.61
"BLD",8037,"KRN",771,0)
771
"BLD",8037,"KRN",779.2,0)
779.2
"BLD",8037,"KRN",870,0)
870
"BLD",8037,"KRN",8989.51,0)
8989.51
"BLD",8037,"KRN",8989.51,"NM",0)
^9.68A^2^2
"BLD",8037,"KRN",8989.51,"NM",1,0)
BSDX AUTO PRINT AS^^0
"BLD",8037,"KRN",8989.51,"NM",2,0)
BSDX AUTO PRINT RS^^0
"BLD",8037,"KRN",8989.51,"NM","B","BSDX AUTO PRINT AS",1)

"BLD",8037,"KRN",8989.51,"NM","B","BSDX AUTO PRINT RS",2)

"BLD",8037,"KRN",8989.52,0)
8989.52
"BLD",8037,"KRN",8994,0)
8994
"BLD",8037,"KRN",8994,"NM",0)
^9.68A^111^63
"BLD",8037,"KRN",8994,"NM",1,0)
BSDX ADD NEW APPOINTMENT^^0
"BLD",8037,"KRN",8994,"NM",2,0)
BSDX ADD NEW AVAILABILITY^^0
"BLD",8037,"KRN",8994,"NM",3,0)
BSDX APPT BLOCKS OVERLAP^^0
"BLD",8037,"KRN",8994,"NM",4,0)
BSDX CANCEL APPOINTMENT^^0
"BLD",8037,"KRN",8994,"NM",5,0)
BSDX CANCEL AVAILABILITY^^0
"BLD",8037,"KRN",8994,"NM",6,0)
BSDX CREATE APPT SCHEDULE^^0
"BLD",8037,"KRN",8994,"NM",7,0)
BSDX CREATE ASGND SLOT SCHED^^0
"BLD",8037,"KRN",8994,"NM",10,0)
BSDX GET BASIC REG INFO^^0
"BLD",8037,"KRN",8994,"NM",12,0)
BSDX TYPE BLOCKS OVERLAP^^0
"BLD",8037,"KRN",8994,"NM",13,0)
BSDX ADD/EDIT ACCESS TYPE^^0
"BLD",8037,"KRN",8994,"NM",14,0)
BSDX GET ACCESS GROUP TYPES^^0
"BLD",8037,"KRN",8994,"NM",15,0)
BSDX GROUP RESOURCE^^0
"BLD",8037,"KRN",8994,"NM",16,0)
BSDX RESOURCE GROUPS BY USER^^0
"BLD",8037,"KRN",8994,"NM",17,0)
BSDX ADD/EDIT RESOURCEUSER^^0
"BLD",8037,"KRN",8994,"NM",18,0)
BSDX DELETE RESOURCEUSER^^0
"BLD",8037,"KRN",8994,"NM",19,0)
BSDX SCHEDULE USER^^0
"BLD",8037,"KRN",8994,"NM",20,0)
BSDX ADD/EDIT RESOURCE^^0
"BLD",8037,"KRN",8994,"NM",21,0)
BSDX SCHEDULING USER INFO^^0
"BLD",8037,"KRN",8994,"NM",22,0)
BSDX RESOURCES^^0
"BLD",8037,"KRN",8994,"NM",23,0)
BSDX ADD/EDIT RESOURCE GROUP^^0
"BLD",8037,"KRN",8994,"NM",24,0)
BSDX DELETE RESOURCE GROUP^^0
"BLD",8037,"KRN",8994,"NM",25,0)
BSDX DELETE RES GROUP ITEM^^0
"BLD",8037,"KRN",8994,"NM",26,0)
BSDX DEPARTMENT RESOURCE^^0
"BLD",8037,"KRN",8994,"NM",27,0)
BSDX DEPARTMENTS BY USER^^0
"BLD",8037,"KRN",8994,"NM",28,0)
BSDX RESOURCES BY USER^^0
"BLD",8037,"KRN",8994,"NM",29,0)
BSDX ADD ACCESS GROUP ITEM^^0
"BLD",8037,"KRN",8994,"NM",30,0)
BSDX ADD RES GROUP ITEM^^0
"BLD",8037,"KRN",8994,"NM",31,0)
BSDX ADD/EDIT ACCESS GROUP^^0
"BLD",8037,"KRN",8994,"NM",32,0)
BSDX DELETE ACCESS GROUP^^0
"BLD",8037,"KRN",8994,"NM",33,0)
BSDX DELETE ACCESS GROUP ITEM^^0
"BLD",8037,"KRN",8994,"NM",34,0)
BSDX REGISTER EVENT^^0
"BLD",8037,"KRN",8994,"NM",35,0)
BSDX UNREGISTER EVENT^^0
"BLD",8037,"KRN",8994,"NM",36,0)
BSDX RAISE EVENT^^0
"BLD",8037,"KRN",8994,"NM",37,0)
BSDX SEARCH AVAILABILITY^^0
"BLD",8037,"KRN",8994,"NM",38,0)
BSDX CHECKIN APPOINTMENT^^0
"BLD",8037,"KRN",8994,"NM",39,0)
BSDX EDIT APPOINTMENT^^0
"BLD",8037,"KRN",8994,"NM",40,0)
BSDX PATIENT APPT DISPLAY^^0
"BLD",8037,"KRN",8994,"NM",41,0)
BSDXPatientLookupRS^^0
"BLD",8037,"KRN",8994,"NM",42,0)
BSDX SPACEBAR SET^^0
"BLD",8037,"KRN",8994,"NM",43,0)
BSDX COPY APPOINTMENT CANCEL^^0
"BLD",8037,"KRN",8994,"NM",44,0)
BSDX COPY APPOINTMENT STATUS^^0
"BLD",8037,"KRN",8994,"NM",45,0)
BSDX COPY APPOINTMENTS^^0
"BLD",8037,"KRN",8994,"NM",46,0)
BSDX CLINIC LETTERS^^0
"BLD",8037,"KRN",8994,"NM",47,0)
BSDX NOSHOW^^0
"BLD",8037,"KRN",8994,"NM",48,0)
BSDX IM HERE^^0
"BLD",8037,"KRN",8994,"NM",49,0)
BSDX HOSPITAL LOCATION^^0
"BLD",8037,"KRN",8994,"NM",50,0)
BSDX CLINIC SETUP^^0
"BLD",8037,"KRN",8994,"NM",51,0)
BSDX REBOOK LIST^^0
"BLD",8037,"KRN",8994,"NM",52,0)
BSDX REBOOK CLINIC LIST^^0
"BLD",8037,"KRN",8994,"NM",53,0)
BSDX REBOOK SET^^0
"BLD",8037,"KRN",8994,"NM",54,0)
BSDX RESOURCE LETTERS^^0
"BLD",8037,"KRN",8994,"NM",55,0)
BSDX CANCEL CLINIC LIST^^0
"BLD",8037,"KRN",8994,"NM",56,0)
BSDX CANCEL AV BY DATE^^0
"BLD",8037,"KRN",8994,"NM",57,0)
BSDX REBOOK NEXT BLOCK^^0
"BLD",8037,"KRN",8994,"NM",58,0)
BSDX EHR PATIENT^^0
"BLD",8037,"KRN",8994,"NM",59,0)
BSDX HOSP LOC PROVIDERS^^0
"BLD",8037,"KRN",8994,"NM",105,0)
BSDX SET PARAM^^0
"BLD",8037,"KRN",8994,"NM",106,0)
BSDX GET PARAM^^0
"BLD",8037,"KRN",8994,"NM",107,0)
BSDX REMOVE CHECK-IN^^0
"BLD",8037,"KRN",8994,"NM",108,0)
BSDX GET RAD EXAM FOR PT^^0
"BLD",8037,"KRN",8994,"NM",109,0)
BSDX SCHEDULE RAD EXAM^^0
"BLD",8037,"KRN",8994,"NM",110,0)
BSDX HOLD RAD EXAM^^0
"BLD",8037,"KRN",8994,"NM",111,0)
BSDX CAN HOLD RAD EXAM^^0
"BLD",8037,"KRN",8994,"NM","B","BSDX ADD ACCESS GROUP ITEM",29)

"BLD",8037,"KRN",8994,"NM","B","BSDX ADD NEW APPOINTMENT",1)

"BLD",8037,"KRN",8994,"NM","B","BSDX ADD NEW AVAILABILITY",2)

"BLD",8037,"KRN",8994,"NM","B","BSDX ADD RES GROUP ITEM",30)

"BLD",8037,"KRN",8994,"NM","B","BSDX ADD/EDIT ACCESS GROUP",31)

"BLD",8037,"KRN",8994,"NM","B","BSDX ADD/EDIT ACCESS TYPE",13)

"BLD",8037,"KRN",8994,"NM","B","BSDX ADD/EDIT RESOURCE",20)

"BLD",8037,"KRN",8994,"NM","B","BSDX ADD/EDIT RESOURCE GROUP",23)

"BLD",8037,"KRN",8994,"NM","B","BSDX ADD/EDIT RESOURCEUSER",17)

"BLD",8037,"KRN",8994,"NM","B","BSDX APPT BLOCKS OVERLAP",3)

"BLD",8037,"KRN",8994,"NM","B","BSDX CAN HOLD RAD EXAM",111)

"BLD",8037,"KRN",8994,"NM","B","BSDX CANCEL APPOINTMENT",4)

"BLD",8037,"KRN",8994,"NM","B","BSDX CANCEL AV BY DATE",56)

"BLD",8037,"KRN",8994,"NM","B","BSDX CANCEL AVAILABILITY",5)

"BLD",8037,"KRN",8994,"NM","B","BSDX CANCEL CLINIC LIST",55)

"BLD",8037,"KRN",8994,"NM","B","BSDX CHECKIN APPOINTMENT",38)

"BLD",8037,"KRN",8994,"NM","B","BSDX CLINIC LETTERS",46)

"BLD",8037,"KRN",8994,"NM","B","BSDX CLINIC SETUP",50)

"BLD",8037,"KRN",8994,"NM","B","BSDX COPY APPOINTMENT CANCEL",43)

"BLD",8037,"KRN",8994,"NM","B","BSDX COPY APPOINTMENT STATUS",44)

"BLD",8037,"KRN",8994,"NM","B","BSDX COPY APPOINTMENTS",45)

"BLD",8037,"KRN",8994,"NM","B","BSDX CREATE APPT SCHEDULE",6)

"BLD",8037,"KRN",8994,"NM","B","BSDX CREATE ASGND SLOT SCHED",7)

"BLD",8037,"KRN",8994,"NM","B","BSDX DELETE ACCESS GROUP",32)

"BLD",8037,"KRN",8994,"NM","B","BSDX DELETE ACCESS GROUP ITEM",33)

"BLD",8037,"KRN",8994,"NM","B","BSDX DELETE RES GROUP ITEM",25)

"BLD",8037,"KRN",8994,"NM","B","BSDX DELETE RESOURCE GROUP",24)

"BLD",8037,"KRN",8994,"NM","B","BSDX DELETE RESOURCEUSER",18)

"BLD",8037,"KRN",8994,"NM","B","BSDX DEPARTMENT RESOURCE",26)

"BLD",8037,"KRN",8994,"NM","B","BSDX DEPARTMENTS BY USER",27)

"BLD",8037,"KRN",8994,"NM","B","BSDX EDIT APPOINTMENT",39)

"BLD",8037,"KRN",8994,"NM","B","BSDX EHR PATIENT",58)

"BLD",8037,"KRN",8994,"NM","B","BSDX GET ACCESS GROUP TYPES",14)

"BLD",8037,"KRN",8994,"NM","B","BSDX GET BASIC REG INFO",10)

"BLD",8037,"KRN",8994,"NM","B","BSDX GET PARAM",106)

"BLD",8037,"KRN",8994,"NM","B","BSDX GET RAD EXAM FOR PT",108)

"BLD",8037,"KRN",8994,"NM","B","BSDX GROUP RESOURCE",15)

"BLD",8037,"KRN",8994,"NM","B","BSDX HOLD RAD EXAM",110)

"BLD",8037,"KRN",8994,"NM","B","BSDX HOSP LOC PROVIDERS",59)

"BLD",8037,"KRN",8994,"NM","B","BSDX HOSPITAL LOCATION",49)

"BLD",8037,"KRN",8994,"NM","B","BSDX IM HERE",48)

"BLD",8037,"KRN",8994,"NM","B","BSDX NOSHOW",47)

"BLD",8037,"KRN",8994,"NM","B","BSDX PATIENT APPT DISPLAY",40)

"BLD",8037,"KRN",8994,"NM","B","BSDX RAISE EVENT",36)

"BLD",8037,"KRN",8994,"NM","B","BSDX REBOOK CLINIC LIST",52)

"BLD",8037,"KRN",8994,"NM","B","BSDX REBOOK LIST",51)

"BLD",8037,"KRN",8994,"NM","B","BSDX REBOOK NEXT BLOCK",57)

"BLD",8037,"KRN",8994,"NM","B","BSDX REBOOK SET",53)

"BLD",8037,"KRN",8994,"NM","B","BSDX REGISTER EVENT",34)

"BLD",8037,"KRN",8994,"NM","B","BSDX REMOVE CHECK-IN",107)

"BLD",8037,"KRN",8994,"NM","B","BSDX RESOURCE GROUPS BY USER",16)

"BLD",8037,"KRN",8994,"NM","B","BSDX RESOURCE LETTERS",54)

"BLD",8037,"KRN",8994,"NM","B","BSDX RESOURCES",22)

"BLD",8037,"KRN",8994,"NM","B","BSDX RESOURCES BY USER",28)

"BLD",8037,"KRN",8994,"NM","B","BSDX SCHEDULE RAD EXAM",109)

"BLD",8037,"KRN",8994,"NM","B","BSDX SCHEDULE USER",19)

"BLD",8037,"KRN",8994,"NM","B","BSDX SCHEDULING USER INFO",21)

"BLD",8037,"KRN",8994,"NM","B","BSDX SEARCH AVAILABILITY",37)

"BLD",8037,"KRN",8994,"NM","B","BSDX SET PARAM",105)

"BLD",8037,"KRN",8994,"NM","B","BSDX SPACEBAR SET",42)

"BLD",8037,"KRN",8994,"NM","B","BSDX TYPE BLOCKS OVERLAP",12)

"BLD",8037,"KRN",8994,"NM","B","BSDX UNREGISTER EVENT",35)

"BLD",8037,"KRN",8994,"NM","B","BSDXPatientLookupRS",41)

"BLD",8037,"KRN","B",.4,.4)

"BLD",8037,"KRN","B",.401,.401)

"BLD",8037,"KRN","B",.402,.402)

"BLD",8037,"KRN","B",.403,.403)

"BLD",8037,"KRN","B",.5,.5)

"BLD",8037,"KRN","B",.84,.84)

"BLD",8037,"KRN","B",3.6,3.6)

"BLD",8037,"KRN","B",3.8,3.8)

"BLD",8037,"KRN","B",9.2,9.2)

"BLD",8037,"KRN","B",9.8,9.8)

"BLD",8037,"KRN","B",19,19)

"BLD",8037,"KRN","B",19.1,19.1)

"BLD",8037,"KRN","B",101,101)

"BLD",8037,"KRN","B",409.61,409.61)

"BLD",8037,"KRN","B",771,771)

"BLD",8037,"KRN","B",779.2,779.2)

"BLD",8037,"KRN","B",870,870)

"BLD",8037,"KRN","B",8989.51,8989.51)

"BLD",8037,"KRN","B",8989.52,8989.52)

"BLD",8037,"KRN","B",8994,8994)

"BLD",8037,"PRE")
BSDX2E
"BLD",8037,"QUES",0)
^9.62^^
"BLD",8037,"REQB",0)
^9.611^^0
"DATA",9002018.5,1,0)
1^7^3120706.1005
"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.7^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.7^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.7^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.7^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.7^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.7^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.7^BSDX
"FIA",9002018.39,9002018.39)
0
"FIA",9002018.4)
BSDX APPOINTMENT
"FIA",9002018.4,0)
^BSDXAPPT(
"FIA",9002018.4,0,0)
9002018.4DAI
"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.7^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.7^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)

"IX",9002018.4,9002018.4,"APAT",0)
9002018.4^APAT^Index of Patient, appointment time, resource^R^^R^IR^I^9002018.4^^^^^S
"IX",9002018.4,9002018.4,"APAT",.1,0)
^^14^14^3120706^
"IX",9002018.4,9002018.4,"APAT",.1,1,0)
Index of Patient, appointment time, and resource. Use this index to
"IX",9002018.4,9002018.4,"APAT",.1,2,0)
quickly check to see if a patient has an appointment at a specific time 
"IX",9002018.4,9002018.4,"APAT",.1,3,0)
and where.
"IX",9002018.4,9002018.4,"APAT",.1,4,0)
 
"IX",9002018.4,9002018.4,"APAT",.1,5,0)
The index looks like this:
"IX",9002018.4,9002018.4,"APAT",.1,6,0)
^BSDXAPPT("APAT",90,3120706.1,7,2833)=""
"IX",9002018.4,9002018.4,"APAT",.1,7,0)
^BSDXAPPT("APAT",90,3120706.1,7,2862)=""
"IX",9002018.4,9002018.4,"APAT",.1,8,0)
^BSDXAPPT("APAT",132,3120418.09,1,1)=""
"IX",9002018.4,9002018.4,"APAT",.1,9,0)
^BSDXAPPT("APAT",170,3120627.09,2,1519)=""
"IX",9002018.4,9002018.4,"APAT",.1,10,0)
^BSDXAPPT("APAT",178,3120621.1615,3,330)=""
"IX",9002018.4,9002018.4,"APAT",.1,11,0)
^BSDXAPPT("APAT",178,3120627.093,1,1466)=""
"IX",9002018.4,9002018.4,"APAT",.1,12,0)
 
"IX",9002018.4,9002018.4,"APAT",.1,13,0)
The 1st subscript is the DFN, and the second is the appointment time, and 
"IX",9002018.4,9002018.4,"APAT",.1,14,0)
the third is the resource where the appointment is.
"IX",9002018.4,9002018.4,"APAT",1)
S ^BSDXAPPT("APAT",X(1),X(2),X(3),DA)=""
"IX",9002018.4,9002018.4,"APAT",2)
K ^BSDXAPPT("APAT",X(1),X(2),X(3),DA)
"IX",9002018.4,9002018.4,"APAT",2.5)
K ^BSDXAPPT("APAT")
"IX",9002018.4,9002018.4,"APAT",11.1,0)
^.114IA^3^3
"IX",9002018.4,9002018.4,"APAT",11.1,1,0)
1^F^9002018.4^.05^^1^F
"IX",9002018.4,9002018.4,"APAT",11.1,2,0)
2^F^9002018.4^.01^^2^F
"IX",9002018.4,9002018.4,"APAT",11.1,3,0)
3^F^9002018.4^.07^^3^F
"KRN",19,11025,-1)
0^1
"KRN",19,11025,0)
BSDXRPC^WINDOWS SCHEDULING PROCEDURE CALLS^^B^^^^^^^^IHS Windows Scheduling^y
"KRN",19,11025,1,0)
^19.06^4^4^3130526^^^^
"KRN",19,11025,1,1,0)
This option hosts RPCs in the BSDX namespace.  Windows Scheduling users
"KRN",19,11025,1,2,0)
 mustg have access to this option
"KRN",19,11025,1,3,0)
 
"KRN",19,11025,1,4,0)
in order to use Windows Scheduling.
"KRN",19,11025,99.1)
62936,43587
"KRN",19,11025,"RPC",0)
^19.05P^109^109
"KRN",19,11025,"RPC",1,0)
BSDX ADD ACCESS GROUP ITEM
"KRN",19,11025,"RPC",2,0)
BSDX ADD NEW APPOINTMENT
"KRN",19,11025,"RPC",3,0)
BSDX ADD NEW AVAILABILITY
"KRN",19,11025,"RPC",4,0)
BSDX ADD RES GROUP ITEM
"KRN",19,11025,"RPC",5,0)
BSDX ADD/EDIT ACCESS GROUP
"KRN",19,11025,"RPC",6,0)
BSDX ADD/EDIT ACCESS TYPE
"KRN",19,11025,"RPC",7,0)
BSDX ADD/EDIT RESOURCE
"KRN",19,11025,"RPC",8,0)
BSDX ADD/EDIT RESOURCE GROUP
"KRN",19,11025,"RPC",9,0)
BSDX ADD/EDIT RESOURCEUSER
"KRN",19,11025,"RPC",10,0)
BSDX APPT BLOCKS OVERLAP
"KRN",19,11025,"RPC",11,0)
BSDX CANCEL APPOINTMENT
"KRN",19,11025,"RPC",12,0)
BSDX CANCEL AVAILABILITY
"KRN",19,11025,"RPC",13,0)
BSDX CHECKIN APPOINTMENT
"KRN",19,11025,"RPC",14,0)
BSDX CREATE APPT SCHEDULE
"KRN",19,11025,"RPC",15,0)
BSDX CREATE ASGND SLOT SCHED
"KRN",19,11025,"RPC",16,0)
BSDX DELETE ACCESS GROUP
"KRN",19,11025,"RPC",17,0)
BSDX DELETE ACCESS GROUP ITEM
"KRN",19,11025,"RPC",18,0)
BSDX DELETE RES GROUP ITEM
"KRN",19,11025,"RPC",19,0)
BSDX DELETE RESOURCE GROUP
"KRN",19,11025,"RPC",20,0)
BSDX DELETE RESOURCEUSER
"KRN",19,11025,"RPC",21,0)
BSDX DEPARTMENT RESOURCE
"KRN",19,11025,"RPC",22,0)
BSDX DEPARTMENTS BY USER
"KRN",19,11025,"RPC",23,0)
BSDX EDIT APPOINTMENT
"KRN",19,11025,"RPC",24,0)
BSDX GET ACCESS GROUP TYPES
"KRN",19,11025,"RPC",25,0)
BSDX GET BASIC REG INFO
"KRN",19,11025,"RPC",26,0)
BSDX GROUP RESOURCE
"KRN",19,11025,"RPC",27,0)
BSDX PATIENT APPT DISPLAY
"KRN",19,11025,"RPC",28,0)
BSDX RAISE EVENT
"KRN",19,11025,"RPC",29,0)
BSDX REGISTER EVENT
"KRN",19,11025,"RPC",30,0)
BSDX RESOURCE GROUPS BY USER
"KRN",19,11025,"RPC",31,0)
BSDX RESOURCES
"KRN",19,11025,"RPC",32,0)
BSDX RESOURCES BY USER
"KRN",19,11025,"RPC",33,0)
BSDX SCHEDULE USER
"KRN",19,11025,"RPC",34,0)
BSDX SCHEDULING USER INFO
"KRN",19,11025,"RPC",35,0)
BSDX SEARCH AVAILABILITY
"KRN",19,11025,"RPC",36,0)
BSDX TYPE BLOCKS OVERLAP
"KRN",19,11025,"RPC",37,0)
BSDX UNREGISTER EVENT
"KRN",19,11025,"RPC",38,0)
BSDXPatientLookupRS
"KRN",19,11025,"RPC",39,0)
BSDX SPACEBAR SET
"KRN",19,11025,"RPC",40,0)
BSDX COPY APPOINTMENTS
"KRN",19,11025,"RPC",41,0)
BSDX COPY APPOINTMENT CANCEL
"KRN",19,11025,"RPC",42,0)
BSDX COPY APPOINTMENT STATUS
"KRN",19,11025,"RPC",43,0)
BSDX CLINIC LETTERS
"KRN",19,11025,"RPC",44,0)
BSDX NOSHOW
"KRN",19,11025,"RPC",45,0)
BSDX IM HERE
"KRN",19,11025,"RPC",46,0)
BSDX HOSPITAL LOCATION
"KRN",19,11025,"RPC",47,0)
BSDX CLINIC SETUP
"KRN",19,11025,"RPC",49,0)
BSDX REBOOK LIST
"KRN",19,11025,"RPC",50,0)
BSDX REBOOK CLINIC LIST
"KRN",19,11025,"RPC",51,0)
BSDX REBOOK SET
"KRN",19,11025,"RPC",52,0)
BSDX RESOURCE LETTERS
"KRN",19,11025,"RPC",53,0)
BSDX CANCEL CLINIC LIST
"KRN",19,11025,"RPC",54,0)
BSDX CANCEL AV BY DATE
"KRN",19,11025,"RPC",55,0)
BSDX REBOOK NEXT BLOCK
"KRN",19,11025,"RPC",56,0)
BSDX HOSP LOC PROVIDERS
"KRN",19,11025,"RPC",71,0)
BSDX GET RAD EXAM FOR PT
"KRN",19,11025,"RPC",102,0)
BSDX REMOVE CHECK-IN
"KRN",19,11025,"RPC",103,0)
BSDX SET PARAM
"KRN",19,11025,"RPC",104,0)
BSDX GET PARAM
"KRN",19,11025,"RPC",105,0)
BSDX GET RAD EXAM FOR PT
"KRN",19,11025,"RPC",106,0)
BSDX SCHEDULE RAD EXAM
"KRN",19,11025,"RPC",107,0)
BSDX HOLD RAD EXAM
"KRN",19,11025,"RPC",108,0)
BSDX CAN HOLD RAD EXAM
"KRN",19,11025,"RPC",109,0)
UJO GET OVERBOOKS PER DAY
"KRN",19,11025,"U")
WINDOWS SCHEDULING PROCEDURE C
"KRN",19.1,488,-1)
0^1
"KRN",19.1,488,0)
BSDXZMENU^IHS Windows Scheduling
"KRN",19.1,489,-1)
0^2
"KRN",19.1,489,0)
BSDXZMGR^IHS Windows Scheduling Manager
"KRN",101,4298,-1)
0^2
"KRN",101,4298,0)
BSDX CANCEL APPOINTMENT^BSDX CANCEL APPOINTMENT^^A^^^^^^^^
"KRN",101,4298,1,0)
^^4^4^3040915^
"KRN",101,4298,1,1,0)
IHS protocol called by the PIMS v5.3 Scheduling Event Driver
"KRN",101,4298,1,2,0)
(BSDAM APPOINTMENT EVENTS).  This protocol will
"KRN",101,4298,1,3,0)
cancel an appointment in the IHS Windows Scheduling package
"KRN",101,4298,1,4,0)
when the corresponding appointment in RPMS Scheduling is cancelled.
"KRN",101,4298,4)
^^^BSDX CANCEL APPOINTMENT
"KRN",101,4298,20)
I $G(SDAMEVT)=2,$D(^BSDXAPPL) D CANEVT^BSDX08($G(DFN),$G(SDT),$G(SDCL))
"KRN",101,4298,99)
62772,44459
"KRN",101,4299,-1)
0^1
"KRN",101,4299,0)
BSDX ADD APPOINTMENT^BSDX ADD APPOINTMENT^^A^^^^^^^^
"KRN",101,4299,1,0)
^101.06^4^4^3040915^^
"KRN",101,4299,1,1,0)
IHS protocol called by the PIMS v5.3 Scheduling Event Driver
"KRN",101,4299,1,2,0)
(BSDAM APPOINTMENT EVENTS).  This protocol will
"KRN",101,4299,1,3,0)
add an appointment in the IHS Windows Scheduling package
"KRN",101,4299,1,4,0)
when the corresponding appointment in RPMS Scheduling is added.
"KRN",101,4299,4)
^^^BSDX ADD APPOINTMENT
"KRN",101,4299,20)
I $G(SDAMEVT)=1,$D(^BSDXAPPL) D ADDEVT^BSDX07($G(DFN),$G(SDT),$G(SDCL),$G(SDDA))
"KRN",101,4299,99)
62772,44459
"KRN",101,4300,-1)
0^4
"KRN",101,4300,0)
BSDX NOSHOW APPOINTMENT^BSDX NOSHOW APPOINTMENT^^A^^^^^^^^
"KRN",101,4300,1,0)
^101.06^4^4^3040915^^
"KRN",101,4300,1,1,0)
IHS protocol called by the PIMS v5.3 Scheduling Event Driver
"KRN",101,4300,1,2,0)
(BSDAM APPOINTMENT EVENTS).  This protocol will
"KRN",101,4300,1,3,0)
no-show an appointment in the IHS Windows Scheduling package
"KRN",101,4300,1,4,0)
when the corresponding appointment in RPMS Scheduling is no-showed.
"KRN",101,4300,4)
^^^BSDX NOSHOW APPOINTMENT
"KRN",101,4300,20)
I $G(SDAMEVT)=3,$D(^BSDXAPPL) D NOSEVT^BSDX31($G(DFN),$G(SDT),$G(SDCL))
"KRN",101,4300,99)
62772,44459
"KRN",101,4301,-1)
0^3
"KRN",101,4301,0)
BSDX CHECKIN APPOINTMENT^BSDX CHECKIN APPOINTMENT^^A^^^^^^^^
"KRN",101,4301,1,0)
^101.06^4^4^3040915^^^
"KRN",101,4301,1,1,0)
IHS protocol called by the PIMS v5.3 Scheduling Event Driver
"KRN",101,4301,1,2,0)
(BSDAM APPOINTMENT EVENTS).  This protocol will
"KRN",101,4301,1,3,0)
check in an appointment in the IHS Windows Scheduling package
"KRN",101,4301,1,4,0)
when the corresponding appointment in RPMS Scheduling is checked in.
"KRN",101,4301,4)
^^^BSDX CHECKIN APPOINTMENT
"KRN",101,4301,20)
I $G(SDAMEVT)=4,$D(^BSDXAPPL) D CHKEVT^BSDX25($G(DFN),$G(SDT),$G(SDCL))
"KRN",101,4301,99)
62772,44459
"KRN",8989.5,30793,0)
212;DIC(9.4,^BSDX AUTO PRINT RS^1
"KRN",8989.5,30793,1)
0
"KRN",8989.5,30794,0)
212;DIC(9.4,^BSDX AUTO PRINT AS^1
"KRN",8989.5,30794,1)
0
"KRN",8989.51,1245,-1)
0^2
"KRN",8989.51,1245,0)
BSDX AUTO PRINT RS^Auto Print Routing Slip?^0
"KRN",8989.51,1245,1)
Y^^Should Routing Slip in BSDX GUI be printed automatically? (yes/no)
"KRN",8989.51,1245,4,0)
^8989.514^4^4
"KRN",8989.51,1245,4,1,0)
ROUTING
"KRN",8989.51,1245,4,2,0)
SLIP
"KRN",8989.51,1245,4,3,0)
SCHEDULING
"KRN",8989.51,1245,4,4,0)
PRINTING
"KRN",8989.51,1245,4,"B","PRINTING",4)

"KRN",8989.51,1245,4,"B","ROUTING",1)

"KRN",8989.51,1245,4,"B","SCHEDULING",3)

"KRN",8989.51,1245,4,"B","SLIP",2)

"KRN",8989.51,1245,30,0)
^8989.513I^4^4
"KRN",8989.51,1245,30,1,0)
1^200
"KRN",8989.51,1245,30,2,0)
2^44
"KRN",8989.51,1245,30,3,0)
3^4.2
"KRN",8989.51,1245,30,4,0)
4^9.4
"KRN",8989.51,1246,-1)
0^1
"KRN",8989.51,1246,0)
BSDX AUTO PRINT AS^Auto Print Appointment Slip?^0
"KRN",8989.51,1246,1)
Y^^Should Appointment Slip in BSDX GUI by printed automatically? (yes/no)
"KRN",8989.51,1246,4,0)
^8989.514^4^4
"KRN",8989.51,1246,4,1,0)
APPOINTMENT
"KRN",8989.51,1246,4,2,0)
SLIP
"KRN",8989.51,1246,4,3,0)
SCHEDULING
"KRN",8989.51,1246,4,4,0)
PRINTING
"KRN",8989.51,1246,4,"B","APPOINTMENT",1)

"KRN",8989.51,1246,4,"B","PRINTING",4)

"KRN",8989.51,1246,4,"B","SCHEDULING",3)

"KRN",8989.51,1246,4,"B","SLIP",2)

"KRN",8989.51,1246,30,0)
^8989.513I^4^4
"KRN",8989.51,1246,30,1,0)
1^200
"KRN",8989.51,1246,30,2,0)
2^44
"KRN",8989.51,1246,30,3,0)
3^4.2
"KRN",8989.51,1246,30,4,0)
4^9.4
"KRN",8994,2465,-1)
0^16
"KRN",8994,2465,0)
BSDX RESOURCE GROUPS BY USER^DEPUSR^BSDX01^4
"KRN",8994,2466,-1)
0^22
"KRN",8994,2466,0)
BSDX RESOURCES^RESUSR^BSDX01^4
"KRN",8994,2467,-1)
0^6
"KRN",8994,2467,0)
BSDX CREATE APPT SCHEDULE^CRSCH^BSDX02^4
"KRN",8994,2468,-1)
0^1
"KRN",8994,2468,0)
BSDX ADD NEW APPOINTMENT^APPADD^BSDX07^4
"KRN",8994,2469,-1)
0^4
"KRN",8994,2469,0)
BSDX CANCEL APPOINTMENT^APPDEL^BSDX08^4
"KRN",8994,2470,-1)
0^7
"KRN",8994,2470,0)
BSDX CREATE ASGND SLOT SCHED^CASSCH^BSDX04^4
"KRN",8994,2471,-1)
0^2
"KRN",8994,2471,0)
BSDX ADD NEW AVAILABILITY^AVADD^BSDX12^4
"KRN",8994,2472,-1)
0^5
"KRN",8994,2472,0)
BSDX CANCEL AVAILABILITY^AVDEL^BSDX13^4
"KRN",8994,2473,-1)
0^3
"KRN",8994,2473,0)
BSDX APPT BLOCKS OVERLAP^APBLKOV^BSDX05^4
"KRN",8994,2474,-1)
0^12
"KRN",8994,2474,0)
BSDX TYPE BLOCKS OVERLAP^TPBLKOV^BSDX06^4
"KRN",8994,2475,-1)
0^10
"KRN",8994,2475,0)
BSDX GET BASIC REG INFO^GETREGA^BSDX09^4
"KRN",8994,2476,-1)
0^15
"KRN",8994,2476,0)
BSDX GROUP RESOURCE^DEPRES^BSDX01^4
"KRN",8994,2477,-1)
0^13
"KRN",8994,2477,0)
BSDX ADD/EDIT ACCESS TYPE^ACCTYP^BSDX14^4
"KRN",8994,2478,-1)
0^14
"KRN",8994,2478,0)
BSDX GET ACCESS GROUP TYPES^GRPTYP^BSDX15^4
"KRN",8994,2479,-1)
0^20
"KRN",8994,2479,0)
BSDX ADD/EDIT RESOURCE^RSRC^BSDX16^4
"KRN",8994,2480,-1)
0^19
"KRN",8994,2480,0)
BSDX SCHEDULE USER^SCHUSR^BSDX17^4
"KRN",8994,2481,-1)
0^18
"KRN",8994,2481,0)
BSDX DELETE RESOURCEUSER^DELRU^BSDX18^4
"KRN",8994,2482,-1)
0^17
"KRN",8994,2482,0)
BSDX ADD/EDIT RESOURCEUSER^ADDRU^BSDX18^4
"KRN",8994,2483,-1)
0^21
"KRN",8994,2483,0)
BSDX SCHEDULING USER INFO^SUINFO^BSDX01^4
"KRN",8994,2484,-1)
0^23
"KRN",8994,2484,0)
BSDX ADD/EDIT RESOURCE GROUP^ADDRG^BSDX19^4
"KRN",8994,2485,-1)
0^24
"KRN",8994,2485,0)
BSDX DELETE RESOURCE GROUP^DELRG^BSDX19^4
"KRN",8994,2486,-1)
0^27
"KRN",8994,2486,0)
BSDX DEPARTMENTS BY USER^DEPUSR^BSDX01^4
"KRN",8994,2487,-1)
0^28
"KRN",8994,2487,0)
BSDX RESOURCES BY USER^RESUSR^BSDX01^4
"KRN",8994,2488,-1)
0^26
"KRN",8994,2488,0)
BSDX DEPARTMENT RESOURCE^DEPRES^BSDX01^4
"KRN",8994,2489,-1)
0^25
"KRN",8994,2489,0)
BSDX DELETE RES GROUP ITEM^DELRGI^BSDX20^4
"KRN",8994,2490,-1)
0^30
"KRN",8994,2490,0)
BSDX ADD RES GROUP ITEM^ADDRGI^BSDX20^4
"KRN",8994,2491,-1)
0^31
"KRN",8994,2491,0)
BSDX ADD/EDIT ACCESS GROUP^ADDAG^BSDX21^4
"KRN",8994,2492,-1)
0^32
"KRN",8994,2492,0)
BSDX DELETE ACCESS GROUP^DELAG^BSDX21^4
"KRN",8994,2493,-1)
0^29
"KRN",8994,2493,0)
BSDX ADD ACCESS GROUP ITEM^ADDAGI^BSDX22^4
"KRN",8994,2494,-1)
0^33
"KRN",8994,2494,0)
BSDX DELETE ACCESS GROUP ITEM^DELAGI^BSDX22^4
"KRN",8994,2495,-1)
0^34
"KRN",8994,2495,0)
BSDX REGISTER EVENT^REGEVNT^BSDX23^4
"KRN",8994,2496,-1)
0^35
"KRN",8994,2496,0)
BSDX UNREGISTER EVENT^UNREG^BSDX23^4
"KRN",8994,2497,-1)
0^36
"KRN",8994,2497,0)
BSDX RAISE EVENT^RAISEVNT^BSDX23^4
"KRN",8994,2498,-1)
0^37
"KRN",8994,2498,0)
BSDX SEARCH AVAILABILITY^SEARCH^BSDX24^4
"KRN",8994,2499,-1)
0^38
"KRN",8994,2499,0)
BSDX CHECKIN APPOINTMENT^CHECKIN^BSDX25^4
"KRN",8994,2500,-1)
0^39
"KRN",8994,2500,0)
BSDX EDIT APPOINTMENT^EDITAPT^BSDX26^4
"KRN",8994,2501,-1)
0^40
"KRN",8994,2501,0)
BSDX PATIENT APPT DISPLAY^PADISP^BSDX27^4
"KRN",8994,2502,-1)
0^41
"KRN",8994,2502,0)
BSDXPatientLookupRS^PTLOOKRS^BSDX28^1
"KRN",8994,2503,-1)
0^42
"KRN",8994,2503,0)
BSDX SPACEBAR SET^SPACE^BSDX30^4
"KRN",8994,2504,-1)
0^45
"KRN",8994,2504,0)
BSDX COPY APPOINTMENTS^BSDXCP^BSDX29^4
"KRN",8994,2505,-1)
0^44
"KRN",8994,2505,0)
BSDX COPY APPOINTMENT STATUS^CPSTAT^BSDX29^4
"KRN",8994,2506,-1)
0^43
"KRN",8994,2506,0)
BSDX COPY APPOINTMENT CANCEL^CPCANC^BSDX29^4
"KRN",8994,2507,-1)
0^46
"KRN",8994,2507,0)
BSDX CLINIC LETTERS^CLDISP^BSDX27^4
"KRN",8994,2508,-1)
0^47
"KRN",8994,2508,0)
BSDX NOSHOW^NOSHOW^BSDX31^4
"KRN",8994,2509,-1)
0^48
"KRN",8994,2509,0)
BSDX IM HERE^IMHERE^BSDX31^1
"KRN",8994,2509,1,0)
^^2^2^3040304^
"KRN",8994,2509,1,1,0)
Returns a simple value to client.  Used to establish continued existence
"KRN",8994,2509,1,2,0)
of the client to the server; resets the server READ timeout.
"KRN",8994,2510,-1)
0^49
"KRN",8994,2510,0)
BSDX HOSPITAL LOCATION^HOSPLOC^BSDX32^4
"KRN",8994,2511,-1)
0^50
"KRN",8994,2511,0)
BSDX CLINIC SETUP^CLNSET^BSDX32^4
"KRN",8994,2512,-1)
0^51
"KRN",8994,2512,0)
BSDX REBOOK LIST^RBLETT^BSDX34^4
"KRN",8994,2513,-1)
0^52
"KRN",8994,2513,0)
BSDX REBOOK CLINIC LIST^RBCLIN^BSDX34^4
"KRN",8994,2514,-1)
0^53
"KRN",8994,2514,0)
BSDX REBOOK SET^SETRBK^BSDX33^4
"KRN",8994,2515,-1)
0^54
"KRN",8994,2515,0)
BSDX RESOURCE LETTERS^RSRCLTR^BSDX35^4
"KRN",8994,2516,-1)
0^55
"KRN",8994,2516,0)
BSDX CANCEL CLINIC LIST^CANCLIN^BSDX34^4
"KRN",8994,2517,-1)
0^56
"KRN",8994,2517,0)
BSDX CANCEL AV BY DATE^AVDELDT^BSDX13^4
"KRN",8994,2518,-1)
0^57
"KRN",8994,2518,0)
BSDX REBOOK NEXT BLOCK^RBNEXT^BSDX33^4
"KRN",8994,2519,-1)
0^58
"KRN",8994,2519,0)
BSDX EHR PATIENT^EHRPT^BSDX30^4
"KRN",8994,2520,-1)
0^59
"KRN",8994,2520,0)
BSDX HOSP LOC PROVIDERS^P^BSDXGPRV^4
"KRN",8994,2524,-1)
0^107
"KRN",8994,2524,0)
BSDX REMOVE CHECK-IN^RMCI^BSDX25^4^
"KRN",8994,2525,-1)
0^105
"KRN",8994,2525,0)
BSDX SET PARAM^SP^BSDX01^1
"KRN",8994,2526,-1)
0^106
"KRN",8994,2526,0)
BSDX GET PARAM^GP^BSDX01^1
"KRN",8994,2705,-1)
0^108
"KRN",8994,2705,0)
BSDX GET RAD EXAM FOR PT^GETRADEX^BSDX01^4
"KRN",8994,2706,-1)
0^109
"KRN",8994,2706,0)
BSDX SCHEDULE RAD EXAM^SCHRAEX^BSDX01^1
"KRN",8994,2707,-1)
0^110
"KRN",8994,2707,0)
BSDX HOLD RAD EXAM^HOLDRAEX^BSDX01^1
"KRN",8994,2708,-1)
0^111
"KRN",8994,2708,0)
BSDX CAN HOLD RAD EXAM^CANHOLD^BSDX01^1
"MBREQ")
0
"ORD",3,19.1)
19.1;3;;;KEY^XPDTA1;KEYF1^XPDIA1;KEYE1^XPDIA1;KEYF2^XPDIA1;;KEYDEL^XPDIA1
"ORD",3,19.1,0)
SECURITY KEY
"ORD",15,101)
101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA
"ORD",15,101,0)
PROTOCOL
"ORD",16,8994)
8994;16;1;;;;;;;RPCDEL^XPDIA1
"ORD",16,8994,0)
REMOTE PROCEDURE
"ORD",18,19)
19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
"ORD",18,19,0)
OPTION
"ORD",20,8989.51)
8989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^XPDIA3(%)
"ORD",20,8989.51,0)
PARAMETER DEFINITION
"PKG",212,-1)
1^1
"PKG",212,0)
IHS Windows Scheduling^BSDX^IHS Windows Scheduling Extensions
"PKG",212,20,0)
^9.402P^^
"PKG",212,22,0)
^9.49I^1^1
"PKG",212,22,1,0)
1.7^3130601^3121111^8
"PKG",212,22,1,1,0)
^^33^33^3130601
"PKG",212,22,1,1,1,0)
IHS Clinical Scheduling modified for VISTA v 1.7.
"PKG",212,22,1,1,2,0)
Documentation:
"PKG",212,22,1,1,3,0)
https://trac.opensourcevista.net/wiki/SchedulingGUI
"PKG",212,22,1,1,4,0)
 
"PKG",212,22,1,1,5,0)
Program originally written by Horace Whitt for IHS.
"PKG",212,22,1,1,6,0)
Port to VISTA and Maintenance done by Sam Habiel for various clients.
"PKG",212,22,1,1,7,0)
Electronic Health Solutions (EHS) has funded most of the work for the 
"PKG",212,22,1,1,8,0)
quality assurance of the Scheduling GUI.
"PKG",212,22,1,1,9,0)
 
"PKG",212,22,1,1,10,0)
Feature List
"PKG",212,22,1,1,11,0)
    Make and cancel appointments (Future appointments and Walk-ins)
"PKG",212,22,1,1,12,0)
    Check-in and undo check-in's.
"PKG",212,22,1,1,13,0)
    No-show and undo No-shows.
"PKG",212,22,1,1,14,0)
    Make slots (i.e. how many patients will a provider see)
"PKG",212,22,1,1,15,0)
    Set Overbook permissions to Clerks
"PKG",212,22,1,1,16,0)
    Print Schedule List for Providers
"PKG",212,22,1,1,17,0)
    Print Appointment List for Patients
"PKG",212,22,1,1,18,0)
    Print Appointment Reminder Letters
"PKG",212,22,1,1,19,0)
    Auto-Rebook appointments (along with Rebook letters)
"PKG",212,22,1,1,20,0)
    Search for appointments in the future (you can limit to specific slot 
"PKG",212,22,1,1,21,0)
type or day)
"PKG",212,22,1,1,22,0)
    Integration with the Radiology Package to make Radiology Appointments 
"PKG",212,22,1,1,23,0)
(v 1.6)
"PKG",212,22,1,1,24,0)
    Dynamic view of Schedules:
"PKG",212,22,1,1,25,0)
        Can open multiple schedules for a Clinic Group
"PKG",212,22,1,1,26,0)
        Can view a single schedule in 1, 5 or 7 day view
"PKG",212,22,1,1,27,0)
        Can change the time scale as long as it isn't less the minimum 
"PKG",212,22,1,1,28,0)
appointment length 
"PKG",212,22,1,1,29,0)
    Bi-directional communication with PIMS Scheduling Module.
"PKG",212,22,1,1,30,0)
    Appointment Clipboard Functionality
"PKG",212,22,1,1,31,0)
    Drag and drop for appointments
"PKG",212,22,1,1,32,0)
    Full UTF-8 support if the Mumps Database supports it.
"PKG",212,22,1,1,33,0)
    L18N for Arabic 
"PKG",212,"VERSION")
1.7
"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")
41
"RTN","BSDX01")
0^1^B172528150
"RTN","BSDX01",1,0)
BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 1/29/13 12:53pm
"RTN","BSDX01",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX01",3,0)
 ; Licensed under LGPL
"RTN","BSDX01",4,0)
 ;
"RTN","BSDX01",5,0)
SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point
"RTN","BSDX01",6,0)
 ;D DEBUG^%Serenji("SUINFO^BSDX01(.BSDXY,BSDXDUZ)")
"RTN","BSDX01",7,0)
 ;
"RTN","BSDX01",8,0)
 Q
"RTN","BSDX01",9,0)
 ;EHS/WAT;UJOK*1.0*4 ;JAN 24,2013;Update [Updating the SUINFO function by adding a new parameter "USERKEY" that holds the name of the user key].
"RTN","BSDX01",10,0)
    ;EHS/WAT;UJO*2.0*31 ;JAN 24,2013;Update [Updating the SUINFO function by adding a new parameter "USERKEY" that holds the name of the user key].
"RTN","BSDX01",11,0)
    ;SUINFO(BSDXY,BSDXDUZ)    ;EP
"RTN","BSDX01",12,0)
SUINFO(BSDXY,BSDXDUZ,USERKEY)  ;EP
"RTN","BSDX01",13,0)
 ;Called by BSDX SCHEDULING USER INFO
"RTN","BSDX01",14,0)
 ;Returns ADO Recordset having column MANAGER
"RTN","BSDX01",15,0)
 ;MANAGER = YES if user has keys BSDXZMGR or XUPROGMODE
"RTN","BSDX01",16,0)
 ;
"RTN","BSDX01",17,0)
 N BSDXMGR,BSDXERR
"RTN","BSDX01",18,0)
 K ^BSDXTMP($J)
"RTN","BSDX01",19,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX01",20,0)
 S BSDXI=0
"RTN","BSDX01",21,0)
 S BSDXERR=""
"RTN","BSDX01",22,0)
 S ^BSDXTMP($J,BSDXI)="T00010MANAGER"_$C(30)
"RTN","BSDX01",23,0)
 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
"RTN","BSDX01",24,0)
 I '+BSDXDUZ S BSDXDUZ=DUZ
"RTN","BSDX01",25,0)
 ;EHS/WAT;UJOK*1.0*4 ;JAN 24,2013; Update [Updating the argument sent to $$APSEC function from hard coded string "BSDXZMGR" to "USERKEY" variable].
"RTN","BSDX01",26,0)
    ;EHS/WAT;UJO*2.0*31 ;JAN 24,2013; Update [Updating the argument sent to $$APSEC function from hard coded string "BSDXZMGR" to "USERKEY" variable].
"RTN","BSDX01",27,0)
    ;S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ);
"RTN","BSDX01",28,0)
    S BSDXMGR=$$APSEC(USERKEY,BSDXDUZ)
"RTN","BSDX01",29,0)
 S BSDXMGR=$S(BSDXMGR=1:"YES",1:"NO")
"RTN","BSDX01",30,0)
 S BSDXI=BSDXI+1
"RTN","BSDX01",31,0)
 S ^BSDXTMP($J,BSDXI)=BSDXMGR_$C(30)
"RTN","BSDX01",32,0)
 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR    
"RTN","BSDX01",33,0)
 Q
"RTN","BSDX01",34,0)
DEPUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
"RTN","BSDX01",35,0)
 ;
"RTN","BSDX01",36,0)
 ;
"RTN","BSDX01",37,0)
 ;D DEBUG^%Serenji("DEPUSR^BSDX01(.BSDXY,BSDXDUZ)")
"RTN","BSDX01",38,0)
 ;
"RTN","BSDX01",39,0)
 Q
"RTN","BSDX01",40,0)
 ;
"RTN","BSDX01",41,0)
DEPUSR(BSDXY,BSDXDUZ)  ;EP
"RTN","BSDX01",42,0)
 ;Called by BSDX RESOURCE GROUPS BY USER
"RTN","BSDX01",43,0)
 ;Returns ADO Recordset with all ACTIVE resource group names to which user has access
"RTN","BSDX01",44,0)
 ;based on entries in BSDX RESOURCE USER file (Say this again for myself: Groups ONLY!!)
"RTN","BSDX01",45,0)
 ;If BSDXDUZ=0 then returns all department names for current DUZ
"RTN","BSDX01",46,0)
    ;if not linked, always returned.
"RTN","BSDX01",47,0)
 ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
"RTN","BSDX01",48,0)
 ;then ALL resource group names are returned regardless of whether any active resources
"RTN","BSDX01",49,0)
 ;are associated with the group or not.
"RTN","BSDX01",50,0)
 ;
"RTN","BSDX01",51,0)
 ;
"RTN","BSDX01",52,0)
 N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
"RTN","BSDX01",53,0)
 N BSDXMGR,BSDXNOD
"RTN","BSDX01",54,0)
 K ^BSDXTEMP($J)
"RTN","BSDX01",55,0)
 K ^BSDXTMP($J)
"RTN","BSDX01",56,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX01",57,0)
 S BSDXI=0
"RTN","BSDX01",58,0)
 S BSDXERR=""
"RTN","BSDX01",59,0)
 S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP"_$C(30)
"RTN","BSDX01",60,0)
 I '+BSDXDUZ S BSDXDUZ=DUZ
"RTN","BSDX01",61,0)
 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
"RTN","BSDX01",62,0)
 S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
"RTN","BSDX01",63,0)
 ;
"RTN","BSDX01",64,0)
 ;User does not have BSDXZMGR or XUPROGMODE keys, so
"RTN","BSDX01",65,0)
 ;$O THRU AC XREF OF BSDX RESOURCE USER
"RTN","BSDX01",66,0)
 I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F  S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN  D
"RTN","BSDX01",67,0)
 . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
"RTN","BSDX01",68,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",69,0)
    . ; Q:'$$INDIV2(BSDXRES)  ; If not in the same division as user, quit
"RTN","BSDX01",70,0)
 . S BSDXRNOD=^BSDXRES(BSDXRES,0)
"RTN","BSDX01",71,0)
 . ;QUIT if the resource is inactive
"RTN","BSDX01",72,0)
 . Q:$P(BSDXRNOD,U,2)=1
"RTN","BSDX01",73,0)
 . S BSDXDEP=0 F  S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP  D
"RTN","BSDX01",74,0)
 . . Q:'$D(^BSDXDEPT(BSDXDEP,0))
"RTN","BSDX01",75,0)
 . . Q:$D(^BSDXTEMP($J,BSDXDEP))
"RTN","BSDX01",76,0)
 . . S ^BSDXTEMP($J,BSDXDEP)=""
"RTN","BSDX01",77,0)
 . . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U)
"RTN","BSDX01",78,0)
 . . S BSDXI=BSDXI+1
"RTN","BSDX01",79,0)
 . . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_$C(30)
"RTN","BSDX01",80,0)
 . . Q
"RTN","BSDX01",81,0)
 . Q
"RTN","BSDX01",82,0)
 ;
"RTN","BSDX01",83,0)
 ;User does have BSDXZMGR or XUPROGMODE keys, so
"RTN","BSDX01",84,0)
 ;$O THRU BSDX RESOURCE GROUP file directly
"RTN","BSDX01",85,0)
 I BSDXMGR S BSDXIEN=0 F  S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN  D
"RTN","BSDX01",86,0)
 . Q:'$D(^BSDXDEPT(BSDXIEN,0))
"RTN","BSDX01",87,0)
 . S BSDXNOD=^BSDXDEPT(BSDXIEN,0)
"RTN","BSDX01",88,0)
 . S BSDXDEPN=$P(BSDXNOD,U)
"RTN","BSDX01",89,0)
 . S BSDXI=BSDXI+1
"RTN","BSDX01",90,0)
 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_$C(30)
"RTN","BSDX01",91,0)
 . Q
"RTN","BSDX01",92,0)
 ;
"RTN","BSDX01",93,0)
 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
"RTN","BSDX01",94,0)
 Q
"RTN","BSDX01",95,0)
 ;
"RTN","BSDX01",96,0)
 ;
"RTN","BSDX01",97,0)
RESUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
"RTN","BSDX01",98,0)
 ;
"RTN","BSDX01",99,0)
 ;
"RTN","BSDX01",100,0)
 ;D DEBUG^%Serenji("RESUSR^BSDX01(.BSDXY,BSDXDUZ)")
"RTN","BSDX01",101,0)
 ;
"RTN","BSDX01",102,0)
 Q
"RTN","BSDX01",103,0)
 ;
"RTN","BSDX01",104,0)
RESUSR(BSDXY,BSDXDUZ) ;EP
"RTN","BSDX01",105,0)
 ;Returns ADO Recordset with ALL RESOURCE names
"RTN","BSDX01",106,0)
 ;Inactive RESOURCES are NOT filtered out
"RTN","BSDX01",107,0)
 ;Called by BSDX RESOURCES BY USER
"RTN","BSDX01",108,0)
 ;
"RTN","BSDX01",109,0)
 N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI,BSDX,BSDXLTR
"RTN","BSDX01",110,0)
 N BSDXNOS,BSDXCAN
"RTN","BSDX01",111,0)
 K ^BSDXTMP($J)
"RTN","BSDX01",112,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX01",113,0)
 S BSDXI=0
"RTN","BSDX01",114,0)
 S BSDXERR=""
"RTN","BSDX01",115,0)
 S ^BSDXTMP($J,BSDXI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00010INACTIVE^I00010TIMESCALE^I00010HOSPITAL_LOCATION_ID^T00030LETTER_TEXT^T00030NO_SHOW_LETTER"
"RTN","BSDX01",116,0)
 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^T00030CLINIC_CANCELLATION_LETTER^I00010VIEW^I00010OVERBOOK^I00010MODIFY_SCHEDULE^I00010MODIFY_APPOINTMENTS"_$C(30)
"RTN","BSDX01",117,0)
 I '+BSDXDUZ S BSDXDUZ=DUZ
"RTN","BSDX01",118,0)
 ;$O THRU AC XREF OF BSDX RESOURCE USER
"RTN","BSDX01",119,0)
 ;Rmoved these lines in order to just return all resource names
"RTN","BSDX01",120,0)
 ;I $D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F  S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN  D
"RTN","BSDX01",121,0)
 ;. S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
"RTN","BSDX01",122,0)
 ;
"RTN","BSDX01",123,0)
 ;$O THRU BSDX RESOURCE File
"RTN","BSDX01",124,0)
 S BSDXRES=0 F  S BSDXRES=$O(^BSDXRES(BSDXRES)) Q:'+BSDXRES  D
"RTN","BSDX01",125,0)
 . Q:'$D(^BSDXRES(BSDXRES,0))
"RTN","BSDX01",126,0)
 . S BSDXRNOD=^BSDXRES(BSDXRES,0)
"RTN","BSDX01",127,0)
 . N BSDXSC S BSDXSC=$P(BSDXRNOD,U,4)  ; Hospital Location
"RTN","BSDX01",128,0)
    . ;Q:$P(BSDXRNOD,U,2)=1  ;Inactive resources not filtered
"RTN","BSDX01",129,0)
 . ;S BSDXRDAT=$P(BSDXRNOD,U,1,4)
"RTN","BSDX01",130,0)
 . ;I '$$INDIV(BSDXSC) QUIT  ; If not in division, quit
"RTN","BSDX01",131,0)
    . K BSDXRDAT
"RTN","BSDX01",132,0)
 . F BSDX=1:1:4 S $P(BSDXRDAT,U,BSDX)=$P(BSDXRNOD,U,BSDX)
"RTN","BSDX01",133,0)
 . S BSDXRDAT=BSDXRES_U_BSDXRDAT
"RTN","BSDX01",134,0)
 . ;Get letter text from wp field
"RTN","BSDX01",135,0)
 . S BSDXLTR=""
"RTN","BSDX01",136,0)
 . I $D(^BSDXRES(BSDXRES,1)) D
"RTN","BSDX01",137,0)
 . . S BSDXIEN=0
"RTN","BSDX01",138,0)
 . . F  S BSDXIEN=$O(^BSDXRES(BSDXRES,1,BSDXIEN)) Q:'+BSDXIEN  D
"RTN","BSDX01",139,0)
 . . . S BSDXLTR=BSDXLTR_$G(^BSDXRES(BSDXRES,1,BSDXIEN,0))
"RTN","BSDX01",140,0)
 . . . S BSDXLTR=BSDXLTR_$C(13)_$C(10)
"RTN","BSDX01",141,0)
 . S BSDXNOS=""
"RTN","BSDX01",142,0)
 . I $D(^BSDXRES(BSDXRES,12)) D
"RTN","BSDX01",143,0)
 . . S BSDXIEN=0 F  S BSDXIEN=$O(^BSDXRES(BSDXRES,12,BSDXIEN)) Q:'+BSDXIEN  D
"RTN","BSDX01",144,0)
 . . . S BSDXNOS=BSDXNOS_$G(^BSDXRES(BSDXRES,12,BSDXIEN,0))
"RTN","BSDX01",145,0)
 . . . S BSDXNOS=BSDXNOS_$C(13)_$C(10)
"RTN","BSDX01",146,0)
 . S BSDXCAN=""
"RTN","BSDX01",147,0)
 . I $D(^BSDXRES(BSDXRES,13)) D
"RTN","BSDX01",148,0)
 . . S BSDXIEN=0 F  S BSDXIEN=$O(^BSDXRES(BSDXRES,13,BSDXIEN)) Q:'+BSDXIEN  D
"RTN","BSDX01",149,0)
 . . . S BSDXCAN=BSDXCAN_$G(^BSDXRES(BSDXRES,13,BSDXIEN,0))
"RTN","BSDX01",150,0)
 . . . S BSDXCAN=BSDXCAN_$C(13)_$C(10)
"RTN","BSDX01",151,0)
 . N BSDXACC,BSDXMGR
"RTN","BSDX01",152,0)
 . S BSDXACC="0^0^0^0"
"RTN","BSDX01",153,0)
 . S BSDXMGR=$O(^DIC(19.1,"B","BSDXZMGR",0))
"RTN","BSDX01",154,0)
 . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
"RTN","BSDX01",155,0)
 . S BSDXMGR=$O(^DIC(19.1,"B","XUPROGMODE",0))
"RTN","BSDX01",156,0)
 . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
"RTN","BSDX01",157,0)
 . I BSDXACC="0^0^0^0" D
"RTN","BSDX01",158,0)
 . . N BSDXNOD,BSDXRUID
"RTN","BSDX01",159,0)
 . . S BSDXRUID=0
"RTN","BSDX01",160,0)
 . . ;Get entry for this user and resource
"RTN","BSDX01",161,0)
 . . F  S BSDXRUID=$O(^BSDXRSU("AC",BSDXDUZ,BSDXRUID)) Q:'+BSDXRUID  I $D(^BSDXRSU(BSDXRUID,0)),$P(^(0),U)=BSDXRES Q
"RTN","BSDX01",162,0)
 . . Q:'+BSDXRUID
"RTN","BSDX01",163,0)
 . . S $P(BSDXACC,U)=1
"RTN","BSDX01",164,0)
 . . S BSDXNOD=$G(^BSDXRSU(BSDXRUID,0))
"RTN","BSDX01",165,0)
 . . S $P(BSDXACC,U,2)=+$P(BSDXNOD,U,3)
"RTN","BSDX01",166,0)
 . . S $P(BSDXACC,U,3)=+$P(BSDXNOD,U,4)
"RTN","BSDX01",167,0)
 . . S $P(BSDXACC,U,4)=+$P(BSDXNOD,U,5)
"RTN","BSDX01",168,0)
 . S BSDXRDAT=BSDXRDAT_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_U_BSDXACC
"RTN","BSDX01",169,0)
 . S BSDXI=BSDXI+1
"RTN","BSDX01",170,0)
 . S ^BSDXTMP($J,BSDXI)=BSDXRDAT_$C(30)
"RTN","BSDX01",171,0)
 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
"RTN","BSDX01",172,0)
 Q
"RTN","BSDX01",173,0)
 ;
"RTN","BSDX01",174,0)
DEPRESD(BSDXY,BSDXDUZ) ;EP Debugging entry point
"RTN","BSDX01",175,0)
 ;
"RTN","BSDX01",176,0)
 ;
"RTN","BSDX01",177,0)
 ;D DEBUG^%Serenji("DEPRES^BSDX01(.BSDXY,BSDXDUZ)")
"RTN","BSDX01",178,0)
 ;
"RTN","BSDX01",179,0)
 Q
"RTN","BSDX01",180,0)
 ;
"RTN","BSDX01",181,0)
DEPRES(BSDXY,BSDXDUZ) ;EP
"RTN","BSDX01",182,0)
 ;Called by BSDX GROUP RESOURCE
"RTN","BSDX01",183,0)
 ;Returns ADO Recordset with all ACTIVE GROUP/RESOURCE combinations
"RTN","BSDX01",184,0)
 ;to which user has access based on entries in BSDX RESOURCE USER file
"RTN","BSDX01",185,0)
 ;If BSDXDUZ=0 then returns all ACTIVE GROUP/RESOURCE combinations for current DUZ
"RTN","BSDX01",186,0)
 ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
"RTN","BSDX01",187,0)
 ;then ALL ACTIVE resource group names are returned
"RTN","BSDX01",188,0)
 ;
"RTN","BSDX01",189,0)
 N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
"RTN","BSDX01",190,0)
 N BSDXRESN,BSDXMGR,BSDXRESD,BSDXNOD,BSDXSUBID
"RTN","BSDX01",191,0)
 K ^BSDXTEMP($J)
"RTN","BSDX01",192,0)
 K ^BSDXTMP($J)
"RTN","BSDX01",193,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX01",194,0)
 S BSDXI=0
"RTN","BSDX01",195,0)
 S BSDXERR=""
"RTN","BSDX01",196,0)
 S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$C(30)
"RTN","BSDX01",197,0)
 I '+BSDXDUZ S BSDXDUZ=DUZ
"RTN","BSDX01",198,0)
 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
"RTN","BSDX01",199,0)
 S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
"RTN","BSDX01",200,0)
 ;
"RTN","BSDX01",201,0)
 ;User does not have BSDXZMGR or XUPROGMODE keys, so
"RTN","BSDX01",202,0)
 ;$O THRU AC XREF OF BSDX RESOURCE USER
"RTN","BSDX01",203,0)
 I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ))  S BSDXIEN=0 F  S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN  D
"RTN","BSDX01",204,0)
 . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
"RTN","BSDX01",205,0)
 . Q:'$D(^BSDXDEPT("AB",BSDXRES))  ; Quit if Resource isn't part of any Group
"RTN","BSDX01",206,0)
    . ;Q:'$$INDIV2(BSDXRES)  ; Quit if Resource isn't in same division as user.
"RTN","BSDX01",207,0)
 . S BSDXRNOD=$G(^BSDXRES(BSDXRES,0))
"RTN","BSDX01",208,0)
 . Q:BSDXRNOD=""
"RTN","BSDX01",209,0)
 . ;QUIT if the resource is inactive
"RTN","BSDX01",210,0)
 . Q:$P(BSDXRNOD,U,2)=1
"RTN","BSDX01",211,0)
 . S BSDXRESN=$P(BSDXRNOD,U)
"RTN","BSDX01",212,0)
 . S BSDXDEP=0 F  S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP  D
"RTN","BSDX01",213,0)
 . . Q:'$D(^BSDXDEPT(BSDXDEP,0))
"RTN","BSDX01",214,0)
 . . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U)
"RTN","BSDX01",215,0)
 . . S BSDXSUBID=$O(^BSDXDEPT(BSDXDEP,1,"B",BSDXRES,0))
"RTN","BSDX01",216,0)
 . . S BSDXI=BSDXI+1
"RTN","BSDX01",217,0)
 . . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_U_BSDXSUBID_U_BSDXRESN_U_BSDXRES_$C(30)
"RTN","BSDX01",218,0)
 . Q
"RTN","BSDX01",219,0)
 ;
"RTN","BSDX01",220,0)
 ;User does have BSDXZMGR or XUPROGMODE keys, so
"RTN","BSDX01",221,0)
 ;$O THRU BSDX RESOURCE GROUP file directly
"RTN","BSDX01",222,0)
 I BSDXMGR S BSDXIEN=0 F  S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN  D
"RTN","BSDX01",223,0)
 . Q:'$D(^BSDXDEPT(BSDXIEN,0))
"RTN","BSDX01",224,0)
 . S BSDXNOD=^BSDXDEPT(BSDXIEN,0)
"RTN","BSDX01",225,0)
 . S BSDXDEPN=$P(BSDXNOD,U)
"RTN","BSDX01",226,0)
 . S BSDXRES=0 F  S BSDXRES=$O(^BSDXDEPT(BSDXIEN,1,BSDXRES)) Q:'+BSDXRES  D
"RTN","BSDX01",227,0)
 . . N BSDXRESD
"RTN","BSDX01",228,0)
 . . Q:'$D(^BSDXDEPT(BSDXIEN,1,BSDXRES,0))  ; Quit if zero node is invalid in multiple
"RTN","BSDX01",229,0)
 . . S BSDXRESD=$P(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^")
"RTN","BSDX01",230,0)
 . . Q:'$D(^BSDXRES(BSDXRESD,0))  ; Quit if zero node of resouce file is invalid
"RTN","BSDX01",231,0)
    . . ;Q:'$$INDIV2(BSDXRESD)  ; Quit if resource is not in the same division
"RTN","BSDX01",232,0)
 . . S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
"RTN","BSDX01",233,0)
 . . Q:BSDXRNOD=""
"RTN","BSDX01",234,0)
 . . ;QUIT if the resource is inactive
"RTN","BSDX01",235,0)
 . . Q:$P(BSDXRNOD,U,2)=1
"RTN","BSDX01",236,0)
 . . S BSDXRESN=$P(BSDXRNOD,U)
"RTN","BSDX01",237,0)
 . . S BSDXI=BSDXI+1
"RTN","BSDX01",238,0)
 . . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_U_BSDXRES_U_BSDXRESN_U_BSDXRESD_$C(30)
"RTN","BSDX01",239,0)
 . . Q
"RTN","BSDX01",240,0)
 . Q
"RTN","BSDX01",241,0)
 ;
"RTN","BSDX01",242,0)
 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
"RTN","BSDX01",243,0)
 Q
"RTN","BSDX01",244,0)
 ;
"RTN","BSDX01",245,0)
APSEC(BSDXKEY,BSDXDUZ) ;EP - Return TRUE (1) if user has keys BSDXKEY or XUPROGMODE, otherwise, returns FALSE (0)
"RTN","BSDX01",246,0)
 ;
"RTN","BSDX01",247,0)
 N BSDXIEN,BSDXPROG,BSDXPKEY
"RTN","BSDX01",248,0)
 I '$G(BSDXDUZ) Q 0
"RTN","BSDX01",249,0)
 ;
"RTN","BSDX01",250,0)
 ;Test for programmer mode key
"RTN","BSDX01",251,0)
 S BSDXPROG=0
"RTN","BSDX01",252,0)
 I $D(^DIC(19.1,"B","XUPROGMODE")) D
"RTN","BSDX01",253,0)
 . S BSDXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0))
"RTN","BSDX01",254,0)
 . I '+BSDXPKEY Q
"RTN","BSDX01",255,0)
 . I '$D(^VA(200,BSDXDUZ,51,BSDXPKEY,0)) Q
"RTN","BSDX01",256,0)
 . S BSDXPROG=1
"RTN","BSDX01",257,0)
 I BSDXPROG Q 1
"RTN","BSDX01",258,0)
 ;
"RTN","BSDX01",259,0)
 I BSDXKEY="" Q 0
"RTN","BSDX01",260,0)
 I '$D(^DIC(19.1,"B",BSDXKEY)) Q 0
"RTN","BSDX01",261,0)
 S BSDXIEN=$O(^DIC(19.1,"B",BSDXKEY,0))
"RTN","BSDX01",262,0)
 I '+BSDXIEN Q 0
"RTN","BSDX01",263,0)
 I '$D(^VA(200,BSDXDUZ,51,BSDXIEN,0)) Q 0
"RTN","BSDX01",264,0)
 Q 1
"RTN","BSDX01",265,0)
SP(BSDXY,PARAM,YESNO) ; Save Param at User Level - EP
"RTN","BSDX01",266,0)
 ; Called by RPC: BSDX SET PARAM
"RTN","BSDX01",267,0)
 ; Input:
"RTN","BSDX01",268,0)
 ; - Param: Name of Parameter (prog name of course)
"RTN","BSDX01",269,0)
 ; - Yes/No: 1 or 0
"RTN","BSDX01",270,0)
 ; Output: Error Code as string; 0 is good
"RTN","BSDX01",271,0)
 ;
"RTN","BSDX01",272,0)
 ; Security Protection
"RTN","BSDX01",273,0)
 IF $EXTRACT(PARAM,1,4)'="BSDX" S BSDXY="-1^BSDX Params only allowed" QUIT
"RTN","BSDX01",274,0)
 ;
"RTN","BSDX01",275,0)
 N ERROR
"RTN","BSDX01",276,0)
 D PUT^XPAR("USR",PARAM,1,YESNO,.ERROR)
"RTN","BSDX01",277,0)
 S BSDXY=$G(ERROR)
"RTN","BSDX01",278,0)
 QUIT
"RTN","BSDX01",279,0)
 ;
"RTN","BSDX01",280,0)
GP(BSDXY,PARAM) ; Get Param - EP
"RTN","BSDX01",281,0)
 ; Called by RPC: BSDX GET PARAM
"RTN","BSDX01",282,0)
 ; Input: Name of Parameter
"RTN","BSDX01",283,0)
 ; Output: Value of parameter: 0 or 1, for now.
"RTN","BSDX01",284,0)
 ;
"RTN","BSDX01",285,0)
 S BSDXY=$$GET^XPAR("USR^LOC^SYS^PKG",PARAM,1,"I")
"RTN","BSDX01",286,0)
 QUIT
"RTN","BSDX01",287,0)
 ;
"RTN","BSDX01",288,0)
INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user?
"RTN","BSDX01",289,0)
 ; Input: BSDXSC - Hospital Location IEN
"RTN","BSDX01",290,0)
 ; Output: True or False
"RTN","BSDX01",291,0)
 I '+BSDXSC QUIT 1  ;If not tied to clinic, yes
"RTN","BSDX01",292,0)
 I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
"RTN","BSDX01",293,0)
 ; Jump to Division:Medical Center Division:Inst File Pointer for
"RTN","BSDX01",294,0)
 ; Institution IEN (and get its internal value)
"RTN","BSDX01",295,0)
 N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
"RTN","BSDX01",296,0)
 I DIV="" Q 1 ; If clinic has no division, consider it avial to user.
"RTN","BSDX01",297,0)
 I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
"RTN","BSDX01",298,0)
 E  Q 0 ; Otherwise, no
"RTN","BSDX01",299,0)
INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
"RTN","BSDX01",300,0)
 ; Input BSDXRES - BSDX RESOURCE IEN
"RTN","BSDX01",301,0)
 ; Output: True of False
"RTN","BSDX01",302,0)
 Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
"RTN","BSDX01",303,0)
UTINDIV ; Unit Test $$INDIV
"RTN","BSDX01",304,0)
 W "Testing if they are the same",!
"RTN","BSDX01",305,0)
 S DUZ(2)=67
"RTN","BSDX01",306,0)
 I '$$INDIV(1) W "ERROR",!
"RTN","BSDX01",307,0)
 I '$$INDIV(2) W "ERROR",!
"RTN","BSDX01",308,0)
 W "Testing if Div not defined in 44, should be true",!
"RTN","BSDX01",309,0)
 I '$$INDIV(3) W "ERROR",!
"RTN","BSDX01",310,0)
 W "Testing empty string. Should be true",!
"RTN","BSDX01",311,0)
 I '$$INDIV("") W "ERROR",!
"RTN","BSDX01",312,0)
 W "Testing if they are different",!
"RTN","BSDX01",313,0)
 S DUZ(2)=899
"RTN","BSDX01",314,0)
 I $$INDIV(1) W "ERROR",!
"RTN","BSDX01",315,0)
 I $$INDIV(2) W "ERROR",!
"RTN","BSDX01",316,0)
 QUIT
"RTN","BSDX01",317,0)
UTINDIV2 ; Unit Test $$INDIV2
"RTN","BSDX01",318,0)
 W "Testing if they are the same",!
"RTN","BSDX01",319,0)
 S DUZ(2)=69
"RTN","BSDX01",320,0)
 I $$INDIV2(22)'=0 W "ERROR",!
"RTN","BSDX01",321,0)
 I $$INDIV2(25)'=1 W "ERROR",!
"RTN","BSDX01",322,0)
 I $$INDIV2(26)'=1 W "ERROR",!
"RTN","BSDX01",323,0)
 I $$INDIV2(27)'=1 W "ERROR",!
"RTN","BSDX01",324,0)
 QUIT
"RTN","BSDX01",325,0)
 ;
"RTN","BSDX01",326,0)
GETRADEX(BSDXY,DFN,SCIEN) ; Get All Pending and On Hold Radiology Exams for Patient; RPC EP; UJO/SMH new in v 1.6
"RTN","BSDX01",327,0)
 ; RPC: BSDX GET RAD EXAM FOR PT; Return: Global Array
"RTN","BSDX01",328,0)
 ;
"RTN","BSDX01",329,0)
 ; Input: DFN - you should know; SCIEN - IEN of Hospital Location
"RTN","BSDX01",330,0)
 ; Output: ADO Datatable with the following columns:
"RTN","BSDX01",331,0)
 ; - BMXIEN: Radiology Exam IEN in file 75.1 (RAD/NUC MED ORDERS)
"RTN","BSDX01",332,0)
 ; - STATUS: Pending Or Hold Status
"RTN","BSDX01",333,0)
 ; - PROCEDURE: Text Procedure Name
"RTN","BSDX01",334,0)
 ; - REQUEST_DATE: Date Procedure was requested
"RTN","BSDX01",335,0)
 ;
"RTN","BSDX01",336,0)
 ; Error Processing: Silent failure. 
"RTN","BSDX01",337,0)
 ;
"RTN","BSDX01",338,0)
 S BSDXY=$NA(^BMXTEMP($J))
"RTN","BSDX01",339,0)
 K @BSDXY
"RTN","BSDX01",340,0)
 ;
"RTN","BSDX01",341,0)
 N BSDXI S BSDXI=0
"RTN","BSDX01",342,0)
 S @BSDXY@(BSDXI)="I00015BMXIEN^T00015STATUS^T00100PROCEDURE^D00030REQUEST_DATE"_$C(30)
"RTN","BSDX01",343,0)
 ;
"RTN","BSDX01",344,0)
 N BSDXRLIEN S BSDXRLIEN=$ORDER(^RA(79.1,"B",SCIEN,""))  ; IEN of HL in file 79.1, to get Radiology Imaging IEN
"RTN","BSDX01",345,0)
 I 'BSDXRLIEN GOTO END
"RTN","BSDX01",346,0)
 ;
"RTN","BSDX01",347,0)
 N BSDXOUT,BSDXERR ; Out, Error
"RTN","BSDX01",348,0)
 ;
"RTN","BSDX01",349,0)
 ; File 75.1 = RAD/NUC MED ORDERS
"RTN","BSDX01",350,0)
 ; Fields 5 = Request Status; 2 = Procedure; 16 = Requested Entered Date Time
"RTN","BSDX01",351,0)
 ; Filter Field: First piece is DFN, 5th piece is 3 or 5 (Status of Pending Or Hold); 20th piece is Radiology Location requested
"RTN","BSDX01",352,0)
        ;;EHS/MKH,BAH;;BSDX 1.7;;30/09/2012;; Update [Fix the performance issue in SchedGUI]
"RTN","BSDX01",353,0)
        ; START OF CODE CHANGES FOR [BSDX 1.7]
"RTN","BSDX01",354,0)
        ; Commented old Line
"RTN","BSDX01",355,0)
        ;D LIST^DIC(75.1,"","@;5;2;16","P","","","","B","I $P(^(0),U)=DFN&(35[$P(^(0),U,5))&($P(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXE>>RR")
"RTN","BSDX01",356,0)
        DO FIND^DIC(75.1,"","@;5;2;16","QP",DFN,"","B","IF 35[$PIECE(^(0),U,5)&($PIECE(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXERR")
"RTN","BSDX01",357,0)
        ; END OF CODE CHANGES FOR [BSDX 1.7]
"RTN","BSDX01",358,0)
 ;
"RTN","BSDX01",359,0)
 IF $DATA(BSDXERR) GOTO END
"RTN","BSDX01",360,0)
 ;
"RTN","BSDX01",361,0)
 I +BSDXOUT("DILIST",0)>0 FOR BSDXI=1:1:+BSDXOUT("DILIST",0) DO  ; if we have data, fetch the data in each row and store it in the return variable
"RTN","BSDX01",362,0)
 . N BMXIEN,BMXSTAUS,BMXPROC,BMXDATE ; Proc IEN, Proc Status, Proc Name
"RTN","BSDX01",363,0)
 . S BMXIEN=$P(BSDXOUT("DILIST",BSDXI,0),U) ; IEN
"RTN","BSDX01",364,0)
 . S BMXSTATUS=$P(BSDXOUT("DILIST",BSDXI,0),U,2) ; Status
"RTN","BSDX01",365,0)
 . S BMXPROC=$P(BSDXOUT("DILIST",BSDXI,0),U,3) ; Procedure Name
"RTN","BSDX01",366,0)
 . S BMXDATE=$TR($P(BSDXOUT("DILIST",BSDXI,0),U,4),"@"," ") ; Request Entered Date Time
"RTN","BSDX01",367,0)
 . S @BSDXY@(BSDXI)=BMXIEN_U_BMXSTATUS_U_BMXPROC_U_BMXDATE_$C(30)
"RTN","BSDX01",368,0)
END ; Errors Jump Here...
"RTN","BSDX01",369,0)
 S @BSDXY@(BSDXI+1)=$C(31)
"RTN","BSDX01",370,0)
 QUIT
"RTN","BSDX01",371,0)
 ;
"RTN","BSDX01",372,0)
SCHRAEX(BSDXY,RADFN,RAOIFN,RAOSCH) ; Schedule a Radiology Exam; RPC EP; UJO/SMH new in v 1.6
"RTN","BSDX01",373,0)
 ; RPC: BSDX SCHEDULE RAD EXAM; Return: Single Value
"RTN","BSDX01",374,0)
 ;
"RTN","BSDX01",375,0)
 ; Input: 
"RTN","BSDX01",376,0)
 ; - RADFN -> DFN
"RTN","BSDX01",377,0)
 ; - RAOIFN -> Radiology Order IEN in file 75.1
"RTN","BSDX01",378,0)
 ; - RAOSCH -> Scheduled Time for Exam
"RTN","BSDX01",379,0)
 ; Output: Always "1"
"RTN","BSDX01",380,0)
 ;
"RTN","BSDX01",381,0)
 S RAOSCH=+RAOSCH ; Strip the trailing zeros from the Fileman Date produced by C#
"RTN","BSDX01",382,0)
 N RAOSTS S RAOSTS=8  ; Status of Scheduled
"RTN","BSDX01",383,0)
 D ^RAORDU  ; API in Rad expects RADFN, RAOIFN, RAOSCH, and RAOSTS
"RTN","BSDX01",384,0)
 S BSDXY=1 ; Success
"RTN","BSDX01",385,0)
 QUIT
"RTN","BSDX01",386,0)
 ;
"RTN","BSDX01",387,0)
HOLDRAEX(BSDXY,RADFN,RAOIFN) ; Hold a Radiology Exam; RPC EP; UJO/SMH new in v 1.6
"RTN","BSDX01",388,0)
 ; RPC: BSDX HOLD RAD EXAM; Return: Single Value
"RTN","BSDX01",389,0)
 ;
"RTN","BSDX01",390,0)
 ; Input:
"RTN","BSDX01",391,0)
 ; - RADFN -> DFN
"RTN","BSDX01",392,0)
 ; - RAOIFN -> Radiology Order IEN in file 75.1
"RTN","BSDX01",393,0)
 ; Output: 1 OR 0 for success or failure.
"RTN","BSDX01",394,0)
 ; Can we hold?
"RTN","BSDX01",395,0)
 N CANHOLD
"RTN","BSDX01",396,0)
 D CANHOLD(.CANHOLD,RAOIFN)
"RTN","BSDX01",397,0)
 I 'CANHOLD S BSDXY=0 QUIT
"RTN","BSDX01",398,0)
 ;
"RTN","BSDX01",399,0)
 N RAOSTS S RAOSTS=3  ; Status of Hold
"RTN","BSDX01",400,0)
 N RAOREA ; Reason, stored in file 75.2
"RTN","BSDX01",401,0)
 I $D(^RA(75.2,100)) S RAOREA=100  ; Custom site Reason
"RTN","BSDX01",402,0)
 E  I $D(^RA(75.2,20))  S RAOREA=20 ; Reason: Exam Cancelled
"RTN","BSDX01",403,0)
 E   ; Else is empty. I won't set RAOREA at all.
"RTN","BSDX01",404,0)
 D ^RAORDU
"RTN","BSDX01",405,0)
 S BSDXY=1 ; Success
"RTN","BSDX01",406,0)
 QUIT
"RTN","BSDX01",407,0)
 ;
"RTN","BSDX01",408,0)
CANHOLD(BSDXY,RAOIFN) ; Can we hold this Exam? RPC EP; UJO/SMH new in 1.6
"RTN","BSDX01",409,0)
 ; RPC: BSDX CAN HOLD RAD EXAM; Return: Single Value
"RTN","BSDX01",410,0)
 ;
"RTN","BSDX01",411,0)
 ; Input:
"RTN","BSDX01",412,0)
 ; - RAOIFN -> Radiology Order IEN in file 75.1
"RTN","BSDX01",413,0)
 ; Output: 0 or 1 for false or true
"RTN","BSDX01",414,0)
 ;
"RTN","BSDX01",415,0)
 N STATUS S STATUS=$$GET1^DIQ(75.1,RAOIFN,"REQUEST STATUS","I")
"RTN","BSDX01",416,0)
 ; 1 = discontinued; 2 = Complete; 6 = Active
"RTN","BSDX01",417,0)
 ; if any one of these, cannot hold exam; otherwise, we can
"RTN","BSDX01",418,0)
 I 126[STATUS S BSDXY=0 QUIT
"RTN","BSDX01",419,0)
 ELSE  S BSDXY=1 QUIT
"RTN","BSDX01",420,0)
 QUIT
"RTN","BSDX02")
0^2^B19587814
"RTN","BSDX02",1,0)
BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 11:09am
"RTN","BSDX02",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX02",3,0)
 ;Licensed under LGPL 
"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)
 ; March 21 2011: UJO/SMH (v 1.5) - Return new fields: Patient SEX, PID, and DOB
"RTN","BSDX02",7,0)
 ; April 11 2011: UJO/SMH (v 1.6) - Added Radiology Exam Field, to retrieve Radiology Exam associated with appt
"RTN","BSDX02",8,0)
 ;
"RTN","BSDX02",9,0)
 ;
"RTN","BSDX02",10,0)
CRSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND) ;EP
"RTN","BSDX02",11,0)
 ;Entry point for debugging
"RTN","BSDX02",12,0)
 ;
"RTN","BSDX02",13,0)
 ;D DEBUG^%Serenji("CRSCH^BSDX02(.BSDXY,BSDXRES,BSDXSTART,BSDXEND)")
"RTN","BSDX02",14,0)
 Q
"RTN","BSDX02",15,0)
 ;
"RTN","BSDX02",16,0)
CRSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXWKIN)     ;
"RTN","BSDX02",17,0)
 ;Called by BSDX CREATE APPT SCHEDULE
"RTN","BSDX02",18,0)
 ;Create Resource Appointment Schedule recordset
"RTN","BSDX02",19,0)
 ;On error, returns 0 in APPOINTMENTID field and error text in NOTE field
"RTN","BSDX02",20,0)
 ;
"RTN","BSDX02",21,0)
 ;$O Thru ^BSDXAPPT("ARSRC", RESOURCE, STARTTIME, APPTID)
"RTN","BSDX02",22,0)
 ;BMXRES is a | delimited list of resource names
"RTN","BSDX02",23,0)
 ;BSDXWKIN - If 1, then return walkins, otherwise skip them
"RTN","BSDX02",24,0)
 ;9-27-2004 Added walkin to returned datatable
"RTN","BSDX02",25,0)
 ;TODO: Change BSDXRES from names to IDs
"RTN","BSDX02",26,0)
 ;
"RTN","BSDX02",27,0)
 N BSDXERR,BSDXIEN,BSDXDEPD,BSDXDEPN,BSDXRESD,BSDXI,BSDXJ,BSDXRESN,BSDXS,BSDXAD,BSDXZ,BSDXQ,BSDXNOD
"RTN","BSDX02",28,0)
 N BSDXPAT,BSDXNOT,BSDXZPCD,BSDXPCD
"RTN","BSDX02",29,0)
 K ^BSDXTMP($J)
"RTN","BSDX02",30,0)
 S BSDXERR=""
"RTN","BSDX02",31,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX02",32,0)
 S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME"
"RTN","BSDX02",33,0)
 S ^(0)=^(0)_"^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE^T00006SEX^T00040PID^D00030DOB^I00020RADIOLOGY_EXAM"_$C(30)
"RTN","BSDX02",34,0)
 D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP")
"RTN","BSDX02",35,0)
 ;
"RTN","BSDX02",36,0)
 ; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
"RTN","BSDX02",37,0)
 ; I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q
"RTN","BSDX02",38,0)
 ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
"RTN","BSDX02",39,0)
 ; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
"RTN","BSDX02",40,0)
 ;
"RTN","BSDX02",41,0)
 S BSDXI=0
"RTN","BSDX02",42,0)
 D STRES
"RTN","BSDX02",43,0)
 ;
"RTN","BSDX02",44,0)
 S BSDXI=BSDXI+1
"RTN","BSDX02",45,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX02",46,0)
 Q
"RTN","BSDX02",47,0)
 ;
"RTN","BSDX02",48,0)
STRES ;
"RTN","BSDX02",49,0)
 F BSDXJ=1:1:$L(BSDXRES,"|") S BSDXRESN=$P(BSDXRES,"|",BSDXJ) D
"RTN","BSDX02",50,0)
 . Q:BSDXRESN=""
"RTN","BSDX02",51,0)
 . Q:'$D(^BSDXRES("B",BSDXRESN))
"RTN","BSDX02",52,0)
 . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
"RTN","BSDX02",53,0)
 . Q:'+BSDXRESD
"RTN","BSDX02",54,0)
 . Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD))
"RTN","BSDX02",55,0)
 . S BSDXS=BSDXSTART-.0001
"RTN","BSDX02",56,0)
 . F  S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS  Q:BSDXS>BSDXEND  D
"RTN","BSDX02",57,0)
 . . S BSDXAD=0 F  S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD  D STCOMM(BSDXAD,BSDXRESN)
"RTN","BSDX02",58,0)
 Q
"RTN","BSDX02",59,0)
 ;
"RTN","BSDX02",60,0)
STCOMM(BSDXAD,BSDXRESN)      ;
"RTN","BSDX02",61,0)
 ;BSDXAD is the appointment IEN
"RTN","BSDX02",62,0)
 N BSDXC,BSDXQ,BSDXZ,BSDXSUBC,BSDXHRN,BSDXPATD,BSDXATID,BSDXISWK
"RTN","BSDX02",63,0)
 Q:'$D(^BSDXAPPT(BSDXAD,0))
"RTN","BSDX02",64,0)
 S BSDXNOD=^BSDXAPPT(BSDXAD,0)
"RTN","BSDX02",65,0)
 Q:$P(BSDXNOD,U,12)]""  ;CANCELLED
"RTN","BSDX02",66,0)
 S BSDXISWK=0
"RTN","BSDX02",67,0)
 S:$P(BSDXNOD,U,13)="y" BSDXISWK=1
"RTN","BSDX02",68,0)
 I +$G(BSDXWKIN) Q:BSDXISWK  ;Don't return walkins if appt is WALKIN and BSDXWKIN is 1
"RTN","BSDX02",69,0)
 S BSDXZ=BSDXAD_"^"
"RTN","BSDX02",70,0)
 F BSDXQ=1:1:4 D
"RTN","BSDX02",71,0)
 . S Y=$P(BSDXNOD,U,BSDXQ)
"RTN","BSDX02",72,0)
 . X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX02",73,0)
 . S BSDXZ=BSDXZ_Y_"^"
"RTN","BSDX02",74,0)
 S BSDXPATD=$P(BSDXNOD,U,5)
"RTN","BSDX02",75,0)
 S BSDXZ=BSDXZ_BSDXPATD_"^" ;PATIENT ID
"RTN","BSDX02",76,0)
 S BSDXPAT=""
"RTN","BSDX02",77,0)
 I BSDXPATD]"",$D(^DPT(BSDXPATD,0)) S BSDXPAT=$P(^DPT(BSDXPATD,0),U)
"RTN","BSDX02",78,0)
 S BSDXZ=BSDXZ_BSDXPAT_"^" ;PATIENT NAME
"RTN","BSDX02",79,0)
 S BSDXZ=BSDXZ_BSDXRESN_"^" ;RESOURCENAME
"RTN","BSDX02",80,0)
 S BSDXZ=BSDXZ_+$P(BSDXNOD,U,10)_"^" ;NOSHOW
"RTN","BSDX02",81,0)
 S BSDXHRN=""
"RTN","BSDX02",82,0)
 I $D(DUZ(2)),DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPATD,41,DUZ(2),0)),U,2) ;HRN
"RTN","BSDX02",83,0)
 S BSDXZ=BSDXZ_BSDXHRN_"^"
"RTN","BSDX02",84,0)
 S BSDXATID=$P(BSDXNOD,U,6)
"RTN","BSDX02",85,0)
 S:'+BSDXATID BSDXATID=0 ;UNKNOWN TYPE
"RTN","BSDX02",86,0)
 S BSDXZ=BSDXZ_BSDXATID_"^"_BSDXISWK_"^"
"RTN","BSDX02",87,0)
 S BSDXI=BSDXI+1
"RTN","BSDX02",88,0)
 S ^BSDXTMP($J,BSDXI)=BSDXZ
"RTN","BSDX02",89,0)
 ;NOTE
"RTN","BSDX02",90,0)
 S BSDXNOT="",BSDXQ=0 F  S BSDXQ=$O(^BSDXAPPT(BSDXAD,1,BSDXQ)) Q:'+BSDXQ  D
"RTN","BSDX02",91,0)
 . S BSDXNOT=$G(^BSDXAPPT(BSDXAD,1,BSDXQ,0))
"RTN","BSDX02",92,0)
 . S:$E(BSDXNOT,$L(BSDXNOT)-1,$L(BSDXNOT))'=" " BSDXNOT=BSDXNOT_" "
"RTN","BSDX02",93,0)
 . S BSDXI=BSDXI+1
"RTN","BSDX02",94,0)
 . S ^BSDXTMP($J,BSDXI)=BSDXNOT
"RTN","BSDX02",95,0)
 S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_U ; Add "^" to separate note from next fields.
"RTN","BSDX02",96,0)
 S BSDXI=BSDXI+1
"RTN","BSDX02",97,0)
 ; new code for V1.5. Extra fields to return.
"RTN","BSDX02",98,0)
 N SEX S SEX=$$GET1^DIQ(2,BSDXPATD,.02)  ; SEX
"RTN","BSDX02",99,0)
 N PID S PID=$$GET1^DIQ(2,BSDXPATD,.363) ; PRIMARY LONG ID
"RTN","BSDX02",100,0)
 ; Note strange way I retrieve the value. B/c DOB Output Transform
"RTN","BSDX02",101,0)
 ; Outputs it in MM/DD/YYYY format, which is ambigous for C#.
"RTN","BSDX02",102,0)
 N DOB S DOB=$$FMTE^XLFDT($$GET1^DIQ(2,BSDXPATD,.03,"I"))  ; DOB
"RTN","BSDX02",103,0)
 N RADEX S RADEX=$P(BSDXNOD,U,14) ;Radiology exam
"RTN","BSDX02",104,0)
 S ^BSDXTMP($J,BSDXI)=SEX_U_PID_U_DOB_U_RADEX_$C(30)
"RTN","BSDX02",105,0)
 ; end new code
"RTN","BSDX02",106,0)
 Q
"RTN","BSDX02",107,0)
 ;
"RTN","BSDX02",108,0)
ERR(BSDXI,BSDXERR) ;Error processing
"RTN","BSDX02",109,0)
 S BSDXI=BSDXI+1
"RTN","BSDX02",110,0)
 S ^BSDXTMP($J,BSDXI)="0^^^^^^^^^^^"_BSDXERR_$C(30)
"RTN","BSDX02",111,0)
 S BSDXI=BSDXI+1
"RTN","BSDX02",112,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX02",113,0)
 Q
"RTN","BSDX02",114,0)
 ;
"RTN","BSDX02",115,0)
ETRAP ;EP Error trap entry
"RTN","BSDX02",116,0)
 D ^%ZTER
"RTN","BSDX02",117,0)
 I '$D(BSDXI) N BSDXI S BSDXI=999999
"RTN","BSDX02",118,0)
 S BSDXI=BSDXI+1
"RTN","BSDX02",119,0)
 D ERR(BSDXI,"BSDX31 Error: "_$G(%ZTERROR))
"RTN","BSDX02",120,0)
 Q
"RTN","BSDX03")
0^3^B2916424
"RTN","BSDX03",1,0)
BSDX03 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:14am
"RTN","BSDX03",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX03",3,0)
 ;Licensed under LGPL
"RTN","BSDX03",4,0)
 ;
"RTN","BSDX03",5,0)
 ;
"RTN","BSDX03",6,0)
 Q
"RTN","BSDX03",7,0)
 ;
"RTN","BSDX03",8,0)
XR2S(BSDXDA) ;EP
"RTN","BSDX03",9,0)
 ;XR2 is the ARSRC xref for the
"RTN","BSDX03",10,0)
 ;RESOURCE field of the BSDX APPOINTMENT file
"RTN","BSDX03",11,0)
 ;Format is ^BSDXAPPT("ARSRC",RESOURCEID,STARTTIME,APPTID)
"RTN","BSDX03",12,0)
 Q:'$D(^BSDXAPPT(BSDXDA,0))
"RTN","BSDX03",13,0)
 N BSDXNOD,BSDXAPPID,BSDXRSID,BSDXS
"RTN","BSDX03",14,0)
 S BSDXNOD=^BSDXAPPT(BSDXDA,0)
"RTN","BSDX03",15,0)
 S BSDXAPPID=BSDXDA
"RTN","BSDX03",16,0)
 S BSDXRSID=$P(BSDXNOD,U,7)
"RTN","BSDX03",17,0)
 Q:'+BSDXAPPID>0
"RTN","BSDX03",18,0)
 Q:'+BSDXRSID>0
"RTN","BSDX03",19,0)
 S BSDXS=$P(BSDXNOD,U)
"RTN","BSDX03",20,0)
 Q:'+BSDXS
"RTN","BSDX03",21,0)
 S ^BSDXAPPT("ARSRC",BSDXRSID,BSDXS,BSDXAPPID)=""
"RTN","BSDX03",22,0)
 Q
"RTN","BSDX03",23,0)
 ;
"RTN","BSDX03",24,0)
XR2K(BSDXA) ;EP
"RTN","BSDX03",25,0)
 Q:'$D(^BSDXAPPT(BSDXA,0))
"RTN","BSDX03",26,0)
 N BSDXNOD,BSDXAPPID,BSDXRSID,BSDXS
"RTN","BSDX03",27,0)
 S BSDXNOD=^BSDXAPPT(BSDXA,0)
"RTN","BSDX03",28,0)
 S BSDXAPPID=BSDXA
"RTN","BSDX03",29,0)
 S BSDXRSID=$P(BSDXNOD,U,7)
"RTN","BSDX03",30,0)
 S BSDXS=$P(BSDXNOD,U)
"RTN","BSDX03",31,0)
 Q:'+BSDXAPPID>0
"RTN","BSDX03",32,0)
 Q:'+BSDXRSID>0
"RTN","BSDX03",33,0)
 Q:'+BSDXS>0
"RTN","BSDX03",34,0)
 K ^BSDXAPPT("ARSRC",BSDXRSID,BSDXS,BSDXAPPID)
"RTN","BSDX03",35,0)
 Q
"RTN","BSDX03",36,0)
XR4S(BSDXDA) ;EP
"RTN","BSDX03",37,0)
 ;XR4 is the ARSCT xref for the
"RTN","BSDX03",38,0)
 ;STARTTIME field of the BSDX ACCESS BLOCK file
"RTN","BSDX03",39,0)
 ;Format is ^BSDXAB("ARSCT",RESOURCEID,STARTTIME,DA)
"RTN","BSDX03",40,0)
 Q:'$D(^BSDXAB(BSDXDA,0))
"RTN","BSDX03",41,0)
 N BSDXNOD,BSDXR,BSDXS
"RTN","BSDX03",42,0)
 S BSDXNOD=^BSDXAB(BSDXDA,0)
"RTN","BSDX03",43,0)
 S BSDXR=$P(BSDXNOD,U)
"RTN","BSDX03",44,0)
 S BSDXS=$P(BSDXNOD,U,2)
"RTN","BSDX03",45,0)
 Q:'+BSDXR>0
"RTN","BSDX03",46,0)
 Q:'+BSDXS>0
"RTN","BSDX03",47,0)
 S ^BSDXAB("ARSCT",BSDXR,BSDXS,BSDXDA)=""
"RTN","BSDX03",48,0)
 Q
"RTN","BSDX03",49,0)
 ;
"RTN","BSDX03",50,0)
XR4K(BSDXDA) ;EP
"RTN","BSDX03",51,0)
 Q:'$D(^BSDXAB(BSDXDA,0))
"RTN","BSDX03",52,0)
 N BSDXNOD,BSDXR,BSDXS
"RTN","BSDX03",53,0)
 S BSDXNOD=^BSDXAB(BSDXDA,0)
"RTN","BSDX03",54,0)
 S BSDXR=$P(BSDXNOD,U)
"RTN","BSDX03",55,0)
 S BSDXS=$P(BSDXNOD,U,2)
"RTN","BSDX03",56,0)
 Q:'+BSDXR>0
"RTN","BSDX03",57,0)
 Q:'+BSDXS>0
"RTN","BSDX03",58,0)
 K ^BSDXAB("ARSCT",BSDXR,BSDXS,BSDXDA)
"RTN","BSDX03",59,0)
 Q
"RTN","BSDX04")
0^4^B24529408
"RTN","BSDX04",1,0)
BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 7/6/12 10:55am
"RTN","BSDX04",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX04",3,0)
 ; Licensed under LGPL
"RTN","BSDX04",4,0)
 ; Change Log:
"RTN","BSDX04",5,0)
 ; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates
"RTN","BSDX04",6,0)
 ;       for i18n
"RTN","BSDX04",7,0)
 ; Feb 27 2010 (v. 1.5) SMH
"RTN","BSDX04",8,0)
 ; - Grab multiple resources instead of a single resource. 
"RTN","BSDX04",9,0)
 ;   --> Will be passed from C# as | delimited.
"RTN","BSDX04",10,0)
 ; - Change in algorithm. Padding part to pad start and end dates to coincide
"RTN","BSDX04",11,0)
 ;   --> with schedule now not performed. C# won't need that anymore.
"RTN","BSDX04",12,0)
 ;
"RTN","BSDX04",13,0)
 ;
"RTN","BSDX04",14,0)
CASSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP
"RTN","BSDX04",15,0)
 ;
"RTN","BSDX04",16,0)
 ;D DEBUG^%Serenji("CASSCH^BSDX04(.BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH)")
"RTN","BSDX04",17,0)
 ;
"RTN","BSDX04",18,0)
 Q
"RTN","BSDX04",19,0)
 ;
"RTN","BSDX04",20,0)
CASSET ;EP
"RTN","BSDX04",21,0)
 ;Error Trap
"RTN","BSDX04",22,0)
 D ^%ZTER
"RTN","BSDX04",23,0)
 I '$D(BSDXI) N BSDXI S BSDXI=99999
"RTN","BSDX04",24,0)
 S BSDXI=BSDXI+1
"RTN","BSDX04",25,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX04",26,0)
 Q
"RTN","BSDX04",27,0)
 ;
"RTN","BSDX04",28,0)
CASSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP  -- RPC: BSDX CREATE ASGND SLOT SCHED
"RTN","BSDX04",29,0)
 ;Create Assigned Slot Schedule recordset (Access Blocks, Availabilities, etc.)
"RTN","BSDX04",30,0)
 ;This call is used both to create a schedule of availability for the calendar display
"RTN","BSDX04",31,0)
 ;and to search for availability in the Find Appointment function
"RTN","BSDX04",32,0)
 ;
"RTN","BSDX04",33,0)
 ;BSDXRES is resources name, delimited by |
"RTN","BSDX04",34,0)
 ;
"RTN","BSDX04",35,0)
 ; BSDXSTART and BSDXEND both passed in FM Format.
"RTN","BSDX04",36,0)
 ; BSDXSTART is the Date Portion of FM Date
"RTN","BSDX04",37,0)
 ; BSDXEND -- pass date and h,m,s as well
"RTN","BSDX04",38,0)
 ;
"RTN","BSDX04",39,0)
 ;BSDXTYPES is |-delimited list of Access Type Names
"RTN","BSDX04",40,0)
 ;If BSDXTYPES is "" then the screen passes all types.
"RTN","BSDX04",41,0)
 ;
"RTN","BSDX04",42,0)
 ;BSDXSRCH is |-delimited search info for the Find Appointment function
"RTN","BSDX04",43,0)
 ;First piece is 1 if we are in a Find Appointment call
"RTN","BSDX04",44,0)
 ;Second piece is weekday info in the format MTWHFSU
"RTN","BSDX04",45,0)
 ;Third piece is AM PM info in the form AP
"RTN","BSDX04",46,0)
 ;If 2nd or 3rd pieces are null, the screen for that piece is skipped
"RTN","BSDX04",47,0)
 ;
"RTN","BSDX04",48,0)
 ;Test lines:
"RTN","BSDX04",49,0)
 ;D CASSCH^BSDX04(.RES,"REMILLARD,MIKE","<fmdate>","<fmdate>") ZW RES
"RTN","BSDX04",50,0)
 ;BSDX CREATE ASGND SLOT SCHED^ROGERS,BUCK^<fmdate>^<fmdate>^2
"RTN","BSDX04",51,0)
 ;S ^HW("BSDX04")=BSDXRES_U_BSDXSTART_U_BSDXEND
"RTN","BSDX04",52,0)
 ;
"RTN","BSDX04",53,0)
 N BSDXERR,BSDXIEN,BSDXDEP,BSDXTYPED,BSDXTYPE,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXZ,BSDXTMP,BSDXQ,BSDXNOT,BSDXNOD,BSDXAD
"RTN","BSDX04",54,0)
 N BSDXSUBCD
"RTN","BSDX04",55,0)
 S X="CASSET^BSDX04",@^%ZOSF("TRAP")
"RTN","BSDX04",56,0)
 K ^BSDXTMP($J)
"RTN","BSDX04",57,0)
 S BSDXERR=""
"RTN","BSDX04",58,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX04",59,0)
 S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME^I00010SLOTS^T00030RESOURCE^T00010ACCESS_TYPE^T00250NOTE^I00030AVAILABILITYID"_$C(30)
"RTN","BSDX04",60,0)
 S BSDXI=2
"RTN","BSDX04",61,0)
 ;
"RTN","BSDX04",62,0)
 ;Get Access Type IDs
"RTN","BSDX04",63,0)
 N BSDXK,BSDXTYPED,BSDXL
"RTN","BSDX04",64,0)
 I '+BSDXSRCH S BSDXTYPED=""
"RTN","BSDX04",65,0)
 I +BSDXSRCH F BSDXK=1:1:$L(BSDXTYPES,"|") D
"RTN","BSDX04",66,0)
 . S BSDXL=$P(BSDXTYPES,"|",BSDXK)
"RTN","BSDX04",67,0)
 . I BSDXL="" S $P(BSDXTYPED,"|",BSDXK)=0 Q
"RTN","BSDX04",68,0)
 . I '$D(^BSDXTYPE("B",BSDXL)) S $P(BSDXTYPED,"|",BSDXK)=0 Q
"RTN","BSDX04",69,0)
 . S $P(BSDXTYPED,"|",BSDXK)=$O(^BSDXTYPE("B",BSDXL,0))
"RTN","BSDX04",70,0)
 ;
"RTN","BSDX04",71,0)
 N BSDXCOUN ; Counter
"RTN","BSDX04",72,0)
 FOR BSDXCOUN=1:1:$L(BSDXRES,"|") DO  ;smh - d in algo to do multiple res
"RTN","BSDX04",73,0)
 . S BSDXRESN=$P(BSDXRES,"|",BSDXCOUN)
"RTN","BSDX04",74,0)
 . Q:BSDXRESN=""
"RTN","BSDX04",75,0)
 . Q:'$D(^BSDXRES("B",BSDXRESN))
"RTN","BSDX04",76,0)
 . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
"RTN","BSDX04",77,0)
 . Q:'+BSDXRESD
"RTN","BSDX04",78,0)
 . Q:'$D(^BSDXAB("ARSCT",BSDXRESD))
"RTN","BSDX04",79,0)
 . S BSDXBS=0
"RTN","BSDX04",80,0)
 . D STRES(BSDXRESN,BSDXRESD)
"RTN","BSDX04",81,0)
 . Q
"RTN","BSDX04",82,0)
 ;
"RTN","BSDX04",83,0)
 ; V 1.5 -- All of this commented out; algo changed on C# side.
"RTN","BSDX04",84,0)
 ;start, end, slots, resource, accesstype, note, availabilityid
"RTN","BSDX04",85,0)
 ;I '+BSDXSRCH,BSDXALO D
"RTN","BSDX04",86,0)
 ; I BSDXALO D
"RTN","BSDX04",87,0)
 ; . ;If first block start time > input start time then pad with new block
"RTN","BSDX04",88,0)
 ; . I BSDXBS>BSDXSTART K BSDXTMP D
"RTN","BSDX04",89,0)
 ; . . S Y=BSDXSTART X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX04",90,0)
 ; . . S BSDXTMP=Y
"RTN","BSDX04",91,0)
 ; . . S Y=BSDXBS X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX04",92,0)
 ; . . S BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$C(30)
"RTN","BSDX04",93,0)
 ; . . S ^BSDXTMP($J,1)=BSDXTMP
"RTN","BSDX04",94,0)
 ; . ;
"RTN","BSDX04",95,0)
 ; . ;If first block start time < input start time then trim
"RTN","BSDX04",96,0)
 ; . I BSDXBS<BSDXSTART D
"RTN","BSDX04",97,0)
 ; . . S Y=BSDXSTART
"RTN","BSDX04",98,0)
 ; . . X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX04",99,0)
 ; . . S $P(^BSDXTMP($J,2),U,1)=Y
"RTN","BSDX04",100,0)
 ; . ;
"RTN","BSDX04",101,0)
 ; . ;If last block end time < input end time then pad end with new block
"RTN","BSDX04",102,0)
 ; . I BSDXPEND<BSDXEND D
"RTN","BSDX04",103,0)
 ; . . S Y=BSDXPEND X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX04",104,0)
 ; . . S BSDXTMP=Y
"RTN","BSDX04",105,0)
 ; . . S Y=BSDXEND X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX04",106,0)
 ; . . S BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$C(30)
"RTN","BSDX04",107,0)
 ; . . S ^BSDXTMP($J,BSDXI-1)=BSDXTMP
"RTN","BSDX04",108,0)
 ; . ;
"RTN","BSDX04",109,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX04",110,0)
 Q
"RTN","BSDX04",111,0)
 ;
"RTN","BSDX04",112,0)
STRES(BSDXRESN,BSDXRESD) ;
"RTN","BSDX04",113,0)
 ;BSDXRESD is a Resource ID
"RTN","BSDX04",114,0)
 ;$O THRU "ARSCT" XREF OF ^BSDXAB
"RTN","BSDX04",115,0)
 S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
"RTN","BSDX04",116,0)
 S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
"RTN","BSDX04",117,0)
 F  S BSDXS=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS)) Q:'+BSDXS  Q:BSDXS>BSDXEND  D
"RTN","BSDX04",118,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",119,0)
 . Q
"RTN","BSDX04",120,0)
 Q
"RTN","BSDX04",121,0)
 ;
"RTN","BSDX04",122,0)
STCOMM(BSDXRESN,BSDXRESD,BSDXS,BSDXAD) ;
"RTN","BSDX04",123,0)
 N BSDXNSTART,BSDXNEND,BSDXNOD,Y,BSDXQ,BSDXZ,BSDXATID,BSDXATOK
"RTN","BSDX04",124,0)
 Q:'$D(^BSDXAB(BSDXAD,0))
"RTN","BSDX04",125,0)
 S BSDXNOD=^BSDXAB(BSDXAD,0)
"RTN","BSDX04",126,0)
 S BSDXATID=$P(BSDXNOD,U,5)
"RTN","BSDX04",127,0)
 ;
"RTN","BSDX04",128,0)
 ;Screen for Access Type
"RTN","BSDX04",129,0)
 ;S BSDXATOK=0
"RTN","BSDX04",130,0)
 ;I BSDXTYPED="" S BSDXATOK=1
"RTN","BSDX04",131,0)
 ;E  D
"RTN","BSDX04",132,0)
 ;. F J=1:1:$L(BSDXTYPED,"|") I BSDXATID=$P(BSDXTYPED,"|",J) S BSDXATOK=1 Q
"RTN","BSDX04",133,0)
 ;Q:'BSDXATOK
"RTN","BSDX04",134,0)
 ;
"RTN","BSDX04",135,0)
 ;I +BSDXSRCH
"RTN","BSDX04",136,0)
 ;Screen for Weekday
"RTN","BSDX04",137,0)
 ;
"RTN","BSDX04",138,0)
 ;Screen for AM PM
"RTN","BSDX04",139,0)
 ;
"RTN","BSDX04",140,0)
 S BSDXZ=""
"RTN","BSDX04",141,0)
 S BSDXNSTART=$P(BSDXNOD,U,2)
"RTN","BSDX04",142,0)
 S BSDXNEND=$P(BSDXNOD,U,3)
"RTN","BSDX04",143,0)
 I BSDXNEND'>BSDXSTART Q  ;End is less than start
"RTN","BSDX04",144,0)
 I +BSDXBS=0 S BSDXBS=$P(BSDXNOD,U,2) ;First block start time
"RTN","BSDX04",145,0)
 F BSDXQ=2:1:3 D  ;Start and End times
"RTN","BSDX04",146,0)
 . S Y=$P(BSDXNOD,U,BSDXQ)
"RTN","BSDX04",147,0)
 . X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX04",148,0)
 . S BSDXZ=BSDXZ_Y_"^"
"RTN","BSDX04",149,0)
 S BSDXZ=BSDXZ_$P(BSDXNOD,U,4)_"^" ;SLOTS
"RTN","BSDX04",150,0)
 S BSDXZ=BSDXZ_BSDXRESN_"^" ;Resource name
"RTN","BSDX04",151,0)
 S BSDXZ=BSDXZ_BSDXATID_"^" ;Access type ID
"RTN","BSDX04",152,0)
 S BSDXNOT="",BSDXQ=0 F  S BSDXQ=$O(^BSDXAB(BSDXAD,1,BSDXQ)) Q:'+BSDXQ  D
"RTN","BSDX04",153,0)
 . S BSDXNOT=BSDXNOT_$G(^BSDXAB(BSDXAD,1,BSDXQ,0))_" "
"RTN","BSDX04",154,0)
 S BSDXZ=BSDXZ_BSDXNOT ;_"^"
"RTN","BSDX04",155,0)
 ;I '+BSDXSRCH,BSDXPEND,BSDXNSTART>BSDXPEND D  ;Fill in gap between appointment
"RTN","BSDX04",156,0)
 I BSDXPEND,BSDXNSTART>BSDXPEND D  ;Fill in gap between appointment
"RTN","BSDX04",157,0)
 . S Y=BSDXPEND X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX04",158,0)
 . S BSDXTMP=Y
"RTN","BSDX04",159,0)
 . S Y=BSDXNSTART X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX04",160,0)
 . S BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$C(30)
"RTN","BSDX04",161,0)
 . S ^BSDXTMP($J,BSDXI-1)=BSDXTMP
"RTN","BSDX04",162,0)
 S BSDXPEND=BSDXNEND
"RTN","BSDX04",163,0)
 S ^BSDXTMP($J,BSDXI)=BSDXZ_"^"_BSDXAD_$C(30)
"RTN","BSDX04",164,0)
 S BSDXI=BSDXI+2
"RTN","BSDX04",165,0)
 Q
"RTN","BSDX05")
0^5^B11080417
"RTN","BSDX05",1,0)
BSDX05  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
"RTN","BSDX05",2,0)
    ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX05",3,0)
    ; Licensed under LGPL
"RTN","BSDX05",4,0)
    ;
"RTN","BSDX05",5,0)
    ; Change Log:
"RTN","BSDX05",6,0)
    ; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates
"RTN","BSDX05",7,0)
    ; UJO/SMH - Dec 8 2010: In STCOMM, the logic was that an appointment 
"RTN","BSDX05",8,0)
    ;  that was a walk-in didn't count towards slot calculations.
"RTN","BSDX05",9,0)
    ;  I checked PIMS, and Walk-ins do indeed count towards slot calculations.
"RTN","BSDX05",10,0)
    ;  Therefore, I commented this line out:
"RTN","BSDX05",11,0)
    ;    ;Q:$P(BSDXNOD,U,13)="y"  ;WALKIN
"RTN","BSDX05",12,0)
    ;
"RTN","BSDX05",13,0)
APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES)     ;EP
"RTN","BSDX05",14,0)
    ;Called by BSDX APPT BLOCKS OVERLAP
"RTN","BSDX05",15,0)
       ; July 11 2010 - pass FM Dates for Start and End rather than US Dates
"RTN","BSDX05",16,0)
    ;(Duplicates old qryAppointmentBlocksOverlapB)
"RTN","BSDX05",17,0)
    ;BSDXRES is resource name
"RTN","BSDX05",18,0)
    ;
"RTN","BSDX05",19,0)
    ;Test lines:
"RTN","BSDX05",20,0)
    ;D APBLKOV^BSDX05(.RES,"11-8-2000","11-8-2004","WHITT") ZW RES
"RTN","BSDX05",21,0)
    ;BSDX APPT BLOCKS OVERLAP^11-8-2000^11-8-2004^WHITT
"RTN","BSDX05",22,0)
    ;S ^HW("BSDXD05")=BSDXSTART_U_BSDXEND_U_BSDXRES
"RTN","BSDX05",23,0)
    ;
"RTN","BSDX05",24,0)
    N BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXAD,BSDXNOD
"RTN","BSDX05",25,0)
    K ^BSDXTMP($J)
"RTN","BSDX05",26,0)
    S BSDXERR=""
"RTN","BSDX05",27,0)
    S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX05",28,0)
    S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME"_$C(30)
"RTN","BSDX05",29,0)
    D
"RTN","BSDX05",30,0)
    . S BSDXBS=0
"RTN","BSDX05",31,0)
    . S BSDXEND=BSDXEND+.9999 ;Go to end of day
"RTN","BSDX05",32,0)
    . S BSDXRESN=BSDXRES
"RTN","BSDX05",33,0)
    . Q:BSDXRESN=""
"RTN","BSDX05",34,0)
    . Q:'$D(^BSDXRES("B",BSDXRESN))
"RTN","BSDX05",35,0)
    . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
"RTN","BSDX05",36,0)
    . Q:'+BSDXRESD
"RTN","BSDX05",37,0)
    . Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD))
"RTN","BSDX05",38,0)
    . D STRES(BSDXRESD,BSDXSTART,BSDXEND)
"RTN","BSDX05",39,0)
    . Q
"RTN","BSDX05",40,0)
    ;
"RTN","BSDX05",41,0)
    S BSDXI=$G(BSDXI)+1
"RTN","BSDX05",42,0)
    S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX05",43,0)
    Q
"RTN","BSDX05",44,0)
    ;
"RTN","BSDX05",45,0)
STRES(BSDXRESD,BSDXSTART,BSDXEND)   ;
"RTN","BSDX05",46,0)
    ;$O THRU "ARSRC" XREF OF ^BSDXAPPT
"RTN","BSDX05",47,0)
    ;Start at the beginning of the day -- appts can't overlap days
"RTN","BSDX05",48,0)
    S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
"RTN","BSDX05",49,0)
    S BSDXI=0
"RTN","BSDX05",50,0)
    F  S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS  Q:BSDXS>BSDXEND  D
"RTN","BSDX05",51,0)
    . S BSDXAD=0 F  S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD  D STCOMM(BSDXAD) ;BSDXAD Is the AppointmentID
"RTN","BSDX05",52,0)
    . Q
"RTN","BSDX05",53,0)
    Q
"RTN","BSDX05",54,0)
    ;
"RTN","BSDX05",55,0)
STCOMM(BSDXAD)  ;
"RTN","BSDX05",56,0)
    S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
"RTN","BSDX05",57,0)
    Q:'$D(^BSDXAPPT(BSDXAD,0))
"RTN","BSDX05",58,0)
    S BSDXNOD=^BSDXAPPT(BSDXAD,0)
"RTN","BSDX05",59,0)
    Q:$P(BSDXNOD,U,10)=1  ;NO-SHOW Flag
"RTN","BSDX05",60,0)
    Q:$P(BSDXNOD,U,12)]""  ;CANCELLED APPT
"RTN","BSDX05",61,0)
    ; Q:$P(BSDXNOD,U,13)="y"  ;WALKIN -- new in V 1.42. See top comments.
"RTN","BSDX05",62,0)
    S BSDXNSTART=$P(BSDXNOD,U)
"RTN","BSDX05",63,0)
    S BSDXNEND=$P(BSDXNOD,U,2)
"RTN","BSDX05",64,0)
    I BSDXNEND'>BSDXSTART Q  ;End is less than start
"RTN","BSDX05",65,0)
    S Y=BSDXNSTART X ^DD("DD") S BSDXNSTART=$TR(Y,"@"," ")
"RTN","BSDX05",66,0)
    S Y=BSDXNEND X ^DD("DD") S BSDXNEND=$TR(Y,"@"," ")
"RTN","BSDX05",67,0)
    S BSDXI=BSDXI+1
"RTN","BSDX05",68,0)
    S ^BSDXTMP($J,BSDXI)=BSDXNSTART_U_BSDXNEND_$C(30)
"RTN","BSDX05",69,0)
    Q
"RTN","BSDX06")
0^6^B6651946
"RTN","BSDX06",1,0)
BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
"RTN","BSDX06",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX06",3,0)
 ; Licensed under LGPL
"RTN","BSDX06",4,0)
 ; Change Log:
"RTN","BSDX06",5,0)
 ; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get
"RTN","BSDX06",6,0)
 ; dates in FM format for i18n
"RTN","BSDX06",7,0)
 ;
"RTN","BSDX06",8,0)
 ;
"RTN","BSDX06",9,0)
TPBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES)  ;EP
"RTN","BSDX06",10,0)
 ;Called by BSDXD TYPE BLOCKS OVERLAP
"RTN","BSDX06",11,0)
 ;(Duplicates old qryTypeBlocksOverlapB)
"RTN","BSDX06",12,0)
 ;BSDXRES is resource name
"RTN","BSDX06",13,0)
 ;
"RTN","BSDX06",14,0)
 ;Test lines:
"RTN","BSDX06",15,0)
 ;D TPBLKOV^BSDX06(.RES,"3030513","3030516","REMILLARD,MIKE") ZW RES
"RTN","BSDX06",16,0)
 ;BSDX TYPE BLOCKS OVERLAP^303513^3030516^REMILLARD,MIKE
"RTN","BSDX06",17,0)
 ;S ^HW("BSDXD06")=BSDXSTART_U_BSDXEND_U_BSDXRES
"RTN","BSDX06",18,0)
 ;
"RTN","BSDX06",19,0)
 N BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXTPID,BSDXNOD,BSDXAD
"RTN","BSDX06",20,0)
 K ^BSDXTMP($J)
"RTN","BSDX06",21,0)
 S BSDXERR=""
"RTN","BSDX06",22,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX06",23,0)
 S ^BSDXTMP($J,0)="D00030StartTime^D00030EndTime^I00010AppointmentTypeID^I00010AvailabilityID^T00030ResourceName"_$C(30)
"RTN","BSDX06",24,0)
 S BSDXI=0
"RTN","BSDX06",25,0)
 D
"RTN","BSDX06",26,0)
 . S BSDXBS=0
"RTN","BSDX06",27,0)
 . I $L(BSDXEND,".")=1 S BSDXEND=BSDXEND+.9999 ;Go to end of day if only date (not time) is passed
"RTN","BSDX06",28,0)
 . S BSDXRESN=BSDXRES
"RTN","BSDX06",29,0)
 . Q:BSDXRESN=""
"RTN","BSDX06",30,0)
 . Q:'$D(^BSDXRES("B",BSDXRESN))
"RTN","BSDX06",31,0)
 . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
"RTN","BSDX06",32,0)
 . Q:'+BSDXRESD
"RTN","BSDX06",33,0)
 . D STCOMM(BSDXRESN,BSDXRESD)
"RTN","BSDX06",34,0)
 . Q
"RTN","BSDX06",35,0)
 ;
"RTN","BSDX06",36,0)
 S BSDXI=$G(BSDXI)+1
"RTN","BSDX06",37,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX06",38,0)
 Q
"RTN","BSDX06",39,0)
 ;
"RTN","BSDX06",40,0)
STCOMM(BSDXRESN,BSDXRESD) ;EP
"RTN","BSDX06",41,0)
 ;
"RTN","BSDX06",42,0)
 Q:'$D(^BSDXAB("ARSCT",BSDXRESD))
"RTN","BSDX06",43,0)
 Q:'$D(^BSDXRES(BSDXRESD,0))
"RTN","BSDX06",44,0)
 ;$O THRU "ARSCT" XREF OF ^BSDXAB
"RTN","BSDX06",45,0)
 S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
"RTN","BSDX06",46,0)
 ;Start at the beginning of the day -- AV Blocks can't overlap days
"RTN","BSDX06",47,0)
 S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
"RTN","BSDX06",48,0)
 F  S BSDXS=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS)) Q:'+BSDXS  Q:BSDXS>BSDXEND  D
"RTN","BSDX06",49,0)
 . S BSDXAD=0 F  S BSDXAD=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD  D
"RTN","BSDX06",50,0)
 . . Q:'$D(^BSDXAB(BSDXAD,0))
"RTN","BSDX06",51,0)
 . . S BSDXNOD=^BSDXAB(BSDXAD,0)
"RTN","BSDX06",52,0)
 . . S BSDXNSTART=$P(BSDXNOD,U,2)
"RTN","BSDX06",53,0)
 . . S BSDXNEND=$P(BSDXNOD,U,3)
"RTN","BSDX06",54,0)
 . . I BSDXNEND'>BSDXSTART Q
"RTN","BSDX06",55,0)
 . . S Y=BSDXNSTART X ^DD("DD") S BSDXNSTART=$TR(Y,"@"," ")
"RTN","BSDX06",56,0)
 . . S Y=BSDXNEND X ^DD("DD") S BSDXNEND=$TR(Y,"@"," ")
"RTN","BSDX06",57,0)
 . . S BSDXTPID=$P(BSDXNOD,U,5)
"RTN","BSDX06",58,0)
 . . S BSDXI=BSDXI+1
"RTN","BSDX06",59,0)
 . . S ^BSDXTMP($J,BSDXI)=BSDXNSTART_U_BSDXNEND_U_BSDXTPID_U_BSDXAD_U_BSDXRESN_$C(30)
"RTN","BSDX06",60,0)
 . . Q
"RTN","BSDX06",61,0)
 . Q
"RTN","BSDX06",62,0)
 Q
"RTN","BSDX07")
0^7^B81183501
"RTN","BSDX07",1,0)
BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS  ; 7/9/12 4:02pm
"RTN","BSDX07",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX07",3,0)
 ; Licensed under LGPL
"RTN","BSDX07",4,0)
 ;
"RTN","BSDX07",5,0)
 ; Change Log:
"RTN","BSDX07",6,0)
 ; UJO/SMH
"RTN","BSDX07",7,0)
 ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
"RTN","BSDX07",8,0)
 ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments
"RTN","BSDX07",9,0)
 ; v1.42 Oct 30 2010 - Extensive refactoring.
"RTN","BSDX07",10,0)
 ; v1.5  Mar 15 2011 - End time does not have to have time anymore.
"RTN","BSDX07",11,0)
 ;      It could be midnight of the next day
"RTN","BSDX07",12,0)
 ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams...
"RTN","BSDX07",13,0)
 ; v1.7 Jun 20 2012 - Refactoring to remove transactions - many changes
"RTN","BSDX07",14,0)
 ;                  - AVUPDT moved to AVUPDTMK in BSDXAPI1
"RTN","BSDX07",15,0)
 ;
"RTN","BSDX07",16,0)
 ; Error Reference:
"RTN","BSDX07",17,0)
 ; -1: Patient Record is locked. This means something is wrong!!!!
"RTN","BSDX07",18,0)
 ; -2: Start Time is not a valid Fileman date
"RTN","BSDX07",19,0)
 ; -3: End Time is not a valid Fileman date
"RTN","BSDX07",20,0)
 ; v1.5:obsolete::-4: End Time does not have time inside of it.
"RTN","BSDX07",21,0)
 ; -5: BSDXPATID is not numeric
"RTN","BSDX07",22,0)
 ; -6: Patient Does not exist in ^DPT
"RTN","BSDX07",23,0)
 ; -7: Resource Name does not exist in B index of BSDX RESOURCE
"RTN","BSDX07",24,0)
 ; -8: Resouce doesn't exist in ^BSDXRES
"RTN","BSDX07",25,0)
 ; -9: Couldn't add appointment to BSDX APPOINTMENT
"RTN","BSDX07",26,0)
 ; -10: Couldn't add appointment to files 2 and/or 44
"RTN","BSDX07",27,0)
 ; -100: Mumps Error
"RTN","BSDX07",28,0)
 ;
"RTN","BSDX07",29,0)
APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)    ;EP
"RTN","BSDX07",30,0)
 ;Entry point for debugging
"RTN","BSDX07",31,0)
 ; D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
"RTN","BSDX07",32,0)
 Q
"RTN","BSDX07",33,0)
 ;
"RTN","BSDX07",34,0)
APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;Private EP
"RTN","BSDX07",35,0)
 ;
"RTN","BSDX07",36,0)
 ;Called by RPC: BSDX ADD NEW APPOINTMENT
"RTN","BSDX07",37,0)
 ;
"RTN","BSDX07",38,0)
 ;Add new appointment to 3 files
"RTN","BSDX07",39,0)
 ; - BSDX APPOINTMENT
"RTN","BSDX07",40,0)
 ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic
"RTN","BSDX07",41,0)
 ; - Patient Appointment Subfile if Resource is linked to clinic
"RTN","BSDX07",42,0)
 ;
"RTN","BSDX07",43,0)
 ;Paramters:
"RTN","BSDX07",44,0)
 ;BSDXY: Global Return (RPC must be set to Global Array)
"RTN","BSDX07",45,0)
 ;BSDXSTART: FM Start Date
"RTN","BSDX07",46,0)
 ;BSDXEND: FM End Date
"RTN","BSDX07",47,0)
 ;BSDXPATID: Patient DFN
"RTN","BSDX07",48,0)
 ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN)
"RTN","BSDX07",49,0)
 ;BSDXLEN is the appointment duration in minutes
"RTN","BSDX07",50,0)
 ;BSDXNOTE is the Appiontment Note
"RTN","BSDX07",51,0)
 ;BSDXATID is used for 2 purposes:
"RTN","BSDX07",52,0)
 ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
"RTN","BSDX07",53,0)
 ; if BSDXATID = a number, then it is the access type id (used for rebooking)
"RTN","BSDX07",54,0)
 ;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional)
"RTN","BSDX07",55,0)
 ;
"RTN","BSDX07",56,0)
 ;Return:
"RTN","BSDX07",57,0)
 ; ADO.net Recordset having fields:
"RTN","BSDX07",58,0)
 ; AppointmentID and ErrorNumber
"RTN","BSDX07",59,0)
 ;
"RTN","BSDX07",60,0)
 ; TODO: Specifying BSDXLEN and BSDXEND is redundant. For future programmers
"RTN","BSDX07",61,0)
 ; to sort out. Needs changes on client.
"RTN","BSDX07",62,0)
 ;
"RTN","BSDX07",63,0)
 ;Test lines:
"RTN","BSDX07",64,0)
 ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
"RTN","BSDX07",65,0)
 ;
"RTN","BSDX07",66,0)
 ; Deal with optional arguments
"RTN","BSDX07",67,0)
 S BSDXRADEXAM=$G(BSDXRADEXAM)
"RTN","BSDX07",68,0)
 ;
"RTN","BSDX07",69,0)
 ; Return Array; set Return and clear array
"RTN","BSDX07",70,0)
 S BSDXY=$NA(^BSDXTMP($J))
"RTN","BSDX07",71,0)
 K ^BSDXTMP($J)
"RTN","BSDX07",72,0)
 ;
"RTN","BSDX07",73,0)
 ; $ET
"RTN","BSDX07",74,0)
 N $ET S $ET="G ETRAP^BSDX07"
"RTN","BSDX07",75,0)
 ;
"RTN","BSDX07",76,0)
 ; Counter
"RTN","BSDX07",77,0)
 N BSDXI S BSDXI=0
"RTN","BSDX07",78,0)
 ;
"RTN","BSDX07",79,0)
 ; Lock BSDX node, only to synchronize access to the globals.
"RTN","BSDX07",80,0)
 ; It's not expected that the error will ever happen as no filing
"RTN","BSDX07",81,0)
 ; is supposed to take 5 seconds.
"RTN","BSDX07",82,0)
 L +^BSDXPAT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
"RTN","BSDX07",83,0)
 ;
"RTN","BSDX07",84,0)
 ; Header Node
"RTN","BSDX07",85,0)
 S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30)
"RTN","BSDX07",86,0)
 ;
"RTN","BSDX07",87,0)
 ; Turn off SDAM APPT PROTOCOL BSDX Entries
"RTN","BSDX07",88,0)
 N BSDXNOEV
"RTN","BSDX07",89,0)
 S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
"RTN","BSDX07",90,0)
 ;
"RTN","BSDX07",91,0)
 ; Set Error Message to be empty
"RTN","BSDX07",92,0)
 N BSDXERR S BSDXERR=0
"RTN","BSDX07",93,0)
 ;
"RTN","BSDX07",94,0)
 ;;;test for error. See if %ZTER works
"RTN","BSDX07",95,0)
 I $G(BSDXDIE) N X S X=1/0
"RTN","BSDX07",96,0)
 ;;;test
"RTN","BSDX07",97,0)
 ;
"RTN","BSDX07",98,0)
 ; -- Start and End Date Processing --
"RTN","BSDX07",99,0)
 ; If C# sends the dates with extra zeros, remove them
"RTN","BSDX07",100,0)
 S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
"RTN","BSDX07",101,0)
 ; Are the dates valid? Must be FM Dates > than 2010
"RTN","BSDX07",102,0)
 I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q
"RTN","BSDX07",103,0)
 I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q
"RTN","BSDX07",104,0)
 ;
"RTN","BSDX07",105,0)
 ;; If Ending date doesn't have a time, this is an error --rm 1.5
"RTN","BSDX07",106,0)
 ; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q
"RTN","BSDX07",107,0)
 ;
"RTN","BSDX07",108,0)
 ; If the Start Date is greater than the end date, swap dates
"RTN","BSDX07",109,0)
 N BSDXTMP
"RTN","BSDX07",110,0)
 I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
"RTN","BSDX07",111,0)
 ;
"RTN","BSDX07",112,0)
 ; Check if the patient exists:
"RTN","BSDX07",113,0)
 ; - DFN valid number?
"RTN","BSDX07",114,0)
 ; - Valid Patient in file 2?
"RTN","BSDX07",115,0)
 I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q 
"RTN","BSDX07",116,0)
 I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q
"RTN","BSDX07",117,0)
 ;
"RTN","BSDX07",118,0)
 ;Validate Resource entry
"RTN","BSDX07",119,0)
 I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q
"RTN","BSDX07",120,0)
 N BSDXRESD ; Resource IEN
"RTN","BSDX07",121,0)
 S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
"RTN","BSDX07",122,0)
 N BSDXRNOD ; Resouce zero node
"RTN","BSDX07",123,0)
 S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
"RTN","BSDX07",124,0)
 I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q
"RTN","BSDX07",125,0)
 ;
"RTN","BSDX07",126,0)
 ; Walk-in (Unscheduled) Appointment?
"RTN","BSDX07",127,0)
 N BSDXWKIN S BSDXWKIN=0
"RTN","BSDX07",128,0)
 I BSDXATID="WALKIN" S BSDXWKIN=1
"RTN","BSDX07",129,0)
 ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number
"RTN","BSDX07",130,0)
 I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID=""
"RTN","BSDX07",131,0)
 ;
"RTN","BSDX07",132,0)
 ; Now, check if PIMS has any issues with us making the appt using MAKECK
"RTN","BSDX07",133,0)
 N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4)  ; Hosp Location IEN
"RTN","BSDX07",134,0)
 N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK
"RTN","BSDX07",135,0)
 N BSDXC ; Array to send to MAKE and MAKECK APIs
"RTN","BSDX07",136,0)
 ; Only if we have a valid Hosp Location
"RTN","BSDX07",137,0)
 I +BSDXSCD,$D(^SC(BSDXSCD,0)) D 
"RTN","BSDX07",138,0)
 . S BSDXC("PAT")=BSDXPATID
"RTN","BSDX07",139,0)
 . S BSDXC("CLN")=BSDXSCD
"RTN","BSDX07",140,0)
 . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins
"RTN","BSDX07",141,0)
 . S:BSDXWKIN BSDXC("TYP")=4
"RTN","BSDX07",142,0)
 . S BSDXC("ADT")=BSDXSTART
"RTN","BSDX07",143,0)
 . S BSDXC("LEN")=BSDXLEN
"RTN","BSDX07",144,0)
 . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field
"RTN","BSDX07",145,0)
 . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI
"RTN","BSDX07",146,0)
 . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note
"RTN","BSDX07",147,0)
 . S BSDXC("USR")=DUZ
"RTN","BSDX07",148,0)
 . S BSDXERR=$$MAKECK^BSDXAPI(.BSDXC)
"RTN","BSDX07",149,0)
 I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKECK^BSDXAPI returned error code: "_BSDXERR) Q  ; no need for roll back
"RTN","BSDX07",150,0)
 ;
"RTN","BSDX07",151,0)
 ; Done with all checks, let's make appointment in BSDX APPOINTMENT
"RTN","BSDX07",152,0)
 N BSDXAPPTID
"RTN","BSDX07",153,0)
 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)
"RTN","BSDX07",154,0)
 I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q  ; no roll back needed! No appts made.
"RTN","BSDX07",155,0)
 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) ; no error checks are made here
"RTN","BSDX07",156,0)
 ; I don't think it's important b/c users can detect right away if the WP
"RTN","BSDX07",157,0)
 ; filing fails.
"RTN","BSDX07",158,0)
 ;
"RTN","BSDX07",159,0)
 I $G(BSDXSIMERR1) D ERR(BSDXI,"-11~BSDX07 Error: Simulated Error"),ROLLBACK(BSDXAPPTID,.BSDXC) Q  ; UT Line
"RTN","BSDX07",160,0)
 ;
"RTN","BSDX07",161,0)
 ; Only if we have a valid Hosp Loc can we make an appointment in 2/44
"RTN","BSDX07",162,0)
 ; Use BSDXC array from before.
"RTN","BSDX07",163,0)
 ; FYI: $$MAKE itself calls $$MAKECK to check again for being okay.
"RTN","BSDX07",164,0)
 ; If an error happens here, we roll back both ^BSDXAPPT and 2/44 by deleting
"RTN","BSDX07",165,0)
 N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK
"RTN","BSDX07",166,0)
 I +BSDXSCD,$D(^SC(BSDXSCD,0)) S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
"RTN","BSDX07",167,0)
 I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q
"RTN","BSDX07",168,0)
 ;
"RTN","BSDX07",169,0)
 ; Unlock
"RTN","BSDX07",170,0)
 L -^BSDXPAT(BSDXPATID)
"RTN","BSDX07",171,0)
 ;
"RTN","BSDX07",172,0)
 ;Return Recordset
"RTN","BSDX07",173,0)
 S BSDXI=BSDXI+1
"RTN","BSDX07",174,0)
 S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
"RTN","BSDX07",175,0)
 S BSDXI=BSDXI+1
"RTN","BSDX07",176,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX07",177,0)
 Q
"RTN","BSDX07",178,0)
STRIP(BSDXZ)    ;Replace control characters with spaces
"RTN","BSDX07",179,0)
 N BSDXI
"RTN","BSDX07",180,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",181,0)
 Q BSDXZ
"RTN","BSDX07",182,0)
 ;
"RTN","BSDX07",183,0)
BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)  ;ADD BSDX APPOINTMENT ENTRY
"RTN","BSDX07",184,0)
 ;Returns ien in BSDXAPPT or 0 if failed
"RTN","BSDX07",185,0)
 ;Create entry in BSDX APPOINTMENT
"RTN","BSDX07",186,0)
 N BSDXAPPTID,BSDXFDA
"RTN","BSDX07",187,0)
 S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
"RTN","BSDX07",188,0)
 S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
"RTN","BSDX07",189,0)
 S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
"RTN","BSDX07",190,0)
 S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
"RTN","BSDX07",191,0)
 S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
"RTN","BSDX07",192,0)
 S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
"RTN","BSDX07",193,0)
 S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
"RTN","BSDX07",194,0)
 S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
"RTN","BSDX07",195,0)
 S BSDXFDA(9002018.4,"+1,",.14)=$G(BSDXRADEXAM)
"RTN","BSDX07",196,0)
 N BSDXIEN,BSDXMSG
"RTN","BSDX07",197,0)
 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX07",198,0)
 S BSDXAPPTID=+$G(BSDXIEN(1))
"RTN","BSDX07",199,0)
 Q BSDXAPPTID
"RTN","BSDX07",200,0)
 ;
"RTN","BSDX07",201,0)
BSDXWP(BSDXAPPTID,BSDXNOTE) ;
"RTN","BSDX07",202,0)
 ;Add WP field
"RTN","BSDX07",203,0)
 N BSDXMSG
"RTN","BSDX07",204,0)
 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
"RTN","BSDX07",205,0)
 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
"RTN","BSDX07",206,0)
 I $D(BSDXNOTE(.5)) D
"RTN","BSDX07",207,0)
 . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG")
"RTN","BSDX07",208,0)
 Q
"RTN","BSDX07",209,0)
 ;
"RTN","BSDX07",210,0)
ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP
"RTN","BSDX07",211,0)
 ;Called by BSDX ADD APPOINTMENT protocol
"RTN","BSDX07",212,0)
 ;BSDXSC=IEN of clinic in ^SC
"RTN","BSDX07",213,0)
 ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
"RTN","BSDX07",214,0)
 ;
"RTN","BSDX07",215,0)
 N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES,BSDXNOTE,BSDXEND
"RTN","BSDX07",216,0)
 Q:+$G(BSDXNOEV)
"RTN","BSDX07",217,0)
 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
"RTN","BSDX07",218,0)
 E  I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0))
"RTN","BSDX07",219,0)
 Q:'+$G(BSDXRES)
"RTN","BSDX07",220,0)
 S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0))
"RTN","BSDX07",221,0)
 Q:BSDXNOD=""
"RTN","BSDX07",222,0)
 S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0))
"RTN","BSDX07",223,0)
 S BSDXWKIN=""
"RTN","BSDX07",224,0)
 S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile
"RTN","BSDX07",225,0)
 S BSDXLEN=$P(BSDXNOD,U,2)
"RTN","BSDX07",226,0)
 Q:'+BSDXLEN
"RTN","BSDX07",227,0)
 S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0)
"RTN","BSDX07",228,0)
 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN)
"RTN","BSDX07",229,0)
 Q:'+BSDXAPPTID
"RTN","BSDX07",230,0)
 S BSDXNOTE=$P(BSDXNOD,U,4)
"RTN","BSDX07",231,0)
 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
"RTN","BSDX07",232,0)
 D ADDEVT3(BSDXRES)
"RTN","BSDX07",233,0)
 Q
"RTN","BSDX07",234,0)
 ;
"RTN","BSDX07",235,0)
ADDEVT3(BSDXRES)    ;
"RTN","BSDX07",236,0)
 ;Call RaiseEvent to notify GUI clients
"RTN","BSDX07",237,0)
 N BSDXRESN
"RTN","BSDX07",238,0)
 S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
"RTN","BSDX07",239,0)
 Q:BSDXRESN=""
"RTN","BSDX07",240,0)
 S BSDXRESN=$P(BSDXRESN,"^")
"RTN","BSDX07",241,0)
 ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
"RTN","BSDX07",242,0)
 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
"RTN","BSDX07",243,0)
 Q
"RTN","BSDX07",244,0)
 ;
"RTN","BSDX07",245,0)
ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set
"RTN","BSDX07",246,0)
 ; DO NOT USE except as an emergency measure - only if unforseen error occurs
"RTN","BSDX07",247,0)
 ; Input: 
"RTN","BSDX07",248,0)
 ; Appointment ID to remove from ^BSDXAPPT
"RTN","BSDX07",249,0)
 ; BSDXC array (see array format in $$MAKE^BSDXAPI)
"RTN","BSDX07",250,0)
 N %
"RTN","BSDX07",251,0)
 D BSDXDEL^BSDX07(BSDXAPPTID)
"RTN","BSDX07",252,0)
 S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0
"RTN","BSDX07",253,0)
 QUIT
"RTN","BSDX07",254,0)
 ;
"RTN","BSDX07",255,0)
BSDXDEL(BSDXAPPTID) ;Private EP ; Deletes appointment BSDXAPPTID from ^BSDXAPPT
"RTN","BSDX07",256,0)
 ; DO NOT USE except in emergencies to roll back an appointment set
"RTN","BSDX07",257,0)
 N DA,DIK
"RTN","BSDX07",258,0)
 S DIK="^BSDXAPPT(",DA=BSDXAPPTID
"RTN","BSDX07",259,0)
 D ^DIK
"RTN","BSDX07",260,0)
 Q
"RTN","BSDX07",261,0)
 ;
"RTN","BSDX07",262,0)
ERR(BSDXI,BSDXERR)  ;Error processing - different from error trap.
"RTN","BSDX07",263,0)
 ; Unlock first
"RTN","BSDX07",264,0)
 L -^BSDXPAT(BSDXPATID)
"RTN","BSDX07",265,0)
 ; If last line is $C(31), we are done. No more errors to send to client.
"RTN","BSDX07",266,0)
 I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
"RTN","BSDX07",267,0)
 S BSDXI=BSDXI+1
"RTN","BSDX07",268,0)
 S BSDXERR=$TR(BSDXERR,"^","~")
"RTN","BSDX07",269,0)
 S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
"RTN","BSDX07",270,0)
 S BSDXI=BSDXI+1
"RTN","BSDX07",271,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX07",272,0)
 Q
"RTN","BSDX07",273,0)
 ;
"RTN","BSDX07",274,0)
ETRAP   ;EP Error trap entry
"RTN","BSDX07",275,0)
 N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
"RTN","BSDX07",276,0)
 D ^%ZTER
"RTN","BSDX07",277,0)
 ;
"RTN","BSDX07",278,0)
 I +$G(BSDXAPPTID) D ROLLBACK(BSDXAPPTID,.BSDXC) ; Rollback if BSDXAPPTID exists
"RTN","BSDX07",279,0)
 ;
"RTN","BSDX07",280,0)
 ; Log error message and send to client
"RTN","BSDX07",281,0)
 I '$D(BSDXI) N BSDXI S BSDXI=0
"RTN","BSDX07",282,0)
 D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
"RTN","BSDX07",283,0)
 Q:$Q 1_U_"Mumps Error" Q
"RTN","BSDX07",284,0)
 ;
"RTN","BSDX08")
0^8^B46874843
"RTN","BSDX08",1,0)
BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:22pm
"RTN","BSDX08",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"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 work. As of v 1.7, all work here has been superceded
"RTN","BSDX08",9,0)
 ;  - Refactoring of AVUPDT - never tested though.
"RTN","BSDX08",10,0)
 ;  - Refactored all of APPDEL.
"RTN","BSDX08",11,0)
 ; 
"RTN","BSDX08",12,0)
 ; 3111125 UJO/SMH v1.5
"RTN","BSDX08",13,0)
 ;  - Added ability to remove checked in appointments. Added a couple
"RTN","BSDX08",14,0)
 ;    of units tests for that under UT2.
"RTN","BSDX08",15,0)
 ; 
"RTN","BSDX08",16,0)
 ; 3120625 VEN/SMH v1.7
"RTN","BSDX08",17,0)
 ;  - Transactions removed. Code refactored to work w/o txns.
"RTN","BSDX08",18,0)
 ;  - Moved AVUPDT to AVUPDTCN in BSDXAPI1. BSDXAPI takes care of calling
"RTN","BSDX08",19,0)
 ;    that.
"RTN","BSDX08",20,0)
 ; 
"RTN","BSDX08",21,0)
 ; Error Reference:
"RTN","BSDX08",22,0)
 ;  -1~BSDX08: Appt record is locked. Please contact technical support.
"RTN","BSDX08",23,0)
 ;  -2~BSDX08: Invalid Appointment ID
"RTN","BSDX08",24,0)
 ;  -3~BSDX08: Invalid Appointment ID
"RTN","BSDX08",25,0)
 ;  -4~BSDX08: Cancelled appointment does not have a Resouce ID  
"RTN","BSDX08",26,0)
 ;  -5~BSDX08: Resouce ID does not exist in BSDX RESOURCE
"RTN","BSDX08",27,0)
 ;  -6~BSDX08: Invalid Hosp Location stored in Database
"RTN","BSDX08",28,0)
 ;  -7~BSDX08: Patient does not have an appointment in PIMS Clinic
"RTN","BSDX08",29,0)
 ;  -8^BSDX08: Unable to find associated PIMS appointment for this patient
"RTN","BSDX08",30,0)
 ;  -9^BSDX08: BSDXAPI returned an error: (error)
"RTN","BSDX08",31,0)
 ;  -10^BSDX08: $$BSDXCAN failed (Fileman filing error)
"RTN","BSDX08",32,0)
 ;  -100~BSDX08 Error: (Mumps Error)
"RTN","BSDX08",33,0)
 ;
"RTN","BSDX08",34,0)
APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
"RTN","BSDX08",35,0)
 ;Entry point for debugging
"RTN","BSDX08",36,0)
 ;D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)")
"RTN","BSDX08",37,0)
 Q
"RTN","BSDX08",38,0)
 ;
"RTN","BSDX08",39,0)
APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)        ; Private EP
"RTN","BSDX08",40,0)
 ;Called by RPC: BSDX CANCEL APPOINTMENT
"RTN","BSDX08",41,0)
 ;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles
"RTN","BSDX08",42,0)
 ;Input Parameters:
"RTN","BSDX08",43,0)
 ; - BSDXAPTID is entry number in BSDX APPOINTMENT file
"RTN","BSDX08",44,0)
 ; - BSDXTYP is C for clinic-cancelled and PC for patient cancelled
"RTN","BSDX08",45,0)
 ; - BSDXCR is pointer to CANCELLATION REASON File (409.2)
"RTN","BSDX08",46,0)
 ; - BSDXNOT is user note
"RTN","BSDX08",47,0)
 ;
"RTN","BSDX08",48,0)
 ; Returns error code in recordset field ERRORID. Empty string is success.
"RTN","BSDX08",49,0)
 ; Returns Global Array. Must use this type in RPC.
"RTN","BSDX08",50,0)
 ;
"RTN","BSDX08",51,0)
 ; Return Array: set Return and clear array
"RTN","BSDX08",52,0)
 S BSDXY=$NA(^BSDXTMP($J))
"RTN","BSDX08",53,0)
 K ^BSDXTMP($J)
"RTN","BSDX08",54,0)
 ;
"RTN","BSDX08",55,0)
 ; Set min DUZ vars if they don't exist
"RTN","BSDX08",56,0)
 D ^XBKVAR
"RTN","BSDX08",57,0)
 ;
"RTN","BSDX08",58,0)
 ; $ET
"RTN","BSDX08",59,0)
 N $ET S $ET="G ETRAP^BSDX08"
"RTN","BSDX08",60,0)
 ;
"RTN","BSDX08",61,0)
 ; Counter
"RTN","BSDX08",62,0)
 N BSDXI S BSDXI=0
"RTN","BSDX08",63,0)
 ;
"RTN","BSDX08",64,0)
 ; Header Node
"RTN","BSDX08",65,0)
 S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
"RTN","BSDX08",66,0)
 ;
"RTN","BSDX08",67,0)
 ; Turn off SDAM APPT PROTOCOL BSDX Entries
"RTN","BSDX08",68,0)
 N BSDXNOEV
"RTN","BSDX08",69,0)
 S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol
"RTN","BSDX08",70,0)
 ;
"RTN","BSDX08",71,0)
 ;;;test for error inside transaction. See if %ZTER works
"RTN","BSDX08",72,0)
 I $G(BSDXDIE1) N X S X=1/0
"RTN","BSDX08",73,0)
 ;
"RTN","BSDX08",74,0)
 ; Check appointment ID and whether it exists
"RTN","BSDX08",75,0)
 I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q
"RTN","BSDX08",76,0)
 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-3~BSDX08: Invalid Appointment ID") Q
"RTN","BSDX08",77,0)
 ; 
"RTN","BSDX08",78,0)
 ; Lock BSDX node, only to synchronize access to the globals.
"RTN","BSDX08",79,0)
 ; It's not expected that the error will ever happen as no filing
"RTN","BSDX08",80,0)
 ; is supposed to take 5 seconds.
"RTN","BSDX08",81,0)
 L +^BSDXAPPT(BSDXAPTID):5 E  D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q
"RTN","BSDX08",82,0)
 ;
"RTN","BSDX08",83,0)
 ; Start Processing:
"RTN","BSDX08",84,0)
 ; First, get data
"RTN","BSDX08",85,0)
 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; BSDX Appt Node
"RTN","BSDX08",86,0)
 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; Patient ID
"RTN","BSDX08",87,0)
 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Time
"RTN","BSDX08",88,0)
 ;
"RTN","BSDX08",89,0)
 ; Check the resource ID and whether it exists
"RTN","BSDX08",90,0)
 N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
"RTN","BSDX08",91,0)
 ; If the resource id doesn't exist...
"RTN","BSDX08",92,0)
 I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT
"RTN","BSDX08",93,0)
 I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT
"RTN","BSDX08",94,0)
 ;
"RTN","BSDX08",95,0)
 ;
"RTN","BSDX08",96,0)
 ; Check if PIMS will let us cancel the appointment using $$CANCELCK^BSDXAPI
"RTN","BSDX08",97,0)
 ; Get zero node of resouce
"RTN","BSDX08",98,0)
 N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0)
"RTN","BSDX08",99,0)
 ; Get Hosp location
"RTN","BSDX08",100,0)
 N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4)
"RTN","BSDX08",101,0)
 ; Error indicator
"RTN","BSDX08",102,0)
 N BSDXERR S BSDXERR=0
"RTN","BSDX08",103,0)
 ; 
"RTN","BSDX08",104,0)
 N BSDXC ; Array to pass to BSDXAPI
"RTN","BSDX08",105,0)
 ;
"RTN","BSDX08",106,0)
 I BSDXLOC D 
"RTN","BSDX08",107,0)
 . S BSDXC("PAT")=BSDXPATID
"RTN","BSDX08",108,0)
 . S BSDXC("CLN")=BSDXLOC
"RTN","BSDX08",109,0)
 . S BSDXC("TYP")=BSDXTYP
"RTN","BSDX08",110,0)
 . S BSDXC("ADT")=BSDXSTART
"RTN","BSDX08",111,0)
 . S BSDXC("CDT")=$$NOW^XLFDT()
"RTN","BSDX08",112,0)
 . S BSDXC("NOT")=BSDXNOT
"RTN","BSDX08",113,0)
 . S:'+$G(BSDXCR) BSDXCR=11 ;Other
"RTN","BSDX08",114,0)
 . S BSDXC("CR")=BSDXCR
"RTN","BSDX08",115,0)
 . S BSDXC("USR")=DUZ
"RTN","BSDX08",116,0)
 . ;
"RTN","BSDX08",117,0)
 . S BSDXERR=$$CANCELCK^BSDXAPI(.BSDXC) ; 0 or 1^error message
"RTN","BSDX08",118,0)
 ; If error, quit. No need to rollback as no changes took place.
"RTN","BSDX08",119,0)
 I BSDXERR D ERR(BSDXI,"-9~BSDX08: BSDXAPI reports that "_$P(BSDXERR,U,2)) QUIT
"RTN","BSDX08",120,0)
 ;
"RTN","BSDX08",121,0)
 I $G(BSDXDIE2) N X S X=1/0
"RTN","BSDX08",122,0)
 ;
"RTN","BSDX08",123,0)
 ; Now cancel the appointment for real
"RTN","BSDX08",124,0)
 ; BSDXAPPT First; no need for rollback if error occured.
"RTN","BSDX08",125,0)
 N BSDXERR S BSDXERR=$$BSDXCAN(BSDXAPTID)  ; Add a cancellation date in BSDX APPOINTMENT
"RTN","BSDX08",126,0)
 I BSDXERR D ERR(BSDXI,"-10~BSDX08: $$BSDXCAN failed (Fileman filing error): "_$P(BSDXERR,U,2)) QUIT
"RTN","BSDX08",127,0)
 ;
"RTN","BSDX08",128,0)
 ; Then PIMS: 
"RTN","BSDX08",129,0)
 ; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
"RTN","BSDX08",130,0)
 ; If error happens, must rollback ^BSDXAPPT
"RTN","BSDX08",131,0)
 I BSDXLOC S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) ; Cancel through BSDXAPI
"RTN","BSDX08",132,0)
 ; Rollback BSDXAPPT if error occurs
"RTN","BSDX08",133,0)
 I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)),ROLLBACK(BSDXAPTID)  QUIT
"RTN","BSDX08",134,0)
 ;
"RTN","BSDX08",135,0)
 L -^BSDXAPPT(BSDXAPTID)
"RTN","BSDX08",136,0)
 S BSDXI=BSDXI+1
"RTN","BSDX08",137,0)
 S ^BSDXTMP($J,BSDXI)=""_$C(30)
"RTN","BSDX08",138,0)
 S BSDXI=BSDXI+1
"RTN","BSDX08",139,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX08",140,0)
 Q
"RTN","BSDX08",141,0)
 ;
"RTN","BSDX08",142,0)
BSDXCAN(BSDXAPTID) ; $$; Private; Cancel BSDX APPOINTMENT entry
"RTN","BSDX08",143,0)
 ; Input: Appt IEN in ^BSDXAPPT
"RTN","BSDX08",144,0)
 ; Output: 0 for success and 1^Msg for failure
"RTN","BSDX08",145,0)
 N BSDXDATE,BSDXIENS,BSDXFDA,BSDXMSG
"RTN","BSDX08",146,0)
 S BSDXDATE=$$NOW^XLFDT()
"RTN","BSDX08",147,0)
 S BSDXIENS=BSDXAPTID_","
"RTN","BSDX08",148,0)
 S BSDXFDA(9002018.4,BSDXIENS,.12)=BSDXDATE
"RTN","BSDX08",149,0)
 D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX08",150,0)
 I $D(BSDXMSG) Q 1_U_BSDXMSG("DIERR",1,"TEXT",1)
"RTN","BSDX08",151,0)
 QUIT 0
"RTN","BSDX08",152,0)
 ;
"RTN","BSDX08",153,0)
ROLLBACK(BSDXAPTID)  ; Proc; Private; Rollback cancellation
"RTN","BSDX08",154,0)
 ; Input same as $$BSDXCAN
"RTN","BSDX08",155,0)
 N BSDXIENS S BSDXIENS=BSDXAPTID_","
"RTN","BSDX08",156,0)
 N BSDXFDA S BSDXFDA(9002018.4,BSDXIENS,.12)="@"
"RTN","BSDX08",157,0)
 N BSDXMSG
"RTN","BSDX08",158,0)
 D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX08",159,0)
 ;I $D(BSDXMSG)  ; Not sure what to do. We are already handling an error.
"RTN","BSDX08",160,0)
 QUIT
"RTN","BSDX08",161,0)
 ;
"RTN","BSDX08",162,0)
CANEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CANCEL APPOINTMENT event
"RTN","BSDX08",163,0)
 ;when appointments cancelled via PIMS interface.
"RTN","BSDX08",164,0)
 ;Propagates cancellation to BSDXAPPT and raises refresh event to running GUI clients
"RTN","BSDX08",165,0)
 N BSDXFOUND,BSDXRES
"RTN","BSDX08",166,0)
 Q:+$G(BSDXNOEV)
"RTN","BSDX08",167,0)
 Q:'+$G(BSDXSC)
"RTN","BSDX08",168,0)
 S BSDXFOUND=0
"RTN","BSDX08",169,0)
 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$CANEVT1(BSDXRES,BSDXSTART,BSDXPAT)
"RTN","BSDX08",170,0)
 I BSDXFOUND D CANEVT3(BSDXRES) Q
"RTN","BSDX08",171,0)
 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$CANEVT1(BSDXRES,BSDXSTART,BSDXPAT)
"RTN","BSDX08",172,0)
 I BSDXFOUND D CANEVT3(BSDXRES)
"RTN","BSDX08",173,0)
 Q
"RTN","BSDX08",174,0)
 ;
"RTN","BSDX08",175,0)
CANEVT1(BSDXRES,BSDXSTART,BSDXPAT) ;
"RTN","BSDX08",176,0)
 ;Get appointment id in BSDXAPT
"RTN","BSDX08",177,0)
 ;If found, call BSDXCAN(BSDXAPPT) and return 1
"RTN","BSDX08",178,0)
 ;else return 0
"RTN","BSDX08",179,0)
 N BSDXFOUND,BSDXAPPT
"RTN","BSDX08",180,0)
 S BSDXFOUND=0
"RTN","BSDX08",181,0)
 Q:'+BSDXRES BSDXFOUND
"RTN","BSDX08",182,0)
 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
"RTN","BSDX08",183,0)
 S BSDXAPPT=0 F  S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT  D  Q:BSDXFOUND
"RTN","BSDX08",184,0)
 . N BSDXNOD
"RTN","BSDX08",185,0)
 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
"RTN","BSDX08",186,0)
 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
"RTN","BSDX08",187,0)
 I BSDXFOUND,+$G(BSDXAPPT) N % S %=$$BSDXCAN(BSDXAPPT) I % D ^%ZTER
"RTN","BSDX08",188,0)
 Q BSDXFOUND
"RTN","BSDX08",189,0)
 ;
"RTN","BSDX08",190,0)
CANEVT3(BSDXRES) ;
"RTN","BSDX08",191,0)
 ;Call RaiseEvent to notify GUI clients
"RTN","BSDX08",192,0)
 ;
"RTN","BSDX08",193,0)
 N BSDXRESN
"RTN","BSDX08",194,0)
 S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
"RTN","BSDX08",195,0)
 Q:BSDXRESN=""
"RTN","BSDX08",196,0)
 S BSDXRESN=$P(BSDXRESN,"^")
"RTN","BSDX08",197,0)
 ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
"RTN","BSDX08",198,0)
 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
"RTN","BSDX08",199,0)
 Q
"RTN","BSDX08",200,0)
 ;
"RTN","BSDX08",201,0)
ERR(BSDXI,BSDXERR) ;Error processing
"RTN","BSDX08",202,0)
 ; Unlock first
"RTN","BSDX08",203,0)
 L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
"RTN","BSDX08",204,0)
 ; If last line is $C(31), we are done. No more errors to send to client.
"RTN","BSDX08",205,0)
 I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
"RTN","BSDX08",206,0)
 S BSDXI=BSDXI+1
"RTN","BSDX08",207,0)
 S BSDXERR=$TR(BSDXERR,"^","~")
"RTN","BSDX08",208,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
"RTN","BSDX08",209,0)
 S BSDXI=BSDXI+1
"RTN","BSDX08",210,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX08",211,0)
 QUIT
"RTN","BSDX08",212,0)
 ;
"RTN","BSDX08",213,0)
ETRAP ;EP Error trap entry
"RTN","BSDX08",214,0)
 N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
"RTN","BSDX08",215,0)
 D ^%ZTER
"RTN","BSDX08",216,0)
 ;
"RTN","BSDX08",217,0)
 ; Roll back BSDXAPPT; 
"RTN","BSDX08",218,0)
 ; NB: What if a Mumps error happens inside fileman in BSDXAPI? 
"RTN","BSDX08",219,0)
 ; I have decided the M errors are out of scope for me to handle.
"RTN","BSDX08",220,0)
 D:$G(BSDXAPTID) ROLLBACK(BSDXAPTID)
"RTN","BSDX08",221,0)
 ;
"RTN","BSDX08",222,0)
 ; Log error message and send to client
"RTN","BSDX08",223,0)
 I '$D(BSDXI) N BSDXI S BSDXI=0
"RTN","BSDX08",224,0)
 D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE))
"RTN","BSDX08",225,0)
 Q:$Q 1_U_"-100~Mumps Error" Q
"RTN","BSDX08",226,0)
 ;
"RTN","BSDX08",227,0)
 ;;;NB: This is code that is unused in both original and port.
"RTN","BSDX08",228,0)
 ; ; If not appt in the "S" node is found in ^SC then check associated RPMS Clinic Multiple
"RTN","BSDX08",229,0)
 ; I BSDXSCIEN="" D  I 'BSDXZ Q  ;Q:BSDXZ
"RTN","BSDX08",230,0)
 ; . S BSDXERR="BSDX08: Unable to find associated RPMS appointment for this patient. "
"RTN","BSDX08",231,0)
 ; . S BSDXZ=1
"RTN","BSDX08",232,0)
 ; . ; Check if there are associated RPMS clinics. (not currently used) Does the multiple exist? No, then quit
"RTN","BSDX08",233,0)
 ; . I '$D(^BSDXRES(BSDXSC1,20)) S BSDXZ=0 QUIT
"RTN","BSDX08",234,0)
 ; . ; Loop through the multiple. Get Location and then the ^SC "S" node IEN.
"RTN","BSDX08",235,0)
 ; . N BSDX1 S BSDX1=0
"RTN","BSDX08",236,0)
 ; . F  S BSDX1=$O(^BSDXRES(BSDXSC1,20,BSDX1)) Q:'+BSDX1  Q:BSDXZ=0  D
"RTN","BSDX08",237,0)
 ; . . Q:'$D(^BSDXRES(BSDXSC1,20,BSDX1,0))
"RTN","BSDX08",238,0)
 ; . . S BSDXLOC=$P(^BSDXRES(BSDXSC1,20,BSDX1,0),U)
"RTN","BSDX08",239,0)
 ; . . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) I +BSDXSCIEN S BSDXZ=0 Q
"RTN","BSDX09")
0^9^B35856892
"RTN","BSDX09",1,0)
BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 6/21/12 11:03am
"RTN","BSDX09",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX09",3,0)
 ; Licensed under LGPL
"RTN","BSDX09",4,0)
 ;
"RTN","BSDX09",5,0)
 ; Change Log:
"RTN","BSDX09",6,0)
 ; UJO/TH - v 1.3 on 3100714 - Extra Demographics:
"RTN","BSDX09",7,0)
 ; - Email
"RTN","BSDX09",8,0)
 ; - Cell Phone
"RTN","BSDX09",9,0)
 ; - Country
"RTN","BSDX09",10,0)
 ; - + refactoring of routine
"RTN","BSDX09",11,0)
 ; 
"RTN","BSDX09",12,0)
 ; UJO/TH - v 1.3 on 3100715 - Change SSN to PID and get PID field instead
"RTN","BSDX09",13,0)
 ;
"RTN","BSDX09",14,0)
    ; UJO/TH - v 1.42 on 3101020 - Add Sex field.
"RTN","BSDX09",15,0)
 ;
"RTN","BSDX09",16,0)
GETREGA(BSDXRET,BSDXPAT)        ;EP
"RTN","BSDX09",17,0)
 ;
"RTN","BSDX09",18,0)
 ; See below for the returned fields
"RTN","BSDX09",19,0)
 ;
"RTN","BSDX09",20,0)
 ;For patient with ien BSDXPAT
"RTN","BSDX09",21,0)
 ;K ^BSDXTMP($J)
"RTN","BSDX09",22,0)
 S BSDXERR=""
"RTN","BSDX09",23,0)
 S BSDXRET="^BSDXTMP("_$J_")"
"RTN","BSDX09",24,0)
 ;
"RTN","BSDX09",25,0)
 N OUT S OUT=$NA(^BSDXTMP($J,0))
"RTN","BSDX09",26,0)
 S $P(@OUT,U,1)="T00030IEN"
"RTN","BSDX09",27,0)
 S $P(@OUT,U,2)="T00030STREET"
"RTN","BSDX09",28,0)
 S $P(@OUT,U,3)="T00030CITY"
"RTN","BSDX09",29,0)
 S $P(@OUT,U,4)="T00030STATE"
"RTN","BSDX09",30,0)
 S $P(@OUT,U,5)="T00030ZIP"
"RTN","BSDX09",31,0)
 S $P(@OUT,U,6)="T00030NAME"
"RTN","BSDX09",32,0)
 S $P(@OUT,U,7)="D00030DOB"
"RTN","BSDX09",33,0)
 S $P(@OUT,U,8)="T00030PID"
"RTN","BSDX09",34,0)
 S $P(@OUT,U,9)="T00030HRN"
"RTN","BSDX09",35,0)
 S $P(@OUT,U,10)="T00030HOMEPHONE"
"RTN","BSDX09",36,0)
 S $P(@OUT,U,11)="T00030OFCPHONE"
"RTN","BSDX09",37,0)
 S $P(@OUT,U,12)="T00030MSGPHONE"
"RTN","BSDX09",38,0)
 S $P(@OUT,U,13)="T00030NOK NAME"
"RTN","BSDX09",39,0)
 S $P(@OUT,U,14)="T00030RELATIONSHIP"
"RTN","BSDX09",40,0)
 S $P(@OUT,U,15)="T00030PHONE"
"RTN","BSDX09",41,0)
 S $P(@OUT,U,16)="T00030STREET"
"RTN","BSDX09",42,0)
 S $P(@OUT,U,17)="T00030CITY"
"RTN","BSDX09",43,0)
 S $P(@OUT,U,18)="T00030STATE"
"RTN","BSDX09",44,0)
 S $P(@OUT,U,19)="T00030ZIP"
"RTN","BSDX09",45,0)
 S $P(@OUT,U,20)="D00030DATAREVIEWED"
"RTN","BSDX09",46,0)
 S $P(@OUT,U,21)="T00030RegistrationComments"
"RTN","BSDX09",47,0)
 S $P(@OUT,U,22)="T00050EMAIL ADDRESS"
"RTN","BSDX09",48,0)
 S $P(@OUT,U,23)="T00020PHONE NUMBER [CELLULAR]"
"RTN","BSDX09",49,0)
 S $P(@OUT,U,24)="T00030COUNTRY"
"RTN","BSDX09",50,0)
 S $P(@OUT,U,25)="T00030SEX"
"RTN","BSDX09",51,0)
 S $E(@OUT,$L(@OUT)+1)=$C(30)
"RTN","BSDX09",52,0)
 ;
"RTN","BSDX09",53,0)
 ;
"RTN","BSDX09",54,0)
 N BSDXNOD,BSDXNAM,Y,U
"RTN","BSDX09",55,0)
 S U="^"
"RTN","BSDX09",56,0)
 S BSDXY="ERROR"
"RTN","BSDX09",57,0)
 K NAME
"RTN","BSDX09",58,0)
 I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q
"RTN","BSDX09",59,0)
 I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q
"RTN","BSDX09",60,0)
 S BSDXY=""
"RTN","BSDX09",61,0)
 S $P(BSDXY,U)=BSDXPAT
"RTN","BSDX09",62,0)
 ;//smh S $P(BSDXY,U,23)=""
"RTN","BSDX09",63,0)
 S $P(BSDXY,U,21)=""
"RTN","BSDX09",64,0)
 S BSDXNOD=^DPT(+BSDXPAT,0)
"RTN","BSDX09",65,0)
 S $P(BSDXY,"^",6)=$P(BSDXNOD,U) ;NAME
"RTN","BSDX09",66,0)
 S $P(BSDXY,"^",8)=$$GET1^DIQ(2,BSDXPAT,"PRIMARY LONG ID") ;PID
"RTN","BSDX09",67,0)
 S Y=$P(BSDXNOD,U,3) I Y]""  X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX09",68,0)
 S $P(BSDXY,"^",7)=Y ;DOB
"RTN","BSDX09",69,0)
 S $P(BSDXY,"^",9)=""
"RTN","BSDX09",70,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",71,0)
 D MAIL
"RTN","BSDX09",72,0)
 D PHONE
"RTN","BSDX09",73,0)
 D NOK
"RTN","BSDX09",74,0)
 D DATAREV
"RTN","BSDX09",75,0)
 ;/smh D MEDICARE
"RTN","BSDX09",76,0)
 D REGCMT
"RTN","BSDX09",77,0)
 S $P(BSDXY,"^",22)=$$GET1^DIQ(2,BSDXPAT,"EMAIL ADDRESS")
"RTN","BSDX09",78,0)
 S $P(BSDXY,"^",23)=$$GET1^DIQ(2,BSDXPAT,"PHONE NUMBER [CELLULAR]")
"RTN","BSDX09",79,0)
 S $P(BSDXY,"^",24)=$$GET1^DIQ(2,BSDXPAT,"COUNTRY:DESCRIPTION")
"RTN","BSDX09",80,0)
 S $P(BSDXY,"^",25)=$$GET1^DIQ(2,BSDXPAT,"SEX")
"RTN","BSDX09",81,0)
 N BSDXBEG,BSDXEND,BSDXLEN,BSDXI
"RTN","BSDX09",82,0)
 S BSDXLEN=$L(BSDXY)
"RTN","BSDX09",83,0)
 S BSDXBEG=0,BSDXI=2
"RTN","BSDX09",84,0)
 F  D  Q:BSDXEND=BSDXLEN
"RTN","BSDX09",85,0)
 . S BSDXEND=BSDXBEG+100
"RTN","BSDX09",86,0)
 . S:BSDXEND>BSDXLEN BSDXEND=BSDXLEN
"RTN","BSDX09",87,0)
 . S BSDXI=BSDXI+1
"RTN","BSDX09",88,0)
 . S ^BSDXTMP($J,BSDXI)=$E(BSDXY,BSDXBEG,BSDXEND)
"RTN","BSDX09",89,0)
 . S BSDXBEG=BSDXBEG+101
"RTN","BSDX09",90,0)
 S ^BSDXTMP($J,BSDXI+1)=$C(30)_$C(31)
"RTN","BSDX09",91,0)
 Q
"RTN","BSDX09",92,0)
 ;
"RTN","BSDX09",93,0)
MAIL N BSDXST
"RTN","BSDX09",94,0)
 Q:'$D(^DPT(+BSDXPAT,.11))
"RTN","BSDX09",95,0)
 S BSDXNOD=^DPT(+BSDXPAT,.11)
"RTN","BSDX09",96,0)
 Q:BSDXNOD=""
"RTN","BSDX09",97,0)
 S $P(BSDXY,"^",2)=$E($P(BSDXNOD,U),1,50) ;STREET
"RTN","BSDX09",98,0)
 S $P(BSDXY,"^",3)=$P(BSDXNOD,U,4) ;CITY
"RTN","BSDX09",99,0)
 S BSDXST=$P(BSDXNOD,U,5)
"RTN","BSDX09",100,0)
 I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2)
"RTN","BSDX09",101,0)
 S $P(BSDXY,"^",4)=BSDXST ;STATE
"RTN","BSDX09",102,0)
 S $P(BSDXY,"^",5)=$P(BSDXNOD,U,6) ;ZIP
"RTN","BSDX09",103,0)
 Q
"RTN","BSDX09",104,0)
 ;
"RTN","BSDX09",105,0)
PHONE ;PHONE 10,11,12 HOME,OFC,MSG
"RTN","BSDX09",106,0)
 I $D(^DPT(+BSDXPAT,.13)) D
"RTN","BSDX09",107,0)
 . S BSDXNOD=^DPT(+BSDXPAT,.13)
"RTN","BSDX09",108,0)
 . S $P(BSDXY,U,10)=$P(BSDXNOD,U,1)
"RTN","BSDX09",109,0)
 . S $P(BSDXY,U,11)=$P(BSDXNOD,U,2)
"RTN","BSDX09",110,0)
 I $D(^DPT(+BSDXPAT,.121)) D
"RTN","BSDX09",111,0)
 . S BSDXNOD=^DPT(+BSDXPAT,.121)
"RTN","BSDX09",112,0)
 . S $P(BSDXY,U,12)=$P(BSDXNOD,U,10)
"RTN","BSDX09",113,0)
 Q
"RTN","BSDX09",114,0)
 ;
"RTN","BSDX09",115,0)
NOK ;NOK
"RTN","BSDX09",116,0)
 ;   13 NOK NAME^RELATIONSHIP^PHONE^STREET^CITY^STATE^ZIP
"RTN","BSDX09",117,0)
 N Y,BSDXST
"RTN","BSDX09",118,0)
 I $D(^DPT(+BSDXPAT,.21)) D
"RTN","BSDX09",119,0)
 . S BSDXNOD=^DPT(+BSDXPAT,.21)
"RTN","BSDX09",120,0)
 . S $P(BSDXY,U,13)=$P(BSDXNOD,U,1)
"RTN","BSDX09",121,0)
 . S $P(BSDXY,U,14)=$$VAL^XBDIQ1(9000001,BSDXPAT,2802)
"RTN","BSDX09",122,0)
 . S $P(BSDXY,U,15)=$P(BSDXNOD,U,9)
"RTN","BSDX09",123,0)
 . S $P(BSDXY,U,16)=$P(BSDXNOD,U,3)
"RTN","BSDX09",124,0)
 . S $P(BSDXY,U,17)=$P(BSDXNOD,U,6)
"RTN","BSDX09",125,0)
 . S BSDXST=$P(BSDXNOD,U,7)
"RTN","BSDX09",126,0)
 . I +BSDXST D
"RTN","BSDX09",127,0)
 . . I $D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2),$P(BSDXY,U,18)=BSDXST
"RTN","BSDX09",128,0)
 . S $P(BSDXY,U,19)=$P(BSDXNOD,U,8)
"RTN","BSDX09",129,0)
 Q
"RTN","BSDX09",130,0)
 ;
"RTN","BSDX09",131,0)
DATAREV S $P(BSDXY,U,20)=$P($$VAL^XBDIQ1(9000001,BSDXPAT,16651),"@")
"RTN","BSDX09",132,0)
 Q
"RTN","BSDX09",133,0)
 ;
"RTN","BSDX09",134,0)
REGCMT N BSDXI,BSDXM,BSDXR
"RTN","BSDX09",135,0)
 S BSDXR=""
"RTN","BSDX09",136,0)
 D ENP^XBDIQ1(9000001,BSDXPAT,1301,"BSDXM(")
"RTN","BSDX09",137,0)
 S BSDXI=0 F  S BSDXI=$O(BSDXM(1301,BSDXI)) Q:'+BSDXI  D
"RTN","BSDX09",138,0)
 . S BSDXR=BSDXR_" "_BSDXM(1301,BSDXI)
"RTN","BSDX09",139,0)
 ; S $P(BSDXY,U,23)=$TR($E(BSDXR,1,1024),U," ") ; MJL 1/17/2007 //smh
"RTN","BSDX09",140,0)
 S $P(BSDXY,U,21)=$TR($E(BSDXR,1,1024),U," ") ;
"RTN","BSDX09",141,0)
 Q
"RTN","BSDX09",142,0)
 ;
"RTN","BSDX09",143,0)
GETMCAID(BSDXY,BSDXPAT) ; not in wv
"RTN","BSDX09",144,0)
 ;Returns PATIENTIEN^ENTRY#^MEDICAID#^SUBENTRY#^ELIG.BEGIN^ELIG.END |
"RTN","BSDX09",145,0)
 ;File is not dinum
"RTN","BSDX09",146,0)
 N C,N,ASDGX,BSDXM,BSDXBLD,BSDXCNT
"RTN","BSDX09",147,0)
 N BSDXIEN
"RTN","BSDX09",148,0)
 S BSDXBLD=""
"RTN","BSDX09",149,0)
 S BSDXIEN=0
"RTN","BSDX09",150,0)
 S BSDXCNT=1
"RTN","BSDX09",151,0)
 F  S BSDXIEN=$O(^AUPNMCD("B",BSDXPAT,BSDXIEN)) Q:'+BSDXIEN  D
"RTN","BSDX09",152,0)
 . S BSDXNUM=$$VAL^XBDIQ1(9000004,BSDXIEN,.03) ;MCAID#
"RTN","BSDX09",153,0)
 . D ENPM^XBDIQ1(9000004.11,BSDXIEN_",0",".01:.02","ASDGX(")
"RTN","BSDX09",154,0)
 . S C=1,N=0,BSDXM=""
"RTN","BSDX09",155,0)
 . F  S N=$O(ASDGX(N)) Q:'N  D
"RTN","BSDX09",156,0)
 . . S $P(BSDXY,"|",C)=BSDXPAT_U_BSDXIEN_U_BSDXNUM_U_N_U_ASDGX(N,.01)_U_ASDGX(N,.02)
"RTN","BSDX09",157,0)
 . . S C=C+1
"RTN","BSDX09",158,0)
 . . Q
"RTN","BSDX09",159,0)
 . Q
"RTN","BSDX09",160,0)
 Q
"RTN","BSDX09",161,0)
 ;
"RTN","BSDX09",162,0)
MEDICARE ; not in WV
"RTN","BSDX09",163,0)
 S $P(BSDXY,U,21)=$$VAL^XBDIQ1(9000003,BSDXPAT,.03)
"RTN","BSDX09",164,0)
 S $P(BSDXY,U,22)=$$VAL^XBDIQ1(9000003,BSDXPAT,.04)
"RTN","BSDX09",165,0)
 Q
"RTN","BSDX09",166,0)
 ;
"RTN","BSDX09",167,0)
GETMCARE(BSDXY,BSDXPAT)      ;
"RTN","BSDX09",168,0)
 ;Returns IEN^MEDICARE#^SUFFIX^SUBENTRY#^TYPE^ELIG.BEGIN^ELIG.END |
"RTN","BSDX09",169,0)
 ;File is dinum
"RTN","BSDX09",170,0)
 ;
"RTN","BSDX09",171,0)
 N ASDGX,C,N,BSDXNUM,BSDXSUF,BSDXBLD
"RTN","BSDX09",172,0)
 S BSDXNUM=$$VAL^XBDIQ1(9000003,BSDXPAT,.03)
"RTN","BSDX09",173,0)
 S BSDXSUF=$$VAL^XBDIQ1(9000003,BSDXPAT,.04)
"RTN","BSDX09",174,0)
 D ENPM^XBDIQ1(9000003.11,BSDXPAT_",0",".01:.03","ASDGX(")
"RTN","BSDX09",175,0)
 S C=1,N=0,BSDXBLD=""
"RTN","BSDX09",176,0)
 F  S N=$O(ASDGX(N)) Q:'N  D
"RTN","BSDX09",177,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",178,0)
 . S C=C+1
"RTN","BSDX09",179,0)
 . Q
"RTN","BSDX09",180,0)
 Q
"RTN","BSDX09",181,0)
 ;
"RTN","BSDX09",182,0)
GETPVTIN(BSDXY,BSDXPAT) ;
"RTN","BSDX09",183,0)
 ;Returns IEN^SUBENTRY^INSURER^POLICYNUMBER^ELIG.BEGIN^ELIG.END|...
"RTN","BSDX09",184,0)
 ;File is dinum
"RTN","BSDX09",185,0)
 ;
"RTN","BSDX09",186,0)
 N ASDGX,C,N
"RTN","BSDX09",187,0)
 D ENPM^XBDIQ1(9000006.11,BSDXPAT_",0",".01;.02;.06;.07","ASDGX(")
"RTN","BSDX09",188,0)
 S C=1,N=0
"RTN","BSDX09",189,0)
 F  S N=$O(ASDGX(N)) Q:'N  D
"RTN","BSDX09",190,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",191,0)
 . S C=C+1
"RTN","BSDX09",192,0)
 . Q
"RTN","BSDX09",193,0)
 Q
"RTN","BSDX09",194,0)
 ;
"RTN","BSDX09",195,0)
DFN(FILE,BSDXPAT) ; -- returns ien for file
"RTN","BSDX09",196,0)
 I FILE'[9000004 Q BSDXPAT
"RTN","BSDX09",197,0)
 Q +$O(^AUPNMCD("B",BSDXPAT,0))
"RTN","BSDX11")
0^34^B6468379
"RTN","BSDX11",1,0)
BSDX11 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
"RTN","BSDX11",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX11",3,0)
 ; Licensed under LGPL
"RTN","BSDX11",4,0)
 ;
"RTN","BSDX11",5,0)
ENV0100 ;EP Version 1.0 Environment check
"RTN","BSDX11",6,0)
 I '$G(IOM) D HOME^%ZIS
"RTN","BSDX11",7,0)
 I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
"RTN","BSDX11",8,0)
 I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
"RTN","BSDX11",9,0)
 I '(DUZ(0)["@") W:'$D(ZTQUEUED) !,"DUZ(0) DOES NOT CONTAIN AN '@'." D SORRY(2) Q
"RTN","BSDX11",10,0)
 S X=$$GET1^DIQ(200,DUZ,.01)
"RTN","BSDX11",11,0)
 W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
"RTN","BSDX11",12,0)
 W !!,$$CJ^XLFSTR("Checking Environment...",IOM)
"RTN","BSDX11",13,0)
 ;
"RTN","BSDX11",14,0)
 ;is the PIMS requirement present?
"RTN","BSDX11",15,0)
 I '$$INSTALLD("PIMS*5.3*1003") D
"RTN","BSDX11",16,0)
 .D BMES^XPDUTL("Version 1.0 of the BSDX Package")
"RTN","BSDX11",17,0)
 . D BMES^XPDUTL("Cannot Be Installed Unless")
"RTN","BSDX11",18,0)
 . D BMES^XPDUTL("Patch 1003 of version 5.3 of the PIMS Package has been installed.")
"RTN","BSDX11",19,0)
 . D SORRY(2)
"RTN","BSDX11",20,0)
 . Q
"RTN","BSDX11",21,0)
 ;is the BMX requirement present?
"RTN","BSDX11",22,0)
 I '$$INSTALLD("BMX 1.0") D
"RTN","BSDX11",23,0)
 .D BMES^XPDUTL("Version 1.0 of the BSDX Package")
"RTN","BSDX11",24,0)
 . D BMES^XPDUTL("Cannot Be Installed Unless")
"RTN","BSDX11",25,0)
 . D BMES^XPDUTL("version 1.0 of the BMX Package has been installed.")
"RTN","BSDX11",26,0)
 . D SORRY(2)
"RTN","BSDX11",27,0)
 . Q
"RTN","BSDX11",28,0)
 Q
"RTN","BSDX11",29,0)
 ;End Environment check
"RTN","BSDX11",30,0)
 ;
"RTN","BSDX11",31,0)
V0100 ;EP Version 1.0 PostInit
"RTN","BSDX11",32,0)
 ;Add Protocol items to BSDAM APPOINTMENT EVENTS protocol
"RTN","BSDX11",33,0)
 ;
"RTN","BSDX11",34,0)
 N BSDXDA,BSDXFDA,BSDXDA1,BSDXSEQ,BSDXDAT,BSDXNOD,BSDXIEN,BSDXMSG
"RTN","BSDX11",35,0)
 S BSDXDA=$O(^ORD(101,"B","BSDAM APPOINTMENT EVENTS",0))
"RTN","BSDX11",36,0)
 Q:'+BSDXDA
"RTN","BSDX11",37,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",38,0)
 F J=1:1:$L(BSDXDAT,U) D
"RTN","BSDX11",39,0)
 . K BSDXIEN,BSDXMSG,BSDXFDA
"RTN","BSDX11",40,0)
 . S BSDXNOD=$P(BSDXDAT,U,J)
"RTN","BSDX11",41,0)
 . S BSDXDA1=$P(BSDXNOD,";")
"RTN","BSDX11",42,0)
 . S BSDXSEQ=$P(BSDXNOD,";",2)
"RTN","BSDX11",43,0)
 . S BSDXDA1=$O(^ORD(101,"B",BSDXDA1,0))
"RTN","BSDX11",44,0)
 . Q:'+BSDXDA1
"RTN","BSDX11",45,0)
 . Q:$D(^ORD(101,BSDXDA,10,"B",BSDXDA1))
"RTN","BSDX11",46,0)
 . S BSDXFDA(101.01,"+1,"_BSDXDA_",",".01")=BSDXDA1
"RTN","BSDX11",47,0)
 . S BSDXFDA(101.01,"+1,"_BSDXDA_",","3")=BSDXSEQ
"RTN","BSDX11",48,0)
 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX11",49,0)
 . Q
"RTN","BSDX11",50,0)
 Q
"RTN","BSDX11",51,0)
 ;
"RTN","BSDX11",52,0)
SORRY(X) ;
"RTN","BSDX11",53,0)
 KILL DIFQ
"RTN","BSDX11",54,0)
 S XPDQUIT=X
"RTN","BSDX11",55,0)
 W *7,!,$$CJ^XLFSTR("Sorry....Please fix it.",IOM)
"RTN","BSDX11",56,0)
 Q
"RTN","BSDX11",57,0)
 ;
"RTN","BSDX11",58,0)
INSTALLD(BMXPKG) ;
"RTN","BSDX11",59,0)
 ;Determine if BMXPKG is present.
"RTN","BSDX11",60,0)
 Q 1
"RTN","BSDX11",61,0)
 ;S BSDXFIN=$O(^XPD(9.7,"B","PIMS*5.3*1003",""))
"RTN","BSDX11",62,0)
 S BSDXFIN=$O(^XPD(9.7,"B",BMXPKG,""))
"RTN","BSDX11",63,0)
 I $G(BSDXFIN)="" Q 0
"RTN","BSDX11",64,0)
 S BSDXSTAT=$P($G(^XPD(9.7,BSDXFIN,0)),U,9)
"RTN","BSDX11",65,0)
 ;'0' Loaded from Distribution
"RTN","BSDX11",66,0)
 ;'1' Queued for Install 
"RTN","BSDX11",67,0)
 ;'2' Start of Install 
"RTN","BSDX11",68,0)
 ;'3' Install Completed 
"RTN","BSDX11",69,0)
 ;'4' FOR De-Installed; 
"RTN","BSDX11",70,0)
 ;
"RTN","BSDX11",71,0)
 I BSDXSTAT'=3 Q 0
"RTN","BSDX11",72,0)
 Q 1
"RTN","BSDX12")
0^10^B7048487
"RTN","BSDX12",1,0)
BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
"RTN","BSDX12",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX12",3,0)
 ; Licensed under LGPL
"RTN","BSDX12",4,0)
 ; 
"RTN","BSDX12",5,0)
 ; Change Log:
"RTN","BSDX12",6,0)
 ; v 1.3 - i18n support - 3100718
"RTN","BSDX12",7,0)
 ; BSDXSTART and BSDXEND passed in FM Dates, not US dates
"RTN","BSDX12",8,0)
 ;
"RTN","BSDX12",9,0)
 ;
"RTN","BSDX12",10,0)
AVADD(BSDXY,BSDXSTART,BSDXEND,BSDXTYPID,BSDXRES,BSDXSLOTS,BSDXNOTE)  ;EP
"RTN","BSDX12",11,0)
 ;Called by BSDX ADD NEW AVAILABILITY
"RTN","BSDX12",12,0)
 ;Create entry in BSDX ACCESS BLOCK
"RTN","BSDX12",13,0)
 ;
"RTN","BSDX12",14,0)
 ;BSDXRES is Resource Name
"RTN","BSDX12",15,0)
 ;Returns recordset having fields 
"RTN","BSDX12",16,0)
 ; AvailabilityID and ErrorNumber
"RTN","BSDX12",17,0)
 ;
"RTN","BSDX12",18,0)
 ;Test lines:
"RTN","BSDX12",19,0)
 ;D AVADD^BSDX12(.RES,"3091227.09","3091227.0930","1","WHITT",2,"SCRATCH AV NOTE") ZW RES
"RTN","BSDX12",20,0)
 ;BSDX ADD NEW AVAILABILITY^3091227.09^3091227.0930^1^WHITT^2^SCRATCH AVAILABILITY NOTE
"RTN","BSDX12",21,0)
 ;
"RTN","BSDX12",22,0)
 N BSDXERR,BSDXIEN,BSDXDEP,BSDXI,BSDXAVID,BSDXI,BSDXERR,BSDXFDA,BSDXMSG,BSDXRESD
"RTN","BSDX12",23,0)
 K ^BSDXTMP($J)
"RTN","BSDX12",24,0)
 S BSDXERR=0
"RTN","BSDX12",25,0)
 S BSDXI=0
"RTN","BSDX12",26,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX12",27,0)
 S ^BSDXTMP($J,0)="I00020AVAILABILITYID^I00020ERRORID"_$C(30)
"RTN","BSDX12",28,0)
 ;Check input data for errors
"RTN","BSDX12",29,0)
    ; i18n - FM Dates passed in
"RTN","BSDX12",30,0)
 ; S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@")
"RTN","BSDX12",31,0)
 ; S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@")
"RTN","BSDX12",32,0)
 ; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
"RTN","BSDX12",33,0)
 ; I BSDXSTART=-1 D ERR(70) Q
"RTN","BSDX12",34,0)
 ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
"RTN","BSDX12",35,0)
 ; I BSDXEND=-1 D ERR(70) Q
"RTN","BSDX12",36,0)
    ; Make sure dates are canonical and don't contain extra zeros
"RTN","BSDX12",37,0)
    S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
"RTN","BSDX12",38,0)
    ;
"RTN","BSDX12",39,0)
 I $L(BSDXEND,".")=1 D ERR(70) Q
"RTN","BSDX12",40,0)
 I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
"RTN","BSDX12",41,0)
 ;Validate Access Type
"RTN","BSDX12",42,0)
 I '+BSDXTYPID,'$D(^BSDXTYPE(BSDXTYPID,0)) D ERR(70) Q
"RTN","BSDX12",43,0)
 ;Validate Resource
"RTN","BSDX12",44,0)
 I '$D(^BSDXRES("B",BSDXRES)) S BSDXERR=70 D ERR(BSDXERR) Q
"RTN","BSDX12",45,0)
 S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0)) I '+BSDXRESD S BSDXERR=70 D ERR(BSDXERR) Q
"RTN","BSDX12",46,0)
 ;
"RTN","BSDX12",47,0)
 ;Create entry in BSDX ACCESS BLOCK
"RTN","BSDX12",48,0)
 S BSDXFDA(9002018.3,"+1,",.01)=BSDXRESD
"RTN","BSDX12",49,0)
 S BSDXFDA(9002018.3,"+1,",.02)=BSDXSTART
"RTN","BSDX12",50,0)
 S BSDXFDA(9002018.3,"+1,",.03)=BSDXEND
"RTN","BSDX12",51,0)
 S BSDXFDA(9002018.3,"+1,",.04)=BSDXSLOTS
"RTN","BSDX12",52,0)
 S BSDXFDA(9002018.3,"+1,",.05)=BSDXTYPID
"RTN","BSDX12",53,0)
 K BSDXIEN,BSDXMSG
"RTN","BSDX12",54,0)
 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX12",55,0)
 S BSDXAVID=+$G(BSDXIEN(1))
"RTN","BSDX12",56,0)
 I 'BSDXAVID D ERR(70) Q
"RTN","BSDX12",57,0)
 ;
"RTN","BSDX12",58,0)
 ;Add WP field
"RTN","BSDX12",59,0)
 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
"RTN","BSDX12",60,0)
 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
"RTN","BSDX12",61,0)
 I $D(BSDXNOTE(.5)) D
"RTN","BSDX12",62,0)
 . D WP^DIE(9002018.3,BSDXAVID_",",1,"","BSDXNOTE","BSDXMSG")
"RTN","BSDX12",63,0)
 ;
"RTN","BSDX12",64,0)
 ;Return Recordset
"RTN","BSDX12",65,0)
 S BSDXI=BSDXI+1
"RTN","BSDX12",66,0)
 S ^BSDXTMP($J,BSDXI)=BSDXAVID_"^-1"_$C(30)
"RTN","BSDX12",67,0)
 S BSDXI=BSDXI+1
"RTN","BSDX12",68,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX12",69,0)
 Q
"RTN","BSDX12",70,0)
 ;
"RTN","BSDX12",71,0)
ERR(ERRNO) ;Error processing
"RTN","BSDX12",72,0)
 S BSDXERR=ERRNO+134234112 ;vbObjectError
"RTN","BSDX12",73,0)
 S BSDXI=BSDXI+1
"RTN","BSDX12",74,0)
 S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
"RTN","BSDX12",75,0)
 S BSDXI=BSDXI+1
"RTN","BSDX12",76,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX12",77,0)
 Q
"RTN","BSDX13")
0^11^B9627754
"RTN","BSDX13",1,0)
BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
"RTN","BSDX13",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX13",3,0)
 ; Licensed under LGPL
"RTN","BSDX13",4,0)
 ;
"RTN","BSDX13",5,0)
 ; Change Log:
"RTN","BSDX13",6,0)
 ; V 1.3 - i18n support - Dates passed to Routine as FM Date - WV/SMH
"RTN","BSDX13",7,0)
 Q
"RTN","BSDX13",8,0)
AVDELDTD(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP
"RTN","BSDX13",9,0)
 ;Entry point for debugging
"RTN","BSDX13",10,0)
 ;
"RTN","BSDX13",11,0)
 ;D DEBUG^%Serenji("AVDELDT^BSDX13(.BSDXY,BSDXRESD,BSDXSTART,BSDXEND)")
"RTN","BSDX13",12,0)
 Q
"RTN","BSDX13",13,0)
 ;
"RTN","BSDX13",14,0)
AVDELDT(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP
"RTN","BSDX13",15,0)
 ;Cancel availability in a date range
"RTN","BSDX13",16,0)
 ;Called by BSDX CANCEL AV BY DATE
"RTN","BSDX13",17,0)
 ;
"RTN","BSDX13",18,0)
 ;BSDXRESD is BSDX RESOURCE ien
"RTN","BSDX13",19,0)
 ;BSDXSTART and BSDXEND are FM dates (change in v 1.3)
"RTN","BSDX13",20,0)
 ;
"RTN","BSDX13",21,0)
 S X="ERROR^BSDX13",@^%ZOSF("TRAP")
"RTN","BSDX13",22,0)
 N BMXIEN,BSDXI
"RTN","BSDX13",23,0)
 S BSDXI=0
"RTN","BSDX13",24,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX13",25,0)
 K ^BSDXTMP($J)
"RTN","BSDX13",26,0)
 S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
"RTN","BSDX13",27,0)
 ; S X=BSDXSTART ; commented out *v1.3
"RTN","BSDX13",28,0)
 ; S %DT="X" D ^%DT
"RTN","BSDX13",29,0)
 ; I Y=-1 D ERR(0,"AVDELDT-BSDX13: Invalid Start Date") Q
"RTN","BSDX13",30,0)
 ; S BSDXSTART=$P(Y,".")
"RTN","BSDX13",31,0)
 ; S X=BSDXEND
"RTN","BSDX13",32,0)
 ; S %DT="X" D ^%DT
"RTN","BSDX13",33,0)
 ; I Y=-1 D ERR(0,"AVDELDT-BSDX13: Invalid End Date") Q
"RTN","BSDX13",34,0)
 S BSDXEND=$P(BSDXEND,".")_".99999"
"RTN","BSDX13",35,0)
 I '+BSDXRESD D ERR(0,"AVDELDT-BSDX13: Invalid Resource ID") Q
"RTN","BSDX13",36,0)
 ;
"RTN","BSDX13",37,0)
 F  S BSDXSTART=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXSTART)) Q:'+BSDXSTART  Q:BSDXSTART>BSDXEND  D
"RTN","BSDX13",38,0)
 . S BMXIEN=0
"RTN","BSDX13",39,0)
 . F  S BMXIEN=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXSTART,BMXIEN)) Q:'+BMXIEN  D
"RTN","BSDX13",40,0)
 . . D CALLDIK(BMXIEN)
"RTN","BSDX13",41,0)
 ;
"RTN","BSDX13",42,0)
 S BSDXI=BSDXI+1
"RTN","BSDX13",43,0)
 S ^BSDXTMP($J,BSDXI)="-1^"_$C(30)_$C(31)
"RTN","BSDX13",44,0)
 Q
"RTN","BSDX13",45,0)
ERROR ;
"RTN","BSDX13",46,0)
 D ^%ZTER
"RTN","BSDX13",47,0)
 I '+$G(BSDXI) N BSDXI S BSDXI=999999
"RTN","BSDX13",48,0)
 S BSDXI=BSDXI+1
"RTN","BSDX13",49,0)
 D ERR(0,"BSDX13 M Error: <"_$G(%ZTERZE)_">")
"RTN","BSDX13",50,0)
 Q
"RTN","BSDX13",51,0)
 ;
"RTN","BSDX13",52,0)
ERR(BSDXERID,ERRTXT) ;Error processing
"RTN","BSDX13",53,0)
 S:'+$G(BSDXI) BSDXI=999999
"RTN","BSDX13",54,0)
 S BSDXI=BSDXI+1
"RTN","BSDX13",55,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
"RTN","BSDX13",56,0)
 S BSDXI=BSDXI+1
"RTN","BSDX13",57,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX13",58,0)
 Q
"RTN","BSDX13",59,0)
 ;
"RTN","BSDX13",60,0)
AVDEL(BSDXY,BSDXAVID) ;EP
"RTN","BSDX13",61,0)
 ;Called by BSDX CANCEL AVAILABILITY
"RTN","BSDX13",62,0)
 ;Deletes Access block
"RTN","BSDX13",63,0)
 ;BSDXAVID is entry number in BSDX AVAILABILITY file
"RTN","BSDX13",64,0)
 ;Returns error code in recordset field ERRORID
"RTN","BSDX13",65,0)
 ;
"RTN","BSDX13",66,0)
 S X="ERROR^BSDX13",@^%ZOSF("TRAP")
"RTN","BSDX13",67,0)
 N BSDXNOD,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXEND,BSDXRSID
"RTN","BSDX13",68,0)
 ;
"RTN","BSDX13",69,0)
 S BSDXI=0
"RTN","BSDX13",70,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX13",71,0)
 K ^BSDXTMP($J)
"RTN","BSDX13",72,0)
 S ^BSDXTMP($J,0)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
"RTN","BSDX13",73,0)
 I '+BSDXAVID D ERR(70) Q
"RTN","BSDX13",74,0)
 I '$D(^BSDXAB(BSDXAVID,0)) D ERR(70) Q
"RTN","BSDX13",75,0)
 ;
"RTN","BSDX13",76,0)
 ;
"RTN","BSDX13",77,0)
 ;TODO: Test for existing appointments in availability block
"RTN","BSDX13",78,0)
 ; (corresponds to old qryAppointmentBlocksOverlapC
"RTN","BSDX13",79,0)
 ;  and AVBlockHasAppointments)
"RTN","BSDX13",80,0)
 ;
"RTN","BSDX13",81,0)
 ;I $$APTINBLK(BSDXAVID) D ERR(20) Q
"RTN","BSDX13",82,0)
 ;
"RTN","BSDX13",83,0)
 ;Delete AVAILABILITY entries
"RTN","BSDX13",84,0)
 D CALLDIK(BSDXAVID)
"RTN","BSDX13",85,0)
 ;
"RTN","BSDX13",86,0)
 S BSDXI=BSDXI+1
"RTN","BSDX13",87,0)
 S ^BSDXTMP($J,BSDXI)="-1^"_$C(30)_$C(31)
"RTN","BSDX13",88,0)
 Q
"RTN","BSDX13",89,0)
 ;
"RTN","BSDX13",90,0)
CALLDIK(BSDXAVID) ;
"RTN","BSDX13",91,0)
 ;Delete AVAILABILITY entries
"RTN","BSDX13",92,0)
 ;
"RTN","BSDX13",93,0)
 S DIK="^BSDXAB("
"RTN","BSDX13",94,0)
 S DA=BSDXAVID
"RTN","BSDX13",95,0)
 D ^DIK
"RTN","BSDX13",96,0)
 ;
"RTN","BSDX13",97,0)
 Q
"RTN","BSDX13",98,0)
 ;
"RTN","BSDX13",99,0)
APTINBLK(BSDXAVID) ;
"RTN","BSDX13",100,0)
 ;
"RTN","BSDX13",101,0)
 ;NOTE: This Subroutine Not called in current version.  Keep code for later use.
"RTN","BSDX13",102,0)
 ;
"RTN","BSDX13",103,0)
 ;N BSDXS,BSDXID,BSDXHIT,BSDXNOD,BSDXE,BSDXSTART,BSDXEND,BSDXRSID
"RTN","BSDX13",104,0)
 ;S BSDXNOD=^BSDXAB(BSDXAVID,0)
"RTN","BSDX13",105,0)
 ;S BSDXSTART=$P(BSDXNOD,U,3)
"RTN","BSDX13",106,0)
 ;S BSDXEND=$P(BSDXNOD,U,4)
"RTN","BSDX13",107,0)
 ;S BSDXRSID=$P(BSDXNOD,U,1)
"RTN","BSDX13",108,0)
 ;I '$D(^BSDXDAPRS("ARSRC",BSDXRSID)) Q 0
"RTN","BSDX13",109,0)
 ;;If any appointments start at the AV block start time:
"RTN","BSDX13",110,0)
 ;I $D(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXSTART)) Q 1
"RTN","BSDX13",111,0)
 ;;Find the first appt time BSDXS on the same day as the av block
"RTN","BSDX13",112,0)
 ;S BSDXS=$O(^BSDXDAPRS("ARSRC",BSDXRSID,$P(BSDXSTART,".")))
"RTN","BSDX13",113,0)
 ;I BSDXS>BSDXEND Q 0
"RTN","BSDX13",114,0)
 ;;For all the appts that day with start times less
"RTN","BSDX13",115,0)
 ;;than the av block's end time, find any whose end time is
"RTN","BSDX13",116,0)
 ;;greater than the av block's start time
"RTN","BSDX13",117,0)
 ;S BSDXHIT=0
"RTN","BSDX13",118,0)
 ;S BSDXS=BSDXS-.0001
"RTN","BSDX13",119,0)
 ;F  S BSDXS=$O(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXS)) Q:'+BSDXS  Q:BSDXS'<BSDXEND  D  Q:BSDXHIT
"RTN","BSDX13",120,0)
 ;. S BSDXID=0 F  S BSDXID=$O(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXS,BSDXID)) Q:'+BSDXID  D  Q:BSDXHIT
"RTN","BSDX13",121,0)
 ;. . Q:'$D(^BSDXDAPT(BSDXID,0))
"RTN","BSDX13",122,0)
 ;. . S BSDXNOD=^BSDXDAPT(BSDXID,0)
"RTN","BSDX13",123,0)
 ;. . S BSDXE=$P(BSDXNOD,U,2)
"RTN","BSDX13",124,0)
 ;. . I BSDXE>BSDXSTART S BSDXHIT=1 Q
"RTN","BSDX13",125,0)
 ;;
"RTN","BSDX13",126,0)
 ;I BSDXHIT Q 1
"RTN","BSDX13",127,0)
 Q 0
"RTN","BSDX13",128,0)
 ;
"RTN","BSDX13",129,0)
 ;ERR(ERRNO) ;Error processing
"RTN","BSDX13",130,0)
 ;N BSDXERR
"RTN","BSDX13",131,0)
 ;S BSDXERR=ERRNO+134234112 ;vbObjectError
"RTN","BSDX13",132,0)
 ;S BSDXI=BSDXI+1
"RTN","BSDX13",133,0)
 ;S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
"RTN","BSDX13",134,0)
 ;S BSDXI=BSDXI+1
"RTN","BSDX13",135,0)
 ;S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX13",136,0)
 ;Q
"RTN","BSDX14")
0^12^B6549711
"RTN","BSDX14",1,0)
BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
"RTN","BSDX14",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX14",3,0)
 ; Licensed under LGPL
"RTN","BSDX14",4,0)
 ;
"RTN","BSDX14",5,0)
 ;
"RTN","BSDX14",6,0)
ACCTYPD(BSDXY,BSDXVAL) ;EP
"RTN","BSDX14",7,0)
 ;Entry point for debugging
"RTN","BSDX14",8,0)
 ;
"RTN","BSDX14",9,0)
 ;D DEBUG^%Serenji("ACCTYP^BSDX14(.BSDXY,BSDXVAL)")
"RTN","BSDX14",10,0)
 Q
"RTN","BSDX14",11,0)
 ;
"RTN","BSDX14",12,0)
ACCTYP(BSDXY,BSDXVAL) ;EP
"RTN","BSDX14",13,0)
 ;Called by BSDX ADD/EDIT ACCESS TYPE
"RTN","BSDX14",14,0)
 ;Add/Edit ACCESS TYPE entry
"RTN","BSDX14",15,0)
 ;BSDXVAL is IEN|NAME|INACTIVE|COLOR|RED|GREEN|BLUE
"RTN","BSDX14",16,0)
 ;If IEN=0 Then this is a new ACCTYPE
"RTN","BSDX14",17,0)
 ;Test Line:
"RTN","BSDX14",18,0)
 ;D ACCTYP^BSDX14(.RES,"0|ORAL HYGIENE|false|Red")
"RTN","BSDX14",19,0)
 ;
"RTN","BSDX14",20,0)
 S X="ERROR^BSDX14",@^%ZOSF("TRAP")
"RTN","BSDX14",21,0)
 N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXNAM
"RTN","BSDX14",22,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX14",23,0)
 S ^BSDXTMP($J,0)="I00020ACCESSTYPEID^T00030ERRORTEXT"_$C(30)
"RTN","BSDX14",24,0)
 I BSDXVAL="" D ERR(0,"BSDX14: Invalid null input Parameter") Q
"RTN","BSDX14",25,0)
 S BSDXIEN=$P(BSDXVAL,"|")
"RTN","BSDX14",26,0)
 I +BSDXIEN D
"RTN","BSDX14",27,0)
 . S BSDX="EDIT"
"RTN","BSDX14",28,0)
 . S BSDXIENS=BSDXIEN_","
"RTN","BSDX14",29,0)
 E  D
"RTN","BSDX14",30,0)
 . S BSDX="ADD"
"RTN","BSDX14",31,0)
 . S BSDXIENS="+1,"
"RTN","BSDX14",32,0)
 ;
"RTN","BSDX14",33,0)
 S BSDXNAM=$P(BSDXVAL,"|",2)
"RTN","BSDX14",34,0)
 I BSDXNAM="" D ERR(0,"BSDX14: Invalid null Access Type name.") Q
"RTN","BSDX14",35,0)
 ;
"RTN","BSDX14",36,0)
 ;Prevent adding entry with duplicate name
"RTN","BSDX14",37,0)
 I $D(^BSDXTYPE("B",BSDXNAM)),$O(^BSDXTYPE("B",BSDXNAM,0))'=BSDXIEN D  Q
"RTN","BSDX14",38,0)
 . D ERR(0,"BSDX14: Cannot have two Access Types with the same name.")
"RTN","BSDX14",39,0)
 . Q
"RTN","BSDX14",40,0)
 ;
"RTN","BSDX14",41,0)
 S BSDXINA=$P(BSDXVAL,"|",3)
"RTN","BSDX14",42,0)
 S BSDXINA=$S(BSDXINA="YES":1,1:0)
"RTN","BSDX14",43,0)
 ;
"RTN","BSDX14",44,0)
 S BSDXFDA(9002018.35,BSDXIENS,.01)=$P(BSDXVAL,"|",2) ;NAME
"RTN","BSDX14",45,0)
 S BSDXFDA(9002018.35,BSDXIENS,.02)=BSDXINA ;INACTIVE
"RTN","BSDX14",46,0)
 S BSDXFDA(9002018.35,BSDXIENS,.04)=$P(BSDXVAL,"|",4) ;COLOR
"RTN","BSDX14",47,0)
 S BSDXFDA(9002018.35,BSDXIENS,.05)=$P(BSDXVAL,"|",5) ;RED
"RTN","BSDX14",48,0)
 S BSDXFDA(9002018.35,BSDXIENS,.06)=$P(BSDXVAL,"|",6) ;GREEN
"RTN","BSDX14",49,0)
 S BSDXFDA(9002018.35,BSDXIENS,.07)=$P(BSDXVAL,"|",7) ;BLUE
"RTN","BSDX14",50,0)
 K BSDXMSG
"RTN","BSDX14",51,0)
 I BSDX="ADD" D
"RTN","BSDX14",52,0)
 . K BSDXIEN
"RTN","BSDX14",53,0)
 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX14",54,0)
 . S BSDXIEN=+$G(BSDXIEN(1))
"RTN","BSDX14",55,0)
 E  D
"RTN","BSDX14",56,0)
 . D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX14",57,0)
 S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^-1"_$C(30)_$C(31)
"RTN","BSDX14",58,0)
 Q
"RTN","BSDX14",59,0)
 ;
"RTN","BSDX14",60,0)
ERR(BSDXERID,ERRTXT) ;Error processing
"RTN","BSDX14",61,0)
 S:'+$G(BSDXI) BSDXI=999999
"RTN","BSDX14",62,0)
 S BSDXI=BSDXI+1
"RTN","BSDX14",63,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
"RTN","BSDX14",64,0)
 S BSDXI=BSDXI+1
"RTN","BSDX14",65,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX14",66,0)
 Q
"RTN","BSDX14",67,0)
 ;
"RTN","BSDX14",68,0)
ERROR ;
"RTN","BSDX14",69,0)
 D ^%ZTER
"RTN","BSDX14",70,0)
 I '+$G(BSDXI) N BSDXI S BSDXI=999999
"RTN","BSDX14",71,0)
 S BSDXI=BSDXI+1
"RTN","BSDX14",72,0)
 D ERR(0,"BSDX14 M Error: <"_$G(%ZTERROR)_">")
"RTN","BSDX14",73,0)
 Q
"RTN","BSDX15")
0^13^B5399368
"RTN","BSDX15",1,0)
BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
"RTN","BSDX15",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX15",3,0)
 ; Licensed under LGPL
"RTN","BSDX15",4,0)
 ;
"RTN","BSDX15",5,0)
 ;
"RTN","BSDX15",6,0)
GRPTYP(BSDXY) ;EP
"RTN","BSDX15",7,0)
 ;Called by BSDX GET ACCESS GROUP TYPES
"RTN","BSDX15",8,0)
 ;Returns ADO recordset containing ACTIVE Access types ordered alphabetically
"RTN","BSDX15",9,0)
 ;by Access Group
"RTN","BSDX15",10,0)
 ;AccessGroupID, AccessGroup, AccessTypeID, AccessType
"RTN","BSDX15",11,0)
 ;
"RTN","BSDX15",12,0)
 ;Test Code:
"RTN","BSDX15",13,0)
 ;D GRPTYP^BSDX15(.RES) ZW RES
"RTN","BSDX15",14,0)
 ;
"RTN","BSDX15",15,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX15",16,0)
 N BSDX1
"RTN","BSDX15",17,0)
 S BSDXI=0
"RTN","BSDX15",18,0)
 S X="ETRAP^BSDX15",@^%ZOSF("TRAP")
"RTN","BSDX15",19,0)
 S ^BSDXTMP($J,BSDXI)="I00020ACCESS_GROUP_TYPEID^I00020ACCESS_GROUP_ID^T00030ACCESS_GROUP^I00020ACCESS_TYPE_ID^T00030ACCESS_TYPE"_$C(30)
"RTN","BSDX15",20,0)
 ;
"RTN","BSDX15",21,0)
 ;N BSDX0,BSDX1,BSDXNOD,BSDXGPN,BSDXTN
"RTN","BSDX15",22,0)
 ;$O Through "B" x-ref of BSDX ACCESS GROUP file
"RTN","BSDX15",23,0)
 ;S BSDXGPN=0 F  S BSDXGPN=$O(^BSDXAGP("B",BSDXGPN)) Q:BSDXGPN=""  D
"RTN","BSDX15",24,0)
 ;. S BSDX0=$O(^BSDXAGP("B",BSDXGPN,0))
"RTN","BSDX15",25,0)
 ;. Q:'+BSDX0
"RTN","BSDX15",26,0)
 ;. Q:'$D(^BSDXAGP(BSDX0,0))  ;INDEX VALIDITY CHECK
"RTN","BSDX15",27,0)
 ;. Q:'$D(^BSDXAGTP("B",BSDX0))
"RTN","BSDX15",28,0)
 ;. ;$O through "B" x-ref of BSDX ACCESS GROUP TYPE
"RTN","BSDX15",29,0)
 ;. S BSDX1=0 F  S BSDX1=$O(^BSDXAGTP("B",BSDX0,BSDX1)) Q:'+BSDX1  D
"RTN","BSDX15",30,0)
 ;. . Q:'$D(^BSDXAGTP(BSDX1,0))
"RTN","BSDX15",31,0)
 ;. . S BSDX2=$P(^BSDXAGTP(BSDX1,0),U,2)
"RTN","BSDX15",32,0)
 ;. . Q:'+BSDX2
"RTN","BSDX15",33,0)
 ;. . Q:'$D(^BSDXTYPE(BSDX2,0))
"RTN","BSDX15",34,0)
 ;. . S BSDXNOD=^BSDXTYPE(BSDX2,0)
"RTN","BSDX15",35,0)
 ;. . Q:$P(BSDXNOD,U,2)=1  ;INACTIVE
"RTN","BSDX15",36,0)
 ;. . S BSDXTN=$P(BSDXNOD,U)
"RTN","BSDX15",37,0)
 ;. . S BSDXI=BSDXI+1
"RTN","BSDX15",38,0)
 ;. . S ^BSDXTMP($J,BSDXI)=BSDX1_U_BSDX0_U_BSDXGPN_U_BSDX2_U_BSDXTN_$C(30)
"RTN","BSDX15",39,0)
 ;. . Q
"RTN","BSDX15",40,0)
 ;. Q
"RTN","BSDX15",41,0)
 ;
"RTN","BSDX15",42,0)
 ;$O Through "AC" x-ref of BSDX ACCESS GROUP TYPE file
"RTN","BSDX15",43,0)
 N BSDXAGID,BSDXAGN,BSDXATID,BSDXATN,BSDXAGTID
"RTN","BSDX15",44,0)
 S BSDXAGID=0
"RTN","BSDX15",45,0)
 F  S BSDXAGID=$O(^BSDXAGTP("AC",BSDXAGID)) Q:'+BSDXAGID  D
"RTN","BSDX15",46,0)
 . I '$D(^BSDXAGP(BSDXAGID,0)) Q
"RTN","BSDX15",47,0)
 . S BSDXAGN=$P(^BSDXAGP(BSDXAGID,0),U)
"RTN","BSDX15",48,0)
 . S BSDXATID=0 F  S BSDXATID=$O(^BSDXAGTP("AC",BSDXAGID,BSDXATID)) Q:'+BSDXATID  D
"RTN","BSDX15",49,0)
 . . S BSDXNOD=$G(^BSDXTYPE(BSDXATID,0))
"RTN","BSDX15",50,0)
 . . I BSDXNOD="" Q
"RTN","BSDX15",51,0)
 . . I $P(BSDXNOD,U,2)=1 Q  ;Inactive
"RTN","BSDX15",52,0)
 . . S BSDXATN=$P(BSDXNOD,U)
"RTN","BSDX15",53,0)
 . . S BSDXAGTID=$O(^BSDXAGTP("AC",BSDXAGID,BSDXATID,0))
"RTN","BSDX15",54,0)
 . . I '+BSDXAGTID Q
"RTN","BSDX15",55,0)
 . . I '$D(^BSDXAGTP(BSDXAGTID,0)) Q
"RTN","BSDX15",56,0)
 . . S BSDXI=BSDXI+1
"RTN","BSDX15",57,0)
 . . S ^BSDXTMP($J,BSDXI)=BSDXAGTID_U_BSDXAGID_U_BSDXAGN_U_BSDXATID_U_BSDXATN_$C(30)
"RTN","BSDX15",58,0)
 . . Q
"RTN","BSDX15",59,0)
 . Q
"RTN","BSDX15",60,0)
 ;
"RTN","BSDX15",61,0)
 S BSDXI=BSDXI+1
"RTN","BSDX15",62,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX15",63,0)
 Q
"RTN","BSDX15",64,0)
 ;
"RTN","BSDX15",65,0)
ERR(BSDXI,BSDXID,BSDXERR) ;Error processing
"RTN","BSDX15",66,0)
 S BSDXI=BSDXI+1
"RTN","BSDX15",67,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERR_"^^^^"_$C(30)
"RTN","BSDX15",68,0)
 S BSDXI=BSDXI+1
"RTN","BSDX15",69,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX15",70,0)
 Q
"RTN","BSDX15",71,0)
 ;
"RTN","BSDX15",72,0)
ETRAP ;EP Error trap entry
"RTN","BSDX15",73,0)
 I '$D(BSDXI) N BSDXI S BSDXI=999
"RTN","BSDX15",74,0)
 S BSDXI=BSDXI+1
"RTN","BSDX15",75,0)
 D ERR(BSDXI,99,70)
"RTN","BSDX15",76,0)
 Q
"RTN","BSDX16")
0^14^B12093707
"RTN","BSDX16",1,0)
BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 4/28/11 10:20am
"RTN","BSDX16",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX16",3,0)
 ; Licensed under LGPL
"RTN","BSDX16",4,0)
 ;
"RTN","BSDX16",5,0)
 ;
"RTN","BSDX16",6,0)
RSRCD(BSDXY,BSDXVAL) ;EP
"RTN","BSDX16",7,0)
 ;Entry point for debugging
"RTN","BSDX16",8,0)
 ;
"RTN","BSDX16",9,0)
 ;D DEBUG^%Serenji("RSRC^BSDX16(.BSDXY,BSDXVAL)")
"RTN","BSDX16",10,0)
 Q
"RTN","BSDX16",11,0)
 ;
"RTN","BSDX16",12,0)
RSRC(BSDXY,BSDXVAL) ;EP
"RTN","BSDX16",13,0)
 ;
"RTN","BSDX16",14,0)
 ;Called by BSDX ADD/EDIT RESOURCE
"RTN","BSDX16",15,0)
 ;Add/Edit BSDX RESOURCE entry
"RTN","BSDX16",16,0)
 ;BSDXVAL is sResourceID|sResourceName|sInactive|sHospLocID|TIME_SCALE|LETTER_TEXT|NO_SHOW_LETTER|CANCELLATION_LETTER
"RTN","BSDX16",17,0)
 ;If IEN=0 Then this is a new Resource
"RTN","BSDX16",18,0)
 ;Test Line:
"RTN","BSDX16",19,0)
 ;D RSRC^BSDX16(.RES,"sResourceID|sResourceName|sInactive|sHospLocID")
"RTN","BSDX16",20,0)
 ;
"RTN","BSDX16",21,0)
 S X="ERROR^BSDX16",@^%ZOSF("TRAP")
"RTN","BSDX16",22,0)
 N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXINA,BSDXNOTE,BSDXNAM
"RTN","BSDX16",23,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX16",24,0)
 K ^BSDXTMP($J)
"RTN","BSDX16",25,0)
 S ^BSDXTMP($J,0)="I00020RESOURCEID^T00030ERRORTEXT"_$C(30)
"RTN","BSDX16",26,0)
 ; Changed following from a $G = "" to $D check: $G didn't work since BSDXVAL is an array. MJL 10/18/2006
"RTN","BSDX16",27,0)
 I BSDXVAL="",$D(BSDXVAL)<2 D ERR(0,"BSDX16: Invalid null input Parameter") Q
"RTN","BSDX16",28,0)
 ;Unpack array at @XWBARY
"RTN","BSDX16",29,0)
 I BSDXVAL="" D
"RTN","BSDX16",30,0)
 . N BSDXC S BSDXC=0 F  S BSDXC=$O(BSDXVAL(BSDXC)) Q:'BSDXC  D
"RTN","BSDX16",31,0)
 . . S BSDXVAL=BSDXVAL_BSDXVAL(BSDXC)
"RTN","BSDX16",32,0)
 S BSDXIEN=$P(BSDXVAL,"|")
"RTN","BSDX16",33,0)
 I +BSDXIEN D
"RTN","BSDX16",34,0)
 . S BSDX="EDIT"
"RTN","BSDX16",35,0)
 . S BSDXIENS=BSDXIEN_","
"RTN","BSDX16",36,0)
 E  D
"RTN","BSDX16",37,0)
 . S BSDX="ADD"
"RTN","BSDX16",38,0)
 . S BSDXIENS="+1,"
"RTN","BSDX16",39,0)
 ;
"RTN","BSDX16",40,0)
 S BSDXNAM=$P(BSDXVAL,"|",2)
"RTN","BSDX16",41,0)
 ;Prevent adding entry with duplicate name
"RTN","BSDX16",42,0)
 I $D(^BSDXRES("B",BSDXNAM)),$O(^BSDXRES("B",BSDXNAM,0))'=BSDXIEN D  Q
"RTN","BSDX16",43,0)
 . D ERR(0,"BSDX16: Cannot have two Resources with the same name.")
"RTN","BSDX16",44,0)
 . Q
"RTN","BSDX16",45,0)
 ;
"RTN","BSDX16",46,0)
 S BSDXINA=$P(BSDXVAL,"|",3)
"RTN","BSDX16",47,0)
 S BSDXINA=$S(BSDXINA="YES":1,1:0)
"RTN","BSDX16",48,0)
 ;
"RTN","BSDX16",49,0)
 S BSDXFDA(9002018.1,BSDXIENS,.01)=$P(BSDXVAL,"|",2) ;NAME
"RTN","BSDX16",50,0)
 S BSDXFDA(9002018.1,BSDXIENS,.02)=BSDXINA ;INACTIVE
"RTN","BSDX16",51,0)
 I +$P(BSDXVAL,"|",5) S BSDXFDA(9002018.1,BSDXIENS,.03)=+$P(BSDXVAL,"|",5) ;TIME SCALE
"RTN","BSDX16",52,0)
 I +$P(BSDXVAL,"|",4) S BSDXFDA(9002018.1,BSDXIENS,.04)=$P(BSDXVAL,"|",4) ;HOSPITAL LOCATION
"RTN","BSDX16",53,0)
 K BSDXMSG
"RTN","BSDX16",54,0)
 I BSDX="ADD" D  ;TODO: Check for error
"RTN","BSDX16",55,0)
 . K BSDXIEN
"RTN","BSDX16",56,0)
 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX16",57,0)
 . S BSDXIEN=+$G(BSDXIEN(1))
"RTN","BSDX16",58,0)
 E  D
"RTN","BSDX16",59,0)
 . D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX16",60,0)
 ;
"RTN","BSDX16",61,0)
 ;LETTER TEXT wp field
"RTN","BSDX16",62,0)
 S BSDXNOTE=$P(BSDXVAL,"|",6)
"RTN","BSDX16",63,0)
 ;
"RTN","BSDX16",64,0)
 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
"RTN","BSDX16",65,0)
 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
"RTN","BSDX16",66,0)
 ;
"RTN","BSDX16",67,0)
 I $D(BSDXNOTE(.5)) D
"RTN","BSDX16",68,0)
 . D WP^DIE(9002018.1,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
"RTN","BSDX16",69,0)
 ;
"RTN","BSDX16",70,0)
 ;NO SHOW LETTER wp fields
"RTN","BSDX16",71,0)
 K BSDXNOTE
"RTN","BSDX16",72,0)
 S BSDXNOTE=$P(BSDXVAL,"|",7)
"RTN","BSDX16",73,0)
 ;
"RTN","BSDX16",74,0)
 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
"RTN","BSDX16",75,0)
 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
"RTN","BSDX16",76,0)
 ;
"RTN","BSDX16",77,0)
 I $D(BSDXNOTE(.5)) D
"RTN","BSDX16",78,0)
 . D WP^DIE(9002018.1,BSDXIEN_",",1201,"","BSDXNOTE","BSDXMSG")
"RTN","BSDX16",79,0)
 ;
"RTN","BSDX16",80,0)
 ;CANCELLATION LETTER wp field
"RTN","BSDX16",81,0)
 K BSDXNOTE
"RTN","BSDX16",82,0)
 S BSDXNOTE=$P(BSDXVAL,"|",8)
"RTN","BSDX16",83,0)
 ;
"RTN","BSDX16",84,0)
 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
"RTN","BSDX16",85,0)
 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
"RTN","BSDX16",86,0)
 ;
"RTN","BSDX16",87,0)
 I $D(BSDXNOTE(.5)) D
"RTN","BSDX16",88,0)
 . D WP^DIE(9002018.1,BSDXIEN_",",1301,"","BSDXNOTE","BSDXMSG")
"RTN","BSDX16",89,0)
 ;
"RTN","BSDX16",90,0)
 S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^"_$C(30)_$C(31)
"RTN","BSDX16",91,0)
 Q
"RTN","BSDX16",92,0)
 ;
"RTN","BSDX16",93,0)
ERROR ;
"RTN","BSDX16",94,0)
 D ^%ZTER
"RTN","BSDX16",95,0)
 I '+$G(BSDXI) N BSDXI S BSDXI=999999
"RTN","BSDX16",96,0)
 S BSDXI=BSDXI+1
"RTN","BSDX16",97,0)
 D ERR(0,"BSDX16 M Error: <"_$G(%ZTERROR)_">")
"RTN","BSDX16",98,0)
 Q
"RTN","BSDX16",99,0)
 ;
"RTN","BSDX16",100,0)
ERR(BSDXERID,ERRTXT) ;Error processing
"RTN","BSDX16",101,0)
 S:'+$G(BSDXI) BSDXI=999999
"RTN","BSDX16",102,0)
 S BSDXI=BSDXI+1
"RTN","BSDX16",103,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
"RTN","BSDX16",104,0)
 S BSDXI=BSDXI+1
"RTN","BSDX16",105,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX16",106,0)
 Q
"RTN","BSDX17")
0^15^B2113933
"RTN","BSDX17",1,0)
BSDX17 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
"RTN","BSDX17",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX17",3,0)
 ; Licensed under LGPL
"RTN","BSDX17",4,0)
 ;
"RTN","BSDX17",5,0)
 ;
"RTN","BSDX17",6,0)
SCHUSRD(BSDXY) ;EP
"RTN","BSDX17",7,0)
 ;Entry point for debugging
"RTN","BSDX17",8,0)
 ;
"RTN","BSDX17",9,0)
 ;D DEBUG^%Serenji("SCHUSR^BSDX17(.BSDXY)")
"RTN","BSDX17",10,0)
 Q
"RTN","BSDX17",11,0)
 ;
"RTN","BSDX17",12,0)
SCHUSR(BSDXY) ;EP
"RTN","BSDX17",13,0)
 ;Return recordset of all users in NEW PERSON having BSDXZMENU key
"RTN","BSDX17",14,0)
 ;Called by BSDX SCHEDULE USER
"RTN","BSDX17",15,0)
 ;Test Line:
"RTN","BSDX17",16,0)
 ;D SCHUSR^BSDX17(.RES)
"RTN","BSDX17",17,0)
 ;
"RTN","BSDX17",18,0)
 N BSDXDUZ,BSDXKEY,BSDXI,BSDXNAM,BSDXKEYN
"RTN","BSDX17",19,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX17",20,0)
 K ^TEMP($J,"BSDX17")
"RTN","BSDX17",21,0)
 S BSDXI=0
"RTN","BSDX17",22,0)
 S ^BSDXTMP($J,0)="I00020USERID^T00030USERNAME"_$C(30)
"RTN","BSDX17",23,0)
 ;$O Through ^VA(200,"AB",
"RTN","BSDX17",24,0)
 F BSDXKEYN="BSDXZMENU","BSDXZMGR","XUPROGMODE" S BSDXKEY=+$O(^DIC(19.1,"B",BSDXKEYN,0)) D
"RTN","BSDX17",25,0)
 . Q:'+BSDXKEY  S BSDXDUZ=0 F  S BSDXDUZ=$O(^VA(200,"AB",BSDXKEY,BSDXDUZ)) Q:'+BSDXDUZ  D
"RTN","BSDX17",26,0)
 . . Q:BSDXDUZ<1  ;IHS/HMW **1**
"RTN","BSDX17",27,0)
 . . Q:'$D(^VA(200,BSDXDUZ,0))
"RTN","BSDX17",28,0)
 . . Q:$D(^TEMP($J,"BSDX17",BSDXDUZ))
"RTN","BSDX17",29,0)
 . . S BSDXNAM=$P(^VA(200,BSDXDUZ,0),U)
"RTN","BSDX17",30,0)
 . . S BSDXI=BSDXI+1
"RTN","BSDX17",31,0)
 . . S ^TEMP($J,"BSDX17",BSDXDUZ)=""
"RTN","BSDX17",32,0)
 . . S ^BSDXTMP($J,BSDXI)=BSDXDUZ_"^"_BSDXNAM_$C(30)
"RTN","BSDX17",33,0)
 . . Q
"RTN","BSDX17",34,0)
 . Q
"RTN","BSDX17",35,0)
 ;
"RTN","BSDX17",36,0)
 S BSDXI=BSDXI+1
"RTN","BSDX17",37,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX17",38,0)
 Q
"RTN","BSDX18")
0^16^B88409544
"RTN","BSDX18",1,0)
BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
"RTN","BSDX18",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX18",3,0)
 ; Licensed under LGPL
"RTN","BSDX18",4,0)
 ;
"RTN","BSDX18",5,0)
 ;
"RTN","BSDX18",6,0)
DELRUD(BSDXY,BSDXIEN) ;EP
"RTN","BSDX18",7,0)
 ;Entry point for debugging
"RTN","BSDX18",8,0)
 ;
"RTN","BSDX18",9,0)
 ;D DEBUG^%Serenji("DELRU^BSDX18(.BSDXY,BSDXIEN)")
"RTN","BSDX18",10,0)
 Q
"RTN","BSDX18",11,0)
 ;
"RTN","BSDX18",12,0)
DELRU(BSDXY,BSDXIEN) ;EP
"RTN","BSDX18",13,0)
 ;Deletes entry BSDXIEN from RESOURCE USERS file
"RTN","BSDX18",14,0)
 ;Return recordset containing error message or "" if no error
"RTN","BSDX18",15,0)
 ;Called by BSDX DELETE RESOURCEUSER
"RTN","BSDX18",16,0)
 ;Test Line:
"RTN","BSDX18",17,0)
 ;D DELRU^BSDX18(.RES,99)
"RTN","BSDX18",18,0)
 ;
"RTN","BSDX18",19,0)
 N BSDXI,DIK,DA
"RTN","BSDX18",20,0)
 S BSDXI=0
"RTN","BSDX18",21,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX18",22,0)
 S ^BSDXTMP($J,0)="I00020RESOURCEUSERID^I00020ERRORID"_$C(30)
"RTN","BSDX18",23,0)
 I '+BSDXIEN D ERR(BSDXI,BSDXIEN,70) Q
"RTN","BSDX18",24,0)
 I '$D(^BSDXRSU(BSDXIEN,0)) D ERR(BSDXI,BSDXIEN,70) Q
"RTN","BSDX18",25,0)
 ;Delete entry BSDXIEN
"RTN","BSDX18",26,0)
 S DIK="^BSDXRSU("
"RTN","BSDX18",27,0)
 S DA=BSDXIEN
"RTN","BSDX18",28,0)
 D ^DIK
"RTN","BSDX18",29,0)
 ;
"RTN","BSDX18",30,0)
 S BSDXI=BSDXI+1
"RTN","BSDX18",31,0)
 S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_"-1"_$C(30)_$C(31)
"RTN","BSDX18",32,0)
 Q
"RTN","BSDX18",33,0)
 ;
"RTN","BSDX18",34,0)
ADDRUD(BSDXY,BSDXVAL) ;EP
"RTN","BSDX18",35,0)
 ;Entry point for debugging
"RTN","BSDX18",36,0)
 ;
"RTN","BSDX18",37,0)
 ;D DEBUG^%Serenji("ADDRU^BSDX18(.BSDXY,BSDXVAL)")
"RTN","BSDX18",38,0)
 Q
"RTN","BSDX18",39,0)
 ;
"RTN","BSDX18",40,0)
ADDRU(BSDXY,BSDXVAL) ;EP
"RTN","BSDX18",41,0)
 ;
"RTN","BSDX18",42,0)
 ;Called by BSDX ADD/EDIT RESOURCEUSER
"RTN","BSDX18",43,0)
 ;Add/Edit BSDX RESOURCEUSER entry
"RTN","BSDX18",44,0)
 ;BSDXVAL is sResourceUserID|sOverbook|sModifySchedule|ResourceID|UserID|sModifyAppointments
"RTN","BSDX18",45,0)
 ;If IEN=0 Then this is a new ResourceUser entry
"RTN","BSDX18",46,0)
 ;Test Line:
"RTN","BSDX18",47,0)
 ;D ADDRU^BSDX18(.RES,"sResourceUserID|sOverbook|sModifySchedule|sResourceID|sUserID|sModifyAppointments")
"RTN","BSDX18",48,0)
 ;
"RTN","BSDX18",49,0)
 N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXOVB,BSDXMOD,BSDXI,BSDXUID,BSDXRID
"RTN","BSDX18",50,0)
 N BSDXRES,BSDXRSU,BSDXF,BSDXAPPT
"RTN","BSDX18",51,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX18",52,0)
 S BSDXI=0
"RTN","BSDX18",53,0)
 S ^BSDXTMP($J,BSDXI)="I00020RESOURCEID^I00020ERRORID"_$C(30)
"RTN","BSDX18",54,0)
 S BSDXIEN=$P(BSDXVAL,"|")
"RTN","BSDX18",55,0)
 I +BSDXIEN D
"RTN","BSDX18",56,0)
 . S BSDX="EDIT"
"RTN","BSDX18",57,0)
 . S BSDXIENS=BSDXIEN_","
"RTN","BSDX18",58,0)
 E  D
"RTN","BSDX18",59,0)
 . S BSDX="ADD"
"RTN","BSDX18",60,0)
 . S BSDXIENS="+1,"
"RTN","BSDX18",61,0)
 ;
"RTN","BSDX18",62,0)
 I '+$P(BSDXVAL,"|",4) D ERR(BSDXI,BSDXIEN,70) Q
"RTN","BSDX18",63,0)
 I '+$P(BSDXVAL,"|",5) D ERR(BSDXI,BSDXIEN,70) Q
"RTN","BSDX18",64,0)
 ;
"RTN","BSDX18",65,0)
 S BSDXRID=$P(BSDXVAL,"|",4) ;ResourceID
"RTN","BSDX18",66,0)
 S BSDXUID=$P(BSDXVAL,"|",5) ;UserID
"RTN","BSDX18",67,0)
 S BSDXRSU=0 ;ResourceUserID
"RTN","BSDX18",68,0)
 S BSDXF=0 ;flag
"RTN","BSDX18",69,0)
 ;If this is an add, check if the user is already assigned to the resource.
"RTN","BSDX18",70,0)
 ;If so, then change to an edit
"RTN","BSDX18",71,0)
 I BSDX="ADD" F  S BSDXRSU=$O(^BSDXRSU("AC",BSDXUID,BSDXRSU)) Q:'+BSDXRSU  D  Q:BSDXF
"RTN","BSDX18",72,0)
 . S BSDXRES=$G(^BSDXRSU(BSDXRSU,0))
"RTN","BSDX18",73,0)
 . S BSDXRES=$P(BSDXRES,U) ;ResourceID
"RTN","BSDX18",74,0)
 . S:BSDXRES=BSDXRID BSDXF=1
"RTN","BSDX18",75,0)
 I BSDXF S BSDX="EDIT",BSDXIEN=BSDXRSU,BSDXIENS=BSDXIEN_","
"RTN","BSDX18",76,0)
 ;
"RTN","BSDX18",77,0)
 S BSDXOVB=$P(BSDXVAL,"|",2)
"RTN","BSDX18",78,0)
 S BSDXOVB=$S(BSDXOVB="YES":1,1:0)
"RTN","BSDX18",79,0)
 S BSDXMOD=$P(BSDXVAL,"|",3)
"RTN","BSDX18",80,0)
 S BSDXMOD=$S(BSDXMOD="YES":1,1:0)
"RTN","BSDX18",81,0)
 S BSDXAPPT=$P(BSDXVAL,"|",6)
"RTN","BSDX18",82,0)
 S BSDXAPPT=$S(BSDXAPPT="YES":1,1:0)
"RTN","BSDX18",83,0)
 ;
"RTN","BSDX18",84,0)
 S BSDXFDA(9002018.15,BSDXIENS,.01)=$P(BSDXVAL,"|",4) ;RESOURCE ID
"RTN","BSDX18",85,0)
 S BSDXFDA(9002018.15,BSDXIENS,.02)=$P(BSDXVAL,"|",5) ;USERID
"RTN","BSDX18",86,0)
 S BSDXFDA(9002018.15,BSDXIENS,.03)=BSDXOVB ;OVERBOOK
"RTN","BSDX18",87,0)
 S BSDXFDA(9002018.15,BSDXIENS,.04)=BSDXMOD ;MODIFY SCHEDULE
"RTN","BSDX18",88,0)
 S BSDXFDA(9002018.15,BSDXIENS,.05)=BSDXAPPT ;ADD, EDIT, DELETE APPOINMENTS
"RTN","BSDX18",89,0)
 K BSDXMSG
"RTN","BSDX18",90,0)
 I BSDX="ADD" D
"RTN","BSDX18",91,0)
 . K BSDXIEN
"RTN","BSDX18",92,0)
 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX18",93,0)
 . S BSDXIEN=+$G(BSDXIEN(1))
"RTN","BSDX18",94,0)
 E  D
"RTN","BSDX18",95,0)
 . D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX18",96,0)
 S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^-1"_$C(31)
"RTN","BSDX18",97,0)
 Q
"RTN","BSDX18",98,0)
 ;
"RTN","BSDX18",99,0)
ERR(BSDXI,BSDXID,BSDXERR) ;Error processing
"RTN","BSDX18",100,0)
 S BSDXERR=BSDXERR+134234112 ;vbObjectError
"RTN","BSDX18",101,0)
 S BSDXI=BSDXI+1
"RTN","BSDX18",102,0)
 S ^BSDXTMP($J,BSDXI)=BSDXID_"^"_BSDXERR_$C(30)
"RTN","BSDX18",103,0)
 S BSDXI=BSDXI+1
"RTN","BSDX18",104,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX18",105,0)
 Q
"RTN","BSDX18",106,0)
 ;
"RTN","BSDX18",107,0)
MADERR(BSDXMSG) ;
"RTN","BSDX18",108,0)
 W !,BSDXMSG
"RTN","BSDX18",109,0)
 Q
"RTN","BSDX18",110,0)
 ;
"RTN","BSDX18",111,0)
MADSCR(BSDXDUZ,BSDXZMGR,BSDXZMENU,BSDXZPROG) ;EP - File 200 screening code for MADDRU
"RTN","BSDX18",112,0)
 ;Called from DIR to screen for scheduling users
"RTN","BSDX18",113,0)
 I $D(^VA(200,BSDXDUZ,51,"B",BSDXZMENU)) Q 1
"RTN","BSDX18",114,0)
 I $D(^VA(200,BSDXDUZ,51,"B",BSDXZMGR)) Q 1
"RTN","BSDX18",115,0)
 I $D(^VA(200,BSDXDUZ,51,"B",BSDXZPROG)) Q 1
"RTN","BSDX18",116,0)
 Q 0
"RTN","BSDX18",117,0)
 ;
"RTN","BSDX18",118,0)
MADDRU ;EP -Command line utility to bulk-add users and set access rights IHS/HMW 20060420 **1**
"RTN","BSDX18",119,0)
 ;Main entry point
"RTN","BSDX18",120,0)
 ;
"RTN","BSDX18",121,0)
 N BSDX,BSDXZMENU,BSDXZMGR,BSDXZPROG,DIR
"RTN","BSDX18",122,0)
 ;
"RTN","BSDX18",123,0)
 ;INIT
"RTN","BSDX18",124,0)
 K ^TMP($J)
"RTN","BSDX18",125,0)
 S BSDXZMENU=$O(^DIC(19.1,"B","BSDXZMENU",0)) I '+BSDXZMENU D MADERR("Error: BSDXZMENU KEY NOT FOUND.") Q
"RTN","BSDX18",126,0)
 S BSDXZMGR=$O(^DIC(19.1,"B","BSDXZMGR",0)) I '+BSDXZMGR D MADERR("Error: BSDXZMGR KEY NOT FOUND.") Q
"RTN","BSDX18",127,0)
 S BSDXZPROG=$O(^DIC(19.1,"B","XUPROGMODE",0)) I '+BSDXZPROG D MADERR("Error: XUPROGMODE KEY NOT FOUND.") Q
"RTN","BSDX18",128,0)
 ;
"RTN","BSDX18",129,0)
 D MADUSR
"RTN","BSDX18",130,0)
 I '$D(^TMP($J,"BSDX MADDRU","USER")) D MADERR("Cancelled:  No Users selected.") Q
"RTN","BSDX18",131,0)
 D MADRES
"RTN","BSDX18",132,0)
 I '$D(^TMP($J,"BSDX MADDRU","RESOURCE")) D MADERR("Cancelled:  No Resources selected.") Q
"RTN","BSDX18",133,0)
 I '$$MADACC(.BSDX) ;D MADERR("Selected users will have no access to the selected clinics.")
"RTN","BSDX18",134,0)
 I '$$MADCONF(.BSDX) W ! D MADERR("--Cancelled") Q
"RTN","BSDX18",135,0)
 D MADASS(.BSDX)
"RTN","BSDX18",136,0)
 W ! D MADERR("--Done")
"RTN","BSDX18",137,0)
 ;
"RTN","BSDX18",138,0)
 Q
"RTN","BSDX18",139,0)
 ;
"RTN","BSDX18",140,0)
MADUSR ;Prompt for users from file 200 who have BSDXUSER key
"RTN","BSDX18",141,0)
 ;Store results in ^TMP($J,"BSDX MADDRU","USER",DUZ) array
"RTN","BSDX18",142,0)
 N DIRUT,Y,DIR
"RTN","BSDX18",143,0)
 S DIR(0)="PO^200:EMZ",DIR("S")="I $$MADSCR^BSDX18(Y,BSDXZMGR,BSDXZMENU,BSDXZPROG)"
"RTN","BSDX18",144,0)
 S Y=0
"RTN","BSDX18",145,0)
 K ^TMP($J,"BSDX MADDRU","USER")
"RTN","BSDX18",146,0)
 W !!,"-------Select Users-------"
"RTN","BSDX18",147,0)
 F  D ^DIR Q:$G(DIRUT)  Q:'Y  D
"RTN","BSDX18",148,0)
 . S ^TMP($J,"BSDX MADDRU","USER",+Y)=""
"RTN","BSDX18",149,0)
 Q
"RTN","BSDX18",150,0)
 ;
"RTN","BSDX18",151,0)
MADRES ;Prompt for Resources
"RTN","BSDX18",152,0)
 ;Store results in ^TMP($J,"BSDX MADDRU","RESOURCE",ResourceID) array
"RTN","BSDX18",153,0)
 N DIRUT,Y,DIR
"RTN","BSDX18",154,0)
 S DIR(0)="PO^9002018.1:EMZ"
"RTN","BSDX18",155,0)
 S Y=0
"RTN","BSDX18",156,0)
 K ^TMP($J,"BSDX MADDRU","RESOURCE")
"RTN","BSDX18",157,0)
 W !!,"-------Select Resources-------"
"RTN","BSDX18",158,0)
 F  D ^DIR Q:$G(DIRUT)  Q:'Y  D
"RTN","BSDX18",159,0)
 . S ^TMP($J,"BSDX MADDRU","RESOURCE",+Y)=""
"RTN","BSDX18",160,0)
 Q
"RTN","BSDX18",161,0)
 ;
"RTN","BSDX18",162,0)
MADACC(BSDX) ;Prompt for access level.
"RTN","BSDX18",163,0)
 ;Start with Overbook and go to read-only access.
"RTN","BSDX18",164,0)
 ;Store results in variables for:
"RTN","BSDX18",165,0)
 ;sOverbook, sModifySchedule, sModifyAppointments
"RTN","BSDX18",166,0)
 ;
"RTN","BSDX18",167,0)
 N DIRUT,Y,DIR,J
"RTN","BSDX18",168,0)
 W !!,"-------Select Access Level-------"
"RTN","BSDX18",169,0)
 S Y=0
"RTN","BSDX18",170,0)
 F J="MODIFY","OVERBOOK","WRITE","READ" S BSDX(J)=1
"RTN","BSDX18",171,0)
 S DIR(0)="Y"
"RTN","BSDX18",172,0)
 ;
"RTN","BSDX18",173,0)
 S DIR("A")="Allow users to Modify Clinic Availability"
"RTN","BSDX18",174,0)
 D ^DIR
"RTN","BSDX18",175,0)
 Q:$G(DIRUT) 0
"RTN","BSDX18",176,0)
 Q:Y 1
"RTN","BSDX18",177,0)
 S BSDX("MODIFY")=0
"RTN","BSDX18",178,0)
 ;
"RTN","BSDX18",179,0)
 S DIR("A")="Allow users to Overbook the selected clinics"
"RTN","BSDX18",180,0)
 D ^DIR
"RTN","BSDX18",181,0)
 Q:$G(DIRUT) 0
"RTN","BSDX18",182,0)
 Q:Y 1
"RTN","BSDX18",183,0)
 S BSDX("OVERBOOK")=0
"RTN","BSDX18",184,0)
 ;
"RTN","BSDX18",185,0)
 S DIR("A")="Allow users to Add, Edit and Delete appointments in the selected resources"
"RTN","BSDX18",186,0)
 D ^DIR
"RTN","BSDX18",187,0)
 Q:$G(DIRUT)
"RTN","BSDX18",188,0)
 Q:Y 1
"RTN","BSDX18",189,0)
 S BSDX("WRITE")=0
"RTN","BSDX18",190,0)
 ;
"RTN","BSDX18",191,0)
 S DIR("A")="Allow users to View appointments in the selected resources"
"RTN","BSDX18",192,0)
 D ^DIR
"RTN","BSDX18",193,0)
 Q:$G(DIRUT)
"RTN","BSDX18",194,0)
 Q:Y 1
"RTN","BSDX18",195,0)
 S BSDX("READ")=0
"RTN","BSDX18",196,0)
 ;
"RTN","BSDX18",197,0)
 Q 0
"RTN","BSDX18",198,0)
 ;
"RTN","BSDX18",199,0)
MADCONF(BSDX) ;Confirm selections
"RTN","BSDX18",200,0)
 N DIR,DIRUT,Y
"RTN","BSDX18",201,0)
 S DIR(0)="Y"
"RTN","BSDX18",202,0)
 W !!,"-------Confirm Selections-------"
"RTN","BSDX18",203,0)
 I BSDX("READ")=0 D
"RTN","BSDX18",204,0)
 . S DIR("A")="Are you sure you want to remove all access to these clinics for these users"
"RTN","BSDX18",205,0)
 E  D
"RTN","BSDX18",206,0)
 . W !,"Selected users will be assigned the following access:"
"RTN","BSDX18",207,0)
 . W !,"Modify clinic availability:  ",?50,BSDX("MODIFY")
"RTN","BSDX18",208,0)
 . W !,"Overbook Appointments:  ",?50,BSDX("OVERBOOK")
"RTN","BSDX18",209,0)
 . W !,"Add, Edit and Delete Appointments:  ",?50,BSDX("WRITE")
"RTN","BSDX18",210,0)
 . W !,"View Clinic Appointments:  ",?50,BSDX("READ")
"RTN","BSDX18",211,0)
 . S DIR("A")="Are you sure you want to assign these access rights to the selected users"
"RTN","BSDX18",212,0)
 D ^DIR
"RTN","BSDX18",213,0)
 Q:$G(DIRUT) 0
"RTN","BSDX18",214,0)
 Q:$G(Y) 1
"RTN","BSDX18",215,0)
 Q 0
"RTN","BSDX18",216,0)
 ;
"RTN","BSDX18",217,0)
MADASS(BSDX) ;
"RTN","BSDX18",218,0)
 ;Assign access level to selected users and resources
"RTN","BSDX18",219,0)
 ;Loop through selected users
"RTN","BSDX18",220,0)
 ;. Loop through selected resources
"RTN","BSDX18",221,0)
 ; . . If an entry in ^BSDXRSU for this user/resource combination exists, then
"RTN","BSDX18",222,0)
 ; . . . S sResourceUserID = to it
"RTN","BSDX18",223,0)
 ; . . Else
"RTN","BSDX18",224,0)
 ; . . . S sResourceUserID = 0
"RTN","BSDX18",225,0)
 ; . . Call MADFILE
"RTN","BSDX18",226,0)
 N BSDXU,BSDXR,BSDXRUID,BSDXVAL
"RTN","BSDX18",227,0)
 S BSDXU=0
"RTN","BSDX18",228,0)
 F  S BSDXU=$O(^TMP($J,"BSDX MADDRU","USER",BSDXU)) Q:'+BSDXU  D
"RTN","BSDX18",229,0)
 . S BSDXR=0 F  S BSDXR=$O(^TMP($J,"BSDX MADDRU","RESOURCE",BSDXR)) Q:'+BSDXR  D
"RTN","BSDX18",230,0)
 . . S BSDXRUID=$$MADEXST(BSDXU,BSDXR)
"RTN","BSDX18",231,0)
 . . S BSDXVAL=BSDXRUID_"|"_BSDX("OVERBOOK")_"|"_BSDX("MODIFY")_"|"_BSDXR_"|"_BSDXU_"|"_BSDX("WRITE")
"RTN","BSDX18",232,0)
 . . I +BSDXRUID,BSDX("READ")=0 D MADDEL(BSDXRUID)
"RTN","BSDX18",233,0)
 . . Q:BSDX("READ")=0
"RTN","BSDX18",234,0)
 . . D MADFILE(BSDXVAL)
"RTN","BSDX18",235,0)
 . . Q
"RTN","BSDX18",236,0)
 . Q
"RTN","BSDX18",237,0)
 Q
"RTN","BSDX18",238,0)
 ;
"RTN","BSDX18",239,0)
MADDEL(BSDXRUID) ;
"RTN","BSDX18",240,0)
 ;Delete entry BSDXRUID from BSDX RESOURCE USER file
"RTN","BSDX18",241,0)
 N DIK,DA
"RTN","BSDX18",242,0)
 Q:'+BSDXRUID
"RTN","BSDX18",243,0)
 Q:'$D(^BSDXRSU(BSDXRUID))
"RTN","BSDX18",244,0)
 S DIK="^BSDXRSU("
"RTN","BSDX18",245,0)
 S DA=BSDXRUID
"RTN","BSDX18",246,0)
 D ^DIK
"RTN","BSDX18",247,0)
 Q
"RTN","BSDX18",248,0)
 ;
"RTN","BSDX18",249,0)
MADFILE(BSDXVAL) ;
"RTN","BSDX18",250,0)
 ;
"RTN","BSDX18",251,0)
 ;Add/Edit BSDX RESOURCEUSER entry
"RTN","BSDX18",252,0)
 ;BSDXVAL is sResourceUserID|sOverbook|sModifySchedule|ResourceID|UserID|sModifyAppointments
"RTN","BSDX18",253,0)
 ;If sResourceUserID=0 Then this is a new ResourceUser entry
"RTN","BSDX18",254,0)
 ;
"RTN","BSDX18",255,0)
 N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXOVB,BSDXMOD,BSDXI,BSDXUID,BSDXRID
"RTN","BSDX18",256,0)
 N BSDXRES,BSDXRSU,BSDXF,BSDXAPPT
"RTN","BSDX18",257,0)
 S BSDXIEN=$P(BSDXVAL,"|")
"RTN","BSDX18",258,0)
 I +BSDXIEN D
"RTN","BSDX18",259,0)
 . S BSDX="EDIT"
"RTN","BSDX18",260,0)
 . S BSDXIENS=BSDXIEN_","
"RTN","BSDX18",261,0)
 E  D
"RTN","BSDX18",262,0)
 . S BSDX="ADD"
"RTN","BSDX18",263,0)
 . S BSDXIENS="+1,"
"RTN","BSDX18",264,0)
 ;
"RTN","BSDX18",265,0)
 I '+$P(BSDXVAL,"|",4) D MADERR("Error in MADFILE^BSDX18: No Resource ID") Q
"RTN","BSDX18",266,0)
 I '+$P(BSDXVAL,"|",5) D MADERR("Error in MADFILE^BSDX18: No User ID") Q
"RTN","BSDX18",267,0)
 ;
"RTN","BSDX18",268,0)
 S BSDXRID=$P(BSDXVAL,"|",4) ;ResourceID
"RTN","BSDX18",269,0)
 S BSDXUID=$P(BSDXVAL,"|",5) ;UserID
"RTN","BSDX18",270,0)
 S BSDXRSU=0 ;ResourceUserID
"RTN","BSDX18",271,0)
 S BSDXF=0 ;flag
"RTN","BSDX18",272,0)
 ;If this is an add, check if the user is already assigned to the resource.
"RTN","BSDX18",273,0)
 ;If so, then change to an edit
"RTN","BSDX18",274,0)
 I BSDX="ADD" F  S BSDXRSU=$O(^BSDXRSU("AC",BSDXUID,BSDXRSU)) Q:'+BSDXRSU  D  Q:BSDXF
"RTN","BSDX18",275,0)
 . S BSDXRES=$G(^BSDXRSU(BSDXRSU,0))
"RTN","BSDX18",276,0)
 . S BSDXRES=$P(BSDXRES,U) ;ResourceID
"RTN","BSDX18",277,0)
 . S:BSDXRES=BSDXRID BSDXF=1
"RTN","BSDX18",278,0)
 I BSDXF S BSDX="EDIT",BSDXIEN=BSDXRSU,BSDXIENS=BSDXIEN_","
"RTN","BSDX18",279,0)
 ;
"RTN","BSDX18",280,0)
 S BSDXOVB=$P(BSDXVAL,"|",2)
"RTN","BSDX18",281,0)
 S BSDXMOD=$P(BSDXVAL,"|",3)
"RTN","BSDX18",282,0)
 S BSDXAPPT=$P(BSDXVAL,"|",6)
"RTN","BSDX18",283,0)
 ;
"RTN","BSDX18",284,0)
 S BSDXFDA(9002018.15,BSDXIENS,.01)=$P(BSDXVAL,"|",4) ;RESOURCE ID
"RTN","BSDX18",285,0)
 S BSDXFDA(9002018.15,BSDXIENS,.02)=$P(BSDXVAL,"|",5) ;USERID
"RTN","BSDX18",286,0)
 S BSDXFDA(9002018.15,BSDXIENS,.03)=BSDXOVB ;OVERBOOK
"RTN","BSDX18",287,0)
 S BSDXFDA(9002018.15,BSDXIENS,.04)=BSDXMOD ;MODIFY SCHEDULE
"RTN","BSDX18",288,0)
 S BSDXFDA(9002018.15,BSDXIENS,.05)=BSDXAPPT ;ADD, EDIT, DELETE APPOINMENTS
"RTN","BSDX18",289,0)
 K BSDXMSG
"RTN","BSDX18",290,0)
 I BSDX="ADD" D
"RTN","BSDX18",291,0)
 . K BSDXIEN
"RTN","BSDX18",292,0)
 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX18",293,0)
 . S BSDXIEN=+$G(BSDXIEN(1))
"RTN","BSDX18",294,0)
 E  D
"RTN","BSDX18",295,0)
 . D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX18",296,0)
 Q
"RTN","BSDX18",297,0)
 ;
"RTN","BSDX18",298,0)
MADEXST(BSDXU,BSDXR) ;
"RTN","BSDX18",299,0)
 ;Returns BSDX RESOURCE USER ID
"RTN","BSDX18",300,0)
 ;if there is a BSDX RESOURCE USER entry for
"RTN","BSDX18",301,0)
 ;user BSDXU and resource BSDXR
"RTN","BSDX18",302,0)
 ;Otherwise, returns 0
"RTN","BSDX18",303,0)
 ;
"RTN","BSDX18",304,0)
 N BSDXID,BSDXFOUND,BSDXNOD
"RTN","BSDX18",305,0)
 I '$D(^BSDXRSU("AC",BSDXU)) Q 0
"RTN","BSDX18",306,0)
 S BSDXID=0,BSDXFOUND=0
"RTN","BSDX18",307,0)
 F  S BSDXID=$O(^BSDXRSU("AC",BSDXU,BSDXID)) Q:'+BSDXID  D  Q:BSDXFOUND
"RTN","BSDX18",308,0)
 . S BSDXNOD=$G(^BSDXRSU(BSDXID,0))
"RTN","BSDX18",309,0)
 . I +BSDXNOD=BSDXR S BSDXFOUND=BSDXID
"RTN","BSDX18",310,0)
 . Q
"RTN","BSDX18",311,0)
 Q BSDXFOUND
"RTN","BSDX19")
0^17^B7998622
"RTN","BSDX19",1,0)
BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
"RTN","BSDX19",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX19",3,0)
 ; Licensed under LGPL
"RTN","BSDX19",4,0)
 ;
"RTN","BSDX19",5,0)
 ;
"RTN","BSDX19",6,0)
ADDRGD(BSDXY,BSDXVAL) ;EP
"RTN","BSDX19",7,0)
 ;Entry point for debugging
"RTN","BSDX19",8,0)
 ;
"RTN","BSDX19",9,0)
 ;D DEBUG^%Serenji("ADDRG^BSDX19(.BSDXY,BSDXVAL)")
"RTN","BSDX19",10,0)
 Q
"RTN","BSDX19",11,0)
 ;
"RTN","BSDX19",12,0)
ADDRG(BSDXY,BSDXVAL) ;EP
"RTN","BSDX19",13,0)
 ;Called by BSDX ADD/EDIT RESOURCE GROUP
"RTN","BSDX19",14,0)
 ;Add a new BSDX RESOURCE GROUP entry
"RTN","BSDX19",15,0)
 ;BSDXVAL is IEN|NAME of the entry
"RTN","BSDX19",16,0)
 ;Returns IEN of added/edited entry or 0 if error
"RTN","BSDX19",17,0)
 ;
"RTN","BSDX19",18,0)
 S X="ERROR^BSDX19",@^%ZOSF("TRAP")
"RTN","BSDX19",19,0)
 N BSDXIENS,BSDXFDA,BSDXMSG,BSDXIEN,BSDX,BSDXNAM
"RTN","BSDX19",20,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX19",21,0)
 S ^BSDXTMP($J,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$C(30)
"RTN","BSDX19",22,0)
 I BSDXVAL="" D ERR(0,"BSDX16: Invalid null input Parameter") Q
"RTN","BSDX19",23,0)
 S BSDXIEN=$P(BSDXVAL,"|")
"RTN","BSDX19",24,0)
 S BSDXNAM=$P(BSDXVAL,"|",2)
"RTN","BSDX19",25,0)
 I +BSDXIEN D
"RTN","BSDX19",26,0)
 . S BSDX="EDIT"
"RTN","BSDX19",27,0)
 . S BSDXIENS=BSDXIEN_","
"RTN","BSDX19",28,0)
 E  D
"RTN","BSDX19",29,0)
 . S BSDX="ADD"
"RTN","BSDX19",30,0)
 . S BSDXIENS="+1,"
"RTN","BSDX19",31,0)
 ;
"RTN","BSDX19",32,0)
 ;Prevent adding entry with duplicate name
"RTN","BSDX19",33,0)
 I $D(^BSDXDEPT("B",BSDXNAM)),$O(^BSDXDEPT("B",BSDXNAM,0))'=BSDXIEN D  Q
"RTN","BSDX19",34,0)
 . D ERR(0,"BSDX19: Cannot have two Resource Groups with the same name.")
"RTN","BSDX19",35,0)
 . Q
"RTN","BSDX19",36,0)
 ;
"RTN","BSDX19",37,0)
 S BSDXFDA(9002018.2,BSDXIENS,.01)=BSDXNAM ;NAME
"RTN","BSDX19",38,0)
 I BSDX="ADD" D
"RTN","BSDX19",39,0)
 . K BSDXIEN
"RTN","BSDX19",40,0)
 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX19",41,0)
 . S BSDXIEN=+$G(BSDXIEN(1))
"RTN","BSDX19",42,0)
 E  D
"RTN","BSDX19",43,0)
 . D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX19",44,0)
 S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^"_$C(30)_$C(31)
"RTN","BSDX19",45,0)
 Q
"RTN","BSDX19",46,0)
 ;
"RTN","BSDX19",47,0)
DELRGD(BSDXY,BSDXGRP) ;EP
"RTN","BSDX19",48,0)
 ;Entry point for debugging
"RTN","BSDX19",49,0)
 ;
"RTN","BSDX19",50,0)
 ;D DEBUG^%Serenji("DELRG^BSDX19(.BSDXY,BSDXGRP)")
"RTN","BSDX19",51,0)
 Q
"RTN","BSDX19",52,0)
 ;
"RTN","BSDX19",53,0)
DELRG(BSDXY,BSDXGRP) ;EP
"RTN","BSDX19",54,0)
 ;Deletes entry name BSDXGRP from BSDX RESOURCE GROUP file
"RTN","BSDX19",55,0)
 ;Return recordset containing error message or "" if no error
"RTN","BSDX19",56,0)
 ;Called by BSDX DELETE RESOURCE GROUP
"RTN","BSDX19",57,0)
 ;Test Line:
"RTN","BSDX19",58,0)
 ;D DELRU^BSDX18(.RES,99)
"RTN","BSDX19",59,0)
 ;
"RTN","BSDX19",60,0)
 N BSDXI,DIK,DA,BSDXIEN
"RTN","BSDX19",61,0)
 S BSDXI=0
"RTN","BSDX19",62,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX19",63,0)
 S ^BSDXTMP($J,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$C(30)
"RTN","BSDX19",64,0)
 I BSDXGRP="" D ERR(0,"DELRG~BSDX19: Invalid null Resource Group Name") Q
"RTN","BSDX19",65,0)
 S BSDXIEN=$O(^BSDXDEPT("B",BSDXGRP,0))
"RTN","BSDX19",66,0)
 I '+BSDXIEN D ERR(0,"DELRG~BSDX19: Invalid Resource Group Name") Q
"RTN","BSDX19",67,0)
 I '$D(^BSDXDEPT(BSDXIEN,0)) D ERR(0,"DELRG~BSDX19: Invalid Resource Group IEN") Q
"RTN","BSDX19",68,0)
 ;Delete entry BSDXIEN
"RTN","BSDX19",69,0)
 S DIK="^BSDXDEPT("
"RTN","BSDX19",70,0)
 S DA=BSDXIEN
"RTN","BSDX19",71,0)
 D ^DIK
"RTN","BSDX19",72,0)
 ;
"RTN","BSDX19",73,0)
 S BSDXI=BSDXI+1
"RTN","BSDX19",74,0)
 S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_$C(30)_$C(31)
"RTN","BSDX19",75,0)
 Q
"RTN","BSDX19",76,0)
 ;
"RTN","BSDX19",77,0)
ERR(BSDXERID,ERRTXT) ;Error processing
"RTN","BSDX19",78,0)
 S:'+$G(BSDXI) BSDXI=999999
"RTN","BSDX19",79,0)
 S BSDXI=BSDXI+1
"RTN","BSDX19",80,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
"RTN","BSDX19",81,0)
 S BSDXI=BSDXI+1
"RTN","BSDX19",82,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX19",83,0)
 Q
"RTN","BSDX19",84,0)
 ;
"RTN","BSDX19",85,0)
ERROR ;
"RTN","BSDX19",86,0)
 D ^%ZTER
"RTN","BSDX19",87,0)
 I '+$G(BSDXI) N BSDXI S BSDXI=999999
"RTN","BSDX19",88,0)
 S BSDXI=BSDXI+1
"RTN","BSDX19",89,0)
 D ERR(0,"BSDX19 M Error: <"_$G(%ZTERROR)_">")
"RTN","BSDX19",90,0)
 Q
"RTN","BSDX20")
0^18^B5998854
"RTN","BSDX20",1,0)
BSDX20 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
"RTN","BSDX20",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX20",3,0)
 ; Licensed under LGPL
"RTN","BSDX20",4,0)
 ;
"RTN","BSDX20",5,0)
 ;
"RTN","BSDX20",6,0)
DELRGID(BSDXY,BSDXIEN) ;EP
"RTN","BSDX20",7,0)
 ;Entry point for debugging
"RTN","BSDX20",8,0)
 ;
"RTN","BSDX20",9,0)
 ;D DEBUG^%Serenji("DELRGI^BSDX20(.BSDXY,BSDXIEN)")
"RTN","BSDX20",10,0)
 Q
"RTN","BSDX20",11,0)
 ;
"RTN","BSDX20",12,0)
DELRGI(BSDXY,BSDXIEN,BSDXIEN1) ;EP
"RTN","BSDX20",13,0)
 ;Deletes entry BSDXIEN1 from entry BSDXIEN in the RESOURCE GROUP file
"RTN","BSDX20",14,0)
 ;Return recordset containing error message or "" if no error
"RTN","BSDX20",15,0)
 ;Called by BSDX DELETE RES GROUP ITEM
"RTN","BSDX20",16,0)
 ;Test Line:
"RTN","BSDX20",17,0)
 ;D DELRU^BSDX18(.RES,99)
"RTN","BSDX20",18,0)
 ;
"RTN","BSDX20",19,0)
 N BSDXI,DIK,DA
"RTN","BSDX20",20,0)
 S BSDXI=0
"RTN","BSDX20",21,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX20",22,0)
 S ^BSDXTMP($J,0)="I00020RESOURCEGROUPID^I00020ERRORID"_$C(30)
"RTN","BSDX20",23,0)
 I '+BSDXIEN D ERR(BSDXI,BSDXIEN,70) Q
"RTN","BSDX20",24,0)
 I '+BSDXIEN1 D ERR(BSDXI,BSDXIEN,70) Q
"RTN","BSDX20",25,0)
 I '$D(^BSDXDEPT(BSDXIEN,1,BSDXIEN1,0)) D ERR(BSDXI,BSDXIEN,70) Q
"RTN","BSDX20",26,0)
 ;
"RTN","BSDX20",27,0)
 ;Delete entry BSDXIEN1
"RTN","BSDX20",28,0)
 S DIK="^BSDXDEPT("_BSDXIEN_",1,"
"RTN","BSDX20",29,0)
 S DA=BSDXIEN1,DA(1)=BSDXIEN
"RTN","BSDX20",30,0)
 D ^DIK
"RTN","BSDX20",31,0)
 ;
"RTN","BSDX20",32,0)
 S BSDXI=BSDXI+1
"RTN","BSDX20",33,0)
 S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_"-1"_$C(30)_$C(31)
"RTN","BSDX20",34,0)
 Q
"RTN","BSDX20",35,0)
 ;
"RTN","BSDX20",36,0)
ADDRGID(BSDXY,BSDXIEN,BSDXIEN1) ;EP
"RTN","BSDX20",37,0)
 ;Entry point for debugging
"RTN","BSDX20",38,0)
 ;
"RTN","BSDX20",39,0)
 ;D DEBUG^%Serenji("ADDRGI^BSDX20(.BSDXY,BSDXIEN,BSDXIEN1)")
"RTN","BSDX20",40,0)
 Q
"RTN","BSDX20",41,0)
 ;
"RTN","BSDX20",42,0)
ADDRGI(BSDXY,BSDXIEN,BSDXIEN1) ;EP
"RTN","BSDX20",43,0)
 ;Adds RESOURCEID BSEDXIEN1 to RESOURCE GROUP entry BSDXIEN
"RTN","BSDX20",44,0)
 ;Return recordset containing added subentry number error message or "" if no error
"RTN","BSDX20",45,0)
 ;Called by BSDX ADD RES GROUP ITEM
"RTN","BSDX20",46,0)
 ;Test Line:
"RTN","BSDX20",47,0)
 ;D ADDRGI^BSDX20(.RES,1,1)
"RTN","BSDX20",48,0)
 ;
"RTN","BSDX20",49,0)
 N BSDXI,BSDXIENS,BSDXMSG,BSDXFDA
"RTN","BSDX20",50,0)
 S X="ETRAP^BSDX20",@^%ZOSF("TRAP")
"RTN","BSDX20",51,0)
 S BSDXI=0
"RTN","BSDX20",52,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX20",53,0)
 S ^BSDXTMP($J,0)="I00020RESOURCEGROUPITEMID^I00020ERRORID"_$C(30)
"RTN","BSDX20",54,0)
 I '+BSDXIEN D ERR(BSDXI,BSDXIEN,70) Q
"RTN","BSDX20",55,0)
 I '+BSDXIEN1 D ERR(BSDXI,BSDXIEN,70) Q
"RTN","BSDX20",56,0)
 I '$D(^BSDXDEPT(BSDXIEN,0)) D ERR(BSDXI,BSDXIEN,70) Q
"RTN","BSDX20",57,0)
 I '$D(^BSDXRES(BSDXIEN1,0)) D ERR(BSDXI,BSDXIEN1,70) Q
"RTN","BSDX20",58,0)
 I $D(^BSDXDEPT(BSDXIEN,1,"B",BSDXIEN1)) D ERR(BSDXI,0,0) Q
"RTN","BSDX20",59,0)
 ;^BSDXDEPT(3,1,"B",3,1)=
"RTN","BSDX20",60,0)
 ;
"RTN","BSDX20",61,0)
 S BSDXIENS="+1,"_BSDXIEN_","
"RTN","BSDX20",62,0)
 S BSDXFDA(9002018.21,BSDXIENS,.01)=BSDXIEN1 ;RESOURCEID
"RTN","BSDX20",63,0)
 K BSDXIEN
"RTN","BSDX20",64,0)
 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX20",65,0)
 S BSDXI=BSDXI+1
"RTN","BSDX20",66,0)
 S ^BSDXTMP($J,BSDXI)=+$G(BSDXIEN(1))_"^"_"-1"_$C(30)_$C(31)
"RTN","BSDX20",67,0)
 Q
"RTN","BSDX20",68,0)
 ;
"RTN","BSDX20",69,0)
ERR(BSDXI,BSDXID,BSDXERR) ;Error processing
"RTN","BSDX20",70,0)
 S BSDXI=BSDXI+1
"RTN","BSDX20",71,0)
 S ^BSDXTMP($J,BSDXI)=BSDXID_"^"_BSDXERR_$C(30)
"RTN","BSDX20",72,0)
 S BSDXI=BSDXI+1
"RTN","BSDX20",73,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX20",74,0)
 Q
"RTN","BSDX20",75,0)
 ;
"RTN","BSDX20",76,0)
ETRAP ;EP Error trap entry
"RTN","BSDX20",77,0)
 I '$D(BSDXI) N BSDXI S BSDXI=999
"RTN","BSDX20",78,0)
 S BSDXI=BSDXI+1
"RTN","BSDX20",79,0)
 D ERR(BSDXI,99,70)
"RTN","BSDX20",80,0)
 Q
"RTN","BSDX21")
0^19^B8787000
"RTN","BSDX21",1,0)
BSDX21 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
"RTN","BSDX21",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX21",3,0)
 ; Licensed under LGPL
"RTN","BSDX21",4,0)
 ;
"RTN","BSDX21",5,0)
 ;
"RTN","BSDX21",6,0)
ADDAGD(BSDXY,BSDXVAL) ;EP
"RTN","BSDX21",7,0)
 ;Entry point for debugging
"RTN","BSDX21",8,0)
 ;
"RTN","BSDX21",9,0)
 ;D DEBUG^%Serenji("ADDAG^BSDX21(.BSDXY,BSDXVAL)")
"RTN","BSDX21",10,0)
 Q
"RTN","BSDX21",11,0)
 ;
"RTN","BSDX21",12,0)
ADDAG(BSDXY,BSDXVAL) ;EP
"RTN","BSDX21",13,0)
 ;Called by BSDX ADD/EDIT ACCESS GROUP
"RTN","BSDX21",14,0)
 ;Add a new BSDX ACCESS GROUP entry
"RTN","BSDX21",15,0)
 ;BSDXVAL is NAME of the entry
"RTN","BSDX21",16,0)
 ;
"RTN","BSDX21",17,0)
 S X="ERROR^BSDX21",@^%ZOSF("TRAP")
"RTN","BSDX21",18,0)
 N BSDXIENS,BSDXFDA,BSDXMSG,BSDXIEN,BSDX,BSDXNAM
"RTN","BSDX21",19,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX21",20,0)
 S ^BSDXTMP($J,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$C(30)
"RTN","BSDX21",21,0)
 I BSDXVAL="" D ERR(0,"BSDX21: Invalid null input Parameter") Q
"RTN","BSDX21",22,0)
 S BSDXIEN=$P(BSDXVAL,"|")
"RTN","BSDX21",23,0)
 S BSDXNAM=$P(BSDXVAL,"|",2)
"RTN","BSDX21",24,0)
 I +BSDXIEN D
"RTN","BSDX21",25,0)
 . S BSDX="EDIT"
"RTN","BSDX21",26,0)
 . S BSDXIENS=BSDXIEN_","
"RTN","BSDX21",27,0)
 E  D
"RTN","BSDX21",28,0)
 . S BSDX="ADD"
"RTN","BSDX21",29,0)
 . S BSDXIENS="+1,"
"RTN","BSDX21",30,0)
 ;
"RTN","BSDX21",31,0)
 S BSDXNAM=$P(BSDXVAL,"|",2)
"RTN","BSDX21",32,0)
 I BSDXNAM="" D ERR(0,"BSDX14: Invalid null Access Type name.") Q
"RTN","BSDX21",33,0)
 ;
"RTN","BSDX21",34,0)
 ;Prevent adding entry with duplicate name
"RTN","BSDX21",35,0)
 I $D(^BSDXAGP("B",BSDXNAM)),$O(^BSDXAGP("B",BSDXNAM,0))'=BSDXIEN D  Q
"RTN","BSDX21",36,0)
 . D ERR(0,"BSDX21: Cannot have two Access Groups with the same name.")
"RTN","BSDX21",37,0)
 . Q
"RTN","BSDX21",38,0)
 ;
"RTN","BSDX21",39,0)
 S BSDXFDA(9002018.38,BSDXIENS,.01)=BSDXNAM ;NAME
"RTN","BSDX21",40,0)
 I BSDX="ADD" D
"RTN","BSDX21",41,0)
 . K BSDXIEN
"RTN","BSDX21",42,0)
 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX21",43,0)
 . S BSDXIEN=+$G(BSDXIEN(1))
"RTN","BSDX21",44,0)
 E  D
"RTN","BSDX21",45,0)
 . D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX21",46,0)
 S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^"_$C(30)_$C(31)
"RTN","BSDX21",47,0)
 Q
"RTN","BSDX21",48,0)
 ;
"RTN","BSDX21",49,0)
DELAGD(BSDXY,BSDXGRP) ;EP
"RTN","BSDX21",50,0)
 ;Entry point for debugging
"RTN","BSDX21",51,0)
 ;
"RTN","BSDX21",52,0)
 ;D DEBUG^%Serenji("DELAG^BSDX21(.BSDXY,BSDXGRP)")
"RTN","BSDX21",53,0)
 Q
"RTN","BSDX21",54,0)
 ;
"RTN","BSDX21",55,0)
DELAG(BSDXY,BSDXGRP) ;EP
"RTN","BSDX21",56,0)
 ;Deletes entry having IEN BSDXGRP from BSDX ACCESS GROUP file
"RTN","BSDX21",57,0)
 ;Also deletes all entries in BSDX ACCESS GROUP TYPE that point to this group
"RTN","BSDX21",58,0)
 ;Return recordset containing error message or "" if no error
"RTN","BSDX21",59,0)
 ;Called by BSDX DELETE ACCESS GROUP
"RTN","BSDX21",60,0)
 ;Test Line:
"RTN","BSDX21",61,0)
 ;D DELAG^BSDX21(.RES,99)
"RTN","BSDX21",62,0)
 ;
"RTN","BSDX21",63,0)
 S X="ERROR^BSDX21",@^%ZOSF("TRAP")
"RTN","BSDX21",64,0)
 N BSDXI,DIK,DA,BSDXIEN,BSDXIEN1
"RTN","BSDX21",65,0)
 S BSDXI=0
"RTN","BSDX21",66,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX21",67,0)
 S ^BSDXTMP($J,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$C(30)
"RTN","BSDX21",68,0)
 S BSDXIEN=BSDXGRP
"RTN","BSDX21",69,0)
 ;I '$D(^BSDXAGP("B",BSDXGRP)) D ERR(BSDXI,0,0) Q
"RTN","BSDX21",70,0)
 ;S BSDXIEN=$O(^BSDXAGP("B",BSDXGRP,0))
"RTN","BSDX21",71,0)
 I '+BSDXIEN D ERR(BSDXI,BSDXIEN) Q
"RTN","BSDX21",72,0)
 I '$D(^BSDXAGP(BSDXIEN,0)) D ERR(0,"BSDX14: Invalid Access Group ID name.") Q
"RTN","BSDX21",73,0)
 ;
"RTN","BSDX21",74,0)
 ;Delete BSDXACCESS GROUP TYPE entries
"RTN","BSDX21",75,0)
 ;
"RTN","BSDX21",76,0)
 S BSDXIEN1=0 F  S BSDXIEN1=$O(^BSDXAGTP("B",BSDXIEN,BSDXIEN1)) Q:'BSDXIEN1  D
"RTN","BSDX21",77,0)
 . S DIK="^BSDXAGTP("
"RTN","BSDX21",78,0)
 . S DA=BSDXIEN1
"RTN","BSDX21",79,0)
 . D ^DIK
"RTN","BSDX21",80,0)
 . Q
"RTN","BSDX21",81,0)
 ;
"RTN","BSDX21",82,0)
 ;Delete entry BSDXIEN in BSDX ACCESS GROUP
"RTN","BSDX21",83,0)
 S DIK="^BSDXAGP("
"RTN","BSDX21",84,0)
 S DA=BSDXIEN
"RTN","BSDX21",85,0)
 D ^DIK
"RTN","BSDX21",86,0)
 ;
"RTN","BSDX21",87,0)
 S BSDXI=BSDXI+1
"RTN","BSDX21",88,0)
 S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_""_$C(30)_$C(31)
"RTN","BSDX21",89,0)
 Q
"RTN","BSDX21",90,0)
 ;
"RTN","BSDX21",91,0)
ERR(BSDXERID,ERRTXT) ;Error processing
"RTN","BSDX21",92,0)
 S:'+$G(BSDXI) BSDXI=999999
"RTN","BSDX21",93,0)
 S BSDXI=BSDXI+1
"RTN","BSDX21",94,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
"RTN","BSDX21",95,0)
 S BSDXI=BSDXI+1
"RTN","BSDX21",96,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX21",97,0)
 Q
"RTN","BSDX21",98,0)
 ;
"RTN","BSDX21",99,0)
ERROR ;
"RTN","BSDX21",100,0)
 D ^%ZTER
"RTN","BSDX21",101,0)
 I '+$G(BSDXI) N BSDXI S BSDXI=999999
"RTN","BSDX21",102,0)
 S BSDXI=BSDXI+1
"RTN","BSDX21",103,0)
 D ERR(0,"BSDX21 M Error: <"_$G(%ZTERROR)_">")
"RTN","BSDX21",104,0)
 Q
"RTN","BSDX22")
0^20^B9604631
"RTN","BSDX22",1,0)
BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
"RTN","BSDX22",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX22",3,0)
 ; Licensed under LGPL
"RTN","BSDX22",4,0)
 ;
"RTN","BSDX22",5,0)
 ;
"RTN","BSDX22",6,0)
DELAGID(BSDXY,BSDXIEN,BSDXIEN1) ;EP
"RTN","BSDX22",7,0)
 ;Entry point for debugging
"RTN","BSDX22",8,0)
 ;
"RTN","BSDX22",9,0)
 ;D DEBUG^%Serenji("DELAGI^BSDX22(.BSDXY,BSDXIEN,BSDXIEN1)")
"RTN","BSDX22",10,0)
 Q
"RTN","BSDX22",11,0)
 ;
"RTN","BSDX22",12,0)
DELAGI(BSDXY,BSDXIEN,BSDXIEN1) ;EP
"RTN","BSDX22",13,0)
 ;Deletes entry having Access Group BSDXIEN and Access Type BSDXIEN1 the ACCESS GROUP TYPE file
"RTN","BSDX22",14,0)
 ;Return recordset containing error message or "" if no error
"RTN","BSDX22",15,0)
 ;Called by BSDX DELETE ACCESS GROUP ITEM
"RTN","BSDX22",16,0)
 ;Test Line:
"RTN","BSDX22",17,0)
 ;D DELAGI^BSDX22(.RES,99)
"RTN","BSDX22",18,0)
 ;
"RTN","BSDX22",19,0)
 S X="ERROR^BSDX22",@^%ZOSF("TRAP")
"RTN","BSDX22",20,0)
 N BSDXI,DIK,DA,BSDXIEN2
"RTN","BSDX22",21,0)
 S BSDXI=0
"RTN","BSDX22",22,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX22",23,0)
 S ^BSDXTMP($J,0)="I00020ACCESSGROUPTYPEID^T00030ERRORTEXT"_$C(30)
"RTN","BSDX22",24,0)
 I '+BSDXIEN D ERR(0,"BSDX22: Invalid null Access Group ID") Q
"RTN","BSDX22",25,0)
 I '+BSDXIEN1 D ERR(0,"BSDX22: Invalid null Access Type ID") Q
"RTN","BSDX22",26,0)
 I '$D(^BSDXAGTP("AC",BSDXIEN,BSDXIEN1)) D  Q
"RTN","BSDX22",27,0)
 . D ERR(0,"BSDX22: Invalid null Access Group Type ID")
"RTN","BSDX22",28,0)
 . Q
"RTN","BSDX22",29,0)
 S BSDXIEN2=$O(^BSDXAGTP("AC",BSDXIEN,BSDXIEN1,0))
"RTN","BSDX22",30,0)
 I '+BSDXIEN2 D ERR(0,"BSDX22: Invalid null Access Group Type ID") Q
"RTN","BSDX22",31,0)
 ;
"RTN","BSDX22",32,0)
 ;Delete entry
"RTN","BSDX22",33,0)
 S DIK="^BSDXAGTP("
"RTN","BSDX22",34,0)
 S DA=BSDXIEN2
"RTN","BSDX22",35,0)
 D ^DIK
"RTN","BSDX22",36,0)
 ;
"RTN","BSDX22",37,0)
 S BSDXI=BSDXI+1
"RTN","BSDX22",38,0)
 S ^BSDXTMP($J,BSDXI)=BSDXIEN2_"^"_"-1"_$C(30)_$C(31)
"RTN","BSDX22",39,0)
 Q
"RTN","BSDX22",40,0)
 ;
"RTN","BSDX22",41,0)
ADDAGID(BSDXY,BSDXIEN,BSDXIEN1) ;EP
"RTN","BSDX22",42,0)
 ;Entry point for debugging
"RTN","BSDX22",43,0)
 ;
"RTN","BSDX22",44,0)
 ;D DEBUG^%Serenji("ADDAGI^BSDX22(.BSDXY,BSDXIEN,BSDXIEN1)")
"RTN","BSDX22",45,0)
 Q
"RTN","BSDX22",46,0)
 ;
"RTN","BSDX22",47,0)
ADDAGI(BSDXY,BSDXIEN,BSDXIEN1) ;EP
"RTN","BSDX22",48,0)
 ;Adds ACCESS GROUP TYPE file entry having access group BSDXIEN and access type BSDXIEN1
"RTN","BSDX22",49,0)
 ;Return recordset containing added entry number error message or "" if no error
"RTN","BSDX22",50,0)
 ;Called by BSDX ADD ACCESS GROUP ITEM
"RTN","BSDX22",51,0)
 ;Test Line:
"RTN","BSDX22",52,0)
 ;D ADDAGI^BSDX22(.RES,1,1)
"RTN","BSDX22",53,0)
 ;
"RTN","BSDX22",54,0)
 S X="ERROR^BSDX22",@^%ZOSF("TRAP")
"RTN","BSDX22",55,0)
 N BSDXI,BSDXIENS,BSDXMSG,BSDXFDA
"RTN","BSDX22",56,0)
 S BSDXI=0
"RTN","BSDX22",57,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX22",58,0)
 ;S ^BSDXTMP($J,0)="I00020ACCESSGROUPTYPEID^I00020ERRORID"_$C(30)
"RTN","BSDX22",59,0)
 S ^BSDXTMP($J,0)="I00020ACCESSGROUPTYPEID^T00030ERRORTEXT"_$C(30)
"RTN","BSDX22",60,0)
 I '+BSDXIEN D ERR(0,"BSDX22: Invalid null Access Group ID") Q
"RTN","BSDX22",61,0)
 I '+BSDXIEN1 D ERR(0,"BSDX22: Invalid null Access Type ID") Q
"RTN","BSDX22",62,0)
 I '$D(^BSDXAGP(BSDXIEN,0)) D ERR(0,"BSDX22: Invalid Access Group ID") Q
"RTN","BSDX22",63,0)
 I '$D(^BSDXTYPE(BSDXIEN1,0)) D ERR(0,"BSDX22: Invalid Access Type ID") Q
"RTN","BSDX22",64,0)
 I $D(^BSDXAGTP("AC",BSDXIEN,BSDXIEN1)) D  Q
"RTN","BSDX22",65,0)
 . S BSDXIENS=$O(^BSDXAGTP("AC",BSDXIEN,BSDXIEN1,0))
"RTN","BSDX22",66,0)
 . S ^BSDXTMP($J,BSDXI+1)=+BSDXIENS_"^"_$C(30)_$C(31)
"RTN","BSDX22",67,0)
 . Q
"RTN","BSDX22",68,0)
 ;
"RTN","BSDX22",69,0)
 S BSDXIENS="+1,"
"RTN","BSDX22",70,0)
 S BSDXFDA(9002018.39,BSDXIENS,.01)=BSDXIEN ;ACCESS GROUP ID
"RTN","BSDX22",71,0)
 S BSDXFDA(9002018.39,BSDXIENS,.02)=BSDXIEN1 ;ACCESS TYPE ID
"RTN","BSDX22",72,0)
 K BSDXIEN
"RTN","BSDX22",73,0)
 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX22",74,0)
 S BSDXI=BSDXI+1
"RTN","BSDX22",75,0)
 S ^BSDXTMP($J,BSDXI)=+$G(BSDXIEN(1))_"^"_$C(30)_$C(31)
"RTN","BSDX22",76,0)
 Q
"RTN","BSDX22",77,0)
 ;
"RTN","BSDX22",78,0)
ERR(BSDXERID,ERRTXT) ;Error processing
"RTN","BSDX22",79,0)
 S:'+$G(BSDXI) BSDXI=999999
"RTN","BSDX22",80,0)
 S BSDXI=BSDXI+1
"RTN","BSDX22",81,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
"RTN","BSDX22",82,0)
 S BSDXI=BSDXI+1
"RTN","BSDX22",83,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX22",84,0)
 Q
"RTN","BSDX22",85,0)
 ;
"RTN","BSDX22",86,0)
ERROR ;
"RTN","BSDX22",87,0)
 D ^%ZTER
"RTN","BSDX22",88,0)
 I '+$G(BSDXI) N BSDXI S BSDXI=999999
"RTN","BSDX22",89,0)
 S BSDXI=BSDXI+1
"RTN","BSDX22",90,0)
 D ERR(0,"BSDX22 M Error: <"_$G(%ZTERROR)_">")
"RTN","BSDX22",91,0)
 Q
"RTN","BSDX23")
0^21^B8607717
"RTN","BSDX23",1,0)
BSDX23 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
"RTN","BSDX23",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX23",3,0)
 ; Licensed under LGPL
"RTN","BSDX23",4,0)
 ;
"RTN","BSDX23",5,0)
 ;
"RTN","BSDX23",6,0)
EVENT(BSDXEVENT,BSDXPARAM,BSDXSIP,BSDXSPT) ;EP
"RTN","BSDX23",7,0)
 ;Raise event to interested clients
"RTN","BSDX23",8,0)
 ;Clients are listed in ^BSDXTMP("EVENT",EVENT_NAME,IP,PORT)
"RTN","BSDX23",9,0)
 ;BSDXSIP and BSDXSPT represent the sender's IP and PORT.  
"RTN","BSDX23",10,0)
 ;The event will not be raised back to the sender if these are non-null
"RTN","BSDX23",11,0)
 ;
"RTN","BSDX23",12,0)
 Q:'$D(^BSDXTMP("EVENT",BSDXEVENT))
"RTN","BSDX23",13,0)
 S BSDXIP=0 F  S BSDXIP=$O(^BSDXTMP("EVENT",BSDXEVENT,BSDXIP)) Q:BSDXIP=""  D
"RTN","BSDX23",14,0)
 . S BSDXPORT=0 F  S BSDXPORT=$O(^BSDXTMP("EVENT",BSDXEVENT,BSDXIP,BSDXPORT)) Q:'+BSDXPORT  D
"RTN","BSDX23",15,0)
 . . I BSDXIP=BSDXSIP Q  ;,BSDXPORT=BSDXSPT Q
"RTN","BSDX23",16,0)
 . . D CALL^%ZISTCP(BSDXIP,BSDXPORT,5)
"RTN","BSDX23",17,0)
 . . I POP K ^BSDXTMP("EVENT",BSDXEVENT,BSDXIP,BSDXPORT) Q
"RTN","BSDX23",18,0)
 . . ;U IO R X#3:5
"RTN","BSDX23",19,0)
 . . I X'="ACK" K ^BSDXTMP("EVENT",BSDXEVENT,BSDXIP,BSDXPORT) Q
"RTN","BSDX23",20,0)
 . . S BSDXPARAM=$S(BSDXPARAM="":"",1:U_BSDXPARAM)
"RTN","BSDX23",21,0)
 . . U IO W BSDXEVENT,BSDXPARAM,!
"RTN","BSDX23",22,0)
 . . D ^%ZISC
"RTN","BSDX23",23,0)
 . . Q
"RTN","BSDX23",24,0)
 . Q
"RTN","BSDX23",25,0)
 Q
"RTN","BSDX23",26,0)
 ;
"RTN","BSDX23",27,0)
EVERR(BSDXEVENT,BSDXIP,BSDXPORT) ;
"RTN","BSDX23",28,0)
 ;
"RTN","BSDX23",29,0)
 Q:$G(BSDXEVENT)=""
"RTN","BSDX23",30,0)
 Q:$G(BSDXIP)=""
"RTN","BSDX23",31,0)
 Q:$G(BSDXIP)=""
"RTN","BSDX23",32,0)
 K ^BSDXTMP("EVENT",BSDXEVENT,BSDXIP,BSDXPORT)
"RTN","BSDX23",33,0)
 Q
"RTN","BSDX23",34,0)
 ;
"RTN","BSDX23",35,0)
REGET ;EP
"RTN","BSDX23",36,0)
 ;Error trap from REGEVNT
"RTN","BSDX23",37,0)
 ;
"RTN","BSDX23",38,0)
 I '$D(BSDXI) N BSDXI S BSDXI=999
"RTN","BSDX23",39,0)
 S BSDXI=BSDXI+1
"RTN","BSDX23",40,0)
 D REGERR(BSDXI,99)
"RTN","BSDX23",41,0)
 Q
"RTN","BSDX23",42,0)
 ;
"RTN","BSDX23",43,0)
REGERR(BSDXI,BSDXERID) ;Error processing
"RTN","BSDX23",44,0)
 S BSDXI=BSDXI+1
"RTN","BSDX23",45,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERID_$C(30)
"RTN","BSDX23",46,0)
 S BSDXI=BSDXI+1
"RTN","BSDX23",47,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX23",48,0)
 Q
"RTN","BSDX23",49,0)
 ;
"RTN","BSDX23",50,0)
 ;
"RTN","BSDX23",51,0)
REGEVNT(BSDXY,BSDXEVENT,BSDXIP,BSDXPORT) ;EP
"RTN","BSDX23",52,0)
 ;RPC Called by client to inform RPMS server of client's interest in BSDXEVENT
"RTN","BSDX23",53,0)
 ;Returns RECORDSET with field ERRORID.
"RTN","BSDX23",54,0)
 ;If everything ok then ERRORID = 0;
"RTN","BSDX23",55,0)
 ;
"RTN","BSDX23",56,0)
 N BSDXI
"RTN","BSDX23",57,0)
 S BSDXI=0
"RTN","BSDX23",58,0)
 S X="REGET^BSDX23",@^%ZOSF("TRAP")
"RTN","BSDX23",59,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX23",60,0)
 S ^BSDXTMP($J,0)="I00020ERRORID"_$C(30)
"RTN","BSDX23",61,0)
 I '+BSDXPORT D REGERR(BSDXI,1) Q
"RTN","BSDX23",62,0)
 I BSDXIP="" D REGERR(BSDXI,2) Q
"RTN","BSDX23",63,0)
 S ^BSDXTMP("EVENT",BSDXEVENT,BSDXIP,BSDXPORT)=""
"RTN","BSDX23",64,0)
 ;
"RTN","BSDX23",65,0)
 S BSDXI=BSDXI+1
"RTN","BSDX23",66,0)
 S ^BSDXTMP($J,BSDXI)="0"_$C(30)_$C(31)
"RTN","BSDX23",67,0)
 Q
"RTN","BSDX23",68,0)
 ;
"RTN","BSDX23",69,0)
UNREG(BSDXY,BSDXEVENT,BSDXIP,BSDXPORT) ;EP
"RTN","BSDX23",70,0)
 ;RPC Called by client to Unregister client's interest in BSDXEVENT
"RTN","BSDX23",71,0)
 ;Returns RECORDSET with field ERRORID.
"RTN","BSDX23",72,0)
 ;If everything ok then ERRORID = 0;
"RTN","BSDX23",73,0)
 ;
"RTN","BSDX23",74,0)
 N BSDXI
"RTN","BSDX23",75,0)
 S BSDXI=0
"RTN","BSDX23",76,0)
 S X="REGET^BSDX23",@^%ZOSF("TRAP")
"RTN","BSDX23",77,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX23",78,0)
 S ^BSDXTMP($J,0)="I00020ERRORID"_$C(30)
"RTN","BSDX23",79,0)
 I '+BSDXPORT D REGERR(BSDXI,1) Q
"RTN","BSDX23",80,0)
 I BSDXIP="" D REGERR(BSDXI,2) Q
"RTN","BSDX23",81,0)
 K ^BSDXTMP("EVENT",BSDXEVENT,BSDXIP,BSDXPORT)
"RTN","BSDX23",82,0)
 ;
"RTN","BSDX23",83,0)
 S BSDXI=BSDXI+1
"RTN","BSDX23",84,0)
 S ^BSDXTMP($J,BSDXI)="0"_$C(30)_$C(31)
"RTN","BSDX23",85,0)
 Q
"RTN","BSDX23",86,0)
 ;
"RTN","BSDX23",87,0)
RAISEVNT(BSDXY,BSDXEVENT,BSDXPARAM,BSDXSIP,BSDXSPT) ;EP
"RTN","BSDX23",88,0)
 ;RPC Called to raise event BSDXEVENT with parameter BSDXPARAM
"RTN","BSDX23",89,0)
 ;BSDXSIP and BSDXSPT represent the sender's IP and PORT.
"RTN","BSDX23",90,0)
 ;If not null, these will prevent the event from being raised back
"RTN","BSDX23",91,0)
 ;to the sender.
"RTN","BSDX23",92,0)
 ;Returns a RECORDSET wit the field ERRORID.
"RTN","BSDX23",93,0)
 ;If everything ok then ERRORID = 0;
"RTN","BSDX23",94,0)
 ;
"RTN","BSDX23",95,0)
 N BSDXI
"RTN","BSDX23",96,0)
 S BSDXI=0
"RTN","BSDX23",97,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX23",98,0)
 S ^BSDXTMP($J,0)="I00020ERRORID"_$C(30)
"RTN","BSDX23",99,0)
 S X="REGET^BSDX23",@^%ZOSF("TRAP")
"RTN","BSDX23",100,0)
 ;
"RTN","BSDX23",101,0)
 D EVENT(BSDXEVENT,BSDXPARAM,BSDXSIP,BSDXSPT)
"RTN","BSDX23",102,0)
 ;
"RTN","BSDX23",103,0)
 S BSDXI=BSDXI+1
"RTN","BSDX23",104,0)
 S ^BSDXTMP($J,BSDXI)="0"_$C(30)_$C(31)
"RTN","BSDX23",105,0)
 Q
"RTN","BSDX24")
0^22^B13588210
"RTN","BSDX24",1,0)
BSDX24 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
"RTN","BSDX24",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX24",3,0)
 ; Licensed under LGPL
"RTN","BSDX24",4,0)
 ;
"RTN","BSDX24",5,0)
 ;
"RTN","BSDX24",6,0)
 Q
"RTN","BSDX24",7,0)
CRCONTXT(RESULT,OPTION) ;EP
"RTN","BSDX24",8,0)
 ;Entry point for debugging XWBSEC
"RTN","BSDX24",9,0)
 ;
"RTN","BSDX24",10,0)
 ;D DEBUG^%Serenji("CRCONTXT^XWBSEC(.RESULT,OPTION)")
"RTN","BSDX24",11,0)
 ;;H .5
"RTN","BSDX24",12,0)
 ;;D CRCONTXT^XWBSEC(.RESULT,OPTION)
"RTN","BSDX24",13,0)
 ;;S BSDX="^BSDXTMP($J,"
"RTN","BSDX24",14,0)
 ;;S ^BSDXTMP($J,0)=RESULT
"RTN","BSDX24",15,0)
 ;;S RESULT=1
"RTN","BSDX24",16,0)
 Q
"RTN","BSDX24",17,0)
TEST0(BSDX) ;EP Delete user from 200
"RTN","BSDX24",18,0)
 S DIK="^VA(200,"
"RTN","BSDX24",19,0)
 S DA=BSDX
"RTN","BSDX24",20,0)
 D ^DIK
"RTN","BSDX24",21,0)
 ;
"RTN","BSDX24",22,0)
 Q
"RTN","BSDX24",23,0)
KILLM ;EP Delete BMXMENU entry
"RTN","BSDX24",24,0)
 S DIK="^DIC(19,"
"RTN","BSDX24",25,0)
 S DA=$O(^DIC(19,"B","BMXMENU",0))
"RTN","BSDX24",26,0)
 Q:'+DA
"RTN","BSDX24",27,0)
 D ^DIK
"RTN","BSDX24",28,0)
 Q
"RTN","BSDX24",29,0)
 ;
"RTN","BSDX24",30,0)
TEST1 ;EP Adding an entry to 200
"RTN","BSDX24",31,0)
 ;
"RTN","BSDX24",32,0)
 S BSDXFDA(200,"+1,",.01)="BMXNET,APPLICATION"
"RTN","BSDX24",33,0)
 K BSDXIEN,BSDXMSG
"RTN","BSDX24",34,0)
 S DIC(0)=""
"RTN","BSDX24",35,0)
 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX24",36,0)
 ;
"RTN","BSDX24",37,0)
 Q
"RTN","BSDX24",38,0)
TEST2 ;EP
"RTN","BSDX24",39,0)
 ;How to change the ACCESS CODE, VERIFY CODE, DATE VERIFY CODE LAST CHANGED field
"RTN","BSDX24",40,0)
 ;ACCESS CODE BSDXXX1^1_(a>yr}:3x3ja9\8vbH
"RTN","BSDX24",41,0)
 ;VERIFY CODE BSDXXX2^$;HOSs|:3w25lLD}Be=
"RTN","BSDX24",42,0)
 N BSDXFDA
"RTN","BSDX24",43,0)
 S BSDXFDA(200,"36,",2)="1_(a>yr}:3x3ja9\8vbH"
"RTN","BSDX24",44,0)
 S BSDXFDA(200,"36,",11)="$;HOSs|:3w25lLD}Be="
"RTN","BSDX24",45,0)
 S BSDXFDA(200,"36,",11.2)="88888,88888"
"RTN","BSDX24",46,0)
 S BSDXFDA(200,"36,",201)="BMXRPC"
"RTN","BSDX24",47,0)
 D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX24",48,0)
 Q
"RTN","BSDX24",49,0)
 ;
"RTN","BSDX24",50,0)
 ;
"RTN","BSDX24",51,0)
SEARCHD(BSDXY,BSDXRES,BSDXSTRT,BSDXEND,BSDXTYPES,BSDXAMPM,BSDXWKDY) ;EP
"RTN","BSDX24",52,0)
 ;Entry point for debugging
"RTN","BSDX24",53,0)
 ;
"RTN","BSDX24",54,0)
 ;D DEBUG^%Serenji("SEARCH^BSDX24(.RES,""ROGERS,BUCK|FUNAKOSHI,GICHIN"","""","""","""","""","""")")
"RTN","BSDX24",55,0)
 ;D DEBUG^%Serenji("SEARCH^BSDX24(.BSDXY,BSDXRES,BSDXSTRT,BSDXEND,BSDXTYPES,BSDXAMPM,BSDXWKDY)")
"RTN","BSDX24",56,0)
 Q
"RTN","BSDX24",57,0)
 ;
"RTN","BSDX24",58,0)
SEARCH(BSDXY,BSDXRES,BSDXSTRT,BSDXEND,BSDXTYPES,BSDXAMPM,BSDXWKDY) ;EP
"RTN","BSDX24",59,0)
 ;Searches availability database for availability blocks between
"RTN","BSDX24",60,0)
 ;BSDXSTRT and BSDXEND for each of the resources in BSDXRES.
"RTN","BSDX24",61,0)
 ;The av blocks must be one of the types in BSDXTYPES, must be
"RTN","BSDX24",62,0)
 ;AM or PM depending on value in BSDXAMPM and
"RTN","BSDX24",63,0)
 ;must be on one of the weekdays listed in BSDXWKDY.
"RTN","BSDX24",64,0)
 ;
"RTN","BSDX24",65,0)
 ;Return recordset containing the start times of availability blocks
"RTN","BSDX24",66,0)
 ;meeting the search criteria.
"RTN","BSDX24",67,0)
 ;
"RTN","BSDX24",68,0)
 ;Variables:
"RTN","BSDX24",69,0)
 ;BSDXRES |-Delimited list of resource names
"RTN","BSDX24",70,0)
 ;BSDXSTRT FM-formatted beginning date of search
"RTN","BSDX24",71,0)
 ;BSDXEND FM-Formatted ending date of search
"RTN","BSDX24",72,0)
 ;BSDXTYPES |-Delimited list of access type IENs
"RTN","BSDX24",73,0)
 ;BSDXAMPM "AM" for am-only, "PM" for pm-only, "BOTH" for both
"RTN","BSDX24",74,0)
 ;BSDXWKDY "" if any weekday, else |-delimited list of weekdays
"RTN","BSDX24",75,0)
 ;
"RTN","BSDX24",76,0)
 ;NOTE: If BSDXEND="" Then:
"RTN","BSDX24",77,0)
 ; either ONE record is returned matching the first available block
"RTN","BSDX24",78,0)
 ; -or- NO record is returned indicating no available block exists
"RTN","BSDX24",79,0)
 ;
"RTN","BSDX24",80,0)
 ;Called by BSDX SEARCH AVAILABILITY
"RTN","BSDX24",81,0)
 ;Test Line:
"RTN","BSDX24",82,0)
 ;D SEARCH^BSDX24(.RES,"ROGERS,BUCK|FUNAKOSHI,GICHIN","","","","","") ZW RES
"RTN","BSDX24",83,0)
 ;
"RTN","BSDX24",84,0)
 ;
"RTN","BSDX24",85,0)
 S X=BSDXSTRT,%DT="X" D ^%DT S BSDXSTRT=$P(Y,".")
"RTN","BSDX24",86,0)
 S:+BSDXSTRT<0 BSDXSTRT=DT
"RTN","BSDX24",87,0)
 S X=BSDXEND,%DT="X" D ^%DT S BSDXEND=$P(Y,".")
"RTN","BSDX24",88,0)
 S:+BSDXEND<0 BSDXEND=9990101
"RTN","BSDX24",89,0)
 S BSDXEND=BSDXEND_".99"
"RTN","BSDX24",90,0)
 N BSDXRESN,BSDXRESD,BSDXDATE,BSDXI,BSDXABD,BSDXNOD,BSDXATD,BSDXATN
"RTN","BSDX24",91,0)
 N BSDXTYPE
"RTN","BSDX24",92,0)
 ;
"RTN","BSDX24",93,0)
 ;Set up access types array
"RTN","BSDX24",94,0)
 F BSDX=1:1:$L(BSDXTYPES,"|") D
"RTN","BSDX24",95,0)
 . S BSDXATD=$P(BSDXTYPES,"|",BSDX)
"RTN","BSDX24",96,0)
 . S:+BSDXATD BSDXTYPE(BSDXTYPD)=""
"RTN","BSDX24",97,0)
 ;
"RTN","BSDX24",98,0)
 S BSDXI=0
"RTN","BSDX24",99,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX24",100,0)
 S ^BSDXTMP($J,0)="T00030RESOURCENAME^D00030DATE^T00030ACCESSTYPE^T00030COMMENT"_$C(30)
"RTN","BSDX24",101,0)
 F BSDX=1:1:$L(BSDXRES,"|") S BSDXRESN=$P(BSDXRES,"|",BSDX) D
"RTN","BSDX24",102,0)
 . Q:'$D(^BSDXRES("B",BSDXRESN))
"RTN","BSDX24",103,0)
 . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
"RTN","BSDX24",104,0)
 . Q:'+BSDXRESD
"RTN","BSDX24",105,0)
 . Q:'$D(^BSDXRES(BSDXRESD,0))
"RTN","BSDX24",106,0)
 . Q:'$D(^BSDXAB("ARSCT",BSDXRESD))
"RTN","BSDX24",107,0)
 . S BSDXDATE=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXSTRT))
"RTN","BSDX24",108,0)
 . Q:BSDXDATE=""
"RTN","BSDX24",109,0)
 . Q:BSDXDATE>BSDXEND
"RTN","BSDX24",110,0)
 . ;TODO: Screen for AMPM
"RTN","BSDX24",111,0)
 . ;TODO: Screen for Weekday
"RTN","BSDX24",112,0)
 . ;
"RTN","BSDX24",113,0)
 . S BSDXI=BSDXI+1
"RTN","BSDX24",114,0)
 . S BSDXABD=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE,0))
"RTN","BSDX24",115,0)
 . S BSDXNOD=$G(^BSDXAB(BSDXABD,0))
"RTN","BSDX24",116,0)
 . Q:BSDXNOD=""
"RTN","BSDX24",117,0)
 . S Y=$P(BSDXDATE,".")
"RTN","BSDX24",118,0)
 . D DD^%DT
"RTN","BSDX24",119,0)
 . S BSDXATD=$P(BSDXNOD,U,5) ;ACCESS TYPE POINTER
"RTN","BSDX24",120,0)
 . S BSDXATD=$G(^BSDXTYPE(+BSDXATD,0))
"RTN","BSDX24",121,0)
 . S BSDXATN=$P(BSDXATD,U)
"RTN","BSDX24",122,0)
 . I +BSDXATD,BSDXTYPES]"" Q:'$D(BSDXTYPES(BSDXATD))
"RTN","BSDX24",123,0)
 . ;TODO: Screen for TYPE ----DONE!
"RTN","BSDX24",124,0)
 . ;TODO: Comment
"RTN","BSDX24",125,0)
 . S ^BSDXTMP($J,BSDXI)=BSDXRESN_U_Y_U_BSDXATN_U_$C(30)
"RTN","BSDX24",126,0)
 S BSDXI=BSDXI+1
"RTN","BSDX24",127,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX24",128,0)
 Q
"RTN","BSDX25")
0^23^B75573201
"RTN","BSDX25",1,0)
BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 5:00pm
"RTN","BSDX25",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX25",3,0)
 ; Licensed under LGPL
"RTN","BSDX25",4,0)
 ;
"RTN","BSDX25",5,0)
 ; Change Log:
"RTN","BSDX25",6,0)
 ; 3110106: SMH -> Changed Check-in EP - Removed unused paramters. Will change C#
"RTN","BSDX25",7,0)
 ; 3120630: VEN/SMH -> Extensive Refactoring to remove transactions.
"RTN","BSDX25",8,0)
 ;                  -> Functionality still the same.
"RTN","BSDX25",9,0)
 ;                  -> Unit Tests in UT25^BSDXUT2
"RTN","BSDX25",10,0)
 ;
"RTN","BSDX25",11,0)
 ;
"RTN","BSDX25",12,0)
CHECKIND(BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP
"RTN","BSDX25",13,0)
 ;Entry point for debugging
"RTN","BSDX25",14,0)
 ;
"RTN","BSDX25",15,0)
 ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))
"RTN","BSDX25",16,0)
 Q
"RTN","BSDX25",17,0)
 ;
"RTN","BSDX25",18,0)
CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT) ;Private EP Check in appointment
"RTN","BSDX25",19,0)
 ; Old additional vars: ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)
"RTN","BSDX25",20,0)
 ; Called by RPC: BSDX CHECKIN APPOINTMENT
"RTN","BSDX25",21,0)
 ;
"RTN","BSDX25",22,0)
 ; Private to GUI; use BSDXAPI for general API to checkin patients
"RTN","BSDX25",23,0)
 ; Parameters:
"RTN","BSDX25",24,0)
 ; BSDXY: Global Out
"RTN","BSDX25",25,0)
 ; BSDXAPPTID: Appointment ID in ^BSDXAPPT
"RTN","BSDX25",26,0)
 ; BSDXCDT: Checkin Date --> Changed
"RTN","BSDX25",27,0)
 ; BSDXCC: Clinic Stop IEN (not used)
"RTN","BSDX25",28,0)
 ; BSDXPRV: Provider IEN (not used)
"RTN","BSDX25",29,0)
 ; BSDXROU: Print Routing Slip? (not used)
"RTN","BSDX25",30,0)
 ; BSDXVCL: PCC+ Clinic IEN (not used)
"RTN","BSDX25",31,0)
 ; BSDXVFM: PCC+ Form IEN (not used)
"RTN","BSDX25",32,0)
 ; BSDXOG: PCC+ Outguide (true or false) (not used)
"RTN","BSDX25",33,0)
 ;
"RTN","BSDX25",34,0)
 ; Output:
"RTN","BSDX25",35,0)
 ; ADO.net table with 1 column ErrorID, 1 row result
"RTN","BSDX25",36,0)
 ; - 0 if all okay
"RTN","BSDX25",37,0)
 ; - Another number or text if not
"RTN","BSDX25",38,0)
 ;
"RTN","BSDX25",39,0)
 ; Error reference:
"RTN","BSDX25",40,0)
 ; -1 -> Invalid Appointment ID
"RTN","BSDX25",41,0)
 ; -2 -> Invalid Check-in Date
"RTN","BSDX25",42,0)
 ; -3 -> Cannot check-in due to Fileman Filer failure
"RTN","BSDX25",43,0)
 ; -4 -> Cannot lock ^BSDXAPPT(APPTID)
"RTN","BSDX25",44,0)
 ; -10 -> BSDXAPI error
"RTN","BSDX25",45,0)
 ; -100 -> Mumps Error
"RTN","BSDX25",46,0)
 ;
"RTN","BSDX25",47,0)
 ; Turn off SDAM Appointment Events BSDX Protocol Processing
"RTN","BSDX25",48,0)
 N BSDXNOEV
"RTN","BSDX25",49,0)
 S BSDXNOEV=1 ;Don't execute protocol
"RTN","BSDX25",50,0)
 ;
"RTN","BSDX25",51,0)
 ; Set min DUZ vars
"RTN","BSDX25",52,0)
 D ^XBKVAR
"RTN","BSDX25",53,0)
 ;
"RTN","BSDX25",54,0)
 ; $ET
"RTN","BSDX25",55,0)
 N $ET S $ET="G ERROR^BSDX25"
"RTN","BSDX25",56,0)
 ;
"RTN","BSDX25",57,0)
 ; Test for error trap for Unit Tests
"RTN","BSDX25",58,0)
 I $G(BSDXDIE) N X S X=1/0
"RTN","BSDX25",59,0)
 ;
"RTN","BSDX25",60,0)
 N BSDXI S BSDXI=0
"RTN","BSDX25",61,0)
 ;
"RTN","BSDX25",62,0)
 S BSDXY=$NAME(^BSDXTMP($J))
"RTN","BSDX25",63,0)
 K @BSDXY
"RTN","BSDX25",64,0)
 ;
"RTN","BSDX25",65,0)
 S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
"RTN","BSDX25",66,0)
 ;
"RTN","BSDX25",67,0)
 I '+BSDXAPPTID D ERR("-1~Invalid Appointment ID") QUIT
"RTN","BSDX25",68,0)
 I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-1~Invalid Appointment ID") QUIT
"RTN","BSDX25",69,0)
 ;
"RTN","BSDX25",70,0)
 ; Lock BSDX node, only to synchronize access to the globals.
"RTN","BSDX25",71,0)
 ; It's not expected that the error will ever happen as no filing
"RTN","BSDX25",72,0)
 ; is supposed to take 5 seconds.
"RTN","BSDX25",73,0)
 L +^BSDXAPPT(BSDXAPPTID):5 E  D ERR("-4~Appt record is locked. Please contact technical support.") QUIT
"RTN","BSDX25",74,0)
 ;
"RTN","BSDX25",75,0)
 ; Remove Date formatting v.1.5. Client will send date as FM Date.
"RTN","BSDX25",76,0)
 ;S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@")
"RTN","BSDX25",77,0)
 ;S %DT="T",X=BSDXCDT D ^%DT S BSDXCDT=Y
"RTN","BSDX25",78,0)
 S BSDXCDT=+BSDXCDT  ; Strip off zeros if C# sends them
"RTN","BSDX25",79,0)
 I BSDXCDT'>2000000 D ERR("-2~Invalid Check-in Date") QUIT
"RTN","BSDX25",80,0)
 I BSDXCDT>$$NOW^XLFDT S BSDXCDT=$$NOW^XLFDT
"RTN","BSDX25",81,0)
 ;
"RTN","BSDX25",82,0)
 ; Some data
"RTN","BSDX25",83,0)
 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0) ; Appointment Node
"RTN","BSDX25",84,0)
 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
"RTN","BSDX25",85,0)
 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Appointment Start Time
"RTN","BSDX25",86,0)
 ;
"RTN","BSDX25",87,0)
 ; Get Hospital Location IEN from BSDXAPPT to BSDXRES (RESOUCE:HOSPITAL LOCATION)
"RTN","BSDX25",88,0)
 N BSDXSC1 S BSDXSC1=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",".07:.04","I")
"RTN","BSDX25",89,0)
 I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Null it off if it doesn't exist
"RTN","BSDX25",90,0)
 ;
"RTN","BSDX25",91,0)
 ; Check if we can check-in using BSDXAPI
"RTN","BSDX25",92,0)
 N BSDXERR S BSDXERR=0
"RTN","BSDX25",93,0)
 I BSDXSC1 S BSDXERR=$$CHECKIC1^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
"RTN","BSDX25",94,0)
 I BSDXERR D ERR(-10_"~"_$P(BSDXERR,U,2)) QUIT
"RTN","BSDX25",95,0)
 ;
"RTN","BSDX25",96,0)
 ; Checkin BSDX APPOINTMENT entry
"RTN","BSDX25",97,0)
 ; Failure Analysis: If we fail here, no changes were made.
"RTN","BSDX25",98,0)
 N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,BSDXCDT)
"RTN","BSDX25",99,0)
 I BSDXERR D ERR("-3~Fileman Filer failed to check-in appt") QUIT
"RTN","BSDX25",100,0)
 ;
"RTN","BSDX25",101,0)
 ; File check-in using BSDXAPI
"RTN","BSDX25",102,0)
 ; Failure Analysis: If we fail here, we need to roll back first check-in.
"RTN","BSDX25",103,0)
 N BSDXERR S BSDXERR=0
"RTN","BSDX25",104,0)
 I BSDXSC1 S BSDXERR=$$CHECKIN1^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
"RTN","BSDX25",105,0)
 I BSDXERR D  QUIT
"RTN","BSDX25",106,0)
 . N % S %=$$BSDXCHK(BSDXAPPTID,"@") ; No Error checking to prevent loop.
"RTN","BSDX25",107,0)
 . D ERR(-10_"~"_$P(BSDXERR,U,2)) ; Send error message to client
"RTN","BSDX25",108,0)
 ;
"RTN","BSDX25",109,0)
 L -^BSDXAPPT(BSDXAPPTID)
"RTN","BSDX25",110,0)
 S BSDXI=BSDXI+1
"RTN","BSDX25",111,0)
 S ^BSDXTMP($J,BSDXI)="0"_$C(30)
"RTN","BSDX25",112,0)
 S BSDXI=BSDXI+1
"RTN","BSDX25",113,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX25",114,0)
 Q
"RTN","BSDX25",115,0)
 ;
"RTN","BSDX25",116,0)
BSDXCHK(BSDXAPPTID,BSDXCDT) ; $$ Private Entry Point. File or delete check-in to
"RTN","BSDX25",117,0)
 ; BSDX Appointment
"RTN","BSDX25",118,0)
 ; Input: BSDXAPPTID -> Appointment ID
"RTN","BSDX25",119,0)
 ;        BSDXCDT -> Check-in date, or "@" to remove check-in.
"RTN","BSDX25",120,0)
 ;
"RTN","BSDX25",121,0)
 ; Output: 1^Error for error
"RTN","BSDX25",122,0)
 ;         0 for success
"RTN","BSDX25",123,0)
 ;
"RTN","BSDX25",124,0)
 Q:$G(BSDXSIMERR1) 1_U_"Simulated Error 1"
"RTN","BSDX25",125,0)
 ;
"RTN","BSDX25",126,0)
 N BSDXIENS,BSDXMSG,BSDXFDA ; Filer variables
"RTN","BSDX25",127,0)
 S BSDXIENS=BSDXAPPTID_","
"RTN","BSDX25",128,0)
 S BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT
"RTN","BSDX25",129,0)
 D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX25",130,0)
 Q:$D(BSDXMSG) 1_U_BSDXMSG("DIERR",1,"TEXT",1)
"RTN","BSDX25",131,0)
 Q 0
"RTN","BSDX25",132,0)
 ;
"RTN","BSDX25",133,0)
RMCI(BSDXY,BSDXAPPTID) ; Private EP - Remove Check-in from BSDX APPT and 2/44
"RTN","BSDX25",134,0)
 ; Called by RPC BSDX REMOVE CHECK-IN
"RTN","BSDX25",135,0)
 ; 
"RTN","BSDX25",136,0)
 ; Parameters to pass:
"RTN","BSDX25",137,0)
 ; APPTID: IEN in file BSDX APPOINTMENT
"RTN","BSDX25",138,0)
 ;
"RTN","BSDX25",139,0)
 ; Return in global array:
"RTN","BSDX25",140,0)
 ; Record set with Column ERRORID; value of 0 AOK; other value 
"RTN","BSDX25",141,0)
 ;  --> means that something went wrong
"RTN","BSDX25",142,0)
 ; 
"RTN","BSDX25",143,0)
 ; Error Reference:
"RTN","BSDX25",144,0)
 ; -1~Invalid Appointment ID (not passed)
"RTN","BSDX25",145,0)
 ; -2~Invalid Appointment ID (Doesn't exist in ^BSDXAPPT)
"RTN","BSDX25",146,0)
 ; -3~DB has corruption. Call Tech Support. (Resource ID doesn't exist in BSDXAPPT)
"RTN","BSDX25",147,0)
 ; -4~DB has corruption. Call Tech Support. (Resource ID in BSDXAPPT doesnt exist in BSDXRES)
"RTN","BSDX25",148,0)
 ; -5~BSDXAPI Error. Message depends on error.
"RTN","BSDX25",149,0)
 ; -6~Data Filing Error in BSDXCHK
"RTN","BSDX25",150,0)
 ; -7~Lock not acquired
"RTN","BSDX25",151,0)
 ; -100~Mumps Error
"RTN","BSDX25",152,0)
 ; 
"RTN","BSDX25",153,0)
 N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
"RTN","BSDX25",154,0)
 ;
"RTN","BSDX25",155,0)
 N $ET S $ET="G ERROR^BSDX25" ; Error Trap
"RTN","BSDX25",156,0)
 ;
"RTN","BSDX25",157,0)
 ; Set return variable and kill contents
"RTN","BSDX25",158,0)
 S BSDXY=$NAME(^BSDXTMP($J))
"RTN","BSDX25",159,0)
 K @BSDXY
"RTN","BSDX25",160,0)
 ; 
"RTN","BSDX25",161,0)
 N BSDXI S BSDXI=0 ; Initialize Counter
"RTN","BSDX25",162,0)
 ;
"RTN","BSDX25",163,0)
 S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30) ; Header of ADO recordset
"RTN","BSDX25",164,0)
 ;
"RTN","BSDX25",165,0)
 ;;;test
"RTN","BSDX25",166,0)
 I $G(BSDXDIE) N X S X=8/0
"RTN","BSDX25",167,0)
 ;
"RTN","BSDX25",168,0)
 ; Check for Appointment ID (passed and exists in file)
"RTN","BSDX25",169,0)
 I '+$G(BSDXAPPTID) D ERR("-1~Invalid Appointment ID") QUIT
"RTN","BSDX25",170,0)
 I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT
"RTN","BSDX25",171,0)
 ;
"RTN","BSDX25",172,0)
 ; Lock
"RTN","BSDX25",173,0)
 ; Timeout not expected to happen except in error conditions.
"RTN","BSDX25",174,0)
 L +^BSDXAPPT(BSDXAPPTID):5 E  D ERR("-7~Appt record is locked. Please contact technical support.") QUIT
"RTN","BSDX25",175,0)
 ;
"RTN","BSDX25",176,0)
 ; Get appointment Data
"RTN","BSDX25",177,0)
 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0)
"RTN","BSDX25",178,0)
 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
"RTN","BSDX25",179,0)
 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date
"RTN","BSDX25",180,0)
 N BSDXRESID S BSDXRESID=$P(BSDXNOD,U,7) ; Resource ID
"RTN","BSDX25",181,0)
 ; 
"RTN","BSDX25",182,0)
 ; If the resource doesn't exist, error out. DB is corrupt.
"RTN","BSDX25",183,0)
 I 'BSDXRESID D ERR("-3~DB has corruption. Call Tech Support.") QUIT
"RTN","BSDX25",184,0)
 I '$D(^BSDXRES(BSDXRESID,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT 
"RTN","BSDX25",185,0)
 ;
"RTN","BSDX25",186,0)
 ; Get HL Data
"RTN","BSDX25",187,0)
 N BSDXNOD S BSDXNOD=^BSDXRES(BSDXRESID,0) ; Resource 0 node
"RTN","BSDX25",188,0)
 N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION IEN
"RTN","BSDX25",189,0)
 I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Zero out if HL doesn't exist
"RTN","BSDX25",190,0)
 ;
"RTN","BSDX25",191,0)
 ; Is it okay to remove check-in from PIMS?
"RTN","BSDX25",192,0)
 N BSDXERR S BSDXERR=0 ; Scratch variable
"RTN","BSDX25",193,0)
 ; $$RMCICK = Remove Check-in Check
"RTN","BSDX25",194,0)
 I BSDXSC1 S BSDXERR=$$RMCICK^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART)
"RTN","BSDX25",195,0)
 I BSDXERR D ERR("-5~"_$P(BSDXERR,U,2)) QUIT
"RTN","BSDX25",196,0)
 ;
"RTN","BSDX25",197,0)
 ; For possible rollback, get old check-in date (internal value)
"RTN","BSDX25",198,0)
 N BSDXCDT S BSDXCDT=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",.03,"I")
"RTN","BSDX25",199,0)
 ;
"RTN","BSDX25",200,0)
 ; Remove checkin from BSDX APPOINTMENT entry
"RTN","BSDX25",201,0)
 ; No need to rollback here on failure.
"RTN","BSDX25",202,0)
 N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,"@")
"RTN","BSDX25",203,0)
 I BSDXERR D ERR("-6~Cannot file data in $$BSDXCHK") QUIT
"RTN","BSDX25",204,0)
 ;
"RTN","BSDX25",205,0)
 ; Now, remove checkin from PIMS files 2/44
"RTN","BSDX25",206,0)
 ; Restore BSDXCDT into ^BSDXAPPT if we fail.
"RTN","BSDX25",207,0)
 N BSDXERR S BSDXERR=0 ; Scratch variable to hold error message
"RTN","BSDX25",208,0)
 I BSDXSC1 S BSDXERR=$$RMCI^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART)
"RTN","BSDX25",209,0)
 I BSDXERR D  QUIT
"RTN","BSDX25",210,0)
 . N % S %=$$BSDXCHK(BSDXAPPTID,BSDXCDT) ; No error checking here.
"RTN","BSDX25",211,0)
 . D ERR("-5~"_$P(BSDXERR,U,2)) ; Send error message to client
"RTN","BSDX25",212,0)
 ;
"RTN","BSDX25",213,0)
 ; Unlock
"RTN","BSDX25",214,0)
 L -^BSDXAPPT(BSDXAPPTID)
"RTN","BSDX25",215,0)
 ;
"RTN","BSDX25",216,0)
 ; Return ADO recordset
"RTN","BSDX25",217,0)
 S BSDXI=BSDXI+1
"RTN","BSDX25",218,0)
 S ^BSDXTMP($J,BSDXI)="0"_$C(30)
"RTN","BSDX25",219,0)
 S BSDXI=BSDXI+1
"RTN","BSDX25",220,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX25",221,0)
 Q
"RTN","BSDX25",222,0)
 ;
"RTN","BSDX25",223,0)
CHKEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CHECKIN APPOINTMENT event
"RTN","BSDX25",224,0)
 ;when appointments CHECKIN via PIMS interface.
"RTN","BSDX25",225,0)
 ;Propagates CHECKIN to BSDXAPPT and raises refresh event to running GUI clients
"RTN","BSDX25",226,0)
 ;
"RTN","BSDX25",227,0)
 Q:+$G(BSDXNOEV)
"RTN","BSDX25",228,0)
 Q:'+$G(BSDXSC)
"RTN","BSDX25",229,0)
 N BSDXSTAT,BSDXFOUND,BSDXRES
"RTN","BSDX25",230,0)
 S BSDXSTAT=""
"RTN","BSDX25",231,0)
 S:$G(SDATA("AFTER","STATUS"))["CHECKED IN" BSDXSTAT=$P(SDATA("AFTER","STATUS"),"^",4)
"RTN","BSDX25",232,0)
 S BSDXFOUND=0
"RTN","BSDX25",233,0)
 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
"RTN","BSDX25",234,0)
 I BSDXFOUND D CHKEVT3(BSDXRES) Q
"RTN","BSDX25",235,0)
 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
"RTN","BSDX25",236,0)
 I BSDXFOUND D CHKEVT3(BSDXRES)
"RTN","BSDX25",237,0)
 Q
"RTN","BSDX25",238,0)
 ;
"RTN","BSDX25",239,0)
CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
"RTN","BSDX25",240,0)
 ;Get appointment id in BSDXAPT
"RTN","BSDX25",241,0)
 ;If found, call BSDXNOS(BSDXAPPT) and return 1
"RTN","BSDX25",242,0)
 ;else return 0
"RTN","BSDX25",243,0)
 N BSDXFOUND,BSDXAPPT
"RTN","BSDX25",244,0)
 S BSDXFOUND=0
"RTN","BSDX25",245,0)
 Q:'+$G(BSDXRES) BSDXFOUND
"RTN","BSDX25",246,0)
 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
"RTN","BSDX25",247,0)
 S BSDXAPPT=0 F  S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT  D  Q:BSDXFOUND
"RTN","BSDX25",248,0)
 . N BSDXNOD S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
"RTN","BSDX25",249,0)
 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
"RTN","BSDX25",250,0)
 I BSDXFOUND,+$G(BSDXAPPT) D
"RTN","BSDX25",251,0)
 . N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPT,BSDXSTAT)
"RTN","BSDX25",252,0)
 . I BSDXERR D ^%ZTER ; VEN/SMH - This is silent. This is a last resort
"RTN","BSDX25",253,0)
 Q BSDXFOUND
"RTN","BSDX25",254,0)
 ;
"RTN","BSDX25",255,0)
CHKEVT3(BSDXRES) ;
"RTN","BSDX25",256,0)
 ;Call RaiseEvent to notify GUI clients
"RTN","BSDX25",257,0)
 ;
"RTN","BSDX25",258,0)
 N BSDXRESN
"RTN","BSDX25",259,0)
 S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
"RTN","BSDX25",260,0)
 Q:BSDXRESN=""
"RTN","BSDX25",261,0)
 S BSDXRESN=$P(BSDXRESN,"^")
"RTN","BSDX25",262,0)
 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
"RTN","BSDX25",263,0)
 Q
"RTN","BSDX25",264,0)
 ;
"RTN","BSDX25",265,0)
ERROR ;
"RTN","BSDX25",266,0)
 S $ETRAP="D ^%ZTER HALT"  ; Emergency Error Trap for the wise
"RTN","BSDX25",267,0)
 D ^%ZTER
"RTN","BSDX25",268,0)
 ; VEN/SMH: NB: I make a conscious decision not to roll back anything
"RTN","BSDX25",269,0)
 ; here in the error trap. Once the error is fixed, users can 
"RTN","BSDX25",270,0)
 ; undo or redo the check-in.
"RTN","BSDX25",271,0)
 ; Individual portions of this routine may choose to do rolling back
"RTN","BSDX25",272,0)
 ; of their own (e.g. a failed call to BSDXAPI causes rollback to occur
"RTN","BSDX25",273,0)
 ; in CHECKIN and RMCI)
"RTN","BSDX25",274,0)
 ;
"RTN","BSDX25",275,0)
 ; Log error message and send to client
"RTN","BSDX25",276,0)
 D ERR("-100~Mumps Error")
"RTN","BSDX25",277,0)
 Q:$Q "-100^Mumps Error" Q
"RTN","BSDX25",278,0)
 ;
"RTN","BSDX25",279,0)
ERR(BSDXERR) ;Error processing
"RTN","BSDX25",280,0)
 ; Unlock first
"RTN","BSDX25",281,0)
 L:$D(BSDXAPPTID) -^BSDXAPPT(BSDXAPPTID)
"RTN","BSDX25",282,0)
 ; If last line is $C(31), we are done. No more errors to send to client.
"RTN","BSDX25",283,0)
 I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
"RTN","BSDX25",284,0)
 S BSDXERR=$G(BSDXERR)
"RTN","BSDX25",285,0)
 S BSDXERR=$P(BSDXERR,"~")_"~"_$TEXT(+0)_":"_$P(BSDXERR,"~",2) ; Append Routine Name
"RTN","BSDX25",286,0)
 S BSDXI=$G(BSDXI)+1
"RTN","BSDX25",287,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
"RTN","BSDX25",288,0)
 S BSDXI=BSDXI+1
"RTN","BSDX25",289,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX25",290,0)
 QUIT
"RTN","BSDX26")
0^24^B15866028
"RTN","BSDX26",1,0)
BSDX26  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:27am
"RTN","BSDX26",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX26",3,0)
 ; Licensed under LGPL
"RTN","BSDX26",4,0)
 ; Change History:
"RTN","BSDX26",5,0)
 ; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx.
"RTN","BSDX26",6,0)
 ; 3101205 - UJO/SMH - Extensive refactoring.
"RTN","BSDX26",7,0)
 ; 3120625 - VEN/SMH - Removal of Transactions, reloation of UTs to BSDXUT1
"RTN","BSDX26",8,0)
 ;
"RTN","BSDX26",9,0)
 ; Error Reference:
"RTN","BSDX26",10,0)
 ; 1: Appt ID is not a number
"RTN","BSDX26",11,0)
 ; 2: Appt IEN is not in ^BSDXAPPT
"RTN","BSDX26",12,0)
 ; 3: FM Failure to file WP field in ^BSDXAPPT
"RTN","BSDX26",13,0)
 ; 4: BSDXAPI reports failure to change note field in ^SC
"RTN","BSDX26",14,0)
 ; 5: Failure to acquire lock on ^BSDXAPPT(APPTID)
"RTN","BSDX26",15,0)
 ; 100: Mumps Error
"RTN","BSDX26",16,0)
 ; 
"RTN","BSDX26",17,0)
 ; NB: Normally I use negative numbers for errors; this routine returns
"RTN","BSDX26",18,0)
 ;     -1 as a successful result! So I needed to use +ve numbers.
"RTN","BSDX26",19,0)
 ;
"RTN","BSDX26",20,0)
EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE)  ;EP
"RTN","BSDX26",21,0)
 ;Entry point for debugging
"RTN","BSDX26",22,0)
 ;
"RTN","BSDX26",23,0)
 ;D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
"RTN","BSDX26",24,0)
 Q
"RTN","BSDX26",25,0)
EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE)   ;EP Edit appointment (only note text can be edited)
"RTN","BSDX26",26,0)
 ; Called by RPC: BSDX EDIT APPOINTMENT
"RTN","BSDX26",27,0)
 ;
"RTN","BSDX26",28,0)
 ; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file
"RTN","BSDX26",29,0)
 ;
"RTN","BSDX26",30,0)
 ; Parameters:
"RTN","BSDX26",31,0)
 ; - BSDXY: Global Return (RPC must be set to Global Array)
"RTN","BSDX26",32,0)
 ; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT
"RTN","BSDX26",33,0)
 ; - BSDXNOTE: New note
"RTN","BSDX26",34,0)
 ;
"RTN","BSDX26",35,0)
 ; Return:
"RTN","BSDX26",36,0)
 ; ADO.net Recordset having 1 field: ERRORID
"RTN","BSDX26",37,0)
 ; If Okay: -1; otherwise, positive integer with message
"RTN","BSDX26",38,0)
 ;
"RTN","BSDX26",39,0)
 ; Return Array; set Return and clear array
"RTN","BSDX26",40,0)
 S BSDXY=$NA(^BSDXTMP($J))
"RTN","BSDX26",41,0)
 K ^BSDXTMP($J)
"RTN","BSDX26",42,0)
 ; ET
"RTN","BSDX26",43,0)
 N $ET S $ET="G ETRAP^BSDX26"
"RTN","BSDX26",44,0)
 ; Set up basic DUZ variables
"RTN","BSDX26",45,0)
 D ^XBKVAR
"RTN","BSDX26",46,0)
 ; Counter
"RTN","BSDX26",47,0)
 N BSDXI S BSDXI=0
"RTN","BSDX26",48,0)
 ; Header Node
"RTN","BSDX26",49,0)
 S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
"RTN","BSDX26",50,0)
 ;
"RTN","BSDX26",51,0)
 ;;;test for error. See if %ZTER works
"RTN","BSDX26",52,0)
 I $G(BSDXDIE) S X=1/0
"RTN","BSDX26",53,0)
 ;
"RTN","BSDX26",54,0)
 ; Validate Appointment ID
"RTN","BSDX26",55,0)
 I '+BSDXAPTID D ERR(BSDXI,"1~BSDX26: Invalid Appointment ID") QUIT
"RTN","BSDX26",56,0)
 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"2~BSDX26: Invalid Appointment ID") QUIT
"RTN","BSDX26",57,0)
 ;
"RTN","BSDX26",58,0)
 ; Lock BSDX node, only to synchronize access to the globals.
"RTN","BSDX26",59,0)
 ; It's not expected that the error will ever happen as no filing
"RTN","BSDX26",60,0)
 ; is supposed to take 5 seconds.
"RTN","BSDX26",61,0)
 L +^BSDXAPPT(BSDXAPTID):5 E  D ERR(BSDXI,"5~BSDX08: Appt record is locked. Please contact technical support.") QUIT
"RTN","BSDX26",62,0)
 ;
"RTN","BSDX26",63,0)
 ; Put the WP in decendant fields from the root to file as a WP field
"RTN","BSDX26",64,0)
 S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
"RTN","BSDX26",65,0)
 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
"RTN","BSDX26",66,0)
 ;
"RTN","BSDX26",67,0)
 N BSDXMSG ; Message in case of error in filing.
"RTN","BSDX26",68,0)
 ;
"RTN","BSDX26",69,0)
 ; Save Before State in case we need it for rollback
"RTN","BSDX26",70,0)
 K ^TMP($J)
"RTN","BSDX26",71,0)
 M ^TMP($J,"BEFORE","BSDXAPPT")=^BSDXAPPT(BSDXAPTID)
"RTN","BSDX26",72,0)
 ;
"RTN","BSDX26",73,0)
 ; Update note in BSDX APPOINTMENT
"RTN","BSDX26",74,0)
 I $D(BSDXNOTE(.5)) D
"RTN","BSDX26",75,0)
 . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG")
"RTN","BSDX26",76,0)
 ;
"RTN","BSDX26",77,0)
 ; Error handling. No need for rollback since nothing else changed.
"RTN","BSDX26",78,0)
 I $D(BSDXMSG) D ERR(BSDXI,"3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
"RTN","BSDX26",79,0)
 ;
"RTN","BSDX26",80,0)
 ; Now file in file 44:
"RTN","BSDX26",81,0)
 N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN
"RTN","BSDX26",82,0)
 N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID
"RTN","BSDX26",83,0)
 N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT
"RTN","BSDX26",84,0)
 N BSDXRES S BSDXRES=0 ; Result
"RTN","BSDX26",85,0)
 ; Update Note only if we have a linked hospital location.
"RTN","BSDX26",86,0)
 I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI1(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
"RTN","BSDX26",87,0)
 ; If we get an error (denoted by -1 in BSDXRES), return error to client
"RTN","BSDX26",88,0)
 ; AND restore the original note
"RTN","BSDX26",89,0)
 I BSDXRES D ERR(BSDXI,"4~BSDX26: BSDXAPI reports an error: "_BSDXRES),ROLLBACK(BSDXAPTID) QUIT
"RTN","BSDX26",90,0)
 ;
"RTN","BSDX26",91,0)
 ;Return Recordset indicating success
"RTN","BSDX26",92,0)
 L -^BSDXAPPT(BSDXAPTID)
"RTN","BSDX26",93,0)
 S BSDXI=BSDXI+1
"RTN","BSDX26",94,0)
 S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
"RTN","BSDX26",95,0)
 S BSDXI=BSDXI+1
"RTN","BSDX26",96,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX26",97,0)
 ;
"RTN","BSDX26",98,0)
 K ^TMP($J) ; Done; remove TMP data
"RTN","BSDX26",99,0)
 QUIT
"RTN","BSDX26",100,0)
 ;
"RTN","BSDX26",101,0)
ROLLBACK(BSDXAPTID) ; Rollback note to original in ^BSDXAPPT
"RTN","BSDX26",102,0)
 M ^BSDXAPPT(BSDXAPTID)=^TMP($J,"BEFORE","BSDXAPPT")
"RTN","BSDX26",103,0)
 K ^TMP($J)
"RTN","BSDX26",104,0)
 QUIT
"RTN","BSDX26",105,0)
 ;
"RTN","BSDX26",106,0)
ERR(BSDXI,BSDXERR)  ;Error processing
"RTN","BSDX26",107,0)
 ; Unlock first
"RTN","BSDX26",108,0)
 L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
"RTN","BSDX26",109,0)
 ; If last line is $C(31), we are done. No more errors to send to client.
"RTN","BSDX26",110,0)
 I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
"RTN","BSDX26",111,0)
 S BSDXI=BSDXI+1
"RTN","BSDX26",112,0)
 S BSDXERR=$TR(BSDXERR,"^","~")
"RTN","BSDX26",113,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
"RTN","BSDX26",114,0)
 S BSDXI=BSDXI+1
"RTN","BSDX26",115,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX26",116,0)
 QUIT
"RTN","BSDX26",117,0)
 ;
"RTN","BSDX26",118,0)
ETRAP   ;EP Error trap entry
"RTN","BSDX26",119,0)
 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
"RTN","BSDX26",120,0)
 D ^%ZTER
"RTN","BSDX26",121,0)
 ;
"RTN","BSDX26",122,0)
 I '$D(BSDXI) N BSDXI S BSDXI=0
"RTN","BSDX26",123,0)
 D ERR(BSDXI,"100~BSDX26 Error: "_$G(%ZTERZE))
"RTN","BSDX26",124,0)
 QUIT
"RTN","BSDX27")
0^25^B133802805
"RTN","BSDX27",1,0)
BSDX27  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
"RTN","BSDX27",2,0)
    ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX27",3,0)
    ; Licensed under LGPL
"RTN","BSDX27",4,0)
    ; 
"RTN","BSDX27",5,0)
    ; Change Log: July 15, 2010
"RTN","BSDX27",6,0)
    ; UJO/SMH - i18n: FM Dates passed into routine for Clinic Letters - CLDISP ta
"RTN","BSDX27",7,0)
    ; v 1.42 - 3101208 - SMH
"RTN","BSDX27",8,0)
    ; - Added check to skip cancelled appointments. Check was forgotten
"RTN","BSDX27",9,0)
    ;   in original code.
"RTN","BSDX27",10,0)
    ;   . N BSDXFLAGS S BSDXFLAGS=$P(BSDXNOD,U,2)  ; No show and Cancel Flags
"RTN","BSDX27",11,0)
    ;   . Q:BSDXFLAGS["C"  ; if appt is cancelled, quit
"RTN","BSDX27",12,0)
    ;
"RTN","BSDX27",13,0)
    Q
"RTN","BSDX27",14,0)
    ;
"RTN","BSDX27",15,0)
PADISPD(BSDXY,BSDXPAT)  ;EP
"RTN","BSDX27",16,0)
    ;Entry point for debugging
"RTN","BSDX27",17,0)
    ;
"RTN","BSDX27",18,0)
    ;D DEBUG^%Serenji("PADISP^BSDX27(.BSDXY,BSDXPAT)")
"RTN","BSDX27",19,0)
    Q
"RTN","BSDX27",20,0)
    ;
"RTN","BSDX27",21,0)
PADISP(BSDXY,BSDXPAT)   ;EP
"RTN","BSDX27",22,0)
    ;Return recordset of patient appointments used in listing
"RTN","BSDX27",23,0)
    ;a patient's appointments and generating patient letters.
"RTN","BSDX27",24,0)
    ;Called by rpc BSDX PATIENT APPT DISPLAY
"RTN","BSDX27",25,0)
    ;
"RTN","BSDX27",26,0)
    ; Sam's Notes:
"RTN","BSDX27",27,0)
    ; Relatively complex algorithm.
"RTN","BSDX27",28,0)
    ; 1. First, loop through ^DPT(DA,"S", and get all appointments. 
"RTN","BSDX27",29,0)
    ;   Exclude cancelled appts. Store in BSDXDPT array.
"RTN","BSDX27",30,0)
    ; 2. Go through ^BSDXAPPT("CPAT", (patient index) . 
"RTN","BSDX27",31,0)
    ;   Get the info from there and compar with BSDXDPT array. If 
"RTN","BSDX27",32,0)
    ;   they are the same, get all info, and rm entry from BSDXDPT array.
"RTN","BSDX27",33,0)
    ; 3. If there are any remaining entries in BSDXDPT (PIMS leftovers),
"RTN","BSDX27",34,0)
    ;   Get the data from file 2 and 44.
"RTN","BSDX27",35,0)
    ;
"RTN","BSDX27",36,0)
    N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ
"RTN","BSDX27",37,0)
    N BSDXSTRT
"RTN","BSDX27",38,0)
    N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
"RTN","BSDX27",39,0)
    S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX27",40,0)
    S BSDXI=0
"RTN","BSDX27",41,0)
    S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
"RTN","BSDX27",42,0)
    S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30)
"RTN","BSDX27",43,0)
    S X="ERROR^BSDX27",@^%ZOSF("TRAP")
"RTN","BSDX27",44,0)
    ;Get patient info
"RTN","BSDX27",45,0)
    ;
"RTN","BSDX27",46,0)
    I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q
"RTN","BSDX27",47,0)
    I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q
"RTN","BSDX27",48,0)
    S BSDXNOD=$$PATINFO(BSDXPAT)
"RTN","BSDX27",49,0)
    S BSDXNAM=$P(BSDXNOD,U) ;NAME
"RTN","BSDX27",50,0)
    S BSDXSEX=$P(BSDXNOD,U,2) ;SEX
"RTN","BSDX27",51,0)
    S BSDXDOB=$P(BSDXNOD,U,3) ;DOB
"RTN","BSDX27",52,0)
    S BSDXHRN=$P(BSDXNOD,U,4) ;Health Record Number for location DUZ(2)
"RTN","BSDX27",53,0)
    S BSDXSTRE=$P(BSDXNOD,U,5) ;Street
"RTN","BSDX27",54,0)
    S BSDXCITY=$P(BSDXNOD,U,6) ;City
"RTN","BSDX27",55,0)
    S BSDXST=$P(BSDXNOD,U,7) ;State
"RTN","BSDX27",56,0)
    S BSDXZIP=$P(BSDXNOD,U,8) ;zip
"RTN","BSDX27",57,0)
    S BSDXPHON=$P(BSDXNOD,U,9) ;homephone
"RTN","BSDX27",58,0)
    ;
"RTN","BSDX27",59,0)
    ;Organize ^DPT(BSDXPAT,"S," nodes
"RTN","BSDX27",60,0)
    ; into BSDXDPT(CLINIC,DATE)
"RTN","BSDX27",61,0)
    ;
"RTN","BSDX27",62,0)
    I $D(^DPT(BSDXPAT,"S")) S BSDXDT=0 F  S BSDXDT=$O(^DPT(BSDXPAT,"S",BSDXDT)) Q:'+BSDXDT  D
"RTN","BSDX27",63,0)
    . S BSDXNOD=$G(^DPT(BSDXPAT,"S",BSDXDT,0))
"RTN","BSDX27",64,0)
    . S BSDXCID=$P(BSDXNOD,U)
"RTN","BSDX27",65,0)
    . Q:'+BSDXCID
"RTN","BSDX27",66,0)
    . Q:'$D(^SC(BSDXCID,0))
"RTN","BSDX27",67,0)
    . N BSDXFLAGS S BSDXFLAGS=$P(BSDXNOD,U,2)  ; No show and Cancel Flags
"RTN","BSDX27",68,0)
    . Q:BSDXFLAGS["C"  ; if appt is cancelled, quit
"RTN","BSDX27",69,0)
    . S BSDXDPT(BSDXCID,BSDXDT)=BSDXNOD
"RTN","BSDX27",70,0)
    ;
"RTN","BSDX27",71,0)
    ;$O Through ^BSDX("CPAT",
"RTN","BSDX27",72,0)
    S BSDXIEN=0
"RTN","BSDX27",73,0)
    I $D(^BSDXAPPT("CPAT",BSDXPAT)) F  S BSDXIEN=$O(^BSDXAPPT("CPAT",BSDXPAT,BSDXIEN)) Q:'BSDXIEN  D
"RTN","BSDX27",74,0)
    . N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN
"RTN","BSDX27",75,0)
    . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
"RTN","BSDX27",76,0)
    . Q:BSDXNOD=""
"RTN","BSDX27",77,0)
    . Q:$P(BSDXNOD,U,12)]""  ;CANCELLED
"RTN","BSDX27",78,0)
    . S Y=$P(BSDXNOD,U)
"RTN","BSDX27",79,0)
    . Q:'+Y
"RTN","BSDX27",80,0)
    . X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",81,0)
    . S BSDXAPT=Y ;Appointment date time
"RTN","BSDX27",82,0)
    . S BSDXCLRK=$P(BSDXNOD,U,8) ;Appointment made by
"RTN","BSDX27",83,0)
    . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
"RTN","BSDX27",84,0)
    . S Y=$P(BSDXNOD,U,9) ;Date Appointment Made
"RTN","BSDX27",85,0)
    . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",86,0)
    . S BSDXMADE=Y
"RTN","BSDX27",87,0)
    . ;NOTE
"RTN","BSDX27",88,0)
    . S BSDXNOT=""
"RTN","BSDX27",89,0)
    . I $D(^BSDXAPPT(BSDXIEN,1,0)) S BSDXNOT="",BSDXQ=0 F  S BSDXQ=$O(^BSDXAPPT(BSDXIEN,1,BSDXQ)) Q:'+BSDXQ  D
"RTN","BSDX27",90,0)
    . . S BSDXLIN=$G(^BSDXAPPT(BSDXIEN,1,BSDXQ,0))
"RTN","BSDX27",91,0)
    . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
"RTN","BSDX27",92,0)
    . . S BSDXNOT=BSDXNOT_BSDXLIN
"RTN","BSDX27",93,0)
    . ;Resource
"RTN","BSDX27",94,0)
    . S BSDXCID=$P(BSDXNOD,U,7) ;IEN of BSDX RESOURCE
"RTN","BSDX27",95,0)
    . Q:'+BSDXCID
"RTN","BSDX27",96,0)
    . Q:'$D(^BSDXRES(BSDXCID,0))
"RTN","BSDX27",97,0)
    . S BSDXCNOD=$G(^BSDXRES(BSDXCID,0)) ;BSDX RESOURCE node
"RTN","BSDX27",98,0)
    . Q:BSDXCNOD=""
"RTN","BSDX27",99,0)
    . S BSDXCLN=$P(BSDXCNOD,U) ;Text name of BSDX Resource
"RTN","BSDX27",100,0)
    . S BSDX44=$P(BSDXCNOD,U,4) ;File 44 pointer
"RTN","BSDX27",101,0)
    . ;If appt entry in ^DPT(PAT,"S" exists for this clinic, get the TYPE/STATUS info from
"RTN","BSDX27",102,0)
    . ;the BSDXDPT array and delete the BSDXDPT node
"RTN","BSDX27",103,0)
    . S BSDXTYPE=""
"RTN","BSDX27",104,0)
    . I +BSDX44,$D(BSDXDPT(BSDX44,$P(BSDXNOD,U))) D  ;BSDXNOD is the BSDX APPOINTMENT node
"RTN","BSDX27",105,0)
    . . S BSDXDNOD=BSDXDPT(BSDX44,$P(BSDXNOD,U)) ;BSDXDNOD is a copy of the ^DPT(PAT,"S" node
"RTN","BSDX27",106,0)
    . . S BSDXTYPE=$$STATUS(BSDXPAT,$P(BSDXNOD,U),BSDXDNOD) ;IHS/OIT/HMW 20050208 Added
"RTN","BSDX27",107,0)
    . . K BSDXDPT(BSDX44,$P(BSDXNOD,U))
"RTN","BSDX27",108,0)
    . S BSDXI=BSDXI+1
"RTN","BSDX27",109,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",110,0)
    . Q
"RTN","BSDX27",111,0)
    ;
"RTN","BSDX27",112,0)
    ;Go through remaining BSDXDPT( entries
"RTN","BSDX27",113,0)
    I $D(BSDXDPT) S BSDX44=0 D
"RTN","BSDX27",114,0)
    . F  S BSDX44=$O(BSDXDPT(BSDX44)) Q:'+BSDX44  S BSDXDT=0 D
"RTN","BSDX27",115,0)
    . . F  S BSDXDT=$O(BSDXDPT(BSDX44,BSDXDT)) Q:'+BSDXDT  D
"RTN","BSDX27",116,0)
    . . . S BSDXDNOD=BSDXDPT(BSDX44,BSDXDT)
"RTN","BSDX27",117,0)
    . . . S Y=BSDXDT
"RTN","BSDX27",118,0)
    . . . Q:'+Y
"RTN","BSDX27",119,0)
    . . . X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",120,0)
    . . . S BSDXAPT=Y
"RTN","BSDX27",121,0)
    . . . S BSDXTYPE=$$STATUS(BSDXPAT,BSDXDT,BSDXDNOD) ;IHS/OIT/HMW 20050208 Added
"RTN","BSDX27",122,0)
    . . . S BSDXCLN=$P($G(^SC(BSDX44,0)),U)
"RTN","BSDX27",123,0)
    . . . S BSDXCLRK=$P(BSDXDNOD,U,18)
"RTN","BSDX27",124,0)
    . . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
"RTN","BSDX27",125,0)
    . . . S Y=$P(BSDXDNOD,U,19)
"RTN","BSDX27",126,0)
    . . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",127,0)
    . . . S BSDXMADE=Y
"RTN","BSDX27",128,0)
    . . . S BSDXNOT=""
"RTN","BSDX27",129,0)
    . . . S BSDXI=BSDXI+1
"RTN","BSDX27",130,0)
    . . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30)
"RTN","BSDX27",131,0)
    . . . K BSDXDPT(BSDX44,BSDXDT)
"RTN","BSDX27",132,0)
    ;
"RTN","BSDX27",133,0)
    S BSDXI=BSDXI+1
"RTN","BSDX27",134,0)
    S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX27",135,0)
    Q
"RTN","BSDX27",136,0)
    ;
"RTN","BSDX27",137,0)
STATUS(PAT,DATE,NODE)   ; returns appt status
"RTN","BSDX27",138,0)
    ;IHS/OIT/HMW 20050208 Added from BSDDPA
"RTN","BSDX27",139,0)
    NEW TYP
"RTN","BSDX27",140,0)
    S TYP=$$APPTYP^BSDXAPI(PAT,DATE)    ;sched vs. walkin
"RTN","BSDX27",141,0)
    I $P(NODE,U,2)["C" Q TYP_" - CANCELLED"
"RTN","BSDX27",142,0)
    I $P(NODE,U,2)'="NT",$P(NODE,U,2)["N" Q TYP_" - NO SHOW"
"RTN","BSDX27",143,0)
    I $$CO^BSDXAPI(PAT,+NODE,DATE) Q TYP_" - CHECKED OUT"
"RTN","BSDX27",144,0)
    I $$CI^BSDXAPI(PAT,+NODE,DATE) Q TYP_" - CHECKED IN"
"RTN","BSDX27",145,0)
    Q TYP
"RTN","BSDX27",146,0)
    ;
"RTN","BSDX27",147,0)
ERROR   ;
"RTN","BSDX27",148,0)
    D ERR(BSDXI,"RPMS Error")
"RTN","BSDX27",149,0)
    Q
"RTN","BSDX27",150,0)
    ;
"RTN","BSDX27",151,0)
ERR(BSDXI,ERRNO,MSG)    ;Error processing
"RTN","BSDX27",152,0)
    S:'$D(BSDXI) BSDXI=999
"RTN","BSDX27",153,0)
    I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
"RTN","BSDX27",154,0)
    E  S BSDXERR=ERRNO
"RTN","BSDX27",155,0)
    S BSDXI=BSDXI+1
"RTN","BSDX27",156,0)
    S ^BSDXTMP($J,BSDXI)=MSG_"^^^^^^^^^^^^^^^"_$C(30)
"RTN","BSDX27",157,0)
    S BSDXI=BSDXI+1
"RTN","BSDX27",158,0)
    S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX27",159,0)
    Q
"RTN","BSDX27",160,0)
PATINFO(BSDXPAT)    ;EP
"RTN","BSDX27",161,0)
    ;Intrisic Function returns NAME^SEX^DOB^HRN^STREET^CITY^STATE^ZIP^PHONE for patient ien BSDXPAT
"RTN","BSDX27",162,0)
    ;DOB is in external format
"RTN","BSDX27",163,0)
    ;HRN depends on existence of DUZ(2)
"RTN","BSDX27",164,0)
    ;
"RTN","BSDX27",165,0)
    N BSDXNOD,BSDXNAM,BSDXSEX,BSDXDOB,BSDXHRN,BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
"RTN","BSDX27",166,0)
    S BSDXNOD=^DPT(+BSDXPAT,0)
"RTN","BSDX27",167,0)
    S BSDXNAM=$P(BSDXNOD,U) ;NAME
"RTN","BSDX27",168,0)
    S BSDXSEX=$P(BSDXNOD,U,2)
"RTN","BSDX27",169,0)
    S BSDXSEX=$S(BSDXSEX="F":"FEMALE",BSDXSEX="M":"MALE",1:"")
"RTN","BSDX27",170,0)
    S Y=$P(BSDXNOD,U,3) I Y]""  X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",171,0)
    S BSDXDOB=Y ;DOB
"RTN","BSDX27",172,0)
    S BSDXHRN=""
"RTN","BSDX27",173,0)
    I $D(DUZ(2)) I DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPAT,41,DUZ(2),0)),U,2) ;HRN
"RTN","BSDX27",174,0)
    ;
"RTN","BSDX27",175,0)
    S BSDXNOD=$G(^DPT(+BSDXPAT,.11))
"RTN","BSDX27",176,0)
    S (BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP)=""
"RTN","BSDX27",177,0)
    I BSDXNOD]"" D
"RTN","BSDX27",178,0)
    . S BSDXSTRT=$E($P(BSDXNOD,U),1,50) ;STREET
"RTN","BSDX27",179,0)
    . S BSDXCITY=$P(BSDXNOD,U,4) ;CITY
"RTN","BSDX27",180,0)
    . S BSDXST=$P(BSDXNOD,U,5) ;STATE
"RTN","BSDX27",181,0)
    . I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2)
"RTN","BSDX27",182,0)
    . S BSDXZIP=$P(BSDXNOD,U,6) ;ZIP
"RTN","BSDX27",183,0)
    ;
"RTN","BSDX27",184,0)
    S BSDXNOD=$G(^DPT(+BSDXPAT,.13)) ;PHONE
"RTN","BSDX27",185,0)
    S BSDXPHON=$P(BSDXNOD,U)
"RTN","BSDX27",186,0)
    ;
"RTN","BSDX27",187,0)
    Q BSDXNAM_U_BSDXSEX_U_BSDXDOB_U_BSDXHRN_U_BSDXSTRT_U_BSDXCITY_U_BSDXST_U_BSDXZIP_U_BSDXPHON
"RTN","BSDX27",188,0)
    ;
"RTN","BSDX27",189,0)
CLDISPD(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
"RTN","BSDX27",190,0)
    ;Entry point for debugging
"RTN","BSDX27",191,0)
    ;
"RTN","BSDX27",192,0)
    ;D DEBUG^%Serenji("CLDISP^BSDX27(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")
"RTN","BSDX27",193,0)
    Q
"RTN","BSDX27",194,0)
    ;
"RTN","BSDX27",195,0)
CLDISP(BSDXY,BSDXCLST,BSDXBEG,BSDXEND)  ;EP
"RTN","BSDX27",196,0)
    ;
"RTN","BSDX27",197,0)
    ;Return recordset of patient appointments
"RTN","BSDX27",198,0)
    ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
"RTN","BSDX27",199,0)
    ;Used in listing a patient's appointments and generating patient letters.
"RTN","BSDX27",200,0)
    ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens.  (The last |-piece is null, so discard it.)
"RTN","BSDX27",201,0)
    ;BSDXBEG and BSDXEND are in external date form.
"RTN","BSDX27",202,0)
    ;Called by BSDX CLINIC LETTERS
"RTN","BSDX27",203,0)
    ;
"RTN","BSDX27",204,0)
       ; July 10, 2010 -- to support i18n, we pass dates from client in
"RTN","BSDX27",205,0)
       ; locale-neutral Fileman format. No need to convert it.
"RTN","BSDX27",206,0)
    N BSDXI,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCID,BSDXCNOD,BSDXDT
"RTN","BSDX27",207,0)
    N BSDXJ,BSDXAID,BSDXPAT,BSDXPNOD,BSDXCLN,BSDXCLRK,BSDXMADE,BSDXNOT,BSDXLIN
"RTN","BSDX27",208,0)
    N BSDXSTRT
"RTN","BSDX27",209,0)
    N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
"RTN","BSDX27",210,0)
    S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX27",211,0)
    K ^BSDXTMP($J)
"RTN","BSDX27",212,0)
    S BSDXI=0
"RTN","BSDX27",213,0)
    S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
"RTN","BSDX27",214,0)
    S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30)
"RTN","BSDX27",215,0)
    S X="ERROR^BSDX27",@^%ZOSF("TRAP")
"RTN","BSDX27",216,0)
    ;
"RTN","BSDX27",217,0)
    ;Convert beginning and ending dates
"RTN","BSDX27",218,0)
    ;
"RTN","BSDX27",219,0)
    S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"
"RTN","BSDX27",220,0)
    S BSDXEND=BSDXEND_".9999"
"RTN","BSDX27",221,0)
    I BSDXCLST="" D ERR(BSDXI,0,"Routine: BSDX27, Error: Null clinic list") Q
"RTN","BSDX27",222,0)
    ;
"RTN","BSDX27",223,0)
    ;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN)
"RTN","BSDX27",224,0)
    ;
"RTN","BSDX27",225,0)
    F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D
"RTN","BSDX27",226,0)
    . S BSDXCLN=$G(^BSDXRES(BSDXCID,0)) S BSDXCLN=$P(BSDXCLN,U) Q:BSDXCLN=""
"RTN","BSDX27",227,0)
    . S BSDXSTRT=BSDXBEG F  S BSDXSTRT=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT)) Q:'+BSDXSTRT  Q:BSDXSTRT>BSDXEND  D
"RTN","BSDX27",228,0)
    . . S BSDXAID=0 F  S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID  D
"RTN","BSDX27",229,0)
    . . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0))
"RTN","BSDX27",230,0)
    . . . Q:BSDXNOD=""
"RTN","BSDX27",231,0)
    . . . Q:$P(BSDXNOD,U,12)]""  ;CANCELLED
"RTN","BSDX27",232,0)
    . . . Q:$P(BSDXNOD,U,13)="y"  ;WALKIN
"RTN","BSDX27",233,0)
    . . . S Y=$P(BSDXNOD,U)
"RTN","BSDX27",234,0)
    . . . Q:'+Y
"RTN","BSDX27",235,0)
    . . . X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",236,0)
    . . . S BSDXAPT=Y ;Appointment date time
"RTN","BSDX27",237,0)
    . . . ;
"RTN","BSDX27",238,0)
    . . . ;NOTE
"RTN","BSDX27",239,0)
    . . . S BSDXNOT=""
"RTN","BSDX27",240,0)
    . . . I $D(^BSDXAPPT(BSDXAID,1,0)) S BSDXQ=0 F  S BSDXQ=$O(^BSDXAPPT(BSDXAID,1,BSDXQ)) Q:'+BSDXQ  D
"RTN","BSDX27",241,0)
    . . . . S BSDXLIN=$G(^BSDXAPPT(BSDXAID,1,BSDXQ,0))
"RTN","BSDX27",242,0)
    . . . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
"RTN","BSDX27",243,0)
    . . . . S BSDXNOT=BSDXNOT_BSDXLIN
"RTN","BSDX27",244,0)
    . . . ;
"RTN","BSDX27",245,0)
    . . . S BSDXPAT=$P(BSDXNOD,U,5)
"RTN","BSDX27",246,0)
    . . . S BSDXPNOD=$$PATINFO(BSDXPAT)
"RTN","BSDX27",247,0)
    . . . S BSDXNAM=$P(BSDXPNOD,U) ;NAME
"RTN","BSDX27",248,0)
    . . . S BSDXSEX=$P(BSDXPNOD,U,2) ;SEX
"RTN","BSDX27",249,0)
    . . . S BSDXDOB=$P(BSDXPNOD,U,3) ;DOB
"RTN","BSDX27",250,0)
    . . . S BSDXHRN=$P(BSDXPNOD,U,4) ;Health Record Number for location DUZ(2)
"RTN","BSDX27",251,0)
    . . . S BSDXSTRE=$P(BSDXPNOD,U,5) ;Street
"RTN","BSDX27",252,0)
    . . . S BSDXCITY=$P(BSDXPNOD,U,6) ;City
"RTN","BSDX27",253,0)
    . . . S BSDXST=$P(BSDXPNOD,U,7) ;State
"RTN","BSDX27",254,0)
    . . . S BSDXZIP=$P(BSDXPNOD,U,8) ;zip
"RTN","BSDX27",255,0)
    . . . S BSDXPHON=$P(BSDXPNOD,U,9) ;homephone
"RTN","BSDX27",256,0)
    . . . S BSDXTYPE="" ;Type/status doesn't exist for BSDX APPT clinics and it's not needed for clinic letters
"RTN","BSDX27",257,0)
    . . . S BSDXCLRK=$P(BSDXNOD,U,8)
"RTN","BSDX27",258,0)
    . . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
"RTN","BSDX27",259,0)
    . . . S Y=$P(BSDXNOD,U,9)
"RTN","BSDX27",260,0)
    . . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX27",261,0)
    . . . S BSDXMADE=Y
"RTN","BSDX27",262,0)
    . . . S BSDXI=BSDXI+1
"RTN","BSDX27",263,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",264,0)
    ;
"RTN","BSDX27",265,0)
    S BSDXI=BSDXI+1
"RTN","BSDX27",266,0)
    S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX27",267,0)
    Q
"RTN","BSDX28")
0^26^B34678667
"RTN","BSDX28",1,0)
BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 10:57am
"RTN","BSDX28",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX28",3,0)
 ; Licensed under LGPL
"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)
DFN ;If DFN is passed as `nnnn, just return that patient
"RTN","BSDX28",31,0)
 I $E(BSDXP)="`" DO  SET BSDXY=BSDXRET_$C(31) QUIT
"RTN","BSDX28",32,0)
 . N BSDXIEN S BSDXIEN=$E(BSDXP,2,99)
"RTN","BSDX28",33,0)
 . I BSDXIEN'=+BSDXIEN QUIT  ; BSDXIEN must be numeric
"RTN","BSDX28",34,0)
 . N NAME S NAME=$P(^DPT(BSDXIEN,0),U)
"RTN","BSDX28",35,0)
 . N HRN S HRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2)
"RTN","BSDX28",36,0)
 . N PID S PID=$P(^DPT(BSDXIEN,.36),U,3)
"RTN","BSDX28",37,0)
 . N DOB S DOB=$$FMTE^XLFDT($P(^DPT(BSDXIEN,0),U,3))
"RTN","BSDX28",38,0)
 . S BSDXRET=BSDXRET_NAME_U_HRN_U_PID_U_DOB_U_BSDXIEN_$C(30)
"RTN","BSDX28",39,0)
PID ;PID Lookup
"RTN","BSDX28",40,0)
 ; If this ID exists, go get it. If "UJOPID" index doesn't exist,
"RTN","BSDX28",41,0)
 ; won't work anyways.
"RTN","BSDX28",42,0)
 I $D(^DPT("UJOPID",BSDXP)) DO  SET BSDXY=BSDXRET_$C(31) QUIT
"RTN","BSDX28",43,0)
 . S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
"RTN","BSDX28",44,0)
 . Q:'$D(^DPT(BSDXIEN,0))
"RTN","BSDX28",45,0)
 . S BSDXDPT=$G(^DPT(BSDXIEN,0))
"RTN","BSDX28",46,0)
 . S BSDXZ=$P(BSDXDPT,U) ;NAME
"RTN","BSDX28",47,0)
 . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
"RTN","BSDX28",48,0)
 . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
"RTN","BSDX28",49,0)
 . ; Inactivated Chart get an *
"RTN","BSDX28",50,0)
 . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
"RTN","BSDX28",51,0)
 . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
"RTN","BSDX28",52,0)
 . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
"RTN","BSDX28",53,0)
 . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
"RTN","BSDX28",54,0)
 . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
"RTN","BSDX28",55,0)
 . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
"RTN","BSDX28",56,0)
 . S BSDXRET=BSDXRET_BSDXZ_$C(30)
"RTN","BSDX28",57,0)
 ;
"RTN","BSDX28",58,0)
DOB ;DOB Lookup
"RTN","BSDX28",59,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",60,0)
 . S X=BSDXP S %DT="P" D ^%DT S BSDXP=Y Q:'+Y
"RTN","BSDX28",61,0)
 . Q:'$D(^DPT("ADOB",BSDXP))
"RTN","BSDX28",62,0)
 . S BSDXIEN=0 F  S BSDXIEN=$O(^DPT("ADOB",BSDXP,BSDXIEN)) Q:'+BSDXIEN  D
"RTN","BSDX28",63,0)
 . . Q:'$D(^DPT(BSDXIEN,0))
"RTN","BSDX28",64,0)
 . . S BSDXDPT=$G(^DPT(BSDXIEN,0))
"RTN","BSDX28",65,0)
 . . S BSDXZ=$P(BSDXDPT,U) ;NAME
"RTN","BSDX28",66,0)
 . . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
"RTN","BSDX28",67,0)
 . . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
"RTN","BSDX28",68,0)
 . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
"RTN","BSDX28",69,0)
 . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
"RTN","BSDX28",70,0)
    . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
"RTN","BSDX28",71,0)
 . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
"RTN","BSDX28",72,0)
 . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
"RTN","BSDX28",73,0)
 . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
"RTN","BSDX28",74,0)
 . . S BSDXRET=BSDXRET_BSDXZ_$C(30)
"RTN","BSDX28",75,0)
 . . Q
"RTN","BSDX28",76,0)
 . Q
"RTN","BSDX28",77,0)
 ;
"RTN","BSDX28",78,0)
CHART ;Chart# Lookup
"RTN","BSDX28",79,0)
 I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D  S BSDXY=BSDXRET_$C(31) Q
"RTN","BSDX28",80,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",81,0)
 . . Q:'$D(^DPT(BSDXIEN,0))
"RTN","BSDX28",82,0)
 . . S BSDXDPT=$G(^DPT(BSDXIEN,0))
"RTN","BSDX28",83,0)
 . . S BSDXZ=$P(BSDXDPT,U) ;NAME
"RTN","BSDX28",84,0)
 . . S BSDXHRN=BSDXP ;CHART
"RTN","BSDX28",85,0)
 . . I $D(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
"RTN","BSDX28",86,0)
 . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
"RTN","BSDX28",87,0)
    . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
"RTN","BSDX28",88,0)
 . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
"RTN","BSDX28",89,0)
 . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
"RTN","BSDX28",90,0)
 . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
"RTN","BSDX28",91,0)
 . . S BSDXRET=BSDXRET_BSDXZ_$C(30)
"RTN","BSDX28",92,0)
 . . Q
"RTN","BSDX28",93,0)
 . Q
"RTN","BSDX28",94,0)
    ;
"RTN","BSDX28",95,0)
SSN ;SSN Lookup
"RTN","BSDX28",96,0)
 I (BSDXP?9N)!(BSDXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BSDXP)) D  S BSDXY=BSDXRET_$C(31) Q
"RTN","BSDX28",97,0)
 . S BSDXIEN=0 F  S BSDXIEN=$O(^DPT("SSN",BSDXP,BSDXIEN)) Q:'+BSDXIEN  D  Q
"RTN","BSDX28",98,0)
 . . Q:'$D(^DPT(BSDXIEN,0))
"RTN","BSDX28",99,0)
 . . S BSDXDPT=$G(^DPT(BSDXIEN,0))
"RTN","BSDX28",100,0)
 . . S BSDXZ=$P(BSDXDPT,U) ;NAME
"RTN","BSDX28",101,0)
 . . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
"RTN","BSDX28",102,0)
 . . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
"RTN","BSDX28",103,0)
 . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
"RTN","BSDX28",104,0)
 . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
"RTN","BSDX28",105,0)
    . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
"RTN","BSDX28",106,0)
 . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
"RTN","BSDX28",107,0)
 . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
"RTN","BSDX28",108,0)
 . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
"RTN","BSDX28",109,0)
 . . S BSDXRET=BSDXRET_BSDXZ_$C(30)
"RTN","BSDX28",110,0)
 . . Q
"RTN","BSDX28",111,0)
 . Q
"RTN","BSDX28",112,0)
 ;
"RTN","BSDX28",113,0)
 S BSDXFILE=9000001
"RTN","BSDX28",114,0)
 S BSDXIENS=""
"RTN","BSDX28",115,0)
 S BSDXFIELDS=".01"
"RTN","BSDX28",116,0)
 S BSDXFLAGS="M"
"RTN","BSDX28",117,0)
 S BSDXVALUE=BSDXP
"RTN","BSDX28",118,0)
 S BSDXNUMBER=BSDXC
"RTN","BSDX28",119,0)
 S BSDXINDEXES=""
"RTN","BSDX28",120,0)
 S BSDXSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
"RTN","BSDX28",121,0)
 S BSDXIDEN=""
"RTN","BSDX28",122,0)
 S BSDXTARG="BSDXRSLT"
"RTN","BSDX28",123,0)
 S BSDXMSG=""
"RTN","BSDX28",124,0)
 D FIND^DIC(BSDXFILE,BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN,BSDXIDEN,BSDXTARG,BSDXMSG)
"RTN","BSDX28",125,0)
 I '+$G(BSDXRSLT("DILIST",0)) S BSDXY=BSDXRET_$C(31) Q
"RTN","BSDX28",126,0)
 N BSDXCNT S BSDXCNT=2
"RTN","BSDX28",127,0)
 F BSDXX=1:1:$P(BSDXRSLT("DILIST",0),U) D
"RTN","BSDX28",128,0)
 . S BSDXIEN=BSDXRSLT("DILIST",2,BSDXX)
"RTN","BSDX28",129,0)
 . S BSDXZ=BSDXRSLT("DILIST","ID",BSDXX,.01) ;NAME
"RTN","BSDX28",130,0)
 . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
"RTN","BSDX28",131,0)
 . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
"RTN","BSDX28",132,0)
 . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
"RTN","BSDX28",133,0)
 . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
"RTN","BSDX28",134,0)
 . S BSDXDPT=$G(^DPT(BSDXIEN,0))
"RTN","BSDX28",135,0)
    . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
"RTN","BSDX28",136,0)
 . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
"RTN","BSDX28",137,0)
 . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
"RTN","BSDX28",138,0)
 . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
"RTN","BSDX28",139,0)
 . S $P(BSDXRET,$C(30),BSDXCNT)=BSDXZ
"RTN","BSDX28",140,0)
 . S BSDXCNT=BSDXCNT+1
"RTN","BSDX28",141,0)
 . Q
"RTN","BSDX28",142,0)
 S BSDXY=BSDXRET_$C(30)_$C(31)
"RTN","BSDX28",143,0)
 Q
"RTN","BSDX28",144,0)
 ;
"RTN","BSDX28",145,0)
ERROR ;
"RTN","BSDX28",146,0)
 D ERR("RPMS Error")
"RTN","BSDX28",147,0)
 Q
"RTN","BSDX28",148,0)
 ;
"RTN","BSDX28",149,0)
ERR(ERRNO) ;Error processing
"RTN","BSDX28",150,0)
 S BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)_"^^^^"_$C(30)_$C(31)
"RTN","BSDX28",151,0)
 Q
"RTN","BSDX29")
0^27^B52386520
"RTN","BSDX29",1,0)
BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am
"RTN","BSDX29",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX29",3,0)
 ; Licensed under LGPL
"RTN","BSDX29",4,0)
 ; 
"RTN","BSDX29",5,0)
 ; Change Log:
"RTN","BSDX29",6,0)
 ; v1.3 by WV/SMH on 3100713
"RTN","BSDX29",7,0)
 ; - Beginning and Ending dates passed as FM Dates
"RTN","BSDX29",8,0)
 ; v1.42 by WV/SMH on 3101023
"RTN","BSDX29",9,0)
 ; - Transaction moved; now restartable too.
"RTN","BSDX29",10,0)
 ; - Refactoring of major portions of routine
"RTN","BSDX29",11,0)
 ; v1.7 by VEN/SMH on 3120622
"RTN","BSDX29",12,0)
 ; - Removed transaction code; Locks added in update to prevent concurrent
"RTN","BSDX29",13,0)
 ;   update
"RTN","BSDX29",14,0)
 ;
"RTN","BSDX29",15,0)
BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
"RTN","BSDX29",16,0)
 ;Entry point for debugging
"RTN","BSDX29",17,0)
 ;
"RTN","BSDX29",18,0)
 ;D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")
"RTN","BSDX29",19,0)
 Q
"RTN","BSDX29",20,0)
 ;
"RTN","BSDX29",21,0)
BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
"RTN","BSDX29",22,0)
 ;Copy appointments from HOSPITAL LOCATION entry BSDX44 to BSDX RESOURCE entry BSDXRES
"RTN","BSDX29",23,0)
 ;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive
"RTN","BSDX29",24,0)
    ;Called by RPC: BSDX COPY APPOINTMENTS
"RTN","BSDX29",25,0)
 ;
"RTN","BSDX29",26,0)
 ; Parameters:
"RTN","BSDX29",27,0)
 ; - BSDXY: Global Return
"RTN","BSDX29",28,0)
 ; - BSDXRES: BSDX RESOURCE to copy appointments to
"RTN","BSDX29",29,0)
 ; - BSDX44: Hospital Location IEN to copy appointments from
"RTN","BSDX29",30,0)
 ; - BSDXBEG: Beginning Date in FM Format
"RTN","BSDX29",31,0)
 ; - BSDXEND: End Date in FM Format
"RTN","BSDX29",32,0)
 ;
"RTN","BSDX29",33,0)
 ;Returns ADO Recordset containing TASK_NUMBER and ERRORID
"RTN","BSDX29",34,0)
 ;
"RTN","BSDX29",35,0)
 ; Return Array
"RTN","BSDX29",36,0)
 S BSDXY=$NA(^BSDXTMP($J))
"RTN","BSDX29",37,0)
 K ^BSDXTMP($J)
"RTN","BSDX29",38,0)
 ; $ET
"RTN","BSDX29",39,0)
 N $ET S $ET="G ETRAP^BSDX29"
"RTN","BSDX29",40,0)
 ; Counter
"RTN","BSDX29",41,0)
 N BSDXI S BSDXI=0
"RTN","BSDX29",42,0)
 ; Header Node
"RTN","BSDX29",43,0)
 S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30)
"RTN","BSDX29",44,0)
 ;
"RTN","BSDX29",45,0)
 ; Make dates inclusive; add 1 to FM dates
"RTN","BSDX29",46,0)
 S BSDXBEG=$$FMADD^XLFDT(BSDXBEG,-1)
"RTN","BSDX29",47,0)
 S BSDXEND=$$FMADD^XLFDT(BSDXEND,+1)
"RTN","BSDX29",48,0)
 ;
"RTN","BSDX29",49,0)
 ; Taskman variables
"RTN","BSDX29",50,0)
 N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,ZTIO
"RTN","BSDX29",51,0)
 ; Task Load
"RTN","BSDX29",52,0)
 S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS",ZTIO=""
"RTN","BSDX29",53,0)
 S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")=""
"RTN","BSDX29",54,0)
 D ^%ZTLOAD
"RTN","BSDX29",55,0)
 ; Set up return ADO.net dataset
"RTN","BSDX29",56,0)
 N BSDXST S BSDXST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.")
"RTN","BSDX29",57,0)
 S BSDXI=BSDXI+1
"RTN","BSDX29",58,0)
 S ^BSDXTMP($J,BSDXI)=$G(ZTSK)_"^"_BSDXST_$C(30)_$C(31)
"RTN","BSDX29",59,0)
 QUIT
"RTN","BSDX29",60,0)
 ;
"RTN","BSDX29",61,0)
ZTMD ;EP - Debug entry point
"RTN","BSDX29",62,0)
 ;D DEBUG^%Serenji("ZTM^BSDX29")
"RTN","BSDX29",63,0)
 Q
"RTN","BSDX29",64,0)
 ;
"RTN","BSDX29",65,0)
ZTM ;EP - Taskman entry point
"RTN","BSDX29",66,0)
 ; Variables set up in ZTSAVE above
"RTN","BSDX29",67,0)
 ;
"RTN","BSDX29",68,0)
 Q:'$D(ZTSK)
"RTN","BSDX29",69,0)
 ;
"RTN","BSDX29",70,0)
 ; $ET
"RTN","BSDX29",71,0)
 N $ET S $ET="G ZTMERR^BSDX29"
"RTN","BSDX29",72,0)
 ;
"RTN","BSDX29",73,0)
 ;$O through ^SC(BSDX44,"S",
"RTN","BSDX29",74,0)
 N BSDXCNT S BSDXCNT=0  ; Count of Copied Appointments
"RTN","BSDX29",75,0)
 N BSDXQUIT S BSDXQUIT=0  ; Quit Flag to be retrieved from an external proc
"RTN","BSDX29",76,0)
 ; Set Count
"RTN","BSDX29",77,0)
 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
"RTN","BSDX29",78,0)
 ; Loop through dates here.
"RTN","BSDX29",79,0)
 F  S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG  Q:BSDXBEG>BSDXEND  Q:BSDXQUIT  D
"RTN","BSDX29",80,0)
 . ; Loop through Entries in each date in the subsubfile.
"RTN","BSDX29",81,0)
 . ; Quit if we are at the end or if a remote process requests a quit.
"RTN","BSDX29",82,0)
 . N BSDXIEN S BSDXIEN=0
"RTN","BSDX29",83,0)
 . F  S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN  Q:BSDXQUIT  D
"RTN","BSDX29",84,0)
 . . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node
"RTN","BSDX29",85,0)
 . . Q:'+BSDXNOD  ; Quit if no node
"RTN","BSDX29",86,0)
 . . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag
"RTN","BSDX29",87,0)
 . . Q:BSDXCAN="C"  ; Quit if appt cancelled -- smh - this will never happen; cancelled appointments are normally removed from 44
"RTN","BSDX29",88,0)
 . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient
"RTN","BSDX29",89,0)
 . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
"RTN","BSDX29",90,0)
 . . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk)
"RTN","BSDX29",91,0)
 . . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made
"RTN","BSDX29",92,0)
 . . N BSDXNOTE S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note
"RTN","BSDX29",93,0)
 . . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE)
"RTN","BSDX29",94,0)
 . . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record
"RTN","BSDX29",95,0)
 . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag ; smh - not used currently (v1.7)
"RTN","BSDX29",96,0)
 ;
"RTN","BSDX29",97,0)
 ;
"RTN","BSDX29",98,0)
 S ^BSDXTMP("BSDXCOPY",ZTSK)=$S(BSDXQUIT:"Cancelled.  No records copied.",1:"Finished.  "_BSDXCNT_" records copied.")
"RTN","BSDX29",99,0)
 Q
"RTN","BSDX29",100,0)
 ;
"RTN","BSDX29",101,0)
ZTMERR ; For now, error from TM is only in trap; not returned to client.
"RTN","BSDX29",102,0)
 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
"RTN","BSDX29",103,0)
 D ^%ZTER
"RTN","BSDX29",104,0)
 QUIT
"RTN","BSDX29",105,0)
 ;
"RTN","BSDX29",106,0)
XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
"RTN","BSDX29",107,0)
 ;
"RTN","BSDX29",108,0)
 ;Copy record to BSDX APPOINTMENT file
"RTN","BSDX29",109,0)
 ;Return 1 if record copied, otherwise 0
"RTN","BSDX29",110,0)
 ;
"RTN","BSDX29",111,0)
 N REF
"RTN","BSDX29",112,0)
 S REF=$NA(^BSDXLOCK(BSDXRES,BSDXBEG,BSDXPAT)) ; This combo is unique
"RTN","BSDX29",113,0)
 L +@REF:0  E  Q 0
"RTN","BSDX29",114,0)
 ;
"RTN","BSDX29",115,0)
 ;$O Thru ^BSDXAPPT to determine if this appt already added
"RTN","BSDX29",116,0)
 N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2,BSDXNOD
"RTN","BSDX29",117,0)
 S BSDXIEN=0,BSDXFND=0
"RTN","BSDX29",118,0)
 F  S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN  D  Q:BSDXFND
"RTN","BSDX29",119,0)
 . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
"RTN","BSDX29",120,0)
 . Q:'+BSDXNOD
"RTN","BSDX29",121,0)
 . S BSDXPAT2=$P(BSDXNOD,U,5)
"RTN","BSDX29",122,0)
 . S BSDXFND=0
"RTN","BSDX29",123,0)
 . I BSDXPAT2=BSDXPAT S BSDXFND=1
"RTN","BSDX29",124,0)
 . Q
"RTN","BSDX29",125,0)
 I BSDXFND L -@REF Q 0
"RTN","BSDX29",126,0)
 ;
"RTN","BSDX29",127,0)
 ;Add to BSDX APPOINTMENT
"RTN","BSDX29",128,0)
 S BSDXEND=BSDXBEG
"RTN","BSDX29",129,0)
 ;Calculate ending time from beginning time and duration.
"RTN","BSDX29",130,0)
 S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN)
"RTN","BSDX29",131,0)
 N BSDXFDA,BSDXIENS
"RTN","BSDX29",132,0)
 S BSDXIENS="+1,"
"RTN","BSDX29",133,0)
 S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG
"RTN","BSDX29",134,0)
 S BSDXFDA(9002018.4,BSDXIENS,.02)=BSDXEND
"RTN","BSDX29",135,0)
 S BSDXFDA(9002018.4,BSDXIENS,.05)=BSDXPAT
"RTN","BSDX29",136,0)
 S BSDXFDA(9002018.4,BSDXIENS,.07)=BSDXRES
"RTN","BSDX29",137,0)
 S BSDXFDA(9002018.4,BSDXIENS,.08)=BSDXCLRK
"RTN","BSDX29",138,0)
 S BSDXFDA(9002018.4,BSDXIENS,.09)=BSDXMADE
"RTN","BSDX29",139,0)
 ;
"RTN","BSDX29",140,0)
 K BSDXIEN
"RTN","BSDX29",141,0)
 ;
"RTN","BSDX29",142,0)
 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX29",143,0)
 S BSDXIEN=+$G(BSDXIEN(1))
"RTN","BSDX29",144,0)
 I '+BSDXIEN L -@REF Q 0
"RTN","BSDX29",145,0)
 ;
"RTN","BSDX29",146,0)
 ;Add WP field
"RTN","BSDX29",147,0)
 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D
"RTN","BSDX29",148,0)
 . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
"RTN","BSDX29",149,0)
 L -@REF
"RTN","BSDX29",150,0)
 ;
"RTN","BSDX29",151,0)
 Q 1
"RTN","BSDX29",152,0)
 ;
"RTN","BSDX29",153,0)
ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing
"RTN","BSDX29",154,0)
 ; If last line is $C(31), we are done. No more errors to send to client.
"RTN","BSDX29",155,0)
 I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
"RTN","BSDX29",156,0)
 S BSDXI=BSDXI+1
"RTN","BSDX29",157,0)
 S BSDXERR=$TR(BSDXERR,"^","~")
"RTN","BSDX29",158,0)
 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)
"RTN","BSDX29",159,0)
 S BSDXI=BSDXI+1
"RTN","BSDX29",160,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX29",161,0)
 Q
"RTN","BSDX29",162,0)
 ;
"RTN","BSDX29",163,0)
ETRAP ;EP Error trap entry
"RTN","BSDX29",164,0)
 ; No Txn here. So don't rollback anything
"RTN","BSDX29",165,0)
 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
"RTN","BSDX29",166,0)
 D ^%ZTER
"RTN","BSDX29",167,0)
 S $EC="" ; Clear error
"RTN","BSDX29",168,0)
 I '$D(BSDXI) N BSDXI S BSDXI=0
"RTN","BSDX29",169,0)
 D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
"RTN","BSDX29",170,0)
 Q
"RTN","BSDX29",171,0)
 ;
"RTN","BSDX29",172,0)
CPSTAT(BSDXY,BSDXTSK) ;EP - Note: As of Dec 6 2010: Inactive Code
"RTN","BSDX29",173,0)
 ;Return status (copied record count) of tasked job having ZTSK=BSDXTSK
"RTN","BSDX29",174,0)
 ;
"RTN","BSDX29",175,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX29",176,0)
 N BSDXI,BSDXCNT
"RTN","BSDX29",177,0)
 S BSDXI=0
"RTN","BSDX29",178,0)
 S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
"RTN","BSDX29",179,0)
 S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
"RTN","BSDX29",180,0)
 S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK))
"RTN","BSDX29",181,0)
 I BSDXCNT["Finished" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
"RTN","BSDX29",182,0)
 I BSDXCNT["Cancelled" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
"RTN","BSDX29",183,0)
 ;I $D(^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")) K ^BSDXTMP("BSDXCOPY",BSDXTSK)
"RTN","BSDX29",184,0)
 S BSDXI=BSDXI+1
"RTN","BSDX29",185,0)
 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31)
"RTN","BSDX29",186,0)
 Q
"RTN","BSDX29",187,0)
 ;
"RTN","BSDX29",188,0)
CPCANC(BSDXY,BSDXTSK) ;EP Note: As of Dec 6 2010: Inactive code.
"RTN","BSDX29",189,0)
 ;Signal tasked job having ZTSK=BSDXTSK to cancel
"RTN","BSDX29",190,0)
 ;Returns current record count of copy process
"RTN","BSDX29",191,0)
 ;
"RTN","BSDX29",192,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX29",193,0)
 N BSDXI,BSDXCNT
"RTN","BSDX29",194,0)
 S BSDXI=0
"RTN","BSDX29",195,0)
 S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
"RTN","BSDX29",196,0)
 S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
"RTN","BSDX29",197,0)
 S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK))
"RTN","BSDX29",198,0)
 I BSDXCNT["FINISHED" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
"RTN","BSDX29",199,0)
 E  S ^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")=""
"RTN","BSDX29",200,0)
 S BSDXI=BSDXI+1
"RTN","BSDX29",201,0)
 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31)
"RTN","BSDX29",202,0)
 Q
"RTN","BSDX29",203,0)
 ;
"RTN","BSDX29",204,0)
ADDMIN(BSDXSTRT,BSDXLEN) ;
"RTN","BSDX29",205,0)
 ;
"RTN","BSDX29",206,0)
 ;Add BSDXLEN minutes to time BSDXSTRT and return end time
"RTN","BSDX29",207,0)
 N BSDXEND,BSDXH,BSDXM,BSDXSTIM,BSDXETIM
"RTN","BSDX29",208,0)
 S BSDXEND=$P(BSDXSTRT,".")
"RTN","BSDX29",209,0)
 ;
"RTN","BSDX29",210,0)
 ;Convert start time to minutes past midnight
"RTN","BSDX29",211,0)
 S BSDXSTIM=$P(BSDXSTRT,".",2)
"RTN","BSDX29",212,0)
 S BSDXSTIM=BSDXSTIM_"0000"
"RTN","BSDX29",213,0)
 S BSDXSTIM=$E(BSDXSTIM,1,4)
"RTN","BSDX29",214,0)
 S BSDXH=$E(BSDXSTIM,1,2)
"RTN","BSDX29",215,0)
 S BSDXH=BSDXH*60
"RTN","BSDX29",216,0)
 S BSDXH=BSDXH+$E(BSDXSTIM,3,4)
"RTN","BSDX29",217,0)
 ;
"RTN","BSDX29",218,0)
 ;Add duration to find minutes past midnight of end time
"RTN","BSDX29",219,0)
 S BSDXETIM=BSDXH+BSDXLEN
"RTN","BSDX29",220,0)
 ;
"RTN","BSDX29",221,0)
 ;Convert back to a time
"RTN","BSDX29",222,0)
 S BSDXH=BSDXETIM\60
"RTN","BSDX29",223,0)
 S BSDXH="00"_BSDXH
"RTN","BSDX29",224,0)
 S BSDXH=$E(BSDXH,$L(BSDXH)-1,$L(BSDXH))
"RTN","BSDX29",225,0)
 S BSDXM=BSDXETIM#60
"RTN","BSDX29",226,0)
 S BSDXM="00"_BSDXM
"RTN","BSDX29",227,0)
 S BSDXM=$E(BSDXM,$L(BSDXM)-1,$L(BSDXM))
"RTN","BSDX29",228,0)
 S BSDXETIM=BSDXH_BSDXM
"RTN","BSDX29",229,0)
 I BSDXETIM>2400 S BSDXETIM=2400
"RTN","BSDX29",230,0)
 S $P(BSDXEND,".",2)=BSDXETIM
"RTN","BSDX29",231,0)
 Q BSDXEND
"RTN","BSDX2E")
0^^B26008273
"RTN","BSDX2E",1,0)
BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/11/12 9:37am]
"RTN","BSDX2E",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX2E",3,0)
 ; Licensed under LGPL
"RTN","BSDX2E",4,0)
 ;
"RTN","BSDX2E",5,0)
 S LINE="",$P(LINE,"*",81)=""
"RTN","BSDX2E",6,0)
 S XPDNOQUE="NO QUE"  ;NO QUEUING ALLOWED
"RTN","BSDX2E",7,0)
 S XPDABORT=0
"RTN","BSDX2E",8,0)
 I '$G(DUZ) D SORRY("DUZ UNDEFINED OR 0") Q
"RTN","BSDX2E",9,0)
 ;
"RTN","BSDX2E",10,0)
 I '$L($G(DUZ(0))) D SORRY("DUZ(0) UNDEFINED OR NULL") Q
"RTN","BSDX2E",11,0)
 ;
"RTN","BSDX2E",12,0)
 D HOME^%ZIS,DT^DICRW
"RTN","BSDX2E",13,0)
 S X=$P($G(^VA(200,DUZ,0)),U)
"RTN","BSDX2E",14,0)
 I $G(X)="" W !,$$C^XBFUNC("Who are you????") D SORRY("Unknown User") Q
"RTN","BSDX2E",15,0)
 ;
"RTN","BSDX2E",16,0)
VERSION ;
"RTN","BSDX2E",17,0)
 W !,$$C^XBFUNC("Hello, "_$P(X,",",2)_" "_$P(X,","))
"RTN","BSDX2E",18,0)
 W !!,$$C^XBFUNC("Checking Environment for Install of Version "_$P($T(+2),";",3)_" of "_$P($T(+2),";",4)_".")
"RTN","BSDX2E",19,0)
 ;
"RTN","BSDX2E",20,0)
 Q:'$$VERCHK("VA FILEMAN",22)
"RTN","BSDX2E",21,0)
 Q:'$$VERCHK("KERNEL",8)
"RTN","BSDX2E",22,0)
 Q:'$$VERCHK("XB",3)
"RTN","BSDX2E",23,0)
 ;Is the PIMS requirement present?
"RTN","BSDX2E",24,0)
 Q:'$$VERCHK("SD",5.3)
"RTN","BSDX2E",25,0)
 ; Q:'$$PATCHCK("PIMS*5.3*1003") D
"RTN","BSDX2E",26,0)
 Q:'$$VERCHK("BMX",4)
"RTN","BSDX2E",27,0)
 ;
"RTN","BSDX2E",28,0)
OTHER ;
"RTN","BSDX2E",29,0)
 ;Other checks
"RTN","BSDX2E",30,0)
 ;
"RTN","BSDX2E",31,0)
ENVOK ; If this is just an environ check, end here.
"RTN","BSDX2E",32,0)
 W !!,$$C^XBFUNC("ENVIRONMENT OK.")
"RTN","BSDX2E",33,0)
 ;
"RTN","BSDX2E",34,0)
 ; The following line prevents the "Disable Options..." and "Move
"RTN","BSDX2E",35,0)
 ; Routines..." questions from being asked during the install.
"RTN","BSDX2E",36,0)
 I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
"RTN","BSDX2E",37,0)
 ;
"RTN","BSDX2E",38,0)
 ;
"RTN","BSDX2E",39,0)
 ;VERIFY BACKUPS HAVE BEEN DONE
"RTN","BSDX2E",40,0)
 ;W !!
"RTN","BSDX2E",41,0)
 ;S DIR(0)="Y"
"RTN","BSDX2E",42,0)
 ;S DIR("B")="NO"
"RTN","BSDX2E",43,0)
 ;S DIR("A")="Has a SUCCESSFUL system backup been performed??"
"RTN","BSDX2E",44,0)
 ;D ^DIR
"RTN","BSDX2E",45,0)
 ;I $D(DIRUT)!($G(Y)=0) S XPDABORT=1 S XPX="BACKUP" D SORRY Q
"RTN","BSDX2E",46,0)
 ;S ^TMP("BPCPRE",$J,"BACKUPS CONFIRMED BY "_DUZ)=$H
"RTN","BSDX2E",47,0)
 ;
"RTN","BSDX2E",48,0)
 Q
"RTN","BSDX2E",49,0)
 ;
"RTN","BSDX2E",50,0)
VERCHK(XPXPKG,XVRMIN) ;
"RTN","BSDX2E",51,0)
 S X=$$VERSION^XPDUTL(XPXPKG)
"RTN","BSDX2E",52,0)
 W !!,$$C^XBFUNC("Need at least "_XPXPKG_" "_XVRMIN_"....."_XPXPKG_" "_$S(X'="":X,1:"Is Not")_" Present")
"RTN","BSDX2E",53,0)
 I X<XVRMIN  D SORRY(XPXPKG_" "_XVRMIN_" Is Not Installed") Q 0
"RTN","BSDX2E",54,0)
 Q 1
"RTN","BSDX2E",55,0)
 ;
"RTN","BSDX2E",56,0)
PATCHCK(XPXPCH) ;
"RTN","BSDX2E",57,0)
 S X=$$PATCH^XPDUTL(XPXPCH)
"RTN","BSDX2E",58,0)
 W !!,$$C^XBFUNC("Need "_XPXPCH_"....."_XPXPCH_" "_$S(X:"Is",1:"Is Not")_" Present")
"RTN","BSDX2E",59,0)
 Q X
"RTN","BSDX2E",60,0)
 ;
"RTN","BSDX2E",61,0)
V0200 ;EP Version 1.5 PostInit
"RTN","BSDX2E",62,0)
 ;Add Protocol items to SDAM APPOINTMENT EVENTS protocol
"RTN","BSDX2E",63,0)
 ;Remove protocols known to cause problems from SDAM APPOINTMENT EVENTS
"RTN","BSDX2E",64,0)
 ;Set Default Values for Parameters
"RTN","BSDX2E",65,0)
 N BSDXDA,BSDXFDA,BSDXDA1,BSDXSEQ,BSDXDAT,BSDXNOD,BSDXIEN,BSDXMSG
"RTN","BSDX2E",66,0)
 ;
"RTN","BSDX2E",67,0)
 ; 1st, add the BSDX event protocols
"RTN","BSDX2E",68,0)
 ; Get SDAM APPOINTMENT EVENTS IEN in 101
"RTN","BSDX2E",69,0)
 S BSDXDA=$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))
"RTN","BSDX2E",70,0)
 Q:'+BSDXDA
"RTN","BSDX2E",71,0)
 ; Add each of those protocols unless they already exist.
"RTN","BSDX2E",72,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",73,0)
 ; For each
"RTN","BSDX2E",74,0)
 F J=1:1:$L(BSDXDAT,U) D
"RTN","BSDX2E",75,0)
 . K BSDXIEN,BSDXMSG,BSDXFDA
"RTN","BSDX2E",76,0)
 . ; Get Item
"RTN","BSDX2E",77,0)
 . S BSDXNOD=$P(BSDXDAT,U,J)
"RTN","BSDX2E",78,0)
 . ; Get Item Name (BSDX ADD APPOINTMENT)
"RTN","BSDX2E",79,0)
 . S BSDXDA1=$P(BSDXNOD,";")
"RTN","BSDX2E",80,0)
 . ; Get Item Sequence (10.2)
"RTN","BSDX2E",81,0)
 . S BSDXSEQ=$P(BSDXNOD,";",2)
"RTN","BSDX2E",82,0)
 . ; Get Item Reference (Item is already in the protocol file)
"RTN","BSDX2E",83,0)
 . S BSDXDA1=$O(^ORD(101,"B",BSDXDA1,0))
"RTN","BSDX2E",84,0)
 . ; Quit if not found
"RTN","BSDX2E",85,0)
 . Q:'+BSDXDA1
"RTN","BSDX2E",86,0)
 . ; Quit if already exists in the SDAM protocol
"RTN","BSDX2E",87,0)
 . Q:$D(^ORD(101,BSDXDA,10,"B",BSDXDA1))
"RTN","BSDX2E",88,0)
 . ; Go ahead and save it.
"RTN","BSDX2E",89,0)
 . S BSDXFDA(101.01,"+1,"_BSDXDA_",",".01")=BSDXDA1
"RTN","BSDX2E",90,0)
 . S BSDXFDA(101.01,"+1,"_BSDXDA_",","3")=BSDXSEQ
"RTN","BSDX2E",91,0)
 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
"RTN","BSDX2E",92,0)
 . ; Error message
"RTN","BSDX2E",93,0)
 . I $D(BSDXMSG) D MES^XPDUTL("Error: ",BSDXMSG("DIERR",1,"TEXT",1))
"RTN","BSDX2E",94,0)
 ;
"RTN","BSDX2E",95,0)
 ; Remove nassssty protocols ORU PATIENT MOVMT and DVBA C&P SCHD EVENT
"RTN","BSDX2E",96,0)
 ; SDAM APPOINTMENT EVENTS IENS for use in FIND1^DIC
"RTN","BSDX2E",97,0)
 N SDEVTIENS S SDEVTIENS=","_BSDXDA_","
"RTN","BSDX2E",98,0)
 ; Subfile entry for ORU...
"RTN","BSDX2E",99,0)
 N ORUIEN S ORUIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","ORU PATIENT MOVMT")
"RTN","BSDX2E",100,0)
 ; Subfile entry for DVBA...
"RTN","BSDX2E",101,0)
 N DVBAIEN S DVBAIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","DVBA C&P SCHD EVENT")
"RTN","BSDX2E",102,0)
 ; Deletion code
"RTN","BSDX2E",103,0)
 N BSDXFDA,BSDXMSG
"RTN","BSDX2E",104,0)
 S:ORUIEN>0 BSDXFDA(101.01,ORUIEN_SDEVTIENS,.01)="@"
"RTN","BSDX2E",105,0)
 S:DVBAIEN>0 BSDXFDA(101.01,DVBAIEN_SDEVTIENS,.01)="@"
"RTN","BSDX2E",106,0)
 D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX2E",107,0)
 ; If error
"RTN","BSDX2E",108,0)
 I $D(BSDXMSG) D MES^XPDUTL("Error: ",BSDXMSG("DIERR",1,"TEXT",1))
"RTN","BSDX2E",109,0)
 ;
"RTN","BSDX2E",110,0)
 ;
"RTN","BSDX2E",111,0)
 ; Now put in the default values for parameters
"RTN","BSDX2E",112,0)
 ; BSDX AUTO PRINT RS as false
"RTN","BSDX2E",113,0)
 ; BSDX AUTO PRINT AS as false
"RTN","BSDX2E",114,0)
 ;
"RTN","BSDX2E",115,0)
 N BSDXERR
"RTN","BSDX2E",116,0)
 D PUT^XPAR("PKG","BSDX AUTO PRINT RS",1,0,.BSDXERR)
"RTN","BSDX2E",117,0)
 I $G(BSDXERR) W $C(7),"Error: ",BSDXERR
"RTN","BSDX2E",118,0)
 D PUT^XPAR("PKG","BSDX AUTO PRINT AS",1,0,.BSDXERR)
"RTN","BSDX2E",119,0)
 I $G(BSDXERR) D MES^XPDUTL("Error: ",BSDXERR)
"RTN","BSDX2E",120,0)
 QUIT
"RTN","BSDX2E",121,0)
 ;
"RTN","BSDX2E",122,0)
SORRY(XPX) ;
"RTN","BSDX2E",123,0)
 K DIFQ
"RTN","BSDX2E",124,0)
 S XPDABORT=1
"RTN","BSDX2E",125,0)
 W !,$$C^XBFUNC($P($T(+2),";",3)_" of "_$P($T(+2),";",4)_" Cannot Be Installed!")
"RTN","BSDX2E",126,0)
 W !,$$C^XBFUNC("Reason: "_XPX_".")
"RTN","BSDX2E",127,0)
 W *7,!!!,$$C^XBFUNC("Sorry....something is wrong with your environment")
"RTN","BSDX2E",128,0)
 W !,$$C^XBFUNC("Aborting "_XPDNM_" install!")
"RTN","BSDX2E",129,0)
 W !,$$C^XBFUNC("Correct error and reinstall otherwise")
"RTN","BSDX2E",130,0)
 W !,$$C^XBFUNC("please print/capture this screen and notify")
"RTN","BSDX2E",131,0)
 W !,$$C^XBFUNC("technical support")
"RTN","BSDX2E",132,0)
 W !!,LINE
"RTN","BSDX2E",133,0)
 D BMES^XPDUTL("Sorry....something is wrong with your environment")
"RTN","BSDX2E",134,0)
 D BMES^XPDUTL("Enviroment ERROR "_$G(XPX))
"RTN","BSDX2E",135,0)
 D BMES^XPDUTL("Aborting "_XPDNM_" install!")
"RTN","BSDX2E",136,0)
 D BMES^XPDUTL("Correct error and reinstall otherwise")
"RTN","BSDX2E",137,0)
 D BMES^XPDUTL("please print/capture this screen and notify")
"RTN","BSDX2E",138,0)
 D BMES^XPDUTL("technical support")
"RTN","BSDX2E",139,0)
 Q
"RTN","BSDX2E",140,0)
 ;
"RTN","BSDX30")
0^28^B3691453
"RTN","BSDX30",1,0)
BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [7/6/12 11:03am]
"RTN","BSDX30",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX30",3,0)
 ; Licensed under LGPL
"RTN","BSDX30",4,0)
 ;
"RTN","BSDX30",5,0)
 ;
"RTN","BSDX30",6,0)
SPACED(BSDXY,BSDXDIC,BSDXVAL) ;EP
"RTN","BSDX30",7,0)
 ;Entry point for debugging
"RTN","BSDX30",8,0)
 ;
"RTN","BSDX30",9,0)
 ; D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)")
"RTN","BSDX30",10,0)
 Q
"RTN","BSDX30",11,0)
 ;
"RTN","BSDX30",12,0)
SPACE(BSDXY,BSDXDIC,BSDXVAL) ;EP
"RTN","BSDX30",13,0)
 ;Update ^DISV with most recent lookup value BSDXVAL from file BSDXDIC
"RTN","BSDX30",14,0)
 ;BSDXDIC is the data global in the form GLOBAL(
"RTN","BSDX30",15,0)
 ;BSDXVAL is the entry number (IEN) in the file
"RTN","BSDX30",16,0)
 ;
"RTN","BSDX30",17,0)
 ;Return Status = 1 if success, 0 if fail
"RTN","BSDX30",18,0)
 ;
"RTN","BSDX30",19,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX30",20,0)
 N BSDX1,BSDXRES
"RTN","BSDX30",21,0)
 S BSDXI=0
"RTN","BSDX30",22,0)
 S X="ETRAP^BSDX30",@^%ZOSF("TRAP")
"RTN","BSDX30",23,0)
 I (BSDXDIC="")!('+$G(BSDXVAL)) D ERR(BSDXI+1,99) Q
"RTN","BSDX30",24,0)
 S BSDXDIC="^"_BSDXDIC
"RTN","BSDX30",25,0)
 S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
"RTN","BSDX30",26,0)
 ;Note:  Naked reference below is immediately preceded
"RTN","BSDX30",27,0)
 ;by the full global reference per SAC 2.2.2.8
"RTN","BSDX30",28,0)
 I $D(@(BSDXDIC_"BSDXVAL,0)")),'$D(^(-9)) D
"RTN","BSDX30",29,0)
 . S ^DISV(DUZ,BSDXDIC)=BSDXVAL
"RTN","BSDX30",30,0)
 . S BSDXRES=1
"RTN","BSDX30",31,0)
 E  S BSDXRES=0
"RTN","BSDX30",32,0)
 S BSDXI=BSDXI+1
"RTN","BSDX30",33,0)
 S ^BSDXTMP($J,BSDXI)=BSDXRES_$C(30)_$C(31)
"RTN","BSDX30",34,0)
 Q
"RTN","BSDX30",35,0)
 ;
"RTN","BSDX30",36,0)
ERR(BSDXI,BSDXERR) ;Error processing
"RTN","BSDX30",37,0)
 S BSDXI=BSDXI+1
"RTN","BSDX30",38,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
"RTN","BSDX30",39,0)
 S BSDXI=BSDXI+1
"RTN","BSDX30",40,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX30",41,0)
 Q
"RTN","BSDX30",42,0)
 ;
"RTN","BSDX30",43,0)
ETRAP ;EP Error trap entry
"RTN","BSDX30",44,0)
 I '$D(BSDXI) N BSDXI S BSDXI=999
"RTN","BSDX30",45,0)
 S BSDXI=BSDXI+1
"RTN","BSDX30",46,0)
 D ERR(99,0)
"RTN","BSDX30",47,0)
 Q
"RTN","BSDX30",48,0)
 ;
"RTN","BSDX30",49,0)
EHRPTD(BSDXY,BSDXWID,BSDXDFN) ;
"RTN","BSDX30",50,0)
 ;
"RTN","BSDX30",51,0)
 ; D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)")
"RTN","BSDX30",52,0)
 Q
"RTN","BSDX30",53,0)
 ;
"RTN","BSDX30",54,0)
EHRPT(BSDXY,BSDXWID,BSDXDFN) ;
"RTN","BSDX30",55,0)
 ;
"RTN","BSDX30",56,0)
 ;Return Status = 1 if success, 0 if error
"RTN","BSDX30",57,0)
 ;
"RTN","BSDX30",58,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX30",59,0)
 N BSDX1,BSDXRES
"RTN","BSDX30",60,0)
 S BSDXI=0,BSDXRES=1
"RTN","BSDX30",61,0)
 S X="ETRAP^BSDX30",@^%ZOSF("TRAP")
"RTN","BSDX30",62,0)
 S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
"RTN","BSDX30",63,0)
 I '+BSDXDFN D ERR(BSDXI+1,0) Q
"RTN","BSDX30",64,0)
 ;
"RTN","BSDX30",65,0)
 D PEVENT(BSDXWID,BSDXDFN) ;Raise patient selected event
"RTN","BSDX30",66,0)
 ;
"RTN","BSDX30",67,0)
 S BSDXI=BSDXI+1
"RTN","BSDX30",68,0)
 S ^BSDXTMP($J,BSDXI)=BSDXRES_$C(30)_$C(31)
"RTN","BSDX30",69,0)
 Q
"RTN","BSDX30",70,0)
 ;
"RTN","BSDX30",71,0)
PEVENT(BSDXWID,DFN) ;EP - Raise patient selection event to EHR
"RTN","BSDX30",72,0)
 ; VEN/SMH v1.7 3120706 - Not used in VISTA.
"RTN","BSDX30",73,0)
 ; No way right now to synchronize with CPRS.
"RTN","BSDX30",74,0)
 ; Code commented out for now.
"RTN","BSDX30",75,0)
 ;
"RTN","BSDX30",76,0)
 ;Change patient context to patient DFN
"RTN","BSDX30",77,0)
 ;on all EHR client sessions associated with user DUZ
"RTN","BSDX30",78,0)
 ;and workstation BSDXWID.
"RTN","BSDX30",79,0)
 ;
"RTN","BSDX30",80,0)
 ;If BSDXWID is "", the context change is sent to
"RTN","BSDX30",81,0)
 ;all EHR client sessions belonging to user DUZ.
"RTN","BSDX30",82,0)
 ;
"RTN","BSDX30",83,0)
 ;Q:'$G(DUZ)
"RTN","BSDX30",84,0)
 ;N X
"RTN","BSDX30",85,0)
 ;S X="CIANBUTL" X ^%ZOSF("TEST") Q:'$T
"RTN","BSDX30",86,0)
 ;S X="CIANBEVT" X ^%ZOSF("TEST") Q:'$T
"RTN","BSDX30",87,0)
 ;N UID,BRET
"RTN","BSDX30",88,0)
 ;S BRET=0,UID=0
"RTN","BSDX30",89,0)
 ;F  S BRET=$$NXTUID^CIANBUTL(.UID,1) Q:'UID  D
"RTN","BSDX30",90,0)
 ;. Q:DUZ'=$$GETVAR^CIANBUTL("DUZ",,,UID)
"RTN","BSDX30",91,0)
 ;. I BSDXWID'="" Q:BSDXWID'=$TR($$GETVAR^CIANBUTL("WID",,,UID),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
"RTN","BSDX30",92,0)
 ;. D QUEUE^CIANBEVT("CONTEXT.PATIENT",+DFN,UID)
"RTN","BSDX30",93,0)
 ;Q
"RTN","BSDX31")
0^29^B45572120
"RTN","BSDX31",1,0)
BSDX31  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:39am
"RTN","BSDX31",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX31",3,0)
 ; Licensed under LGPL
"RTN","BSDX31",4,0)
 ; Change Log:
"RTN","BSDX31",5,0)
 ; v1.42 3101023 WV/SMH - Change transaction to restartable. 
"RTN","BSDX31",6,0)
 ; v1.42 3101206 UJO/SMH - Extensive refactoring
"RTN","BSDX31",7,0)
 ; v1.7  3120626 VEN/SMH - Removed transactions; extensive refactoring
"RTN","BSDX31",8,0)
 ;                       - Moved APTNS (whatever it was) to BSDXAPI1 
"RTN","BSDX31",9,0)
 ;                         as $$NOSHOW
"RTN","BSDX31",10,0)
 ;                       - Made BSDXNOS extrinsic.
"RTN","BSDX31",11,0)
 ;                       - Moved Unit Tests to BSDXUT1
"RTN","BSDX31",12,0)
 ;                       - BSDXNOS deletes no-show rather than file 0 for
"RTN","BSDX31",13,0)
 ;                         undoing a no show
"RTN","BSDX31",14,0)
 ; 
"RTN","BSDX31",15,0)
 ; Error Reference:
"RTN","BSDX31",16,0)
 ; -1: zero or null Appt ID
"RTN","BSDX31",17,0)
 ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT)
"RTN","BSDX31",18,0)
 ; -3: No-show flag is invalid
"RTN","BSDX31",19,0)
 ; -4: Filing of No-show in ^BSDXAPPT failed
"RTN","BSDX31",20,0)
 ; -5: Filing of No-show in ^DPT failed (BSDXAPI error)
"RTN","BSDX31",21,0)
 ; -6: Invalid Resource ID
"RTN","BSDX31",22,0)
 ; -7: Lock not acquired on ^BSDXAPPT(BSDXAPTID)
"RTN","BSDX31",23,0)
 ; -100: M Error
"RTN","BSDX31",24,0)
 ;
"RTN","BSDX31",25,0)
 ;
"RTN","BSDX31",26,0)
NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP
"RTN","BSDX31",27,0)
 ;Entry point for debugging
"RTN","BSDX31",28,0)
 ;
"RTN","BSDX31",29,0)
 ; D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")
"RTN","BSDX31",30,0)
 Q
"RTN","BSDX31",31,0)
 ;
"RTN","BSDX31",32,0)
NOSHOW(BSDXY,BSDXAPTID,BSDXNS)         ;EP - No show a patient
"RTN","BSDX31",33,0)
 ; Called by RPC: BSDX NOSHOW
"RTN","BSDX31",34,0)
 ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2
"RTN","BSDX31",35,0)
 ;
"RTN","BSDX31",36,0)
 ; Parameters:
"RTN","BSDX31",37,0)
 ; BSDXY: Global Return
"RTN","BSDX31",38,0)
 ; BSDXAPTID is entry number in BSDX APPOINTMENT file
"RTN","BSDX31",39,0)
 ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO
"RTN","BSDX31",40,0)
 ; 
"RTN","BSDX31",41,0)
 ; Returns ADO.net record set with fields
"RTN","BSDX31",42,0)
 ; - ERRORID; ERRORTEXT
"RTN","BSDX31",43,0)
 ; ERRORID of 1 is okay
"RTN","BSDX31",44,0)
 ; Anything else is an error.
"RTN","BSDX31",45,0)
 ;
"RTN","BSDX31",46,0)
 ; Return Array; set and clear
"RTN","BSDX31",47,0)
 S BSDXY=$NA(^BSDXTMP($J))
"RTN","BSDX31",48,0)
 K ^BSDXTMP($J)
"RTN","BSDX31",49,0)
 ;
"RTN","BSDX31",50,0)
 ; $ET
"RTN","BSDX31",51,0)
 N $ET S $ET="G ETRAP^BSDX31"
"RTN","BSDX31",52,0)
 ;
"RTN","BSDX31",53,0)
 ; Basline vars
"RTN","BSDX31",54,0)
 D ^XBKVAR  ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist
"RTN","BSDX31",55,0)
 ;
"RTN","BSDX31",56,0)
 ; Counter
"RTN","BSDX31",57,0)
 N BSDXI S BSDXI=0
"RTN","BSDX31",58,0)
 ;
"RTN","BSDX31",59,0)
 ; Header Node
"RTN","BSDX31",60,0)
 S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30)
"RTN","BSDX31",61,0)
 ;
"RTN","BSDX31",62,0)
 ;;;test for error. See if %ZTER works
"RTN","BSDX31",63,0)
 I $G(BSDXDIE) N X S X=1/0
"RTN","BSDX31",64,0)
 ;;;TEST
"RTN","BSDX31",65,0)
 ;
"RTN","BSDX31",66,0)
 ; Turn off SDAM APPT PROTOCOL BSDX Entries
"RTN","BSDX31",67,0)
 N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
"RTN","BSDX31",68,0)
 ;
"RTN","BSDX31",69,0)
 ; Appointment ID check
"RTN","BSDX31",70,0)
 I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q
"RTN","BSDX31",71,0)
 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q
"RTN","BSDX31",72,0)
 ;
"RTN","BSDX31",73,0)
 ; Lock BSDX node, only to synchronize access to the globals.
"RTN","BSDX31",74,0)
 ; It's not expected that the error will ever happen as no filing
"RTN","BSDX31",75,0)
 ; is supposed to take 5 seconds.
"RTN","BSDX31",76,0)
 L +^BSDXAPPT(BSDXAPTID):5 E  D ERR(-7,"BSDX31: Appt record is locked. Please contact technical support.") Q
"RTN","BSDX31",77,0)
 ;
"RTN","BSDX31",78,0)
 ; Noshow value check - Must be 1 or 0
"RTN","BSDX31",79,0)
 S BSDXNS=+BSDXNS
"RTN","BSDX31",80,0)
 I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q
"RTN","BSDX31",81,0)
 ;
"RTN","BSDX31",82,0)
 ; Get Some data
"RTN","BSDX31",83,0)
 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node
"RTN","BSDX31",84,0)
 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
"RTN","BSDX31",85,0)
 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U)  ; Start Date/Time
"RTN","BSDX31",86,0)
 N BSDXRES S BSDXRES=$P(BSDXNOD,U,7) ; Resource ID
"RTN","BSDX31",87,0)
 ;
"RTN","BSDX31",88,0)
 ; Check if Resource ID is missing or invalid
"RTN","BSDX31",89,0)
 I BSDXRES="" D ERR(-6,"BSDX31: Invalid Resource") QUIT
"RTN","BSDX31",90,0)
 I '$D(^BSDXRES(BSDXRES,0)) D ERR(-6,"BSDX31: Invalid Resource") QUIT
"RTN","BSDX31",91,0)
 ;
"RTN","BSDX31",92,0)
 ; Get the Hospital Location
"RTN","BSDX31",93,0)
 N BSDXRESNOD S BSDXRESNOD=^BSDXRES(BSDXRES,0)
"RTN","BSDX31",94,0)
 N BSDXLOC S BSDXLOC=$P(BSDXRESNOD,U,4) ;HOSPITAL LOCATION
"RTN","BSDX31",95,0)
 I BSDXLOC,'$D(^SC(BSDXLOC,0)) S BSDXLOC="" ; Unlink it if it doesn't exist
"RTN","BSDX31",96,0)
 ; I can go and then delete it from ^BSDXRES like Mailman code which tries
"RTN","BSDX31",97,0)
 ; to be too helpful... but I will postpone that until this is a need.
"RTN","BSDX31",98,0)
 ;
"RTN","BSDX31",99,0)
 ; Check if it's okay to no-show patient.
"RTN","BSDX31",100,0)
 N BSDXERR S BSDXERR=0 ; Error variable
"RTN","BSDX31",101,0)
 I BSDXLOC S BSDXERR=$$NOSHOWCK^BSDXAPI1(BSDXPATID,BSDXLOC,BSDXSTART,BSDXNS)
"RTN","BSDX31",102,0)
 I BSDXERR D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2)) QUIT
"RTN","BSDX31",103,0)
 ;
"RTN","BSDX31",104,0)
 ; Simulated Error
"RTN","BSDX31",105,0)
 I $G(BSDXSIMERR1) D ERR(-4,"BSDX31: Simulated Error") QUIT
"RTN","BSDX31",106,0)
 ; Edit BSDX APPOINTMENT entry No-show field
"RTN","BSDX31",107,0)
 ; Failure Analysis: If we fail here, no rollback needed, as this is the 1st
"RTN","BSDX31",108,0)
 ; call
"RTN","BSDX31",109,0)
 N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPTID,BSDXNS)
"RTN","BSDX31",110,0)
 I BSDXMSG D ERR(-4,"BSDX31: "_$P(BSDXMSG,U,2)) QUIT
"RTN","BSDX31",111,0)
 ;
"RTN","BSDX31",112,0)
 ; Edit File 2 "S" node entry
"RTN","BSDX31",113,0)
 ; Failure Analysis: If we fail here, we need to rollback the BSDX
"RTN","BSDX31",114,0)
 ; Apptointment Entry
"RTN","BSDX31",115,0)
 N BSDXERR S BSDXERR=0 ; Error variable
"RTN","BSDX31",116,0)
 ; If HL exist, (resource is linked to PIMS), file no show in File 2
"RTN","BSDX31",117,0)
 I BSDXLOC S BSDXERR=$$NOSHOW^BSDXAPI1(BSDXPATID,BSDXLOC,BSDXSTART,BSDXNS)
"RTN","BSDX31",118,0)
 I BSDXERR D  QUIT
"RTN","BSDX31",119,0)
 . D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2))
"RTN","BSDX31",120,0)
 . N % S %=$$BSDXNOS(BSDXAPTID,'BSDXNS) ; no error checking for filer
"RTN","BSDX31",121,0)
 ;
"RTN","BSDX31",122,0)
 ; Unlock
"RTN","BSDX31",123,0)
 L -^BSDXAPPT(BSDXAPTID)
"RTN","BSDX31",124,0)
 ;
"RTN","BSDX31",125,0)
 ; Return data in ADO.net table
"RTN","BSDX31",126,0)
 S BSDXI=BSDXI+1
"RTN","BSDX31",127,0)
 S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay
"RTN","BSDX31",128,0)
 S BSDXI=BSDXI+1
"RTN","BSDX31",129,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX31",130,0)
 QUIT
"RTN","BSDX31",131,0)
 ;
"RTN","BSDX31",132,0)
BSDXNOS(BSDXAPTID,BSDXNS) ; $$ Private; File/unfile noshow in ^BSDXAPPT
"RTN","BSDX31",133,0)
 ; in v1.7 I delete the no-show value rather than file zero
"RTN","BSDX31",134,0)
 N BSDXFDA,BSDXIENS,BSDXMSG
"RTN","BSDX31",135,0)
 N BSDXVALUE ; What to file: 1 or delete it.
"RTN","BSDX31",136,0)
 I BSDXNS S BSDXVALUE=1
"RTN","BSDX31",137,0)
 E  S BSDXVALUE="@"
"RTN","BSDX31",138,0)
 S BSDXIENS=BSDXAPTID_","
"RTN","BSDX31",139,0)
 S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXVALUE ;NOSHOW 1 or 0
"RTN","BSDX31",140,0)
 D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX31",141,0)
 QUIT:$D(BSDXMSG) -1_U_BSDXMSG("DIERR",1,"TEXT",1)
"RTN","BSDX31",142,0)
 QUIT 0
"RTN","BSDX31",143,0)
 ;
"RTN","BSDX31",144,0)
NOSEVT(BSDXPAT,BSDXSTART,BSDXSC)    ;EP Called by BSDX NOSHOW APPOINTMENT event
"RTN","BSDX31",145,0)
 ;when appointments NOSHOW via PIMS interface.
"RTN","BSDX31",146,0)
 ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients
"RTN","BSDX31",147,0)
 ;
"RTN","BSDX31",148,0)
 Q:+$G(BSDXNOEV)
"RTN","BSDX31",149,0)
 Q:'+$G(BSDXSC)
"RTN","BSDX31",150,0)
 Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
"RTN","BSDX31",151,0)
 N BSDXSTAT,BSDXFOUND,BSDXRES
"RTN","BSDX31",152,0)
 S BSDXSTAT=1
"RTN","BSDX31",153,0)
 S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0
"RTN","BSDX31",154,0)
 S BSDXFOUND=0
"RTN","BSDX31",155,0)
 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
"RTN","BSDX31",156,0)
 I BSDXFOUND D NOSEVT3(BSDXRES) Q
"RTN","BSDX31",157,0)
 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
"RTN","BSDX31",158,0)
 I BSDXFOUND D NOSEVT3(BSDXRES)
"RTN","BSDX31",159,0)
 Q
"RTN","BSDX31",160,0)
 ;
"RTN","BSDX31",161,0)
NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
"RTN","BSDX31",162,0)
 ;Get appointment id in BSDXAPT
"RTN","BSDX31",163,0)
 ;If found, call BSDXNOS(BSDXAPPT) and return 1
"RTN","BSDX31",164,0)
 ;else return 0
"RTN","BSDX31",165,0)
 N BSDXFOUND,BSDXAPPT,BSDXNOD
"RTN","BSDX31",166,0)
 S BSDXFOUND=0
"RTN","BSDX31",167,0)
 Q:'+$G(BSDXRES) BSDXFOUND
"RTN","BSDX31",168,0)
 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
"RTN","BSDX31",169,0)
 S BSDXAPPT=0 F  S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT  D  Q:BSDXFOUND
"RTN","BSDX31",170,0)
 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
"RTN","BSDX31",171,0)
 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
"RTN","BSDX31",172,0)
 I BSDXFOUND,+$G(BSDXAPPT) N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPPT,BSDXSTAT)
"RTN","BSDX31",173,0)
 I BSDXMSG D ^%ZTER ; Last ditch error handling. This is supposed to be silently called from the protocol file.
"RTN","BSDX31",174,0)
 Q BSDXFOUND
"RTN","BSDX31",175,0)
 ;
"RTN","BSDX31",176,0)
NOSEVT3(BSDXRES)    ;
"RTN","BSDX31",177,0)
 ;Call RaiseEvent to notify GUI clients
"RTN","BSDX31",178,0)
 ;
"RTN","BSDX31",179,0)
 N BSDXRESN
"RTN","BSDX31",180,0)
 S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
"RTN","BSDX31",181,0)
 Q:BSDXRESN=""
"RTN","BSDX31",182,0)
 S BSDXRESN=$P(BSDXRESN,"^")
"RTN","BSDX31",183,0)
 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
"RTN","BSDX31",184,0)
 Q
"RTN","BSDX31",185,0)
 ;
"RTN","BSDX31",186,0)
 ;
"RTN","BSDX31",187,0)
ERR(BSDXERID,ERRTXT)    ;Error processing
"RTN","BSDX31",188,0)
 ; Unlock first
"RTN","BSDX31",189,0)
 L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
"RTN","BSDX31",190,0)
 ; If last line is $C(31), we are done. No more errors to send to client.
"RTN","BSDX31",191,0)
 I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
"RTN","BSDX31",192,0)
 S BSDXI=BSDXI+1
"RTN","BSDX31",193,0)
 S ERRTXT=$TR(ERRTXT,"^","~")
"RTN","BSDX31",194,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
"RTN","BSDX31",195,0)
 S BSDXI=BSDXI+1
"RTN","BSDX31",196,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX31",197,0)
 QUIT
"RTN","BSDX31",198,0)
 ;
"RTN","BSDX31",199,0)
ETRAP   ;EP Error trap entry
"RTN","BSDX31",200,0)
 N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
"RTN","BSDX31",201,0)
 D ^%ZTER
"RTN","BSDX31",202,0)
 ;
"RTN","BSDX31",203,0)
 ; Send to client
"RTN","BSDX31",204,0)
 I '$D(BSDXI) N BSDXI S BSDXI=0
"RTN","BSDX31",205,0)
 D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE))
"RTN","BSDX31",206,0)
 Q:$Q 100_U_"Mumps Error" Q
"RTN","BSDX31",207,0)
 ;
"RTN","BSDX31",208,0)
IMHERE(BSDXRES) ;EP
"RTN","BSDX31",209,0)
 ;Entry point for BSDX IM HERE remote procedure
"RTN","BSDX31",210,0)
 S BSDXRES=1
"RTN","BSDX31",211,0)
 Q
"RTN","BSDX31",212,0)
 ;
"RTN","BSDX32")
0^30^B20186652
"RTN","BSDX32",1,0)
BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/11/11 10:39am
"RTN","BSDX32",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX32",3,0)
 ; Licensed under LGPL
"RTN","BSDX32",4,0)
 ;
"RTN","BSDX32",5,0)
 ; Change Log:
"RTN","BSDX32",6,0)
 ; April 2011: Added Field "IS_RADIOLOGY_LOCATION" to help decide if the Hospital Location
"RTN","BSDX32",7,0)
 ; should be treated in the GUI as a Radiology Location
"RTN","BSDX32",8,0)
 ;
"RTN","BSDX32",9,0)
 ;
"RTN","BSDX32",10,0)
ERROR ;
"RTN","BSDX32",11,0)
 D ERR("RPMS Error")
"RTN","BSDX32",12,0)
 Q
"RTN","BSDX32",13,0)
 ;
"RTN","BSDX32",14,0)
ERR(BSDXERR) ;Error processing
"RTN","BSDX32",15,0)
 S BSDXI=BSDXI+1
"RTN","BSDX32",16,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX32",17,0)
 Q
"RTN","BSDX32",18,0)
 ;
"RTN","BSDX32",19,0)
HOSPLOCD(BSDXY) ;EP Debugging entry point
"RTN","BSDX32",20,0)
 ;
"RTN","BSDX32",21,0)
 ;D DEBUG^%Serenji("HOSPLOC^BSDX32(.BSDXY)")
"RTN","BSDX32",22,0)
 ;
"RTN","BSDX32",23,0)
 Q
"RTN","BSDX32",24,0)
 ;
"RTN","BSDX32",25,0)
HOSPLOC(BSDXY) ;EP
"RTN","BSDX32",26,0)
 ;Called by BSDX HOSPITAL LOCATION
"RTN","BSDX32",27,0)
    ;Returns all hospital locations that are active 
"RTN","BSDX32",28,0)
 ;
"RTN","BSDX32",29,0)
 N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXINA,BSDXREA,BSDXSCOD
"RTN","BSDX32",30,0)
 D ^XBKVAR S X="ERROR^BSDX32",@^%ZOSF("TRAP")
"RTN","BSDX32",31,0)
 K ^BSDXTMP($J)
"RTN","BSDX32",32,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX32",33,0)
 S BSDXI=0
"RTN","BSDX32",34,0)
 ;"SELECT BSDXIEN 'HOSPITAL_LOCATION_ID', NAME 'HOSPITAL_LOCATION', DEFAULT_PROVIDER, STOP_CODE_NUMBER, INACTIVATE_DATE, REACTIVATE_DATE FROM HOSPITAL_LOCATION";
"RTN","BSDX32",35,0)
 S ^BSDXTMP($J,BSDXI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE^T00001IS_RADIOLOGY_LOCATION"_$C(30)
"RTN","BSDX32",36,0)
 ;
"RTN","BSDX32",37,0)
 S BSDXNAM="" F  S BSDXNAM=$O(^SC("B",BSDXNAM)) Q:BSDXNAM=""  D
"RTN","BSDX32",38,0)
 . S BSDXIEN=$O(^SC("B",BSDXNAM,0))
"RTN","BSDX32",39,0)
 . Q:'+BSDXIEN>0
"RTN","BSDX32",40,0)
 . Q:'$D(^SC(+BSDXIEN,0))
"RTN","BSDX32",41,0)
    . ;Q:'$$INDIV^BSDX01(+BSDXIEN)  ; if not in the same division, quit
"RTN","BSDX32",42,0)
 . S BSDXINA=$$GET1^DIQ(44,BSDXIEN_",",2505) ;INACTIVATE
"RTN","BSDX32",43,0)
 . S BSDXREA=$$GET1^DIQ(44,BSDXIEN_",",2506) ;REACTIVATE
"RTN","BSDX32",44,0)
 . I BSDXINA]""&(BSDXREA="") Q  ;Clinic is inactivated and has no reactivate date
"RTN","BSDX32",45,0)
 . S BSDXNOD=^SC(BSDXIEN,0)
"RTN","BSDX32",46,0)
 . S BSDXNAM=$P(BSDXNOD,U)
"RTN","BSDX32",47,0)
 . S BSDXSCOD=$$GET1^DIQ(44,BSDXIEN_",",8) ;STOP CODE
"RTN","BSDX32",48,0)
 . ;Calculate default provider
"RTN","BSDX32",49,0)
 . S BSDXPRV=""
"RTN","BSDX32",50,0)
 . I $D(^SC(BSDXIEN,"PR")) D
"RTN","BSDX32",51,0)
 . . S BSDXIEN1=0 F  S BSDXIEN1=$O(^SC(BSDXIEN,"PR",BSDXIEN1)) Q:'+BSDXIEN1  Q:BSDXPRV]""  D
"RTN","BSDX32",52,0)
 . . . S BSDXNOD1=$G(^SC(BSDXIEN,"PR",BSDXIEN1,0))
"RTN","BSDX32",53,0)
 . . . S:$P(BSDXNOD1,U,2)="1" BSDXPRV=$$GET1^DIQ(200,$P(BSDXNOD1,U),.01)
"RTN","BSDX32",54,0)
 . . . Q
"RTN","BSDX32",55,0)
 . . Q
"RTN","BSDX32",56,0)
 . ; Decide if this is a radiology location - Check "B" index of ^RA(79.1 global to see if HL is there
"RTN","BSDX32",57,0)
 . N BSDXISRAD S BSDXISRAD=''$DATA(^RA(79.1,"B",BSDXIEN))
"RTN","BSDX32",58,0)
 . ;
"RTN","BSDX32",59,0)
 . S BSDXI=BSDXI+1
"RTN","BSDX32",60,0)
 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXPRV_U_BSDXSCOD_U_BSDXINA_U_BSDXREA_U_BSDXISRAD_$C(30)
"RTN","BSDX32",61,0)
 . Q
"RTN","BSDX32",62,0)
 S BSDXI=BSDXI+1
"RTN","BSDX32",63,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX32",64,0)
 Q
"RTN","BSDX32",65,0)
 ;
"RTN","BSDX32",66,0)
CLNSETD(BSDXY) ;EP Debugging entry point
"RTN","BSDX32",67,0)
 ;
"RTN","BSDX32",68,0)
 ;D DEBUG^%Serenji("CLNSET^BSDX32(.BSDXY)")
"RTN","BSDX32",69,0)
 ;
"RTN","BSDX32",70,0)
 Q
"RTN","BSDX32",71,0)
 ;
"RTN","BSDX32",72,0)
CLNSET(BSDXY) ;EP
"RTN","BSDX32",73,0)
 ;Called by BSDX CLINIC SETUP
"RTN","BSDX32",74,0)
 ;Returns CLINIC SETUP file entries for clinics which
"RTN","BSDX32",75,0)
 ;are active in ^SC
"RTN","BSDX32",76,0)
 N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXINA,BSDXREA
"RTN","BSDX32",77,0)
 N BSDXCRV,BSDXVSC,BSDXMULT,BSDXREQ,BSDXPCC
"RTN","BSDX32",78,0)
 D ^XBKVAR S X="ERROR^BSDX32",@^%ZOSF("TRAP")
"RTN","BSDX32",79,0)
 K ^BSDXTMP($J)
"RTN","BSDX32",80,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX32",81,0)
 S BSDXI=0
"RTN","BSDX32",82,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",83,0)
 ;GENERATE_PCCPLUS_FORMS? FROM CLINIC_SETUP_PARAMETERS
"RTN","BSDX32",84,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",85,0)
 ;
"RTN","BSDX32",86,0)
 S BSDXIEN=0 F  S BSDXIEN=$O(^BSDSC(BSDXIEN)) Q:'+BSDXIEN  D
"RTN","BSDX32",87,0)
 . Q:'$D(^SC(+BSDXIEN,0))
"RTN","BSDX32",88,0)
 . Q:'$D(^BSDSC(+BSDXIEN,0))
"RTN","BSDX32",89,0)
 . S BSDXINA=$$GET1^DIQ(44,BSDXIEN_",",2505) ;INACTIVATE
"RTN","BSDX32",90,0)
 . S BSDXREA=$$GET1^DIQ(44,BSDXIEN_",",2506) ;REACTIVATE
"RTN","BSDX32",91,0)
 . I BSDXINA]""&(BSDXREA="") Q  ;Clinic is inactivated and has no reactivate date
"RTN","BSDX32",92,0)
 . S BSDXNOD=^BSDSC(BSDXIEN,0)
"RTN","BSDX32",93,0)
 . S BSDXNAM=$$GET1^DIQ(44,BSDXIEN_",",.01)
"RTN","BSDX32",94,0)
 . S BSDXCRV=$$GET1^DIQ(9009017.2,BSDXIEN_",",.09)
"RTN","BSDX32",95,0)
 . S BSDXVSC=$$GET1^DIQ(9009017.2,BSDXIEN_",",.12)
"RTN","BSDX32",96,0)
 . S BSDXMULT=$$GET1^DIQ(9009017.2,BSDXIEN_",",.13)
"RTN","BSDX32",97,0)
 . S BSDXREQ=$$GET1^DIQ(9009017.2,BSDXIEN_",",.14)
"RTN","BSDX32",98,0)
 . S BSDXPCC=$$GET1^DIQ(9009017.2,BSDXIEN_",",.15)
"RTN","BSDX32",99,0)
 . S BSDXI=BSDXI+1
"RTN","BSDX32",100,0)
 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXCRV_U_BSDXVSC_U_BSDXMULT_U_BSDXREQ_U_BSDXPCC_$C(30)
"RTN","BSDX32",101,0)
 . Q
"RTN","BSDX32",102,0)
 S BSDXI=BSDXI+1
"RTN","BSDX32",103,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX32",104,0)
 Q
"RTN","BSDX33")
0^31^B14422341
"RTN","BSDX33",1,0)
BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
"RTN","BSDX33",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX33",3,0)
 ; Licensed under LGPL
"RTN","BSDX33",4,0)
 ; Mods by WV/STAR
"RTN","BSDX33",5,0)
 ;
"RTN","BSDX33",6,0)
 ; Change Log:
"RTN","BSDX33",7,0)
 ; July 13, 2010
"RTN","BSDX33",8,0)
 ; v 1.3 adds fixes Rebooking behavior in application (see RBNEXT)
"RTN","BSDX33",9,0)
 ; also adds i18 support - Dates passed in FM format from application
"RTN","BSDX33",10,0)
 ; in tag SETRBK and RBNEXT
"RTN","BSDX33",11,0)
 ;
"RTN","BSDX33",12,0)
 ;
"RTN","BSDX33",13,0)
 Q
"RTN","BSDX33",14,0)
RBNEXTD(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP
"RTN","BSDX33",15,0)
 ;Entry point for debugging
"RTN","BSDX33",16,0)
 ;
"RTN","BSDX33",17,0)
 ;D DEBUG^%Serenji("RBNEXT^BSDX33(.BSDXY,BSDXDATE,BSDXRES,BSDXTPID)")
"RTN","BSDX33",18,0)
 Q
"RTN","BSDX33",19,0)
 ;
"RTN","BSDX33",20,0)
RBNEXT(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP
"RTN","BSDX33",21,0)
 ;Called by BSDX REBOOK NEXT BLOCK to find
"RTN","BSDX33",22,0)
 ;the next ACCESS BLOCK in resource BSDXRES after BSDXDATE
"RTN","BSDX33",23,0)
 ;Returns 1 in ERRORID and date in NEXTBLOCK if a block was found or NULL in NEXTBLOCK of no date found
"RTN","BSDX33",24,0)
 ;Otherwise, returns 0 and error message in ERRORTEXT
"RTN","BSDX33",25,0)
 ;If BSDXTPID = 0 then any access type match
"RTN","BSDX33",26,0)
 ;
"RTN","BSDX33",27,0)
 S X="ERROR2^BSDX33",@^%ZOSF("TRAP")
"RTN","BSDX33",28,0)
 N BSDXI,BSDXIENS,%DT,BSDXMSG,Y,BSDXRESD,BSDXFND,BSDXIEN,BSDXNOD,BSDXATID
"RTN","BSDX33",29,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX33",30,0)
 S BSDXI=0
"RTN","BSDX33",31,0)
 S ^BSDXTMP($J,BSDXI)="I00020ERRORID^D00010NEXTBLOCK^T00030ERRORTEXT"_$C(30)
"RTN","BSDX33",32,0)
 ;
"RTN","BSDX33",33,0)
 I BSDXRES="" D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
"RTN","BSDX33",34,0)
 I '$D(^BSDXRES("B",BSDXRES)) D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
"RTN","BSDX33",35,0)
 S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
"RTN","BSDX33",36,0)
 I '+BSDXRESD D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
"RTN","BSDX33",37,0)
 ;
"RTN","BSDX33",38,0)
    ; i18n fix
"RTN","BSDX33",39,0)
    ; S X=BSDXDATE,%DT="XT" D ^%DT
"RTN","BSDX33",40,0)
 ; I Y=-1 D ERR2(1,"BSDX REBOOK NEXT BLOCK: Invalid datetime") Q
"RTN","BSDX33",41,0)
 ;
"RTN","BSDX33",42,0)
    ; S BSDXDATE=$P(Y,".")
"RTN","BSDX33",43,0)
 ;
"RTN","BSDX33",44,0)
 S BSDXFND=0
"RTN","BSDX33",45,0)
 F  S BSDXDATE=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE)) Q:'+BSDXDATE  D  Q:BSDXFND
"RTN","BSDX33",46,0)
 . S BSDXIEN=0 F  S BSDXIEN=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE,BSDXIEN)) Q:'+BSDXIEN  D  Q:BSDXFND
"RTN","BSDX33",47,0)
 . . Q:'$D(^BSDXAB(BSDXIEN,0))
"RTN","BSDX33",48,0)
 . . S BSDXNOD=^BSDXAB(BSDXIEN,0)
"RTN","BSDX33",49,0)
 . . Q:+$P(BSDXNOD,U,4)=0  ;Slots
"RTN","BSDX33",50,0)
 . . S BSDXATID=$P(BSDXNOD,U,5)
"RTN","BSDX33",51,0)
 . . I BSDXTPID=0!(BSDXATID=BSDXTPID) S BSDXFND=$P(BSDXNOD,U,2) Q
"RTN","BSDX33",52,0)
 ;
"RTN","BSDX33",53,0)
 I BSDXFND=0 S BSDXFND=""
"RTN","BSDX33",54,0)
 E  S Y=BSDXFND X ^DD("DD") S BSDXFND=Y
"RTN","BSDX33",55,0)
 S BSDXI=BSDXI+1
"RTN","BSDX33",56,0)
    ;//smh - bug (V 1.3): Need to replace @ in FM date for C# to recognize it
"RTN","BSDX33",57,0)
    S BSDXFND=$TR(BSDXFND,"@"," ")
"RTN","BSDX33",58,0)
    ;//smh end fix
"RTN","BSDX33",59,0)
 S ^BSDXTMP($J,BSDXI)="1^"_BSDXFND_"^"_$C(30)_$C(31)
"RTN","BSDX33",60,0)
 Q
"RTN","BSDX33",61,0)
SETRBKD(BSDXY,BSDXAPPT,BSDXDATE) ;EP
"RTN","BSDX33",62,0)
 ;Entry point for debugging
"RTN","BSDX33",63,0)
 ;
"RTN","BSDX33",64,0)
 ;D DEBUG^%Serenji("SETRBK^BSDX33(.BSDXY,BSDXAPPT,BSDXDATE)")
"RTN","BSDX33",65,0)
 Q
"RTN","BSDX33",66,0)
 ;
"RTN","BSDX33",67,0)
SETRBK(BSDXY,BSDXAPPT,BSDXDATE) ;EP
"RTN","BSDX33",68,0)
 ;
"RTN","BSDX33",69,0)
 ;Sets rebook date into appointment
"RTN","BSDX33",70,0)
 ;BSDXAPPT - Appointment ID
"RTN","BSDX33",71,0)
 ;BSDXDATE - Rebook Datetime in internal format
"RTN","BSDX33",72,0)
 ;Called by BSDX REBOOK SET
"RTN","BSDX33",73,0)
 ;
"RTN","BSDX33",74,0)
 ;ErrorID:
"RTN","BSDX33",75,0)
 ; 0 if a problem.  Message in ERRORTEXT
"RTN","BSDX33",76,0)
 ; 1 if OK
"RTN","BSDX33",77,0)
 ;
"RTN","BSDX33",78,0)
 S X="ERROR^BSDX33",@^%ZOSF("TRAP")
"RTN","BSDX33",79,0)
 N BSDXI,BSDXIENS,%DT,BSDXMSG,Y
"RTN","BSDX33",80,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX33",81,0)
 S BSDXI=0
"RTN","BSDX33",82,0)
 S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
"RTN","BSDX33",83,0)
 ;
"RTN","BSDX33",84,0)
 I '+BSDXAPPT
"RTN","BSDX33",85,0)
 I '$D(^BSDXAPPT(BSDXAPPT,0)) D ERR(1,"BSDX REBOOK SET: Invalid appointment ID") Q
"RTN","BSDX33",86,0)
 ; i18n (v 1.3)
"RTN","BSDX33",87,0)
    ;S X=BSDXDATE,%DT="XT" D ^%DT
"RTN","BSDX33",88,0)
 ;I Y=-1 D ERR(1,"BSDX REBOOK SET: Invalid rebook datetime") Q
"RTN","BSDX33",89,0)
 ;S BSDXDATE=Y
"RTN","BSDX33",90,0)
 S BSDXIENS=BSDXAPPT_","
"RTN","BSDX33",91,0)
 S BSDXFDA(9002018.4,BSDXIENS,.11)=+BSDXDATE
"RTN","BSDX33",92,0)
 ;
"RTN","BSDX33",93,0)
 K BSDXMSG
"RTN","BSDX33",94,0)
 D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDX33",95,0)
 S BSDXI=BSDXI+1
"RTN","BSDX33",96,0)
 S ^BSDXTMP($J,BSDXI)="1^"_$C(31)
"RTN","BSDX33",97,0)
 ;
"RTN","BSDX33",98,0)
 Q
"RTN","BSDX33",99,0)
 ;
"RTN","BSDX33",100,0)
ERR(BSDXERID,ERRTXT) ;Error processing
"RTN","BSDX33",101,0)
 S:'+$G(BSDXI) BSDXI=999999
"RTN","BSDX33",102,0)
 S BSDXI=BSDXI+1
"RTN","BSDX33",103,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
"RTN","BSDX33",104,0)
 S BSDXI=BSDXI+1
"RTN","BSDX33",105,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX33",106,0)
 Q
"RTN","BSDX33",107,0)
 ;
"RTN","BSDX33",108,0)
ERROR ;
"RTN","BSDX33",109,0)
 D ^%ZTER
"RTN","BSDX33",110,0)
 I '+$G(BSDXI) N BSDXI S BSDXI=999999
"RTN","BSDX33",111,0)
 S BSDXI=BSDXI+1
"RTN","BSDX33",112,0)
 D ERR(0,"BSDX33 M Error: <"_$G(%ZTERROR)_">")
"RTN","BSDX33",113,0)
 Q
"RTN","BSDX33",114,0)
 ;
"RTN","BSDX33",115,0)
ERR2(BSDXERID,ERRTXT) ;Error processing
"RTN","BSDX33",116,0)
 S:'+$G(BSDXI) BSDXI=999999
"RTN","BSDX33",117,0)
 S BSDXI=BSDXI+1
"RTN","BSDX33",118,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^^"_ERRTXT_$C(30)
"RTN","BSDX33",119,0)
 S BSDXI=BSDXI+1
"RTN","BSDX33",120,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX33",121,0)
 Q
"RTN","BSDX33",122,0)
 ;
"RTN","BSDX33",123,0)
ERROR2 ;
"RTN","BSDX33",124,0)
 D ^%ZTER
"RTN","BSDX33",125,0)
 I '+$G(BSDXI) N BSDXI S BSDXI=999999
"RTN","BSDX33",126,0)
 S BSDXI=BSDXI+1
"RTN","BSDX33",127,0)
 D ERR2(0,"BSDX33 M Error: <"_$G(%ZTERROR)_">")
"RTN","BSDX33",128,0)
 Q
"RTN","BSDX34")
0^32^B43456861
"RTN","BSDX34",1,0)
BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
"RTN","BSDX34",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX34",3,0)
 ; Licensed under LGPL  
"RTN","BSDX34",4,0)
 ;
"RTN","BSDX34",5,0)
 ; Change Log:
"RTN","BSDX34",6,0)
 ; July 10 2010: 
"RTN","BSDX34",7,0)
 ; CANCLIN AND RBCLIN: Dates passed in FM format for i18n
"RTN","BSDX34",8,0)
 ;
"RTN","BSDX34",9,0)
 Q
"RTN","BSDX34",10,0)
 ;
"RTN","BSDX34",11,0)
RBCLIND(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
"RTN","BSDX34",12,0)
 ;Entry point for debugging
"RTN","BSDX34",13,0)
 ;
"RTN","BSDX34",14,0)
 ;D DEBUG^%Serenji("RBCLIN^BSDX34(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")
"RTN","BSDX34",15,0)
 Q
"RTN","BSDX34",16,0)
 ;
"RTN","BSDX34",17,0)
RBERR ;
"RTN","BSDX34",18,0)
 ;Called from RBCLIN on error to set up header
"RTN","BSDX34",19,0)
 K ^BSDXTMP($J)
"RTN","BSDX34",20,0)
 S ^BSDXTMP($J,0)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus^I00010RESOURCEID"
"RTN","BSDX34",21,0)
 S ^BSDXTMP($J,0)=^(0)_"^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30)
"RTN","BSDX34",22,0)
 D ERR(999)
"RTN","BSDX34",23,0)
 Q
"RTN","BSDX34",24,0)
 ;
"RTN","BSDX34",25,0)
CANCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
"RTN","BSDX34",26,0)
 ;
"RTN","BSDX34",27,0)
 ;Return recordset of CANCELLED patient appointments
"RTN","BSDX34",28,0)
 ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
"RTN","BSDX34",29,0)
 ;Used in generating cancellation letters for a clinic
"RTN","BSDX34",30,0)
 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens.  (The last |-piece is null, so discard it.)
"RTN","BSDX34",31,0)
    ;v 1.3 BSDXBEG and BSDXEND are in fm format
"RTN","BSDX34",32,0)
 ;Called by BSDX CANCEL CLINIC LIST
"RTN","BSDX34",33,0)
 N BSDXCAN
"RTN","BSDX34",34,0)
 S BSDXCAN=1
"RTN","BSDX34",35,0)
 D RBCLIN(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)
"RTN","BSDX34",36,0)
 ;
"RTN","BSDX34",37,0)
 Q
"RTN","BSDX34",38,0)
 ;
"RTN","BSDX34",39,0)
RBCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
"RTN","BSDX34",40,0)
 ;
"RTN","BSDX34",41,0)
 ;Return recordset of rebooked patient appointments
"RTN","BSDX34",42,0)
 ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
"RTN","BSDX34",43,0)
 ;Used in generating rebook letters for a clinic
"RTN","BSDX34",44,0)
 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens.  (The last |-piece is null, so discard it.)
"RTN","BSDX34",45,0)
 ;Called by BSDX REBOOK CLINIC LIST and BSDX CANCEL CLINIC LIST via entry point CANCLIN above
"RTN","BSDX34",46,0)
 ;Jul 11 2010 (smh):
"RTN","BSDX34",47,0)
    ;for i18n, pass BSDXBEG and BSDXEND in FM format.
"RTN","BSDX34",48,0)
 ;
"RTN","BSDX34",49,0)
 S X="RBERR^BSDX34",@^%ZOSF("TRAP")
"RTN","BSDX34",50,0)
 ;
"RTN","BSDX34",51,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX34",52,0)
 N %DT,Y,BSDXJ,BSDXCID,BSDXCLN,BSDXSTRT,BSDXAID,BSDXNOD,BSDXLIST,BSDX,BSDY
"RTN","BSDX34",53,0)
 ;Convert beginning and ending dates
"RTN","BSDX34",54,0)
 ;TODO: Validation of date to make sure it's a right FM Date
"RTN","BSDX34",55,0)
    S BSDXBEG=$P(BSDXBEG,".")
"RTN","BSDX34",56,0)
    S BSDXEND=$P(BSDXEND,".")
"RTN","BSDX34",57,0)
 S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"
"RTN","BSDX34",58,0)
 S BSDXEND=BSDXEND_".9999"
"RTN","BSDX34",59,0)
    ;
"RTN","BSDX34",60,0)
 I BSDXCLST="" D RBERR Q
"RTN","BSDX34",61,0)
 ;
"RTN","BSDX34",62,0)
 ;
"RTN","BSDX34",63,0)
 ;If BSDXCLST is a list of resource NAMES, look up each name and convert to IEN
"RTN","BSDX34",64,0)
 F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDX=$P(BSDXCLST,"|",BSDXJ) D  S $P(BSDXCLST,"|",BSDXJ)=BSDY
"RTN","BSDX34",65,0)
 . S BSDY=""
"RTN","BSDX34",66,0)
 . I BSDX]"",$D(^BSDXRES(BSDX,0)) S BSDY=BSDX Q
"RTN","BSDX34",67,0)
 . I BSDX]"",$D(^BSDXRES("B",BSDX)) S BSDY=$O(^BSDXRES("B",BSDX,0)) Q
"RTN","BSDX34",68,0)
 . Q
"RTN","BSDX34",69,0)
 ;
"RTN","BSDX34",70,0)
 ;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN)
"RTN","BSDX34",71,0)
 ;
"RTN","BSDX34",72,0)
 S BSDXLIST=""
"RTN","BSDX34",73,0)
 F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D:+BSDXCID
"RTN","BSDX34",74,0)
 . S BSDXCLN=$G(^BSDXRES(BSDXCID,0)) S BSDXCLN=$P(BSDXCLN,U) Q:BSDXCLN=""
"RTN","BSDX34",75,0)
 . S BSDXSTRT=BSDXBEG F  S BSDXSTRT=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT)) Q:'+BSDXSTRT  Q:BSDXSTRT>BSDXEND  D
"RTN","BSDX34",76,0)
 . . S BSDXAID=0 F  S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID  D
"RTN","BSDX34",77,0)
 . . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0))
"RTN","BSDX34",78,0)
 . . . I $D(BSDXCAN) D  Q
"RTN","BSDX34",79,0)
 . . . . I $P(BSDXNOD,U,12) S BSDXLIST=BSDXLIST_BSDXAID_"|" ;Cancelled appt
"RTN","BSDX34",80,0)
 . . . I $P(BSDXNOD,U,11) S BSDXLIST=BSDXLIST_BSDXAID_"|" ;Rebooked appt
"RTN","BSDX34",81,0)
 D RBLETT(.BSDXY,BSDXLIST)
"RTN","BSDX34",82,0)
 Q
"RTN","BSDX34",83,0)
 ;
"RTN","BSDX34",84,0)
RBLETTD(BSDXY,BSDXLIST) ;EP
"RTN","BSDX34",85,0)
 ;Entry point for debugging
"RTN","BSDX34",86,0)
 ;
"RTN","BSDX34",87,0)
 ;D DEBUG^%Serenji("RBLETT^BSDX34(.BSDXY,BSDXLIST)")
"RTN","BSDX34",88,0)
 Q
"RTN","BSDX34",89,0)
 ;
"RTN","BSDX34",90,0)
RBLETT(BSDXY,BSDXLIST) ;EP
"RTN","BSDX34",91,0)
 ;Return recordset of patient appointments used in listing
"RTN","BSDX34",92,0)
 ;REBOOKED appointments for a list of appointmentIDs.
"RTN","BSDX34",93,0)
 ;Called by rpc BSDX REBOOK LIST
"RTN","BSDX34",94,0)
 ;BSDXLIST is a |-delimited list of BSDX APPOINTMENT iens (the last |-piece is null)
"RTN","BSDX34",95,0)
 ;
"RTN","BSDX34",96,0)
 N BSDXI,BSDXIEN,BSDXNOD,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ,BSDX
"RTN","BSDX34",97,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX34",98,0)
 S BSDXI=0
"RTN","BSDX34",99,0)
 S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus"
"RTN","BSDX34",100,0)
 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30)
"RTN","BSDX34",101,0)
 S X="ERROR^BSDX34",@^%ZOSF("TRAP")
"RTN","BSDX34",102,0)
 ;
"RTN","BSDX34",103,0)
 ;Iterate through BSDXLIST
"RTN","BSDX34",104,0)
 S BSDXIEN=0
"RTN","BSDX34",105,0)
 F BSDX=1:1:$L(BSDXLIST,"|")-1 S BSDXIEN=$P(BSDXLIST,"|",BSDX) D
"RTN","BSDX34",106,0)
 . N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN,BSDXPAT
"RTN","BSDX34",107,0)
 . N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
"RTN","BSDX34",108,0)
 . N BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX
"RTN","BSDX34",109,0)
 . N BSDXREBK
"RTN","BSDX34",110,0)
 . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
"RTN","BSDX34",111,0)
 . Q:BSDXNOD=""
"RTN","BSDX34",112,0)
 . S BSDXPAT=$P(BSDXNOD,U,5) ;PATIENT ien
"RTN","BSDX34",113,0)
 . Q:'+BSDXPAT
"RTN","BSDX34",114,0)
 . Q:'$D(^DPT(BSDXPAT))
"RTN","BSDX34",115,0)
 . D PINFO(BSDXPAT)
"RTN","BSDX34",116,0)
 . S Y=$P(BSDXNOD,U)
"RTN","BSDX34",117,0)
 . Q:'+Y
"RTN","BSDX34",118,0)
 . X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX34",119,0)
 . S BSDXAPT=Y ;Appointment date time
"RTN","BSDX34",120,0)
 . S BSDXREBK=""
"RTN","BSDX34",121,0)
 . S Y=$P(BSDXNOD,U,11)
"RTN","BSDX34",122,0)
 . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") S BSDXREBK=Y ;Rebook date time
"RTN","BSDX34",123,0)
 . S BSDXCLRK=$P(BSDXNOD,U,8) ;Appointment made by
"RTN","BSDX34",124,0)
 . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
"RTN","BSDX34",125,0)
 . S Y=$P(BSDXNOD,U,9) ;Date Appointment Made
"RTN","BSDX34",126,0)
 . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
"RTN","BSDX34",127,0)
 . S BSDXMADE=Y
"RTN","BSDX34",128,0)
 . ;NOTE
"RTN","BSDX34",129,0)
 . S BSDXNOT=""
"RTN","BSDX34",130,0)
 . I $D(^BSDXAPPT(BSDXIEN,1,0)) S BSDXNOT="",BSDXQ=0 F  S BSDXQ=$O(^BSDXAPPT(BSDXIEN,1,BSDXQ)) Q:'+BSDXQ  D
"RTN","BSDX34",131,0)
 . . S BSDXLIN=$G(^BSDXAPPT(BSDXIEN,1,BSDXQ,0))
"RTN","BSDX34",132,0)
 . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
"RTN","BSDX34",133,0)
 . . S BSDXNOT=BSDXNOT_BSDXLIN
"RTN","BSDX34",134,0)
 . ;Resource
"RTN","BSDX34",135,0)
 . S BSDXCID=$P(BSDXNOD,U,7) ;IEN of BSDX RESOURCE
"RTN","BSDX34",136,0)
 . Q:'+BSDXCID
"RTN","BSDX34",137,0)
 . Q:'$D(^BSDXRES(BSDXCID,0))
"RTN","BSDX34",138,0)
 . S BSDXCNOD=$G(^BSDXRES(BSDXCID,0)) ;BSDX RESOURCE node
"RTN","BSDX34",139,0)
 . Q:BSDXCNOD=""
"RTN","BSDX34",140,0)
 . S BSDXCLN=$P(BSDXCNOD,U) ;Text name of BSDX Resource
"RTN","BSDX34",141,0)
 . S BSDXTYPE="" ;Unused in this recordset
"RTN","BSDX34",142,0)
 . S BSDXI=BSDXI+1
"RTN","BSDX34",143,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",144,0)
 . Q
"RTN","BSDX34",145,0)
 ;
"RTN","BSDX34",146,0)
 S BSDXI=BSDXI+1
"RTN","BSDX34",147,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX34",148,0)
 Q
"RTN","BSDX34",149,0)
 ;
"RTN","BSDX34",150,0)
PINFO(BSDXPAT) ;
"RTN","BSDX34",151,0)
 ;Get patient info
"RTN","BSDX34",152,0)
 N BSDXNOD
"RTN","BSDX34",153,0)
 S BSDXNOD=$$PATINFO^BSDX27(BSDXPAT)
"RTN","BSDX34",154,0)
 S BSDXNAM=$P(BSDXNOD,U) ;NAME
"RTN","BSDX34",155,0)
 S BSDXSEX=$P(BSDXNOD,U,2) ;SEX
"RTN","BSDX34",156,0)
 S BSDXDOB=$P(BSDXNOD,U,3) ;DOB
"RTN","BSDX34",157,0)
 S BSDXHRN=$P(BSDXNOD,U,4) ;Health Record Number for location DUZ(2)
"RTN","BSDX34",158,0)
 S BSDXSTRE=$P(BSDXNOD,U,5) ;Street
"RTN","BSDX34",159,0)
 S BSDXCITY=$P(BSDXNOD,U,6) ;City
"RTN","BSDX34",160,0)
 S BSDXST=$P(BSDXNOD,U,7) ;State
"RTN","BSDX34",161,0)
 S BSDXZIP=$P(BSDXNOD,U,8) ;zip
"RTN","BSDX34",162,0)
 S BSDXPHON=$P(BSDXNOD,U,9) ;homephone
"RTN","BSDX34",163,0)
 Q
"RTN","BSDX34",164,0)
 ;
"RTN","BSDX34",165,0)
ERROR ;
"RTN","BSDX34",166,0)
 D ERR("RPMS Error")
"RTN","BSDX34",167,0)
 Q
"RTN","BSDX34",168,0)
 ;
"RTN","BSDX34",169,0)
ERR(ERRNO) ;Error processing
"RTN","BSDX34",170,0)
 S:'$D(BSDXI) BSDXI=999
"RTN","BSDX34",171,0)
 I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
"RTN","BSDX34",172,0)
 E  S BSDXERR=ERRNO
"RTN","BSDX34",173,0)
 S BSDXI=BSDXI+1
"RTN","BSDX34",174,0)
 S ^BSDXTMP($J,BSDXI)="^^^^^^^^^^^^^^^^"_$C(30)
"RTN","BSDX34",175,0)
 S BSDXI=BSDXI+1
"RTN","BSDX34",176,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX34",177,0)
 Q
"RTN","BSDX35")
0^33^B8259199
"RTN","BSDX35",1,0)
BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/21/12 3:57pm
"RTN","BSDX35",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDX35",3,0)
 ; Licensed under LGPL  
"RTN","BSDX35",4,0)
 ;
"RTN","BSDX35",5,0)
 ;
"RTN","BSDX35",6,0)
 Q
"RTN","BSDX35",7,0)
 ;
"RTN","BSDX35",8,0)
RSRCLTRD(BSDXY,BSDXLIST) ;EP
"RTN","BSDX35",9,0)
 ;Entry point for debugging
"RTN","BSDX35",10,0)
 ;
"RTN","BSDX35",11,0)
 ;D DEBUG^%Serenji("RSRCLTR^BSDX35(.BSDXY,BSDXLIST)")
"RTN","BSDX35",12,0)
 Q
"RTN","BSDX35",13,0)
 ;
"RTN","BSDX35",14,0)
RSRCLTR(BSDXY,BSDXLIST) ;EP
"RTN","BSDX35",15,0)
 ;
"RTN","BSDX35",16,0)
 ;Return recordset of RESOURCES and associated LETTERS
"RTN","BSDX35",17,0)
 ;Used in generating rebook letters for a clinic
"RTN","BSDX35",18,0)
 ;BSDXLIST is a |-delimited list of BSDX RESOURCE iens.  (The last |-piece is null, so discard it.)
"RTN","BSDX35",19,0)
 ;Called by BSDX RESOURCE LETTERS
"RTN","BSDX35",20,0)
 ;
"RTN","BSDX35",21,0)
 ;
"RTN","BSDX35",22,0)
 S X="ERROR^BSDX35",@^%ZOSF("TRAP")
"RTN","BSDX35",23,0)
 S BSDXY="^BSDXTMP("_$J_")"
"RTN","BSDX35",24,0)
 N BSDXIEN,BSDX,BSDXLTR,BSDXNOS,BSDXCAN,BSDXIEN1
"RTN","BSDX35",25,0)
 S BSDXI=0
"RTN","BSDX35",26,0)
 S ^BSDXTMP($J,BSDXI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00030LETTER_TEXT^T00030NO_SHOW_LETTER^T00030CLINIC_CANCELLATION_LETTER"_$C(30)
"RTN","BSDX35",27,0)
 ;
"RTN","BSDX35",28,0)
 ;
"RTN","BSDX35",29,0)
 ;If BSDXLIST is a list of resource NAMES, look up each name and convert to IEN
"RTN","BSDX35",30,0)
 F BSDXJ=1:1:$L(BSDXLIST,"|")-1 S BSDX=$P(BSDXLIST,"|",BSDXJ) D  S $P(BSDXLIST,"|",BSDXJ)=BSDY
"RTN","BSDX35",31,0)
 . S BSDY=""
"RTN","BSDX35",32,0)
 . I BSDX]"",$D(^BSDXRES(BSDX,0)) S BSDY=BSDX Q
"RTN","BSDX35",33,0)
 . I BSDX]"",$D(^BSDXRES("B",BSDX)) S BSDY=$O(^BSDXRES("B",BSDX,0)) Q
"RTN","BSDX35",34,0)
 . Q
"RTN","BSDX35",35,0)
 ;
"RTN","BSDX35",36,0)
 ;Get letter text from wp fields
"RTN","BSDX35",37,0)
 S BSDXIEN=0
"RTN","BSDX35",38,0)
 F BSDX=1:1:$L(BSDXLIST,"|")-1 S BSDXIEN=$P(BSDXLIST,"|",BSDX) D
"RTN","BSDX35",39,0)
 . Q:'$D(^BSDXRES(BSDXIEN))
"RTN","BSDX35",40,0)
 . S BSDXNAM=$P(^BSDXRES(BSDXIEN,0),U)
"RTN","BSDX35",41,0)
 . S BSDXLTR=""
"RTN","BSDX35",42,0)
 . I $D(^BSDXRES(BSDXIEN,1)) D
"RTN","BSDX35",43,0)
 . . S BSDXIEN1=0 F  S BSDXIEN1=$O(^BSDXRES(BSDXIEN,1,BSDXIEN1)) Q:'+BSDXIEN1  D
"RTN","BSDX35",44,0)
 . . . S BSDXLTR=BSDXLTR_$G(^BSDXRES(BSDXIEN,1,BSDXIEN1,0))
"RTN","BSDX35",45,0)
 . . . S BSDXLTR=BSDXLTR_$C(13)_$C(10)
"RTN","BSDX35",46,0)
 . S BSDXNOS=""
"RTN","BSDX35",47,0)
 . I $D(^BSDXRES(BSDXIEN,12)) D
"RTN","BSDX35",48,0)
 . . S BSDXIEN1=0 F  S BSDXIEN1=$O(^BSDXRES(BSDXIEN,12,BSDXIEN1)) Q:'+BSDXIEN1  D
"RTN","BSDX35",49,0)
 . . . S BSDXNOS=BSDXNOS_$G(^BSDXRES(BSDXIEN,12,BSDXIEN1,0))
"RTN","BSDX35",50,0)
 . . . S BSDXNOS=BSDXNOS_$C(13)_$C(10)
"RTN","BSDX35",51,0)
 . S BSDXCAN=""
"RTN","BSDX35",52,0)
 . I $D(^BSDXRES(BSDXIEN,13)) D
"RTN","BSDX35",53,0)
 . . S BSDXIEN1=0 F  S BSDXIEN1=$O(^BSDXRES(BSDXIEN,13,BSDXIEN1)) Q:'+BSDXIEN1  D
"RTN","BSDX35",54,0)
 . . . S BSDXCAN=BSDXCAN_$G(^BSDXRES(BSDXIEN,13,BSDXIEN1,0))
"RTN","BSDX35",55,0)
 . . . S BSDXCAN=BSDXCAN_$C(13)_$C(10)
"RTN","BSDX35",56,0)
 . S BSDXI=BSDXI+1
"RTN","BSDX35",57,0)
 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_$C(30)
"RTN","BSDX35",58,0)
 ;
"RTN","BSDX35",59,0)
 S BSDXI=BSDXI+1
"RTN","BSDX35",60,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX35",61,0)
 Q
"RTN","BSDX35",62,0)
 ;
"RTN","BSDX35",63,0)
ERROR ;
"RTN","BSDX35",64,0)
 D ERR("RPMS Error")
"RTN","BSDX35",65,0)
 Q
"RTN","BSDX35",66,0)
 ;
"RTN","BSDX35",67,0)
ERR(ERRNO) ;Error processing
"RTN","BSDX35",68,0)
 S:'$D(BSDXI) BSDXI=999
"RTN","BSDX35",69,0)
 I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
"RTN","BSDX35",70,0)
 E  S BSDXERR=ERRNO
"RTN","BSDX35",71,0)
 S BSDXI=BSDXI+1
"RTN","BSDX35",72,0)
 S ^BSDXTMP($J,BSDXI)="^^^^"_$C(30)
"RTN","BSDX35",73,0)
 S BSDXI=BSDXI+1
"RTN","BSDX35",74,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDX35",75,0)
 Q
"RTN","BSDXAPI")
0^35^B171938499
"RTN","BSDXAPI",1,0)
BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/10/12 5:58pm
"RTN","BSDXAPI",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDXAPI",3,0)
 ; Licensed under LGPL  
"RTN","BSDXAPI",4,0)
 ;
"RTN","BSDXAPI",5,0)
 ; Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
"RTN","BSDXAPI",6,0)
 ; mods (many) by WV/SMH
"RTN","BSDXAPI",7,0)
 ; Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
"RTN","BSDXAPI",8,0)
 ; Change history is located in BSDXAPI1 (to save space).
"RTN","BSDXAPI",9,0)
 ;
"RTN","BSDXAPI",10,0)
MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
"RTN","BSDXAPI",11,0)
 ; Call like this for DFN 23435 having an appointment at Hospital Location 33
"RTN","BSDXAPI",12,0)
 ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
"RTN","BSDXAPI",13,0)
 ; for Baby foxes hallucinations.
"RTN","BSDXAPI",14,0)
 ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
"RTN","BSDXAPI",15,0)
 N BSDR
"RTN","BSDXAPI",16,0)
 S BSDR("PAT")=DFN       ;DFN
"RTN","BSDXAPI",17,0)
 S BSDR("CLN")=CLIN      ;Hosp Loc IEN
"RTN","BSDXAPI",18,0)
 S BSDR("TYP")=TYP       ;3 sched or 4 walkin
"RTN","BSDXAPI",19,0)
 S BSDR("ADT")=DATE      ;Appointment date in FM format
"RTN","BSDXAPI",20,0)
 S BSDR("LEN")=LEN       ;Appt len upto 240 (min)
"RTN","BSDXAPI",21,0)
 S BSDR("OI")=INFO     ;Reason for appt - up to 150 char
"RTN","BSDXAPI",22,0)
 S BSDR("USR")=DUZ       ;Person who made appt - current user
"RTN","BSDXAPI",23,0)
 Q $$MAKE(.BSDR)
"RTN","BSDXAPI",24,0)
 ;
"RTN","BSDXAPI",25,0)
MAKE(BSDR) ;PEP; call to store appt made
"RTN","BSDXAPI",26,0)
 ;
"RTN","BSDXAPI",27,0)
 ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
"RTN","BSDXAPI",28,0)
 ;
"RTN","BSDXAPI",29,0)
 ; Input Array -
"RTN","BSDXAPI",30,0)
 ; BSDR("PAT") = ien of patient in file 2
"RTN","BSDXAPI",31,0)
 ; BSDR("CLN") = ien of clinic in file 44
"RTN","BSDXAPI",32,0)
 ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
"RTN","BSDXAPI",33,0)
 ; BSDR("ADT") = appointment date and time
"RTN","BSDXAPI",34,0)
 ; BSDR("LEN") = appointment length in minutes (*1.42 limit removed)
"RTN","BSDXAPI",35,0)
 ; BSDR("OI")  = reason for appt - up to 150 characters
"RTN","BSDXAPI",36,0)
 ; BSDR("USR") = user who made appt
"RTN","BSDXAPI",37,0)
 ;
"RTN","BSDXAPI",38,0)
 ;Output: error status and message
"RTN","BSDXAPI",39,0)
 ;   = 0 or null:  everything okay
"RTN","BSDXAPI",40,0)
 ;   = 1^message:  error and reason
"RTN","BSDXAPI",41,0)
 ;
"RTN","BSDXAPI",42,0)
 N BSDXMKCK S BSDXMKCK=$$MAKECK(.BSDR) ; Check if we can make appointment
"RTN","BSDXAPI",43,0)
 I BSDXMKCK Q BSDXMKCK ; If we can't, quit with the reason why.
"RTN","BSDXAPI",44,0)
 ;
"RTN","BSDXAPI",45,0)
 ;Otherwise, we continue
"RTN","BSDXAPI",46,0)
 ;
"RTN","BSDXAPI",47,0)
 N BSDXFDA,BSDXIENS,BSDXMSG ; FILE/UPDATE^DIE variables
"RTN","BSDXAPI",48,0)
 ;
"RTN","BSDXAPI",49,0)
 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
"RTN","BSDXAPI",50,0)
 . ; "un-cancel" existing appt in file 2
"RTN","BSDXAPI",51,0)
 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
"RTN","BSDXAPI",52,0)
 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
"RTN","BSDXAPI",53,0)
 . S BSDXFDA(2.98,BSDXIENS,"3")=""
"RTN","BSDXAPI",54,0)
 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
"RTN","BSDXAPI",55,0)
 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
"RTN","BSDXAPI",56,0)
 . S BSDXFDA(2.98,BSDXIENS,"14")=""
"RTN","BSDXAPI",57,0)
 . S BSDXFDA(2.98,BSDXIENS,"15")=""
"RTN","BSDXAPI",58,0)
 . S BSDXFDA(2.98,BSDXIENS,"16")=""
"RTN","BSDXAPI",59,0)
 . S BSDXFDA(2.98,BSDXIENS,"17")="@" ; v 1.7; cancellation remarks were left over
"RTN","BSDXAPI",60,0)
 . S BSDXFDA(2.98,BSDXIENS,"19")=""
"RTN","BSDXAPI",61,0)
 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
"RTN","BSDXAPI",62,0)
 . D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDXAPI",63,0)
 Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
"RTN","BSDXAPI",64,0)
 ;
"RTN","BSDXAPI",65,0)
 Q:$G(BSDXSIMERR2) 1_U_$NA(BSDXSIMERR2) ; Unit Test line
"RTN","BSDXAPI",66,0)
 ;
"RTN","BSDXAPI",67,0)
 E  D  ; File new appointment/edit existing appointment in file 2
"RTN","BSDXAPI",68,0)
 . S BSDXIENS="?+2,"_BSDR("PAT")_","
"RTN","BSDXAPI",69,0)
 . S BSDXIENS(2)=BSDR("ADT")
"RTN","BSDXAPI",70,0)
 . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
"RTN","BSDXAPI",71,0)
 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
"RTN","BSDXAPI",72,0)
 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
"RTN","BSDXAPI",73,0)
 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
"RTN","BSDXAPI",74,0)
 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXMSG")
"RTN","BSDXAPI",75,0)
 Q:$D(BSDXMSG) 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
"RTN","BSDXAPI",76,0)
 ;
"RTN","BSDXAPI",77,0)
 Q:$G(BSDXSIMERR3) 1_U_$NA(BSDXSIMERR3) ; Unit Test line
"RTN","BSDXAPI",78,0)
 ;
"RTN","BSDXAPI",79,0)
 ; add appt to file 44. This adds it to the FIRST subfile (Appointment)
"RTN","BSDXAPI",80,0)
 N DIC,DA,Y,X,DD,DO,DLAYGO,DINUM
"RTN","BSDXAPI",81,0)
 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
"RTN","BSDXAPI",82,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",83,0)
 . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
"RTN","BSDXAPI",84,0)
 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
"RTN","BSDXAPI",85,0)
 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
"RTN","BSDXAPI",86,0)
 ;
"RTN","BSDXAPI",87,0)
 Q:$G(BSDXSIMERR4) 1_U_$NA(BSDXSIMERR4) ; Unit Test line
"RTN","BSDXAPI",88,0)
 ;
"RTN","BSDXAPI",89,0)
 ; add appt for file 44, second subfile (Appointment/Patient)
"RTN","BSDXAPI",90,0)
 ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
"RTN","BSDXAPI",91,0)
 ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
"RTN","BSDXAPI",92,0)
 ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
"RTN","BSDXAPI",93,0)
 ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
"RTN","BSDXAPI",94,0)
 ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
"RTN","BSDXAPI",95,0)
 ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
"RTN","BSDXAPI",96,0)
 ;D FILE^DICN
"RTN","BSDXAPI",97,0)
 ;
"RTN","BSDXAPI",98,0)
 N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_","
"RTN","BSDXAPI",99,0)
 N BSDXFDA
"RTN","BSDXAPI",100,0)
 S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT")
"RTN","BSDXAPI",101,0)
 S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN")
"RTN","BSDXAPI",102,0)
 S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150)
"RTN","BSDXAPI",103,0)
 S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR")
"RTN","BSDXAPI",104,0)
 S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".")
"RTN","BSDXAPI",105,0)
 N BSDXERR
"RTN","BSDXAPI",106,0)
 D UPDATE^DIE("","BSDXFDA","","BSDXERR")
"RTN","BSDXAPI",107,0)
 ;
"RTN","BSDXAPI",108,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",109,0)
 ;
"RTN","BSDXAPI",110,0)
 ;Q:$G(BSDXSIMERR5) 1_U_$NA(BSDXSIMERR5) ; Unit Test line
"RTN","BSDXAPI",111,0)
 S:$G(BSDXSIMERR5) X=1/0
"RTN","BSDXAPI",112,0)
 ;
"RTN","BSDXAPI",113,0)
 ; Update the Availablilities ; Doesn't fail. Global reads and sets.
"RTN","BSDXAPI",114,0)
 D AVUPDTMK^BSDXAPI1(BSDR("CLN"),BSDR("ADT"),BSDR("LEN"),BSDR("PAT"))
"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)
MAKECK(BSDR) ; $$ - Is it okay to make an appointment? ; PEP
"RTN","BSDXAPI",124,0)
 ; Input: Same as $$MAKE
"RTN","BSDXAPI",125,0)
 ; Output: 1^error or 0 for success
"RTN","BSDXAPI",126,0)
 ; NB: This subroutine saves no data. Only checks whether it's okay.
"RTN","BSDXAPI",127,0)
 ;
"RTN","BSDXAPI",128,0)
 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
"RTN","BSDXAPI",129,0)
 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
"RTN","BSDXAPI",130,0)
 I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
"RTN","BSDXAPI",131,0)
 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
"RTN","BSDXAPI",132,0)
 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
"RTN","BSDXAPI",133,0)
 ;
"RTN","BSDXAPI",134,0)
 ; Appt Length check removed in v 1.5
"RTN","BSDXAPI",135,0)
 ;
"RTN","BSDXAPI",136,0)
 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
"RTN","BSDXAPI",137,0)
 ; More verbose error message in v1.5
"RTN","BSDXAPI",138,0)
 ; Following block to give an error message to user if there is already an appointment for patient. More verbose than others.
"RTN","BSDXAPI",139,0)
 N BSDXERR ; place to store error message
"RTN","BSDXAPI",140,0)
 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" DO  QUIT BSDXERR  ; If there's an appt in the "S" node of file 2 and it's not cancelled
"RTN","BSDXAPI",141,0)
 . S BSDXERR=1_U_"Patient "_$P(^DPT(BSDR("PAT"),0),U)_" ("_BSDR("PAT")_") "
"RTN","BSDXAPI",142,0)
 . S BSDXERR=BSDXERR_"already has appt at "_$$FMTE^XLFDT(BSDR("ADT"))
"RTN","BSDXAPI",143,0)
 . N BSDXSCIEN S BSDXSCIEN=$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U)  ; Clinic IEN in ^SC (0 piece of 0 node of "S" multiple in file 2)
"RTN","BSDXAPI",144,0)
 . N BSDXSCNAM S BSDXSCNAM=$P(^SC(BSDXSCIEN,0),U) ; PIMS Name of Clinic
"RTN","BSDXAPI",145,0)
 . S BSDXERR=BSDXERR_$C(13,10)_"PIMS clinic: "_BSDXSCNAM ; tell the user of the PIMS clinic
"RTN","BSDXAPI",146,0)
 . I $D(^BSDXRES("ALOC",BSDXSCIEN)) DO  ; if the Clinic is linked to a BSDX Resource (we find out using the index ALOC in the BSDX RESOURCE file)
"RTN","BSDXAPI",147,0)
 . . N BSDXRESIEN S BSDXRESIEN=$O(^BSDXRES("ALOC",BSDXSCIEN,""))
"RTN","BSDXAPI",148,0)
 . . QUIT:'BSDXRESIEN  ; Safeguard if index is corrupt
"RTN","BSDXAPI",149,0)
 . . N BSDXRESNAM S BSDXRESNAM=$P(^BSDXRES(BSDXRESIEN,0),U)
"RTN","BSDXAPI",150,0)
 . . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic
"RTN","BSDXAPI",151,0)
 Q 0
"RTN","BSDXAPI",152,0)
 ;
"RTN","BSDXAPI",153,0)
UNMAKE(BSDR) ; Reverse Make - Private $$
"RTN","BSDXAPI",154,0)
 ; Only used in Emergiencies where Fileman data filing fails.
"RTN","BSDXAPI",155,0)
 ; If previous data exists, which caused an error, it's destroyed.
"RTN","BSDXAPI",156,0)
 ; NB: ^DIK stops for nobody
"RTN","BSDXAPI",157,0)
 ; NB: If Patient Appointment previously existed as cancelled, it's removed.
"RTN","BSDXAPI",158,0)
 ; How can I tell if one previously existed when data is in an intermediate
"RTN","BSDXAPI",159,0)
 ; State? Can I restore it if the other file failed? Restoration can cause
"RTN","BSDXAPI",160,0)
 ; another error. If I restore the global, there will be cross-references
"RTN","BSDXAPI",161,0)
 ; missing (ASDCN specifically).
"RTN","BSDXAPI",162,0)
 ;
"RTN","BSDXAPI",163,0)
 ; Input: Same array as $$MAKE
"RTN","BSDXAPI",164,0)
 ; Output: Always 0
"RTN","BSDXAPI",165,0)
 NEW DIK,DA
"RTN","BSDXAPI",166,0)
 S DIK="^DPT("_BSDR("PAT")_",""S"","
"RTN","BSDXAPI",167,0)
 S DA(1)=BSDR("PAT"),DA=BSDR("ADT")
"RTN","BSDXAPI",168,0)
 D ^DIK
"RTN","BSDXAPI",169,0)
 ;
"RTN","BSDXAPI",170,0)
 N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
"RTN","BSDXAPI",171,0)
 I 'IEN QUIT 0
"RTN","BSDXAPI",172,0)
 ;
"RTN","BSDXAPI",173,0)
 NEW DIK,DA
"RTN","BSDXAPI",174,0)
 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
"RTN","BSDXAPI",175,0)
 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
"RTN","BSDXAPI",176,0)
 D ^DIK
"RTN","BSDXAPI",177,0)
 QUIT 0
"RTN","BSDXAPI",178,0)
 ;
"RTN","BSDXAPI",179,0)
CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
"RTN","BSDXAPI",180,0)
 ; Call like this for DFN 23435 checking in now at Hospital Location 33
"RTN","BSDXAPI",181,0)
 ; for appt at Dec 20, 2009 @ 10:11:59 
"RTN","BSDXAPI",182,0)
 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
"RTN","BSDXAPI",183,0)
 N BSDR
"RTN","BSDXAPI",184,0)
 S BSDR("PAT")=DFN          ;DFN
"RTN","BSDXAPI",185,0)
 S BSDR("CLN")=CLIN         ;Hosp Loc IEN
"RTN","BSDXAPI",186,0)
 S BSDR("ADT")=APDATE       ;Appt Date
"RTN","BSDXAPI",187,0)
 S BSDR("CDT")=$$NOW^XLFDT  ;Check-in date defaults to now
"RTN","BSDXAPI",188,0)
 S BSDR("USR")=DUZ          ;Check-in user defaults to current
"RTN","BSDXAPI",189,0)
 Q $$CHECKIN(.BSDR)
"RTN","BSDXAPI",190,0)
 ;
"RTN","BSDXAPI",191,0)
CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
"RTN","BSDXAPI",192,0)
 ;
"RTN","BSDXAPI",193,0)
 ; Make call by using:  S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
"RTN","BSDXAPI",194,0)
 ;
"RTN","BSDXAPI",195,0)
 ; Input array -
"RTN","BSDXAPI",196,0)
 ;  BSDR("PAT") = ien of patient in file 2
"RTN","BSDXAPI",197,0)
 ;  BSDR("CLN") = ien of clinic in file 44
"RTN","BSDXAPI",198,0)
 ;  BSDR("ADT") = appt date/time
"RTN","BSDXAPI",199,0)
 ;  BSDR("CDT") = checkin date/time
"RTN","BSDXAPI",200,0)
 ;  BSDR("USR") = checkin user
"RTN","BSDXAPI",201,0)
 ;
"RTN","BSDXAPI",202,0)
 ; Output value -
"RTN","BSDXAPI",203,0)
 ;              = 0 means everything worked
"RTN","BSDXAPI",204,0)
 ;              = 1^message means error with reason message
"RTN","BSDXAPI",205,0)
 ;
"RTN","BSDXAPI",206,0)
 I $G(BSDXDIE2) N X S X=1/0
"RTN","BSDXAPI",207,0)
 ;
"RTN","BSDXAPI",208,0)
 N BSDXERR S BSDXERR=$$CHECKICK(.BSDR)
"RTN","BSDXAPI",209,0)
 I BSDXERR Q BSDXERR
"RTN","BSDXAPI",210,0)
 ;
"RTN","BSDXAPI",211,0)
 ; find ien for appt in file 44
"RTN","BSDXAPI",212,0)
 NEW IEN,DIE,DA,DR
"RTN","BSDXAPI",213,0)
 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
"RTN","BSDXAPI",214,0)
 ;
"RTN","BSDXAPI",215,0)
 ; remember before status
"RTN","BSDXAPI",216,0)
 ; Failure analysis: Only ^TMP global is set here.
"RTN","BSDXAPI",217,0)
 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE
"RTN","BSDXAPI",218,0)
 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
"RTN","BSDXAPI",219,0)
 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
"RTN","BSDXAPI",220,0)
 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
"RTN","BSDXAPI",221,0)
 ;
"RTN","BSDXAPI",222,0)
 ; set checkin; Old Code -- keep for ref VEN/SMH 3 Jul 2012
"RTN","BSDXAPI",223,0)
 ; S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
"RTN","BSDXAPI",224,0)
 ; S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
"RTN","BSDXAPI",225,0)
 ; S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
"RTN","BSDXAPI",226,0)
 ; D ^DIE
"RTN","BSDXAPI",227,0)
 ;
"RTN","BSDXAPI",228,0)
 I $D(BSDXSIMERR3) Q 1_U_"Simulated Error"
"RTN","BSDXAPI",229,0)
 ;
"RTN","BSDXAPI",230,0)
 ; Failure analysis: If this fails, no other changes were made in this routine
"RTN","BSDXAPI",231,0)
 N BSDXIENS S BSDXIENS=IEN_","_BSDR("ADT")_","_BSDR("CLN")_","
"RTN","BSDXAPI",232,0)
 N BSDXFDA
"RTN","BSDXAPI",233,0)
 S BSDXFDA(44.003,BSDXIENS,309)=BSDR("CDT")
"RTN","BSDXAPI",234,0)
 S BSDXFDA(44.003,BSDXIENS,302)=BSDR("USR")
"RTN","BSDXAPI",235,0)
 S BSDXFDA(44.003,BSDXIENS,305)=$$NOW^XLFDT()
"RTN","BSDXAPI",236,0)
 N BSDXERR
"RTN","BSDXAPI",237,0)
 D UPDATE^DIE("","BSDXFDA","BSDXERR")
"RTN","BSDXAPI",238,0)
 ;
"RTN","BSDXAPI",239,0)
 I $D(BSDXERR) Q 1_U_"Error checking in appointment to file 44. Error: "_BSDXERR("DIERR",1,"TEXT",1)
"RTN","BSDXAPI",240,0)
 ;
"RTN","BSDXAPI",241,0)
 ; set after status
"RTN","BSDXAPI",242,0)
 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
"RTN","BSDXAPI",243,0)
 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
"RTN","BSDXAPI",244,0)
 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
"RTN","BSDXAPI",245,0)
 ;
"RTN","BSDXAPI",246,0)
 ; Point of no Return
"RTN","BSDXAPI",247,0)
 ; call event driver
"RTN","BSDXAPI",248,0)
 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
"RTN","BSDXAPI",249,0)
 Q 0
"RTN","BSDXAPI",250,0)
 ;
"RTN","BSDXAPI",251,0)
CHECKIC1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKICK -
"RTN","BSDXAPI",252,0)
 ; Check-in Check
"RTN","BSDXAPI",253,0)
 ; Call like this for DFN 23435 checking in now at Hospital Location 33
"RTN","BSDXAPI",254,0)
 ; for appt at Dec 20, 2009 @ 10:11:59 
"RTN","BSDXAPI",255,0)
 ; S RESULT=$$CHECKIC1^BSDXAPI(23435,33,3091220.221159)
"RTN","BSDXAPI",256,0)
 N BSDR
"RTN","BSDXAPI",257,0)
 S BSDR("PAT")=DFN          ;DFN
"RTN","BSDXAPI",258,0)
 S BSDR("CLN")=CLIN         ;Hosp Loc IEN
"RTN","BSDXAPI",259,0)
 S BSDR("ADT")=APDATE       ;Appt Date
"RTN","BSDXAPI",260,0)
 S BSDR("CDT")=$$NOW^XLFDT  ;Check-in date defaults to now
"RTN","BSDXAPI",261,0)
 S BSDR("USR")=DUZ          ;Check-in user defaults to current
"RTN","BSDXAPI",262,0)
 Q $$CHECKICK(.BSDR)
"RTN","BSDXAPI",263,0)
 ;
"RTN","BSDXAPI",264,0)
CHECKICK(BSDR) ; $$ PEP; - Is it okay to check-in patient?
"RTN","BSDXAPI",265,0)
 ; Input: Same as $$CHECKIN
"RTN","BSDXAPI",266,0)
 ; Output: 0 if okay or 1^message if error
"RTN","BSDXAPI",267,0)
 ;
"RTN","BSDXAPI",268,0)
 I $G(BSDXSIMERR2) Q 1_U_"Simulated Error"
"RTN","BSDXAPI",269,0)
 ;
"RTN","BSDXAPI",270,0)
 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
"RTN","BSDXAPI",271,0)
 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
"RTN","BSDXAPI",272,0)
 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
"RTN","BSDXAPI",273,0)
 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
"RTN","BSDXAPI",274,0)
 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12)  ;remove seconds
"RTN","BSDXAPI",275,0)
 I $G(BSDR("CDT"))'?7N.1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
"RTN","BSDXAPI",276,0)
 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
"RTN","BSDXAPI",277,0)
 ;
"RTN","BSDXAPI",278,0)
 ; find ien for appt in file 44
"RTN","BSDXAPI",279,0)
 N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
"RTN","BSDXAPI",280,0)
 I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
"RTN","BSDXAPI",281,0)
 Q 0
"RTN","BSDXAPI",282,0)
 ;
"RTN","BSDXAPI",283,0)
CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
"RTN","BSDXAPI",284,0)
 ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
"RTN","BSDXAPI",285,0)
 ; cancellation initiated by patient ("PC" rather than clinic "C"),
"RTN","BSDXAPI",286,0)
 ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
"RTN","BSDXAPI",287,0)
 ; because foxes come out during bad weather.
"RTN","BSDXAPI",288,0)
 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
"RTN","BSDXAPI",289,0)
 N BSDR
"RTN","BSDXAPI",290,0)
 S BSDR("PAT")=DFN
"RTN","BSDXAPI",291,0)
 S BSDR("CLN")=CLIN
"RTN","BSDXAPI",292,0)
 S BSDR("TYP")=TYP
"RTN","BSDXAPI",293,0)
 S BSDR("ADT")=APDATE
"RTN","BSDXAPI",294,0)
 S BSDR("CDT")=$$NOW^XLFDT
"RTN","BSDXAPI",295,0)
 S BSDR("USR")=DUZ
"RTN","BSDXAPI",296,0)
 S BSDR("CR")=REASON
"RTN","BSDXAPI",297,0)
 S BSDR("NOT")=INFO
"RTN","BSDXAPI",298,0)
 Q $$CANCEL(.BSDR)
"RTN","BSDXAPI",299,0)
 ;
"RTN","BSDXAPI",300,0)
CANCEL(BSDR) ;PEP; called to cancel appt
"RTN","BSDXAPI",301,0)
 ;
"RTN","BSDXAPI",302,0)
 ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
"RTN","BSDXAPI",303,0)
 ;
"RTN","BSDXAPI",304,0)
 ; Input Array -
"RTN","BSDXAPI",305,0)
 ; BSDR("PAT") = ien of patient in file 2
"RTN","BSDXAPI",306,0)
 ; BSDR("CLN") = ien of clinic in file 44
"RTN","BSDXAPI",307,0)
 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
"RTN","BSDXAPI",308,0)
 ; BSDR("ADT") = appointment date and time
"RTN","BSDXAPI",309,0)
 ; BSDR("CDT") = cancel date and time
"RTN","BSDXAPI",310,0)
 ; BSDR("USR") = user who canceled appt
"RTN","BSDXAPI",311,0)
 ; BSDR("CR")  = cancel reason - pointer to file 409.2
"RTN","BSDXAPI",312,0)
 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
"RTN","BSDXAPI",313,0)
 ;
"RTN","BSDXAPI",314,0)
 ;Output: error status and message
"RTN","BSDXAPI",315,0)
 ;   = 0 or null:  everything okay
"RTN","BSDXAPI",316,0)
 ;   = 1^message:  error and reason
"RTN","BSDXAPI",317,0)
 ;
"RTN","BSDXAPI",318,0)
 ; Okay to Cancel? Call Cancel Check.
"RTN","BSDXAPI",319,0)
 N BSDXCANCK S BSDXCANCK=$$CANCELCK(.BSDR)
"RTN","BSDXAPI",320,0)
 I BSDXCANCK Q BSDXCANCK
"RTN","BSDXAPI",321,0)
 ;
"RTN","BSDXAPI",322,0)
 ; BSDX 1.5 3110125
"RTN","BSDXAPI",323,0)
 ; UJO/SMH - Add ability to remove check-in if the patient is checked in
"RTN","BSDXAPI",324,0)
 ; VEN/SMH on 3120625/v1.7 - PIMS doesn't care if patient is already checked in
"RTN","BSDXAPI",325,0)
 ; Lets you remove appointment anyways! Not like RPMS.
"RTN","BSDXAPI",326,0)
 ; Plus... deleting checkin affects S node on 44, which is DELETED anyways!
"RTN","BSDXAPI",327,0)
 ;
"RTN","BSDXAPI",328,0)
 ; remember before status
"RTN","BSDXAPI",329,0)
 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL,SDMODE
"RTN","BSDXAPI",330,0)
 NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
"RTN","BSDXAPI",331,0)
 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
"RTN","BSDXAPI",332,0)
 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
"RTN","BSDXAPI",333,0)
 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
"RTN","BSDXAPI",334,0)
 ; NB: Here only ^TMP globals are set with before values.
"RTN","BSDXAPI",335,0)
 ;
"RTN","BSDXAPI",336,0)
 ; get user who made appt and date appt made from ^SC
"RTN","BSDXAPI",337,0)
 ;    because data in ^SC will be deleted
"RTN","BSDXAPI",338,0)
 ; Appointment Length: ditto
"RTN","BSDXAPI",339,0)
 NEW USER,DATE
"RTN","BSDXAPI",340,0)
 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
"RTN","BSDXAPI",341,0)
 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
"RTN","BSDXAPI",342,0)
 N BSDXLEN S BSDXLEN=$$APPLEN(DFN,SDCL,SDT) ; appt length
"RTN","BSDXAPI",343,0)
 ;
"RTN","BSDXAPI",344,0)
 ; update file 2 info --old code; keep for reference
"RTN","BSDXAPI",345,0)
 ;NEW DIE,DA,DR
"RTN","BSDXAPI",346,0)
 ;S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
"RTN","BSDXAPI",347,0)
 ;S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
"RTN","BSDXAPI",348,0)
 ;S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
"RTN","BSDXAPI",349,0)
 ;D ^DIE
"RTN","BSDXAPI",350,0)
 N BSDXIENS S BSDXIENS=SDT_","_DFN_","
"RTN","BSDXAPI",351,0)
 N BSDXFDA
"RTN","BSDXAPI",352,0)
 S BSDXFDA(2.98,BSDXIENS,3)=BSDR("TYP")
"RTN","BSDXAPI",353,0)
 S BSDXFDA(2.98,BSDXIENS,14)=BSDR("USR")
"RTN","BSDXAPI",354,0)
 S BSDXFDA(2.98,BSDXIENS,15)=BSDR("CDT")
"RTN","BSDXAPI",355,0)
 S BSDXFDA(2.98,BSDXIENS,16)=BSDR("CR")
"RTN","BSDXAPI",356,0)
 S BSDXFDA(2.98,BSDXIENS,19)=USER
"RTN","BSDXAPI",357,0)
 S BSDXFDA(2.98,BSDXIENS,20)=DATE
"RTN","BSDXAPI",358,0)
 S:$G(BSDR("NOT"))]"" BSDXFDA(2.98,BSDXIENS,17)=$E(BSDR("NOT"),1,160)
"RTN","BSDXAPI",359,0)
 N BSDXERR
"RTN","BSDXAPI",360,0)
 D FILE^DIE("","BSDXFDA","BSDXERR")
"RTN","BSDXAPI",361,0)
 I $D(BSDXERR) Q 1_U_"Cannot cancel appointment in File 2"
"RTN","BSDXAPI",362,0)
 ; Failure point 1: If we fail here, nothing has happened yet.
"RTN","BSDXAPI",363,0)
 ;
"RTN","BSDXAPI",364,0)
 ; delete data in ^SC -- this does not (typically) fail. Fileman won't stop
"RTN","BSDXAPI",365,0)
 NEW DIK,DA
"RTN","BSDXAPI",366,0)
 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
"RTN","BSDXAPI",367,0)
 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
"RTN","BSDXAPI",368,0)
 D ^DIK
"RTN","BSDXAPI",369,0)
 ; Failure point 2: not expected to happen here
"RTN","BSDXAPI",370,0)
 ;
"RTN","BSDXAPI",371,0)
 ; Update PIMS availability -- this doesn't fail. Global gets/sets only.
"RTN","BSDXAPI",372,0)
 D AVUPDTCN^BSDXAPI1(SDCL,SDT,BSDXLEN)
"RTN","BSDXAPI",373,0)
 ;
"RTN","BSDXAPI",374,0)
 ; call event driver -- point of no return
"RTN","BSDXAPI",375,0)
 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
"RTN","BSDXAPI",376,0)
 ;
"RTN","BSDXAPI",377,0)
 Q 0
"RTN","BSDXAPI",378,0)
 ;
"RTN","BSDXAPI",379,0)
CANCELCK(BSDR) ; $$ PEP; Okay to Cancel Appointment?
"RTN","BSDXAPI",380,0)
 ; Input: .BSDR array as documented in $$CANCEL
"RTN","BSDXAPI",381,0)
 ; Output: 0 or 1^Error message
"RTN","BSDXAPI",382,0)
 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
"RTN","BSDXAPI",383,0)
 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
"RTN","BSDXAPI",384,0)
 I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
"RTN","BSDXAPI",385,0)
 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
"RTN","BSDXAPI",386,0)
 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
"RTN","BSDXAPI",387,0)
 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12)  ;remove seconds
"RTN","BSDXAPI",388,0)
 I $G(BSDR("CDT"))'?7N.1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
"RTN","BSDXAPI",389,0)
 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
"RTN","BSDXAPI",390,0)
 I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
"RTN","BSDXAPI",391,0)
 ;
"RTN","BSDXAPI",392,0)
 NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
"RTN","BSDXAPI",393,0)
 I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
"RTN","BSDXAPI",394,0)
 ;
"RTN","BSDXAPI",395,0)
 ; Check-out check. New in v1.7
"RTN","BSDXAPI",396,0)
 I $$CO(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Cannot delete. Appointment has already been checked-out!"
"RTN","BSDXAPI",397,0)
 Q 0
"RTN","BSDXAPI",398,0)
 ;
"RTN","BSDXAPI",399,0)
CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
"RTN","BSDXAPI",400,0)
 NEW X
"RTN","BSDXAPI",401,0)
 S X=$G(SDIEN)   ;ien sent in call
"RTN","BSDXAPI",402,0)
 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
"RTN","BSDXAPI",403,0)
 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
"RTN","BSDXAPI",404,0)
 Q $S(X:1,1:0)
"RTN","BSDXAPI",405,0)
 ;
"RTN","BSDXAPI",406,0)
CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
"RTN","BSDXAPI",407,0)
 NEW X
"RTN","BSDXAPI",408,0)
 S X=$G(SDIEN)   ;ien sent in call
"RTN","BSDXAPI",409,0)
 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
"RTN","BSDXAPI",410,0)
 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
"RTN","BSDXAPI",411,0)
 Q $S(X:1,1:0)
"RTN","BSDXAPI",412,0)
 ;
"RTN","BSDXAPI",413,0)
SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
"RTN","BSDXAPI",414,0)
 NEW X,IEN
"RTN","BSDXAPI",415,0)
 S X=0 F  S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X  Q:$G(IEN)  D
"RTN","BSDXAPI",416,0)
 . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)["C"  ;cancelled
"RTN","BSDXAPI",417,0)
  . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
"RTN","BSDXAPI",418,0)
 Q $G(IEN)
"RTN","BSDXAPI",419,0)
 ;
"RTN","BSDXAPI",420,0)
APPLEN(PAT,CLINIC,DATE) ; $$ PEP; returns an appointment's length
"RTN","BSDXAPI",421,0)
 ; Get either the appointment length or zero
"RTN","BSDXAPI",422,0)
 N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE)
"RTN","BSDXAPI",423,0)
 Q:SCIEN $P(^SC(CLINIC,"S",DATE,1,SCIEN,0),U,2)
"RTN","BSDXAPI",424,0)
 Q 0
"RTN","BSDXAPI",425,0)
APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
"RTN","BSDXAPI",426,0)
 NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
"RTN","BSDXAPI",427,0)
 Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
"RTN","BSDXAPI",428,0)
 ;
"RTN","BSDXAPI1")
0^37^B99176581
"RTN","BSDXAPI1",1,0)
BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/9/12 2:22pm
"RTN","BSDXAPI1",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDXAPI1",3,0)
 ; Licensed under LGPL  
"RTN","BSDXAPI1",4,0)
 ;
"RTN","BSDXAPI1",5,0)
 ; Change History (BSDXAPI and BSDXAPI1)
"RTN","BSDXAPI1",6,0)
 ; Pre 1.42:
"RTN","BSDXAPI1",7,0)
 ; - Simplified entry points (MAKE1, CANCEL1, CHECKIN1)
"RTN","BSDXAPI1",8,0)
 ; 2010-11-5: (1.42)
"RTN","BSDXAPI1",9,0)
 ; - Fixed errors having to do uncanceling patient appointments if it was 
"RTN","BSDXAPI1",10,0)
 ;   a patient cancelled appointment.
"RTN","BSDXAPI1",11,0)
 ; - Use new style Fileman API for storing appointments in file 44 in 
"RTN","BSDXAPI1",12,0)
 ;   $$MAKE due to problems with legacy API.
"RTN","BSDXAPI1",13,0)
 ; 2010-11-12: (1.42)
"RTN","BSDXAPI1",14,0)
 ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as 
"RTN","BSDXAPI1",15,0)
 ;   well. 
"RTN","BSDXAPI1",16,0)
 ; 2010-12-5 (1.42)
"RTN","BSDXAPI1",17,0)
 ; Added an entry point to update the patient note in file 44.
"RTN","BSDXAPI1",18,0)
 ; 2010-12-6 (1.42)
"RTN","BSDXAPI1",19,0)
 ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI")
"RTN","BSDXAPI1",20,0)
 ; 2010-12-8 (1.42)
"RTN","BSDXAPI1",21,0)
 ; Removed restriction on max appt length. Even though this restriction
"RTN","BSDXAPI1",22,0)
 ; exists in fileman (120 minutes), PIMS ignores it. Therefore, I 
"RTN","BSDXAPI1",23,0)
 ; will ignore it here too.
"RTN","BSDXAPI1",24,0)
 ; 2011-01-25 (v.1.5)
"RTN","BSDXAPI1",25,0)
 ; Added entry point $$RMCI to remove checked in appointments.
"RTN","BSDXAPI1",26,0)
 ; In $$CANCEL, if the appointment is checked in, delete check-in rather than
"RTN","BSDXAPI1",27,0)
 ;  spitting an error message to the user saying 'Delete the check-in'
"RTN","BSDXAPI1",28,0)
 ; Changed all lines that look like this:
"RTN","BSDXAPI1",29,0)
 ;  I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
"RTN","BSDXAPI1",30,0)
 ; to:
"RTN","BSDXAPI1",31,0)
 ;  I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
"RTN","BSDXAPI1",32,0)
 ; to allow for date at midnight which does not have a dot at the end.
"RTN","BSDXAPI1",33,0)
 ; 2011-01-26 (v.1.5)
"RTN","BSDXAPI1",34,0)
 ; More user friendly message if patient already has appointment in $$MAKE:
"RTN","BSDXAPI1",35,0)
 ;  Spits out pt name and user friendly date.
"RTN","BSDXAPI1",36,0)
 ; 2012-06-18 (v 1.7)
"RTN","BSDXAPI1",37,0)
 ; Removing transacions. Means that code SHOULD NOT fail. Took all checks
"RTN","BSDXAPI1",38,0)
 ;  out for making an appointment to MAKECK. We call this first to make sure
"RTN","BSDXAPI1",39,0)
 ; that the appointment is okay to make before committing to make it. We
"RTN","BSDXAPI1",40,0)
 ; still have the provision to delete the data though if we fail when we 
"RTN","BSDXAPI1",41,0)
 ; actually make the appointment.
"RTN","BSDXAPI1",42,0)
 ; CANCELCK exists for the same purpose.
"RTN","BSDXAPI1",43,0)
 ; CHECKINK ditto
"RTN","BSDXAPI1",44,0)
 ; New API: $$NOSHOW^BSDXAPI1 for no-showing patients
"RTN","BSDXAPI1",45,0)
 ; Moved RMCI from BSDXAPI to BSDXAPI1 because BSDXAPI1 is getting larger
"RTN","BSDXAPI1",46,0)
 ;  than 20000 characters.
"RTN","BSDXAPI1",47,0)
 ; Added RMCICK (Remove check-in check)
"RTN","BSDXAPI1",48,0)
 ; Moved Availability update EPs in BSDX07 and BSDX08 b/c they really
"RTN","BSDXAPI1",49,0)
 ; belong to PIMS, not to the Scheduling GUI. $$MAKE and $$CANCEL now
"RTN","BSDXAPI1",50,0)
 ; call the EPs here.
"RTN","BSDXAPI1",51,0)
 ; Cancel and Remove-Check-in now check to see if the patient is checked-out
"RTN","BSDXAPI1",52,0)
 ; If the patient is checked out, then we fail to cancel/no-show.
"RTN","BSDXAPI1",53,0)
 ; UPDATENOTE was renamed to UPDATENT and moved to BSDXAPI1.
"RTN","BSDXAPI1",54,0)
 ;
"RTN","BSDXAPI1",55,0)
NOSHOW(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Patient at appt date (new in v1.7)
"RTN","BSDXAPI1",56,0)
 ; PAT = DFN
"RTN","BSDXAPI1",57,0)
 ; CLINIC = SC IEN
"RTN","BSDXAPI1",58,0)
 ; DATE = FM Date/Time of Appointment
"RTN","BSDXAPI1",59,0)
 ; NSFLAG = truthy value to add no-show, or falsy to remove (use 1 or 0 pls!)
"RTN","BSDXAPI1",60,0)
 ; 1^error for failure, 0 for success
"RTN","BSDXAPI1",61,0)
 ; Code follows EN1^SDN
"RTN","BSDXAPI1",62,0)
 ;
"RTN","BSDXAPI1",63,0)
 ; Check for failure conditions first before doing this. No globals set here
"RTN","BSDXAPI1",64,0)
 N NOSHOWCK S NOSHOWCK=$$NOSHOWCK(PAT,CLINIC,DATE,NSFLAG)
"RTN","BSDXAPI1",65,0)
 I NOSHOWCK Q NOSHOWCK
"RTN","BSDXAPI1",66,0)
 ;
"RTN","BSDXAPI1",67,0)
 ; Set up Protocol Driver
"RTN","BSDXAPI1",68,0)
 N SDNSHDL,SDDA S SDNSHDL=$$HANDLE^SDAMEVT(1) S SDDA=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE)
"RTN","BSDXAPI1",69,0)
 N SDATA
"RTN","BSDXAPI1",70,0)
 D BEFORE^SDAMEVT(.SDATA,PAT,DATE,CLINIC,SDDA,SDNSHDL) ; Only ^TMP set here.
"RTN","BSDXAPI1",71,0)
 ;
"RTN","BSDXAPI1",72,0)
 ; Simulated Errors
"RTN","BSDXAPI1",73,0)
 Q:$D(BSDXSIMERR2) 1_U_"Simulated Error"
"RTN","BSDXAPI1",74,0)
 ;
"RTN","BSDXAPI1",75,0)
 ; Edit the ^DPT( "S" node entry - Noshow or undo noshow
"RTN","BSDXAPI1",76,0)
 ; Failure analysis: if we fail here, we presume no change happened in 
"RTN","BSDXAPI1",77,0)
 ; ^DPT(DA,"S", and so we just have to roll back ^BSDXAPPT
"RTN","BSDXAPI1",78,0)
 N BSDXIENS S BSDXIENS=DATE_","_PAT_","
"RTN","BSDXAPI1",79,0)
 N BSDXFDA
"RTN","BSDXAPI1",80,0)
 I +NSFLAG D
"RTN","BSDXAPI1",81,0)
 . S BSDXFDA(2.98,BSDXIENS,3)="N"
"RTN","BSDXAPI1",82,0)
 . S BSDXFDA(2.98,BSDXIENS,14)=DUZ
"RTN","BSDXAPI1",83,0)
 . S BSDXFDA(2.98,BSDXIENS,15)=$$NOW^XLFDT()
"RTN","BSDXAPI1",84,0)
 E  D
"RTN","BSDXAPI1",85,0)
 . S BSDXFDA(2.98,BSDXIENS,3)="@"
"RTN","BSDXAPI1",86,0)
 . S BSDXFDA(2.98,BSDXIENS,14)="@"
"RTN","BSDXAPI1",87,0)
 . S BSDXFDA(2.98,BSDXIENS,15)="@"
"RTN","BSDXAPI1",88,0)
 N BSDXMSG
"RTN","BSDXAPI1",89,0)
 D FILE^DIE("","BSDXFDA","BSDXMSG")
"RTN","BSDXAPI1",90,0)
 Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_PAT_" Appt="_DATE_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
"RTN","BSDXAPI1",91,0)
 ; 
"RTN","BSDXAPI1",92,0)
 ; This M error trigger tests if ^BSDXAPPT rolls back. 
"RTN","BSDXAPI1",93,0)
 ; I won't try to roll back ^DPT(,"S" because
"RTN","BSDXAPI1",94,0)
 ; the M error is caused here, so if I try to rollback, I can cause another
"RTN","BSDXAPI1",95,0)
 ; error. Infinite Errors then.
"RTN","BSDXAPI1",96,0)
 I $D(BSDXSIMERR3) N X S X=1/0
"RTN","BSDXAPI1",97,0)
 ;
"RTN","BSDXAPI1",98,0)
 ; Run the event driver
"RTN","BSDXAPI1",99,0)
 D NOSHOW^SDAMEVT(.SDATA,PAT,DATE,CLINIC,SDDA,0,SDNSHDL)
"RTN","BSDXAPI1",100,0)
 Q 0
"RTN","BSDXAPI1",101,0)
 ;
"RTN","BSDXAPI1",102,0)
NOSHOWCK(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Check
"RTN","BSDXAPI1",103,0)
 ; TODO: Not all appointments can be no showed.
"RTN","BSDXAPI1",104,0)
 ; Check the code in SDAMN 
"RTN","BSDXAPI1",105,0)
 ; S SDSTB=$$STATUS^SDAM1(DFN,SDT,SDCL,$G(^DPT(DFN,"S",SDT,0))) ; before status  
"RTN","BSDXAPI1",106,0)
 ; Q:'$$CHK ; Checks $D(^SD(409.63,"ANS",1,+SDSTB))
"RTN","BSDXAPI1",107,0)
 QUIT 0
"RTN","BSDXAPI1",108,0)
 ;
"RTN","BSDXAPI1",109,0)
RMCI(PAT,CLINIC,DATE)  ;PEP; -- Remove Check-in; $$
"RTN","BSDXAPI1",110,0)
 ; PAT = DFN
"RTN","BSDXAPI1",111,0)
 ; CLINIC = SC IEN
"RTN","BSDXAPI1",112,0)
 ; DATE = FM Date/Time of Appointment
"RTN","BSDXAPI1",113,0)
 ;
"RTN","BSDXAPI1",114,0)
 ; Returns:
"RTN","BSDXAPI1",115,0)
 ; 0 if okay
"RTN","BSDXAPI1",116,0)
 ; -1 if failure
"RTN","BSDXAPI1",117,0)
 ;
"RTN","BSDXAPI1",118,0)
 ; Call like this: $$RMCI(233,33,3110102.1130)
"RTN","BSDXAPI1",119,0)
 ;
"RTN","BSDXAPI1",120,0)
 ; Check to see if we can remove the check-in
"RTN","BSDXAPI1",121,0)
 N BSDXERR S BSDXERR=$$RMCICK(PAT,CLINIC,DATE)
"RTN","BSDXAPI1",122,0)
 I BSDXERR Q BSDXERR
"RTN","BSDXAPI1",123,0)
 ;
"RTN","BSDXAPI1",124,0)
 ; Move my variables into the ones used by SDAPIs (just a convenience)
"RTN","BSDXAPI1",125,0)
 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE
"RTN","BSDXAPI1",126,0)
 S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN^BSDXAPI(DFN,SDCL,SDT)
"RTN","BSDXAPI1",127,0)
 ;
"RTN","BSDXAPI1",128,0)
 I SDDA<1 QUIT 0    ; Appt cancelled; cancelled appts rm'ed from file 44
"RTN","BSDXAPI1",129,0)
 ;
"RTN","BSDXAPI1",130,0)
 ; remember before status
"RTN","BSDXAPI1",131,0)
 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
"RTN","BSDXAPI1",132,0)
 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
"RTN","BSDXAPI1",133,0)
 ;
"RTN","BSDXAPI1",134,0)
 ; M Error Test - Simulate behavior when an M error occurs
"RTN","BSDXAPI1",135,0)
 I $G(BSDXDIE2) N X S X=1/0
"RTN","BSDXAPI1",136,0)
 ; 
"RTN","BSDXAPI1",137,0)
 ; Simulate a failure to file the data in Fileman
"RTN","BSDXAPI1",138,0)
 I $D(BSDXSIMERR3) Q 1_U_"Simulated Error"
"RTN","BSDXAPI1",139,0)
 ;
"RTN","BSDXAPI1",140,0)
 ; remove check-in using filer.
"RTN","BSDXAPI1",141,0)
 N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_","
"RTN","BSDXAPI1",142,0)
 N BSDXFDA
"RTN","BSDXAPI1",143,0)
 S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN
"RTN","BSDXAPI1",144,0)
 S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER
"RTN","BSDXAPI1",145,0)
 S BSDXFDA(44.003,BSDXIENS,305)="@" ; CHECK IN ENTERED
"RTN","BSDXAPI1",146,0)
 N BSDXERR
"RTN","BSDXAPI1",147,0)
 D FILE^DIE("","BSDXFDA","BSDXERR")
"RTN","BSDXAPI1",148,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","BSDXAPI1",149,0)
 ;
"RTN","BSDXAPI1",150,0)
 ; set after status
"RTN","BSDXAPI1",151,0)
 ; S SDDA=$$SCIEN(DFN,SDCL,SDT) ;smh -why is this here? SDDA won't change.
"RTN","BSDXAPI1",152,0)
 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
"RTN","BSDXAPI1",153,0)
 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
"RTN","BSDXAPI1",154,0)
 ;
"RTN","BSDXAPI1",155,0)
 ; call event driver
"RTN","BSDXAPI1",156,0)
 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
"RTN","BSDXAPI1",157,0)
 QUIT 0
"RTN","BSDXAPI1",158,0)
 ;
"RTN","BSDXAPI1",159,0)
RMCICK(PAT,CLINIC,DATE) ;PEP; Can you remove a check-in for this patient?
"RTN","BSDXAPI1",160,0)
 ; PAT - DFN by value
"RTN","BSDXAPI1",161,0)
 ; CLINIC - ^SC ien by value
"RTN","BSDXAPI1",162,0)
 ; DATE - Appointment Date
"RTN","BSDXAPI1",163,0)
 ; Output: 0 if okay or 1 if error
"RTN","BSDXAPI1",164,0)
 ;
"RTN","BSDXAPI1",165,0)
 ; Error for Unit Tests
"RTN","BSDXAPI1",166,0)
 I $G(BSDXSIMERR2) Q 1_U_"Simulated Error"
"RTN","BSDXAPI1",167,0)
 ;
"RTN","BSDXAPI1",168,0)
 ; Get appointment IEN in ^SC(DA(2),"S",DA(1),1,
"RTN","BSDXAPI1",169,0)
 N SCIEN S SCIEN=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE)
"RTN","BSDXAPI1",170,0)
 ;
"RTN","BSDXAPI1",171,0)
 ; If not there, it has been cancelled. Okay to Remove Check-in.
"RTN","BSDXAPI1",172,0)
 I 'SCIEN QUIT 0
"RTN","BSDXAPI1",173,0)
 ;
"RTN","BSDXAPI1",174,0)
 ; Check if checked out
"RTN","BSDXAPI1",175,0)
 I $$CO^BSDXAPI(PAT,CLINIC,DATE,SCIEN) Q 1_U_"Appointment Already Checked Out"
"RTN","BSDXAPI1",176,0)
 ;
"RTN","BSDXAPI1",177,0)
 QUIT 0
"RTN","BSDXAPI1",178,0)
 ;
"RTN","BSDXAPI1",179,0)
UPDATENT(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
"RTN","BSDXAPI1",180,0)
 ; PAT = DFN
"RTN","BSDXAPI1",181,0)
 ; CLINIC = SC IEN
"RTN","BSDXAPI1",182,0)
 ; DATE = FM Date/Time of Appointment
"RTN","BSDXAPI1",183,0)
 ;
"RTN","BSDXAPI1",184,0)
 ; Returns:
"RTN","BSDXAPI1",185,0)
 ; 0 if okay
"RTN","BSDXAPI1",186,0)
 ; -1 if failure
"RTN","BSDXAPI1",187,0)
 ;
"RTN","BSDXAPI1",188,0)
 ; ERROR SIMULATION
"RTN","BSDXAPI1",189,0)
 I $G(BSDXSIMERR1) QUIT "-1~Simulated Error"
"RTN","BSDXAPI1",190,0)
 ;
"RTN","BSDXAPI1",191,0)
 N SCIEN S SCIEN=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE) ; ien of appt in ^SC
"RTN","BSDXAPI1",192,0)
 I SCIEN<1 QUIT 0    ; Appt cancelled; cancelled appts rm'ed from file 44
"RTN","BSDXAPI1",193,0)
 N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
"RTN","BSDXAPI1",194,0)
 N BSDXFDA S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
"RTN","BSDXAPI1",195,0)
 N BSDXERR
"RTN","BSDXAPI1",196,0)
 D FILE^DIE("","BSDXFDA","BSDXERR")
"RTN","BSDXAPI1",197,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","BSDXAPI1",198,0)
 QUIT 0
"RTN","BSDXAPI1",199,0)
 ;
"RTN","BSDXAPI1",200,0)
AVUPDTCN(BSDXSCD,BSDXSTART,BSDXLEN) ;Update PIMS Clinic availability for cancel
"RTN","BSDXAPI1",201,0)
 ; NB: VEN/SMH: This code has never been tested. It's here for its
"RTN","BSDXAPI1",202,0)
 ; presumptive function, but I don't know whether it works accurately!
"RTN","BSDXAPI1",203,0)
 ;See SDCNP0
"RTN","BSDXAPI1",204,0)
 N SD,S  ; Start Date
"RTN","BSDXAPI1",205,0)
 S (SD,S)=BSDXSTART
"RTN","BSDXAPI1",206,0)
 N I ; Clinic IEN in 44
"RTN","BSDXAPI1",207,0)
 S I=BSDXSCD
"RTN","BSDXAPI1",208,0)
 ; if day has no schedule in legacy PIMS, forget about this update.
"RTN","BSDXAPI1",209,0)
 Q:'$D(^SC(I,"ST",SD\1,1))
"RTN","BSDXAPI1",210,0)
 N SL ; Clinic characteristics node (length of appt, when appts start etc)
"RTN","BSDXAPI1",211,0)
 S SL=^SC(I,"SL")
"RTN","BSDXAPI1",212,0)
 N X ; Hour Clinic Display Begins
"RTN","BSDXAPI1",213,0)
 S X=$P(SL,U,3)
"RTN","BSDXAPI1",214,0)
 N STARTDAY ; When does the day start?
"RTN","BSDXAPI1",215,0)
 S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am
"RTN","BSDXAPI1",216,0)
 N SB ; ?? Who knows? Day Start - 1 divided by 100.
"RTN","BSDXAPI1",217,0)
 S SB=STARTDAY-1/100
"RTN","BSDXAPI1",218,0)
 S X=$P(SL,U,6) ; Now X is Display increments per hour
"RTN","BSDXAPI1",219,0)
 N HSI ; Slots per hour, try 1
"RTN","BSDXAPI1",220,0)
 S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4
"RTN","BSDXAPI1",221,0)
 N SI ; Slots per hour, try 2
"RTN","BSDXAPI1",222,0)
 S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4
"RTN","BSDXAPI1",223,0)
 N STR ; ??
"RTN","BSDXAPI1",224,0)
 S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
"RTN","BSDXAPI1",225,0)
 N SDDIF ; Slots per hour diff??
"RTN","BSDXAPI1",226,0)
 S SDDIF=$S(HSI<3:8/HSI,1:2)
"RTN","BSDXAPI1",227,0)
 S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI
"RTN","BSDXAPI1",228,0)
 S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS
"RTN","BSDXAPI1",229,0)
 N Y ; Hours since start of Date
"RTN","BSDXAPI1",230,0)
 S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs
"RTN","BSDXAPI1",231,0)
 N ST  ; ??
"RTN","BSDXAPI1",232,0)
 ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour
"RTN","BSDXAPI1",233,0)
 ; Y\1 -> Hours since start of day; * SI: * slots
"RTN","BSDXAPI1",234,0)
 S ST=Y#1*SI\.6+(Y\1*SI)
"RTN","BSDXAPI1",235,0)
 N SS ; how many slots are supposed to be taken by appointment
"RTN","BSDXAPI1",236,0)
 S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots)
"RTN","BSDXAPI1",237,0)
 N I
"RTN","BSDXAPI1",238,0)
 I Y'<1 D  ; If Hours since start of Date is greater than 1
"RTN","BSDXAPI1",239,0)
 . ; loop through pattern. Tired of documenting.
"RTN","BSDXAPI1",240,0)
 . F I=ST+ST:SDDIF D  Q:Y=""  Q:SS'>0
"RTN","BSDXAPI1",241,0)
 . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y=""
"RTN","BSDXAPI1",242,0)
 . . S S=$E(S,1,I)_Y_$E(S,I+2,999)
"RTN","BSDXAPI1",243,0)
 . . S SS=SS-1
"RTN","BSDXAPI1",244,0)
 . . Q:SS'>0
"RTN","BSDXAPI1",245,0)
 S ^SC(BSDXSCD,"ST",SD\1,1)=S  ; new pattern; global set
"RTN","BSDXAPI1",246,0)
 Q
"RTN","BSDXAPI1",247,0)
 ;
"RTN","BSDXAPI1",248,0)
AVUPDTMK(BSDXSCD,BSDXSTART,BSDXLEN,BSDXPATID) ; Update RPMS Clinic availability for Make
"RTN","BSDXAPI1",249,0)
 ;SEE SDM1
"RTN","BSDXAPI1",250,0)
 N Y,DFN
"RTN","BSDXAPI1",251,0)
 N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG
"RTN","BSDXAPI1",252,0)
 N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I
"RTN","BSDXAPI1",253,0)
 S Y=BSDXSCD,DFN=BSDXPATID
"RTN","BSDXAPI1",254,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","BSDXAPI1",255,0)
 ;Determine maximum days for scheduling
"RTN","BSDXAPI1",256,0)
 S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365
"RTN","BSDXAPI1",257,0)
 S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1))
"RTN","BSDXAPI1",258,0)
 S SDDATE=BSDXSTART
"RTN","BSDXAPI1",259,0)
 S SDSDATE=SDDATE,SDDATE=SDDATE\1
"RTN","BSDXAPI1",260,0)
1 ;L  Q:$D(SDXXX)  S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0  S SC=+SC
"RTN","BSDXAPI1",261,0)
 Q:$D(SDXXX)  S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0  S SC=+SC
"RTN","BSDXAPI1",262,0)
 S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2)
"RTN","BSDXAPI1",263,0)
 S X2=SDEDT D C^%DTC S SDEDT=X
"RTN","BSDXAPI1",264,0)
 S Y=BSDXSTART
"RTN","BSDXAPI1",265,0)
EN1 S (X,SD)=Y,SM=0 D DOW
"RTN","BSDXAPI1",266,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","BSDXAPI1",267,0)
 S S=BSDXLEN
"RTN","BSDXAPI1",268,0)
 ;Check if BSDXLEN evenly divisible by appointment length
"RTN","BSDXAPI1",269,0)
 S RPMSL=$P(SL,U)
"RTN","BSDXAPI1",270,0)
 I BSDXLEN<RPMSL S BSDXLEN=RPMSL
"RTN","BSDXAPI1",271,0)
 I BSDXLEN#RPMSL'=0 D
"RTN","BSDXAPI1",272,0)
 . S BSDXINC=BSDXLEN\RPMSL
"RTN","BSDXAPI1",273,0)
 . S BSDXINC=BSDXINC+1
"RTN","BSDXAPI1",274,0)
 . S BSDXLEN=RPMSL*BSDXINC
"RTN","BSDXAPI1",275,0)
 S SL=S_U_$P(SL,U,2,99)
"RTN","BSDXAPI1",276,0)
SC S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9
"RTN","BSDXAPI1",277,0)
 L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC
"RTN","BSDXAPI1",278,0)
 S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1)
"RTN","BSDXAPI1",279,0)
 S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST
"RTN","BSDXAPI1",280,0)
 I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q
"RTN","BSDXAPI1",281,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","BSDXAPI1",282,0)
 ;
"RTN","BSDXAPI1",283,0)
SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP
"RTN","BSDXAPI1",284,0)
 S SDNOT=1
"RTN","BSDXAPI1",285,0)
 S ABORT=0
"RTN","BSDXAPI1",286,0)
 F I=ST+ST:SDDIF:SS-SDDIF D  Q:ABORT
"RTN","BSDXAPI1",287,0)
 . S ST=$E(S,I+1) S:ST="" ST=" "
"RTN","BSDXAPI1",288,0)
 . S Y=$E(STR,$F(STR,ST)-2)
"RTN","BSDXAPI1",289,0)
 . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q
"RTN","BSDXAPI1",290,0)
 . I Y="" S ABORT=1 Q
"RTN","BSDXAPI1",291,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","BSDXAPI1",292,0)
 . Q
"RTN","BSDXAPI1",293,0)
 S ^SC(SC,"ST",$P(SD,"."),1)=S
"RTN","BSDXAPI1",294,0)
 L -^SC(SC,"ST",$P(SD,"."),1)
"RTN","BSDXAPI1",295,0)
 Q
"RTN","BSDXAPI1",296,0)
DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
"RTN","BSDXAPI1",297,0)
 ;
"RTN","BSDXAPI1",298,0)
DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y)
"RTN","BSDXAPI1",299,0)
 F %=%:-1:281 S Y=%#4=1+1+Y
"RTN","BSDXAPI1",300,0)
 S Y=$E(X,6,7)+Y#7
"RTN","BSDXAPI1",301,0)
 Q
"RTN","BSDXAPI1",302,0)
 ;
"RTN","BSDXGPRV")
0^36^B4677493
"RTN","BSDXGPRV",1,0)
BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 7/6/12 11:07am
"RTN","BSDXGPRV",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDXGPRV",3,0)
 ; Licensed under LGPL  
"RTN","BSDXGPRV",4,0)
 ;
"RTN","BSDXGPRV",5,0)
 ;
"RTN","BSDXGPRV",6,0)
ERROR ;
"RTN","BSDXGPRV",7,0)
 D ERR("RPMS Error")
"RTN","BSDXGPRV",8,0)
 Q
"RTN","BSDXGPRV",9,0)
 ;
"RTN","BSDXGPRV",10,0)
ERR(BSDXERR) ;Error processing
"RTN","BSDXGPRV",11,0)
 D ^%ZTER
"RTN","BSDXGPRV",12,0)
 S BSDXI=BSDXI+1
"RTN","BSDXGPRV",13,0)
 S ^BSDXTMP($J,BSDXI)=BSDXERR
"RTN","BSDXGPRV",14,0)
 S BSDXI=BSDXI+1
"RTN","BSDXGPRV",15,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDXGPRV",16,0)
 Q
"RTN","BSDXGPRV",17,0)
 ;
"RTN","BSDXGPRV",18,0)
PD(BSDXY,HLIEN) ;EP Debugging entry point
"RTN","BSDXGPRV",19,0)
 ;
"RTN","BSDXGPRV",20,0)
 ;D DEBUG^%Serenji("P^BSDXGPRV(.BSDXY,HLIEN)","192.168.254.130")
"RTN","BSDXGPRV",21,0)
 ;
"RTN","BSDXGPRV",22,0)
 Q
"RTN","BSDXGPRV",23,0)
 ;
"RTN","BSDXGPRV",24,0)
P(BSDXY,HLIEN) ; Public Entry point; Get Providers for Hosp Location
"RTN","BSDXGPRV",25,0)
 ; Input: HLIEN - Hospital Location IEN
"RTN","BSDXGPRV",26,0)
 ; Output: ADO Datatable with columns:
"RTN","BSDXGPRV",27,0)
 ; - HOSPITAL_LOCATION_ID, BMXIEN, PROV_NAME, DEFAULT
"RTN","BSDXGPRV",28,0)
 ; If there are providers in the PROVIDER multiple of file 44 
"RTN","BSDXGPRV",29,0)
 ; (Hospital Location) return them;
"RTN","BSDXGPRV",30,0)
 ; If no providers in PROVIDER multiple of file 44, return nothing
"RTN","BSDXGPRV",31,0)
 ; Called by BSDX HOSP LOC PROVIDERS
"RTN","BSDXGPRV",32,0)
 ;
"RTN","BSDXGPRV",33,0)
 S BSDXI=0
"RTN","BSDXGPRV",34,0)
 I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT
"RTN","BSDXGPRV",35,0)
 D ^XBKVAR
"RTN","BSDXGPRV",36,0)
 N $ET S $ET="G ERROR^BSDXGPRV"
"RTN","BSDXGPRV",37,0)
 K ^BSDXTMP($J)
"RTN","BSDXGPRV",38,0)
 S BSDXY=$NA(^BSDXTMP($J))
"RTN","BSDXGPRV",39,0)
 S $P(^BSDXTMP($J,BSDXI),U,1)="I00020HOSPITAL_LOCATION_ID"
"RTN","BSDXGPRV",40,0)
 S $P(^BSDXTMP($J,BSDXI),U,2)="I00020BMXIEN"
"RTN","BSDXGPRV",41,0)
 S $P(^BSDXTMP($J,BSDXI),U,3)="T00030NAME"
"RTN","BSDXGPRV",42,0)
 S $P(^BSDXTMP($J,BSDXI),U,4)="T00005DEFAULT"
"RTN","BSDXGPRV",43,0)
 S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30)
"RTN","BSDXGPRV",44,0)
 ;
"RTN","BSDXGPRV",45,0)
 N OUTPUT
"RTN","BSDXGPRV",46,0)
 D GETS^DIQ(44,HLIEN_",","2600*","IE","OUTPUT") ; Provider Multiple
"RTN","BSDXGPRV",47,0)
 ; No results
"RTN","BSDXGPRV",48,0)
 I '$D(OUTPUT) S ^BSDXTMP($J,BSDXI+1)=$C(31) QUIT
"RTN","BSDXGPRV",49,0)
 ; if results, get them
"RTN","BSDXGPRV",50,0)
 N I S I=""
"RTN","BSDXGPRV",51,0)
 F  S I=$O(OUTPUT(44.1,I)) Q:I=""  D
"RTN","BSDXGPRV",52,0)
 . S BSDXI=BSDXI+1
"RTN","BSDXGPRV",53,0)
 . S $P(^BSDXTMP($J,BSDXI),U,1)=HLIEN                  ; HL IEN
"RTN","BSDXGPRV",54,0)
 . S $P(^BSDXTMP($J,BSDXI),U,2)=$P(OUTPUT(44.1,I,.01,"I"),",") ; PROV IEN
"RTN","BSDXGPRV",55,0)
 . S $P(^BSDXTMP($J,BSDXI),U,3)=$E(OUTPUT(44.1,I,.01,"E"),1,30) ; PROV NAME
"RTN","BSDXGPRV",56,0)
 . S $P(^BSDXTMP($J,BSDXI),U,4)=OUTPUT(44.1,I,.02,"E") ; Default - YES, NO
"RTN","BSDXGPRV",57,0)
 . S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30)
"RTN","BSDXGPRV",58,0)
 S BSDXI=BSDXI+1
"RTN","BSDXGPRV",59,0)
 S ^BSDXTMP($J,BSDXI)=$C(31)
"RTN","BSDXGPRV",60,0)
 QUIT
"RTN","BSDXUT")
0^38^B130401979
"RTN","BSDXUT",1,0)
BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/29/12 12:20pm
"RTN","BSDXUT",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDXUT",3,0)
 ; Licensed under LGPL
"RTN","BSDXUT",4,0)
 ;
"RTN","BSDXUT",5,0)
 ; Change Log:
"RTN","BSDXUT",6,0)
 ; June 21 2012: Initial Version
"RTN","BSDXUT",7,0)
 ;
"RTN","BSDXUT",8,0)
EN ; Run all Unit Tests
"RTN","BSDXUT",9,0)
 D UT07
"RTN","BSDXUT",10,0)
 QUIT
"RTN","BSDXUT",11,0)
UT07 ; Unit Tests for BSDX07 - Assumes you have Patients with DFNs 1,2,3,4,5
"RTN","BSDXUT",12,0)
 ; HLs/Resources are created as part of the UT
"RTN","BSDXUT",13,0)
 ; Set-up - Create Clinics
"RTN","BSDXUT",14,0)
 N RESNAM S RESNAM="UTCLINIC"
"RTN","BSDXUT",15,0)
 N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
"RTN","BSDXUT",16,0)
 D
"RTN","BSDXUT",17,0)
 . N $ET S $ET="D ^%ZTER B"
"RTN","BSDXUT",18,0)
 . S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
"RTN","BSDXUT",19,0)
 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
"RTN","BSDXUT",20,0)
 ;
"RTN","BSDXUT",21,0)
 N HLIEN,RESIEN
"RTN","BSDXUT",22,0)
 S HLIEN=$P(HLRESIENS,U)
"RTN","BSDXUT",23,0)
 S RESIEN=$P(HLRESIENS,U,2)
"RTN","BSDXUT",24,0)
 ;
"RTN","BSDXUT",25,0)
 ; Get start and end times
"RTN","BSDXUT",26,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT",27,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT",28,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT",29,0)
 ;
"RTN","BSDXUT",30,0)
 N ZZZ,DFN
"RTN","BSDXUT",31,0)
 ; Test for normality:
"RTN","BSDXUT",32,0)
 S DFN=3
"RTN","BSDXUT",33,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",34,0)
 ; Does Appt exist?
"RTN","BSDXUT",35,0)
 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT",36,0)
 I 'APPID W "Error Making Appt-1" QUIT
"RTN","BSDXUT",37,0)
 I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-2"
"RTN","BSDXUT",38,0)
 I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-3"
"RTN","BSDXUT",39,0)
 I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-4"
"RTN","BSDXUT",40,0)
 ;
"RTN","BSDXUT",41,0)
 ; Do it again for a different patient
"RTN","BSDXUT",42,0)
 S DFN=2
"RTN","BSDXUT",43,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",44,0)
 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT",45,0)
 I 'APPID W "Error Making Appt-5" QUIT
"RTN","BSDXUT",46,0)
 I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-6"
"RTN","BSDXUT",47,0)
 I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-7"
"RTN","BSDXUT",48,0)
 I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-8"
"RTN","BSDXUT",49,0)
 ;
"RTN","BSDXUT",50,0)
 ; Again for a different patient (4)
"RTN","BSDXUT",51,0)
 S DFN=4
"RTN","BSDXUT",52,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",53,0)
 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT",54,0)
 I 'APPID W "Error Making Appt-9" QUIT
"RTN","BSDXUT",55,0)
 I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-10"
"RTN","BSDXUT",56,0)
 I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-11"
"RTN","BSDXUT",57,0)
 I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-12"
"RTN","BSDXUT",58,0)
 ;
"RTN","BSDXUT",59,0)
 ; Delete appointment set for Patient 4 (made above)
"RTN","BSDXUT",60,0)
 N BSDX,DFN
"RTN","BSDXUT",61,0)
 S DFN=4
"RTN","BSDXUT",62,0)
 S BSDX("PAT")=DFN
"RTN","BSDXUT",63,0)
 S BSDX("CLN")=HLIEN
"RTN","BSDXUT",64,0)
 S BSDX("ADT")=APPTTIME
"RTN","BSDXUT",65,0)
 D ROLLBACK^BSDX07(APPID,.BSDX)
"RTN","BSDXUT",66,0)
 I +$G(^BSDXAPPT(APPID,0)) W "Error in deleting appointment-1",!
"RTN","BSDXUT",67,0)
 I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-2",!
"RTN","BSDXUT",68,0)
 I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-3",!
"RTN","BSDXUT",69,0)
 ;
"RTN","BSDXUT",70,0)
 ; Again for a different patient (5)
"RTN","BSDXUT",71,0)
 S DFN=5
"RTN","BSDXUT",72,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",73,0)
 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT",74,0)
 I 'APPID W "Error Making Appt-13" QUIT
"RTN","BSDXUT",75,0)
 I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-14"
"RTN","BSDXUT",76,0)
 I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-15"
"RTN","BSDXUT",77,0)
 I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-16"
"RTN","BSDXUT",78,0)
 ; Now cancel that appointment
"RTN","BSDXUT",79,0)
 D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
"RTN","BSDXUT",80,0)
 ; Now make it again
"RTN","BSDXUT",81,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",82,0)
 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT",83,0)
 I 'APPID W "Error Making Appt-17" QUIT
"RTN","BSDXUT",84,0)
 I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-18"
"RTN","BSDXUT",85,0)
 I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-19"
"RTN","BSDXUT",86,0)
 I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-20"
"RTN","BSDXUT",87,0)
 ;
"RTN","BSDXUT",88,0)
 ; Delete appointment set for Patient 1 (not made)... needs to not crash
"RTN","BSDXUT",89,0)
 D
"RTN","BSDXUT",90,0)
 . N $ET S $ET="D ^%ZTER S $EC="""" W ""Failure to del non-existent appt"",!"
"RTN","BSDXUT",91,0)
 . N BSDX
"RTN","BSDXUT",92,0)
 . S BSDX("PAT")=1
"RTN","BSDXUT",93,0)
 . S BSDX("CLN")=HLIEN
"RTN","BSDXUT",94,0)
 . S BSDX("ADT")=APPTTIME
"RTN","BSDXUT",95,0)
 . D ROLLBACK^BSDX07(APPID,.BSDX)
"RTN","BSDXUT",96,0)
 ;
"RTN","BSDXUT",97,0)
 ; Test for bad start date
"RTN","BSDXUT",98,0)
 D APPADD^BSDX07(.ZZZ,2100123,3100123.3,2,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",99,0)
 I +$P(^BSDXTMP($J,1),U,2)'=-2 W "Error in -2",!
"RTN","BSDXUT",100,0)
 ; Test for bad end date
"RTN","BSDXUT",101,0)
 D APPADD^BSDX07(.ZZZ,3100123,2100123.3,2,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",102,0)
 I +$P(^BSDXTMP($J,1),U,2)'=-3 W "Error in -3",!
"RTN","BSDXUT",103,0)
 ; Test for end date without time - obsolete
"RTN","BSDXUT",104,0)
 ; Test for mumps error
"RTN","BSDXUT",105,0)
 N BSDXDIE S BSDXDIE=1
"RTN","BSDXUT",106,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,1,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",107,0)
 I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",!
"RTN","BSDXUT",108,0)
 K BSDXDIE
"RTN","BSDXUT",109,0)
 ; Test for TRESTART -- retired in v 1.7
"RTN","BSDXUT",110,0)
 ; Test for non-numeric patient
"RTN","BSDXUT",111,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,"CAT,DOG",RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",112,0)
 I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",!
"RTN","BSDXUT",113,0)
 ; Test for a non-existent patient
"RTN","BSDXUT",114,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,8989898989,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",115,0)
 I +$P(^BSDXTMP($J,1),U,2)'=-6 W "Error in -6",!
"RTN","BSDXUT",116,0)
 ; Test for a non-existent resource name
"RTN","BSDXUT",117,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,3,"lkajsflkjsadf",30,"Sam's Note",1)
"RTN","BSDXUT",118,0)
 I +$P(^BSDXTMP($J,1),U,2)'=-7 W "Error in -7",!
"RTN","BSDXUT",119,0)
 ; Test for corrupted resource
"RTN","BSDXUT",120,0)
 ; Can't test for -8 since it requires DB corruption
"RTN","BSDXUT",121,0)
 ; Test for inability to add appointment to BSDX Appointment (-9)
"RTN","BSDXUT",122,0)
 ; Also requires something wrong in the DB
"RTN","BSDXUT",123,0)
 ; Test for inability to add appointment to 2,44
"RTN","BSDXUT",124,0)
 ; Test by creating a duplicate appointment
"RTN","BSDXUT",125,0)
 ; Get start and end times
"RTN","BSDXUT",126,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT",127,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT",128,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT",129,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",130,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",131,0)
 I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",!
"RTN","BSDXUT",132,0)
 ;
"RTN","BSDXUT",133,0)
 ; Test that ROLLBACK^BSDX07 occurs properly in various places
"RTN","BSDXUT",134,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT",135,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT",136,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT",137,0)
 S DFN=4
"RTN","BSDXUT",138,0)
 N BSDXSIMERR1 S BSDXSIMERR1=1
"RTN","BSDXUT",139,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",140,0)
 N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,""))
"RTN","BSDXUT",141,0)
 I +APPID W "Error in deleting appointment-4",!
"RTN","BSDXUT",142,0)
 I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-5",!
"RTN","BSDXUT",143,0)
 I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-6",!
"RTN","BSDXUT",144,0)
 ;
"RTN","BSDXUT",145,0)
 K BSDXSIMERR1
"RTN","BSDXUT",146,0)
 N BSDXSIMERR2 S BSDXSIMERR2=1
"RTN","BSDXUT",147,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",148,0)
 N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,""))
"RTN","BSDXUT",149,0)
 I +APPID W "Error in deleting appointment-7",!
"RTN","BSDXUT",150,0)
 I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-8",!
"RTN","BSDXUT",151,0)
 I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-9",!
"RTN","BSDXUT",152,0)
 ;
"RTN","BSDXUT",153,0)
 K BSDXSIMERR2
"RTN","BSDXUT",154,0)
 N BSDXSIMERR4 S BSDXSIMERR4=1
"RTN","BSDXUT",155,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",156,0)
 N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,""))
"RTN","BSDXUT",157,0)
 I +APPID W "Error in deleting appointment-16",!
"RTN","BSDXUT",158,0)
 I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-17",!
"RTN","BSDXUT",159,0)
 I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-18",!
"RTN","BSDXUT",160,0)
 ;
"RTN","BSDXUT",161,0)
 K BSDXSIMERR4
"RTN","BSDXUT",162,0)
 N BSDXSIMERR5 S BSDXSIMERR5=1
"RTN","BSDXUT",163,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",164,0)
 N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,""))
"RTN","BSDXUT",165,0)
 I +APPID W "Error in deleting appointment-19",!
"RTN","BSDXUT",166,0)
 I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-20",!
"RTN","BSDXUT",167,0)
 I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-21",!
"RTN","BSDXUT",168,0)
 ;
"RTN","BSDXUT",169,0)
 ; Okay now we do UTs for an unlinked resource (not linked to PIMS)
"RTN","BSDXUT",170,0)
 N RESNAM S RESNAM="UTCLINICUL" ; Unlinked Clinic
"RTN","BSDXUT",171,0)
 N RESIEN
"RTN","BSDXUT",172,0)
 D
"RTN","BSDXUT",173,0)
 . N $ET S $ET="D ^%ZTER B"
"RTN","BSDXUT",174,0)
 . S RESIEN=$$UTCRRES^BSDXUT(RESNAM)
"RTN","BSDXUT",175,0)
 . I RESIEN<0 S $EC=",U1," ; not supposed to happen - hard crash if so
"RTN","BSDXUT",176,0)
 ;
"RTN","BSDXUT",177,0)
 ; Get start and end times
"RTN","BSDXUT",178,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT",179,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT",180,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT",181,0)
 ;
"RTN","BSDXUT",182,0)
 N ZZZ,DFN
"RTN","BSDXUT",183,0)
 ; Test for normality:
"RTN","BSDXUT",184,0)
 S DFN=3
"RTN","BSDXUT",185,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",186,0)
 ; Does Appt exist?
"RTN","BSDXUT",187,0)
 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT",188,0)
 I 'APPID W "Error Making Appt-101" QUIT
"RTN","BSDXUT",189,0)
 I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-102"
"RTN","BSDXUT",190,0)
 I $D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-103"
"RTN","BSDXUT",191,0)
 ;
"RTN","BSDXUT",192,0)
 ; Again for a different patient (4)
"RTN","BSDXUT",193,0)
 S DFN=4
"RTN","BSDXUT",194,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",195,0)
 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT",196,0)
 I 'APPID W "Error Making Appt-104" QUIT
"RTN","BSDXUT",197,0)
 I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-105"
"RTN","BSDXUT",198,0)
 I $D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-106"
"RTN","BSDXUT",199,0)
 ;
"RTN","BSDXUT",200,0)
 ; Delete appointment set for Patient 4 (made above)
"RTN","BSDXUT",201,0)
 N BSDX,DFN
"RTN","BSDXUT",202,0)
 S DFN=4
"RTN","BSDXUT",203,0)
 D ROLLBACK^BSDX07(APPID)
"RTN","BSDXUT",204,0)
 I +$G(^BSDXAPPT(APPID,0)) W "Error in deleting appointment-1",!
"RTN","BSDXUT",205,0)
 ;
"RTN","BSDXUT",206,0)
 ; Duplicate appointments... This is SUPPOSED to fail for now (v1.7)
"RTN","BSDXUT",207,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT",208,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT",209,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT",210,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",211,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",212,0)
 I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10 in Unlinked Section (existing bug)",!
"RTN","BSDXUT",213,0)
 ;
"RTN","BSDXUT",214,0)
 ; Test that ROLLBACK^BSDX07 occurs properly in various places
"RTN","BSDXUT",215,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT",216,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT",217,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT",218,0)
 S DFN=4
"RTN","BSDXUT",219,0)
 N BSDXSIMERR1 S BSDXSIMERR1=1
"RTN","BSDXUT",220,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",221,0)
 N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,""))
"RTN","BSDXUT",222,0)
 I +APPID W "Error in deleting appointment-101",!
"RTN","BSDXUT",223,0)
 ;
"RTN","BSDXUT",224,0)
 ; These are never triggered, so we should still have an appointment
"RTN","BSDXUT",225,0)
 K BSDXSIMERR1
"RTN","BSDXUT",226,0)
 N BSDXSIMERR2 S BSDXSIMERR2=1
"RTN","BSDXUT",227,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",228,0)
 N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,""))
"RTN","BSDXUT",229,0)
 I '+APPID W "Error in deleting appointment-102",!
"RTN","BSDXUT",230,0)
 ;
"RTN","BSDXUT",231,0)
 K BSDXSIMERR2
"RTN","BSDXUT",232,0)
 N BSDXSIMERR4 S BSDXSIMERR4=1
"RTN","BSDXUT",233,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",234,0)
 N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,""))
"RTN","BSDXUT",235,0)
 I '+APPID W "Error in deleting appointment-103",!
"RTN","BSDXUT",236,0)
 ;
"RTN","BSDXUT",237,0)
 K BSDXSIMERR4
"RTN","BSDXUT",238,0)
 N BSDXSIMERR5 S BSDXSIMERR5=1
"RTN","BSDXUT",239,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT",240,0)
 N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,""))
"RTN","BSDXUT",241,0)
 I '+APPID W "Error in deleting appointment-104",!
"RTN","BSDXUT",242,0)
 QUIT
"RTN","BSDXUT",243,0)
 ; 
"RTN","BSDXUT",244,0)
UTCR(RESNAM) ; $$ - Create Unit Test Clinic and Resource Pair ; Private
"RTN","BSDXUT",245,0)
 ; Input: Resource Name By Value
"RTN","BSDXUT",246,0)
 ; Output: -1^Error or HLIEN^RESIEN for Success (file 44 IEN^file 9002018.1 IEN)
"RTN","BSDXUT",247,0)
 ; DO NOT USE IN A PRODUCTION ENVIRONTMENT. INTENDED FOR TESTING ONLY
"RTN","BSDXUT",248,0)
 N HLIEN S HLIEN=$$UTCR44(RESNAM)
"RTN","BSDXUT",249,0)
 I +HLIEN=-1 QUIT HLIEN
"RTN","BSDXUT",250,0)
 ;
"RTN","BSDXUT",251,0)
 N RESIEN S RESIEN=$$UTCRRES(RESNAM,HLIEN)
"RTN","BSDXUT",252,0)
 I +RESIEN=-1 QUIT RESIEN
"RTN","BSDXUT",253,0)
 E  QUIT HLIEN_U_RESIEN
"RTN","BSDXUT",254,0)
 ;
"RTN","BSDXUT",255,0)
UTCR44(HLNAME) ; $$ - Create Unit Test Clinic in File 44; Private ; TESTING ONLY CODE
"RTN","BSDXUT",256,0)
 ; Output: -1^Error or IEN for Success
"RTN","BSDXUT",257,0)
 ; Input: Hosp Location Name by Value
"RTN","BSDXUT",258,0)
 ; DO NOT USE IN A PRODUCTION ENVIRONTMENT. INTENDED FOR TESTING ONLY
"RTN","BSDXUT",259,0)
 ;
"RTN","BSDXUT",260,0)
 I $D(^SC("B",HLNAME)) Q $O(^(HLNAME,""))
"RTN","BSDXUT",261,0)
 ;
"RTN","BSDXUT",262,0)
 N SAM
"RTN","BSDXUT",263,0)
 S SAM(44,"?+1,",.01)=HLNAME            ; Name
"RTN","BSDXUT",264,0)
 S SAM(44,"?+1,",2)="C"                 ; Type = Clinic
"RTN","BSDXUT",265,0)
 S SAM(44,"?+1,",2.1)=1                 ; Type Extension (not used)
"RTN","BSDXUT",266,0)
 S SAM(44,"?+1,",3.5)=$O(^DG(40.8,0))   ; Division (not yet used)
"RTN","BSDXUT",267,0)
 S SAM(44,"?+1,",8)=295                 ; Stop Code Number (not used)
"RTN","BSDXUT",268,0)
 S SAM(44,"?+1,",9)="M"          ; Service (not used)
"RTN","BSDXUT",269,0)
 S SAM(44,"?+1,",1912)=15               ; Length of Appt (not used)
"RTN","BSDXUT",270,0)
 S SAM(44,"?+1,",1917)=4                ; Display increments per hour (not used)
"RTN","BSDXUT",271,0)
 S SAM(44,"?+1,",1918)=8                ; Overbooks/day max (not used)
"RTN","BSDXUT",272,0)
 S SAM(44,"?+1,",2000.5)=0              ; Require Action Profiles: Yes (not used)
"RTN","BSDXUT",273,0)
 S SAM(44,"?+1,",2001)=999              ; Allowable consecutive no-shows (not used)
"RTN","BSDXUT",274,0)
 S SAM(44,"?+1,",2002)=999              ; Max # days for Future Booking (not used)
"RTN","BSDXUT",275,0)
 S SAM(44,"?+1,",2005)=365              ; Max # days for Auto Rebook (not used)
"RTN","BSDXUT",276,0)
 S SAM(44,"?+1,",2502)="N"             ; Non-Count Clinic (not used)
"RTN","BSDXUT",277,0)
 S SAM(44,"?+1,",2504)="Y"            ; Clinic meets at this Facility? (not used)
"RTN","BSDXUT",278,0)
 S SAM(44,"?+1,",2507)=9              ; Appointment Type (not used)
"RTN","BSDXUT",279,0)
 ;
"RTN","BSDXUT",280,0)
 N BSDXERR,BSDXIEN
"RTN","BSDXUT",281,0)
 D UPDATE^DIE("",$NA(SAM),$NA(BSDXIEN),$NA(BSDXERR))
"RTN","BSDXUT",282,0)
 Q $S($D(BSDXERR):-1_U_BSDXERR("DIERR",1,"TEXT",1),1:BSDXIEN(1))
"RTN","BSDXUT",283,0)
 ;
"RTN","BSDXUT",284,0)
UTCRRES(NAME,HLIEN) ; $$ - Create Unit Test Resource in 9002018.1 (BSDX RESOURCE); Private
"RTN","BSDXUT",285,0)
 ; Input: Hospital Location IEN
"RTN","BSDXUT",286,0)
 ; Output: -1^Error or IEN for Success
"RTN","BSDXUT",287,0)
 ; DO NOT USE IN A PRODUCTION ENVIRONTMENT. INTENDED FOR TESTING ONLY
"RTN","BSDXUT",288,0)
 I $D(^BSDXRES("B",NAME)) Q $O(^(NAME,""))
"RTN","BSDXUT",289,0)
 S HLIEN=$G(HLIEN) ; If we don't send one in
"RTN","BSDXUT",290,0)
 N RES ; garbage variable
"RTN","BSDXUT",291,0)
 D RSRC^BSDX16(.RES,"|"_NAME_"||"_HLIEN)
"RTN","BSDXUT",292,0)
 N RTN S RTN=@$Q(^BSDXTMP($J,0)) ; return array next value
"RTN","BSDXUT",293,0)
 Q $S(RTN=0:-1_U_RTN,1:+RTN) ; 0 means an error has occurred; 1 means IEN returned
"RTN","BSDXUT",294,0)
 ;
"RTN","BSDXUT",295,0)
TIMES() ; $$ - Create a next available appointment time^ending time; Private
"RTN","BSDXUT",296,0)
 ; Output: appttime^endtime
"RTN","BSDXUT",297,0)
 N NOW S NOW=$$NOW^XLFDT() ; Now time
"RTN","BSDXUT",298,0)
 N LAST S LAST=$O(^BSDXAPPT("B"," "),-1) ; highest time in file
"RTN","BSDXUT",299,0)
 N TIME2USE S TIME2USE=$S(NOW>LAST:NOW,1:LAST) ; Which time to use?
"RTN","BSDXUT",300,0)
 S TIME2USE=$E(TIME2USE,1,12) ; Strip away seconds
"RTN","BSDXUT",301,0)
 N APPTIME S APPTIME=$$FMADD^XLFDT(TIME2USE,0,0,15,0) ; Add 15 min
"RTN","BSDXUT",302,0)
 N ENDTIME S ENDTIME=$$FMADD^XLFDT(APPTIME,0,0,15,0) ; Add 15 more min
"RTN","BSDXUT",303,0)
 Q APPTIME_U_ENDTIME ; quit with apptime^endtime
"RTN","BSDXUT",304,0)
 ;
"RTN","BSDXUT",305,0)
TIMEHL(HLIEN) ; $$ - Create a next available appointment time^ending time by HL; Private
"RTN","BSDXUT",306,0)
 ; Input: HLIEN
"RTN","BSDXUT",307,0)
 ; Output: Next available appointment time for the HLIEN
"RTN","BSDXUT",308,0)
 N LAST S LAST=$O(^SC(HLIEN,"S",""),-1)
"RTN","BSDXUT",309,0)
 Q $$FMADD^XLFDT(LAST,1,0,15,0) ; Add 1 day and 15 minutes
"RTN","BSDXUT1")
0^39^B193374796
"RTN","BSDXUT1",1,0)
BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 12:31pm
"RTN","BSDXUT1",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDXUT1",3,0)
 ;
"RTN","BSDXUT1",4,0)
 ;
"RTN","BSDXUT1",5,0)
EN ; Run All Unit Tests in this routine
"RTN","BSDXUT1",6,0)
 D UT08,UT29,UT26,UT31
"RTN","BSDXUT1",7,0)
 QUIT
"RTN","BSDXUT1",8,0)
 ;
"RTN","BSDXUT1",9,0)
UT08 ; Unit Tests for BSDX08; Must have patients 1,2,3,4,5 defined in system
"RTN","BSDXUT1",10,0)
 N RESNAM S RESNAM="UTCLINIC"
"RTN","BSDXUT1",11,0)
 N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
"RTN","BSDXUT1",12,0)
 D
"RTN","BSDXUT1",13,0)
 . N $ET S $ET="D ^%ZTER B"
"RTN","BSDXUT1",14,0)
 . S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
"RTN","BSDXUT1",15,0)
 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
"RTN","BSDXUT1",16,0)
 ;
"RTN","BSDXUT1",17,0)
 N HLIEN,RESIEN
"RTN","BSDXUT1",18,0)
 S HLIEN=$P(HLRESIENS,U)
"RTN","BSDXUT1",19,0)
 S RESIEN=$P(HLRESIENS,U,2)
"RTN","BSDXUT1",20,0)
 ;
"RTN","BSDXUT1",21,0)
 ; Get start and end times
"RTN","BSDXUT1",22,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",23,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",24,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",25,0)
 ;
"RTN","BSDXUT1",26,0)
 ; Test 1: Make normal appointment and cancel it. See if every thing works
"RTN","BSDXUT1",27,0)
 N ZZZ,DFN
"RTN","BSDXUT1",28,0)
 S DFN=3
"RTN","BSDXUT1",29,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT1",30,0)
 S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",31,0)
 D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
"RTN","BSDXUT1",32,0)
 I $P(^BSDXAPPT(APPID,0),U,12)'>0 W "Error in Cancellation-1",!
"RTN","BSDXUT1",33,0)
 I $O(^SC(HLIEN,"S",APPTTIME,1,0))]"" W "Error in Cancellation-2",!
"RTN","BSDXUT1",34,0)
 I $P(^DPT(DFN,"S",APPTTIME,0),U,2)'="PC" W "Error in Cancellation-3",!
"RTN","BSDXUT1",35,0)
 I ^DPT(DFN,"S",APPTTIME,"R")'="Sam's Cancel Note" W "Error in Cancellation-4",!
"RTN","BSDXUT1",36,0)
 ;
"RTN","BSDXUT1",37,0)
 ; Test 2: Check for -1 -- TODO: Fix later... Can't do right now automatically
"RTN","BSDXUT1",38,0)
 ; Make appt
"RTN","BSDXUT1",39,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT1",40,0)
 ; Lock the node in another job
"RTN","BSDXUT1",41,0)
 S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",42,0)
 ; W "Lock ^BSDXAPPT("_APPID_") in another session. You have 10 seconds." H 10
"RTN","BSDXUT1",43,0)
 D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
"RTN","BSDXUT1",44,0)
 ;
"RTN","BSDXUT1",45,0)
 ; Test 3: Check for -100
"RTN","BSDXUT1",46,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",47,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",48,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",49,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT1",50,0)
 S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",51,0)
 N BSDXDIE1 S BSDXDIE1=1
"RTN","BSDXUT1",52,0)
 D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
"RTN","BSDXUT1",53,0)
 I $P(^BSDXTMP($J,1),"~")'=-100 W "Error in -100",!
"RTN","BSDXUT1",54,0)
 K BSDXDIE1
"RTN","BSDXUT1",55,0)
 ; 
"RTN","BSDXUT1",56,0)
 ; Test 3.5: Check for -100 with an appointment to rollback.
"RTN","BSDXUT1",57,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",58,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",59,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",60,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT1",61,0)
 S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",62,0)
 N BSDXDIE2 S BSDXDIE2=1
"RTN","BSDXUT1",63,0)
 D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
"RTN","BSDXUT1",64,0)
 I $P(^BSDXTMP($J,1),"~")'=-100 W "Error in -100-1",!
"RTN","BSDXUT1",65,0)
 I $P(^BSDXAPPT(APPID,0),U,12)'="" W "Error in -100-2",!
"RTN","BSDXUT1",66,0)
 K BSDXDIE2
"RTN","BSDXUT1",67,0)
 ; Test 4: Restartable transaction -- retired in V 1.7
"RTN","BSDXUT1",68,0)
 ; Test 5: for invalid Appointment ID (-2 and -3)
"RTN","BSDXUT1",69,0)
 D APPDEL^BSDX08(.ZZZ,0,"PC",1,"Reasons")
"RTN","BSDXUT1",70,0)
 I $P(^BSDXTMP($J,1),"~")'=-2 W "Error in -2",!
"RTN","BSDXUT1",71,0)
 D APPDEL^BSDX08(.ZZZ,999999,"PC",1,"Reasons")
"RTN","BSDXUT1",72,0)
 I $P(^BSDXTMP($J,1),"~")'=-3 W "Error in -3",!
"RTN","BSDXUT1",73,0)
 ; More unit Tests
"RTN","BSDXUT1",74,0)
 ;
"RTN","BSDXUT1",75,0)
 ; Test 6: for Cancelling walkin and checked-in appointments 
"RTN","BSDXUT1",76,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",77,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",78,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",79,0)
 S DFN=4
"RTN","BSDXUT1",80,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,10,"Sam's Note",1) ; Add appt
"RTN","BSDXUT1",81,0)
 S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",82,0)
 I APPID=0 W "Error in test 6",!
"RTN","BSDXUT1",83,0)
 D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; check-in
"RTN","BSDXUT1",84,0)
 D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; Delete appt
"RTN","BSDXUT1",85,0)
 I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",!
"RTN","BSDXUT1",86,0)
 ;
"RTN","BSDXUT1",87,0)
 ; Test 7: for cancelling walkin and checked-in appointments
"RTN","BSDXUT1",88,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",89,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",90,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",91,0)
 S DFN=4
"RTN","BSDXUT1",92,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,10,"Sam's Note",1) ; Add appt
"RTN","BSDXUT1",93,0)
 S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",94,0)
 I APPID=0 W "Error in test 6",!
"RTN","BSDXUT1",95,0)
 D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; Checkin
"RTN","BSDXUT1",96,0)
 S BSDXRESULT=$$RMCI^BSDXAPI1(DFN,HLIEN,APPTTIME) ; remove checkin
"RTN","BSDXUT1",97,0)
 D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; delete appt
"RTN","BSDXUT1",98,0)
 I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",!
"RTN","BSDXUT1",99,0)
 ;
"RTN","BSDXUT1",100,0)
 ; Unlinked Clinic Tests
"RTN","BSDXUT1",101,0)
 N RESNAM S RESNAM="UTCLINICUL" ; Unlinked Clinic
"RTN","BSDXUT1",102,0)
 N RESIEN
"RTN","BSDXUT1",103,0)
 D
"RTN","BSDXUT1",104,0)
 . N $ET S $ET="D ^%ZTER B"
"RTN","BSDXUT1",105,0)
 . S RESIEN=$$UTCRRES^BSDXUT(RESNAM)
"RTN","BSDXUT1",106,0)
 . I RESIEN<0 S $EC=",U1," ; not supposed to happen - hard crash if so
"RTN","BSDXUT1",107,0)
 ;
"RTN","BSDXUT1",108,0)
 ; Get start and end times
"RTN","BSDXUT1",109,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",110,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",111,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",112,0)
 ;
"RTN","BSDXUT1",113,0)
 ; Test 1: Make normal appointment and cancel it. See if every thing works
"RTN","BSDXUT1",114,0)
 N ZZZ,DFN
"RTN","BSDXUT1",115,0)
 S DFN=3
"RTN","BSDXUT1",116,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT1",117,0)
 S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",118,0)
 D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
"RTN","BSDXUT1",119,0)
 I $P(^BSDXAPPT(APPID,0),U,12)'>0 W "Error in Cancellation-1"
"RTN","BSDXUT1",120,0)
 ;
"RTN","BSDXUT1",121,0)
 ; Test 6: for Cancelling walkin and checked-in appointments 
"RTN","BSDXUT1",122,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",123,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",124,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",125,0)
 S DFN=4
"RTN","BSDXUT1",126,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,10,"Sam's Note",1) ; Add appt
"RTN","BSDXUT1",127,0)
 S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",128,0)
 I APPID=0 W "Error in test 6",!
"RTN","BSDXUT1",129,0)
 D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; check-in
"RTN","BSDXUT1",130,0)
 D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; Delete appt
"RTN","BSDXUT1",131,0)
 I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",!
"RTN","BSDXUT1",132,0)
 ;
"RTN","BSDXUT1",133,0)
 ; Test 7: for cancelling walkin and checked-in appointments
"RTN","BSDXUT1",134,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",135,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",136,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",137,0)
 S DFN=5
"RTN","BSDXUT1",138,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,10,"Sam's Note",1) ; Add appt
"RTN","BSDXUT1",139,0)
 S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",140,0)
 I APPID=0 W "Error in test 6",!
"RTN","BSDXUT1",141,0)
 D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; Checkin
"RTN","BSDXUT1",142,0)
 S BSDXRESULT=$$RMCI^BSDXAPI1(DFN,HLIEN,APPTTIME) ; remove checkin
"RTN","BSDXUT1",143,0)
 D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; delete appt
"RTN","BSDXUT1",144,0)
 I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",!
"RTN","BSDXUT1",145,0)
 QUIT
"RTN","BSDXUT1",146,0)
 ;
"RTN","BSDXUT1",147,0)
UT29 ; Unit Test for BSDX29
"RTN","BSDXUT1",148,0)
 ; HLs/Resources are created as part of the UT
"RTN","BSDXUT1",149,0)
 ; Patients 1,2,3,4,5 must exist
"RTN","BSDXUT1",150,0)
 ;
"RTN","BSDXUT1",151,0)
 I '$$TM^%ZTLOAD() W "Cannot test. Taskman is not running!" QUIT
"RTN","BSDXUT1",152,0)
 ;
"RTN","BSDXUT1",153,0)
 ; Set-up - Create Clinics
"RTN","BSDXUT1",154,0)
 N RESNAM S RESNAM="UTCLINIC"
"RTN","BSDXUT1",155,0)
 N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
"RTN","BSDXUT1",156,0)
 D
"RTN","BSDXUT1",157,0)
 . N $ET S $ET="D ^%ZTER B"
"RTN","BSDXUT1",158,0)
 . S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
"RTN","BSDXUT1",159,0)
 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
"RTN","BSDXUT1",160,0)
 ;
"RTN","BSDXUT1",161,0)
 N HLIEN,RESIEN
"RTN","BSDXUT1",162,0)
 S HLIEN=$P(HLRESIENS,U)
"RTN","BSDXUT1",163,0)
 S RESIEN=$P(HLRESIENS,U,2)
"RTN","BSDXUT1",164,0)
 ;
"RTN","BSDXUT1",165,0)
 ; Turn off SDAM APPT PROTOCOL BSDX Entries
"RTN","BSDXUT1",166,0)
 N BSDXNOEV
"RTN","BSDXUT1",167,0)
 S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
"RTN","BSDXUT1",168,0)
 ;
"RTN","BSDXUT1",169,0)
 ; Create a bunch of appointments in PIMS (25 actually)
"RTN","BSDXUT1",170,0)
 N DFN
"RTN","BSDXUT1",171,0)
 N BSDXAPPT,BSDXDATE
"RTN","BSDXUT1",172,0)
 N BSDXI
"RTN","BSDXUT1",173,0)
 F BSDXI=1:1:5 D
"RTN","BSDXUT1",174,0)
 . N APPTTIME S APPTTIME=$$TIMEHL^BSDXUT(HLIEN) ; appt time
"RTN","BSDXUT1",175,0)
 . F DFN=1,2,3,4,5 D
"RTN","BSDXUT1",176,0)
 . . N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
"RTN","BSDXUT1",177,0)
 . . I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
"RTN","BSDXUT1",178,0)
 . . E  S BSDXAPPT(DFN,APPTTIME)="",BSDXDATE(APPTTIME)=""
"RTN","BSDXUT1",179,0)
 ;
"RTN","BSDXUT1",180,0)
 ; Check that appointments are not in ^BSDXAPPT
"RTN","BSDXUT1",181,0)
 N DFN,APPTTIME S (DFN,APPTTIME)=""
"RTN","BSDXUT1",182,0)
 F  S DFN=$O(BSDXAPPT(DFN)) Q:'DFN  D
"RTN","BSDXUT1",183,0)
 . F  S APPTTIME=$O(BSDXAPPT(DFN,APPTTIME)) Q:'APPTTIME  D
"RTN","BSDXUT1",184,0)
 . . I $D(^BSDXAPPT("APAT",DFN,APPTTIME)) W "Appt for "_DFN_" @ "_APPTTIME_" present",!
"RTN","BSDXUT1",185,0)
 ;
"RTN","BSDXUT1",186,0)
 ; Now, copy those appointments using BSDX29 to ^BSDXAPPT
"RTN","BSDXUT1",187,0)
 N FIRSTDATE S FIRSTDATE=$O(BSDXDATE(""))
"RTN","BSDXUT1",188,0)
 N LASTDATE S LASTDATE=$O(BSDXDATE(""),-1)
"RTN","BSDXUT1",189,0)
 N ZZZ ; garbage
"RTN","BSDXUT1",190,0)
 D BSDXCP^BSDX29(.ZZZ,RESIEN,HLIEN,FIRSTDATE,LASTDATE)
"RTN","BSDXUT1",191,0)
 I +^BSDXTMP($J,1)=0 W "Error... task not created",! QUIT
"RTN","BSDXUT1",192,0)
 ;
"RTN","BSDXUT1",193,0)
 W "Waiting for 5 seconds for taskman to finish",! HANG 5
"RTN","BSDXUT1",194,0)
 N DFN,APPTTIME S (DFN,APPTTIME)=""
"RTN","BSDXUT1",195,0)
 F  S DFN=$O(BSDXAPPT(DFN)) Q:'DFN  D
"RTN","BSDXUT1",196,0)
 . F  S APPTTIME=$O(BSDXAPPT(DFN,APPTTIME)) Q:'APPTTIME  D
"RTN","BSDXUT1",197,0)
 . . I '$D(^BSDXAPPT("APAT",DFN,APPTTIME)) W "Appt for "_DFN_" @ "_APPTTIME_" missing",!
"RTN","BSDXUT1",198,0)
 ;
"RTN","BSDXUT1",199,0)
 ; Do all of this again making sure that events execute.
"RTN","BSDXUT1",200,0)
 K BSDXNOEV
"RTN","BSDXUT1",201,0)
 ;
"RTN","BSDXUT1",202,0)
 ; Create a bunch of appointments in PIMS (25 actually)
"RTN","BSDXUT1",203,0)
 N DFN
"RTN","BSDXUT1",204,0)
 N BSDXAPPT,BSDXDATE
"RTN","BSDXUT1",205,0)
 N BSDXI
"RTN","BSDXUT1",206,0)
 F BSDXI=1:1:5 D
"RTN","BSDXUT1",207,0)
 . N APPTTIME S APPTTIME=$$TIMEHL^BSDXUT(HLIEN) ; appt time
"RTN","BSDXUT1",208,0)
 . F DFN=1,2,3,4,5 D
"RTN","BSDXUT1",209,0)
 . . N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
"RTN","BSDXUT1",210,0)
 . . I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
"RTN","BSDXUT1",211,0)
 . . E  S BSDXAPPT(DFN,APPTTIME)="",BSDXDATE(APPTTIME)=""
"RTN","BSDXUT1",212,0)
 ;
"RTN","BSDXUT1",213,0)
 ; Check that appointments are in ^BSDXAPPT (different from last time)
"RTN","BSDXUT1",214,0)
 N DFN,APPTTIME S (DFN,APPTTIME)=""
"RTN","BSDXUT1",215,0)
 F  S DFN=$O(BSDXAPPT(DFN)) Q:'DFN  D
"RTN","BSDXUT1",216,0)
 . F  S APPTTIME=$O(BSDXAPPT(DFN,APPTTIME)) Q:'APPTTIME  D
"RTN","BSDXUT1",217,0)
 . . I '$D(^BSDXAPPT("APAT",DFN,APPTTIME)) W "Appt for "_DFN_" @ "_APPTTIME_" present",!
"RTN","BSDXUT1",218,0)
 ;
"RTN","BSDXUT1",219,0)
 ; Now, copy those appointments using BSDX29 to ^BSDXAPPT
"RTN","BSDXUT1",220,0)
 N FIRSTDATE S FIRSTDATE=$O(BSDXDATE(""))
"RTN","BSDXUT1",221,0)
 N LASTDATE S LASTDATE=$O(BSDXDATE(""),-1)
"RTN","BSDXUT1",222,0)
 N ZZZ ; garbage
"RTN","BSDXUT1",223,0)
 D BSDXCP^BSDX29(.ZZZ,RESIEN,HLIEN,FIRSTDATE,LASTDATE)
"RTN","BSDXUT1",224,0)
 I +^BSDXTMP($J,1)=0 W "Error... task not created",! QUIT
"RTN","BSDXUT1",225,0)
 ;
"RTN","BSDXUT1",226,0)
 W "Waiting for 5 seconds for taskman to finish",! HANG 5
"RTN","BSDXUT1",227,0)
 W:^BSDXTMP("BSDXCOPY",+^BSDXTMP($J,1))'["  0 records" "Copy failed",!
"RTN","BSDXUT1",228,0)
 QUIT
"RTN","BSDXUT1",229,0)
 ;
"RTN","BSDXUT1",230,0)
UT26 ; Unit Tests - BSDX26
"RTN","BSDXUT1",231,0)
 ;
"RTN","BSDXUT1",232,0)
 ; Test 1: Make sure this damn thing works
"RTN","BSDXUT1",233,0)
 ; Set-up - Create Clinics
"RTN","BSDXUT1",234,0)
 N RESNAM S RESNAM="UTCLINIC"
"RTN","BSDXUT1",235,0)
 N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
"RTN","BSDXUT1",236,0)
 D
"RTN","BSDXUT1",237,0)
 . N $ET S $ET="D ^%ZTER B"
"RTN","BSDXUT1",238,0)
 . S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
"RTN","BSDXUT1",239,0)
 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
"RTN","BSDXUT1",240,0)
 ;
"RTN","BSDXUT1",241,0)
 N HLIEN,RESIEN
"RTN","BSDXUT1",242,0)
 S HLIEN=$P(HLRESIENS,U)
"RTN","BSDXUT1",243,0)
 S RESIEN=$P(HLRESIENS,U,2)
"RTN","BSDXUT1",244,0)
 ;
"RTN","BSDXUT1",245,0)
 ; Get start and end times
"RTN","BSDXUT1",246,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",247,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",248,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",249,0)
 ;
"RTN","BSDXUT1",250,0)
 ; Make appt
"RTN","BSDXUT1",251,0)
 N ZZZ,DFN
"RTN","BSDXUT1",252,0)
 S DFN=3
"RTN","BSDXUT1",253,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT1",254,0)
 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",255,0)
 ;
"RTN","BSDXUT1",256,0)
 ; Now edit the note - basic test
"RTN","BSDXUT1",257,0)
 N %H S %H=$H
"RTN","BSDXUT1",258,0)
 N NOTE S NOTE="New Note "_%H
"RTN","BSDXUT1",259,0)
 D EDITAPT^BSDX26(.ZZZ,APPID,NOTE)
"RTN","BSDXUT1",260,0)
 I ^BSDXAPPT(APPID,1,1,0)'=NOTE W "ERROR 1",!
"RTN","BSDXUT1",261,0)
 I $P(^SC(HLIEN,"S",APPTTIME,1,1,0),U,4)'=NOTE W "Error in HL Section",!
"RTN","BSDXUT1",262,0)
 ;
"RTN","BSDXUT1",263,0)
 ; Test 2: Test Error -1
"RTN","BSDXUT1",264,0)
 ; -1 --> ApptID not a number
"RTN","BSDXUT1",265,0)
 N ZZZ
"RTN","BSDXUT1",266,0)
 N NOTE S NOTE="Nothing important"
"RTN","BSDXUT1",267,0)
 D EDITAPT^BSDX26(.ZZZ,"BLAHBLAH",NOTE)
"RTN","BSDXUT1",268,0)
 I +^BSDXTMP($J,1)'=1 W "ERROR IN -1",!
"RTN","BSDXUT1",269,0)
 ;
"RTN","BSDXUT1",270,0)
 ; Test 3: Test Error -2
"RTN","BSDXUT1",271,0)
 ; -2 --> ApptID not in ^BSDXAPPT
"RTN","BSDXUT1",272,0)
 D EDITAPT^BSDX26(.ZZZ,298734322,NOTE)
"RTN","BSDXUT1",273,0)
 I +^BSDXTMP($J,1)'=2 W "ERROR IN -2",!
"RTN","BSDXUT1",274,0)
 ;
"RTN","BSDXUT1",275,0)
 ; Test 4: M Error
"RTN","BSDXUT1",276,0)
 N BSDXDIE S BSDXDIE=1
"RTN","BSDXUT1",277,0)
 D EDITAPT^BSDX26(.ZZZ,188,NOTE)
"RTN","BSDXUT1",278,0)
 I +^BSDXTMP($J,1)'=100 W "ERROR IN -100",!
"RTN","BSDXUT1",279,0)
 K BSDXDIE
"RTN","BSDXUT1",280,0)
 ; Test 5: Trestart -- retired in v1.7
"RTN","BSDXUT1",281,0)
 ;
"RTN","BSDXUT1",282,0)
 ; Test 6: UTs for an unlinked resource (not linked to PIMS)
"RTN","BSDXUT1",283,0)
 N RESNAM S RESNAM="UTCLINICUL" ; Unlinked Clinic
"RTN","BSDXUT1",284,0)
 N RESIEN
"RTN","BSDXUT1",285,0)
 D
"RTN","BSDXUT1",286,0)
 . N $ET S $ET="D ^%ZTER B"
"RTN","BSDXUT1",287,0)
 . S RESIEN=$$UTCRRES^BSDXUT(RESNAM)
"RTN","BSDXUT1",288,0)
 . I RESIEN<0 S $EC=",U1," ; not supposed to happen - hard crash if so
"RTN","BSDXUT1",289,0)
 ;
"RTN","BSDXUT1",290,0)
 ; Get start and end times
"RTN","BSDXUT1",291,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",292,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",293,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",294,0)
 ;
"RTN","BSDXUT1",295,0)
 N ZZZ,DFN
"RTN","BSDXUT1",296,0)
 S DFN=3
"RTN","BSDXUT1",297,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT1",298,0)
 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",299,0)
 ; Now edit the note - basic test
"RTN","BSDXUT1",300,0)
 N %H S %H=$H
"RTN","BSDXUT1",301,0)
 N NOTE S NOTE="New Note "_%H
"RTN","BSDXUT1",302,0)
 D EDITAPT^BSDX26(.ZZZ,APPID,NOTE)
"RTN","BSDXUT1",303,0)
 I ^BSDXAPPT(APPID,1,1,0)'=NOTE W "ERROR 2",!
"RTN","BSDXUT1",304,0)
 ;
"RTN","BSDXUT1",305,0)
 ; Test 7: Simulated failure in BSDXAPI
"RTN","BSDXUT1",306,0)
 N RESNAM S RESNAM="UTCLINIC"
"RTN","BSDXUT1",307,0)
 N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
"RTN","BSDXUT1",308,0)
 D
"RTN","BSDXUT1",309,0)
 . N $ET S $ET="D ^%ZTER B"
"RTN","BSDXUT1",310,0)
 . S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
"RTN","BSDXUT1",311,0)
 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
"RTN","BSDXUT1",312,0)
 ;
"RTN","BSDXUT1",313,0)
 N HLIEN,RESIEN
"RTN","BSDXUT1",314,0)
 S HLIEN=$P(HLRESIENS,U)
"RTN","BSDXUT1",315,0)
 S RESIEN=$P(HLRESIENS,U,2)
"RTN","BSDXUT1",316,0)
 ;
"RTN","BSDXUT1",317,0)
 ; Get start and end times
"RTN","BSDXUT1",318,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",319,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",320,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",321,0)
 ;
"RTN","BSDXUT1",322,0)
 ; Make appt
"RTN","BSDXUT1",323,0)
 N ZZZ,DFN
"RTN","BSDXUT1",324,0)
 S DFN=3
"RTN","BSDXUT1",325,0)
 N ORIGNOTE S ORIGNOTE="Sam's Note"
"RTN","BSDXUT1",326,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,ORIGNOTE,1)
"RTN","BSDXUT1",327,0)
 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",328,0)
 ;
"RTN","BSDXUT1",329,0)
 ; Create the error condition
"RTN","BSDXUT1",330,0)
 N BSDXSIMERR1 S BSDXSIMERR1=1
"RTN","BSDXUT1",331,0)
 ;
"RTN","BSDXUT1",332,0)
 ; Try to edit the note. Should still be "Sam's Note"
"RTN","BSDXUT1",333,0)
 N %H S %H=$H
"RTN","BSDXUT1",334,0)
 N NOTE S NOTE="New Note "_%H
"RTN","BSDXUT1",335,0)
 D EDITAPT^BSDX26(.ZZZ,APPID,NOTE)
"RTN","BSDXUT1",336,0)
 I +^BSDXTMP($J,1)'=4 W "Simulated error not triggered",!
"RTN","BSDXUT1",337,0)
 I ^BSDXAPPT(APPID,1,1,0)'=ORIGNOTE W "ERROR 3",!
"RTN","BSDXUT1",338,0)
 I $P(^SC(HLIEN,"S",APPTTIME,1,1,0),U,4)'=ORIGNOTE W "ERROR 4",!
"RTN","BSDXUT1",339,0)
 QUIT
"RTN","BSDXUT1",340,0)
 ;
"RTN","BSDXUT1",341,0)
UT31 ; Unit Tests for BSDX31
"RTN","BSDXUT1",342,0)
 ; Set-up - Create Clinics
"RTN","BSDXUT1",343,0)
 N RESNAM S RESNAM="UTCLINIC"
"RTN","BSDXUT1",344,0)
 N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
"RTN","BSDXUT1",345,0)
 D
"RTN","BSDXUT1",346,0)
 . N $ET S $ET="D ^%ZTER B"
"RTN","BSDXUT1",347,0)
 . S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
"RTN","BSDXUT1",348,0)
 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
"RTN","BSDXUT1",349,0)
 ;
"RTN","BSDXUT1",350,0)
 N HLIEN,RESIEN
"RTN","BSDXUT1",351,0)
 S HLIEN=$P(HLRESIENS,U)
"RTN","BSDXUT1",352,0)
 S RESIEN=$P(HLRESIENS,U,2)
"RTN","BSDXUT1",353,0)
 ;
"RTN","BSDXUT1",354,0)
 ; Get start and end times
"RTN","BSDXUT1",355,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",356,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",357,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",358,0)
 ;
"RTN","BSDXUT1",359,0)
 ; Make appt
"RTN","BSDXUT1",360,0)
 N ZZZ,DFN
"RTN","BSDXUT1",361,0)
 S DFN=3
"RTN","BSDXUT1",362,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT1",363,0)
 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",364,0)
 ; Test 1: Sanity Check
"RTN","BSDXUT1",365,0)
 D NOSHOW^BSDX31(.ZZZ,APPID,1)
"RTN","BSDXUT1",366,0)
 I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",!
"RTN","BSDXUT1",367,0)
 I $P(^DPT(DFN,"S",APPTTIME,0),U,2)'="N" W "ERROR T1",!
"RTN","BSDXUT1",368,0)
 ; Test 2: Undo NOSHOW
"RTN","BSDXUT1",369,0)
 D NOSHOW^BSDX31(.ZZZ,APPID,0)
"RTN","BSDXUT1",370,0)
 I $P(^BSDXAPPT(APPID,0),U,10)'="" W "ERROR T2",!
"RTN","BSDXUT1",371,0)
 I $P(^DPT(DFN,"S",APPTTIME,0),U,2)'="" W "ERROR T2",!
"RTN","BSDXUT1",372,0)
 ; Test 3: -1
"RTN","BSDXUT1",373,0)
 D NOSHOW^BSDX31(.ZZZ,"",0)
"RTN","BSDXUT1",374,0)
 I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",!
"RTN","BSDXUT1",375,0)
 ; Test 4: -2
"RTN","BSDXUT1",376,0)
 D NOSHOW^BSDX31(.ZZZ,2938748233,0)
"RTN","BSDXUT1",377,0)
 I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",!
"RTN","BSDXUT1",378,0)
 ; Test 5: -3
"RTN","BSDXUT1",379,0)
 D NOSHOW^BSDX31(.ZZZ,APPID,3)
"RTN","BSDXUT1",380,0)
 I $P(^BSDXTMP($J,1),U)'=-3 W "ERROR T5",!
"RTN","BSDXUT1",381,0)
 ; Test 6: Mumps error (-100)
"RTN","BSDXUT1",382,0)
 N BSDXDIE S BSDXDIE=1
"RTN","BSDXUT1",383,0)
 D NOSHOW^BSDX31(.ZZZ,APPID,1)
"RTN","BSDXUT1",384,0)
 I $P(^BSDXTMP($J,1),U)'=-100 W "ERROR T6",!
"RTN","BSDXUT1",385,0)
 K BSDXDIE
"RTN","BSDXUT1",386,0)
 ;
"RTN","BSDXUT1",387,0)
 ; Test 9
"RTN","BSDXUT1",388,0)
 ; Error Simulations
"RTN","BSDXUT1",389,0)
 ; Get start and end times
"RTN","BSDXUT1",390,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",391,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",392,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",393,0)
 ;
"RTN","BSDXUT1",394,0)
 ; This tests if we fail without filing anything
"RTN","BSDXUT1",395,0)
 N ZZZ,DFN
"RTN","BSDXUT1",396,0)
 S DFN=3
"RTN","BSDXUT1",397,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT1",398,0)
 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",399,0)
 N BSDXSIMERR1 S BSDXSIMERR1=1
"RTN","BSDXUT1",400,0)
 D NOSHOW^BSDX31(.ZZZ,APPID,1)
"RTN","BSDXUT1",401,0)
 I $P(^BSDXTMP($J,1),U)'=-4 W "ERROR T9.1",!
"RTN","BSDXUT1",402,0)
 I $P(^BSDXAPPT(APPID,0),U,10)'="" W "ERROR T9.2",!
"RTN","BSDXUT1",403,0)
 I $P(^DPT(DFN,"S",APPTTIME,0),U,2)'="" W "ERROR T9.3",!
"RTN","BSDXUT1",404,0)
 K BSDXSIMERR1
"RTN","BSDXUT1",405,0)
 ;
"RTN","BSDXUT1",406,0)
 ; This tests if we fail inside BSDXAPI and have to rollback ^BSDXAPPT
"RTN","BSDXUT1",407,0)
 N BSDXSIMERR2 S BSDXSIMERR2=1
"RTN","BSDXUT1",408,0)
 D NOSHOW^BSDX31(.ZZZ,APPID,1)
"RTN","BSDXUT1",409,0)
 I $P(^BSDXTMP($J,1),U)'=-5 W "ERROR T9.4",!
"RTN","BSDXUT1",410,0)
 I $P(^BSDXAPPT(APPID,0),U,10)'="" W "ERROR T9.5",!
"RTN","BSDXUT1",411,0)
 I $P(^DPT(DFN,"S",APPTTIME,0),U,2)'="" W "ERROR T9.6",!
"RTN","BSDXUT1",412,0)
 K BSDXSIMERR2
"RTN","BSDXUT1",413,0)
 ;
"RTN","BSDXUT1",414,0)
 ; This test a mumps error in BSDXAPI
"RTN","BSDXUT1",415,0)
 N BSDXSIMERR3 S BSDXSIMERR3=1
"RTN","BSDXUT1",416,0)
 D NOSHOW^BSDX31(.ZZZ,APPID,1)
"RTN","BSDXUT1",417,0)
 I +$P(^BSDXTMP($J,1),U)'=-100 W "ERROR T9.7",!
"RTN","BSDXUT1",418,0)
 I $P(^BSDXAPPT(APPID,0),U,10)'="" W "ERROR T9.8",!
"RTN","BSDXUT1",419,0)
 K BSDXSIMERR3
"RTN","BSDXUT1",420,0)
 ;
"RTN","BSDXUT1",421,0)
 ; Test 7: Restartable transaction ; Retired
"RTN","BSDXUT1",422,0)
 ;
"RTN","BSDXUT1",423,0)
 ; Test 8: UTs for an unlinked resource (not linked to PIMS)
"RTN","BSDXUT1",424,0)
 N RESNAM S RESNAM="UTCLINICUL" ; Unlinked Clinic
"RTN","BSDXUT1",425,0)
 N RESIEN
"RTN","BSDXUT1",426,0)
 D
"RTN","BSDXUT1",427,0)
 . N $ET S $ET="D ^%ZTER B"
"RTN","BSDXUT1",428,0)
 . S RESIEN=$$UTCRRES^BSDXUT(RESNAM)
"RTN","BSDXUT1",429,0)
 . I RESIEN<0 S $EC=",U1," ; not supposed to happen - hard crash if so
"RTN","BSDXUT1",430,0)
 ;
"RTN","BSDXUT1",431,0)
 ; Get start and end times
"RTN","BSDXUT1",432,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT1",433,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT1",434,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT1",435,0)
 ;
"RTN","BSDXUT1",436,0)
 ; Make appt
"RTN","BSDXUT1",437,0)
 N ZZZ,DFN
"RTN","BSDXUT1",438,0)
 S DFN=3
"RTN","BSDXUT1",439,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT1",440,0)
 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
"RTN","BSDXUT1",441,0)
 ; Test 1: Sanity Check
"RTN","BSDXUT1",442,0)
 D NOSHOW^BSDX31(.ZZZ,APPID,1)
"RTN","BSDXUT1",443,0)
 I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T8.1",!
"RTN","BSDXUT1",444,0)
 ; Test 2: Undo NOSHOW
"RTN","BSDXUT1",445,0)
 D NOSHOW^BSDX31(.ZZZ,APPID,0)
"RTN","BSDXUT1",446,0)
 I $P(^BSDXAPPT(APPID,0),U,10)'="" W "ERROR T8.2",!
"RTN","BSDXUT1",447,0)
 ; Test 3: Put it back on...
"RTN","BSDXUT1",448,0)
 D NOSHOW^BSDX31(.ZZZ,APPID,1)
"RTN","BSDXUT1",449,0)
 I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T8.3",!
"RTN","BSDXUT1",450,0)
 ;
"RTN","BSDXUT1",451,0)
 ;
"RTN","BSDXUT1",452,0)
 QUIT
"RTN","BSDXUT2")
0^40^B91305617
"RTN","BSDXUT2",1,0)
BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 3:18pm
"RTN","BSDXUT2",2,0)
 ;;1.7;BSDX;;Jun 01, 2013;Build 25
"RTN","BSDXUT2",3,0)
 ;
"RTN","BSDXUT2",4,0)
EN ; Run all unit tests in this routine
"RTN","BSDXUT2",5,0)
 D UT25,PIMS
"RTN","BSDXUT2",6,0)
 QUIT
"RTN","BSDXUT2",7,0)
 ;
"RTN","BSDXUT2",8,0)
UT25 ; Unit Tests for BSDX25
"RTN","BSDXUT2",9,0)
 ; Make appointment, checkin, then uncheckin
"RTN","BSDXUT2",10,0)
 N $ET S $ET="W ""An Error Occured. Breaking."",! BREAK"
"RTN","BSDXUT2",11,0)
 N RESNAM S RESNAM="UTCLINIC"
"RTN","BSDXUT2",12,0)
 N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
"RTN","BSDXUT2",13,0)
 D
"RTN","BSDXUT2",14,0)
 . N $ET S $ET="D ^%ZTER B"
"RTN","BSDXUT2",15,0)
 . S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
"RTN","BSDXUT2",16,0)
 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
"RTN","BSDXUT2",17,0)
 ;
"RTN","BSDXUT2",18,0)
 N HLIEN,RESIEN
"RTN","BSDXUT2",19,0)
 S HLIEN=$P(HLRESIENS,U)
"RTN","BSDXUT2",20,0)
 S RESIEN=$P(HLRESIENS,U,2)
"RTN","BSDXUT2",21,0)
 ;
"RTN","BSDXUT2",22,0)
 ; Get start and end times
"RTN","BSDXUT2",23,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT2",24,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT2",25,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT2",26,0)
 ;
"RTN","BSDXUT2",27,0)
 ; Test 1: Make normal appointment and cancel it. See if every thing works
"RTN","BSDXUT2",28,0)
 N ZZZ,DFN
"RTN","BSDXUT2",29,0)
 S DFN=5
"RTN","BSDXUT2",30,0)
 N ZZZ
"RTN","BSDXUT2",31,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT2",32,0)
 N APPTID S APPTID=+^BSDXTMP($J,1)
"RTN","BSDXUT2",33,0)
 N HL S HL=$$GET1^DIQ(9002018.4,APPTID,".07:.04","I")
"RTN","BSDXUT2",34,0)
 D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT())
"RTN","BSDXUT2",35,0)
 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 1",!
"RTN","BSDXUT2",36,0)
 IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 2",!
"RTN","BSDXUT2",37,0)
 D RMCI^BSDX25(.ZZZ,APPTID)
"RTN","BSDXUT2",38,0)
 IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 1",!
"RTN","BSDXUT2",39,0)
 IF $G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 2",!
"RTN","BSDXUT2",40,0)
 D RMCI^BSDX25(.ZZZ,APPTID)  ; again, test sanity in repeat
"RTN","BSDXUT2",41,0)
 IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 1",!
"RTN","BSDXUT2",42,0)
 IF $G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 2",!
"RTN","BSDXUT2",43,0)
 ; now test various error conditions
"RTN","BSDXUT2",44,0)
 ; Test Error 1
"RTN","BSDXUT2",45,0)
 D RMCI^BSDX25(.ZZZ,)
"RTN","BSDXUT2",46,0)
 IF +^BSDXTMP($J,1)'=-1 WRITE "ERROR IN ETest 1",!
"RTN","BSDXUT2",47,0)
 ; Test Error 2
"RTN","BSDXUT2",48,0)
 D RMCI^BSDX25(.ZZZ,234987234398)
"RTN","BSDXUT2",49,0)
 IF +^BSDXTMP($J,1)'=-2 WRITE "ERROR IN Etest 2",!
"RTN","BSDXUT2",50,0)
 ; Tests for 3 to 5 difficult to produce
"RTN","BSDXUT2",51,0)
 ; Error tests follow: Mumps error test;
"RTN","BSDXUT2",52,0)
 ; Error in RMCI
"RTN","BSDXUT2",53,0)
 N BSDXDIE S BSDXDIE=1
"RTN","BSDXUT2",54,0)
 D RMCI^BSDX25(.ZZZ,APPTID)
"RTN","BSDXUT2",55,0)
 IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 3",!
"RTN","BSDXUT2",56,0)
 K BSDXDIE
"RTN","BSDXUT2",57,0)
 ; M Error in CHECKIN
"RTN","BSDXUT2",58,0)
 N BSDXDIE S BSDXDIE=1
"RTN","BSDXUT2",59,0)
 D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT())
"RTN","BSDXUT2",60,0)
 IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 8",!
"RTN","BSDXUT2",61,0)
 K BSDXDIE
"RTN","BSDXUT2",62,0)
 ; M Error in $$CHECKIN^BSDXAPI
"RTN","BSDXUT2",63,0)
 N BSDXDIE2 S BSDXDIE2=1
"RTN","BSDXUT2",64,0)
 D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT())
"RTN","BSDXUT2",65,0)
 IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 9",!
"RTN","BSDXUT2",66,0)
 K BSDXDIE2
"RTN","BSDXUT2",67,0)
 ; M Error in $$RMCI^BSDXAPI1
"RTN","BSDXUT2",68,0)
 N BSDXDIE2 S BSDXDIE2=1
"RTN","BSDXUT2",69,0)
 D RMCI^BSDX25(.ZZZ,APPTID)
"RTN","BSDXUT2",70,0)
 IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 13",!
"RTN","BSDXUT2",71,0)
 K BSDXDIE2
"RTN","BSDXUT2",72,0)
 ;
"RTN","BSDXUT2",73,0)
 ; Get start and end times
"RTN","BSDXUT2",74,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT2",75,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT2",76,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT2",77,0)
 ;
"RTN","BSDXUT2",78,0)
 N ZZZ,DFN
"RTN","BSDXUT2",79,0)
 S DFN=5
"RTN","BSDXUT2",80,0)
 N ZZZ
"RTN","BSDXUT2",81,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT2",82,0)
 N APPTID S APPTID=+^BSDXTMP($J,1)
"RTN","BSDXUT2",83,0)
 N HL S HL=$$GET1^DIQ(9002018.4,APPTID,".07:.04","I")
"RTN","BSDXUT2",84,0)
 ;
"RTN","BSDXUT2",85,0)
 ; Simulated Error in $$BSDXCHK^BSDX25
"RTN","BSDXUT2",86,0)
 N BSDXSIMERR1 S BSDXSIMERR1=1
"RTN","BSDXUT2",87,0)
 D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT())
"RTN","BSDXUT2",88,0)
 IF +^BSDXTMP($J,1)'=-3 WRITE "ERROR in Etest 10",!
"RTN","BSDXUT2",89,0)
 IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 111",!
"RTN","BSDXUT2",90,0)
 IF +$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 112",!
"RTN","BSDXUT2",91,0)
 K BSDXSIMERR1
"RTN","BSDXUT2",92,0)
 ;
"RTN","BSDXUT2",93,0)
 ; Simulated Error in $$CHECKICK^BSDXAPI
"RTN","BSDXUT2",94,0)
 N BSDXSIMERR2 S BSDXSIMERR2=1
"RTN","BSDXUT2",95,0)
 D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT())
"RTN","BSDXUT2",96,0)
 IF +^BSDXTMP($J,1)'=-10 WRITE "ERROR in Etest 11",!
"RTN","BSDXUT2",97,0)
 IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 113",!
"RTN","BSDXUT2",98,0)
 IF +$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 114",!
"RTN","BSDXUT2",99,0)
 K BSDXSIMERR2
"RTN","BSDXUT2",100,0)
 ;
"RTN","BSDXUT2",101,0)
 ; Simulated Error in $$CHECKIN^BSDXAPI
"RTN","BSDXUT2",102,0)
 N BSDXSIMERR3 S BSDXSIMERR3=1
"RTN","BSDXUT2",103,0)
 D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT())
"RTN","BSDXUT2",104,0)
 IF +^BSDXTMP($J,1)'=-10 WRITE "ERROR in Etest 11",!
"RTN","BSDXUT2",105,0)
 IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 115",!
"RTN","BSDXUT2",106,0)
 IF +$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 116",!
"RTN","BSDXUT2",107,0)
 K BSDXSIMERR3
"RTN","BSDXUT2",108,0)
 ;
"RTN","BSDXUT2",109,0)
 ; Check-in for real for the subsequent tests
"RTN","BSDXUT2",110,0)
 D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT()) ; Check-in first!
"RTN","BSDXUT2",111,0)
 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 1110",!
"RTN","BSDXUT2",112,0)
 IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN RMCI 1120",!
"RTN","BSDXUT2",113,0)
 ;
"RTN","BSDXUT2",114,0)
 ; Simulated Error in $$BSDXCHK^BSDX25; This time for remove check-in
"RTN","BSDXUT2",115,0)
 N BSDXSIMERR1 S BSDXSIMERR1=1
"RTN","BSDXUT2",116,0)
 D RMCI^BSDX25(.ZZZ,APPTID)
"RTN","BSDXUT2",117,0)
 IF +^BSDXTMP($J,1)'=-6 WRITE "ERROR in Etest 14",!
"RTN","BSDXUT2",118,0)
 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN RMCI 111",!
"RTN","BSDXUT2",119,0)
 IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN RMCI 112",!
"RTN","BSDXUT2",120,0)
 K BSDXSIMERR1
"RTN","BSDXUT2",121,0)
 ;
"RTN","BSDXUT2",122,0)
 ; Simulated Error in $$RMCICK^BSDXAPI1
"RTN","BSDXUT2",123,0)
 N BSDXSIMERR2 S BSDXSIMERR2=1
"RTN","BSDXUT2",124,0)
 D RMCI^BSDX25(.ZZZ,APPTID)
"RTN","BSDXUT2",125,0)
 IF +^BSDXTMP($J,1)'=-5 WRITE "ERROR in Etest 15",!
"RTN","BSDXUT2",126,0)
 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN RMCI 113",!
"RTN","BSDXUT2",127,0)
 IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN RMCI 114",!
"RTN","BSDXUT2",128,0)
 K BSDXSIMERR2
"RTN","BSDXUT2",129,0)
 ;
"RTN","BSDXUT2",130,0)
 ; Simulated Error in $$RMCI^BSDXAPI1
"RTN","BSDXUT2",131,0)
 N BSDXSIMERR3 S BSDXSIMERR3=1
"RTN","BSDXUT2",132,0)
 D RMCI^BSDX25(.ZZZ,APPTID)
"RTN","BSDXUT2",133,0)
 IF +^BSDXTMP($J,1)'=-5 WRITE "ERROR in Etest 16",!
"RTN","BSDXUT2",134,0)
 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN RMCI 115",!
"RTN","BSDXUT2",135,0)
 IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN RMCI 116",!
"RTN","BSDXUT2",136,0)
 K BSDXSIMERR3
"RTN","BSDXUT2",137,0)
 ;
"RTN","BSDXUT2",138,0)
 ; Unlinked Clinic Tests
"RTN","BSDXUT2",139,0)
 N RESNAM S RESNAM="UTCLINICUL" ; Unlinked Clinic
"RTN","BSDXUT2",140,0)
 N RESIEN
"RTN","BSDXUT2",141,0)
 D
"RTN","BSDXUT2",142,0)
 . N $ET S $ET="D ^%ZTER B"
"RTN","BSDXUT2",143,0)
 . S RESIEN=$$UTCRRES^BSDXUT(RESNAM)
"RTN","BSDXUT2",144,0)
 . I RESIEN<0 S $EC=",U1," ; not supposed to happen - hard crash if so
"RTN","BSDXUT2",145,0)
 ;
"RTN","BSDXUT2",146,0)
 ; Get start and end times
"RTN","BSDXUT2",147,0)
 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
"RTN","BSDXUT2",148,0)
 N APPTTIME S APPTTIME=$P(TIMES,U)
"RTN","BSDXUT2",149,0)
 N ENDTIME S ENDTIME=$P(TIMES,U,2)
"RTN","BSDXUT2",150,0)
 ;
"RTN","BSDXUT2",151,0)
 N ZZZ,DFN
"RTN","BSDXUT2",152,0)
 S DFN=4
"RTN","BSDXUT2",153,0)
 N ZZZ
"RTN","BSDXUT2",154,0)
 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
"RTN","BSDXUT2",155,0)
 N APPTID S APPTID=+^BSDXTMP($J,1)
"RTN","BSDXUT2",156,0)
 N HL S HL=$$GET1^DIQ(9002018.4,APPTID,".07:.04","I")
"RTN","BSDXUT2",157,0)
 I HL'="" W "Error. Hospital Location Exists",!
"RTN","BSDXUT2",158,0)
 ;
"RTN","BSDXUT2",159,0)
 D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT())
"RTN","BSDXUT2",160,0)
 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 3",!
"RTN","BSDXUT2",161,0)
 ;test
"RTN","BSDXUT2",162,0)
 D RMCI^BSDX25(.ZZZ,APPTID)
"RTN","BSDXUT2",163,0)
 IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 3",!
"RTN","BSDXUT2",164,0)
 D RMCI^BSDX25(.ZZZ,APPTID)  ; again, test sanity in repeat
"RTN","BSDXUT2",165,0)
 IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 3",!
"RTN","BSDXUT2",166,0)
 ; now test various error conditions
"RTN","BSDXUT2",167,0)
 ; Test Error 1
"RTN","BSDXUT2",168,0)
 D RMCI^BSDX25(.ZZZ,)
"RTN","BSDXUT2",169,0)
 IF +^BSDXTMP($J,1)'=-1 WRITE "ERROR IN ETest 5",!
"RTN","BSDXUT2",170,0)
 ; Test Error 2
"RTN","BSDXUT2",171,0)
 D RMCI^BSDX25(.ZZZ,234987234398)
"RTN","BSDXUT2",172,0)
 IF +^BSDXTMP($J,1)'=-2 WRITE "ERROR IN Etest 6",!
"RTN","BSDXUT2",173,0)
 ; Tests for 3 to 5 difficult to produce
"RTN","BSDXUT2",174,0)
 ; Error tests follow: Mumps error test; Transaction restartability
"RTN","BSDXUT2",175,0)
 N BSDXDIE S BSDXDIE=1
"RTN","BSDXUT2",176,0)
 D RMCI^BSDX25(.ZZZ,APPTID)
"RTN","BSDXUT2",177,0)
 IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 7",!
"RTN","BSDXUT2",178,0)
 K BSDXDIE
"RTN","BSDXUT2",179,0)
 QUIT
"RTN","BSDXUT2",180,0)
 ;
"RTN","BSDXUT2",181,0)
PIMS ; Tests for running PIMS by itself.
"RTN","BSDXUT2",182,0)
 N $ET S $ET="W ""An Error Occured. Breaking."",! BREAK"
"RTN","BSDXUT2",183,0)
 N RESNAM S RESNAM="UTCLINIC"
"RTN","BSDXUT2",184,0)
 N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
"RTN","BSDXUT2",185,0)
 D
"RTN","BSDXUT2",186,0)
 . N $ET S $ET="D ^%ZTER B"
"RTN","BSDXUT2",187,0)
 . S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
"RTN","BSDXUT2",188,0)
 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
"RTN","BSDXUT2",189,0)
 ;
"RTN","BSDXUT2",190,0)
 N HLIEN,RESIEN
"RTN","BSDXUT2",191,0)
 S HLIEN=$P(HLRESIENS,U)
"RTN","BSDXUT2",192,0)
 S RESIEN=$P(HLRESIENS,U,2)
"RTN","BSDXUT2",193,0)
 ;
"RTN","BSDXUT2",194,0)
 ;
"RTN","BSDXUT2",195,0)
 N APPTTIME S APPTTIME=$$TIMEHL^BSDXUT(HLIEN) ; appt time
"RTN","BSDXUT2",196,0)
 N DFN S DFN=2
"RTN","BSDXUT2",197,0)
 ;
"RTN","BSDXUT2",198,0)
 ; TEST $$MAKE1^BSDXAPI
"RTN","BSDXUT2",199,0)
 N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
"RTN","BSDXUT2",200,0)
 I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
"RTN","BSDXUT2",201,0)
 I '$D(^BSDXAPPT("APAT",DFN,APPTTIME)) W "No BSDX Appointment Created",!
"RTN","BSDXUT2",202,0)
 N RESID S RESID=$O(^(APPTTIME,""))
"RTN","BSDXUT2",203,0)
 N APPTID S APPTID=$O(^(RESID,""))
"RTN","BSDXUT2",204,0)
 I 'APPTID W "Can't get appointment",!
"RTN","BSDXUT2",205,0)
 IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 3",!
"RTN","BSDXUT2",206,0)
 ;
"RTN","BSDXUT2",207,0)
 ; TEST CHECKIN1 AND RMCI ^BSDXAPI[1]
"RTN","BSDXUT2",208,0)
 N % S %=$$CHECKIN1^BSDXAPI(DFN,HLIEN,APPTTIME) ; Checkin via PIMS
"RTN","BSDXUT2",209,0)
 I % W "Error in Checking in via BSDXAPI",!
"RTN","BSDXUT2",210,0)
 IF '+$G(^SC(HLIEN,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 10",!
"RTN","BSDXUT2",211,0)
 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 11",!
"RTN","BSDXUT2",212,0)
 N % S %=$$RMCI^BSDXAPI1(DFN,HLIEN,APPTTIME)
"RTN","BSDXUT2",213,0)
 I % W "Error removing Check-in via PIMS",!
"RTN","BSDXUT2",214,0)
 I +$G(^SC(HLIEN,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 12",!
"RTN","BSDXUT2",215,0)
 IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 13",!
"RTN","BSDXUT2",216,0)
 N % S %=$$CHECKIN1^BSDXAPI(DFN,HLIEN,APPTTIME) ; Checkin via PIMS again
"RTN","BSDXUT2",217,0)
 I % W "Error in Checking in via BSDXAPI",!
"RTN","BSDXUT2",218,0)
 IF '+$G(^SC(HLIEN,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 14",!
"RTN","BSDXUT2",219,0)
 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 15",!
"RTN","BSDXUT2",220,0)
 ;
"RTN","BSDXUT2",221,0)
 ; TEST CANCEL1^BSDXAPI
"RTN","BSDXUT2",222,0)
 N APPTTIME S APPTTIME=$$TIMEHL^BSDXUT(HLIEN) ; appt time
"RTN","BSDXUT2",223,0)
 N DFN S DFN=2
"RTN","BSDXUT2",224,0)
 N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
"RTN","BSDXUT2",225,0)
 I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
"RTN","BSDXUT2",226,0)
 I '$D(^BSDXAPPT("APAT",DFN,APPTTIME)) W "No BSDX Appointment Created",!
"RTN","BSDXUT2",227,0)
 N RESID S RESID=$O(^(APPTTIME,""))
"RTN","BSDXUT2",228,0)
 N APPTID S APPTID=$O(^(RESID,""))
"RTN","BSDXUT2",229,0)
 I 'APPTID W "Can't get appointment",!
"RTN","BSDXUT2",230,0)
 N % S %=$$CANCEL1^BSDXAPI(DFN,HLIEN,"PC",APPTTIME,1,"Afraid of Baby Foxes")
"RTN","BSDXUT2",231,0)
 I % W "Error cancelling via $$CANCEL1^BSDXAPI",!
"RTN","BSDXUT2",232,0)
 I ^BSDXAPPT(APPTID,0) ; Change $R
"RTN","BSDXUT2",233,0)
 I '$P(^(0),U,12) W "No cancel date found in BSDXAPPT",!
"RTN","BSDXUT2",234,0)
 ; Make same appointment again!
"RTN","BSDXUT2",235,0)
 ; NB: Index APAT will have two identical entries, one for the cancelled
"RTN","BSDXUT2",236,0)
 ; appointment, and one for the new one. I won't check it for that reason.
"RTN","BSDXUT2",237,0)
 N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
"RTN","BSDXUT2",238,0)
 I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
"RTN","BSDXUT2",239,0)
 ;
"RTN","BSDXUT2",240,0)
 ; TEST NOSHOW^BSDXAPI1
"RTN","BSDXUT2",241,0)
 N APPTTIME S APPTTIME=$$TIMEHL^BSDXUT(HLIEN) ; appt time
"RTN","BSDXUT2",242,0)
 N DFN S DFN=3
"RTN","BSDXUT2",243,0)
 N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
"RTN","BSDXUT2",244,0)
 I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
"RTN","BSDXUT2",245,0)
 I '$D(^BSDXAPPT("APAT",DFN,APPTTIME)) W "No BSDX Appointment Created",!
"RTN","BSDXUT2",246,0)
 N RESID S RESID=$O(^(APPTTIME,""))
"RTN","BSDXUT2",247,0)
 N APPTID S APPTID=$O(^(RESID,""))
"RTN","BSDXUT2",248,0)
 I 'APPTID W "Can't get appointment",!
"RTN","BSDXUT2",249,0)
 ; No show via PIMS
"RTN","BSDXUT2",250,0)
 N % S %=$$NOSHOW^BSDXAPI1(DFN,HLIEN,APPTTIME,1)
"RTN","BSDXUT2",251,0)
 I % W "Error no-showing via $$NOSHOW^BSDXAPI1",!
"RTN","BSDXUT2",252,0)
 I ^BSDXAPPT(APPTID,0) ; Change $R
"RTN","BSDXUT2",253,0)
 I '$P(^(0),U,10) W "No-show not present in ^BSDXAPPT",!
"RTN","BSDXUT2",254,0)
 ; un-noshow via PIMS
"RTN","BSDXUT2",255,0)
 N % S %=$$NOSHOW^BSDXAPI1(DFN,HLIEN,APPTTIME,0)
"RTN","BSDXUT2",256,0)
 I % W "Error no-showing via $$NOSHOW^BSDXAPI1",!
"RTN","BSDXUT2",257,0)
 I ^BSDXAPPT(APPTID,0) ; Change $R
"RTN","BSDXUT2",258,0)
 I $P(^(0),U,10) W "No-show present in ^BSDXAPPT when it shouldn't",!
"RTN","BSDXUT2",259,0)
 ;
"RTN","BSDXUT2",260,0)
 ; NB: UPDATENT^BSDXAPI is updates the note. Right now, we don't have any
"RTN","BSDXUT2",261,0)
 ; way to update the note from BSDXAPI back to ^BSDXAPPT as the protocol
"RTN","BSDXUT2",262,0)
 ; file is currently not involved. Right now I can't even find the code 
"RTN","BSDXUT2",263,0)
 ; that lets you change an appointment note in PIMS.
"RTN","BSDXUT2",264,0)
 ;
"RTN","BSDXUT2",265,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")
Dd
"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")
Dd
"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")
Dd
"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")
Dd
"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")
Dd
"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")
Dd
"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")
Dd
"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")
Dd
"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")
Dd
"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,"DDA")
N
"^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,"DDA")
N
"^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,"DDA")
N
"^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,"DDA")
N
"^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,"DDA")
N
"^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^15
"^DD",9002018.4,9002018.4,0,"DDA")
N
"^DD",9002018.4,9002018.4,0,"DT")
3040615
"^DD",9002018.4,9002018.4,0,"ID",.05)
S %I=Y,Y=$S('$D(^(0)):"",$D(^AUPNPAT(+$P(^(0),U,5),0))#2:$P(^(0),U,1),1:""),C=$P(^DD(9000001,.01,0),U,2) D Y^DIQ:Y]"" W "   ",Y,@("$E("_DIC_"%I,0),0)") S Y=%I K %I
"^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")
3120706
"^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")
3120706
"^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")
3120706
"^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,.14,0)
RADIOLOGY EXAM^P75.1'^RAO(75.1,^0;14^Q
"^DD",9002018.4,9002018.4,.14,21,0)
^^2^2^3110411^
"^DD",9002018.4,9002018.4,.14,21,1,0)
If this Appointment is for a Radiology Exam, this field points to the 
"^DD",9002018.4,9002018.4,.14,21,2,0)
exam for which this is the appointment.
"^DD",9002018.4,9002018.4,.14,23,0)
^^2^2^3110411^
"^DD",9002018.4,9002018.4,.14,23,1,0)
Added by Sam Habiel on April 11, 2011 to support integration of Radiology 
"^DD",9002018.4,9002018.4,.14,23,2,0)
Exams.
"^DD",9002018.4,9002018.4,.14,"DT")
3110411
"^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,"DDA")
N
"^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,9002018.1,"%",0)
^1.005^^0
"^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,9002018.15,"%",0)
^1.005^^0
"^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,9002018.2,"%",0)
^1.005^^0
"^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,9002018.3,"%",0)
^1.005^^0
"^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,9002018.35,"%",0)
^1.005^^0
"^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,9002018.38,"%",0)
^1.005^^0
"^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,9002018.39,"%",0)
^1.005^^0
"^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,9002018.4,"%",0)
^1.005^^0
"^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,9002018.5,"%",0)
^1.005^^0
"^DIC",9002018.5,"B","BSDX APPLICATION",9002018.5)

**END**
**END**