1 | BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/9/12 2:22pm
|
---|
2 | ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
|
---|
3 | ; Licensed under LGPL
|
---|
4 | ;
|
---|
5 | ; Change History (BSDXAPI and BSDXAPI1)
|
---|
6 | ; Pre 1.42:
|
---|
7 | ; - Simplified entry points (MAKE1, CANCEL1, CHECKIN1)
|
---|
8 | ; 2010-11-5: (1.42)
|
---|
9 | ; - Fixed errors having to do uncanceling patient appointments if it was
|
---|
10 | ; a patient cancelled appointment.
|
---|
11 | ; - Use new style Fileman API for storing appointments in file 44 in
|
---|
12 | ; $$MAKE due to problems with legacy API.
|
---|
13 | ; 2010-11-12: (1.42)
|
---|
14 | ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as
|
---|
15 | ; well.
|
---|
16 | ; 2010-12-5 (1.42)
|
---|
17 | ; Added an entry point to update the patient note in file 44.
|
---|
18 | ; 2010-12-6 (1.42)
|
---|
19 | ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI")
|
---|
20 | ; 2010-12-8 (1.42)
|
---|
21 | ; Removed restriction on max appt length. Even though this restriction
|
---|
22 | ; exists in fileman (120 minutes), PIMS ignores it. Therefore, I
|
---|
23 | ; will ignore it here too.
|
---|
24 | ; 2011-01-25 (v.1.5)
|
---|
25 | ; Added entry point $$RMCI to remove checked in appointments.
|
---|
26 | ; In $$CANCEL, if the appointment is checked in, delete check-in rather than
|
---|
27 | ; spitting an error message to the user saying 'Delete the check-in'
|
---|
28 | ; Changed all lines that look like this:
|
---|
29 | ; I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
|
---|
30 | ; to:
|
---|
31 | ; I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
|
---|
32 | ; to allow for date at midnight which does not have a dot at the end.
|
---|
33 | ; 2011-01-26 (v.1.5)
|
---|
34 | ; More user friendly message if patient already has appointment in $$MAKE:
|
---|
35 | ; Spits out pt name and user friendly date.
|
---|
36 | ; 2012-06-18 (v 1.7)
|
---|
37 | ; Removing transacions. Means that code SHOULD NOT fail. Took all checks
|
---|
38 | ; out for making an appointment to MAKECK. We call this first to make sure
|
---|
39 | ; that the appointment is okay to make before committing to make it. We
|
---|
40 | ; still have the provision to delete the data though if we fail when we
|
---|
41 | ; actually make the appointment.
|
---|
42 | ; CANCELCK exists for the same purpose.
|
---|
43 | ; CHECKINK ditto
|
---|
44 | ; New API: $$NOSHOW^BSDXAPI1 for no-showing patients
|
---|
45 | ; Moved RMCI from BSDXAPI to BSDXAPI1 because BSDXAPI1 is getting larger
|
---|
46 | ; than 20000 characters.
|
---|
47 | ; Added RMCICK (Remove check-in check)
|
---|
48 | ; Moved Availability update EPs in BSDX07 and BSDX08 b/c they really
|
---|
49 | ; belong to PIMS, not to the Scheduling GUI. $$MAKE and $$CANCEL now
|
---|
50 | ; call the EPs here.
|
---|
51 | ; Cancel and Remove-Check-in now check to see if the patient is checked-out
|
---|
52 | ; If the patient is checked out, then we fail to cancel/no-show.
|
---|
53 | ; UPDATENOTE was renamed to UPDATENT and moved to BSDXAPI1.
|
---|
54 | ;
|
---|
55 | NOSHOW(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Patient at appt date (new in v1.7)
|
---|
56 | ; PAT = DFN
|
---|
57 | ; CLINIC = SC IEN
|
---|
58 | ; DATE = FM Date/Time of Appointment
|
---|
59 | ; NSFLAG = truthy value to add no-show, or falsy to remove (use 1 or 0 pls!)
|
---|
60 | ; 1^error for failure, 0 for success
|
---|
61 | ; Code follows EN1^SDN
|
---|
62 | ;
|
---|
63 | ; Check for failure conditions first before doing this. No globals set here
|
---|
64 | N NOSHOWCK S NOSHOWCK=$$NOSHOWCK(PAT,CLINIC,DATE,NSFLAG)
|
---|
65 | I NOSHOWCK Q NOSHOWCK
|
---|
66 | ;
|
---|
67 | ; Set up Protocol Driver
|
---|
68 | N SDNSHDL,SDDA S SDNSHDL=$$HANDLE^SDAMEVT(1) S SDDA=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE)
|
---|
69 | N SDATA
|
---|
70 | D BEFORE^SDAMEVT(.SDATA,PAT,DATE,CLINIC,SDDA,SDNSHDL) ; Only ^TMP set here.
|
---|
71 | ;
|
---|
72 | ; Simulated Errors
|
---|
73 | Q:$D(BSDXSIMERR2) 1_U_"Simulated Error"
|
---|
74 | ;
|
---|
75 | ; Edit the ^DPT( "S" node entry - Noshow or undo noshow
|
---|
76 | ; Failure analysis: if we fail here, we presume no change happened in
|
---|
77 | ; ^DPT(DA,"S", and so we just have to roll back ^BSDXAPPT
|
---|
78 | N BSDXIENS S BSDXIENS=DATE_","_PAT_","
|
---|
79 | N BSDXFDA
|
---|
80 | I +NSFLAG D
|
---|
81 | . S BSDXFDA(2.98,BSDXIENS,3)="N"
|
---|
82 | . S BSDXFDA(2.98,BSDXIENS,14)=DUZ
|
---|
83 | . S BSDXFDA(2.98,BSDXIENS,15)=$$NOW^XLFDT()
|
---|
84 | E D
|
---|
85 | . S BSDXFDA(2.98,BSDXIENS,3)="@"
|
---|
86 | . S BSDXFDA(2.98,BSDXIENS,14)="@"
|
---|
87 | . S BSDXFDA(2.98,BSDXIENS,15)="@"
|
---|
88 | N BSDXMSG
|
---|
89 | D FILE^DIE("","BSDXFDA","BSDXMSG")
|
---|
90 | Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_PAT_" Appt="_DATE_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
|
---|
91 | ;
|
---|
92 | ; This M error trigger tests if ^BSDXAPPT rolls back.
|
---|
93 | ; I won't try to roll back ^DPT(,"S" because
|
---|
94 | ; the M error is caused here, so if I try to rollback, I can cause another
|
---|
95 | ; error. Infinite Errors then.
|
---|
96 | I $D(BSDXSIMERR3) N X S X=1/0
|
---|
97 | ;
|
---|
98 | ; Run the event driver
|
---|
99 | D NOSHOW^SDAMEVT(.SDATA,PAT,DATE,CLINIC,SDDA,0,SDNSHDL)
|
---|
100 | Q 0
|
---|
101 | ;
|
---|
102 | NOSHOWCK(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Check
|
---|
103 | ; TODO: Not all appointments can be no showed.
|
---|
104 | ; Check the code in SDAMN
|
---|
105 | ; S SDSTB=$$STATUS^SDAM1(DFN,SDT,SDCL,$G(^DPT(DFN,"S",SDT,0))) ; before status
|
---|
106 | ; Q:'$$CHK ; Checks $D(^SD(409.63,"ANS",1,+SDSTB))
|
---|
107 | QUIT 0
|
---|
108 | ;
|
---|
109 | RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$
|
---|
110 | ; PAT = DFN
|
---|
111 | ; CLINIC = SC IEN
|
---|
112 | ; DATE = FM Date/Time of Appointment
|
---|
113 | ;
|
---|
114 | ; Returns:
|
---|
115 | ; 0 if okay
|
---|
116 | ; -1 if failure
|
---|
117 | ;
|
---|
118 | ; Call like this: $$RMCI(233,33,3110102.1130)
|
---|
119 | ;
|
---|
120 | ; Check to see if we can remove the check-in
|
---|
121 | N BSDXERR S BSDXERR=$$RMCICK(PAT,CLINIC,DATE)
|
---|
122 | I BSDXERR Q BSDXERR
|
---|
123 | ;
|
---|
124 | ; Move my variables into the ones used by SDAPIs (just a convenience)
|
---|
125 | NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE
|
---|
126 | S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN^BSDXAPI(DFN,SDCL,SDT)
|
---|
127 | ;
|
---|
128 | I SDDA<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
|
---|
129 | ;
|
---|
130 | ; remember before status
|
---|
131 | S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
|
---|
132 | D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
|
---|
133 | ;
|
---|
134 | ; M Error Test - Simulate behavior when an M error occurs
|
---|
135 | I $G(BSDXDIE2) N X S X=1/0
|
---|
136 | ;
|
---|
137 | ; Simulate a failure to file the data in Fileman
|
---|
138 | I $D(BSDXSIMERR3) Q 1_U_"Simulated Error"
|
---|
139 | ;
|
---|
140 | ; remove check-in using filer.
|
---|
141 | N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_","
|
---|
142 | N BSDXFDA
|
---|
143 | S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN
|
---|
144 | S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER
|
---|
145 | S BSDXFDA(44.003,BSDXIENS,305)="@" ; CHECK IN ENTERED
|
---|
146 | N BSDXERR
|
---|
147 | D FILE^DIE("","BSDXFDA","BSDXERR")
|
---|
148 | 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)
|
---|
149 | ;
|
---|
150 | ; set after status
|
---|
151 | ; S SDDA=$$SCIEN(DFN,SDCL,SDT) ;smh -why is this here? SDDA won't change.
|
---|
152 | S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
|
---|
153 | D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
|
---|
154 | ;
|
---|
155 | ; call event driver
|
---|
156 | D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
|
---|
157 | QUIT 0
|
---|
158 | ;
|
---|
159 | RMCICK(PAT,CLINIC,DATE) ;PEP; Can you remove a check-in for this patient?
|
---|
160 | ; PAT - DFN by value
|
---|
161 | ; CLINIC - ^SC ien by value
|
---|
162 | ; DATE - Appointment Date
|
---|
163 | ; Output: 0 if okay or 1 if error
|
---|
164 | ;
|
---|
165 | ; Error for Unit Tests
|
---|
166 | I $G(BSDXSIMERR2) Q 1_U_"Simulated Error"
|
---|
167 | ;
|
---|
168 | ; Get appointment IEN in ^SC(DA(2),"S",DA(1),1,
|
---|
169 | N SCIEN S SCIEN=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE)
|
---|
170 | ;
|
---|
171 | ; If not there, it has been cancelled. Okay to Remove Check-in.
|
---|
172 | I 'SCIEN QUIT 0
|
---|
173 | ;
|
---|
174 | ; Check if checked out
|
---|
175 | I $$CO^BSDXAPI(PAT,CLINIC,DATE,SCIEN) Q 1_U_"Appointment Already Checked Out"
|
---|
176 | ;
|
---|
177 | QUIT 0
|
---|
178 | ;
|
---|
179 | UPDATENT(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
|
---|
180 | ; PAT = DFN
|
---|
181 | ; CLINIC = SC IEN
|
---|
182 | ; DATE = FM Date/Time of Appointment
|
---|
183 | ;
|
---|
184 | ; Returns:
|
---|
185 | ; 0 if okay
|
---|
186 | ; -1 if failure
|
---|
187 | ;
|
---|
188 | ; ERROR SIMULATION
|
---|
189 | I $G(BSDXSIMERR1) QUIT "-1~Simulated Error"
|
---|
190 | ;
|
---|
191 | N SCIEN S SCIEN=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE) ; ien of appt in ^SC
|
---|
192 | I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
|
---|
193 | N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
|
---|
194 | N BSDXFDA S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
|
---|
195 | N BSDXERR
|
---|
196 | D FILE^DIE("","BSDXFDA","BSDXERR")
|
---|
197 | 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)
|
---|
198 | QUIT 0
|
---|
199 | ;
|
---|
200 | AVUPDTCN(BSDXSCD,BSDXSTART,BSDXLEN) ;Update PIMS Clinic availability for cancel
|
---|
201 | ; NB: VEN/SMH: This code has never been tested. It's here for its
|
---|
202 | ; presumptive function, but I don't know whether it works accurately!
|
---|
203 | ;See SDCNP0
|
---|
204 | N SD,S ; Start Date
|
---|
205 | S (SD,S)=BSDXSTART
|
---|
206 | N I ; Clinic IEN in 44
|
---|
207 | S I=BSDXSCD
|
---|
208 | ; if day has no schedule in legacy PIMS, forget about this update.
|
---|
209 | Q:'$D(^SC(I,"ST",SD\1,1))
|
---|
210 | N SL ; Clinic characteristics node (length of appt, when appts start etc)
|
---|
211 | S SL=^SC(I,"SL")
|
---|
212 | N X ; Hour Clinic Display Begins
|
---|
213 | S X=$P(SL,U,3)
|
---|
214 | N STARTDAY ; When does the day start?
|
---|
215 | S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am
|
---|
216 | N SB ; ?? Who knows? Day Start - 1 divided by 100.
|
---|
217 | S SB=STARTDAY-1/100
|
---|
218 | S X=$P(SL,U,6) ; Now X is Display increments per hour
|
---|
219 | N HSI ; Slots per hour, try 1
|
---|
220 | S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4
|
---|
221 | N SI ; Slots per hour, try 2
|
---|
222 | S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4
|
---|
223 | N STR ; ??
|
---|
224 | S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
|
---|
225 | N SDDIF ; Slots per hour diff??
|
---|
226 | S SDDIF=$S(HSI<3:8/HSI,1:2)
|
---|
227 | S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI
|
---|
228 | S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS
|
---|
229 | N Y ; Hours since start of Date
|
---|
230 | S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs
|
---|
231 | N ST ; ??
|
---|
232 | ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour
|
---|
233 | ; Y\1 -> Hours since start of day; * SI: * slots
|
---|
234 | S ST=Y#1*SI\.6+(Y\1*SI)
|
---|
235 | N SS ; how many slots are supposed to be taken by appointment
|
---|
236 | S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots)
|
---|
237 | N I
|
---|
238 | I Y'<1 D ; If Hours since start of Date is greater than 1
|
---|
239 | . ; loop through pattern. Tired of documenting.
|
---|
240 | . F I=ST+ST:SDDIF D Q:Y="" Q:SS'>0
|
---|
241 | . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y=""
|
---|
242 | . . S S=$E(S,1,I)_Y_$E(S,I+2,999)
|
---|
243 | . . S SS=SS-1
|
---|
244 | . . Q:SS'>0
|
---|
245 | S ^SC(BSDXSCD,"ST",SD\1,1)=S ; new pattern; global set
|
---|
246 | Q
|
---|
247 | ;
|
---|
248 | AVUPDTMK(BSDXSCD,BSDXSTART,BSDXLEN,BSDXPATID) ; Update RPMS Clinic availability for Make
|
---|
249 | ;SEE SDM1
|
---|
250 | N Y,DFN
|
---|
251 | N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG
|
---|
252 | N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I
|
---|
253 | S Y=BSDXSCD,DFN=BSDXPATID
|
---|
254 | S SL=$G(^SC(+Y,"SL")),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SC=Y,SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y
|
---|
255 | ;Determine maximum days for scheduling
|
---|
256 | S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365
|
---|
257 | S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1))
|
---|
258 | S SDDATE=BSDXSTART
|
---|
259 | S SDSDATE=SDDATE,SDDATE=SDDATE\1
|
---|
260 | 1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC
|
---|
261 | Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC
|
---|
262 | S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2)
|
---|
263 | S X2=SDEDT D C^%DTC S SDEDT=X
|
---|
264 | S Y=BSDXSTART
|
---|
265 | EN1 S (X,SD)=Y,SM=0 D DOW
|
---|
266 | S I '$D(^SC(SC,"ST",$P(SD,"."),1)) S SS=+$O(^SC(+SC,"T"_Y,SD)) Q:SS'>0 Q:^(SS,1)="" S ^SC(+SC,"ST",$P(SD,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(SD,".")
|
---|
267 | S S=BSDXLEN
|
---|
268 | ;Check if BSDXLEN evenly divisible by appointment length
|
---|
269 | S RPMSL=$P(SL,U)
|
---|
270 | I BSDXLEN<RPMSL S BSDXLEN=RPMSL
|
---|
271 | I BSDXLEN#RPMSL'=0 D
|
---|
272 | . S BSDXINC=BSDXLEN\RPMSL
|
---|
273 | . S BSDXINC=BSDXINC+1
|
---|
274 | . S BSDXLEN=RPMSL*BSDXINC
|
---|
275 | S SL=S_U_$P(SL,U,2,99)
|
---|
276 | SC S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9
|
---|
277 | L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC
|
---|
278 | S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1)
|
---|
279 | S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST
|
---|
280 | I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q
|
---|
281 | I SM<7 S %=$F(S,"[",SS-1) S:'%!($P(SL,"^",6)<3) %=999 I $F(S,"]",SS)'<%!(SDDIF=2&$E(S,ST+ST+1,SS-1)["[") S SM=7
|
---|
282 | ;
|
---|
283 | SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP
|
---|
284 | S SDNOT=1
|
---|
285 | S ABORT=0
|
---|
286 | F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT
|
---|
287 | . S ST=$E(S,I+1) S:ST="" ST=" "
|
---|
288 | . S Y=$E(STR,$F(STR,ST)-2)
|
---|
289 | . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q
|
---|
290 | . I Y="" S ABORT=1 Q
|
---|
291 | . S:Y'?1NL&(SM<6) SM=6 S ST=$E(S,I+2,999) S:ST="" ST=" " S S=$E(S,1,I)_Y_ST
|
---|
292 | . Q
|
---|
293 | S ^SC(SC,"ST",$P(SD,"."),1)=S
|
---|
294 | L -^SC(SC,"ST",$P(SD,"."),1)
|
---|
295 | Q
|
---|
296 | DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
|
---|
297 | ;
|
---|
298 | DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y)
|
---|
299 | F %=%:-1:281 S Y=%#4=1+1+Y
|
---|
300 | S Y=$E(X,6,7)+Y#7
|
---|
301 | Q
|
---|
302 | ;
|
---|