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

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

Updated routine version numbers to 1.7T2.
Changes the Writes in the post-init to MESXPDUTL in BSDX2E.
Changed the check for BMX to be for BMX 4 rather than BMX 2.
File size: 4.2 KB
Line 
1BSDX26 ; 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 ;
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 ; 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 ;
101ROLLBACK(BSDXAPTID) ; Rollback note to original in ^BSDXAPPT
102 M ^BSDXAPPT(BSDXAPTID)=^TMP($J,"BEFORE","BSDXAPPT")
103 K ^TMP($J)
104 QUIT
105 ;
106ERR(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 ;
118ETRAP ;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
Note: See TracBrowser for help on using the repository browser.