source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDMULT0.m@ 1432

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