SDCLDOW ;ALB/TMP - PRINT LIST OF CLINICS BY DAY OF WEEK ; 22 MAR 1999 2:22 pm
;;5.3;Scheduling;**188,1011,1012,1015**;Aug 13, 1993;Build 21
;IHS/ANMC/LJF 10/04/2000 added choice of clinics; removed page #
; and call to list manager code
;
S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL
;IHS/ANMC/LJF 10/04/2000
;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 DIV="" D CLINIC^BSDU(1) I $D(BSDQ) K BSDQ G END
;I DIV="" S DIV=$O(^DG(40.8,"C",DUZ(2),0)) ;cmi/maw 9/1/09 orig PATCH 1011
I DIV="" S DIV=$O(^DG(40.8,"AD",DUZ(2),0)) ;cmi/maw 9/1/09 modified PATCH 1011
;S VAR="DIV",VAL=DIV,PGM="START^SDCLDOW" D ZIS^DGUTQ Q:POP
S VAR="VAUTC#^VAUTD#^DIV",PGM="START^BSDCLDOW" ;IHS/ANMC/LJF 10/4/2000
I $$BROWSE^BDGF="B" D START^BSDCLDOW Q
D ZIS^DGUTQ Q:POP D START^BSDCLDOW Q
;IHS/ANMC/LJF 10/04/2000 end of mods
;
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=""
. I VAUTC=0 Q:'$D(VAUTC(SCN)) ;ihs/cmi/maw 04/07/2012 PIMS Patch 1015
. 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 ;IHS/ANMC/LJF 10/4/2000
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 ;IHS/ANMC/LJF 10/4/2000
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
SDCLDOW ;ALB/TMP - PRINT LIST OF CLINICS BY DAY OF WEEK ; 22 MAR 1999 2:22 pm
+1 ;;5.3;Scheduling;**188,1011,1012,1015**;Aug 13, 1993;Build 21
+2 ;IHS/ANMC/LJF 10/04/2000 added choice of clinics; removed page #
+3 ; and call to list manager code
+4 ;
+5 IF '$DATA(DTIME)
SET DTIME=300
IF '$DATA(DT)
DO DT^SDUTL
+6 ;IHS/ANMC/LJF 10/04/2000
+7 ;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
+8 SET DIV=""
DO CLINIC^BSDU(1)
IF $DATA(BSDQ)
KILL BSDQ
GOTO END
+9 ;I DIV="" S DIV=$O(^DG(40.8,"C",DUZ(2),0)) ;cmi/maw 9/1/09 orig PATCH 1011
+10 ;cmi/maw 9/1/09 modified PATCH 1011
IF DIV=""
SET DIV=$ORDER(^DG(40.8,"AD",DUZ(2),0))
+11 ;S VAR="DIV",VAL=DIV,PGM="START^SDCLDOW" D ZIS^DGUTQ Q:POP
+12 ;IHS/ANMC/LJF 10/4/2000
SET VAR="VAUTC#^VAUTD#^DIV"
SET PGM="START^BSDCLDOW"
+13 IF $$BROWSE^BDGF="B"
DO START^BSDCLDOW
QUIT
+14 DO ZIS^DGUTQ
IF POP
QUIT
DO START^BSDCLDOW
QUIT
+15 ;IHS/ANMC/LJF 10/04/2000 end of mods
+16 ;
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 ;ihs/cmi/maw 04/07/2012 PIMS Patch 1015
IF VAUTC=0
IF '$DATA(VAUTC(SCN))
QUIT
+7 FOR
SET SC=$ORDER(^SC("B",SCN,SC))
IF SC=""
QUIT
DO CHECK
IF $TEST
DO SET
DO PRT
End DoDot:1
+8 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 ;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 ;IHS/ANMC/LJF 10/4/2000
+1 ;S SDPG=SDPG+1 W ?(IOM-10),"PAGE: ",SDPG ;IHS/ANMC/LJF 10/4/2000
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
+2 WRITE !!,?3,"*C* = CLINIC CURRENTLY MEETS ON THIS DAY",!,?3,"*F* = CLINIC WILL MEET IN THE FUTURE ON THIS DAY",!!
+3 WRITE !,"CLINIC:",?37,"| SUN | MON | TUE | WED | THU | FRI | SAT |"
+4 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
