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

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

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