SDAUT1.m

SDAUT1 ;MAN/GRR - AUTO REBOOK SET REQUIRED AVAILABILITY NODES ; 28 MAR 84  1:46 pm

 ;;5.3;Scheduling;**140,1015**;Aug 13, 1993;Build 21

 ;IHS/ANMC/LJF  8/18/2000 changed $N to $O

 K SDXXX S MAX=$S($D(^SC(SC,"SDP")):$P(^("SDP"),"^",4),1:0)

 Q:MAX=0  S STIME=$S($D(^SC(SC,"SDP")):$P(^("SDP"),"^",3),1:"0800"),X1=CDATE,X2=DT D ^%DTC

 I X<10 S X1=$S(CDATE<DT:DT,1:CDATE),X2=10 D C^%DTC S SDSTRTDT=X G OVR

 S SDSTRTDT=CDATE

OVR S SDSOH=$S('$D(^SC(SC,"SL")):0,$P(^("SL"),"^",8)']"":0,1:1)

 S X1=SDSTRTDT,X2=MAX D C^%DTC S ENDATE=$S('$D(SDIN):X,SDIN>SDSTRTDT&(SDIN<X):SDIN,1:X),X=SDSTRTDT

EN1 ;S:$N(^SC(+SC,"T",0))>X X=$N(^(0)) D DOW S I=Y+32,SM=X,D=Y D WM  ;IHS/ANMC/LJF 8/18/2000

 S:$O(^SC(+SC,"T",0))>X X=$O(^(0)) D DOW S I=Y+32,SM=X,D=Y D WM  ;IHS/ANMC/LJF 8/18/2000

 K J F Y=0:1:6 I $D(^SC(+SC,"T"_Y)) S J(Y)="",DA=+SC,DOW=Y D:'$D(^SC(+SC,"T"_Y,0)) TX^SDB1

 Q:'$D(J)

X1 Q:X>ENDATE  S X1=X\100_28

 ;IHS/ANMC/LJF 8/18/2000

W ;S X=X\1 I '$D(^SC(+SC,"ST",X,1)) S Y=D#7 G L:'$D(J(Y)),H:$D(^HOLIDAY(X))&('SDSOH) S SS=$N(^SC(+SC,"T"_Y,X)) G L:SS<0,L:^(SS,1)="" S ^SC(+SC,"ST",X\1,1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(X,6,7)_$J("",SI+SI-6)_^(1),^(0)=X\1

 S X=X\1 I '$D(^SC(+SC,"ST",X,1)) S Y=D#7 G L:'$D(J(Y)),H:$D(^HOLIDAY(X))&('SDSOH) S SS=$O(^SC(+SC,"T"_Y,X)) G L:SS'>0,L:^(SS,1)="" S ^SC(+SC,"ST",X\1,1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(X,6,7)_$J("",SI+SI-6)_^(1),^(0)=X\1

 ;

 I $D(SDXXX) S SDXXX=SDXXX+1 W:'(SDXXX#100) "."

 D WM:X>SM

L I X>ENDATE Q

 S X=X+1,D=D+1 G W:X'>X1 S X2=X-X1 D C^%DTC G X1

 ;

H S ^SC(+SC,"ST",X,1)="   "_$E(X,6,7)_"    "_$P(^(X,0),U,2),^(0)=X S:'$D(^SC(+SC,"ST",0)) ^(0)="^44.005DA^^" G W

 ;

WM S SM=$S($E(X,4,5)[12:$E(X,1,3)+1_"01",1:$E(X,1,3)_$E(X,4,5)+1)_"00" Q

 ;

DOW ;

 S Y=$$DOW^XLFDT(X,1)

 Q

 ;

DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR

SDAUT1    ;MAN/GRR - AUTO REBOOK SET REQUIRED AVAILABILITY NODES ; 28 MAR 84  1:46 pm

 +1       ;;5.3;Scheduling;**140,1015**;Aug 13, 1993;Build 21

 +2       ;IHS/ANMC/LJF  8/18/2000 changed $N to $O

 +3        KILL SDXXX

           SET MAX=$SELECT($DATA(^SC(SC,"SDP")):$PIECE(^("SDP"),"^",4),1:0)

 +4        IF MAX=0

               QUIT 

           SET STIME=$SELECT($DATA(^SC(SC,"SDP")):$PIECE(^("SDP"),"^",3),1:"0800")

           SET X1=CDATE

           SET X2=DT

           DO ^%DTC

 +5        IF X<10

               SET X1=$SELECT(CDATE<DT:DT,1:CDATE)

               SET X2=10

               DO C^%DTC

               SET SDSTRTDT=X

               GOTO OVR

 +6        SET SDSTRTDT=CDATE

OVR        SET SDSOH=$SELECT('$DATA(^SC(SC,"SL")):0,$PIECE(^("SL"),"^",8)']"":0,1:1)

 +1        SET X1=SDSTRTDT

           SET X2=MAX

           DO C^%DTC

           SET ENDATE=$SELECT('$DATA(SDIN):X,SDIN>SDSTRTDT&(SDIN<X):SDIN,1:X)

           SET X=SDSTRTDT

EN1       ;S:$N(^SC(+SC,"T",0))>X X=$N(^(0)) D DOW S I=Y+32,SM=X,D=Y D WM  ;IHS/ANMC/LJF 8/18/2000

 +1       ;IHS/ANMC/LJF 8/18/2000

           IF $ORDER(^SC(+SC,"T",0))>X

               SET X=$ORDER(^(0))

           DO DOW

           SET I=Y+32

           SET SM=X

           SET D=Y

           DO WM

 +2        KILL J

           FOR Y=0:1:6

               IF $DATA(^SC(+SC,"T"_Y))

                   SET J(Y)=""

                   SET DA=+SC

                   SET DOW=Y

                   IF '$DATA(^SC(+SC,"T"_Y,0))

                       DO TX^SDB1

 +3        IF '$DATA(J)

               QUIT 

X1         IF X>ENDATE

               QUIT 

           SET X1=X\100_28

 +1       ;IHS/ANMC/LJF 8/18/2000

W         ;S X=X\1 I '$D(^SC(+SC,"ST",X,1)) S Y=D#7 G L:'$D(J(Y)),H:$D(^HOLIDAY(X))&('SDSOH) S SS=$N(^SC(+SC,"T"_Y,X)) G L:SS<0,L:^(SS,1)="" S ^SC(+SC,"ST",X\1,1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(X,6,7)_$J("",SI+SI-6)_^(1),^(0)=X\1

 +1        SET X=X\1

           IF '$DATA(^SC(+SC,"ST",X,1))

               SET Y=D#7

               IF '$DATA(J(Y))

                   GOTO L

               IF $DATA(^HOLIDAY(X))&('SDSOH)

                   GOTO H

               SET SS=$ORDER(^SC(+SC,"T"_Y,X))

               IF SS'>0

                   GOTO L

               IF ^(SS,1)=""

                   GOTO L

               SET ^SC(+SC,"ST",X\1,1)=$EXTRACT($PIECE($TEXT(DAY),U,Y+2),1,2)_" "_$EXTRACT(X,6,7)_$JUSTIFY("",SI+SI-6)_^(1)

               SET ^(0)=X\1

 +2       ;

 +3        IF $DATA(SDXXX)

               SET SDXXX=SDXXX+1

               IF '(SDXXX#100)

                   WRITE "."

 +4        IF X>SM

               DO WM

L          IF X>ENDATE

               QUIT 

 +1        SET X=X+1

           SET D=D+1

           IF X'>X1

               GOTO W

           SET X2=X-X1

           DO C^%DTC

           GOTO X1

 +2       ;

H          SET ^SC(+SC,"ST",X,1)="   "_$EXTRACT(X,6,7)_"    "_$PIECE(^(X,0),U,2)

           SET ^(0)=X

           IF '$DATA(^SC(+SC,"ST",0))

               SET ^(0)="^44.005DA^^"

           GOTO W

 +1       ;

WM         SET SM=$SELECT($EXTRACT(X,4,5)[12:$EXTRACT(X,1,3)+1_"01",1:$EXTRACT(X,1,3)_$EXTRACT(X,4,5)+1)_"00"

           QUIT 

 +1       ;

DOW       ;

 +1        SET Y=$$DOW^XLFDT(X,1)

 +2        QUIT 

 +3       ;

DAY       ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR