Changeset 1563 for Scheduling/trunk/m/BSDX26.m
- Timestamp:
- Oct 8, 2012, 6:59:10 AM (12 years ago)
- File:
-
- 1 edited
-
Scheduling/trunk/m/BSDX26.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX26.m
r1481 r1563 1 BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:27am 2 ;;1.7T2;BSDX;;Jul 11, 2012;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 ; 5: Failure to acquire lock on ^BSDXAPPT(APPTID) 15 ; 100: Mumps Error 16 ; 17 ; NB: Normally I use negative numbers for errors; this routine returns 18 ; -1 as a successful result! So I needed to use +ve numbers. 19 ; 1 BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am 2 ;;1.6;BSDX;;Aug 31, 2011;Build 25 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 ; 20 14 EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP 21 ;Entry point for debugging 22 ; 23 ;D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)") 24 Q 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 ; 25 54 EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be edited) 26 ; Called by RPC: BSDX EDIT APPOINTMENT 27 ; 28 ; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file 29 ; 30 ; Parameters: 31 ; - BSDXY: Global Return (RPC must be set to Global Array) 32 ; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT 33 ; - BSDXNOTE: New note 34 ; 35 ; Return: 36 ; ADO.net Recordset having 1 field: ERRORID 37 ; If Okay: -1; otherwise, positive integer with message 38 ; 39 ; Return Array; set Return and clear array 40 S BSDXY=$NA(^BSDXTMP($J)) 41 K ^BSDXTMP($J) 42 ; ET 43 N $ET S $ET="G ETRAP^BSDX26" 44 ; Set up basic DUZ variables 45 D ^XBKVAR 46 ; Counter 47 N BSDXI S BSDXI=0 48 ; Header Node 49 S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30) 50 ; 51 ;;;test for error. See if %ZTER works 52 I $G(BSDXDIE) S X=1/0 53 ; 54 ; Validate Appointment ID 55 I '+BSDXAPTID D ERR(BSDXI,"1~BSDX26: Invalid Appointment ID") QUIT 56 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"2~BSDX26: Invalid Appointment ID") QUIT 57 ; 58 ; Lock BSDX node, only to synchronize access to the globals. 59 ; It's not expected that the error will ever happen as no filing 60 ; is supposed to take 5 seconds. 61 L +^BSDXAPPT(BSDXAPTID):5 E D ERR(BSDXI,"5~BSDX08: Appt record is locked. Please contact technical support.") QUIT 62 ; 63 ; Put the WP in decendant fields from the root to file as a WP field 64 S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" 65 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) 66 ; 67 N BSDXMSG ; Message in case of error in filing. 68 ; 69 ; Save Before State in case we need it for rollback 70 K ^TMP($J) 71 M ^TMP($J,"BEFORE","BSDXAPPT")=^BSDXAPPT(BSDXAPTID) 72 ; 73 ; Update note in BSDX APPOINTMENT 74 I $D(BSDXNOTE(.5)) D 75 . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG") 76 ; 77 ; Error handling. No need for rollback since nothing else changed. 78 I $D(BSDXMSG) D ERR(BSDXI,"3~BSDX26: Fileman failure to file data into 9002018.4") QUIT 79 ; 80 ; Now file in file 44: 81 N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN 82 N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID 83 N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT 84 N BSDXRES S BSDXRES=0 ; Result 85 ; Update Note only if we have a linked hospital location. 86 I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI1(PTIEN,HLIEN,DATE,BSDXNOTE(.5)) 87 ; If we get an error (denoted by -1 in BSDXRES), return error to client 88 ; AND restore the original note 89 I BSDXRES D ERR(BSDXI,"4~BSDX26: BSDXAPI reports an error: "_BSDXRES),ROLLBACK(BSDXAPTID) QUIT 90 ; 91 ;Return Recordset indicating success 92 L -^BSDXAPPT(BSDXAPTID) 93 S BSDXI=BSDXI+1 94 S ^BSDXTMP($J,BSDXI)="-1"_$C(30) 95 S BSDXI=BSDXI+1 96 S ^BSDXTMP($J,BSDXI)=$C(31) 97 ; 98 K ^TMP($J) ; Done; remove TMP data 99 QUIT 100 ; 101 ROLLBACK(BSDXAPTID) ; Rollback note to original in ^BSDXAPPT 102 M ^BSDXAPPT(BSDXAPTID)=^TMP($J,"BEFORE","BSDXAPPT") 103 K ^TMP($J) 104 QUIT 105 ; 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=$$UPDATENOTE^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 ; 106 117 ERR(BSDXI,BSDXERR) ;Error processing 107 ; Unlock first 108 L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID) 109 ; If last line is $C(31), we are done. No more errors to send to client. 110 I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT 111 S BSDXI=BSDXI+1 112 S BSDXERR=$TR(BSDXERR,"^","~") 113 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) 114 S BSDXI=BSDXI+1 115 S ^BSDXTMP($J,BSDXI)=$C(31) 116 QUIT 117 ; 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 ; 118 126 ETRAP ;EP Error trap entry 119 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 120 D ^%ZTER 121 ; 122 I '$D(BSDXI) N BSDXI S BSDXI=0 123 D ERR(BSDXI,"100~BSDX26 Error: "_$G(%ZTERZE)) 124 QUIT 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
Note:
See TracChangeset
for help on using the changeset viewer.
