source: Scheduling/trunk/m/BSDX26.m@ 1479

Last change on this file since 1479 was 1479, checked in by Sam Habiel, 12 years ago

Added/fixed the following:

  • Unit Tests for running everything through PIMS
  • Checks for end of message for error handling ((31))
  • All routines previously using transactions use locks now
File size: 4.2 KB
Line 
1BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 2:19pm
2 ;;1.7T1;BSDX;;Jul 06, 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 ;
20EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP
21 ;Entry point for debugging
22 ;
23 ;D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
24 Q
25EDITAPT(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 I $D(BSDXNOTE(.5)) D
74 . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG")
75 ;
76 ; Error handling. No need for rollback since nothing else changed.
77 I $D(BSDXMSG) D ERR(BSDXI,"3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
78 ;
79 ; Now file in file 44:
80 N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN
81 N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID
82 N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT
83 N BSDXRES S BSDXRES=0 ; Result
84 ; Update Note only if we have a linked hospital location.
85 I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI1(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
86 ; If we get an error (denoted by -1 in BSDXRES), return error to client
87 ; AND restore the original note
88 I BSDXRES<0 D ERR(BSDXI,"4~BSDX26: BSDXAPI reports an error: "_BSDXRES),ROLLBACK(BSDXAPTID) QUIT
89 ;
90 ;Return Recordset indicating success
91 L -^BSDXAPPT(BSDXAPTID)
92 S BSDXI=BSDXI+1
93 S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
94 S BSDXI=BSDXI+1
95 S ^BSDXTMP($J,BSDXI)=$C(31)
96 ;
97 K ^TMP($J) ; Done; remove TMP data
98 QUIT
99 ;
100ROLLBACK(BSDXAPTID) ; Rollback note to original in ^BSDXAPPT
101 M ^BSDXAPPT(BSDXAPTID)=^TMP($J,"BEFORE","BSDXAPPT")
102 K ^TMP($J)
103 QUIT
104 ;
105ERR(BSDXI,BSDXERR) ;Error processing
106 ; Unlock first
107 L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
108 ; If last line is $C(31), we are done. No more errors to send to client.
109 I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
110 S BSDXI=BSDXI+1
111 S BSDXERR=$TR(BSDXERR,"^","~")
112 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
113 S BSDXI=BSDXI+1
114 S ^BSDXTMP($J,BSDXI)=$C(31)
115 QUIT
116 ;
117ETRAP ;EP Error trap entry
118 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
119 D ^%ZTER
120 ;
121 I '$D(BSDXI) N BSDXI S BSDXI=0
122 D ERR(BSDXI,"100~BSDX26 Error: "_$G(%ZTERZE))
123 QUIT
Note: See TracBrowser for help on using the repository browser.