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

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

Updated version number on all routines to be 1.7T1.
Minor fixes here and there for XINDEX errors.

File size: 9.5 KB
RevLine 
[1467]1BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 11:55am
[1472]2 ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
[1161]3 ; Licensed under LGPL
[614]4 ;
[1114]5 ; Change Log:
6 ; 3110106: SMH -> Changed Check-in EP - Removed unused paramters. Will change C#
[1467]7 ; 3120630: VEN/SMH -> Extensive Refactoring to remove transactions.
8 ; -> Functionality still the same.
9 ; -> Unit Tests in UT25^BSDXUT2
[614]10 ;
[1114]11 ;
[1464]12CHECKIND(BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP
[614]13 ;Entry point for debugging
14 ;
[1464]15 ;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))
[614]16 Q
17 ;
[1472]18CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT) ;Private EP Check in appointment
[1463]19 ; Old additional vars: ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)
[1464]20 ; Called by RPC: BSDX CHECKIN APPOINTMENT
21 ;
[1064]22 ; Private to GUI; use BSDXAPI for general API to checkin patients
[1114]23 ; Parameters:
24 ; BSDXY: Global Out
[1464]25 ; BSDXAPPTID: Appointment ID in ^BSDXAPPT
[1114]26 ; BSDXCDT: Checkin Date --> Changed
27 ; BSDXCC: Clinic Stop IEN (not used)
28 ; BSDXPRV: Provider IEN (not used)
29 ; BSDXROU: Print Routing Slip? (not used)
30 ; BSDXVCL: PCC+ Clinic IEN (not used)
31 ; BSDXVFM: PCC+ Form IEN (not used)
[1464]32 ; BSDXOG: PCC+ Outguide (true or false) (not used)
[1114]33 ;
34 ; Output:
35 ; ADO.net table with 1 column ErrorID, 1 row result
36 ; - 0 if all okay
37 ; - Another number or text if not
[1463]38 ;
[1466]39 ; Error reference:
40 ; -1 -> Invalid Appointment ID
41 ; -2 -> Invalid Check-in Date
42 ; -3 -> Cannot check-in due to Fileman Filer failure
43 ; -10 -> BSDXAPI error
44 ; -100 -> Mumps Error
45 ;
[1463]46 ; Turn off SDAM Appointment Events BSDX Protocol Processing
[614]47 N BSDXNOEV
48 S BSDXNOEV=1 ;Don't execute protocol
49 ;
[1463]50 ; Set min DUZ vars
[1464]51 D ^XBKVAR
[1463]52 ;
53 ; $ET
54 N $ET S $ET="G ERROR^BSDX25"
55 ;
[1466]56 ; Test for error trap for Unit Tests
57 I $G(BSDXDIE) N X S X=1/0
58 ;
[1463]59 N BSDXI S BSDXI=0
[1464]60 ;
61 S BSDXY=$NAME(^BSDXTMP($J))
62 K @BSDXY
63 ;
[614]64 S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
[1464]65 ;
[1466]66 I '+BSDXAPPTID D ERR("-1~Invalid Appointment ID") QUIT
67 I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-1~Invalid Appointment ID") QUIT
[1464]68 ;
[1064]69 ; Remove Date formatting v.1.5. Client will send date as FM Date.
70 ;S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@")
71 ;S %DT="T",X=BSDXCDT D ^%DT S BSDXCDT=Y
[1463]72 S BSDXCDT=+BSDXCDT ; Strip off zeros if C# sends them
[1466]73 I BSDXCDT'>2000000 D ERR("-2~Invalid Check-in Date") QUIT
[614]74 I BSDXCDT>$$NOW^XLFDT S BSDXCDT=$$NOW^XLFDT
[1464]75 ;
[1466]76 ; Some data
77 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0) ; Appointment Node
78 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
79 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Appointment Start Time
[614]80 ;
[1464]81 ; Get Hospital Location IEN from BSDXAPPT to BSDXRES (RESOUCE:HOSPITAL LOCATION)
82 N BSDXSC1 S BSDXSC1=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",".07:.04","I")
83 I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Null it off if it doesn't exist
84 ;
[1466]85 ; Check if we can check-in using BSDXAPI
86 N BSDXERR S BSDXERR=0
87 I BSDXSC1 S BSDXERR=$$CHECKIC1^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
88 I BSDXERR D ERR(-10_"~"_$P(BSDXERR,U,2)) QUIT
89 ;
90 ; Checkin BSDX APPOINTMENT entry
91 ; Failure Analysis: If we fail here, no changes were made.
92 N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,BSDXCDT)
93 I BSDXERR D ERR("-3~Fileman Filer failed to check-in appt") QUIT
94 ;
[1464]95 ; File check-in using BSDXAPI
[1466]96 ; Failure Analysis: If we fail here, we need to roll back first check-in.
[1464]97 N BSDXERR S BSDXERR=0
98 I BSDXSC1 S BSDXERR=$$CHECKIN1^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
[1466]99 I BSDXERR D QUIT
100 . N % S %=$$BSDXCHK(BSDXAPPTID,"@") ; No Error checking to prevent loop.
101 . D ERR(-10_"~"_$P(BSDXERR,U,2)) ; Send error message to client
[1464]102 ;
[614]103 S BSDXI=BSDXI+1
104 S ^BSDXTMP($J,BSDXI)="0"_$C(30)
105 S BSDXI=BSDXI+1
106 S ^BSDXTMP($J,BSDXI)=$C(31)
107 Q
108 ;
[1464]109BSDXCHK(BSDXAPPTID,BSDXCDT) ; $$ Private Entry Point. File or delete check-in to
110 ; BSDX Appointment
111 ; Input: BSDXAPPTID -> Appointment ID
112 ; BSDXCDT -> Check-in date, or "@" to remove check-in.
[614]113 ;
[1464]114 ; Output: 1^Error for error
115 ; 0 for success
116 ;
[1466]117 Q:$G(BSDXSIMERR1) 1_U_"Simulated Error 1"
118 ;
[1464]119 N BSDXIENS,BSDXMSG,BSDXFDA ; Filer variables
120 S BSDXIENS=BSDXAPPTID_","
[614]121 S BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT
122 D FILE^DIE("","BSDXFDA","BSDXMSG")
[1464]123 Q:$D(BSDXMSG) 1_U_BSDXMSG("DIERR",1,"TEXT",1)
124 Q 0
[614]125 ;
[1116]126RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44
[1464]127 ; Called by RPC BSDX REMOVE CHECK-IN
[1113]128 ;
129 ; Parameters to pass:
130 ; APPTID: IEN in file BSDX APPOINTMENT
131 ;
132 ; Return in global array:
133 ; Record set with Column ERRORID; value of 0 AOK; other value
134 ; --> means that something went wrong
[1114]135 ;
136 ; Error Reference:
137 ; -1~Invalid Appointment ID (not passed)
138 ; -2~Invalid Appointment ID (Doesn't exist in ^BSDXAPPT)
139 ; -3~DB has corruption. Call Tech Support. (Resource ID doesn't exist in BSDXAPPT)
140 ; -4~DB has corruption. Call Tech Support. (Resource ID in BSDXAPPT doesnt exist in BSDXRES)
141 ; -5~BSDXAPI Error. Message depends on error.
[1464]142 ; -6~Data Filing Error in BSDXCHK
143 ; -7~Lock not acquired
[1463]144 ; -100~Mumps Error
[1114]145 ;
[1113]146 N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
147 ;
148 N $ET S $ET="G ERROR^BSDX25" ; Error Trap
149 ;
150 ; Set return variable and kill contents
[1115]151 S BSDXY=$NAME(^BSDXTMP($J))
[1113]152 K @BSDXY
153 ;
154 N BSDXI S BSDXI=0 ; Initialize Counter
155 ;
156 S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30) ; Header of ADO recordset
157 ;
[1114]158 ;;;test
[1464]159 I $G(BSDXDIE) N X S X=8/0
[1114]160 ;
[1113]161 ; Check for Appointment ID (passed and exists in file)
[1114]162 I '+$G(BSDXAPPTID) D ERR("-1~Invalid Appointment ID") QUIT
163 I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT
[1113]164 ;
[1467]165 ; Get appointment Data
[1114]166 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0)
[1463]167 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
168 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date
[1467]169 N BSDXRESID S BSDXRESID=$P(BSDXNOD,U,7) ; Resource ID
[1113]170 ;
171 ; If the resource doesn't exist, error out. DB is corrupt.
[1467]172 I 'BSDXRESID D ERR("-3~DB has corruption. Call Tech Support.") QUIT
173 I '$D(^BSDXRES(BSDXRESID,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT
[1113]174 ;
[1467]175 ; Get HL Data
176 N BSDXNOD S BSDXNOD=^BSDXRES(BSDXRESID,0) ; Resource 0 node
177 N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION IEN
178 I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Zero out if HL doesn't exist
[1113]179 ;
[1467]180 ; Is it okay to remove check-in from PIMS?
181 N BSDXERR S BSDXERR=0 ; Scratch variable
182 ; $$RMCICK = Remove Check-in Check
183 I BSDXSC1 S BSDXERR=$$RMCICK^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART)
184 I BSDXERR D ERR("-5~"_$P(BSDXERR,U,2)) QUIT
185 ;
186 ; For possible rollback, get old check-in date (internal value)
187 N BSDXCDT S BSDXCDT=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",.03,"I")
188 ;
189 ; Remove checkin from BSDX APPOINTMENT entry
190 ; No need to rollback here on failure.
191 N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,"@")
192 I BSDXERR D ERR("-6~Cannot file data in $$BSDXCHK") QUIT
193 ;
194 ; Now, remove checkin from PIMS files 2/44
195 ; Restore BSDXCDT into ^BSDXAPPT if we fail.
196 N BSDXERR S BSDXERR=0 ; Scratch variable to hold error message
197 I BSDXSC1 S BSDXERR=$$RMCI^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART)
198 I BSDXERR D QUIT
199 . N % S %=$$BSDXCHK(BSDXAPPTID,BSDXCDT) ; No error checking here.
200 . D ERR("-5~"_$P(BSDXERR,U,2)) ; Send error message to client
[1113]201 ;
202 ; Return ADO recordset
203 S BSDXI=BSDXI+1
204 S ^BSDXTMP($J,BSDXI)="0"_$C(30)
205 S BSDXI=BSDXI+1
206 S ^BSDXTMP($J,BSDXI)=$C(31)
207 Q
208 ;
[614]209CHKEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CHECKIN APPOINTMENT event
210 ;when appointments CHECKIN via PIMS interface.
211 ;Propagates CHECKIN to BSDXAPPT and raises refresh event to running GUI clients
212 ;
213 Q:+$G(BSDXNOEV)
214 Q:'+$G(BSDXSC)
215 N BSDXSTAT,BSDXFOUND,BSDXRES
216 S BSDXSTAT=""
217 S:$G(SDATA("AFTER","STATUS"))["CHECKED IN" BSDXSTAT=$P(SDATA("AFTER","STATUS"),"^",4)
218 S BSDXFOUND=0
219 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
220 I BSDXFOUND D CHKEVT3(BSDXRES) Q
221 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
222 I BSDXFOUND D CHKEVT3(BSDXRES)
223 Q
224 ;
225CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
226 ;Get appointment id in BSDXAPT
227 ;If found, call BSDXNOS(BSDXAPPT) and return 1
228 ;else return 0
229 N BSDXFOUND,BSDXAPPT
230 S BSDXFOUND=0
231 Q:'+$G(BSDXRES) BSDXFOUND
232 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
233 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND
[1464]234 . N BSDXNOD S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
[614]235 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
[1464]236 I BSDXFOUND,+$G(BSDXAPPT) D
237 . N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPT,BSDXSTAT)
238 . I BSDXERR D ^%ZTER ; VEN/SMH - This is silent. This is a last resort
[614]239 Q BSDXFOUND
240 ;
241CHKEVT3(BSDXRES) ;
242 ;Call RaiseEvent to notify GUI clients
243 ;
244 N BSDXRESN
245 S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
246 Q:BSDXRESN=""
247 S BSDXRESN=$P(BSDXRESN,"^")
248 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
249 Q
250 ;
251ERROR ;
[1114]252 S $ETRAP="D ^%ZTER HALT" ; Emergency Error Trap for the wise
[1463]253 D ^%ZTER
[1466]254 ; VEN/SMH: NB: I make a conscious decision not to roll back anything
255 ; here in the error trap. Once the error is fixed, users can
256 ; undo or redo the check-in.
257 ; Individual portions of this routine may choose to do rolling back
258 ; of their own (e.g. a failed call to BSDXAPI causes rollback to occur
[1467]259 ; in CHECKIN and RMCI)
[1466]260 ;
[1463]261 ; Log error message and send to client
262 D ERR("-100~Mumps Error")
[1466]263 Q:$Q "-100^Mumps Error" Q
[614]264 ;
[1113]265ERR(BSDXERR) ;Error processing
[1466]266 ; If last line is $C(31), we are done. No more errors to send to client.
267 I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
[1114]268 S BSDXERR=$G(BSDXERR)
269 S BSDXERR=$P(BSDXERR,"~")_"~"_$TEXT(+0)_":"_$P(BSDXERR,"~",2) ; Append Routine Name
270 S BSDXI=$G(BSDXI)+1
[614]271 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
272 S BSDXI=BSDXI+1
273 S ^BSDXTMP($J,BSDXI)=$C(31)
[1113]274 QUIT
Note: See TracBrowser for help on using the repository browser.