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

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

BSDX25 refactoring, continued
File size: 19.0 KB
Line 
1BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/29/12 12:19pm
2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
3 ; Licensed under LGPL
4 ;
5 ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
6 ; 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
11 ; a patient cancelled appointment.
12 ; - Use new style Fileman API for storing appointments in file 44 in
13 ; $$MAKE due to problems with legacy API.
14 ; 2010-11-12: (1.42)
15 ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as
16 ; well.
17 ; 2010-12-5 (1.42)
18 ; Added an entry point to update the patient note in file 44.
19 ; 2010-12-6 (1.42)
20 ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI")
21 ; 2010-12-8 (1.42)
22 ; Removed restriction on max appt length. Even though this restriction
23 ; exists in fileman (120 minutes), PIMS ignores it. Therefore, I
24 ; will ignore it here too.
25 ; 2011-01-25 (v.1.5)
26 ; Added entry point $$RMCI to remove checked in appointments.
27 ; In $$CANCEL, if the appointment is checked in, delete check-in rather than
28 ; spitting an error message to the user saying 'Delete the check-in'
29 ; Changed all lines that look like this:
30 ; I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
31 ; to:
32 ; I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
33 ; to allow for date at midnight which does not have a dot at the end.
34 ; 2011-01-26 (v.1.5)
35 ; More user friendly message if patient already has appointment in $$MAKE:
36 ; Spits out pt name and user friendly date.
37 ; 2012-06-18 (v 1.7)
38 ; Removing transacions. Means that code SHOULD NOT fail. Took all checks
39 ; out for making an appointment to MAKECK. We call this first to make sure
40 ; that the appointment is okay to make before committing to make it. We
41 ; still have the provision to delete the data though if we fail when we
42 ; actually make the appointment.
43 ; CANCELCK exists for the same purpose.
44 ;
45MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
46 ; Call like this for DFN 23435 having an appointment at Hospital Location 33
47 ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
48 ; for Baby foxes hallucinations.
49 ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
50 N BSDR
51 S BSDR("PAT")=DFN ;DFN
52 S BSDR("CLN")=CLIN ;Hosp Loc IEN
53 S BSDR("TYP")=TYP ;3 sched or 4 walkin
54 S BSDR("ADT")=DATE ;Appointment date in FM format
55 S BSDR("LEN")=LEN ;Appt len upto 240 (min)
56 S BSDR("OI")=INFO ;Reason for appt - up to 150 char
57 S BSDR("USR")=DUZ ;Person who made appt - current user
58 Q $$MAKE(.BSDR)
59 ;
60MAKE(BSDR) ;PEP; call to store appt made
61 ;
62 ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
63 ;
64 ; Input Array -
65 ; BSDR("PAT") = ien of patient in file 2
66 ; BSDR("CLN") = ien of clinic in file 44
67 ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
68 ; BSDR("ADT") = appointment date and time
69 ; BSDR("LEN") = appointment length in minutes (*1.42 limit removed)
70 ; BSDR("OI") = reason for appt - up to 150 characters
71 ; BSDR("USR") = user who made appt
72 ;
73 ;Output: error status and message
74 ; = 0 or null: everything okay
75 ; = 1^message: error and reason
76 ;
77 N BSDXMKCK S BSDXMKCK=$$MAKECK(.BSDR) ; Check if we can make appointment
78 I BSDXMKCK Q BSDXMKCK ; If we can't, quit with the reason why.
79 ;
80 ;Otherwise, we continue
81 ;
82 N BSDXFDA,BSDXIENS,BSDXMSG ; FILE/UPDATE^DIE variables
83 ;
84 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
85 . ; "un-cancel" existing appt in file 2
86 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
87 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
88 . S BSDXFDA(2.98,BSDXIENS,"3")=""
89 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
90 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
91 . S BSDXFDA(2.98,BSDXIENS,"14")=""
92 . S BSDXFDA(2.98,BSDXIENS,"15")=""
93 . S BSDXFDA(2.98,BSDXIENS,"16")=""
94 . S BSDXFDA(2.98,BSDXIENS,"17")="@" ; v 1.7; cancellation remarks were left over
95 . S BSDXFDA(2.98,BSDXIENS,"19")=""
96 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
97 . D FILE^DIE("","BSDXFDA","BSDXMSG")
98 Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
99 ;
100 Q:$G(BSDXSIMERR2) 1_U_$NA(BSDXSIMERR2) ; Unit Test line
101 ;
102 E D ; File new appointment/edit existing appointment in file 2
103 . S BSDXIENS="?+2,"_BSDR("PAT")_","
104 . S BSDXIENS(2)=BSDR("ADT")
105 . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
106 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
107 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
108 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
109 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXMSG")
110 Q:$D(BSDXMSG) 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
111 ;
112 Q:$G(BSDXSIMERR3) 1_U_$NA(BSDXSIMERR3) ; Unit Test line
113 ;
114 ; add appt to file 44. This adds it to the FIRST subfile (Appointment)
115 N DIC,DA,Y,X,DD,DO,DLAYGO,DINUM
116 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
117 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")
118 . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
119 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
120 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
121 ;
122 Q:$G(BSDXSIMERR4) 1_U_$NA(BSDXSIMERR4) ; Unit Test line
123 ;
124 ; add appt for file 44, second subfile (Appointment/Patient)
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 ;Q:$G(BSDXSIMERR5) 1_U_$NA(BSDXSIMERR5) ; Unit Test line
146 S:$G(BSDXSIMERR5) X=1/0
147 ;
148 ; call event driver
149 NEW DFN,SDT,SDCL,SDDA,SDMODE
150 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
151 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
152 D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
153 Q 0
154 ;
155MAKECK(BSDR) ; $$ - Is it okay to make an appointment? ; PEP
156 ; Input: Same as $$MAKE
157 ; Output: 1^error or 0 for success
158 ; NB: This subroutine saves no data. Only checks whether it's okay.
159 ;
160 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
161 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
162 I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
163 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
164 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
165 ;
166 ; Appt Length check removed in v 1.5
167 ;
168 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
169 ; More verbose error message in v1.5
170 ; Following block to give an error message to user if there is already an appointment for patient. More verbose than others.
171 N BSDXERR ; place to store error message
172 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
173 . S BSDXERR=1_U_"Patient "_$P(^DPT(BSDR("PAT"),0),U)_" ("_BSDR("PAT")_") "
174 . S BSDXERR=BSDXERR_"already has appt at "_$$FMTE^XLFDT(BSDR("ADT"))
175 . 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)
176 . N BSDXSCNAM S BSDXSCNAM=$P(^SC(BSDXSCIEN,0),U) ; PIMS Name of Clinic
177 . S BSDXERR=BSDXERR_$C(13,10)_"PIMS clinic: "_BSDXSCNAM ; tell the user of the PIMS clinic
178 . 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)
179 . . N BSDXRESIEN S BSDXRESIEN=$O(^BSDXRES("ALOC",BSDXSCIEN,""))
180 . . QUIT:'BSDXRESIEN ; Safeguard if index is corrupt
181 . . N BSDXRESNAM S BSDXRESNAM=$P(^BSDXRES(BSDXRESIEN,0),U)
182 . . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic
183 Q 0
184 ;
185UNMAKE(BSDR) ; Reverse Make - Private $$
186 ; Only used in Emergiencies where Fileman data filing fails.
187 ; If previous data exists, which caused an error, it's destroyed.
188 ; NB: ^DIK stops for nobody
189 ; Input: Same array as $$MAKE
190 ; Output: Always 0
191 NEW DIK,DA
192 S DIK="^DPT("_BSDR("PAT")_",""S"","
193 S DA(1)=BSDR("PAT"),DA=BSDR("ADT")
194 D ^DIK
195 ;
196 N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
197 I 'IEN QUIT 0
198 ;
199 NEW DIK,DA
200 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
201 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
202 D ^DIK
203 QUIT 0
204 ;
205CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
206 ; Call like this for DFN 23435 checking in now at Hospital Location 33
207 ; for appt at Dec 20, 2009 @ 10:11:59
208 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
209 N BSDR
210 S BSDR("PAT")=DFN ;DFN
211 S BSDR("CLN")=CLIN ;Hosp Loc IEN
212 S BSDR("ADT")=APDATE ;Appt Date
213 S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now
214 S BSDR("USR")=DUZ ;Check-in user defaults to current
215 Q $$CHECKIN(.BSDR)
216 ;
217CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
218 ;
219 ; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
220 ;
221 ; Input array -
222 ; BSDR("PAT") = ien of patient in file 2
223 ; BSDR("CLN") = ien of clinic in file 44
224 ; BSDR("ADT") = appt date/time
225 ; BSDR("CDT") = checkin date/time
226 ; BSDR("USR") = checkin user
227 ;
228 ; Output value -
229 ; = 0 means everything worked
230 ; = 1^message means error with reason message
231 ;
232 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
233 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
234 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
235 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
236 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
237 I $G(BSDR("CDT"))'?7N.1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
238 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
239 ;
240 ; find ien for appt in file 44
241 NEW IEN,DIE,DA,DR
242 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
243 I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
244 ;
245 ; remember before status
246 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE
247 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
248 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
249 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
250 ;
251 ; set checkin
252 S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
253 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
254 S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
255 D ^DIE
256 ;
257 ; set after status
258 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
259 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
260 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
261 ;
262 ; call event driver
263 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
264 Q 0
265 ;
266CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
267 ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
268 ; cancellation initiated by patient ("PC" rather than clinic "C"),
269 ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
270 ; because foxes come out during bad weather.
271 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
272 N BSDR
273 S BSDR("PAT")=DFN
274 S BSDR("CLN")=CLIN
275 S BSDR("TYP")=TYP
276 S BSDR("ADT")=APDATE
277 S BSDR("CDT")=$$NOW^XLFDT
278 S BSDR("USR")=DUZ
279 S BSDR("CR")=REASON
280 S BSDR("NOT")=INFO
281 Q $$CANCEL(.BSDR)
282 ;
283CANCEL(BSDR) ;PEP; called to cancel appt
284 ;
285 ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
286 ;
287 ; Input Array -
288 ; BSDR("PAT") = ien of patient in file 2
289 ; BSDR("CLN") = ien of clinic in file 44
290 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
291 ; BSDR("ADT") = appointment date and time
292 ; BSDR("CDT") = cancel date and time
293 ; BSDR("USR") = user who canceled appt
294 ; BSDR("CR") = cancel reason - pointer to file 409.2
295 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
296 ;
297 ;Output: error status and message
298 ; = 0 or null: everything okay
299 ; = 1^message: error and reason
300 ;
301 ; Okay to Cancel? Call Cancel Check.
302 N BSDXCANCK S BSDXCANCK=$$CANCELCK(.BSDR)
303 I BSDXCANCK Q BSDXCANCK
304 ;
305 ; BSDX 1.5 3110125
306 ; UJO/SMH - Add ability to remove check-in if the patient is checked in
307 ; VEN/SMH on 3120625/v1.7 - PIMS doesn't care if patient is already checked in
308 ; Lets you remove appointment anyways! Not like RPMS.
309 ; Plus... deleting checkin affects S node on 44, which is DELETED anyways!
310 ;
311 ; remember before status
312 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL,SDMODE
313 NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
314 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
315 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
316 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
317 ; NB: Here only ^TMP globals are set with before values.
318 ;
319 ; get user who made appt and date appt made from ^SC
320 ; because data in ^SC will be deleted
321 NEW USER,DATE
322 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
323 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
324 ;
325 ; update file 2 info --old code; keep for reference
326 ;NEW DIE,DA,DR
327 ;S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
328 ;S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
329 ;S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
330 ;D ^DIE
331 N BSDXIENS S BSDXIENS=SDT_","_DFN_","
332 N BSDXFDA
333 S BSDXFDA(2.98,BSDXIENS,3)=BSDR("TYP")
334 S BSDXFDA(2.98,BSDXIENS,14)=BSDR("USR")
335 S BSDXFDA(2.98,BSDXIENS,15)=BSDR("CDT")
336 S BSDXFDA(2.98,BSDXIENS,16)=BSDR("CR")
337 S BSDXFDA(2.98,BSDXIENS,19)=USER
338 S BSDXFDA(2.98,BSDXIENS,20)=DATE
339 S:$G(BSDR("NOT"))]"" BSDXFDA(2.98,BSDXIENS,17)=$E(BSDR("NOT"),1,160)
340 N BSDXERR
341 D FILE^DIE("","BSDXFDA","BSDXERR")
342 I $D(BSDXERR) Q 1_U_"Cannot cancel appointment in File 2"
343 ; Failure point 1: If we fail here, nothing has happened yet.
344 ; No rollback needed in ^BSDXAPPT
345 ;
346 ; delete data in ^SC -- this does not (typically) fail. Fileman won't stop
347 NEW DIK,DA
348 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
349 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
350 D ^DIK
351 ; Failure point 2: not expected to happen here
352 ;
353 ; call event driver -- point of no return
354 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
355 Q 0
356 ;
357CANCELCK(BSDR) ; $$ PEP; Okay to Cancel Appointment?
358 ; Input: .BSDR array as documented in $$CANCEL
359 ; Output: 0 or 1^Error message
360 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
361 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
362 I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
363 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
364 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
365 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
366 I $G(BSDR("CDT"))'?7N.1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
367 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
368 I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
369 ;
370 NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
371 I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
372 Q 0
373CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
374 NEW X
375 S X=$G(SDIEN) ;ien sent in call
376 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
377 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
378 Q $S(X:1,1:0)
379 ;
380RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$
381 ; PAT = DFN
382 ; CLINIC = SC IEN
383 ; DATE = FM Date/Time of Appointment
384 ;
385 ; Returns:
386 ; 0 if okay
387 ; -1 if failure
388 ;
389 ; Call like this: $$RMCI(233,33,3110102.1130)
390 ;
391 ; Move my variables into the ones used by SDAPIs (just a convenience)
392 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE
393 S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN(DFN,SDCL,SDT)
394 ;
395 I SDDA<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
396 ;
397 ; remember before status
398 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
399 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
400 ;
401 ; remove check-in using filer.
402 N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_","
403 N BSDXFDA
404 S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN
405 S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER
406 S BSDXFDA(44.003,BSDXIENS,305)="@" ; CHECK IN ENTERED
407 N BSDXERR
408 D FILE^DIE("","BSDXFDA","BSDXERR")
409 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)
410 ;
411 ; set after status
412 ; S SDDA=$$SCIEN(DFN,SDCL,SDT) ;smh -why is this here? SDDA won't change.
413 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
414 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
415 ;
416 ; call event driver
417 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
418 QUIT 0
419 ;
420SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
421 NEW X,IEN
422 S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
423 . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)["C" ;cancelled
424 . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
425 Q $G(IEN)
426 ;
427APPLEN(PAT,CLINIC,DATE) ; $$ PEP; returns an appointment's length
428 ; Get either the appointment length or zero
429 ; TODO: Test
430 N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE)
431 Q:SCIEN $P(^SC(CLINIC,"S",DATE,1,SCIEN,0),U,2)
432 Q 0
433APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
434 NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
435 Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
436 ;
437CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
438 NEW X
439 S X=$G(SDIEN) ;ien sent in call
440 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
441 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
442 Q $S(X:1,1:0)
443 ;
444UPDATENT(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
445 ; PAT = DFN
446 ; CLINIC = SC IEN
447 ; DATE = FM Date/Time of Appointment
448 ;
449 ; Returns:
450 ; 0 if okay
451 ; -1 if failure
452 ;
453 ; ERROR SIMULATION
454 I $G(BSDXSIMERR1) QUIT "-1~Simulated Error"
455 ;
456 N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
457 I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
458 N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
459 N BSDXFDA S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
460 N BSDXERR
461 D FILE^DIE("","BSDXFDA","BSDXERR")
462 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)
463 QUIT 0
Note: See TracBrowser for help on using the repository browser.