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

Last change on this file since 1521 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
RevLine 
[1480]1BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:27am
[1481]2 ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
[1460]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:
[1479]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.
[1460]19 ;
[1041]20EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP
[1460]21 ;Entry point for debugging
22 ;
23 ;D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
24 Q
[1041]25EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be edited)
[1460]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
[1479]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
[1460]57 ;
[1479]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 ;
[1460]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 ;
[1480]73 ; Update note in BSDX APPOINTMENT
[1460]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.
[1479]78 I $D(BSDXMSG) D ERR(BSDXI,"3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
[1460]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.
[1479]86 I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI1(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
[1460]87 ; If we get an error (denoted by -1 in BSDXRES), return error to client
88 ; AND restore the original note
[1480]89 I BSDXRES D ERR(BSDXI,"4~BSDX26: BSDXAPI reports an error: "_BSDXRES),ROLLBACK(BSDXAPTID) QUIT
[1460]90 ;
91 ;Return Recordset indicating success
[1479]92 L -^BSDXAPPT(BSDXAPTID)
[1460]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 ;
[1472]101ROLLBACK(BSDXAPTID) ; Rollback note to original in ^BSDXAPPT
[1460]102 M ^BSDXAPPT(BSDXAPTID)=^TMP($J,"BEFORE","BSDXAPPT")
103 K ^TMP($J)
104 QUIT
105 ;
[1041]106ERR(BSDXI,BSDXERR) ;Error processing
[1479]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
[1460]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 ;
[1041]118ETRAP ;EP Error trap entry
[1460]119 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
120 D ^%ZTER
[1479]121 ;
[1460]122 I '$D(BSDXI) N BSDXI S BSDXI=0
[1479]123 D ERR(BSDXI,"100~BSDX26 Error: "_$G(%ZTERZE))
[1460]124 QUIT
Note: See TracBrowser for help on using the repository browser.