- 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 Feb 19, 2025@00:15:33 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
