source: Scheduling/trunk/m/BSDX31.m@ 1235

Last change on this file since 1235 was 1187, checked in by Sam Habiel, 14 years ago

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.
File size: 7.5 KB
RevLine 
[1161]1BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:28am
[1187]2 ;;1.6T2;BSDX;;May 16, 2011
[1161]3 ; Licensed under LGPL
[1041]4 ; Change Log:
5 ; v1.42 Oct 23 2010 WV/SMH
6 ; - Change transaction to restartable. Thanks to Zach Gonzalez
7 ; --> and Rick Marshall for their help.
8 ; v1.42 Dec 6 2010: Extensive refactoring
9 ;
10 ; Error Reference:
11 ; -1: zero or null Appt ID
12 ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT)
13 ; -3: No-show flag is invalid
14 ; -4: Filing of No-show in ^BSDXAPPT failed
15 ; -5: Filing of No-show in ^DPT failed (BSDXAPI error)
16 ; -100: M Error
17 ;
18 ;
19NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP
20 ;Entry point for debugging
21 ;
22 D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")
23 Q
24 ;
25UT ; Unit Tests
26 ; Test 1: Sanity Check
27 N ZZZ ; Garbage return variable
28 N DATE S DATE=$$NOW^XLFDT()
29 S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform
30 D APPADD^BSDX07(.ZZZ,DATE,DATE+.0001,3,"Dr Office",30,"Old Note",1)
31 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
32 D NOSHOW(.ZZZ,APPID,1)
33 I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",! B
34 I $P(^DPT(3,"S",DATE,0),U,2)'="N" W "ERROR T1",! B
35 ; Test 2: Undo noshow
36 D NOSHOW(.ZZZ,APPID,0)
37 I $P(^BSDXAPPT(APPID,0),U,10)'="0" W "ERROR T2",! B
38 I $P(^DPT(3,"S",DATE,0),U,2)'="" W "ERROR T2",! B
39 ; Test 3: -1
40 D NOSHOW(.ZZZ,"",0)
41 I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",! B
42 ; Test 4: -2
43 D NOSHOW(.ZZZ,2938748233,0)
44 I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",! B
45 ; Test 5: -3
46 D NOSHOW(.ZZZ,APPID,3)
47 I $P(^BSDXTMP($J,1),U)'=-3 W "ERROR T5",! B
48 ; Test 6: Mumps error (-100)
49 s bsdxdie=1
50 D NOSHOW(.ZZZ,APPID,1)
51 I $P(^BSDXTMP($J,1),U)'=-100 W "ERROR T6",! B
52 k bsdxdie
53 ; Test 7: Restartable transaction
54 s bsdxrestart=1
55 D NOSHOW(.ZZZ,APPID,1)
56 I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T7",! B
57 QUIT
58NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP - No show a patient
59 ; Called by RPC: BSDX NOSHOW
60 ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2
61 ;
62 ; Parameters:
63 ; BSDXY: Global Return
64 ; BSDXAPTID is entry number in BSDX APPOINTMENT file
65 ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO
66 ;
67 ; Returns ADO.net record set with fields
68 ; - ERRORID; ERRORTEXT
69 ; ERRORID of 1 is okay
70 ; Anything else is an error.
71 ;
72 ; Return Array; set and clear
73 S BSDXY=$NA(^BSDXTMP($J))
74 K ^BSDXTMP($J)
75 ; $ET
76 N $ET S $ET="G ETRAP^BSDX31"
77 ; Basline vars
78 D ^XBKVAR ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist
79 ; Counter
80 N BSDXI S BSDXI=0
81 ; Header Node
82 S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30)
83 ; Begin transaction
84 TSTART (BSDXI,BSDXY,BSDXAPTID,BSDXNS):T="BSDX NOSHOW CANCEL^BSDX29"
85 ;;;test for error inside transaction. See if %ZTER works
86 I $G(bsdxdie) S X=1/0
87 ;;;TEST
88 ;;;test for TRESTART
89 I $G(bsdxrestart) K bsdxrestart TRESTART
90 ;;;test
91 ; Turn off SDAM APPT PROTOCOL BSDX Entries
92 N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
93 ; Appointment ID check
94 I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q
95 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q
96 ; Noshow value check - Must be 1 or 0
97 S BSDXNS=+BSDXNS
98 I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q
99 ; Get Some data
100 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node
101 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
102 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date/Time
103 ; Edit BSDX APPOINTMENT entry
104 N BSDXMSG ;
105 D BSDXNOS(BSDXAPTID,BSDXNS,.BSDXMSG) ;Edit BSDX APPOINTMENT entry NOSHOW field
106 I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(-4,"BSDX31: "_BSDXMSG) Q
107 ; Edit File 2 "S" node entry
108 N BSDXZ,BSDXERR ; Error variables to control looping
109 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
110 ; If Resource ID exists, and HL exists (means that Resource is linked), No show in File 2
111 I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(-5,BSDXERR) Q
112 . S BSDXNOD=^BSDXRES(BSDXSC1,0)
113 . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
114 . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS)
115 ;
116 TCOMMIT
117 S BSDXI=BSDXI+1
118 S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay
119 S BSDXI=BSDXI+1
120 S ^BSDXTMP($J,BSDXI)=$C(31)
121 QUIT
122 ;
123APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS) ;
124 ; update file 2 info
125 ;Set noshow for patient BSDXDFN in clinic BSDXSC1
126 ;at time BSDXSD
127 N BSDXC,%H,BSDXCDT,BSDXIEN
128 N BSDXIENS,BSDXFDA,BSDXMSG
129 S %H=$H D YMD^%DTC
130 S BSDXCDT=X+%
131 ;
132 S BSDXIENS=BSDXSD_","_BSDXDFN_","
133 I +BSDXNS D
134 . S BSDXFDA(2.98,BSDXIENS,3)="N"
135 . S BSDXFDA(2.98,BSDXIENS,14)=DUZ
136 . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT
137 E D
138 . S BSDXFDA(2.98,BSDXIENS,3)=""
139 . S BSDXFDA(2.98,BSDXIENS,14)=""
140 . S BSDXFDA(2.98,BSDXIENS,15)=""
141 K BSDXIEN
142 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
143 S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1))
144 Q
145 ;
146BSDXNOS(BSDXAPTID,BSDXNS,BSDXMSG) ;
147 ;
148 N BSDXFDA,BSDXIENS
149 S BSDXIENS=BSDXAPTID_","
150 S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW
151 D FILE^DIE("","BSDXFDA","BSDXMSG")
152 QUIT
153 ;
154NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event
155 ;when appointments NOSHOW via PIMS interface.
156 ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients
157 ;
158 Q:+$G(BSDXNOEV)
159 Q:'+$G(BSDXSC)
160 Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
161 N BSDXSTAT,BSDXFOUND,BSDXRES
162 S BSDXSTAT=1
163 S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0
164 S BSDXFOUND=0
165 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
166 I BSDXFOUND D NOSEVT3(BSDXRES) Q
167 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
168 I BSDXFOUND D NOSEVT3(BSDXRES)
169 Q
170 ;
171NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
172 ;Get appointment id in BSDXAPT
173 ;If found, call BSDXNOS(BSDXAPPT) and return 1
174 ;else return 0
175 N BSDXFOUND,BSDXAPPT
176 S BSDXFOUND=0
177 Q:'+$G(BSDXRES) BSDXFOUND
178 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
179 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND
180 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
181 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
182 I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT)
183 Q BSDXFOUND
184 ;
185NOSEVT3(BSDXRES) ;
186 ;Call RaiseEvent to notify GUI clients
187 ;
188 N BSDXRESN
189 S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
190 Q:BSDXRESN=""
191 S BSDXRESN=$P(BSDXRESN,"^")
192 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
193 Q
194 ;
195 ;
196ERR(BSDXERID,ERRTXT) ;Error processing
197 S BSDXI=BSDXI+1
198 S ERRTXT=$TR(ERRTXT,"^","~")
199 I $TL>0 TROLLBACK
200 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
201 S BSDXI=BSDXI+1
202 S ^BSDXTMP($J,BSDXI)=$C(31)
203 QUIT
204 ;
205ETRAP ;EP Error trap entry
206 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
207 ; Rollback, otherwise ^XTER will be empty from future rollback
208 I $TL>0 TROLLBACK
209 D ^%ZTER
210 S $EC="" ; Clear Error
211 ; Send to client
212 I '$D(BSDXI) N BSDXI S BSDXI=0
213 D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE))
214 QUIT
215 ;
216IMHERE(BSDXRES) ;EP
217 ;Entry point for BSDX IM HERE remote procedure
218 S BSDXRES=1
219 Q
220 ;
Note: See TracBrowser for help on using the repository browser.