Changeset 1563 for Scheduling/trunk/m/BSDX08.m
- Timestamp:
- Oct 8, 2012, 6:59:10 AM (12 years ago)
- File:
-
- 1 edited
-
Scheduling/trunk/m/BSDX08.m (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX08.m
r1481 r1563 1 BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:22pm2 ;;1. 7T2;BSDX;;Jul 11, 2012;Build 181 BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am 2 ;;1.6;BSDX;;Aug 31, 2011;Build 25 3 3 ; 4 4 ; Original by HMW. New Written by Sam Habiel. Licensed under LGPL. … … 6 6 ; Change History 7 7 ; 3101022 UJO/SMH v1.42 8 ; - Transaction work. As of v 1.7, all work here has been superceded 9 ; - Refactoring of AVUPDT - never tested though. 8 ; - Transaction now restartable. Thanks to 9 ; --> Zach Gonzalez and Rick Marshall for fix. 10 ; - Extra TROLLBACK in Lock Statement when lock fails. 11 ; --> Removed--Rollback is already in ERR tag. 12 ; - Added new statements to old SD code in AVUPDT to obviate 13 ; --> need to restore variables in transaction 14 ; - Refactored this chunk of code. Don't really know whether it 15 ; --> worked in the first place. Waiting for bug report to know. 10 16 ; - Refactored all of APPDEL. 11 17 ; … … 13 19 ; - Added ability to remove checked in appointments. Added a couple 14 20 ; of units tests for that under UT2. 15 ; 16 ; 3120625 VEN/SMH v1.7 17 ; - Transactions removed. Code refactored to work w/o txns. 18 ; - Moved AVUPDT to AVUPDTCN in BSDXAPI1. BSDXAPI takes care of calling 19 ; that. 21 ; - Minor reformatting because of how KIDS adds tabs. 20 22 ; 21 23 ; Error Reference: … … 29 31 ; -8^BSDX08: Unable to find associated PIMS appointment for this patient 30 32 ; -9^BSDX08: BSDXAPI returned an error: (error) 31 ; -10^BSDX08: $$BSDXCAN failed (Fileman filing error)32 33 ; -100~BSDX08 Error: (Mumps Error) 33 34 ; 34 35 APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP 35 36 ;Entry point for debugging 36 ;D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)") 37 Q 38 ; 39 APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ; Private EP 37 D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)") 38 Q 39 ; 40 UT ; Unit Tests 41 ; Test 1: Make normal appointment and cancel it. See if every thing works 42 N ZZZ 43 D APPADD^BSDX07(.ZZZ,3110123.2,3110123.3,4,"Dr Office",10,"Sam's Note",1) 44 S APPID=+$P(^BSDXTMP($J,1),U) 45 D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note") 46 I $P(^BSDXAPPT(APPID,0),U,12)'>0 W "Error in Cancellation-1" 47 I $O(^SC(2,"S",3110123.2,1,0))]"" W "Error in Cancellation-2" 48 I $P(^DPT(4,"S",3110123.2,0),U,2)'="PC" W "Error in Cancellation-3" 49 I ^DPT(4,"S",3110123.2,"R")'="Sam's Cancel Note" W "Error in Cancellation-4" 50 ; 51 ; Test 2: Check for -1 52 ; Make appt 53 D APPADD^BSDX07(.ZZZ,3110125.2,3110125.3,4,"Dr Office",10,"Sam's Note",1) 54 ; Lock the node in another job 55 S APPID=+$P(^BSDXTMP($J,1),U) 56 ; W "Lock ^BSDXAPPT("_APPID_") in another session. You have 10 seconds." H 10 57 D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note") 58 ; 59 ; Test 3: Check for -100 60 S bsdxdie=1 61 D APPADD^BSDX07(.ZZZ,3110126.2,3110126.3,4,"Dr Office",10,"Sam's Note",1) 62 S APPID=+$P(^BSDXTMP($J,1),U) 63 D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons") 64 I $P(^BSDXTMP($J,1),"~")'=-100 W "Error in -100",! 65 K bsdxdie 66 ; 67 ; Test 4: Restartable transaction 68 S bsdxrestart=1 69 D APPADD^BSDX07(.ZZZ,3110128.2,3110128.3,4,"Dr Office",10,"Sam's Note",1) 70 S APPID=+$P(^BSDXTMP($J,1),U) 71 D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons") 72 I $P(^DPT(4,"S",3110128.2,0),U,2)'="PC" W "Error in Restartable Transaction",! 73 ; 74 ; Test 5: for invalid Appointment ID (-2 and -3) 75 D APPDEL^BSDX08(.ZZZ,0,"PC",1,"Reasons") 76 I $P(^BSDXTMP($J,1),"~")'=-2 W "Error in -2",! 77 D APPDEL^BSDX08(.ZZZ,999999,"PC",1,"Reasons") 78 I $P(^BSDXTMP($J,1),"~")'=-3 W "Error in -3",! 79 UT2 ; More unit Tests 80 ; 81 ; Test 6: for Cancelling walkin and checked-in appointments 82 S BSDXSTART=$E($$NOW^XLFDT,1,12),BSDXEND=BSDXSTART+.0001 83 D APPADD^BSDX07(.ZZZ,BSDXSTART,BSDXEND,4,"Dr Office",10,"Sam's Note",1) ; Add appt 84 S APPID=+$P(^BSDXTMP($J,1),U) 85 I APPID=0 W "Error in test 6",! 86 D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; check-in 87 D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; Delete appt 88 I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",! 89 ; 90 ; Test 7: for cancelling walkin and checked-in appointments 91 S BSDXSTART=$E($$NOW^XLFDT,1,12)+.0001,BSDXEND=BSDXSTART+.0001 92 D APPADD^BSDX07(.ZZZ,BSDXSTART,BSDXEND,4,"Dr Office",10,"Sam's Note",1) ; Add appt 93 S APPID=+$P(^BSDXTMP($J,1),U) 94 I APPID=0 W "Error in test 6",! 95 D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; Checkin 96 S BSDXRES=$O(^BSDXRES("B","Dr Office","")) 97 S BSDXCLN=$P(^BSDXRES(BSDXRES,0),U,4) 98 S BSDXRESULT=$$RMCI^BSDXAPI(4,BSDXCLN,BSDXSTART) ; remove checkin 99 D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; delete appt 100 I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",! 101 QUIT 102 APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP 40 103 ;Called by RPC: BSDX CANCEL APPOINTMENT 41 104 ;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles … … 61 124 ; Counter 62 125 N BSDXI S BSDXI=0 63 ;64 126 ; Header Node 65 127 S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30) 128 ; 129 ; Lock BSDX node, only to synchronize access to the globals. 130 ; It's not expected that the error will ever happen as no filing 131 ; is supposed to take 5 seconds. 132 L +^BSDXAPPT(BSDXAPTID):5 I '$T D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q 133 ; 134 ;Restartable Transaction; restore paramters when starting. 135 ; (Params restored are what's passed here + BSDXI) 136 TSTART (BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT,BSDXI):T="BSDX CANCEL APPOINTEMENT^BSDX08" 66 137 ; 67 138 ; Turn off SDAM APPT PROTOCOL BSDX Entries … … 70 141 ; 71 142 ;;;test for error inside transaction. See if %ZTER works 72 I $G(BSDXDIE1) N X S X=1/0 143 I $G(bsdxdie) S X=1/0 144 ;;;test 145 ;;;test for TRESTART 146 I $G(bsdxrestart) K bsdxrestart TRESTART 147 ;;;test 73 148 ; 74 149 ; Check appointment ID and whether it exists 75 150 I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q 76 151 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-3~BSDX08: Invalid Appointment ID") Q 77 ;78 ; Lock BSDX node, only to synchronize access to the globals.79 ; It's not expected that the error will ever happen as no filing80 ; is supposed to take 5 seconds.81 L +^BSDXAPPT(BSDXAPTID):5 E D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q82 152 ; 83 153 ; Start Processing: 84 ; First, get data154 ; First, add cancellation date to appt entry in BSDX APPOINTMENT 85 155 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; BSDX Appt Node 86 156 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; Patient ID 87 157 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Time 88 ; 89 ; Check the resource ID and whether it exists 158 D BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT 159 ; 160 ; Second, cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability 90 161 N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID 91 ; If the resou rce id doesn't exist...162 ; If the resouce id doesn't exist... 92 163 I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT 93 164 I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT 94 ;95 ;96 ; Check if PIMS will let us cancel the appointment using $$CANCELCK^BSDXAPI97 165 ; Get zero node of resouce 98 N BSDXNODS BSDXNOD=^BSDXRES(BSDXSC1,0)166 S BSDXNOD=^BSDXRES(BSDXSC1,0) 99 167 ; Get Hosp location 100 168 N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4) 101 ; Error indicator 169 ; Error indicator for Hosp Location filing for getting out of routine 102 170 N BSDXERR S BSDXERR=0 103 ; 104 N BSDXC ; Array to pass to BSDXAPI 105 ; 106 I BSDXLOC D 107 . S BSDXC("PAT")=BSDXPATID 108 . S BSDXC("CLN")=BSDXLOC 109 . S BSDXC("TYP")=BSDXTYP 110 . S BSDXC("ADT")=BSDXSTART 111 . S BSDXC("CDT")=$$NOW^XLFDT() 112 . S BSDXC("NOT")=BSDXNOT 113 . S:'+$G(BSDXCR) BSDXCR=11 ;Other 114 . S BSDXC("CR")=BSDXCR 115 . S BSDXC("USR")=DUZ 116 . ; 117 . S BSDXERR=$$CANCELCK^BSDXAPI(.BSDXC) ; 0 or 1^error message 118 ; If error, quit. No need to rollback as no changes took place. 119 I BSDXERR D ERR(BSDXI,"-9~BSDX08: BSDXAPI reports that "_$P(BSDXERR,U,2)) QUIT 120 ; 121 I $G(BSDXDIE2) N X S X=1/0 122 ; 123 ; Now cancel the appointment for real 124 ; BSDXAPPT First; no need for rollback if error occured. 125 N BSDXERR S BSDXERR=$$BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT 126 I BSDXERR D ERR(BSDXI,"-10~BSDX08: $$BSDXCAN failed (Fileman filing error): "_$P(BSDXERR,U,2)) QUIT 127 ; 128 ; Then PIMS: 129 ; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability 130 ; If error happens, must rollback ^BSDXAPPT 131 I BSDXLOC S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) ; Cancel through BSDXAPI 132 ; Rollback BSDXAPPT if error occurs 133 I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)),ROLLBACK(BSDXAPTID) QUIT 134 ; 171 ; Only file in 2/44 if there is an associated hospital location 172 I BSDXLOC D QUIT:BSDXERR 173 . I '$D(^SC(BSDXLOC,0)) S BSDXERR=1 D ERR(BSDXI,"-6~BSDX08: Invalid Hosp Location stored in Database") QUIT 174 . ; Get the IEN of the appointment in the "S" node of ^SC 175 . N BSDXSCIEN 176 . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) 177 . I BSDXSCIEN="" S BSDXERR=1 D ERR(BSDXI,"-7~BSDX08: Patient does not have an appointment in PIMS Clinic") QUIT 178 . ; Get the appointment node 179 . S BSDXNOD=$G(^SC(BSDXLOC,"S",BSDXSTART,1,BSDXSCIEN,0)) 180 . I BSDXNOD="" S BSDXERR=1 D ERR(BSDXI,"-8^BSDX08: Unable to find associated PIMS appointment for this patient") QUIT 181 . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) 182 . ; Cancel through BSDXAPI 183 . N BSDXZ 184 . D APCAN(.BSDXZ,BSDXLOC,BSDXPATID,BSDXSTART) 185 . I +BSDXZ>0 S BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT 186 . ; Update Legacy PIMS clinic Availability 187 . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN) 188 ; 189 TCOMMIT 135 190 L -^BSDXAPPT(BSDXAPTID) 136 191 S BSDXI=BSDXI+1 … … 140 195 Q 141 196 ; 142 BSDXCAN(BSDXAPTID) ; $$; Private; Cancel BSDX APPOINTMENT entry 143 ; Input: Appt IEN in ^BSDXAPPT 144 ; Output: 0 for success and 1^Msg for failure 145 N BSDXDATE,BSDXIENS,BSDXFDA,BSDXMSG 146 S BSDXDATE=$$NOW^XLFDT() 197 AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update Legacy PIMS Clinic availability 198 ;See SDCNP0 199 N SD,S ; Start Date 200 S (SD,S)=BSDXSTART 201 N I ; Clinic IEN in 44 202 S I=BSDXSCD 203 ; if day has no schedule in legacy PIMS, forget about this update. 204 Q:'$D(^SC(I,"ST",SD\1,1)) 205 N SL ; Clinic characteristics node (length of appt, when appts start etc) 206 S SL=^SC(I,"SL") 207 N X ; Hour Clinic Display Begins 208 S X=$P(SL,U,3) 209 N STARTDAY ; When does the day start? 210 S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am 211 N SB ; ?? Who knows? Day Start - 1 divided by 100. 212 S SB=STARTDAY-1/100 213 S X=$P(SL,U,6) ; Now X is Display increments per hour 214 N HSI ; Slots per hour, try 1 215 S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4 216 N SI ; Slots per hour, try 2 217 S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4 218 N STR ; ?? 219 S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz" 220 N SDDIF ; Slots per hour diff?? 221 S SDDIF=$S(HSI<3:8/HSI,1:2) 222 S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI 223 S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS 224 N Y ; Hours since start of Date 225 S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs 226 N ST ; ?? 227 ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour 228 ; Y\1 -> Hours since start of day; * SI: * slots 229 S ST=Y#1*SI\.6+(Y\1*SI) 230 N SS ; how many slots are supposed to be taken by appointment 231 S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots) 232 N I 233 I Y'<1 D ; If Hours since start of Date is greater than 1 234 . ; loop through pattern. Tired of documenting. 235 . F I=ST+ST:SDDIF D Q:Y="" Q:SS'>0 236 . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" 237 . . S S=$E(S,1,I)_Y_$E(S,I+2,999) 238 . . S SS=SS-1 239 . . Q:SS'>0 240 S ^SC(BSDXSCD,"ST",SD\1,1)=S ; new pattern; global set 241 Q 242 ; 243 APCAN(BSDXZ,BSDXLOC,BSDXDFN,BSDXSD) ; 244 ;Cancel appointment for patient BSDXDFN in clinic BSDXSC1 245 ;at time BSDXSD 246 N BSDXC,%H 247 S BSDXC("PAT")=BSDXPATID 248 S BSDXC("CLN")=BSDXLOC 249 S BSDXC("TYP")=BSDXTYP 250 S BSDXC("ADT")=BSDXSD 251 S %H=$H D YMD^%DTC 252 S BSDXC("CDT")=X+% 253 S BSDXC("NOT")=BSDXNOT 254 S:'+$G(BSDXCR) BSDXCR=11 ;Other 255 S BSDXC("CR")=BSDXCR 256 S BSDXC("USR")=DUZ 257 ; 258 S BSDXZ=$$CANCEL^BSDXAPI(.BSDXC) 259 Q 260 ; 261 BSDXCAN(BSDXAPTID) ; 262 ;Cancel BSDX APPOINTMENT entry 263 N %DT,X,BSDXDATE,Y,BSDXIENS,BSDXFDA,BSDXMSG 264 S %DT="XT",X="NOW" D ^%DT ; X ^DD("DD") 265 S BSDXDATE=Y 147 266 S BSDXIENS=BSDXAPTID_"," 148 267 S BSDXFDA(9002018.4,BSDXIENS,.12)=BSDXDATE 268 K BSDXMSG 149 269 D FILE^DIE("","BSDXFDA","BSDXMSG") 150 I $D(BSDXMSG) Q 1_U_BSDXMSG("DIERR",1,"TEXT",1) 151 QUIT 0 152 ; 153 ROLLBACK(BSDXAPTID) ; Proc; Private; Rollback cancellation 154 ; Input same as $$BSDXCAN 155 N BSDXIENS S BSDXIENS=BSDXAPTID_"," 156 N BSDXFDA S BSDXFDA(9002018.4,BSDXIENS,.12)="@" 157 N BSDXMSG 158 D FILE^DIE("","BSDXFDA","BSDXMSG") 159 ;I $D(BSDXMSG) ; Not sure what to do. We are already handling an error. 160 QUIT 270 Q 161 271 ; 162 272 CANEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CANCEL APPOINTMENT event … … 182 292 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND 183 293 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND 184 . N BSDXNOD185 294 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" 186 295 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q 187 I BSDXFOUND,+$G(BSDXAPPT) N % S %=$$BSDXCAN(BSDXAPPT) I % D ^%ZTER296 I BSDXFOUND,+$G(BSDXAPPT) D BSDXCAN(BSDXAPPT) 188 297 Q BSDXFOUND 189 298 ; … … 200 309 ; 201 310 ERR(BSDXI,BSDXERR) ;Error processing 202 ; Unlock first203 L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)204 ; If last line is $C(31), we are done. No more errors to send to client.205 I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT206 311 S BSDXI=BSDXI+1 207 312 S BSDXERR=$TR(BSDXERR,"^","~") 313 I $TL>0 TROLLBACK 208 314 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) 209 315 S BSDXI=BSDXI+1 210 316 S ^BSDXTMP($J,BSDXI)=$C(31) 317 L -^BSDXAPPT(BSDXAPTID) 211 318 QUIT 212 319 ; 213 320 ETRAP ;EP Error trap entry 214 321 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 322 ; Rollback, otherwise ^XTER will be empty from future rollback 323 I $TL>0 TROLLBACK 215 324 D ^%ZTER 216 ; 217 ; Roll back BSDXAPPT; 218 ; NB: What if a Mumps error happens inside fileman in BSDXAPI? 219 ; I have decided the M errors are out of scope for me to handle. 220 D:$G(BSDXAPTID) ROLLBACK(BSDXAPTID) 221 ; 325 S $EC="" ; Clear Error 222 326 ; Log error message and send to client 223 327 I '$D(BSDXI) N BSDXI S BSDXI=0 224 328 D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE)) 225 Q :$Q 1_U_"-100~Mumps Error" Q329 QUIT 226 330 ; 227 331 ;;;NB: This is code that is unused in both original and port.
Note:
See TracChangeset
for help on using the changeset viewer.
