SDNOS1 ;ALB/LDB - NO-SHOW REPORT ;07 May 99 11:13 AM
;;5.3;Scheduling;**194,410,689**;Aug 13, 1993;Build 2
D:'SDV1 CL I SDV1 F SDDIV=0:0 S SDDIV=$O(^UTILITY($J,"SDNO",SDDIV)) Q:'SDDIV!(SDDIV="") Q:SDIO=IO(0)&(SDEND) D CL Q:SDEND D:SDIO=IO(0) SCR Q:SDEND
I 'SDABB D:SDIO'=IO TP^DGUTL
D END^SDNOS Q
;
CL S SDC="***TOT***",Q=SDCL(1) I SDABB D ABB Q
F C=0:1 S SDC=$O(^UTILITY($J,"SDNO",SDDIV,SDC)) Q:(SDC?1"***".E)!(SDC="")!SDEND I (^(SDC,"***TOT***")>0&'Q)!Q D HDR,HDR1 S SDHD=1 D WR S SDTOT=1 Q:SDEND D:SDIO=IO(0) SCR Q:SDEND D HDR,HDR2,TOT S SDTOT=0 W !! D:SDIO=IO(0) SCR Q:SDEND
Q:SDEND S SDTOT1=1 D SDTOT^SDNOS2 S SDTOT1=0
Q
;
HDR D NOW^%DTC S Y=% X ^DD("DD") W @IOF,Y,?70,"PAGE " S P1=P1+1 W P1
W !,?30,"NO SHOW REPORT",$S(SDTOT!SDTOT1:" TOTALS",1:""),! D LINE^SDNOS1A W !!,?2,"FOR PERIOD COVERING: " S Y=SDBD D D^DIQ S SDBG=Y W ?30,SDBG
I $D(SDED) S Y=SDED D D^DIQ W " TO ",Y
D DIV^SDNOS1A D:SDABB HDR3 Q
;
HDR1 Q:SDIO=IO&(SDEND) W !,"DATE",?23,"TIME",?32,"PATIENT",?63,"SSN",!,"----",?23,"----",?32,"-------",?63,"---"
Q
;
WR S (SDNO,X1,Y3)=0 S C1=0 F C6=1:1 S Y3=C1,C1=$O(^UTILITY($J,"SDNO",SDDIV,SDC,C1)) Q:SDEND D:(C6=1)&(C1?1"***".E) NONE Q:C1?1"***".E!(C1="")!(SDEND) S:C6=1 Y3=C1 S X1=0 Q:SDIO=IO(0)&(SDEND) D WR1
Q
;
NONE W !!!,"*** NO NO-SHOWS OCCURRED IN THIS CLINIC DURING THIS TIME FRAME ***" Q
;
WR1 N SDX S SDPT=0 F C2=0:0 S SDPT=$O(^UTILITY($J,"SDNO",SDDIV,SDC,C1,SDPT)) Q:SDPT?1"***".E!(SDPT="")!(SDEND) S C3=0 F C4=0:0 S C3=$O(^UTILITY($J,"SDNO",SDDIV,SDC,C1,SDPT,C3)) Q:C3<1!(SDEND) S SDX=^(C3) D WR2
Q
;
WR2 S X=C1 X ^DD("FUNC",2,1) S Y2=X
S X=C1 D DW^%DTC S SDOW=X,Y=C1 X ^DD("DD") S Y1=$P(Y,"@")
Q:SDEND
I $Y+6>IOSL D:SDIO=IO(0) SCR Q:SDEND D HDR,HDR1 S SDHD=1 Q:SDEND
I SDHD=1 S X=C1 X ^DD("FUNC",2,1) S Y2=X W !!,SDOW,?10,Y1 W:$L(Y2)>7 ?22 W:$L(Y2)<8 ?23 W Y2,?32,SDPT,?63,C3
I $P(Y3,".",2)']""&('SDHD) W !!,SDOW,?10,Y1 W:$L(Y2)>7 ?22 W:$L(Y2)<8 ?23 W Y2,?32,SDPT,?63,C3
;I $P(Y3,".",2)]""&('SDHD) W !! W:$L(Y2)>7 ?22 W:$L(Y2)<8 ?23 W Y2,?32,SDPT,?63,C3
I $P(Y3,".",2)]""&('SDHD) D
. ; SD*689 - compare dates: if NOT the same, print date of week and date of clinic
. I $P(Y3,".",1)'=$P(C1,".",1) W !!,SDOW,?10,Y1 W:$L(Y2)>7 ?22 W:$L(Y2)<8 ?23 W Y2,?32,SDPT,?63,C3
. E W !! W:$L(Y2)>7 ?22 W:$L(Y2)<8 ?23 W Y2,?32,SDPT,?63,C3
W !,?32,"CLERK: ",$S($P(SDX,U,3):$P($G(^VA(200,$P(SDX,U,3),0)),U),$P(SDX,U)["NT":"NONE - NO ACTION TAKEN",1:"UNKNOWN")
S SDHD=0,Y3=C1
WR3 I $P(SDX,U)["A" W !,?32,"REBOOKED ON " S SDRB=$P(SDX,U,2),Y=SDRB X ^DD("DD") W Y,!
Q
;
TOT I 'SDABB F C1=0:0 S C1=$O(^UTILITY($J,"SDNO",SDDIV,SDC,C1)) Q:(C1?1"***".E)!(C1="")!SDEND D TOTAL
S SDT4=$G(^UTILITY($J,"SDNO",SDDIV,SDC,"***N***","***TOT***"))+$G(^UTILITY($J,"SDNO",SDDIV,SDC,"***NT***","***TOT***"))+$G(^UTILITY($J,"SDNO",SDDIV,SDC,"******","***TOT***"))
S SDT5=+$G(^UTILITY($J,"SDNO",SDDIV,SDC,"***NA***","***TOT***"))
S SDT6=+^UTILITY($J,"SDNO",SDDIV,SDC,"***TOT***")
Q:SDEND
D:$Y+6>IOSL&(SDIO=IO(0)) SCR Q:SDEND
D:$Y+6>IOSL HDR
I 'SDABB W !,?27,"___",?45,"___",?75,"___",!!,?27,SDT4,?47,SDT5,?75,SDT6
I 'SDABB D:$Y+6>IOSL&(SDIO=IO(0)) SCR Q:SDEND D:$Y+6>IOSL HDR
S SDPR=$S(^UTILITY($J,"SDNO",SDDIV,SDC,"***TOT***"):$J((^("***TOT***")/^UTILITY($J,"SDNO",SDDIV,SDC,"***SDNMS***")*100),2,0),1:0)_"%"
I 'SDABB W !!!,SDPR," of appointments for ",SDC," were NO-SHOWS for this period" Q
I SDABB W !,SDC,?40,$J(SDT4,5),?50,$J(SDT5,5),?60,$J(SDT6,5),?70,$J(SDPR,5)
Q
;
TOTAL S SDT1=$G(^UTILITY($J,"SDNO",SDDIV,SDC,C1,"***N***","***TOT***"))+$G(^UTILITY($J,"SDNO",SDDIV,SDC,C1,"***NT***","***TOT***"))+$G(^UTILITY($J,"SDNO",SDDIV,SDC,C1,"******","***TOT***"))
S:SDT1 SDOK=1
S SDT2=+$G(^UTILITY($J,"SDNO",SDDIV,SDC,C1,"***NA***","***TOT***"))
I SDT1!(SDT2) D WTOT
Q
;
WTOT D:$Y+5>IOSL&(SDIO=IO(0)) SCR Q:SDEND D:$Y+6>IOSL HDR,HDR2 S X=C1 D DW^%DTC W !,X S Y=C1 X ^DD("DD") W ?10,Y,?27,SDT1,?47,SDT2 S SDT3=SDT1+SDT2 W ?75,SDT3,!
Q
;
HDR2 W !!,?23,"TOTAL NO-SHOWS W/NO",?45,"TOTAL NO-SHOWS W/",?65,"TOTAL NO-SHOWS"
W:'SDTOT1 !,"DATE" W:SDTOT1 ! W ?23,"REBOOKED APPTS.",?45,"REBOOKED APPTS." D LINE^SDNOS1A
Q
;
SCR I $E(IOST,1,2)="C-" D OUT^SDUTL Q
Q
;
ABB ;Print abbreviated no-show report (clinic totals only)
S (SDTOT,SDTOT1)=1 D HDR
F C=0:1 S SDC=$O(^UTILITY($J,"SDNO",SDDIV,SDC)) Q:(SDC?1"***".E)!(SDC="")!SDEND D
.I (^UTILITY($J,"SDNO",SDDIV,SDC,"***TOT***")>0&'Q)!Q D:$Y>(IOSL-2) ABBHD Q:SDEND D TOT
.Q
Q:SDEND D:$E(IOST,1,2)="C-" SCR Q:SDEND D SDTOT^SDNOS2
Q
;
ABBHD I $E(IOST,1,2)="C-" D OUT^SDUTL Q
D HDR,HDR3 Q
;
HDR3 N SDLINE,SDI
S SDLINE="",$P(SDLINE,"-",31)=""
W ?40,"Without",?50,"With",!?40,"Rebooked",?50,"Rebooked",?60,"Total"
W ?70,"Percent",!,"Clinic",?40,"Appts.",?50,"Appts.",?60,"No-Shows"
W ?70,"No-Shows",!,SDLINE F SDI=1:1:4 W ?(30+(10*SDI)),$E(SDLINE,1,8)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDNOS1 4857 printed Apr 09, 2024@21:52:17 Page 2
SDNOS1 ;ALB/LDB - NO-SHOW REPORT ;07 May 99 11:13 AM
+1 ;;5.3;Scheduling;**194,410,689**;Aug 13, 1993;Build 2
+2 if 'SDV1
DO CL
IF SDV1
FOR SDDIV=0:0
SET SDDIV=$ORDER(^UTILITY($JOB,"SDNO",SDDIV))
if 'SDDIV!(SDDIV="")
QUIT
if SDIO=IO(0)&(SDEND)
QUIT
DO CL
if SDEND
QUIT
if SDIO=IO(0)
DO SCR
if SDEND
QUIT
+3 IF 'SDABB
if SDIO'=IO
DO TP^DGUTL
+4 DO END^SDNOS
QUIT
+5 ;
CL SET SDC="***TOT***"
SET Q=SDCL(1)
IF SDABB
DO ABB
QUIT
+1 FOR C=0:1
SET SDC=$ORDER(^UTILITY($JOB,"SDNO",SDDIV,SDC))
if (SDC?1"***".E)!(SDC="")!SDEND
QUIT
IF (^(SDC,"***TOT***")>0&'Q)!Q
DO HDR
DO HDR1
SET SDHD=1
DO WR
SET SDTOT=1
if SDEND
QUIT
if SDIO=IO(0)
DO SCR
if SDEND
QUIT
DO HDR
DO HDR2
DO TOT
SET SDTOT=0
WRITE !!
if SDIO=IO(0)
DO SCR
if SDEND
QUIT
+2 if SDEND
QUIT
SET SDTOT1=1
DO SDTOT^SDNOS2
SET SDTOT1=0
+3 QUIT
+4 ;
HDR DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
WRITE @IOF,Y,?70,"PAGE "
SET P1=P1+1
WRITE P1
+1 WRITE !,?30,"NO SHOW REPORT",$SELECT(SDTOT!SDTOT1:" TOTALS",1:""),!
DO LINE^SDNOS1A
WRITE !!,?2,"FOR PERIOD COVERING: "
SET Y=SDBD
DO D^DIQ
SET SDBG=Y
WRITE ?30,SDBG
+2 IF $DATA(SDED)
SET Y=SDED
DO D^DIQ
WRITE " TO ",Y
+3 DO DIV^SDNOS1A
if SDABB
DO HDR3
QUIT
+4 ;
HDR1 if SDIO=IO&(SDEND)
QUIT
WRITE !,"DATE",?23,"TIME",?32,"PATIENT",?63,"SSN",!,"----",?23,"----",?32,"-------",?63,"---"
+1 QUIT
+2 ;
WR SET (SDNO,X1,Y3)=0
SET C1=0
FOR C6=1:1
SET Y3=C1
SET C1=$ORDER(^UTILITY($JOB,"SDNO",SDDIV,SDC,C1))
if SDEND
QUIT
if (C6=1)&(C1?1"***".E)
DO NONE
if C1?1"***".E!(C1="")!(SDEND)
QUIT
if C6=1
SET Y3=C1
SET X1=0
if SDIO=IO(0)&(SDEND)
QUIT
DO WR1
+1 QUIT
+2 ;
NONE WRITE !!!,"*** NO NO-SHOWS OCCURRED IN THIS CLINIC DURING THIS TIME FRAME ***"
QUIT
+1 ;
WR1 NEW SDX
SET SDPT=0
FOR C2=0:0
SET SDPT=$ORDER(^UTILITY($JOB,"SDNO",SDDIV,SDC,C1,SDPT))
if SDPT?1"***".E!(SDPT="")!(SDEND)
QUIT
SET C3=0
FOR C4=0:0
SET C3=$ORDER(^UTILITY($JOB,"SDNO",SDDIV,SDC,C1,SDPT,C3))
if C3<1!(SDEND)
QUIT
SET SDX=^(C3)
DO WR2
+1 QUIT
+2 ;
WR2 SET X=C1
XECUTE ^DD("FUNC",2,1)
SET Y2=X
+1 SET X=C1
DO DW^%DTC
SET SDOW=X
SET Y=C1
XECUTE ^DD("DD")
SET Y1=$PIECE(Y,"@")
+2 if SDEND
QUIT
+3 IF $Y+6>IOSL
if SDIO=IO(0)
DO SCR
if SDEND
QUIT
DO HDR
DO HDR1
SET SDHD=1
if SDEND
QUIT
+4 IF SDHD=1
SET X=C1
XECUTE ^DD("FUNC",2,1)
SET Y2=X
WRITE !!,SDOW,?10,Y1
if $LENGTH(Y2)>7
WRITE ?22
if $LENGTH(Y2)<8
WRITE ?23
WRITE Y2,?32,SDPT,?63,C3
+5 IF $PIECE(Y3,".",2)']""&('SDHD)
WRITE !!,SDOW,?10,Y1
if $LENGTH(Y2)>7
WRITE ?22
if $LENGTH(Y2)<8
WRITE ?23
WRITE Y2,?32,SDPT,?63,C3
+6 ;I $P(Y3,".",2)]""&('SDHD) W !! W:$L(Y2)>7 ?22 W:$L(Y2)<8 ?23 W Y2,?32,SDPT,?63,C3
+7 IF $PIECE(Y3,".",2)]""&('SDHD)
Begin DoDot:1
+8 ; SD*689 - compare dates: if NOT the same, print date of week and date of clinic
+9 IF $PIECE(Y3,".",1)'=$PIECE(C1,".",1)
WRITE !!,SDOW,?10,Y1
if $LENGTH(Y2)>7
WRITE ?22
if $LENGTH(Y2)<8
WRITE ?23
WRITE Y2,?32,SDPT,?63,C3
+10 IF '$TEST
WRITE !!
if $LENGTH(Y2)>7
WRITE ?22
if $LENGTH(Y2)<8
WRITE ?23
WRITE Y2,?32,SDPT,?63,C3
End DoDot:1
+11 WRITE !,?32,"CLERK: ",$SELECT($PIECE(SDX,U,3):$PIECE($GET(^VA(200,$PIECE(SDX,U,3),0)),U),$PIECE(SDX,U)["NT":"NONE - NO ACTION TAKEN",1:"UNKNOWN")
+12 SET SDHD=0
SET Y3=C1
WR3 IF $PIECE(SDX,U)["A"
WRITE !,?32,"REBOOKED ON "
SET SDRB=$PIECE(SDX,U,2)
SET Y=SDRB
XECUTE ^DD("DD")
WRITE Y,!
+1 QUIT
+2 ;
TOT IF 'SDABB
FOR C1=0:0
SET C1=$ORDER(^UTILITY($JOB,"SDNO",SDDIV,SDC,C1))
if (C1?1"***".E)!(C1="")!SDEND
QUIT
DO TOTAL
+1 SET SDT4=$GET(^UTILITY($JOB,"SDNO",SDDIV,SDC,"***N***","***TOT***"))+$GET(^UTILITY($JOB,"SDNO",SDDIV,SDC,"***NT***","***TOT***"))+$GET(^UTILITY($JOB,"SDNO",SDDIV,SDC,"******","***TOT***"))
+2 SET SDT5=+$GET(^UTILITY($JOB,"SDNO",SDDIV,SDC,"***NA***","***TOT***"))
+3 SET SDT6=+^UTILITY($JOB,"SDNO",SDDIV,SDC,"***TOT***")
+4 if SDEND
QUIT
+5 if $Y+6>IOSL&(SDIO=IO(0))
DO SCR
if SDEND
QUIT
+6 if $Y+6>IOSL
DO HDR
+7 IF 'SDABB
WRITE !,?27,"___",?45,"___",?75,"___",!!,?27,SDT4,?47,SDT5,?75,SDT6
+8 IF 'SDABB
if $Y+6>IOSL&(SDIO=IO(0))
DO SCR
if SDEND
QUIT
if $Y+6>IOSL
DO HDR
+9 SET SDPR=$SELECT(^UTILITY($JOB,"SDNO",SDDIV,SDC,"***TOT***"):$JUSTIFY((^("***TOT***")/^UTILITY($JOB,"SDNO",SDDIV,SDC,"***SDNMS***")*100),2,0),1:0)_"%"
+10 IF 'SDABB
WRITE !!!,SDPR," of appointments for ",SDC," were NO-SHOWS for this period"
QUIT
+11 IF SDABB
WRITE !,SDC,?40,$JUSTIFY(SDT4,5),?50,$JUSTIFY(SDT5,5),?60,$JUSTIFY(SDT6,5),?70,$JUSTIFY(SDPR,5)
+12 QUIT
+13 ;
TOTAL SET SDT1=$GET(^UTILITY($JOB,"SDNO",SDDIV,SDC,C1,"***N***","***TOT***"))+$GET(^UTILITY($JOB,"SDNO",SDDIV,SDC,C1,"***NT***","***TOT***"))+$GET(^UTILITY($JOB,"SDNO",SDDIV,SDC,C1,"******","***TOT***"))
+1 if SDT1
SET SDOK=1
+2 SET SDT2=+$GET(^UTILITY($JOB,"SDNO",SDDIV,SDC,C1,"***NA***","***TOT***"))
+3 IF SDT1!(SDT2)
DO WTOT
+4 QUIT
+5 ;
WTOT if $Y+5>IOSL&(SDIO=IO(0))
DO SCR
if SDEND
QUIT
if $Y+6>IOSL
DO HDR
DO HDR2
SET X=C1
DO DW^%DTC
WRITE !,X
SET Y=C1
XECUTE ^DD("DD")
WRITE ?10,Y,?27,SDT1,?47,SDT2
SET SDT3=SDT1+SDT2
WRITE ?75,SDT3,!
+1 QUIT
+2 ;
HDR2 WRITE !!,?23,"TOTAL NO-SHOWS W/NO",?45,"TOTAL NO-SHOWS W/",?65,"TOTAL NO-SHOWS"
+1 if 'SDTOT1
WRITE !,"DATE"
if SDTOT1
WRITE !
WRITE ?23,"REBOOKED APPTS.",?45,"REBOOKED APPTS."
DO LINE^SDNOS1A
+2 QUIT
+3 ;
SCR IF $EXTRACT(IOST,1,2)="C-"
DO OUT^SDUTL
QUIT
+1 QUIT
+2 ;
ABB ;Print abbreviated no-show report (clinic totals only)
+1 SET (SDTOT,SDTOT1)=1
DO HDR
+2 FOR C=0:1
SET SDC=$ORDER(^UTILITY($JOB,"SDNO",SDDIV,SDC))
if (SDC?1"***".E)!(SDC="")!SDEND
QUIT
Begin DoDot:1
+3 IF (^UTILITY($JOB,"SDNO",SDDIV,SDC,"***TOT***")>0&'Q)!Q
if $Y>(IOSL-2)
DO ABBHD
if SDEND
QUIT
DO TOT
+4 QUIT
End DoDot:1
+5 if SDEND
QUIT
if $EXTRACT(IOST,1,2)="C-"
DO SCR
if SDEND
QUIT
DO SDTOT^SDNOS2
+6 QUIT
+7 ;
ABBHD IF $EXTRACT(IOST,1,2)="C-"
DO OUT^SDUTL
QUIT
+1 DO HDR
DO HDR3
QUIT
+2 ;
HDR3 NEW SDLINE,SDI
+1 SET SDLINE=""
SET $PIECE(SDLINE,"-",31)=""
+2 WRITE ?40,"Without",?50,"With",!?40,"Rebooked",?50,"Rebooked",?60,"Total"
+3 WRITE ?70,"Percent",!,"Clinic",?40,"Appts.",?50,"Appts.",?60,"No-Shows"
+4 WRITE ?70,"No-Shows",!,SDLINE
FOR SDI=1:1:4
WRITE ?(30+(10*SDI)),$EXTRACT(SDLINE,1,8)
+5 QUIT
