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

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

Updated routine version numbers to 1.5

File size: 16.2 KB
RevLine 
[1081]1BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 1/26/11 11:47am
[1085]2 ;;1.5;BSDX;;Jan 25, 2011;Build 7
[968]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:
[1080]7 ; 2010-11-5: (1.42)
[968]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.
[1080]10 ; 2010-11-12: (1.42)
[1076]11 ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well.
[1080]12 ; 2010-12-5 (1.42)
[1076]13 ; Added an entry point to update the patient note in file 44.
[1080]14 ; 2010-12-6 (1.42)
[1076]15 ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI")
[1080]16 ; 2010-12-8 (1.42)
[1076]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.
[1080]20 ; 2011-01-25 (v.1.5)
21 ; Added entry point $$RMCI to remove checked in appointments.
22 ; In $$CANCEL, if the appointment is checked in, delete check-in rather than
23 ; spitting an error message to the user saying 'Delete the check-in'
24 ; Changed all lines that look like this:
25 ; I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
26 ; to:
27 ; I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
28 ; to allow for date at midnight which does not have a dot at the end.
[1081]29 ; 2011-01-26 (v.1.5)
30 ; More user friendly message if patient already has appointment in $$MAKE:
31 ; Spits out pt name and user friendly date.
[1080]32 ;
[968]33 ;
34MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
35 ; Call like this for DFN 23435 having an appointment at Hospital Location 33
36 ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
37 ; for Baby foxes hallucinations.
38 ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
39 S BSDR("PAT")=DFN ;DFN
40 S BSDR("CLN")=CLIN ;Hosp Loc IEN
41 S BSDR("TYP")=TYP ;3 sched or 4 walkin
42 S BSDR("ADT")=DATE ;Appointment date in FM format
43 S BSDR("LEN")=LEN ;Appt len upto 240 (min)
[1035]44 S BSDR("OI")=INFO ;Reason for appt - up to 150 char
[968]45 S BSDR("USR")=DUZ ;Person who made appt - current user
46 Q $$MAKE(.BSDR)
47 ;
48MAKE(BSDR) ;PEP; call to store appt made
49 ;
50 ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
51 ;
52 ; Input Array -
53 ; BSDR("PAT") = ien of patient in file 2
54 ; BSDR("CLN") = ien of clinic in file 44
55 ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
56 ; BSDR("ADT") = appointment date and time
[1081]57 ; BSDR("LEN") = appointment length in minutes (*1.42 limit removed)
[968]58 ; BSDR("OI") = reason for appt - up to 150 characters
59 ; BSDR("USR") = user who made appt
60 ;
61 ;Output: error status and message
62 ; = 0 or null: everything okay
63 ; = 1^message: error and reason
64 ;
65 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
66 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
67 I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
68 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
[1080]69 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
[968]70 ;
[1041]71 ;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.
[968]72 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
[1081]73 ;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") ; v.1.5 more user friendly err msg
[968]74 ;
[1081]75 ; Following block to give an error message to user if there is already an appointment for patient. More verbose than others.
76 N BSDXERR ; place to store error message
77 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
78 . S BSDXERR=1_U_"Patient "_$P(^DPT(BSDR("PAT"),0),U)_" ("_BSDR("PAT")_") "
79 . S BSDXERR=BSDXERR_"already has appt at "_$$FMTE^XLFDT(BSDR("ADT"))
80 . 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)
81 . N BSDXSCNAM S BSDXSCNAM=$P(^SC(BSDXSCIEN,0),U) ; PIMS Name of Clinic
82 . S BSDXERR=BSDXERR_$C(13,10)_"PIMS clinic: "_BSDXSCNAM ; tell the user of the PIMS clinic
83 . 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)
84 . . N BSDXRESIEN S BSDXRESIEN=$O(^BSDXRES("ALOC",BSDXSCIEN,""))
85 . . QUIT:'BSDXRESIEN ; Safeguard if index is corrupt
86 . . N BSDXRESNAM S BSDXRESNAM=$P(^BSDXRES(BSDXRESIEN,0),U)
87 . . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic
88 ;
[968]89 NEW DIC,DA,Y,X,DD,DO,DLAYGO
90 ;
91 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
92 . ; "un-cancel" existing appt in file 2
93 . N BSDXFDA,BSDXIENS,BSDXMSG
94 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
95 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
96 . S BSDXFDA(2.98,BSDXIENS,"3")=""
97 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
98 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
99 . S BSDXFDA(2.98,BSDXIENS,"14")=""
100 . S BSDXFDA(2.98,BSDXIENS,"15")=""
101 . S BSDXFDA(2.98,BSDXIENS,"16")=""
102 . S BSDXFDA(2.98,BSDXIENS,"19")=""
103 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
104 . D FILE^DIE("","BSDXFDA","BSDXMSG")
105 . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
106 E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
107 . N BSDXFDA,BSDXIENS,BSDXMSG
108 . S BSDXIENS="?+2,"_BSDR("PAT")_","
109 . S BSDXIENS(2)=BSDR("ADT")
110 . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
111 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
112 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
113 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
114 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
115 ; add appt to file 44
116 K DIC,DA,X,Y,DLAYGO,DD,DO
117 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
118 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")
119 . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
120 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
121 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
122 ;
123 ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
124 ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
125 ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
126 ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
127 ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
128 ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
129 ;D FILE^DICN
130 ;
131 N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_","
132 N BSDXFDA
133 S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT")
134 S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN")
135 S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150)
136 S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR")
137 S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".")
138 N BSDXERR
139 D UPDATE^DIE("","BSDXFDA","","BSDXERR")
140 ;
141 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)
142 ;
143 ; call event driver
144 NEW DFN,SDT,SDCL,SDDA,SDMODE
145 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
146 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
147 D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
148 Q 0
149 ;
150CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
151 ; Call like this for DFN 23435 checking in now at Hospital Location 33
152 ; for appt at Dec 20, 2009 @ 10:11:59
153 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
154 S BSDR("PAT")=DFN ;DFN
155 S BSDR("CLN")=CLIN ;Hosp Loc IEN
156 S BSDR("ADT")=APDATE ;Appt Date
157 S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now
158 S BSDR("USR")=DUZ ;Check-in user defaults to current
159 Q $$CHECKIN(.BSDR)
160 ;
161CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
162 ;
163 ; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
164 ;
165 ; Input array -
166 ; BSDR("PAT") = ien of patient in file 2
167 ; BSDR("CLN") = ien of clinic in file 44
168 ; BSDR("ADT") = appt date/time
169 ; BSDR("CDT") = checkin date/time
170 ; BSDR("USR") = checkin user
171 ;
172 ; Output value -
173 ; = 0 means everything worked
174 ; = 1^message means error with reason message
175 ;
176 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
177 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
178 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
[1080]179 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
[968]180 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
[1080]181 I $G(BSDR("CDT"))'?7N.1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
[968]182 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
183 ;
184 ; find ien for appt in file 44
185 NEW IEN,DIE,DA,DR
186 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
187 I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
188 ;
189 ; remember before status
190 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
191 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
192 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
193 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
194 ;
195 ; set checkin
196 S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
197 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
198 S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
199 D ^DIE
200 ;
201 ; set after status
202 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
203 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
204 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
205 ;
206 ; call event driver
207 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
208 Q 0
209 ;
210CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
211 ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
212 ; cancellation initiated by patient ("PC" rather than clinic "C"),
213 ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
214 ; because foxes come out during bad weather.
215 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
216 S BSDR("PAT")=DFN
217 S BSDR("CLN")=CLIN
218 S BSDR("TYP")=TYP
219 S BSDR("ADT")=APDATE
220 S BSDR("CDT")=$$NOW^XLFDT
221 S BSDR("USR")=DUZ
222 S BSDR("CR")=REASON
223 S BSDR("NOT")=INFO
224 Q $$CANCEL(.BSDR)
225 ;
226CANCEL(BSDR) ;PEP; called to cancel appt
227 ;
228 ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
229 ;
230 ; Input Array -
231 ; BSDR("PAT") = ien of patient in file 2
232 ; BSDR("CLN") = ien of clinic in file 44
233 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
234 ; BSDR("ADT") = appointment date and time
235 ; BSDR("CDT") = cancel date and time
236 ; BSDR("USR") = user who canceled appt
237 ; BSDR("CR") = cancel reason - pointer to file 409.2
238 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
239 ;
240 ;Output: error status and message
241 ; = 0 or null: everything okay
242 ; = 1^message: error and reason
243 ;
244 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
245 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
246 I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
247 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
[1080]248 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
[968]249 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
[1080]250 I $G(BSDR("CDT"))'?7N.1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
[968]251 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
252 I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
253 ;
254 NEW IEN,DIE,DA,DR
255 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
256 I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
257 ;
[1080]258 ; BSDX 1.5 3110125
259 ; UJO/SMH - Add ability to remove check-in if the patient is checked in
260 ; 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")
261 ; Remove check-in if the patient is checked in.
262 N BSDXRESULT S BSDXRESULT=0 ; Result; should be zero if success; -1 + message if failure
263 I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) SET BSDXRESULT=$$RMCI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
264 I BSDXRESULT Q BSDXRESULT
[968]265 ;
266 ; remember before status
267 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
268 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
269 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
270 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
271 ;
272 ; get user who made appt and date appt made from ^SC
273 ; because data in ^SC will be deleted
274 NEW USER,DATE
275 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
276 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
277 ;
278 ; update file 2 info
279 NEW DIE,DA,DR
280 S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
281 S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
282 S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
283 D ^DIE
284 ;
285 ; delete data in ^SC
286 NEW DIK,DA
287 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
288 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
289 D ^DIK
290 ;
291 ; call event driver
292 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
293 Q 0
294 ;
295CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
296 NEW X
297 S X=$G(SDIEN) ;ien sent in call
298 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
299 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
300 Q $S(X:1,1:0)
301 ;
[1085]302RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$
[1076]303 ; PAT = DFN
304 ; CLINIC = SC IEN
305 ; DATE = FM Date/Time of Appointment
306 ;
307 ; Returns:
308 ; 0 if okay
309 ; -1 if failure
310 ;
[1080]311 ; Call like this: $$RMCI(233,33,3110102.1130)
312 ;
313 ; Move my variables into the ones used by SDAPIs (just a convenience)
[1076]314 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
315 S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN(DFN,SDCL,SDT)
316 ;
317 I SDDA<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
318 ;
[1080]319 ; remember before status
[1076]320 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
321 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
322 ;
323 ; remove check-in using filer.
324 N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_","
325 S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN
326 S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER
327 S BSDXFDA(44.003,BSDXIENS,305)="@" ; CHECK IN ENTERED
328 N BSDXERR
329 D FILE^DIE("","BSDXFDA","BSDXERR")
330 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)
331 ;
332 ; set after status
333 S SDDA=$$SCIEN(DFN,SDCL,SDT)
334 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
335 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
336 ;
337 ; call event driver
338 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
339 QUIT 0
340 ;
[968]341SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
342 NEW X,IEN
343 S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
[1006]344 . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)["C" ;cancelled
[968]345 . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
346 Q $G(IEN)
347 ;
348APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
349 NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
350 Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
351 ;
352CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
353 NEW X
354 S X=$G(SDIEN) ;ien sent in call
355 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
356 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
357 Q $S(X:1,1:0)
358 ;
[1041]359UPDATENOTE(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
[1080]360 ; PAT = DFN
361 ; CLINIC = SC IEN
362 ; DATE = FM Date/Time of Appointment
363 ;
364 ; Returns:
365 ; 0 if okay
366 ; -1 if failure
367 N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
368 I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
369 N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
370 S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
371 N BSDXERR
372 D FILE^DIE("","BSDXFDA","BSDXERR")
373 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)
374 QUIT 0
Note: See TracBrowser for help on using the repository browser.