Changeset 1451 for Scheduling/trunk/m
- Timestamp:
- Jun 19, 2012, 8:19:03 PM (12 years ago)
- Location:
- Scheduling/trunk/m
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX07.m
r1450 r1451 1 BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/1 8/12 5:12pm1 BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/19/12 5:34pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL … … 28 28 APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP 29 29 ;Entry point for debugging 30 D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")31 Q 32 ; 33 UT ; Unit Tests 34 30 ; D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)") 31 Q 32 ; 33 UT ; Unit Tests - Assumes you have Patients with DFNs 1,2 and 3 34 ; Set-up - Create Clinics 35 35 N RESNAM S RESNAM="UTCLINIC" 36 37 38 36 N HLRESIENS ; holds output of UTCR^BSDX35 - HL IEN^Resource IEN 37 D 38 . N $ET S $ET="D ^%ZTER B" 39 39 . S HLRESIENS=$$UTCR^BSDX35(RESNAM) 40 41 42 43 44 45 46 47 48 49 50 51 N ZZZ 40 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen 41 ; 42 N HLIEN,RESIEN 43 S HLIEN=$P(HLRESIENS,U) 44 S RESIEN=$P(HLRESIENS,U,2) 45 ; 46 ; Get start and end times 47 N TIMES S TIMES=$$TIMES^BSDX35 ; appt time^end time 48 N APPTTIME S APPTTIME=$P(TIMES,U) 49 N ENDTIME S ENDTIME=$P(TIMES,U,2) 50 ; 51 N ZZZ,DFN 52 52 ; Test for normality: 53 D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1) 53 S DFN=3 54 D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) 54 55 ; Does Appt exist? 55 56 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 56 57 I 'APPID W "Error Making Appt-1" QUIT 57 58 I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-2" 58 I '$D(^DPT(3,"S",APPTTIME)) W "Error Making Appt-3" 59 I '$D(^SC(HLIEN,"S",APPTTIME)) W "Error Making Appt-4" 60 ; 61 ; Do it again for a different patient 62 D APPADD(.ZZZ,APPTTIME,ENDTIME,2,RESNAM,30,"Sam's Note",1) 63 N APPID S APPID=+$P(^BSDXTMP($J,1),U) B 59 I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-3" 60 I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-4" 61 ; 62 ; Do it again for a different patient 63 S DFN=2 64 D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) 65 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 64 66 I 'APPID W "Error Making Appt-5" QUIT 65 67 I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-6" 66 I '$D(^DPT(2,"S",APPTTIME)) W "Error Making Appt-7" 67 I '$D(^SC(HLIEN,"S",APPTTIME)) W "Error Making Appt-8" 68 ; 68 I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-7" 69 I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-8" 70 ; 71 ; Again for a different patient (4) 72 S DFN=4 73 D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) 74 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 75 I 'APPID W "Error Making Appt-9" QUIT 76 I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-10" 77 I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-11" 78 I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-12" 79 ; 80 ; Delete appointment set for Patient 4 (made above) 81 N BSDX,DFN 82 S DFN=4 83 S BSDX("PAT")=DFN 84 S BSDX("CLN")=HLIEN 85 S BSDX("ADT")=APPTTIME 86 D BSDXDEL^BSDX07(APPID) 87 S %=$$UNMAKE^BSDXAPI(.BSDX) 88 I +$G(^BSDXAPPT(APPID,0)) W "Error in deleting appointment-1",! 89 I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-2",! 90 I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-3",! 91 ; 92 ; Delete appointment set for Patient 1 (not made)... needs to not crash 93 D 94 . N $ET S $ET="D ^%ZTER S $EC="""" W ""Failure to del non-existent appt"",!" 95 . D BSDXDEL^BSDX07(9999999) 96 . N BSDX 97 . S BSDX("PAT")=1 98 . S BSDX("CLN")=HLIEN 99 . S BSDX("ADT")=APPTTIME 100 . S %=$$UNMAKE^BSDXAPI(.BSDX) 101 ; 69 102 ; Test for bad start date 70 103 D APPADD(.ZZZ,2100123,3100123.3,2,RESNAM,30,"Sam's Note",1) … … 81 114 I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",! 82 115 K BSDXDIE 83 ; Test for TRESTART 84 sBSDXRESTART=185 D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1)86 I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",!87 kBSDXRESTART116 ; Test for TRESTART -- retired in v 1.7 117 ; S BSDXRESTART=1 118 ; D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1) 119 ; I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",! 120 ; K BSDXRESTART 88 121 ; Test for non-numeric patient 89 122 D APPADD(.ZZZ,APPTTIME,ENDTIME,"CAT,DOG",RESNAM,30,"Sam's Note",1) … … 97 130 ; Test for corrupted resource 98 131 ; Can't test for -8 since it requires DB corruption 99 ; Test for inability to add appointment to BSDX Appointment 132 ; Test for inability to add appointment to BSDX Appointment (-9) 100 133 ; Also requires something wrong in the DB 101 134 ; Test for inability to add appointment to 2,44 102 135 ; Test by creating a duplicate appointment 103 104 105 106 136 ; Get start and end times 137 N TIMES S TIMES=$$TIMES^BSDX35 ; appt time^end time 138 N APPTTIME S APPTTIME=$P(TIMES,U) 139 N ENDTIME S ENDTIME=$P(TIMES,U,2) 107 140 D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1) 108 141 D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1) … … 111 144 ; 112 145 APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;EP 113 ; 114 ;Called by RPC: BSDX ADD NEW APPOINTMENT 115 ; 116 ;Add new appointment to 3 files 117 ; - BSDX APPOINTMENT 118 ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic 119 ; - Patient Appointment Subfile if Resource is linked to clinic 120 ; 121 ;Paramters: 122 ;BSDXY: Global Return (RPC must be set to Global Array) 123 ;BSDXSTART: FM Start Date 124 ;BSDXEND: FM End Date 125 ;BSDXPATID: Patient DFN 126 ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN) 127 ;BSDXLEN is the appointment duration in minutes 128 ;BSDXNOTE is the Appiontment Note 129 ;BSDXATID is used for 2 purposes: 130 ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt. 131 ; if BSDXATID = a number, then it is the access type id (used for rebooking) 132 ;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional) 133 ; 134 ;Return: 135 ; ADO.net Recordset having fields: 136 ; AppointmentID and ErrorNumber 137 ; 138 ;Test lines: 139 ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN 140 ; 141 ; Deal with optional arguments 142 S BSDXRADEXAM=$G(BSDXRADEXAM) 143 ; Return Array; set Return and clear array 144 S BSDXY=$NA(^BSDXTMP($J)) 145 K ^BSDXTMP($J) 146 ; $ET 147 N $ET S $ET="G ETRAP^BSDX07" 148 ; Counter 149 N BSDXI S BSDXI=0 150 ; Lock BSDX node, only to synchronize access to the globals. 151 ; It's not expected that the error will ever happen as no filing 152 ; is supposed to take 5 seconds. 153 L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q 154 ; Header Node 155 S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30) 156 ;Restartable Transaction; restore paramters when starting. 157 ; (Params restored are what's passed here + BSDXI) 158 TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXI):T="BSDX ADD NEW APPOINTMENT^BSDX07" 159 ; 160 ; Turn off SDAM APPT PROTOCOL BSDX Entries 161 N BSDXNOEV 162 S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol 163 ; 164 ; Set Error Message to be empty 165 N BSDXERR S BSDXERR=0 166 ; 167 ;;;test for error inside transaction. See if %ZTER works 168 I $G(BSDXDIE) S X=1/0 169 ;;;test 170 ;;;test for TRESTART 171 I $G(BSDXRESTART) K BSDXRESTART TRESTART 172 ;;;test 173 ; 174 ; -- Start and End Date Processing -- 175 ; If C# sends the dates with extra zeros, remove them 176 S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND 177 ; Are the dates valid? Must be FM Dates > than 2010 178 I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q 179 I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q 180 ; 181 ;; If Ending date doesn't have a time, this is an error --rm 1.5 182 ; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q 183 ; 184 ; If the Start Date is greater than the end date, swap dates 185 N BSDXTMP 186 I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP 187 ; 188 ; Check if the patient exists: 189 ; - DFN valid number? 190 ; - Valid Patient in file 2? 191 I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q 192 I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q 193 ; 194 ;Validate Resource entry 195 I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q 196 N BSDXRESD ; Resource IEN 197 S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0)) 198 N BSDXRNOD ; Resouce zero node 199 S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0)) 200 I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q 201 ; 202 ; Walk-in (Unscheduled) Appointment? 203 N BSDXWKIN S BSDXWKIN=0 204 I BSDXATID="WALKIN" S BSDXWKIN=1 205 ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number 206 I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID="" 207 ; 208 ; Done with all checks, let's make appointment in BSDX APPOINTMENT 209 N BSDXAPPTID 210 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) 211 I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q 212 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) 213 ; 214 ; Then Create Subfiles in 2/44 Appointment 215 N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4) ; Hosp Location IEN 216 ; Only if we have a valid Hosp Loc can we make an appointment 217 I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR) Q 218 . N BSDXC 219 . S BSDXC("PAT")=BSDXPATID 220 . S BSDXC("CLN")=BSDXSCD 221 . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins 222 . S:BSDXWKIN BSDXC("TYP")=4 223 . S BSDXC("ADT")=BSDXSTART 224 . S BSDXC("LEN")=BSDXLEN 225 . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field 226 . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI 227 . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note 228 . S BSDXC("USR")=DUZ 229 . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC) 230 . Q:BSDXERR 231 . ;Update RPMS Clinic availability 232 . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) 233 . Q 234 ; 235 ;Return Recordset 236 TCOMMIT 237 L -^BSDXAPPT(BSDXPATID) 238 S BSDXI=BSDXI+1 239 S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30) 240 S BSDXI=BSDXI+1 241 S ^BSDXTMP($J,BSDXI)=$C(31) 242 Q 243 BSDXDEL(BSDXAPPTID) ;Deletes appointment BSDXAPPTID from BSDXAPPOINTMETN 244 N DA,DIK 245 S DIK="^BSDXAPPT(",DA=BSDXAPPTID 246 D ^DIK 247 Q 248 ; 146 ; 147 ;Called by RPC: BSDX ADD NEW APPOINTMENT 148 ; 149 ;Add new appointment to 3 files 150 ; - BSDX APPOINTMENT 151 ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic 152 ; - Patient Appointment Subfile if Resource is linked to clinic 153 ; 154 ;Paramters: 155 ;BSDXY: Global Return (RPC must be set to Global Array) 156 ;BSDXSTART: FM Start Date 157 ;BSDXEND: FM End Date 158 ;BSDXPATID: Patient DFN 159 ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN) 160 ;BSDXLEN is the appointment duration in minutes 161 ;BSDXNOTE is the Appiontment Note 162 ;BSDXATID is used for 2 purposes: 163 ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt. 164 ; if BSDXATID = a number, then it is the access type id (used for rebooking) 165 ;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional) 166 ; 167 ;Return: 168 ; ADO.net Recordset having fields: 169 ; AppointmentID and ErrorNumber 170 ; 171 ;Test lines: 172 ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN 173 ; 174 ; Deal with optional arguments 175 S BSDXRADEXAM=$G(BSDXRADEXAM) 176 ; 177 ; Return Array; set Return and clear array 178 S BSDXY=$NA(^BSDXTMP($J)) 179 K ^BSDXTMP($J) 180 ; 181 ; $ET 182 N $ET S $ET="G ETRAP^BSDX07" 183 ; 184 ; Counter 185 N BSDXI S BSDXI=0 186 ; 187 ; Lock BSDX node, only to synchronize access to the globals. 188 ; It's not expected that the error will ever happen as no filing 189 ; is supposed to take 5 seconds. 190 L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q 191 ; 192 ; Header Node 193 S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30) 194 ; 195 ; Turn off SDAM APPT PROTOCOL BSDX Entries 196 N BSDXNOEV 197 S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol 198 ; 199 ; Set Error Message to be empty 200 N BSDXERR S BSDXERR=0 201 ; 202 ;;;test for error inside transaction. See if %ZTER works 203 I $G(BSDXDIE) S X=1/0 204 ;;;test 205 ; 206 ; -- Start and End Date Processing -- 207 ; If C# sends the dates with extra zeros, remove them 208 S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND 209 ; Are the dates valid? Must be FM Dates > than 2010 210 I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q 211 I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q 212 ; 213 ;; If Ending date doesn't have a time, this is an error --rm 1.5 214 ; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q 215 ; 216 ; If the Start Date is greater than the end date, swap dates 217 N BSDXTMP 218 I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP 219 ; 220 ; Check if the patient exists: 221 ; - DFN valid number? 222 ; - Valid Patient in file 2? 223 I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q 224 I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q 225 ; 226 ;Validate Resource entry 227 I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q 228 N BSDXRESD ; Resource IEN 229 S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0)) 230 N BSDXRNOD ; Resouce zero node 231 S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0)) 232 I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q 233 ; 234 ; Walk-in (Unscheduled) Appointment? 235 N BSDXWKIN S BSDXWKIN=0 236 I BSDXATID="WALKIN" S BSDXWKIN=1 237 ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number 238 I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID="" 239 ; 240 ; Now, check if PIMS has any issues with us making the appt using MAKECK 241 N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4) ; Hosp Location IEN 242 N BSDXERR ; Variable to hold value of $$MAKE and $$MAKECK 243 N BSDXC ; Array to send to MAKE and MAKECK APIs 244 ; Only if we have a valid Hosp Location 245 I +BSDXSCD,$D(^SC(BSDXSCD,0)) D 246 . S BSDXC("PAT")=BSDXPATID 247 . S BSDXC("CLN")=BSDXSCD 248 . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins 249 . S:BSDXWKIN BSDXC("TYP")=4 250 . S BSDXC("ADT")=BSDXSTART 251 . S BSDXC("LEN")=BSDXLEN 252 . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field 253 . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI 254 . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note 255 . S BSDXC("USR")=DUZ 256 . S BSDXERR=$$MAKECK^BSDXAPI(.BSDXC) 257 I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKECK^BSDXAPI returned error code: "_BSDXERR) Q ; no need for roll back 258 ; 259 ; Done with all checks, let's make appointment in BSDX APPOINTMENT 260 N BSDXAPPTID 261 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) 262 I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q ; no roll back needed! No appts made. 263 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) ; TODO: check for error and rollback 264 ; 265 ; Only if we have a valid Hosp Loc can we make an appointment in 2/44 266 ; Use BSDXC array from before. 267 ; NB: $$MAKE itself calls $$MAKECK to check again for being okay. 268 I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q 269 . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC) 270 . Q:BSDXERR 271 . ;Update RPMS Clinic availability 272 . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) 273 ; 274 ;Return Recordset 275 L -^BSDXAPPT(BSDXPATID) 276 S BSDXI=BSDXI+1 277 S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30) 278 S BSDXI=BSDXI+1 279 S ^BSDXTMP($J,BSDXI)=$C(31) 280 Q 249 281 STRIP(BSDXZ) ;Replace control characters with spaces 250 251 252 253 282 N BSDXI 283 F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999) 284 Q BSDXZ 285 ; 254 286 BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) ;ADD BSDX APPOINTMENT ENTRY 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 287 ;Returns ien in BSDXAPPT or 0 if failed 288 ;Create entry in BSDX APPOINTMENT 289 N BSDXAPPTID 290 S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART 291 S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND 292 S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID 293 S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD 294 S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ) 295 S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT 296 S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y" 297 S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID 298 S BSDXFDA(9002018.4,"+1,",.14)=$G(BSDXRADEXAM) 299 N BSDXIEN,BSDXMSG 300 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") 301 S BSDXAPPTID=+$G(BSDXIEN(1)) 302 Q BSDXAPPTID 303 ; 272 304 BSDXWP(BSDXAPPTID,BSDXNOTE) ; 273 ;Add WP field 274 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" 275 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) 276 I $D(BSDXNOTE(.5)) D 277 . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG") 278 Q 279 ; 305 ;Add WP field 306 N BSDXMSG 307 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" 308 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) 309 I $D(BSDXNOTE(.5)) D 310 . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG") 311 Q 312 ; 280 313 ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 314 ;Called by BSDX ADD APPOINTMENT protocol 315 ;BSDXSC=IEN of clinic in ^SC 316 ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note 317 ; 318 N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES 319 Q:+$G(BSDXNOEV) 320 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) 321 E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) 322 Q:'+$G(BSDXRES) 323 S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0)) 324 Q:BSDXNOD="" 325 S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0)) 326 S BSDXWKIN="" 327 S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile 328 S BSDXLEN=$P(BSDXNOD,U,2) 329 Q:'+BSDXLEN 330 S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0) 331 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN) 332 Q:'+BSDXAPPTID 333 S BSDXNOTE=$P(BSDXNOD,U,4) 334 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) 335 D ADDEVT3(BSDXRES) 336 Q 337 ; 305 338 ADDEVT3(BSDXRES) ; 306 307 308 309 310 311 312 313 314 339 ;Call RaiseEvent to notify GUI clients 340 N BSDXRESN 341 S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) 342 Q:BSDXRESN="" 343 S BSDXRESN=$P(BSDXRESN,"^") 344 ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","") 345 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) 346 Q 347 ; 315 348 ERR(BSDXI,BSDXERR) ;Error processing 316 S BSDXI=BSDXI+1 317 S BSDXERR=$TR(BSDXERR,"^","~") 318 I $TL>0 TROLLBACK 319 S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30) 320 S BSDXI=BSDXI+1 321 S ^BSDXTMP($J,BSDXI)=$C(31) 322 L -^BSDXAPPT(BSDXPATID) 323 Q 324 ; 349 S BSDXI=BSDXI+1 350 S BSDXERR=$TR(BSDXERR,"^","~") 351 S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30) 352 S BSDXI=BSDXI+1 353 S ^BSDXTMP($J,BSDXI)=$C(31) 354 L -^BSDXAPPT(BSDXPATID) 355 Q 356 ; 357 ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set 358 ; DO NOT USE except as an emergency measure - only if unforseen error occurs 359 ; Input: 360 ; Appointment ID to remove from ^BSDXAPPT 361 ; BSDXC array (see array format in $$MAKE^BSDXAPI) 362 D BSDXDEL^BSDX07(BSDXAPPTID) 363 S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0 364 QUIT 365 ; 366 BSDXDEL(BSDXAPPTID) ;Private EP ; Deletes appointment BSDXAPPTID from ^BSDXAPPT 367 ; DO NOT USE except in emergencies to roll back an appointment set 368 N DA,DIK 369 S DIK="^BSDXAPPT(",DA=BSDXAPPTID 370 D ^DIK 371 Q 372 ; 325 373 ETRAP ;EP Error trap entry 326 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 327 ; Rollback, otherwise ^XTER will be empty from future rollback 328 I $TL>0 TROLLBACK 329 D ^%ZTER 330 S $EC="" ; Clear Error 331 ; Log error message and send to client 332 I '$D(BSDXI) N BSDXI S BSDXI=0 333 D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE)) 334 Q 335 ; 374 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 375 D ^%ZTER 376 S $EC="" ; Clear Error 377 ; Log error message and send to client 378 I '$D(BSDXI) N BSDXI S BSDXI=0 379 D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE)) 380 Q 381 ; 336 382 DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR 337 383 ; 338 384 DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y) 339 340 341 342 385 F %=%:-1:281 S Y=%#4=1+1+Y 386 S Y=$E(X,6,7)+Y#7 387 Q 388 ; 343 389 AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update RPMS Clinic availability 344 345 346 347 348 349 350 351 352 353 354 355 1 356 357 358 359 390 ;SEE SDM1 391 N Y,DFN 392 N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG 393 N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I 394 S Y=BSDXSCD,DFN=BSDXPATID 395 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 396 ;Determine maximum days for scheduling 397 S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365 398 S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1)) 399 S SDDATE=BSDXSTART 400 S SDSDATE=SDDATE,SDDATE=SDDATE\1 401 1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC 402 Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC 403 S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2) 404 S X2=SDEDT D C^%DTC S SDEDT=X 405 S Y=BSDXSTART 360 406 EN1 S (X,SD)=Y,SM=0 D DOW 361 S 362 363 364 365 366 367 368 369 370 371 SC 372 373 374 375 376 377 378 SP 379 380 381 382 383 384 385 386 387 388 389 390 407 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,".") 408 S S=BSDXLEN 409 ;Check if BSDXLEN evenly divisible by appointment length 410 S RPMSL=$P(SL,U) 411 I BSDXLEN<RPMSL S BSDXLEN=RPMSL 412 I BSDXLEN#RPMSL'=0 D 413 . S BSDXINC=BSDXLEN\RPMSL 414 . S BSDXINC=BSDXINC+1 415 . S BSDXLEN=RPMSL*BSDXINC 416 S SL=S_U_$P(SL,U,2,99) 417 SC S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9 418 L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC 419 S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1) 420 S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST 421 I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q 422 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 423 ; 424 SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP 425 S SDNOT=1 426 S ABORT=0 427 F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT 428 . S ST=$E(S,I+1) S:ST="" ST=" " 429 . S Y=$E(STR,$F(STR,ST)-2) 430 . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q 431 . I Y="" S ABORT=1 Q 432 . 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 433 . Q 434 S ^SC(SC,"ST",$P(SD,"."),1)=S 435 L -^SC(SC,"ST",$P(SD,"."),1) 436 Q -
Scheduling/trunk/m/BSDXAPI.m
r1450 r1451 1 BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/1 8/12 5:31pm2 ;;1. 6;BSDX;;Aug 31, 2011;Build 181 BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/19/12 5:42pm 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL 4 4 ; … … 32 32 ; More user friendly message if patient already has appointment in $$MAKE: 33 33 ; Spits out pt name and user friendly date. 34 34 ; 2012-06-18 (v 1.7) 35 35 ; Removing transacions. Means that code SHOULD NOT fail. Took all checks 36 ; out for making an appointment to MAKECK. We call this first to make sure 37 ; that the appointment is okay to make before committing to make it. 36 ; out for making an appointment to MAKECK. We call this first to make sure 37 ; that the appointment is okay to make before committing to make it. We 38 ; still have the provision to delete the data though if we fail when we 39 ; actually make the appointment 38 40 ; 39 41 MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment … … 70 72 N BSDXMKCK S BSDXMKCK=$$MAKECK(.BSDR) ; Check if we can make appointment 71 73 I BSDXMKCK Q BSDXMKCK ; If we can't, quit with the reason why. 72 ; Otherwise, we continue 73 ; 74 NEW DIC,DA,Y,X,DD,DO,DLAYGO 74 ; 75 ;Otherwise, we continue 76 ; 77 N BSDXFDA,BSDXIENS,BSDXMSG ; FILE/UPDATE^DIE variables 75 78 ; 76 79 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D 77 80 . ; "un-cancel" existing appt in file 2 78 . N BSDXFDA,BSDXIENS,BSDXMSG79 81 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," 80 82 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN") … … 88 90 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT 89 91 . D FILE^DIE("","BSDXFDA","BSDXMSG") 90 . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)91 E D92 . N BSDXFDA,BSDXIENS,BSDXMSG92 Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1) 93 ; 94 E D ; File new appointment/edit existing appointment in file 2 93 95 . S BSDXIENS="?+2,"_BSDR("PAT")_"," 94 96 . S BSDXIENS(2)=BSDR("ADT") … … 97 99 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 98 100 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT 99 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)") 100 I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") 101 ; add appt to file 44 102 K DIC,DA,X,Y,DLAYGO,DD,DO 101 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXMSG") 102 Q:$D(BSDXMSG) 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1) 103 ; 104 ; add appt to file 44. This adds it to the FIRST subfile (Appointment) 105 N DIC,DA,Y,X,DD,DO,DLAYGO 103 106 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^" 104 107 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") … … 106 109 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 107 110 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN 108 109 ; 111 ; 112 ; add appt for file 44, second subfile (Appointment/Patient) 110 113 ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh 111 114 ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM … … 136 139 ; 137 140 MAKECK(BSDR) ; $$ - Is it okay to make an appointment? ; PEP 141 ; Input: Same as $$MAKE 142 ; Output: 1^error or 0 for success 143 ; NB: This subroutine saves no data. Only checks whether it's okay. 144 ; 138 145 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) 139 146 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) … … 142 149 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 143 150 ; 144 145 151 ; Appt Length check removed in v 1.5 152 ; 146 153 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) 147 154 ; More verbose error message in v1.5 … … 160 167 . . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic 161 168 Q 0 162 169 ; 163 170 UNMAKE(BSDR) ; Reverse Make - Private $$ 164 ; Only used in Emergiencies where Fileman data filing fails. 165 ; If previous data exists, which caused an error, it's destroyed. 166 N BSDXFDA,BSDXIENS 167 S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," 168 S BSDXFDA(2.98,BSDXIENS,".01")="@" 169 ; 170 I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),1)) QUIT 0 ; No stuff in HL file 171 N X S X=0 F S X=$O(^SC(BSDR("CLN"),"S",BSDR("ADT"),1,X)) Q:'X Q:+^(X,0)=BSDR("PAT") 172 ; 173 I 'X QUIT 0 ; Patient doesn't have appointment 174 ; 175 S BSDXIENS=X_","_BSDR("ADT")_","_BSDR("CLN")_"," 176 S BSDXFDA(44.003,BSDXIENS,.01)="@" 177 N BSDXMSG 178 D FILE^DIE("","BSDXFDA","BSDXMSG") 179 I $D(BSDXMSG) S $EC=",U1," ; If we get an error here, we are REALLY out of control 180 QUIT 0 171 ; Only used in Emergiencies where Fileman data filing fails. 172 ; If previous data exists, which caused an error, it's destroyed. 173 ; NB: ^DIK stops for nobody 174 ; Input: Same array as $$MAKE 175 ; Output: Always 0 176 NEW DIK,DA 177 S DIK="^DPT("_BSDR("PAT")_",""S""," 178 S DA(1)=BSDR("PAT"),DA=BSDX("ADT") 179 D ^DIK 180 ; 181 N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 182 I 'IEN QUIT 0 183 ; 184 NEW DIK,DA 185 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 186 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN 187 D ^DIK 188 QUIT 0 189 ; 181 190 CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in 182 191 ; Call like this for DFN 23435 checking in now at Hospital Location 33
Note:
See TracChangeset
for help on using the changeset viewer.
