SDCLDOW ;ALB/TMP - PRINT LIST OF CLINICS BY DAY OF WEEK ; 22 MAR 1999 2:22 pm
;;5.3;Scheduling;**188**;Aug 13, 1993
S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL
S DIV="" I $D(^DIC(4,+$$SITE^VASITE,"DIV")),^("DIV")="Y" S DIC("A")="CLINIC LIST BY DOW FOR WHICH DIVISION: " D ASK^SDDIV Q:Y<0
S VAR="DIV",VAL=DIV,PGM="START^SDCLDOW" D ZIS^DGUTQ Q:POP
START U IO S (END,SDPG)=0
S LINE1="|------------------------------------|-----|-----|-----|-----|-----|-----|-----|",SDIV=$S(DIV:DIV,1:1)
D TOF
S SCN=0
F S SCN=$O(^SC("B",SCN)) G:SCN=""!(END) END D
. S SC=""
. F S SC=$O(^SC("B",SCN,SC)) Q:SC="" D CHECK I $T D SET,PRT
G END
END K I,SDCL,LINE1,PGM,NAME,POP,SDALL,SCN,END,M,L,DOW,SDOS,SC,SDPG,X,Y D CLOSE^DGUTQ Q
SET S NAME=$P(^SC(SC,0),"^",1)
K DOW F L=DT-.1:0 S L=$O(^SC(SC,"T",L)) Q:L="" S X=L D DW^%DTC S:'$D(^SC(SC,"T"_Y,L,1)) DOW(Y+1)="F"
F L=0:1:6 I '$D(DOW(L+1)) F M=DT-.1:0 S M=$O(^SC(SC,"T"_L,M)) Q:M="" I $D(^(M,1)),^(1)]"" S DOW(L+1)=$S($O(^SC(SC,"T"_L,DT))=M:"C",1:"F") Q
F M=DT-.1:0 S M=$O(^SC(SC,"OST",M)) Q:M="" S X=M D DW^%DTC I '$D(DOW(Y+1)),$D(^SC(SC,"OST",M,1)),^(1)["[" S DOW(Y+1)="C"
Q
PRT I $Y+7>IOSL D:IOSL<25 SEEND:IOST?1"C-".E Q:END D TOF
I $D(DOW) W !,"|",NAME W ?37,"|" F M=1:1:7 S SDOS=(M+6)*6-3 W:$D(DOW(M)) ?SDOS,"*",DOW(M),"*" S SDOS=SDOS+4 W ?SDOS,"|" K SDOS
I $D(DOW) W ! W LINE1
Q
SEEND R !,"Press return to continue or ""^"" to escape ",CXEND:DTIME I '$T!(CXEND="^") S END=1 Q
Q
TOF W @IOF,!!,?2,"FACILITY: ",$P(^DG(40.8,+SDIV,0),"^",1),!,?2,"CLINIC LIST BY DAY OF WEEK AS OF " S Y=DT D DT^DIQ S SDPG=SDPG+1 W ?(IOM-10),"PAGE: ",SDPG
W !!,?3,"*C* = CLINIC CURRENTLY MEETS ON THIS DAY",!,?3,"*F* = CLINIC WILL MEET IN THE FUTURE ON THIS DAY",!!
W !,"CLINIC:",?37,"| SUN | MON | TUE | WED | THU | FRI | SAT |"
S I="",$P(I,"=",81)="" W !,I Q
CHECK I $P(^SC(SC,0),"^",3)="C",$S(DIV="":1,$P(^SC(SC,0),"^",15)=DIV:1,1:0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCLDOW 1909 printed Oct 16, 2024@18:49:42 Page 2
SDCLDOW ;ALB/TMP - PRINT LIST OF CLINICS BY DAY OF WEEK ; 22 MAR 1999 2:22 pm
+1 ;;5.3;Scheduling;**188**;Aug 13, 1993
+2 if '$DATA(DTIME)
SET DTIME=300
IF '$DATA(DT)
DO DT^SDUTL
+3 SET DIV=""
IF $DATA(^DIC(4,+$$SITE^VASITE,"DIV"))
IF ^("DIV")="Y"
SET DIC("A")="CLINIC LIST BY DOW FOR WHICH DIVISION: "
DO ASK^SDDIV
if Y<0
QUIT
+4 SET VAR="DIV"
SET VAL=DIV
SET PGM="START^SDCLDOW"
DO ZIS^DGUTQ
if POP
QUIT
START USE IO
SET (END,SDPG)=0
+1 SET LINE1="|------------------------------------|-----|-----|-----|-----|-----|-----|-----|"
SET SDIV=$SELECT(DIV:DIV,1:1)
+2 DO TOF
+3 SET SCN=0
+4 FOR
SET SCN=$ORDER(^SC("B",SCN))
if SCN=""!(END)
GOTO END
Begin DoDot:1
+5 SET SC=""
+6 FOR
SET SC=$ORDER(^SC("B",SCN,SC))
if SC=""
QUIT
DO CHECK
IF $TEST
DO SET
DO PRT
End DoDot:1
+7 GOTO END
END KILL I,SDCL,LINE1,PGM,NAME,POP,SDALL,SCN,END,M,L,DOW,SDOS,SC,SDPG,X,Y
DO CLOSE^DGUTQ
QUIT
SET SET NAME=$PIECE(^SC(SC,0),"^",1)
+1 KILL DOW
FOR L=DT-.1:0
SET L=$ORDER(^SC(SC,"T",L))
if L=""
QUIT
SET X=L
DO DW^%DTC
if '$DATA(^SC(SC,"T"_Y,L,1))
SET DOW(Y+1)="F"
+2 FOR L=0:1:6
IF '$DATA(DOW(L+1))
FOR M=DT-.1:0
SET M=$ORDER(^SC(SC,"T"_L,M))
if M=""
QUIT
IF $DATA(^(M,1))
IF ^(1)]""
SET DOW(L+1)=$SELECT($ORDER(^SC(SC,"T"_L,DT))=M:"C",1:"F")
QUIT
+3 FOR M=DT-.1:0
SET M=$ORDER(^SC(SC,"OST",M))
if M=""
QUIT
SET X=M
DO DW^%DTC
IF '$DATA(DOW(Y+1))
IF $DATA(^SC(SC,"OST",M,1))
IF ^(1)["["
SET DOW(Y+1)="C"
+4 QUIT
PRT IF $Y+7>IOSL
if IOSL<25
if IOST?1"C-".E
DO SEEND
if END
QUIT
DO TOF
+1 IF $DATA(DOW)
WRITE !,"|",NAME
WRITE ?37,"|"
FOR M=1:1:7
SET SDOS=(M+6)*6-3
if $DATA(DOW(M))
WRITE ?SDOS,"*",DOW(M),"*"
SET SDOS=SDOS+4
WRITE ?SDOS,"|"
KILL SDOS
+2 IF $DATA(DOW)
WRITE !
WRITE LINE1
+3 QUIT
SEEND READ !,"Press return to continue or ""^"" to escape ",CXEND:DTIME
IF '$TEST!(CXEND="^")
SET END=1
QUIT
+1 QUIT
TOF WRITE @IOF,!!,?2,"FACILITY: ",$PIECE(^DG(40.8,+SDIV,0),"^",1),!,?2,"CLINIC LIST BY DAY OF WEEK AS OF "
SET Y=DT
DO DT^DIQ
SET SDPG=SDPG+1
WRITE ?(IOM-10),"PAGE: ",SDPG
+1 WRITE !!,?3,"*C* = CLINIC CURRENTLY MEETS ON THIS DAY",!,?3,"*F* = CLINIC WILL MEET IN THE FUTURE ON THIS DAY",!!
+2 WRITE !,"CLINIC:",?37,"| SUN | MON | TUE | WED | THU | FRI | SAT |"
+3 SET I=""
SET $PIECE(I,"=",81)=""
WRITE !,I
QUIT
CHECK IF $PIECE(^SC(SC,0),"^",3)="C"
IF $SELECT(DIV="":1,$PIECE(^SC(SC,0),"^",15)=DIV:1,1:0)
+1 QUIT
