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

Last change on this file since 1035 was 1035, checked in by Sam Habiel, 13 years ago

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