SDCLAV.m

SDCLAV ;ALB/LDB - ROUTINE TO OUTPUT PATTERNS ;5/8/91  16:39

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

 ;IHS/ANMC/LJF 10/05/2000 changed legend to reflect change in SDCLAV1

 ;                         that now displays all cancelled appts.

 ;             01/09/2004 expanded clinic selection if principle clinic

 ;

 K ^UTILITY($J,"SDNMS"),X,Y S SDUP=0

DIV ;D ASK2^SDDIV G:Y<0 END S VAUTNI=2 D CLINIC^VAUTOMA  ;cmi/maw 11/9/2009 orig line

 ;I VAUTC=0 D EXPNDPC^BSDU(2,.VAUTC)    ;expand principle clinics;IHS/ITSC/LJF 1/9/2004  cmi/maw 11/9/2009 orig line

 S DIV="" D CLINIC^BSDU(2) I $D(BSDQ) K BSDQ G END  ;cmi/maw 11/9/2009 PATCH 1011 changed to standard call

 ;G:Y<0 END  ;cmi/maw 11/9/2009 orig line

 S (SDZ1,SDZ2)=0,SDT00="AEX" D DATE^SDUTL G:POP END S SDZ=SDBD

 ;cmi/maw 11/9/2009 orig line

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

SDCLAV    ;ALB/LDB - ROUTINE TO OUTPUT PATTERNS ;5/8/91  16:39

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

 +2       ;IHS/ANMC/LJF 10/05/2000 changed legend to reflect change in SDCLAV1

 +3       ;                         that now displays all cancelled appts.

 +4       ;             01/09/2004 expanded clinic selection if principle clinic

 +5       ;

 +6        KILL ^UTILITY($JOB,"SDNMS"),X,Y

           SET SDUP=0

DIV       ;D ASK2^SDDIV G:Y<0 END S VAUTNI=2 D CLINIC^VAUTOMA  ;cmi/maw 11/9/2009 orig line

 +1       ;I VAUTC=0 D EXPNDPC^BSDU(2,.VAUTC)    ;expand principle clinics;IHS/ITSC/LJF 1/9/2004  cmi/maw 11/9/2009 orig line

 +2       ;cmi/maw 11/9/2009 PATCH 1011 changed to standard call

           SET DIV=""

           DO CLINIC^BSDU(2)

           IF $DATA(BSDQ)

               KILL BSDQ

               GOTO END

 +3       ;G:Y<0 END  ;cmi/maw 11/9/2009 orig line

 +4        SET (SDZ1,SDZ2)=0

           SET SDT00="AEX"

           DO DATE^SDUTL

           IF POP

               GOTO END

           SET SDZ=SDBD

 +5       ;cmi/maw 11/9/2009 orig line

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