Changeset 1460
- Timestamp:
- Jun 25, 2012, 8:54:59 PM (12 years ago)
- Location:
- Scheduling/trunk/m
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX08.m
r1455 r1460 1 BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/2 2/12 4:19pm1 BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/25/12 6:17pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; … … 94 94 I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT 95 95 ; 96 ; Process PIMS issues first: 96 ; BSDXAPPT First; todo: check for error 97 D BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT 98 ; 99 ; Process PIMS issues second: 97 100 ; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability 98 101 ; Get zero node of resouce … … 120 123 . ; 121 124 . N BSDXLEN S BSDXLEN=$$APPLEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) 122 . ; DEBUG 123 . I 'BSDXLEN S $EC=",U1," 124 . ; DEBUG 125 . ; 125 126 . ; Cancel through BSDXAPI 126 127 . S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) … … 129 130 . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN) 130 131 ; 131 D BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT132 132 ; 133 133 L -^BSDXAPPT(BSDXAPTID) … … 138 138 Q 139 139 ; 140 ROLLBACK(BSDXAPTID) 140 141 AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update Legacy PIMS Clinic availability 141 142 ;See SDCNP0 -
Scheduling/trunk/m/BSDX26.m
r1450 r1460 1 BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/18/12 5:33pm 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 ; Licensed under LGPL 4 ; Change History: 5 ; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx. 6 ; --> Thanks to Zach Gonzalez and Rick Marshall 7 ; 3101205 - UJO/SMH - Extensive refactoring. 8 ; 9 ; Error Reference: 10 ; -1: Appt ID is not a number 11 ; -2: Appt IEN is not in ^BSDXAPPT 12 ; -3: FM Failure to file WP field in ^BSDXAPPT 13 ; 1 BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/25/12 4:29pm 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 ; Licensed under LGPL 4 ; Change History: 5 ; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx. 6 ; 3101205 - UJO/SMH - Extensive refactoring. 7 ; 3120625 - VEN/SMH - Removal of Transactions, reloation of UTs to BSDXUT1 8 ; 9 ; Error Reference: 10 ; -1: Appt ID is not a number 11 ; -2: Appt IEN is not in ^BSDXAPPT 12 ; -3: FM Failure to file WP field in ^BSDXAPPT 13 ; -4: BSDXAPI reports failure to change note field in ^SC 14 ; 14 15 EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP 15 ;Entry point for debugging 16 ; 17 D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)") 18 Q 19 UT ; Unit Tests 20 ; Test 1: Make sure this damn thing works 21 N ZZZ 22 N %H S %H=$H 23 N NOTE S NOTE="New Note "_%H 24 D EDITAPT(.ZZZ,188,NOTE) 25 I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR",! B 26 ; Test 2: Test Errors -1 and -2 27 N ZZZ 28 N NOTE S NOTE="Nothing important" 29 D EDITAPT(.ZZZ,"BLAHBLAH",NOTE) 30 I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",! B 31 D EDITAPT(.ZZZ,298734322,NOTE) 32 I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",! B 33 ; Test 4: M Error 34 N bsdxdie S bsdxdie=1 35 D EDITAPT(.ZZZ,188,NOTE) 36 I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",! B 37 k bsdxdie 38 ; Test 5: Trestart 39 N bsdxrestart S bsdxrestart=1 40 N %H S %H=$H 41 N NOTE S NOTE="New Note "_%H 42 D EDITAPT(.ZZZ,188,NOTE) 43 I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR in TRESTART",! B 44 ; Test 6: for Hosp Location Update 45 N DATE S DATE=$$NOW^XLFDT() 46 S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform 47 D APPADD^BSDX07(.ZZZ,DATE,DATE+.001,3,"Dr Office",30,"Old Note",1) 48 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 49 D EDITAPT(.ZZZ,APPID,"New Note") 50 I ^BSDXAPPT(APTID,1,1,0)'="New Note" W "Error in HL Section",! B 51 I $P(^SC(2,"S",DATE,1,1,0),U,4)'="New Note" W "Error in HL Section",! B 52 QUIT 53 ; 16 ;Entry point for debugging 17 ; 18 ;D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)") 19 Q 54 20 EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be edited) 55 ; Called by RPC: BSDX EDIT APPOINTMENT 56 ; 57 ; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file 58 ; 59 ; Parameters: 60 ; - BSDXY: Global Return (RPC must be set to Global Array) 61 ; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT 62 ; - BSDXNOTE: New note 63 ; 64 ; Return: 65 ; ADO.net Recordset having 1 field: ERRORID 66 ; If Okay: -1; otherwise, positive integer with message 67 ; 68 ; Return Array; set Return and clear array 69 S BSDXY=$NA(^BSDXTMP($J)) 70 K ^BSDXTMP($J) 71 ; ET 72 N $ET S $ET="G ETRAP^BSDX26" 73 ; Set up basic DUZ variables 74 D ^XBKVAR 75 ; Counter 76 N BSDXI S BSDXI=0 77 ; Header Node 78 S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30) 79 ; Restartable txn for GT.M. Restored vars are Params + BSDXI. 80 TSTART (BSDXY,BSDXAPTID,BSDXNOTE,BSDXI):T="BSDX EDIT APPOINTMENT^BSDX26" 81 ; 82 ;;;test for error inside transaction. See if %ZTER works 83 I $G(bsdxdie) S X=1/0 84 ;;;test 85 ;;;test for TRESTART 86 I $G(bsdxrestart) K bsdxrestart TRESTART 87 ;;;test 88 ; 89 ; Validate Appointment ID 90 I '+BSDXAPTID D ERR(BSDXI,"-1~BSDX26: Invalid Appointment ID") QUIT 91 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-2~BSDX26: Invalid Appointment ID") QUIT 92 ; Put the WP in decendant fields from the root to file as a WP field 93 S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" 94 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) 95 N BSDXMSG ; Message in case of error in filing. 96 I $D(BSDXNOTE(.5)) D 97 . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG") 98 I $D(BSDXMSG) D ERR(BSDXI,"-3~BSDX26: Fileman failure to file data into 9002018.4") QUIT 99 ; 100 ; Now file in file 44: 101 N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN 102 N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID 103 N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT 104 N BSDXRES S BSDXRES=0 ; Result 105 ; Update Note only if we have a linked hospital location. 106 I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5)) 107 ; If we get an error (denoted by -1 in BSDXRES), return error to client 108 I BSDXRES<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES) QUIT 109 ;Return Recordset 110 TCOMMIT 111 S BSDXI=BSDXI+1 112 S ^BSDXTMP($J,BSDXI)="-1"_$C(30) 113 S BSDXI=BSDXI+1 114 S ^BSDXTMP($J,BSDXI)=$C(31) 115 QUIT 116 ; 21 ; Called by RPC: BSDX EDIT APPOINTMENT 22 ; 23 ; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file 24 ; 25 ; Parameters: 26 ; - BSDXY: Global Return (RPC must be set to Global Array) 27 ; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT 28 ; - BSDXNOTE: New note 29 ; 30 ; Return: 31 ; ADO.net Recordset having 1 field: ERRORID 32 ; If Okay: -1; otherwise, positive integer with message 33 ; 34 ; Return Array; set Return and clear array 35 S BSDXY=$NA(^BSDXTMP($J)) 36 K ^BSDXTMP($J) 37 ; ET 38 N $ET S $ET="G ETRAP^BSDX26" 39 ; Set up basic DUZ variables 40 D ^XBKVAR 41 ; Counter 42 N BSDXI S BSDXI=0 43 ; Header Node 44 S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30) 45 ; 46 ;;;test for error. See if %ZTER works 47 I $G(BSDXDIE) S X=1/0 48 ; 49 ; Validate Appointment ID 50 I '+BSDXAPTID D ERR(BSDXI,"-1~BSDX26: Invalid Appointment ID") QUIT 51 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-2~BSDX26: Invalid Appointment ID") QUIT 52 ; 53 ; Put the WP in decendant fields from the root to file as a WP field 54 S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" 55 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) 56 ; 57 N BSDXMSG ; Message in case of error in filing. 58 ; 59 ; Save Before State in case we need it for rollback 60 K ^TMP($J) 61 M ^TMP($J,"BEFORE","BSDXAPPT")=^BSDXAPPT(BSDXAPTID) 62 ; 63 I $D(BSDXNOTE(.5)) D 64 . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG") 65 ; 66 ; Error handling. No need for rollback since nothing else changed. 67 I $D(BSDXMSG) D ERR(BSDXI,"-3~BSDX26: Fileman failure to file data into 9002018.4") QUIT 68 ; 69 ; Now file in file 44: 70 N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN 71 N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID 72 N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT 73 N BSDXRES S BSDXRES=0 ; Result 74 ; Update Note only if we have a linked hospital location. 75 I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5)) 76 ; If we get an error (denoted by -1 in BSDXRES), return error to client 77 ; AND restore the original note 78 I BSDXRES<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES),ROLLBACK(BSDXAPTID) QUIT 79 ; 80 ;Return Recordset indicating success 81 S BSDXI=BSDXI+1 82 S ^BSDXTMP($J,BSDXI)="-1"_$C(30) 83 S BSDXI=BSDXI+1 84 S ^BSDXTMP($J,BSDXI)=$C(31) 85 ; 86 K ^TMP($J) ; Done; remove TMP data 87 QUIT 88 ; 89 ROLLBACK(BSDXAPTID) ; Rollback note to original in ^BSDXAPPT 90 M ^BSDXAPPT(BSDXAPTID)=^TMP($J,"BEFORE","BSDXAPPT") 91 K ^TMP($J) 92 QUIT 93 ; 117 94 ERR(BSDXI,BSDXERR) ;Error processing 118 S BSDXI=BSDXI+1 119 S BSDXERR=$TR(BSDXERR,"^","~") 120 I $TL>0 TROLLBACK 121 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) 122 S BSDXI=BSDXI+1 123 S ^BSDXTMP($J,BSDXI)=$C(31) 124 QUIT 125 ; 95 S BSDXI=BSDXI+1 96 S BSDXERR=$TR(BSDXERR,"^","~") 97 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) 98 S BSDXI=BSDXI+1 99 S ^BSDXTMP($J,BSDXI)=$C(31) 100 QUIT 101 ; 126 102 ETRAP ;EP Error trap entry 127 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 128 I $TL>0 TROLLBACK 129 D ^%ZTER 130 S $EC="" 131 I '$D(BSDXI) N BSDXI S BSDXI=0 132 D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE)) 133 Q 103 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 104 D ^%ZTER 105 S $EC="" 106 I '$D(BSDXI) N BSDXI S BSDXI=0 107 D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE)) 108 QUIT -
Scheduling/trunk/m/BSDXAPI.m
r1456 r1460 1 BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/2 2/12 4:25pm1 BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/25/12 6:13pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL … … 44 44 ; for Baby foxes hallucinations. 45 45 ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes") 46 N BSDR 46 47 S BSDR("PAT")=DFN ;DFN 47 48 S BSDR("CLN")=CLIN ;Hosp Loc IEN … … 108 109 ; 109 110 ; add appt to file 44. This adds it to the FIRST subfile (Appointment) 110 N DIC,DA,Y,X,DD,DO,DLAYGO 111 N DIC,DA,Y,X,DD,DO,DLAYGO,DINUM 111 112 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^" 112 113 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") … … 202 203 ; for appt at Dec 20, 2009 @ 10:11:59 203 204 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159) 205 N BSDR 204 206 S BSDR("PAT")=DFN ;DFN 205 207 S BSDR("CLN")=CLIN ;Hosp Loc IEN … … 238 240 ; 239 241 ; remember before status 240 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL 242 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE 241 243 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN 242 244 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL … … 264 266 ; because foxes come out during bad weather. 265 267 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes") 268 N BSDR 266 269 S BSDR("PAT")=DFN 267 270 S BSDR("CLN")=CLIN … … 292 295 ; = 1^message: error and reason 293 296 ; 297 ; Okay to Cancel? Call Cancel Check. 294 298 N BSDXCANCK S BSDXCANCK=$$CANCELCK(.BSDR) 295 299 I BSDXCANCK Q BSDXCANCK … … 297 301 ; BSDX 1.5 3110125 298 302 ; UJO/SMH - Add ability to remove check-in if the patient is checked in 299 ; I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") 300 ; Remove check-in if the patient is checked in. 301 N BSDXRESULT S BSDXRESULT=0 ; Result; should be zero if success; -1 + message if failure 302 NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 303 I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) SET BSDXRESULT=$$RMCI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 304 I BSDXRESULT Q BSDXRESULT 305 ; NB: Failure point 1: we fail here nothing has happened yet 303 ; VEN/SMH on 3120625/v1.7 - PIMS doesn't care if patient is already checked in 304 ; Lets you remove appointment anyways! Not like RPMS. 305 ; Plus... deleting checkin affects S node on 44, which is DELETED anyways! 306 306 ; 307 307 ; remember before status 308 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL 308 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL,SDMODE 309 309 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN 310 310 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 311 311 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) 312 ; NB: Here only globals are set. Nothing else.312 ; NB: Here only ^TMP globals are set with before values. 313 313 ; 314 314 ; get user who made appt and date appt made from ^SC … … 318 318 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) 319 319 ; 320 ; update file 2 info 321 NEW DIE,DA,DR 322 S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT 323 S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE 324 S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160) 325 D ^DIE 326 ; Failure point 2: If we fail here, it means that the check-in was removed; 327 ; but the appointment wasn't cancelled. 328 ; To roll back, we should restore the check-in. However, I would rather not 329 ; do that. This code will only fail if there's something wrong in the DB. 330 ; (deleted field for example). If I try to restore the check-in, I just 331 ; may excercerbate the problem. 332 ; 333 ; delete data in ^SC 320 ; update file 2 info --old code 321 ;NEW DIE,DA,DR 322 ;S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT 323 ;S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE 324 ;S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160) 325 ;D ^DIE 326 N BSDXIENS S BSDXIENS=SDT_","_DFN_"," 327 N BSDXFDA 328 S BSDXFDA(2.98,BSDXIENS,3)=BSDR("TYP") 329 S BSDXFDA(2.98,BSDXIENS,14)=BSDR("USR") 330 S BSDXFDA(2.98,BSDXIENS,15)=BSDR("CDT") 331 S BSDXFDA(2.98,BSDXIENS,16)=BSDR("CR") 332 S BSDXFDA(2.98,BSDXIENS,19)=USER 333 S BSDXFDA(2.98,BSDXIENS,20)=DATE 334 S:$G(BSDR("NOT"))]"" BSDXFDA(2.98,BSDXIENS,17)=$E(BSDR("NOT"),1,160) 335 N BSDXERR 336 D FILE^DIE("","BSDXFDA","BSDXERR") 337 I $D(BSDXERR) Q 1_U_"Cannot cancel appointment in File 2" 338 ; Failure point 1: If we fail here, nothing has happened yet. 339 ; No rollback needed in ^BSDXAPPT 340 ; 341 ; delete data in ^SC -- this does not (typically) fail. Fileman won't stop 334 342 NEW DIK,DA 335 343 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 336 344 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN 337 345 D ^DIK 338 ; Failure point 3: If we fail here, we need to restore the cancel date, 339 ; and possibly, the check-in. 340 ; 341 ; call event driver 346 ; Failure point 2: not expected to happen here 347 ; 348 ; call event driver -- point of no return 342 349 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) 343 350 Q 0 … … 378 385 ; 379 386 ; Move my variables into the ones used by SDAPIs (just a convenience) 380 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL 387 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE 381 388 S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN(DFN,SDCL,SDT) 382 389 ; … … 389 396 ; remove check-in using filer. 390 397 N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_"," 398 N BSDXFDA 391 399 S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN 392 400 S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER … … 397 405 ; 398 406 ; set after status 399 S SDDA=$$SCIEN(DFN,SDCL,SDT)407 ; S SDDA=$$SCIEN(DFN,SDCL,SDT) ;smh -why is this here? SDDA won't change. 400 408 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 401 409 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) … … 437 445 ; 0 if okay 438 446 ; -1 if failure 447 ; 448 ; ERROR SIMULATION 449 I $G(BSDXSIMERR1) QUIT "-1~Simulated Error" 450 ; 439 451 N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC 440 452 I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44 441 453 N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_"," 442 S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)454 N BSDXFDA S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150) 443 455 N BSDXERR 444 456 D FILE^DIE("","BSDXFDA","BSDXERR") -
Scheduling/trunk/m/BSDXUT1.m
r1455 r1460 1 BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/2 2/12 1:44pm1 BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/25/12 4:13pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; … … 86 86 W "Last line should say 0",! 87 87 QUIT 88 ; 89 UT26 ; Unit Tests - BSDX26 90 ; 91 ; Test 1: Make sure this damn thing works 92 ; Set-up - Create Clinics 93 N RESNAM S RESNAM="UTCLINIC" 94 N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN 95 D 96 . N $ET S $ET="D ^%ZTER B" 97 . S HLRESIENS=$$UTCR^BSDXUT(RESNAM) 98 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so 99 ; 100 N HLIEN,RESIEN 101 S HLIEN=$P(HLRESIENS,U) 102 S RESIEN=$P(HLRESIENS,U,2) 103 ; 104 ; Get start and end times 105 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time 106 N APPTTIME S APPTTIME=$P(TIMES,U) 107 N ENDTIME S ENDTIME=$P(TIMES,U,2) 108 ; 109 ; Make appt 110 N ZZZ,DFN 111 S DFN=3 112 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) 113 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 114 ; 115 ; Now edit the note - basic test 116 N %H S %H=$H 117 N NOTE S NOTE="New Note "_%H 118 D EDITAPT^BSDX26(.ZZZ,APPID,NOTE) 119 I ^BSDXAPPT(APPID,1,1,0)'=NOTE W "ERROR 1",! 120 I $P(^SC(HLIEN,"S",APPTTIME,1,1,0),U,4)'=NOTE W "Error in HL Section",! 121 ; 122 ; Test 2: Test Error -1 123 ; -1 --> ApptID not a number 124 N ZZZ 125 N NOTE S NOTE="Nothing important" 126 D EDITAPT^BSDX26(.ZZZ,"BLAHBLAH",NOTE) 127 I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",! 128 ; 129 ; Test 3: Test Error -2 130 ; -2 --> ApptID not in ^BSDXAPPT 131 D EDITAPT^BSDX26(.ZZZ,298734322,NOTE) 132 I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",! 133 ; 134 ; Test 4: M Error 135 N BSDXDIE S BSDXDIE=1 136 D EDITAPT^BSDX26(.ZZZ,188,NOTE) 137 I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",! 138 K BSDXDIE 139 ; Test 5: Trestart -- retired in v1.7 140 ; 141 ; Test 6: UTs for an unlinked resource (not linked to PIMS) 142 N RESNAM S RESNAM="UTCLINICUL" ; Unlinked Clinic 143 N RESIEN 144 D 145 . N $ET S $ET="D ^%ZTER B" 146 . S RESIEN=$$UTCRRES^BSDXUT(RESNAM) 147 . I RESIEN<0 S $EC=",U1," ; not supposed to happen - hard crash if so 148 ; 149 ; Get start and end times 150 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time 151 N APPTTIME S APPTTIME=$P(TIMES,U) 152 N ENDTIME S ENDTIME=$P(TIMES,U,2) 153 ; 154 N ZZZ,DFN 155 S DFN=3 156 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) 157 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 158 ; Now edit the note - basic test 159 N %H S %H=$H 160 N NOTE S NOTE="New Note "_%H 161 D EDITAPT^BSDX26(.ZZZ,APPID,NOTE) 162 I ^BSDXAPPT(APPID,1,1,0)'=NOTE W "ERROR 2",! 163 ; 164 ; Test 7: Simulated failure in BSDXAPI 165 N RESNAM S RESNAM="UTCLINIC" 166 N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN 167 D 168 . N $ET S $ET="D ^%ZTER B" 169 . S HLRESIENS=$$UTCR^BSDXUT(RESNAM) 170 . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so 171 ; 172 N HLIEN,RESIEN 173 S HLIEN=$P(HLRESIENS,U) 174 S RESIEN=$P(HLRESIENS,U,2) 175 ; 176 ; Get start and end times 177 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time 178 N APPTTIME S APPTTIME=$P(TIMES,U) 179 N ENDTIME S ENDTIME=$P(TIMES,U,2) 180 ; 181 ; Make appt 182 N ZZZ,DFN 183 S DFN=3 184 N ORIGNOTE S ORIGNOTE="Sam's Note" 185 D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,ORIGNOTE,1) 186 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 187 ; 188 ; Create the error condition 189 N BSDXSIMERR1 S BSDXSIMERR1=1 190 ; 191 ; Try to edit the note. Should still be "Sam's Note" 192 N %H S %H=$H 193 N NOTE S NOTE="New Note "_%H 194 D EDITAPT^BSDX26(.ZZZ,APPID,NOTE) 195 I +^BSDXTMP($J,1)'=-4 W "Simulated error not triggered",! 196 I ^BSDXAPPT(APPID,1,1,0)'=ORIGNOTE ZWRITE ^(*) W "ERROR 3",! 197 I $P(^SC(HLIEN,"S",APPTTIME,1,1,0),U,4)'=ORIGNOTE W "ERROR 4",! 198 QUIT
Note:
See TracChangeset
for help on using the changeset viewer.