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

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

Updated version number on all routines to be 1.7T1.
Minor fixes here and there for XINDEX errors.
File size: 18.0 KB
Line 
1BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/6/12 10:24am
2 ;;1.7T1;BSDX;;Jul 06, 2012;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"),BSDR("PAT"))
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 ;
389 ; Check-out check. New in v1.7
390 I $$CO(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Cannot delete. Appointment has already been checked-out!"
391 Q 0
392 ;
393CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
394 NEW X
395 S X=$G(SDIEN) ;ien sent in call
396 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
397 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
398 Q $S(X:1,1:0)
399 ;
400CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
401 NEW X
402 S X=$G(SDIEN) ;ien sent in call
403 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
404 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
405 Q $S(X:1,1:0)
406 ;
407SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
408 NEW X,IEN
409 S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
410 . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)["C" ;cancelled
411 . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
412 Q $G(IEN)
413 ;
414APPLEN(PAT,CLINIC,DATE) ; $$ PEP; returns an appointment's length
415 ; Get either the appointment length or zero
416 ; TODO: Test
417 N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE)
418 Q:SCIEN $P(^SC(CLINIC,"S",DATE,1,SCIEN,0),U,2)
419 Q 0
420APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
421 NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
422 Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
423 ;
424UPDATENT(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
425 ; PAT = DFN
426 ; CLINIC = SC IEN
427 ; DATE = FM Date/Time of Appointment
428 ;
429 ; Returns:
430 ; 0 if okay
431 ; -1 if failure
432 ;
433 ; ERROR SIMULATION
434 I $G(BSDXSIMERR1) QUIT "-1~Simulated Error"
435 ;
436 N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
437 I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
438 N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
439 N BSDXFDA S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
440 N BSDXERR
441 D FILE^DIE("","BSDXFDA","BSDXERR")
442 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)
443 QUIT 0
Note: See TracBrowser for help on using the repository browser.