42 lines
3.5 KiB
Mathematica
42 lines
3.5 KiB
Mathematica
SDMULT0 ;ALB/TMP - MAKE MULTI-CLINIC APPOINTMENTS ; 18 APR 86
|
|
;;5.3;Scheduling;**41**;AUG 13, 1993
|
|
START W !,"The following clinics have been selected: ",! F I=0:0 S I=$N(SDC1(I)) Q:I'>0 W !,$P(SDC1(I),"^",1),?45,+$P(SDC1(I),"^",2)," MINUTE APPOINTMENT"
|
|
OK S %=1 W !!,"OK to proceed" D YN^DICN I '% W !,"RESPOND YES (Y) OR NO (N)" G OK
|
|
G:(%-1) END W !
|
|
DT S %DT(0)=-SDMAX,%DT="AEF",%DT("A")="LOOK FOR CLINIC AVAILABILITY STARTING WHEN: " D ^%DT K %DT G:"^"[X END G:Y<0 DT S SDSTRTDT=+Y
|
|
LIM W !,"SELECT LATEST DATE TO CHECK FOR AVAILABLE SLOTS: " S Y=SDMAX D DT^DIQ R "// ",X:DTIME G:X["^"!'($T) END I X']"" G OVR
|
|
I X?.E1"?" W !," The latest date for future bookings (based on the limits from the selected",!," clinics) is: " S Y=SDMAX D DTS^SDUTL W Y," If you enter a date here, it must be less than this",!," date to further limit the search" G LIM
|
|
S %DT="EF",%DT(0)=-SDMAX D ^%DT K %DT G:Y<0!(Y<SDSTRTDT) LIM S:Y>0 SDMAX=+Y
|
|
OVR S SD1=0 F G1=0:0 S G1=$N(SDC(G1)),SD1=SD1+1 Q:G1'>0 D S1,AV Q:'FND S (SDSTRTDT,SDDT(SD1))=SDAPP
|
|
A I 'FND W:'$D(SDNEXT) !,"No available slots found" W:'$D(SDNEXT) " on the same day in all the selected clinics for this",!," date range" G END
|
|
I $D(SDNEXT) Q:SDNEXT G FND^SDMULT1
|
|
S SDNO=0 F I=2:1:SDCT I $D(SDDT(I)),$D(SDDT(I-1)),(SDDT(I)-SDDT(I-1)) S SDNO=1 Q
|
|
I SDNO S SDSTRTDT=SDAPP G LOOKA
|
|
D FND^SDMULT1 G END
|
|
LOOKA S SD1=0 F G1=0:0 S G1=$N(SDC(G1)),SD1=SD1+1 Q:G1'>0 I SDDT(SD1)-SDSTRTDT D S1 D:SDSTRTDT'>SDMAX AV Q:'FND S (SDSTRTDT,SDDT(SD1))=SDAPP
|
|
G A
|
|
AV S SL=$S($D(^SC(SC,"SL")):^("SL"),1:"") I SL']"" W !,*7,"No 'SL' node defined - cannot proceed with this clinic" Q
|
|
S X=$P(SL,U,6),SDSI=$S(X="":4,X<3:4,X:X,1:4),SDSOH=$P(SL,"^",8)
|
|
S SDLEN=+SL,SDINC=$P(^SC(SC,"SL"),"^",6) S:SDINC="" SDINC=4 S SDSTR="123456789jklmnopqrstuvwxyz",SDINCM=$S(SDINC=4:15,SDINC=3:20,SDINC=6:10,SDINC=2:30,SDINC=1:60,1:0),SDNS=$S($D(SDC1(SC)):$P(SDC1(SC),"^",2),1:SDLEN)\SDINCM
|
|
S:SDINC="" SDINC=4 S SDDIF=$S(SDINC<3:8/SDINC,1:2),SDINC=$S(SDINC<3:4,1:SDINC)
|
|
K SDJ,SDAPP S (SDDOT,FND)=0 F J=0:1:6 I $D(^SC(+SC,"T"_J)) S SDJ(J)=""
|
|
I '$D(SDJ),$N(^SC(SC,"ST",SDSTRTDT))'>0 Q
|
|
S SDATE=$S($E(SDSTRTDT,6,7):SDSTRTDT,$E(SDSTRTDT,4,5):SDSTRTDT+1,1:SDSTRTDT+101)
|
|
LOOP I '$D(SDJ),$N(^SC(+SC,"ST",SDATE-1))'>0 Q
|
|
G:$D(^HOLIDAY(SDATE))&('SDSOH) NEXT I $D(^SC(+SC,"ST",SDATE,1)) S SDP=^(1) G CHECK
|
|
S (X,SDATE1)=SDATE D DOW^SDM0 G:'$D(SDJ(Y)) NEXT S SDZ=$N(^SC(+SC,"T"_Y,0)) I SDZ>SDATE S SDATE1=SDZ
|
|
S SDZ=$N(^SC(+SC,"T"_Y,SDATE1)) I SDZ<0!($S('$D(^SC(+SC,"T"_Y,SDZ,1)):1,^(1)']"":1,1:0))!(SDZ>SDATE) K:SDZ<0!(SDZ>SDMAX) SDJ(Y) G NEXT
|
|
S ^SC(+SC,"ST",SDATE,1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SDATE,6,7)_$J("",SDSI+SDSI-6)_^SC(+SC,"T"_Y,SDZ,1),^SC(+SC,"ST",SDATE,0)=SDATE,SDAPP=SDATE,FND=0,SDP=^(1)
|
|
CHECK S SDST=$F(SDP,"["),(CNT,FND)=0
|
|
F J=0:SDDIF:80 Q:$E(SDP,SDST+J,80)'["]" S K=$E(SDP,SDST+J),CNT=$S(K]""&(SDSTR[K):CNT+1,1:0) S:$S(SDSTR[K:0,K?1A!(K=0):0,1:1) STX=$F(SDP,"[",SDST+J),J=$S('STX:80,1:STX-SDDIF-SDST) I (CNT-SDNS)'<0 S SDAPP=SDATE,FND=1 Q
|
|
Q:FND
|
|
NEXT S SDDOT=SDDOT+1 W:'(SDDOT#5) "." S X1=SDATE,X2=1,X=X1+1 D:+$E(X,6,7)>28 C^%DTC S SDATE=X I SDATE'>SDMAX G LOOP
|
|
Q
|
|
DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
|
|
S1 S A=SDC(G1),SC=+A,SDXXX=0
|
|
Q
|
|
END I $S('$D(SDNEXT):1,'SDNEXT:1,1:0) K SB,SC,SDDIF,SDW,SDZ,SI,SL,STARTDAY,STR
|
|
;I $D(SDNEXT),$D(FND),'FND W !,"NO AVAILABILITY FOUND"
|
|
K %,A,CNT,G1,I,K,LINE,LINE1,S,S1,SD,SD1,SDATE,SDATE1,SDC,SDC1,SDCT,SDDOT,SDDT,SDINC,SDINCM,SDJ,SDL,SDLEN,SDMADE,SDMAX,SDNO,SDNS,SDP,SDSI,SDSOH,SDSL,SDST,SDSTR,SDV,SDXXX,SM,SDSTRTDT,STM,X,X1,X2,Y,Y1,Z,ZZ D KVAR^VADPT
|
|
K SDMLT1 W ! Q:$D(SDNEXT) G 1^SDMULT
|