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

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

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