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

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

Updated version number on all routines to be 1.7T1.
Minor fixes here and there for XINDEX errors.
File size: 11.4 KB
Line 
1BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/6/12 10:23am
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 ;
52NOSHOW(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Patient at appt date (new in v1.7)
53 ; PAT = DFN
54 ; CLINIC = SC IEN
55 ; DATE = FM Date/Time of Appointment
56 ; NSFLAG = truthy value to add no-show, or falsy to remove (use 1 or 0 pls!)
57 ; 1^error for failure, 0 for success
58 ; Code follows EN1^SDN
59 ;
60 ; Check for failure conditions first before doing this. No globals set here
61 N NOSHOWCK S NOSHOWCK=$$NOSHOWCK(PAT,CLINIC,DATE,NSFLAG)
62 I NOSHOWCK Q NOSHOWCK
63 ;
64 ; Set up Protocol Driver
65 N SDNSHDL,SDDA S SDNSHDL=$$HANDLE^SDAMEVT(1) S SDDA=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE)
66 N SDATA
67 D BEFORE^SDAMEVT(.SDATA,PAT,DATE,CLINIC,SDDA,SDNSHDL) ; Only ^TMP set here.
68 ;
69 ; Simulated Errors
70 Q:$D(BSDXSIMERR2) 1_U_"Simulated Error"
71 ;
72 ; Edit the ^DPT( "S" node entry - Noshow or undo noshow
73 ; Failure analysis: if we fail here, we presume no change happened in
74 ; ^DPT(DA,"S", and so we just have to roll back ^BSDXAPPT
75 N BSDXIENS S BSDXIENS=DATE_","_PAT_","
76 N BSDXFDA
77 I +NSFLAG D
78 . S BSDXFDA(2.98,BSDXIENS,3)="N"
79 . S BSDXFDA(2.98,BSDXIENS,14)=DUZ
80 . S BSDXFDA(2.98,BSDXIENS,15)=$$NOW^XLFDT()
81 E D
82 . S BSDXFDA(2.98,BSDXIENS,3)="@"
83 . S BSDXFDA(2.98,BSDXIENS,14)="@"
84 . S BSDXFDA(2.98,BSDXIENS,15)="@"
85 N BSDXMSG
86 D FILE^DIE("","BSDXFDA","BSDXMSG")
87 Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_PAT_" Appt="_DATE_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
88 ;
89 ; This M error trigger tests if ^BSDXAPPT rolls back.
90 ; I won't try to roll back ^DPT(,"S" because
91 ; the M error is caused here, so if I try to rollback, I can cause another
92 ; error. Infinite Errors then.
93 I $D(BSDXSIMERR3) N X S X=1/0
94 ;
95 ; Run the event driver
96 D NOSHOW^SDAMEVT(.SDATA,PAT,DATE,CLINIC,SDDA,0,SDNSHDL)
97 Q 0
98 ;
99NOSHOWCK(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Check
100 ; TODO: Not all appointments can be no showed.
101 ; Check the code in SDAMN
102 ; S SDSTB=$$STATUS^SDAM1(DFN,SDT,SDCL,$G(^DPT(DFN,"S",SDT,0))) ; before status
103 ; Q:'$$CHK ; Checks $D(^SD(409.63,"ANS",1,+SDSTB))
104 QUIT 0
105 ;
106RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$
107 ; PAT = DFN
108 ; CLINIC = SC IEN
109 ; DATE = FM Date/Time of Appointment
110 ;
111 ; Returns:
112 ; 0 if okay
113 ; -1 if failure
114 ;
115 ; Call like this: $$RMCI(233,33,3110102.1130)
116 ;
117 ; Check to see if we can remove the check-in
118 N BSDXERR S BSDXERR=$$RMCICK(PAT,CLINIC,DATE)
119 I BSDXERR Q BSDXERR
120 ;
121 ; Move my variables into the ones used by SDAPIs (just a convenience)
122 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE
123 S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN^BSDXAPI(DFN,SDCL,SDT)
124 ;
125 I SDDA<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
126 ;
127 ; remember before status
128 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
129 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
130 ;
131 ; M Error Test - Simulate behavior when an M error occurs
132 I $G(BSDXDIE2) N X S X=1/0
133 ;
134 ; Simulate a failure to file the data in Fileman
135 I $D(BSDXSIMERR3) Q 1_U_"Simulated Error"
136 ;
137 ; remove check-in using filer.
138 N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_","
139 N BSDXFDA
140 S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN
141 S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER
142 S BSDXFDA(44.003,BSDXIENS,305)="@" ; CHECK IN ENTERED
143 N BSDXERR
144 D FILE^DIE("","BSDXFDA","BSDXERR")
145 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)
146 ;
147 ; set after status
148 ; S SDDA=$$SCIEN(DFN,SDCL,SDT) ;smh -why is this here? SDDA won't change.
149 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
150 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
151 ;
152 ; call event driver
153 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
154 QUIT 0
155 ;
156RMCICK(PAT,CLINIC,DATE) ;PEP; Can you remove a check-in for this patient?
157 ; PAT - DFN by value
158 ; CLINIC - ^SC ien by value
159 ; DATE - Appointment Date
160 ; Output: 0 if okay or 1 if error
161 ;
162 ; Error for Unit Tests
163 I $G(BSDXSIMERR2) Q 1_U_"Simulated Error"
164 ;
165 ; Get appointment IEN in ^SC(DA(2),"S",DA(1),1,
166 N SCIEN S SCIEN=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE)
167 ;
168 ; If not there, it has been cancelled. Okay to Remove Check-in.
169 I 'SCIEN QUIT 0
170 ;
171 ; Check if checked out
172 I $$CO^BSDXAPI(PAT,CLINIC,DATE,SCIEN) Q 1_U_"Appointment Already Checked Out"
173 ;
174 QUIT 0
175 ;
176UPDATENT(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
177 ; PAT = DFN
178 ; CLINIC = SC IEN
179 ; DATE = FM Date/Time of Appointment
180 ;
181 ; Returns:
182 ; 0 if okay
183 ; -1 if failure
184 ;
185 ; ERROR SIMULATION
186 I $G(BSDXSIMERR1) QUIT "-1~Simulated Error"
187 ;
188 N SCIEN S SCIEN=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE) ; ien of appt in ^SC
189 I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
190 N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
191 N BSDXFDA S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
192 N BSDXERR
193 D FILE^DIE("","BSDXFDA","BSDXERR")
194 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)
195 QUIT 0
196 ;
197AVUPDTCN(BSDXSCD,BSDXSTART,BSDXLEN) ;Update PIMS Clinic availability for cancel
198 ; NB: VEN/SMH: This code has never been tested. It's here for its
199 ; presumptive function, but I don't know whether it works accurately!
200 ;See SDCNP0
201 N SD,S ; Start Date
202 S (SD,S)=BSDXSTART
203 N I ; Clinic IEN in 44
204 S I=BSDXSCD
205 ; if day has no schedule in legacy PIMS, forget about this update.
206 Q:'$D(^SC(I,"ST",SD\1,1))
207 N SL ; Clinic characteristics node (length of appt, when appts start etc)
208 S SL=^SC(I,"SL")
209 N X ; Hour Clinic Display Begins
210 S X=$P(SL,U,3)
211 N STARTDAY ; When does the day start?
212 S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am
213 N SB ; ?? Who knows? Day Start - 1 divided by 100.
214 S SB=STARTDAY-1/100
215 S X=$P(SL,U,6) ; Now X is Display increments per hour
216 N HSI ; Slots per hour, try 1
217 S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4
218 N SI ; Slots per hour, try 2
219 S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4
220 N STR ; ??
221 S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
222 N SDDIF ; Slots per hour diff??
223 S SDDIF=$S(HSI<3:8/HSI,1:2)
224 S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI
225 S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS
226 N Y ; Hours since start of Date
227 S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs
228 N ST ; ??
229 ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour
230 ; Y\1 -> Hours since start of day; * SI: * slots
231 S ST=Y#1*SI\.6+(Y\1*SI)
232 N SS ; how many slots are supposed to be taken by appointment
233 S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots)
234 N I
235 I Y'<1 D ; If Hours since start of Date is greater than 1
236 . ; loop through pattern. Tired of documenting.
237 . F I=ST+ST:SDDIF D Q:Y="" Q:SS'>0
238 . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y=""
239 . . S S=$E(S,1,I)_Y_$E(S,I+2,999)
240 . . S SS=SS-1
241 . . Q:SS'>0
242 S ^SC(BSDXSCD,"ST",SD\1,1)=S ; new pattern; global set
243 Q
244 ;
245AVUPDTMK(BSDXSCD,BSDXSTART,BSDXLEN,BSDXPATID) ; Update RPMS Clinic availability for Make
246 ;SEE SDM1
247 N Y,DFN
248 N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG
249 N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I
250 S Y=BSDXSCD,DFN=BSDXPATID
251 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
252 ;Determine maximum days for scheduling
253 S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365
254 S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1))
255 S SDDATE=BSDXSTART
256 S SDSDATE=SDDATE,SDDATE=SDDATE\1
2571 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC
258 Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC
259 S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2)
260 S X2=SDEDT D C^%DTC S SDEDT=X
261 S Y=BSDXSTART
262EN1 S (X,SD)=Y,SM=0 D DOW
263S 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,".")
264 S S=BSDXLEN
265 ;Check if BSDXLEN evenly divisible by appointment length
266 S RPMSL=$P(SL,U)
267 I BSDXLEN<RPMSL S BSDXLEN=RPMSL
268 I BSDXLEN#RPMSL'=0 D
269 . S BSDXINC=BSDXLEN\RPMSL
270 . S BSDXINC=BSDXINC+1
271 . S BSDXLEN=RPMSL*BSDXINC
272 S SL=S_U_$P(SL,U,2,99)
273SC S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9
274 L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC
275 S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1)
276 S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST
277 I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q
278 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
279 ;
280SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP
281 S SDNOT=1
282 S ABORT=0
283 F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT
284 . S ST=$E(S,I+1) S:ST="" ST=" "
285 . S Y=$E(STR,$F(STR,ST)-2)
286 . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q
287 . I Y="" S ABORT=1 Q
288 . 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
289 . Q
290 S ^SC(SC,"ST",$P(SD,"."),1)=S
291 L -^SC(SC,"ST",$P(SD,"."),1)
292 Q
293DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
294 ;
295DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y)
296 F %=%:-1:281 S Y=%#4=1+1+Y
297 S Y=$E(X,6,7)+Y#7
298 Q
299 ;
Note: See TracBrowser for help on using the repository browser.