SDNOS ;ALB/LDB - NO SHOW REPORT ; 18 May 99 8:43 AM
;;5.3;Scheduling;**22,28,32,79,194,410,1015**;Aug 13, 1993;Build 21
;IHS/ANMC/LJF 11/03/2000 put in standard clinic lookup
;
D END,LO^DGUTL
S (SDCL,X)="" S SDDIV=$$PRIM^VASITE() S SDIO=IO(0),(SDA,SDB1,SDC,SDV1,SDEND,SDSL,SDT,SDTIM)=0
DIV I $D(^DG(43,1,"GL")),$P(^("GL"),"^",2) S DIC("A")="NO SHOW REPORT FOR WHICH DIVISION: " D ASK^SDDIV S SDV1=1,SDDIV=$S($D(DIV):DIV,1:SDDIV) D MDIV Q:'$D(Y)
SEL K BSDQ D CLINIC^BSDU(2) I $D(BSDQ) D END Q ;IHS/ANMC/LJF 11/03/2000
I VAUTD=1 S SDDIV="A"
;IHS/ITSC/WAR 7/25/03 Allow for a Div which is not the users primary Dv
; Does not handle more than 1 selected Div currently
I VAUTD'=1&($O(VAUTD(""))) S SDDIV=$O(VAUTD(""))
I VAUTC=1 S SDCL="A",SDCL(1)="ALL" ;IHS/ANMC/LJF 11/03/2000
E S (X,C)=0 F S X=$O(VAUTC(X)) Q:'X I '$D(^SC("AIHSPC",X)) S C=C+1,SDCL(C)=X ;IHS/ANMC/LJF 11/03/2000
K X,C,VAUTC G DATE ;IHS/ANMC/LJF 11/03/2000
;
F SDSL=1:1 D READ D:(X="^")!SDTIM END Q:'$D(X) Q:((X="")&(SDSL>1)) Q:SDA D Q:X=""&(SDSL=1)
.W:(Y'>0&'SDB1&'SDT&'SDC) !,"No such clinic"
.W:SDV1&'SDB1&SDDIV&(Y'>0)&'SDT&'SDC " associated with this division."
.S:Y'>0 SDSL=SDSL-1 S (SDB1,SDC,SDT)=0
.Q
Q:'$D(X) S:X=""&(SDSL=1) SDCL="A"
I SDTIM=1 D END Q
I 'SDA,(X="^")!(SDCL(1)']"")&(Y=-1) D END Q
FMT ;Select Format
S DIR(0)="S^1:No Shows ONLY;2:Both No Shows & No Action Taken"
S DIR("?")="Select format for printed report"
S DIR("B")="No Shows ONLY"
D ^DIR K DIR S SDFMT=Y
DATE W !!,"You may enter only a beginning date if you would like",!,"to see a report of No-Shows for only one date."
S SDT00="AEP",%DT(0)="-NOW" D DATE^SDUTL I ('$D(SDBD))&((X="^")!(X="")) D END Q
I '$D(SDED)&(X="^") D END Q
N DIR,SDABB S DIR(0)="Y",DIR("A")="Print report totals only",DIR("B")="YES"
S DIR("?")="Answer 'no' to obtain a detailed report, 'yes' to print just clinic totals"
W ! D ^DIR G:$D(DTOUT)!$D(DUOUT) END S SDABB=Y
ZIS W !! S DGPGM="^SDNOS0",DGVAR="SDCL#^SDDIV"_$S($D(SDBD):"^SDBD",1:"")_$S($D(SDED):"^SDED",1:"")_"^SDIO^SDABB^SDFMT"
D ZIS^DGUTQ G:POP END U IO D ^SDNOS0
D END,CLOSE^DGUTQ Q
;
READ ;Select clinics
W !,"Select Clinic(s):"_$S(SDSL<2:" ALL// ",1:" ") R X:DTIME S:'$T SDTIM=1 Q:'$T!(X="^")!('$D(SDCL(2))&(SDSL>1)&(X="")) I X["?" D HELP
VALID S X=$$UP^XLFSTR(X) I ((X="")&(SDSL<2))!(X="ALL")&(SDSL<2) S SDCL(1)="ALL",SDA=1 Q
I X=""&(SDSL>1) Q
S SDM="$S(SDDIV'=""A""&$P(^(0),""^"",15):$P(^(0),""^"",15)=SDDIV,1:$P(^(0),""^"",15)="""")"
S DIC=44,DIC(0)="EQ",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
S DIC("S")=$S(SDDIV'="A"&SDV1:DIC("S")_","_SDM,1:DIC("S"))
I X?1"*".E S SDT=X,X=$E(X,2,$L(X)) D ^DIC Q:Y'>0 D INAC Q:Y'>0 S SDCL(SDSL)=+Y_$E(SDT,1)_$E(SDT,$F(SDT,"*"),$L(SDT)) Q
D ^DIC Q:Y'>0
S SDB1=0 I $D(SDCL)#10 F SDSB=0:0 S SDSB=$O(SDCL(SDSB)) Q:SDSB'>0 I SDCL(SDSB)=+Y W !,*7,"This clinic has all ready been selected",! S Y=-1,SDB1=1 Q
I 'SDB1 D INAC Q:Y'>0 S SDCL(SDSL)=+Y Q
Q
;
HELP W !!,"Enter the clinic name here. Press return when you are finished choosing clinics.",!,"You may ask for a range of clinics by preceding the clinic or"
W !,"letter(s) that begin the clinic name with an asterisk. For example,"
W !,"if you would like to see all clinics that begin with MED, you could enter ",!,"*MED or *CT for all clinics that begin with CT."
W !,"You will then be asked to choose which actual clinic will begin the range.",!,"When you have chosen one, all clinics that contain the initial response for "
W !,"range and follow your choice in alphabetic order will be included in the report.",!
Q
;
INAC ;Determine if clinic is inactive
S SDC=+Y,X="T" D ^%DT S DT=Y
I $D(^SC(SDC,"I")),$P(^("I"),U),$P(^("I"),U)'>DT W *7,!,"Clinic ",$S('$P(^("I"),U,2):"is",1:"was")," inactive ",$S('$P(^("I"),U,2):"as of ",1:"from ") S Y=$P(^("I"),U) D D^DIQ W Y
I I $P(^SC(SDC,"I"),U,2) S Y=$P(^("I"),U,2) D D^DIQ W " to ",Y,! D ASK Q
I $D(^SC(SDC,"I")),$P(^("I"),U),$P(^("I"),U)'>DT,'$P(^("I"),U,2) S Y=+SDC W ! D ASK Q
S Y=+SDC Q
ASK S %=2 S Y=+SDC W !,"Do you wish to include this clinic in the report" D YN^DICN I %=1 W ! S Y=+SDC Q
I %=-1!(%=2) S Y=-1 W ! Q
I '% W !,"Enter 'Yes' to include clinic in this report or 'No' to exclude from the report." G ASK
;
END K %DT,ALL,BEGDATE,C,C1,C2,C3,C4,C5,C6,DGPGM,DGTCH,DGVAR,DIC,DIV
K ENDDATE,P1,POP,Q,SD,SD1,SD10,SD12,SD14,SD2,SDA,SDAPP,SDB1,SDBD
K SDBEG,SDBEG1,SDBG,SDC,SDCHK,SDCL,SDCL1,SDCT,SDCXX,SDDIV,SDV1
K SDDIV2,SDDIVO,SDED,SDEF,SDEN,SDEND,SDHD,SDIN,SDI1,SDABB,SDT00
K %I,%Y,%T,SDIO,SDIX,SDLAB,SDM,SDNM,SDNM1,SDNMS,SDNO,SDOK,SDOW
K SDPAT,SDPR,SDPR1,SDPT,SDR,SDR1,SDRB,SDREST,SDSL,SDSUB,SDSB
K SDT1,SDT2,SDT3,SDT4,SDT5,SDT6,SDT,SDTIM,SDTOT,SDTOT1,SDX,SDXX
K SDY,SDZ,SDZ1,SDZZ3,X,X1,Y,Y1,Y2,Y3,%,^UTILITY($J,"DGTC"),SDFMT
END1 K DTOUT,DUOUT,^UTILITY($J,"SDNO") Q
;
MDIV I Y'>0 D END,CLOSE^DGUTQ Q
I $D(ALL),ALL S SDDIV="A" Q
Q
SDNOS ;ALB/LDB - NO SHOW REPORT ; 18 May 99 8:43 AM
+1 ;;5.3;Scheduling;**22,28,32,79,194,410,1015**;Aug 13, 1993;Build 21
+2 ;IHS/ANMC/LJF 11/03/2000 put in standard clinic lookup
+3 ;
+4 DO END
DO LO^DGUTL
+5 SET (SDCL,X)=""
SET SDDIV=$$PRIM^VASITE()
SET SDIO=IO(0)
SET (SDA,SDB1,SDC,SDV1,SDEND,SDSL,SDT,SDTIM)=0
DIV IF $DATA(^DG(43,1,"GL"))
IF $PIECE(^("GL"),"^",2)
SET DIC("A")="NO SHOW REPORT FOR WHICH DIVISION: "
DO ASK^SDDIV
SET SDV1=1
SET SDDIV=$SELECT($DATA(DIV):DIV,1:SDDIV)
DO MDIV
IF '$DATA(Y)
QUIT
SEL ;IHS/ANMC/LJF 11/03/2000
KILL BSDQ
DO CLINIC^BSDU(2)
IF $DATA(BSDQ)
DO END
QUIT
+1 IF VAUTD=1
SET SDDIV="A"
+2 ;IHS/ITSC/WAR 7/25/03 Allow for a Div which is not the users primary Dv
+3 ; Does not handle more than 1 selected Div currently
+4 IF VAUTD'=1&($ORDER(VAUTD("")))
SET SDDIV=$ORDER(VAUTD(""))
+5 ;IHS/ANMC/LJF 11/03/2000
IF VAUTC=1
SET SDCL="A"
SET SDCL(1)="ALL"
+6 ;IHS/ANMC/LJF 11/03/2000
IF '$TEST
SET (X,C)=0
FOR
SET X=$ORDER(VAUTC(X))
IF 'X
QUIT
IF '$DATA(^SC("AIHSPC",X))
SET C=C+1
SET SDCL(C)=X
+7 ;IHS/ANMC/LJF 11/03/2000
KILL X,C,VAUTC
GOTO DATE
+8 ;
+9 FOR SDSL=1:1
DO READ
IF (X="^")!SDTIM
DO END
IF '$DATA(X)
QUIT
IF ((X="")&(SDSL>1))
QUIT
IF SDA
QUIT
Begin DoDot:1
+10 IF (Y'>0&'SDB1&'SDT&'SDC)
WRITE !,"No such clinic"
+11 IF SDV1&'SDB1&SDDIV&(Y'>0)&'SDT&'SDC
WRITE " associated with this division."
+12 IF Y'>0
SET SDSL=SDSL-1
SET (SDB1,SDC,SDT)=0
+13 QUIT
End DoDot:1
IF X=""&(SDSL=1)
QUIT
+14 IF '$DATA(X)
QUIT
IF X=""&(SDSL=1)
SET SDCL="A"
+15 IF SDTIM=1
DO END
QUIT
+16 IF 'SDA
IF (X="^")!(SDCL(1)']"")&(Y=-1)
DO END
QUIT
FMT ;Select Format
+1 SET DIR(0)="S^1:No Shows ONLY;2:Both No Shows & No Action Taken"
+2 SET DIR("?")="Select format for printed report"
+3 SET DIR("B")="No Shows ONLY"
+4 DO ^DIR
KILL DIR
SET SDFMT=Y
DATE WRITE !!,"You may enter only a beginning date if you would like",!,"to see a report of No-Shows for only one date."
+1 SET SDT00="AEP"
SET %DT(0)="-NOW"
DO DATE^SDUTL
IF ('$DATA(SDBD))&((X="^")!(X=""))
DO END
QUIT
+2 IF '$DATA(SDED)&(X="^")
DO END
QUIT
+3 NEW DIR,SDABB
SET DIR(0)="Y"
SET DIR("A")="Print report totals only"
SET DIR("B")="YES"
+4 SET DIR("?")="Answer 'no' to obtain a detailed report, 'yes' to print just clinic totals"
+5 WRITE !
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO END
SET SDABB=Y
ZIS WRITE !!
SET DGPGM="^SDNOS0"
SET DGVAR="SDCL#^SDDIV"_$SELECT($DATA(SDBD):"^SDBD",1:"")_$SELECT($DATA(SDED):"^SDED",1:"")_"^SDIO^SDABB^SDFMT"
+1 DO ZIS^DGUTQ
IF POP
GOTO END
USE IO
DO ^SDNOS0
+2 DO END
DO CLOSE^DGUTQ
QUIT
+3 ;
READ ;Select clinics
+1 WRITE !,"Select Clinic(s):"_$SELECT(SDSL<2:" ALL// ",1:" ")
READ X:DTIME
IF '$TEST
SET SDTIM=1
IF '$TEST!(X="^")!('$DATA(SDCL(2))&(SDSL>1)&(X=""))
QUIT
IF X["?"
DO HELP
VALID SET X=$$UP^XLFSTR(X)
IF ((X="")&(SDSL<2))!(X="ALL")&(SDSL<2)
SET SDCL(1)="ALL"
SET SDA=1
QUIT
+1 IF X=""&(SDSL>1)
QUIT
+2 SET SDM="$S(SDDIV'=""A""&$P(^(0),""^"",15):$P(^(0),""^"",15)=SDDIV,1:$P(^(0),""^"",15)="""")"
+3 SET DIC=44
SET DIC(0)="EQ"
SET DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
+4 SET DIC("S")=$SELECT(SDDIV'="A"&SDV1:DIC("S")_","_SDM,1:DIC("S"))
+5 IF X?1"*".E
SET SDT=X
SET X=$EXTRACT(X,2,$LENGTH(X))
DO ^DIC
IF Y'>0
QUIT
DO INAC
IF Y'>0
QUIT
SET SDCL(SDSL)=+Y_$EXTRACT(SDT,1)_$EXTRACT(SDT,$FIND(SDT,"*"),$LENGTH(SDT))
QUIT
+6 DO ^DIC
IF Y'>0
QUIT
+7 SET SDB1=0
IF $DATA(SDCL)#10
FOR SDSB=0:0
SET SDSB=$ORDER(SDCL(SDSB))
IF SDSB'>0
QUIT
IF SDCL(SDSB)=+Y
WRITE !,*7,"This clinic has all ready been selected",!
SET Y=-1
SET SDB1=1
QUIT
+8 IF 'SDB1
DO INAC
IF Y'>0
QUIT
SET SDCL(SDSL)=+Y
QUIT
+9 QUIT
+10 ;
HELP WRITE !!,"Enter the clinic name here. Press return when you are finished choosing clinics.",!,"You may ask for a range of clinics by preceding the clinic or"
+1 WRITE !,"letter(s) that begin the clinic name with an asterisk. For example,"
+2 WRITE !,"if you would like to see all clinics that begin with MED, you could enter ",!,"*MED or *CT for all clinics that begin with CT."
+3 WRITE !,"You will then be asked to choose which actual clinic will begin the range.",!,"When you have chosen one, all clinics that contain the initial response for "
+4 WRITE !,"range and follow your choice in alphabetic order will be included in the report.",!
+5 QUIT
+6 ;
INAC ;Determine if clinic is inactive
+1 SET SDC=+Y
SET X="T"
DO ^%DT
SET DT=Y
+2 IF $DATA(^SC(SDC,"I"))
IF $PIECE(^("I"),U)
IF $PIECE(^("I"),U)'>DT
WRITE *7,!,"Clinic ",$SELECT('$PIECE(^("I"),U,2):"is",1:"was")," inactive ",$SELECT('$PIECE(^("I"),U,2):"as of ",1:"from ")
SET Y=$PIECE(^("I"),U)
DO D^DIQ
WRITE Y
+3 IF $TEST
IF $PIECE(^SC(SDC,"I"),U,2)
SET Y=$PIECE(^("I"),U,2)
DO D^DIQ
WRITE " to ",Y,!
DO ASK
QUIT
+4 IF $DATA(^SC(SDC,"I"))
IF $PIECE(^("I"),U)
IF $PIECE(^("I"),U)'>DT
IF '$PIECE(^("I"),U,2)
SET Y=+SDC
WRITE !
DO ASK
QUIT
+5 SET Y=+SDC
QUIT
ASK SET %=2
SET Y=+SDC
WRITE !,"Do you wish to include this clinic in the report"
DO YN^DICN
IF %=1
WRITE !
SET Y=+SDC
QUIT
+1 IF %=-1!(%=2)
SET Y=-1
WRITE !
QUIT
+2 IF '%
WRITE !,"Enter 'Yes' to include clinic in this report or 'No' to exclude from the report."
GOTO ASK
+3 ;
END KILL %DT,ALL,BEGDATE,C,C1,C2,C3,C4,C5,C6,DGPGM,DGTCH,DGVAR,DIC,DIV
+1 KILL ENDDATE,P1,POP,Q,SD,SD1,SD10,SD12,SD14,SD2,SDA,SDAPP,SDB1,SDBD
+2 KILL SDBEG,SDBEG1,SDBG,SDC,SDCHK,SDCL,SDCL1,SDCT,SDCXX,SDDIV,SDV1
+3 KILL SDDIV2,SDDIVO,SDED,SDEF,SDEN,SDEND,SDHD,SDIN,SDI1,SDABB,SDT00
+4 KILL %I,%Y,%T,SDIO,SDIX,SDLAB,SDM,SDNM,SDNM1,SDNMS,SDNO,SDOK,SDOW
+5 KILL SDPAT,SDPR,SDPR1,SDPT,SDR,SDR1,SDRB,SDREST,SDSL,SDSUB,SDSB
+6 KILL SDT1,SDT2,SDT3,SDT4,SDT5,SDT6,SDT,SDTIM,SDTOT,SDTOT1,SDX,SDXX
+7 KILL SDY,SDZ,SDZ1,SDZZ3,X,X1,Y,Y1,Y2,Y3,%,^UTILITY($JOB,"DGTC"),SDFMT
END1 KILL DTOUT,DUOUT,^UTILITY($JOB,"SDNO")
QUIT
+1 ;
MDIV IF Y'>0
DO END
DO CLOSE^DGUTQ
QUIT
+1 IF $DATA(ALL)
IF ALL
SET SDDIV="A"
QUIT
+2 QUIT
