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

Last change on this file since 1049 was 1041, checked in by Sam Habiel, 14 years ago

Updated routines version to 1.42
File size: 12.7 KB
Line 
1BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 12/6/10 5:50pm
2 ;;1.42;BSDX;;Dec 07, 2010;Build 7
3 ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
4 ;local mods (many) by WV/SMH
5 ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
6 ; Change History:
7 ; 2010-11-5:
8 ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment.
9 ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API.
10 ; 2010-11-12:
11 ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well.
12 ; 2010-12-5
13 ; Added an entry point to update the patient note in file 44.
14 ; 2010-12-6
15 ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI")
16 ; 2010-12-8
17 ; Removed restriction on max appt length. Even though this restriction
18 ; exists in fileman (120 minutes), PIMS ignores it. Therefore, I
19 ; will ignore it here too.
20 ;
21MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
22 ; Call like this for DFN 23435 having an appointment at Hospital Location 33
23 ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
24 ; for Baby foxes hallucinations.
25 ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
26 S BSDR("PAT")=DFN ;DFN
27 S BSDR("CLN")=CLIN ;Hosp Loc IEN
28 S BSDR("TYP")=TYP ;3 sched or 4 walkin
29 S BSDR("ADT")=DATE ;Appointment date in FM format
30 S BSDR("LEN")=LEN ;Appt len upto 240 (min)
31 S BSDR("OI")=INFO ;Reason for appt - up to 150 char
32 S BSDR("USR")=DUZ ;Person who made appt - current user
33 Q $$MAKE(.BSDR)
34 ;
35MAKE(BSDR) ;PEP; call to store appt made
36 ;
37 ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
38 ;
39 ; Input Array -
40 ; BSDR("PAT") = ien of patient in file 2
41 ; BSDR("CLN") = ien of clinic in file 44
42 ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
43 ; BSDR("ADT") = appointment date and time
44 ; BSDR("LEN") = appointment length in minutes (5-120)
45 ; BSDR("OI") = reason for appt - up to 150 characters
46 ; BSDR("USR") = user who made appt
47 ;
48 ;Output: error status and message
49 ; = 0 or null: everything okay
50 ; = 1^message: error and reason
51 ;
52 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
53 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
54 I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
55 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
56 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
57 ;
58 ;I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) ; v 1.42 - no check on length is done anymore. see top comments for details.
59 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
60 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT")
61 ;
62 NEW DIC,DA,Y,X,DD,DO,DLAYGO
63 ;
64 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
65 . ; "un-cancel" existing appt in file 2
66 . N BSDXFDA,BSDXIENS,BSDXMSG
67 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
68 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
69 . S BSDXFDA(2.98,BSDXIENS,"3")=""
70 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
71 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
72 . S BSDXFDA(2.98,BSDXIENS,"14")=""
73 . S BSDXFDA(2.98,BSDXIENS,"15")=""
74 . S BSDXFDA(2.98,BSDXIENS,"16")=""
75 . S BSDXFDA(2.98,BSDXIENS,"19")=""
76 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
77 . D FILE^DIE("","BSDXFDA","BSDXMSG")
78 . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
79 E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
80 . N BSDXFDA,BSDXIENS,BSDXMSG
81 . S BSDXIENS="?+2,"_BSDR("PAT")_","
82 . S BSDXIENS(2)=BSDR("ADT")
83 . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
84 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
85 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
86 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
87 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
88 ; add appt to file 44
89 K DIC,DA,X,Y,DLAYGO,DD,DO
90 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
91 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")
92 . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
93 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
94 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
95 ;
96 ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
97 ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
98 ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
99 ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
100 ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
101 ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
102 ;D FILE^DICN
103 ;
104 N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_","
105 N BSDXFDA
106 S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT")
107 S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN")
108 S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150)
109 S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR")
110 S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".")
111 N BSDXERR
112 D UPDATE^DIE("","BSDXFDA","","BSDXERR")
113 ;
114 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)
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 ;
123CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
124 ; Call like this for DFN 23435 checking in now at Hospital Location 33
125 ; for appt at Dec 20, 2009 @ 10:11:59
126 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
127 S BSDR("PAT")=DFN ;DFN
128 S BSDR("CLN")=CLIN ;Hosp Loc IEN
129 S BSDR("ADT")=APDATE ;Appt Date
130 S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now
131 S BSDR("USR")=DUZ ;Check-in user defaults to current
132 Q $$CHECKIN(.BSDR)
133 ;
134CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
135 ;
136 ; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
137 ;
138 ; Input array -
139 ; BSDR("PAT") = ien of patient in file 2
140 ; BSDR("CLN") = ien of clinic in file 44
141 ; BSDR("ADT") = appt date/time
142 ; BSDR("CDT") = checkin date/time
143 ; BSDR("USR") = checkin user
144 ;
145 ; Output value -
146 ; = 0 means everything worked
147 ; = 1^message means error with reason message
148 ;
149 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
150 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
151 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
152 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
153 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
154 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
155 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
156 ;
157 ; find ien for appt in file 44
158 NEW IEN,DIE,DA,DR
159 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
160 I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
161 ;
162 ; remember before status
163 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
164 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
165 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
166 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
167 ;
168 ; set checkin
169 S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
170 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
171 S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
172 D ^DIE
173 ;
174 ; set after status
175 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
176 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
177 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
178 ;
179 ; call event driver
180 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
181 Q 0
182 ;
183CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
184 ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
185 ; cancellation initiated by patient ("PC" rather than clinic "C"),
186 ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
187 ; because foxes come out during bad weather.
188 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
189 S BSDR("PAT")=DFN
190 S BSDR("CLN")=CLIN
191 S BSDR("TYP")=TYP
192 S BSDR("ADT")=APDATE
193 S BSDR("CDT")=$$NOW^XLFDT
194 S BSDR("USR")=DUZ
195 S BSDR("CR")=REASON
196 S BSDR("NOT")=INFO
197 Q $$CANCEL(.BSDR)
198 ;
199CANCEL(BSDR) ;PEP; called to cancel appt
200 ;
201 ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
202 ;
203 ; Input Array -
204 ; BSDR("PAT") = ien of patient in file 2
205 ; BSDR("CLN") = ien of clinic in file 44
206 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
207 ; BSDR("ADT") = appointment date and time
208 ; BSDR("CDT") = cancel date and time
209 ; BSDR("USR") = user who canceled appt
210 ; BSDR("CR") = cancel reason - pointer to file 409.2
211 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
212 ;
213 ;Output: error status and message
214 ; = 0 or null: everything okay
215 ; = 1^message: error and reason
216 ;
217 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
218 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
219 I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
220 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
221 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
222 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
223 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
224 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
225 I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
226 ;
227 NEW IEN,DIE,DA,DR
228 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
229 I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
230 ;
231 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")
232 ;
233 ; remember before status
234 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
235 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
236 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
237 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
238 ;
239 ; get user who made appt and date appt made from ^SC
240 ; because data in ^SC will be deleted
241 NEW USER,DATE
242 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
243 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
244 ;
245 ; update file 2 info
246 NEW DIE,DA,DR
247 S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
248 S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
249 S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
250 D ^DIE
251 ;
252 ; delete data in ^SC
253 NEW DIK,DA
254 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
255 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
256 D ^DIK
257 ;
258 ; call event driver
259 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
260 Q 0
261 ;
262CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
263 NEW X
264 S X=$G(SDIEN) ;ien sent in call
265 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
266 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
267 Q $S(X:1,1:0)
268 ;
269SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
270 NEW X,IEN
271 S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
272 . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)["C" ;cancelled
273 . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
274 Q $G(IEN)
275 ;
276APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
277 NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
278 Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
279 ;
280CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
281 NEW X
282 S X=$G(SDIEN) ;ien sent in call
283 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
284 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
285 Q $S(X:1,1:0)
286 ;
287UPDATENOTE(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
288 ; PAT = DFN
289 ; CLINIC = SC IEN
290 ; DATE = FM Date/Time of Appointment
291 ;
292 ; Returns:
293 ; 0 if okay
294 ; -1 if failure
295 N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
296 I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
297 N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
298 S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
299 N BSDXERR
300 D FILE^DIE("","BSDXFDA","BSDXERR")
301 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)
302 QUIT 0
Note: See TracBrowser for help on using the repository browser.