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

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

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