source: Scheduling/trunk/m/BSDXAPI1.m@ 1510

Last change on this file since 1510 was 1481, checked in by Sam Habiel, 12 years ago

Updated routine version numbers to 1.7T2.
Changes the Writes in the post-init to MESXPDUTL in BSDX2E.
Changed the check for BMX to be for BMX 4 rather than BMX 2.
File size: 11.6 KB
Line 
1BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/9/12 2:22pm
2 ;;1.7T2;BSDX;;Jul 11, 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 ;
55NOSHOW(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 ;
102NOSHOWCK(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 ;
109RMCI(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 ;
159RMCICK(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 ;
179UPDATENT(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 ;
200AVUPDTCN(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 ;
248AVUPDTMK(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
2601 ;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
265EN1 S (X,SD)=Y,SM=0 D DOW
266S 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)
276SC 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 ;
283SP 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
296DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
297 ;
298DOW 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 ;
Note: See TracBrowser for help on using the repository browser.