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

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

BSDX25 refactoring, continued

File size: 7.8 KB
Line 
1BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 6/29/12 12:04pm
2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
3 ; Licensed under LGPL
4 ;
5 ; Change Log:
6 ; 3110106: SMH -> Changed Check-in EP - Removed unused paramters. Will change C#
7 ;
8 ;
9CHECKIND(BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP
10 ;Entry point for debugging
11 ;
12 ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))
13 Q
14 ;
15CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT) ;Private EP Check in appointment
16 ; Old additional vars: ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)
17 ; Called by RPC: BSDX CHECKIN APPOINTMENT
18 ;
19 ; Private to GUI; use BSDXAPI for general API to checkin patients
20 ; Parameters:
21 ; BSDXY: Global Out
22 ; BSDXAPPTID: Appointment ID in ^BSDXAPPT
23 ; BSDXCDT: Checkin Date --> Changed
24 ; BSDXCC: Clinic Stop IEN (not used)
25 ; BSDXPRV: Provider IEN (not used)
26 ; BSDXROU: Print Routing Slip? (not used)
27 ; BSDXVCL: PCC+ Clinic IEN (not used)
28 ; BSDXVFM: PCC+ Form IEN (not used)
29 ; BSDXOG: PCC+ Outguide (true or false) (not used)
30 ;
31 ; Output:
32 ; ADO.net table with 1 column ErrorID, 1 row result
33 ; - 0 if all okay
34 ; - Another number or text if not
35 ;
36 ; Turn off SDAM Appointment Events BSDX Protocol Processing
37 N BSDXNOEV
38 S BSDXNOEV=1 ;Don't execute protocol
39 ;
40 ; Set min DUZ vars
41 D ^XBKVAR
42 ;
43 ; $ET
44 N $ET S $ET="G ERROR^BSDX25"
45 ;
46 N BSDXI S BSDXI=0
47 ;
48 S BSDXY=$NAME(^BSDXTMP($J))
49 K @BSDXY
50 ;
51 S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
52 ;
53 I '+BSDXAPPTID D ERR("Invalid Appointment ID") QUIT
54 I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("Invalid Appointment ID") QUIT
55 ;
56 ; Lock the node for synchronizing access to appointment
57 LOCK +^BSDXAPPT(BSDXAPPTID):1
58 ELSE DO ERR("-7~Lock not acquired") QUIT
59 ;
60 ; Remove Date formatting v.1.5. Client will send date as FM Date.
61 ;S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@")
62 ;S %DT="T",X=BSDXCDT D ^%DT S BSDXCDT=Y
63 S BSDXCDT=+BSDXCDT ; Strip off zeros if C# sends them
64 I BSDXCDT=-1 D ERR(70) Q
65 I BSDXCDT>$$NOW^XLFDT S BSDXCDT=$$NOW^XLFDT
66 ;
67 ;Checkin BSDX APPOINTMENT entry
68 N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,BSDXCDT)
69 I BSDXERR D ERR("BSDX08: Fileman Filer failed to check-in appt") QUIT
70 ;
71 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0)
72 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5)
73 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U)
74 ;
75 ; Get Hospital Location IEN from BSDXAPPT to BSDXRES (RESOUCE:HOSPITAL LOCATION)
76 N BSDXSC1 S BSDXSC1=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",".07:.04","I")
77 I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Null it off if it doesn't exist
78 ;
79 ; File check-in using BSDXAPI
80 N BSDXERR S BSDXERR=0
81 I BSDXSC1 S BSDXERR=$$CHECKIN1^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
82 I BSDXERR D ERR($P(BSDXZ,U,2)) QUIT
83 ;
84 ; Unlock
85 LOCK -^BSDXAPPT(BSDXAPPTID)
86 ;
87 S BSDXI=BSDXI+1
88 S ^BSDXTMP($J,BSDXI)="0"_$C(30)
89 S BSDXI=BSDXI+1
90 S ^BSDXTMP($J,BSDXI)=$C(31)
91 Q
92 ;
93BSDXCHK(BSDXAPPTID,BSDXCDT) ; $$ Private Entry Point. File or delete check-in to
94 ; BSDX Appointment
95 ; Input: BSDXAPPTID -> Appointment ID
96 ; BSDXCDT -> Check-in date, or "@" to remove check-in.
97 ;
98 ; Output: 1^Error for error
99 ; 0 for success
100 ;
101 N BSDXIENS,BSDXMSG,BSDXFDA ; Filer variables
102 S BSDXIENS=BSDXAPPTID_","
103 S BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT
104 D FILE^DIE("","BSDXFDA","BSDXMSG")
105 Q:$D(BSDXMSG) 1_U_BSDXMSG("DIERR",1,"TEXT",1)
106 Q 0
107 ;
108RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44
109 ; Called by RPC BSDX REMOVE CHECK-IN
110 ;
111 ; Parameters to pass:
112 ; APPTID: IEN in file BSDX APPOINTMENT
113 ;
114 ; Return in global array:
115 ; Record set with Column ERRORID; value of 0 AOK; other value
116 ; --> means that something went wrong
117 ;
118 ; Error Reference:
119 ; -1~Invalid Appointment ID (not passed)
120 ; -2~Invalid Appointment ID (Doesn't exist in ^BSDXAPPT)
121 ; -3~DB has corruption. Call Tech Support. (Resource ID doesn't exist in BSDXAPPT)
122 ; -4~DB has corruption. Call Tech Support. (Resource ID in BSDXAPPT doesnt exist in BSDXRES)
123 ; -5~BSDXAPI Error. Message depends on error.
124 ; -6~Data Filing Error in BSDXCHK
125 ; -7~Lock not acquired
126 ; -100~Mumps Error
127 ;
128 N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
129 ;
130 N $ET S $ET="G ERROR^BSDX25" ; Error Trap
131 ;
132 ; Set return variable and kill contents
133 S BSDXY=$NAME(^BSDXTMP($J))
134 K @BSDXY
135 ;
136 N BSDXI S BSDXI=0 ; Initialize Counter
137 ;
138 S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30) ; Header of ADO recordset
139 ;
140 ;;;test
141 I $G(BSDXDIE) N X S X=8/0
142 ;
143 ; Check for Appointment ID (passed and exists in file)
144 I '+$G(BSDXAPPTID) D ERR("-1~Invalid Appointment ID") QUIT
145 I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT
146 ;
147 ; Lock the node for synchronizing access to appointment
148 LOCK +^BSDXAPPT(BSDXAPPTID):1
149 ELSE DO ERR("-7~Lock not acquired") QUIT
150 ;
151 ; Remove checkin from BSDX APPOINTMENT entry
152 N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,"@")
153 I BSDXERR D ERR("-6~Cannot file data in $$BSDXCHK") QUIT
154 ;
155 ; Now, remove checkin from PIMS files 2/44
156 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0)
157 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
158 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date
159 N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ; Resource ID
160 ;
161 ; If the resource doesn't exist, error out. DB is corrupt.
162 I 'BSDXSC1 D ERR("-3~DB has corruption. Call Tech Support.") QUIT
163 I '$D(^BSDXRES(BSDXSC1,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT
164 ;
165 N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0) ; Resource 0 node
166 S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
167 ;
168 N BSDXZ ; Scratch variable to hold error message
169 I BSDXSC1]"",$D(^SC(BSDXSC1,0)) S BSDXZ=$$RMCI^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
170 I +$G(BSDXZ) D ERR("-5~"_$P(BSDXZ,U,2)) QUIT
171 ;
172 ; Unlock
173 LOCK -^BSDXAPPT(BSDXAPPTID)
174 ;
175 ; Return ADO recordset
176 S BSDXI=BSDXI+1
177 S ^BSDXTMP($J,BSDXI)="0"_$C(30)
178 S BSDXI=BSDXI+1
179 S ^BSDXTMP($J,BSDXI)=$C(31)
180 Q
181 ;
182CHKEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CHECKIN APPOINTMENT event
183 ;when appointments CHECKIN via PIMS interface.
184 ;Propagates CHECKIN to BSDXAPPT and raises refresh event to running GUI clients
185 ;
186 Q:+$G(BSDXNOEV)
187 Q:'+$G(BSDXSC)
188 N BSDXSTAT,BSDXFOUND,BSDXRES
189 S BSDXSTAT=""
190 S:$G(SDATA("AFTER","STATUS"))["CHECKED IN" BSDXSTAT=$P(SDATA("AFTER","STATUS"),"^",4)
191 S BSDXFOUND=0
192 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
193 I BSDXFOUND D CHKEVT3(BSDXRES) Q
194 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
195 I BSDXFOUND D CHKEVT3(BSDXRES)
196 Q
197 ;
198CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
199 ;Get appointment id in BSDXAPT
200 ;If found, call BSDXNOS(BSDXAPPT) and return 1
201 ;else return 0
202 N BSDXFOUND,BSDXAPPT
203 S BSDXFOUND=0
204 Q:'+$G(BSDXRES) BSDXFOUND
205 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
206 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND
207 . N BSDXNOD S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
208 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
209 I BSDXFOUND,+$G(BSDXAPPT) D
210 . N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPT,BSDXSTAT)
211 . I BSDXERR D ^%ZTER ; VEN/SMH - This is silent. This is a last resort
212 Q BSDXFOUND
213 ;
214CHKEVT3(BSDXRES) ;
215 ;Call RaiseEvent to notify GUI clients
216 ;
217 N BSDXRESN
218 S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
219 Q:BSDXRESN=""
220 S BSDXRESN=$P(BSDXRESN,"^")
221 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
222 Q
223 ;
224ERROR ;
225 S $ETRAP="D ^%ZTER HALT" ; Emergency Error Trap for the wise
226 D ^%ZTER
227 S $EC="" ; Clear Error
228 ; Log error message and send to client
229 D ERR("-100~Mumps Error")
230 Q
231 ;
232ERR(BSDXERR) ;Error processing
233 I $G(BSDXAPPTID) LOCK -^BSDXAPPT(BSDXAPPTID)
234 S BSDXERR=$G(BSDXERR)
235 S BSDXERR=$P(BSDXERR,"~")_"~"_$TEXT(+0)_":"_$P(BSDXERR,"~",2) ; Append Routine Name
236 S BSDXI=$G(BSDXI)+1
237 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
238 S BSDXI=BSDXI+1
239 S ^BSDXTMP($J,BSDXI)=$C(31)
240 QUIT
Note: See TracBrowser for help on using the repository browser.