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

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

Refactoring cont.
Many changes in BSDX08. Extensive changes in BSDX31. Creation of BSDXAPI1 as continuation of BSDXAPI.
BSDXUT1 now has UTs for BSDX31. Transactions now gone from BSDX08 and BSDX31.
BSDX08 needs more tests at failure points. BSDX31 still needs analysis for transaction failure and
code for rollback points, plus tests for that.
File size: 19.0 KB
Line 
1BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/26/12 4:55pm
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.