Changeset 1452
- Timestamp:
- Jun 20, 2012, 7:42:19 PM (12 years ago)
- Location:
- Scheduling/trunk/m
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX07.m
r1451 r1452 1 BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/ 19/12 5:34pm1 BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/20/12 3:28pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL … … 12 12 ; It could be midnight of the next day 13 13 ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams... 14 ; v1.7 Jun 20 2012 - Refactoring to remove transactions - many changes 14 15 ; 15 16 ; Error Reference: … … 38 39 . N $ET S $ET="D ^%ZTER B" 39 40 . S HLRESIENS=$$UTCR^BSDX35(RESNAM) 40 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen 41 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so 41 42 ; 42 43 N HLIEN,RESIEN … … 84 85 S BSDX("CLN")=HLIEN 85 86 S BSDX("ADT")=APPTTIME 86 D BSDXDEL^BSDX07(APPID) 87 S %=$$UNMAKE^BSDXAPI(.BSDX) 87 D ROLLBACK(APPID,.BSDX) 88 88 I +$G(^BSDXAPPT(APPID,0)) W "Error in deleting appointment-1",! 89 89 I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-2",! 90 90 I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-3",! 91 91 ; 92 ; Again for a different patient (5) 93 S DFN=5 94 D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) 95 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 96 I 'APPID W "Error Making Appt-13" QUIT 97 I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-14" 98 I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-15" 99 I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-16" 100 ; Now cancel that appointment 101 D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note") 102 ; Now make it again 103 D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) 104 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 105 I 'APPID W "Error Making Appt-17" QUIT 106 I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-18" 107 I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-19" 108 I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-20" 109 ; 92 110 ; Delete appointment set for Patient 1 (not made)... needs to not crash 93 111 D 94 112 . N $ET S $ET="D ^%ZTER S $EC="""" W ""Failure to del non-existent appt"",!" 95 . D BSDXDEL^BSDX07(9999999)96 113 . N BSDX 97 114 . S BSDX("PAT")=1 98 115 . S BSDX("CLN")=HLIEN 99 116 . S BSDX("ADT")=APPTTIME 100 . S %=$$UNMAKE^BSDXAPI(.BSDX)117 . D ROLLBACK(APPID,.BSDX) 101 118 ; 102 119 ; Test for bad start date … … 141 158 D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1) 142 159 I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",! 160 ; 161 ; Test that rollback occurs properly in various places 162 N TIMES S TIMES=$$TIMES^BSDX35 ; appt time^end time 163 N APPTTIME S APPTTIME=$P(TIMES,U) 164 N ENDTIME S ENDTIME=$P(TIMES,U,2) 165 S DFN=4 166 N BSDXSIMERR1 S BSDXSIMERR1=1 167 D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) 168 N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,"")) 169 I +APPID W "Error in deleting appointment-4",! 170 I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-5",! 171 I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-6",! 172 ; 173 K BSDXSIMERR1 174 N BSDXSIMERR2 S BSDXSIMERR2=1 175 D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) 176 N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,"")) 177 I +APPID W "Error in deleting appointment-7",! 178 I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-8",! 179 I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-9",! 180 ; 181 K BSDXSIMERR2 182 N BSDXSIMERR4 S BSDXSIMERR4=1 183 D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) 184 N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,"")) 185 I +APPID W "Error in deleting appointment-16",! 186 I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-17",! 187 I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-18",! 188 ; 189 K BSDXSIMERR4 190 N BSDXSIMERR5 S BSDXSIMERR5=1 191 D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) 192 N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,"")) 193 I +APPID W "Error in deleting appointment-19",! 194 I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-20",! 195 I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-21",! 143 196 QUIT 144 197 ; … … 168 221 ; ADO.net Recordset having fields: 169 222 ; AppointmentID and ErrorNumber 223 ; 224 ; NB: Specifying BSDXLEN and BSDXEND is redundant. For future programmers 225 ; to sort out 170 226 ; 171 227 ;Test lines: … … 261 317 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) 262 318 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 319 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) ; no error checks are made here 320 ; I don't think it's important b/c users can detect right away if the WP 321 ; filing fails. 322 ; 323 I $G(BSDXSIMERR1) D ERR(BSDXI,"-11~BSDX07 Error: Simulated Error"),ROLLBACK(BSDXAPPTID,.BSDXC) Q ; UT Line 264 324 ; 265 325 ; Only if we have a valid Hosp Loc can we make an appointment in 2/44 … … 269 329 . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC) 270 330 . Q:BSDXERR 271 . ;Update RPMS Clinic availability 272 . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) 331 . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ; Update RPMS Clinic availability 273 332 ; 274 333 ;Return Recordset … … 346 405 Q 347 406 ; 348 ERR(BSDXI,BSDXERR) ;Error processing 407 ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set 408 ; DO NOT USE except as an emergency measure - only if unforseen error occurs 409 ; Input: 410 ; Appointment ID to remove from ^BSDXAPPT 411 ; BSDXC array (see array format in $$MAKE^BSDXAPI) 412 ; NB: I am not sure whether I want to do $G to protect?? 413 ; I send the variables to this EP from the Symbol Table in ETRAP 414 D BSDXDEL^BSDX07(BSDXAPPTID) 415 S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0 416 QUIT 417 ; 418 BSDXDEL(BSDXAPPTID) ;Private EP ; Deletes appointment BSDXAPPTID from ^BSDXAPPT 419 ; DO NOT USE except in emergencies to roll back an appointment set 420 N DA,DIK 421 S DIK="^BSDXAPPT(",DA=BSDXAPPTID 422 D ^DIK 423 Q 424 ; 425 ERR(BSDXI,BSDXERR) ;Error processing - different from error trap. 349 426 S BSDXI=BSDXI+1 350 427 S BSDXERR=$TR(BSDXERR,"^","~") … … 355 432 Q 356 433 ; 357 ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set358 ; DO NOT USE except as an emergency measure - only if unforseen error occurs359 ; Input:360 ; Appointment ID to remove from ^BSDXAPPT361 ; BSDXC array (see array format in $$MAKE^BSDXAPI)362 D BSDXDEL^BSDX07(BSDXAPPTID)363 S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0364 QUIT365 ;366 BSDXDEL(BSDXAPPTID) ;Private EP ; Deletes appointment BSDXAPPTID from ^BSDXAPPT367 ; DO NOT USE except in emergencies to roll back an appointment set368 N DA,DIK369 S DIK="^BSDXAPPT(",DA=BSDXAPPTID370 D ^DIK371 Q372 ;373 434 ETRAP ;EP Error trap entry 374 435 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 375 436 D ^%ZTER 376 437 S $EC="" ; Clear Error 438 I +$G(BSDXAPPTID) D ROLLBACK(BSDXAPPTID,.BSDXC) ; Rollback if BSDXAPPTID exists 377 439 ; Log error message and send to client 378 440 I '$D(BSDXI) N BSDXI S BSDXI=0 379 441 D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE)) 380 Q 442 Q:$Q 1_U_"Mumps Error" Q 381 443 ; 382 444 DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR -
Scheduling/trunk/m/BSDX08.m
r1187 r1452 1 BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am2 ;;1.6 T2;BSDX;;May 16, 20111 BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/20/12 3:52pm 2 ;;1.6;BSDX;;Aug 31, 2011;Build 18 3 3 ; 4 4 ; Original by HMW. New Written by Sam Habiel. Licensed under LGPL. … … 35 35 APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP 36 36 ;Entry point for debugging 37 D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)")37 ;D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)") 38 38 Q 39 39 ; 40 40 UT ; Unit Tests 41 N RESNAM S RESNAM="UTCLINIC" 42 N HLRESIENS ; holds output of UTCR^BSDX35 - HL IEN^Resource IEN 43 D 44 . N $ET S $ET="D ^%ZTER B" 45 . S HLRESIENS=$$UTCR^BSDX35(RESNAM) 46 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so 47 ; 48 N HLIEN,RESIEN 49 S HLIEN=$P(HLRESIENS,U) 50 S RESIEN=$P(HLRESIENS,U,2) 51 ; 52 ; Get start and end times 53 N TIMES S TIMES=$$TIMES^BSDX35 ; appt time^end time 54 N APPTTIME S APPTTIME=$P(TIMES,U) 55 N ENDTIME S ENDTIME=$P(TIMES,U,2) 56 ; 41 57 ; 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) 58 N ZZZ,DFN 59 S DFN=3 60 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) 44 61 S APPID=+$P(^BSDXTMP($J,1),U) 45 62 D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note") 46 63 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"64 I $O(^SC(2,"S",APPTTIME,1,0))]"" W "Error in Cancellation-2" 65 I $P(^DPT(4,"S",APPTTIME,0),U,2)'="PC" W "Error in Cancellation-3" 49 66 I ^DPT(4,"S",3110123.2,"R")'="Sam's Cancel Note" W "Error in Cancellation-4" 50 67 ; -
Scheduling/trunk/m/BSDX09.m
r1187 r1452 1 1 BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:18am 2 ;;1.6 T2;BSDX;;May 16, 2011;Build 72 ;;1.6;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL 4 4 ; -
Scheduling/trunk/m/BSDXAPI.m
r1451 r1452 1 BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/ 19/12 5:42pm1 BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/20/12 12:40pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL 4 4 ; 5 5 ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW 6 ; localmods (many) by WV/SMH6 ; mods (many) by WV/SMH 7 7 ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH 8 8 ; Change History: … … 87 87 . S BSDXFDA(2.98,BSDXIENS,"15")="" 88 88 . S BSDXFDA(2.98,BSDXIENS,"16")="" 89 . S BSDXFDA(2.98,BSDXIENS,"17")="@" ; v 1.7; cancellation remarks were left over 89 90 . S BSDXFDA(2.98,BSDXIENS,"19")="" 90 91 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT 91 92 . D FILE^DIE("","BSDXFDA","BSDXMSG") 92 93 Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1) 94 ; 95 Q:$G(BSDXSIMERR2) 1_U_$NA(BSDXSIMERR2) ; Unit Test line 93 96 ; 94 97 E D ; File new appointment/edit existing appointment in file 2 … … 102 105 Q:$D(BSDXMSG) 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1) 103 106 ; 107 Q:$G(BSDXSIMERR3) 1_U_$NA(BSDXSIMERR3) ; Unit Test line 108 ; 104 109 ; add appt to file 44. This adds it to the FIRST subfile (Appointment) 105 110 N DIC,DA,Y,X,DD,DO,DLAYGO … … 109 114 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 110 115 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN 116 ; 117 Q:$G(BSDXSIMERR4) 1_U_$NA(BSDXSIMERR4) ; Unit Test line 111 118 ; 112 119 ; add appt for file 44, second subfile (Appointment/Patient) … … 130 137 ; 131 138 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) 139 ; 140 ;Q:$G(BSDXSIMERR5) 1_U_$NA(BSDXSIMERR5) ; Unit Test line 141 S:$G(BSDXSIMERR5) X=1/0 132 142 ; 133 143 ; call event driver … … 176 186 NEW DIK,DA 177 187 S DIK="^DPT("_BSDR("PAT")_",""S""," 178 S DA(1)=BSDR("PAT"),DA=BSD X("ADT")188 S DA(1)=BSDR("PAT"),DA=BSDR("ADT") 179 189 D ^DIK 180 190 ;
Note:
See TracChangeset
for help on using the changeset viewer.
