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

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

This fixes two bugs:

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