SDCLAV ;ALB/LDB - ROUTINE TO OUTPUT PATTERNS ;5/8/91 16:39
;;5.3;Scheduling;;Aug 13, 1993
K ^UTILITY($J,"SDNMS"),X,Y S SDUP=0
DIV D ASK2^SDDIV G:Y<0 END S VAUTNI=2 D CLINIC^VAUTOMA
G:Y<0 END S (SDZ1,SDZ2)=0,SDT00="AEX" D DATE^SDUTL G:POP END S SDZ=SDBD
INC S DTOUT=0 W !,"INCLUDE CANCELLATIONS AND/OR NO-SHOWS" S %=2 D YN^DICN S:%=1 SDCI=1 G:DTOUT!(%=-1) END I '$D(SDCI)&'% D HELP G INC
Q S SDIO=IO(0) S DGVAR="VAUTC^VAUTC#^VAUTD^VAUTD#^SDZ^SDZ1^SDZ2^SDNM^SDBD^SDED^SDUP^SDIO"_$S($D(SDCI):"^SDCI",1:""),DGPGM="^SDCLAV0" D ZIS^DGUTQ G:POP END U IO S SDIO=IO D ^SDCLAV0 Q
HELP W !,"Responding 'N' will exclude appts cancelled by cancelling availability and all no-showed appts." Q
END K %,%H,%I,%Y,BEGDATE,C,D,D1,D8,DIC,DGVAR,DGPGM,DGTCH,DTOUT,DUOUT,ENDDATE,J,M1,P,POP,S7,S8,S9,SD,SD0,SD5,SDAP,SDAP1,SDBD,SDC,SDCI,SDC1,SDC3,SDHY,SDI,SDIO,SDIN,SDED,SDNM,SDPT,SDT,SDU,SDUP,SDUT,SDM,SDM1,SDN1,SDN2,SDN3,SDRE,SDV,SDZ
K SDZ1,SDZ2,T,VAUTC,VAUTD,X,X1,X2,X4,X5,X6,X9,Y,Y1,Y2,Y3,Y4,Z,Z1,Z5,Z6,Z7,Z8,^UTILITY($J) D CLOSE^DGUTQ Q
A1 W !!,"FOR INDIVIDUAL APPOINTMENT LISTINGS:"
W:$D(SDCI) !?39,"* --APPTS CANCELLED WHEN CLINIC WAS",!?43,"CANCELLED",!?38,"**",?40," --NO-SHOW"
W !?37,"*** --UNSCHEDULED VISIT" Q
PG S P=P+1 W:$E(IOST,1,2)="P-" ?72,"PAGE ",P
I '$D(^UTILITY($J,"DGTC",SDV)) S ^UTILITY($J,"DGTC",SDV,P)=""
S S9=$E(SDZ,4,5),S7=$E(SDZ,2,3) I '$D(^UTILITY($J,"DGTC",SDV_" "_S7_"-"_$S($L(S9)<2:0_S9,1:S9)_" "_SDM)) S ^UTILITY($J,"DGTC",SDV_" "_S7_"-"_$S($L(S9)<2:0_S9,1:S9)_" "_SDM,P)=""
Q
INAC K SDIN,SDRE I $D(^SC(+SDC,"I")) S SDIN=+^("I"),SDRE=+$P(^("I"),U,2)
I $S('$D(SDIN):0,'SDIN:0,1:1) W !!,"Clinic --inactive ",$S(SDRE:"from ",1:"as of ") S SDHY=+SDC,Y=SDIN D DTS^SDUTL W Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCLAV 1758 printed Oct 16, 2024@18:49:39 Page 2
SDCLAV ;ALB/LDB - ROUTINE TO OUTPUT PATTERNS ;5/8/91 16:39
+1 ;;5.3;Scheduling;;Aug 13, 1993
+2 KILL ^UTILITY($JOB,"SDNMS"),X,Y
SET SDUP=0
DIV DO ASK2^SDDIV
if Y<0
GOTO END
SET VAUTNI=2
DO CLINIC^VAUTOMA
+1 if Y<0
GOTO END
SET (SDZ1,SDZ2)=0
SET SDT00="AEX"
DO DATE^SDUTL
if POP
GOTO END
SET SDZ=SDBD
INC SET DTOUT=0
WRITE !,"INCLUDE CANCELLATIONS AND/OR NO-SHOWS"
SET %=2
DO YN^DICN
if %=1
SET SDCI=1
if DTOUT!(%=-1)
GOTO END
IF '$DATA(SDCI)&'%
DO HELP
GOTO INC
Q SET SDIO=IO(0)
SET DGVAR="VAUTC^VAUTC#^VAUTD^VAUTD#^SDZ^SDZ1^SDZ2^SDNM^SDBD^SDED^SDUP^SDIO"_$SELECT($DATA(SDCI):"^SDCI",1:"")
SET DGPGM="^SDCLAV0"
DO ZIS^DGUTQ
if POP
GOTO END
USE IO
SET SDIO=IO
DO ^SDCLAV0
QUIT
HELP WRITE !,"Responding 'N' will exclude appts cancelled by cancelling availability and all no-showed appts."
QUIT
END KILL %,%H,%I,%Y,BEGDATE,C,D,D1,D8,DIC,DGVAR,DGPGM,DGTCH,DTOUT,DUOUT,ENDDATE,J,M1,P,POP,S7,S8,S9,SD,SD0,SD5,SDAP,SDAP1,SDBD,SDC,SDCI,SDC1,SDC3,SDHY,SDI,SDIO,SDIN,SDED,SDNM,SDPT,SDT,SDU,SDUP,SDUT,SDM,SDM1,SDN1,SDN2,SDN3,SDRE,SDV,SDZ
+1 KILL SDZ1,SDZ2,T,VAUTC,VAUTD,X,X1,X2,X4,X5,X6,X9,Y,Y1,Y2,Y3,Y4,Z,Z1,Z5,Z6,Z7,Z8,^UTILITY($JOB)
DO CLOSE^DGUTQ
QUIT
A1 WRITE !!,"FOR INDIVIDUAL APPOINTMENT LISTINGS:"
+1 if $DATA(SDCI)
WRITE !?39,"* --APPTS CANCELLED WHEN CLINIC WAS",!?43,"CANCELLED",!?38,"**",?40," --NO-SHOW"
+2 WRITE !?37,"*** --UNSCHEDULED VISIT"
QUIT
PG SET P=P+1
if $EXTRACT(IOST,1,2)="P-"
WRITE ?72,"PAGE ",P
+1 IF '$DATA(^UTILITY($JOB,"DGTC",SDV))
SET ^UTILITY($JOB,"DGTC",SDV,P)=""
+2 SET S9=$EXTRACT(SDZ,4,5)
SET S7=$EXTRACT(SDZ,2,3)
IF '$DATA(^UTILITY($JOB,"DGTC",SDV_" "_S7_"-"_$SELECT($LENGTH(S9)<2:0_S9,1:S9)_" "_SDM))
SET ^UTILITY($JOB,"DGTC",SDV_" "_S7_"-"_$SELECT($LENGTH(S9)<2:0_S9,1:S9)_" "_SDM,P)=""
+3 QUIT
INAC KILL SDIN,SDRE
IF $DATA(^SC(+SDC,"I"))
SET SDIN=+^("I")
SET SDRE=+$PIECE(^("I"),U,2)
+1 IF $SELECT('$DATA(SDIN):0,'SDIN:0,1:1)
WRITE !!,"Clinic --inactive ",$SELECT(SDRE:"from ",1:"as of ")
SET SDHY=+SDC
SET Y=SDIN
DO DTS^SDUTL
WRITE Y
SET Y=SDRE
if Y
DO DTS^SDUTL
WRITE $SELECT(SDRE:" to "_Y,1:"")
+2 QUIT