source: Scheduling/trunk/m/BSDX25.m@ 1326

Last change on this file since 1326 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: 8.3 KB
Line 
1BSDX25 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
2 ;;1.6T2;BSDX;;May 16, 2011
3 ; Licensed under LGPL
4 ;
5 ; Change Log:
6 ; 3110106: SMH -> Changed Check-in EP - Removed unused paramters. Will change C#
7 ;
8 ;
9UT ; Unit Tests
10 ; Make appointment, checkin, then uncheckin
11 N ZZZ
12 N APPTTIME S APPTTIME=$E($$NOW^XLFDT(),1,12)
13 D APPADD^BSDX07(.ZZZ,APPTTIME,APPTTIME+.0001,3,"Dr Office",30,"Sam's Note",1)
14 N APPTID S APPTID=+^BSDXTMP($J,1)
15 N HL S HL=$$GET1^DIQ(9002018.4,APPTID,".07:.04","I")
16 D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT())
17 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 1",!
18 IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 2",!
19 D RMCI^BSDX25(.ZZZ,APPTID)
20 IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 1",!
21 IF $G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 2",!
22 D RMCI^BSDX25(.ZZZ,APPTID) ; again, test sanity in repeat
23 IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 1",!
24 IF $G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 2",!
25 ; now test various error conditions
26 ; Test Error 1
27 D RMCI^BSDX25(.ZZZ,)
28 IF +^BSDXTMP($J,1)'=-1 WRITE "ERROR IN ETest 1",!
29 ; Test Error 2
30 D RMCI^BSDX25(.ZZZ,234987234398)
31 IF +^BSDXTMP($J,1)'=-2 WRITE "ERROR IN Etest 2",!
32 ; Tests for 3 to 5 difficult to produce
33 ; Error tests follow: Mumps error test; Transaction restartability
34 N bsdxdie S bsdxdie=1
35 D RMCI^BSDX25(.ZZZ,APPTID)
36 IF +^BSDXTMP($J,1)'=-20 WRITE "ERROR IN Etest 3",!
37 K bsdxdie
38 N bsdxrestart S bsdxrestart=1
39 D RMCI^BSDX25(.ZZZ,APPTID)
40 IF +^BSDXTMP($J,1)'=0 WRITE "Error in Etest 4",!
41 QUIT
42CHECKIND(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP
43 ;Entry point for debugging
44 ;
45 ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))
46 Q
47 ;
48CHECKIN(BSDXY,BSDXAPTID,BSDXCDT) ; ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP Check in appointment
49 ; Private to GUI; use BSDXAPI for general API to checkin patients
50 ; Parameters:
51 ; BSDXY: Global Out
52 ; BSDXAPTID: Appointment ID in ^BSDXAPPT
53 ; BSDXCDT: Checkin Date --> Changed
54 ; BSDXCC: Clinic Stop IEN (not used)
55 ; BSDXPRV: Provider IEN (not used)
56 ; BSDXROU: Print Routing Slip? (not used)
57 ; BSDXVCL: PCC+ Clinic IEN (not used)
58 ; BSDXVFM: PCC+ Form IEN (not used)
59 ; BSDXOG: PCC+ Outguide (true or false)
60 ;
61 ; Output:
62 ; ADO.net table with 1 column ErrorID, 1 row result
63 ; - 0 if all okay
64 ; - Another number or text if not
65
66 N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXZ,BSDXIENS,BSDXVEN
67 N BSDXNOEV
68 S BSDXNOEV=1 ;Don't execute protocol
69 ;
70 D ^XBKVAR S X="ERROR^BSDX25",@^%ZOSF("TRAP")
71 S BSDXI=0
72 K ^BSDXTMP($J)
73 S BSDXY="^BSDXTMP("_$J_")"
74 S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
75 I '+BSDXAPTID D ERR("BSDX25: Invalid Appointment ID") Q
76 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR("BSDX08: Invalid Appointment ID") Q
77 ; Remove Date formatting v.1.5. Client will send date as FM Date.
78 ;S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@")
79 ;S %DT="T",X=BSDXCDT D ^%DT S BSDXCDT=Y
80 S BSDXCDT=+BSDXCDT ; Strip off zeros if C# sends them
81 I BSDXCDT=-1 D ERR(70) Q
82 I BSDXCDT>$$NOW^XLFDT S BSDXCDT=$$NOW^XLFDT
83 ;Checkin BSDX APPOINTMENT entry
84 D BSDXCHK(BSDXAPTID,BSDXCDT)
85 S BSDXNOD=^BSDXAPPT(BSDXAPTID,0)
86 S BSDXPATID=$P(BSDXNOD,U,5)
87 S BSDXSTART=$P(BSDXNOD,U)
88 ;
89 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
90 I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I +$G(BSDXZ) D ERR($P(BSDXZ,U,2)) Q
91 . S BSDXNOD=^BSDXRES(BSDXSC1,0)
92 . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
93 . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APCHK(.BSDXZ,BSDXSC1,BSDXPATID,BSDXCDT,BSDXSTART)
94 ;
95 S BSDXI=BSDXI+1
96 S ^BSDXTMP($J,BSDXI)="0"_$C(30)
97 S BSDXI=BSDXI+1
98 S ^BSDXTMP($J,BSDXI)=$C(31)
99 Q
100 ;
101BSDXCHK(BSDXAPTID,BSDXCDT) ;
102 ;
103 S BSDXIENS=BSDXAPTID_","
104 S BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT
105 D FILE^DIE("","BSDXFDA","BSDXMSG")
106 Q
107 ;
108APCHK(BSDXZ,BSDXSC1,BSDXDFN,BSDXCDT,BSDXSTART) ;
109 ;Checkin appointment for patient BSDXDFN in clinic BSDXSC1
110 ;at time BSDXSTART
111 S BSDXZ=$$CHECKIN1^BSDXAPI(BSDXDFN,BSDXSC1,BSDXSTART)
112 Q
113 ;
114RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44
115 ; Called by RPC [Fill in later]
116 ;
117 ; Parameters to pass:
118 ; APPTID: IEN in file BSDX APPOINTMENT
119 ;
120 ; Return in global array:
121 ; Record set with Column ERRORID; value of 0 AOK; other value
122 ; --> means that something went wrong
123 ;
124 ; Error Reference:
125 ; -1~Invalid Appointment ID (not passed)
126 ; -2~Invalid Appointment ID (Doesn't exist in ^BSDXAPPT)
127 ; -3~DB has corruption. Call Tech Support. (Resource ID doesn't exist in BSDXAPPT)
128 ; -4~DB has corruption. Call Tech Support. (Resource ID in BSDXAPPT doesnt exist in BSDXRES)
129 ; -5~BSDXAPI Error. Message depends on error.
130 ; -20~Mumps Error
131 ;
132 N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
133 ;
134 N $ET S $ET="G ERROR^BSDX25" ; Error Trap
135 ;
136 ; Set return variable and kill contents
137 S BSDXY=$NAME(^BSDXTMP($J))
138 K @BSDXY
139 ;
140 N BSDXI S BSDXI=0 ; Initialize Counter
141 ;
142 S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30) ; Header of ADO recordset
143 ;
144 TSTART (BSDXI):SERIAL ; Perform Autolocking
145 ;
146 ;;;test
147 I $g(bsdxdie) S X=8/0
148 ;;;
149 I $g(bsdxrestart) k bsdxrestart TRESTART
150 ;;;test
151 ;
152 ; Check for Appointment ID (passed and exists in file)
153 I '+$G(BSDXAPPTID) D ERR("-1~Invalid Appointment ID") QUIT
154 I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT
155 ;
156 ; Remove checkin from BSDX APPOINTMENT entry
157 D BSDXCHK(BSDXAPPTID,"@")
158 ;
159 ; Now, remove checkin from PIMS files 2/44
160 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0)
161 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
162 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date
163 N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ; Resource ID
164 ;
165 ; If the resource doesn't exist, error out. DB is corrupt.
166 I 'BSDXSC1 D ERR("-3~DB has corruption. Call Tech Support.") QUIT
167 I '$D(^BSDXRES(BSDXSC1,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT
168 ;
169 N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0) ; Resource 0 node
170 S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
171 ;
172 N BSDXZ ; Scratch variable to hold error message
173 I BSDXSC1]"",$D(^SC(BSDXSC1,0)) S BSDXZ=$$RMCI^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
174 I +$G(BSDXZ) D ERR("-5~"_$P(BSDXZ,U,2)) QUIT
175 ;
176 TCOMMIT ; Save Data into Globals
177 ;
178 ; Return ADO recordset
179 S BSDXI=BSDXI+1
180 S ^BSDXTMP($J,BSDXI)="0"_$C(30)
181 S BSDXI=BSDXI+1
182 S ^BSDXTMP($J,BSDXI)=$C(31)
183 Q
184 ;
185CHKEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CHECKIN APPOINTMENT event
186 ;when appointments CHECKIN via PIMS interface.
187 ;Propagates CHECKIN to BSDXAPPT and raises refresh event to running GUI clients
188 ;
189 Q:+$G(BSDXNOEV)
190 Q:'+$G(BSDXSC)
191 N BSDXSTAT,BSDXFOUND,BSDXRES
192 S BSDXSTAT=""
193 S:$G(SDATA("AFTER","STATUS"))["CHECKED IN" BSDXSTAT=$P(SDATA("AFTER","STATUS"),"^",4)
194 S BSDXFOUND=0
195 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
196 I BSDXFOUND D CHKEVT3(BSDXRES) Q
197 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
198 I BSDXFOUND D CHKEVT3(BSDXRES)
199 Q
200 ;
201CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
202 ;Get appointment id in BSDXAPT
203 ;If found, call BSDXNOS(BSDXAPPT) and return 1
204 ;else return 0
205 N BSDXFOUND,BSDXAPPT
206 S BSDXFOUND=0
207 Q:'+$G(BSDXRES) BSDXFOUND
208 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
209 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND
210 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
211 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
212 I BSDXFOUND,+$G(BSDXAPPT) D BSDXCHK(BSDXAPPT,BSDXSTAT)
213 Q BSDXFOUND
214 ;
215CHKEVT3(BSDXRES) ;
216 ;Call RaiseEvent to notify GUI clients
217 ;
218 N BSDXRESN
219 S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
220 Q:BSDXRESN=""
221 S BSDXRESN=$P(BSDXRESN,"^")
222 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
223 Q
224 ;
225ERROR ;
226 S $ETRAP="D ^%ZTER HALT" ; Emergency Error Trap for the wise
227 ; Rollback, otherwise ^XTER will be empty from future rollback
228 I $TL>0 TROLLBACK
229 D ^%ZTER
230 S $EC="" ; Clear Error
231 ; Log error message and send to client
232 D ERR("-20~Mumps Error")
233 Q
234 ;
235ERR(BSDXERR) ;Error processing
236 I $TLEVEL>0 TROLLBACK
237 S BSDXERR=$G(BSDXERR)
238 S BSDXERR=$P(BSDXERR,"~")_"~"_$TEXT(+0)_":"_$P(BSDXERR,"~",2) ; Append Routine Name
239 S BSDXI=$G(BSDXI)+1
240 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
241 S BSDXI=BSDXI+1
242 S ^BSDXTMP($J,BSDXI)=$C(31)
243 QUIT
Note: See TracBrowser for help on using the repository browser.