source: Scheduling/trunk/m/BSDXAPI.m@ 1436

Last change on this file since 1436 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: 16.2 KB
Line 
1BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 4/28/11 10:30am
2 ;;1.6T2;BSDX;;May 16, 2011;Build 7
3 ; Licensed under LGPL
4 ;
5 ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
6 ;local mods (many) by WV/SMH
7 ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
8 ; Change History:
9 ; 2010-11-5: (1.42)
10 ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment.
11 ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API.
12 ; 2010-11-12: (1.42)
13 ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well.
14 ; 2010-12-5 (1.42)
15 ; Added an entry point to update the patient note in file 44.
16 ; 2010-12-6 (1.42)
17 ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI")
18 ; 2010-12-8 (1.42)
19 ; Removed restriction on max appt length. Even though this restriction
20 ; exists in fileman (120 minutes), PIMS ignores it. Therefore, I
21 ; will ignore it here too.
22 ; 2011-01-25 (v.1.5)
23 ; Added entry point $$RMCI to remove checked in appointments.
24 ; In $$CANCEL, if the appointment is checked in, delete check-in rather than
25 ; spitting an error message to the user saying 'Delete the check-in'
26 ; Changed all lines that look like this:
27 ; I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
28 ; to:
29 ; I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
30 ; to allow for date at midnight which does not have a dot at the end.
31 ; 2011-01-26 (v.1.5)
32 ; More user friendly message if patient already has appointment in $$MAKE:
33 ; Spits out pt name and user friendly date.
34 ;
35 ;
36MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
37 ; Call like this for DFN 23435 having an appointment at Hospital Location 33
38 ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
39 ; for Baby foxes hallucinations.
40 ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
41 S BSDR("PAT")=DFN ;DFN
42 S BSDR("CLN")=CLIN ;Hosp Loc IEN
43 S BSDR("TYP")=TYP ;3 sched or 4 walkin
44 S BSDR("ADT")=DATE ;Appointment date in FM format
45 S BSDR("LEN")=LEN ;Appt len upto 240 (min)
46 S BSDR("OI")=INFO ;Reason for appt - up to 150 char
47 S BSDR("USR")=DUZ ;Person who made appt - current user
48 Q $$MAKE(.BSDR)
49 ;
50MAKE(BSDR) ;PEP; call to store appt made
51 ;
52 ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
53 ;
54 ; Input Array -
55 ; BSDR("PAT") = ien of patient in file 2
56 ; BSDR("CLN") = ien of clinic in file 44
57 ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
58 ; BSDR("ADT") = appointment date and time
59 ; BSDR("LEN") = appointment length in minutes (*1.42 limit removed)
60 ; BSDR("OI") = reason for appt - up to 150 characters
61 ; BSDR("USR") = user who made appt
62 ;
63 ;Output: error status and message
64 ; = 0 or null: everything okay
65 ; = 1^message: error and reason
66 ;
67 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
68 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
69 I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
70 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
71 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
72 ;
73 ;I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) ; v 1.42 - no check on length is done anymore. see top comments for details.
74 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
75 ;I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT") ; v.1.5 more user friendly err msg
76 ;
77 ; Following block to give an error message to user if there is already an appointment for patient. More verbose than others.
78 N BSDXERR ; place to store error message
79 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" DO QUIT BSDXERR ; If there's an appt in the "S" node of file 2 and it's not cancelled
80 . S BSDXERR=1_U_"Patient "_$P(^DPT(BSDR("PAT"),0),U)_" ("_BSDR("PAT")_") "
81 . S BSDXERR=BSDXERR_"already has appt at "_$$FMTE^XLFDT(BSDR("ADT"))
82 . N BSDXSCIEN S BSDXSCIEN=$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U) ; Clinic IEN in ^SC (0 piece of 0 node of "S" multiple in file 2)
83 . N BSDXSCNAM S BSDXSCNAM=$P(^SC(BSDXSCIEN,0),U) ; PIMS Name of Clinic
84 . S BSDXERR=BSDXERR_$C(13,10)_"PIMS clinic: "_BSDXSCNAM ; tell the user of the PIMS clinic
85 . I $D(^BSDXRES("ALOC",BSDXSCIEN)) DO ; if the Clinic is linked to a BSDX Resource (we find out using the index ALOC in the BSDX RESOURCE file)
86 . . N BSDXRESIEN S BSDXRESIEN=$O(^BSDXRES("ALOC",BSDXSCIEN,""))
87 . . QUIT:'BSDXRESIEN ; Safeguard if index is corrupt
88 . . N BSDXRESNAM S BSDXRESNAM=$P(^BSDXRES(BSDXRESIEN,0),U)
89 . . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic
90 ;
91 NEW DIC,DA,Y,X,DD,DO,DLAYGO
92 ;
93 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
94 . ; "un-cancel" existing appt in file 2
95 . N BSDXFDA,BSDXIENS,BSDXMSG
96 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
97 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
98 . S BSDXFDA(2.98,BSDXIENS,"3")=""
99 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
100 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
101 . S BSDXFDA(2.98,BSDXIENS,"14")=""
102 . S BSDXFDA(2.98,BSDXIENS,"15")=""
103 . S BSDXFDA(2.98,BSDXIENS,"16")=""
104 . S BSDXFDA(2.98,BSDXIENS,"19")=""
105 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
106 . D FILE^DIE("","BSDXFDA","BSDXMSG")
107 . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
108 E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
109 . N BSDXFDA,BSDXIENS,BSDXMSG
110 . S BSDXIENS="?+2,"_BSDR("PAT")_","
111 . S BSDXIENS(2)=BSDR("ADT")
112 . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
113 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
114 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
115 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
116 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
117 ; add appt to file 44
118 K DIC,DA,X,Y,DLAYGO,DD,DO
119 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
120 I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
121 . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
122 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
123 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
124 ;
125 ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
126 ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
127 ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
128 ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
129 ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
130 ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
131 ;D FILE^DICN
132 ;
133 N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_","
134 N BSDXFDA
135 S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT")
136 S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN")
137 S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150)
138 S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR")
139 S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".")
140 N BSDXERR
141 D UPDATE^DIE("","BSDXFDA","","BSDXERR")
142 ;
143 I $D(BSDXERR) Q 1_U_"Error adding appt to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")_" Patient="_BSDR("PAT")_" Error: "_BSDXERR("DIERR",1,"TEXT",1)
144 ;
145 ; call event driver
146 NEW DFN,SDT,SDCL,SDDA,SDMODE
147 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
148 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
149 D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
150 Q 0
151 ;
152CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
153 ; Call like this for DFN 23435 checking in now at Hospital Location 33
154 ; for appt at Dec 20, 2009 @ 10:11:59
155 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
156 S BSDR("PAT")=DFN ;DFN
157 S BSDR("CLN")=CLIN ;Hosp Loc IEN
158 S BSDR("ADT")=APDATE ;Appt Date
159 S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now
160 S BSDR("USR")=DUZ ;Check-in user defaults to current
161 Q $$CHECKIN(.BSDR)
162 ;
163CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
164 ;
165 ; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
166 ;
167 ; Input array -
168 ; BSDR("PAT") = ien of patient in file 2
169 ; BSDR("CLN") = ien of clinic in file 44
170 ; BSDR("ADT") = appt date/time
171 ; BSDR("CDT") = checkin date/time
172 ; BSDR("USR") = checkin user
173 ;
174 ; Output value -
175 ; = 0 means everything worked
176 ; = 1^message means error with reason message
177 ;
178 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
179 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
180 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
181 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
182 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
183 I $G(BSDR("CDT"))'?7N.1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
184 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
185 ;
186 ; find ien for appt in file 44
187 NEW IEN,DIE,DA,DR
188 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
189 I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
190 ;
191 ; remember before status
192 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
193 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
194 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
195 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
196 ;
197 ; set checkin
198 S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
199 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
200 S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
201 D ^DIE
202 ;
203 ; set after status
204 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
205 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
206 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
207 ;
208 ; call event driver
209 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
210 Q 0
211 ;
212CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
213 ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
214 ; cancellation initiated by patient ("PC" rather than clinic "C"),
215 ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
216 ; because foxes come out during bad weather.
217 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
218 S BSDR("PAT")=DFN
219 S BSDR("CLN")=CLIN
220 S BSDR("TYP")=TYP
221 S BSDR("ADT")=APDATE
222 S BSDR("CDT")=$$NOW^XLFDT
223 S BSDR("USR")=DUZ
224 S BSDR("CR")=REASON
225 S BSDR("NOT")=INFO
226 Q $$CANCEL(.BSDR)
227 ;
228CANCEL(BSDR) ;PEP; called to cancel appt
229 ;
230 ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
231 ;
232 ; Input Array -
233 ; BSDR("PAT") = ien of patient in file 2
234 ; BSDR("CLN") = ien of clinic in file 44
235 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
236 ; BSDR("ADT") = appointment date and time
237 ; BSDR("CDT") = cancel date and time
238 ; BSDR("USR") = user who canceled appt
239 ; BSDR("CR") = cancel reason - pointer to file 409.2
240 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
241 ;
242 ;Output: error status and message
243 ; = 0 or null: everything okay
244 ; = 1^message: error and reason
245 ;
246 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
247 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
248 I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
249 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
250 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
251 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
252 I $G(BSDR("CDT"))'?7N.1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
253 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
254 I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
255 ;
256 NEW IEN,DIE,DA,DR
257 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
258 I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
259 ;
260 ; BSDX 1.5 3110125
261 ; UJO/SMH - Add ability to remove check-in if the patient is checked in
262 ; I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
263 ; Remove check-in if the patient is checked in.
264 N BSDXRESULT S BSDXRESULT=0 ; Result; should be zero if success; -1 + message if failure
265 I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) SET BSDXRESULT=$$RMCI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
266 I BSDXRESULT Q BSDXRESULT
267 ;
268 ; remember before status
269 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
270 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
271 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
272 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
273 ;
274 ; get user who made appt and date appt made from ^SC
275 ; because data in ^SC will be deleted
276 NEW USER,DATE
277 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
278 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
279 ;
280 ; update file 2 info
281 NEW DIE,DA,DR
282 S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
283 S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
284 S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
285 D ^DIE
286 ;
287 ; delete data in ^SC
288 NEW DIK,DA
289 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
290 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
291 D ^DIK
292 ;
293 ; call event driver
294 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
295 Q 0
296 ;
297CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
298 NEW X
299 S X=$G(SDIEN) ;ien sent in call
300 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
301 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
302 Q $S(X:1,1:0)
303 ;
304RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$
305 ; PAT = DFN
306 ; CLINIC = SC IEN
307 ; DATE = FM Date/Time of Appointment
308 ;
309 ; Returns:
310 ; 0 if okay
311 ; -1 if failure
312 ;
313 ; Call like this: $$RMCI(233,33,3110102.1130)
314 ;
315 ; Move my variables into the ones used by SDAPIs (just a convenience)
316 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
317 S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN(DFN,SDCL,SDT)
318 ;
319 I SDDA<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
320 ;
321 ; remember before status
322 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
323 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
324 ;
325 ; remove check-in using filer.
326 N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_","
327 S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN
328 S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER
329 S BSDXFDA(44.003,BSDXIENS,305)="@" ; CHECK IN ENTERED
330 N BSDXERR
331 D FILE^DIE("","BSDXFDA","BSDXERR")
332 I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1)
333 ;
334 ; set after status
335 S SDDA=$$SCIEN(DFN,SDCL,SDT)
336 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
337 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
338 ;
339 ; call event driver
340 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
341 QUIT 0
342 ;
343SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
344 NEW X,IEN
345 S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
346 . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)["C" ;cancelled
347 . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
348 Q $G(IEN)
349 ;
350APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
351 NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
352 Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
353 ;
354CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
355 NEW X
356 S X=$G(SDIEN) ;ien sent in call
357 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
358 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
359 Q $S(X:1,1:0)
360 ;
361UPDATENOTE(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
362 ; PAT = DFN
363 ; CLINIC = SC IEN
364 ; DATE = FM Date/Time of Appointment
365 ;
366 ; Returns:
367 ; 0 if okay
368 ; -1 if failure
369 N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
370 I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
371 N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
372 S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
373 N BSDXERR
374 D FILE^DIE("","BSDXFDA","BSDXERR")
375 I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1)
376 QUIT 0
Note: See TracBrowser for help on using the repository browser.