- SDNOS1 ;ALB/LDB - NO-SHOW REPORT ; 07 May 99 11:13 AM
- ;;5.3;Scheduling;**194,410,1015**;Aug 13, 1993;Build 21
- ;IHS/ANMC/LJF 11/03/2000 changed SSN to HRCN
- ; used IHS call for rebook date
- ; added total # appts to % statement
- ; removed page header for list template
- ; removed table of contents from list template
- ; chckd 4 temp HRCN in a loop;VA assumes numeric
- ; 12/14/2000 added confidential message to heading
- ; 12/22/2000 added patient died message
- ; 3/23/2001 changed X ^DD(FUNC",2,1) to $$TIME^BDGF
- ; 1/02/2002 removed automatic form feed before totals
- ;
- 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 ;IHS/ANMC/LJF 11/03/2000
- I '$G(VALM),'SDABB D:SDIO'=IO TP^DGUTL ;IHS/ANMC/LJF 11/03/2000
- D END^SDNOS Q
- ;
- CL S SDC="***TOT***",Q=SDCL(1) I SDABB D ABB Q
- ;
- ;IHS/ANMC/LJF 1/02/2002
- ;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
- 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 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 ;IHS/ANMC/LJF 11/03/2000
- ;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 ;IHS/ANMC/LJF 11/03/2000
- I '$G(VALM) D NOW^%DTC S Y=% X ^DD("DD") W @IOF,Y,?70,"PAGE " S P1=P1+1 W P1 ;IHS/ANMC/LJF 11/03/2000
- I '$G(VALM) W !,?30,"NO SHOW REPORT",$S(SDTOT!SDTOT1:" TOTALS",1:""),! D LINE^SDNOS1A ;IHS/ANMC/LJF 11/03/2000
- W !?15,$$CONF^BSDU ;IHS/ANMC/LJF 12/14/2000
- W !!,?2,"FOR PERIOD COVERING: " S Y=SDBD D D^DIQ S SDBG=Y W ?30,SDBG ;IHS/ANMC/LJF 11/03/2000
- 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,"---" ;IHS/ANMC/LJF 11/03/2000
- Q:SDIO=IO&(SDEND) W !,"DATE",?23,"TIME",?32,"PATIENT",?63,"HRCN",!,"----",?23,"----",?32,"-------",?63,"----" ;IHS/ANMC/LJF 11/03/2000
- 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
- ;
- ;IHS/ANMC/LJF 11/03/2000 C3 could be temporary chart #
- 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
- 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="")!(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
- 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,! ;IHS/ANMC/LJF 11/03/2000
- I $P(SDX,U)["A" W !,?32,"REBOOKED TO " S SDRB=$P(SDX,U,2),SDRB=$$RBKDT^BSDN1(SDRB,+$P(SDX,U,4)),Y=SDRB X ^DD("DD") W Y,! ;IHS/ANMC/LJF 11/03/2000
- 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 ;IHS/ANMC/LJF 11/03/2000
- NEW X S X=^UTILITY($J,"SDNO",SDDIV,SDC,"***SDNMS***")+^UTILITY($J,"SDNO",SDDIV,SDC,"***TOT***") ;IHS/ANMC/LJF 11/03/2000 total appts
- I 'SDABB W !!!,SDPR," of "_X_" appointments for ",SDC," were NO-SHOWS for this period" Q ;IHS/ANMC/LJF 11/03/2000
- 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
- SDNOS1 ;ALB/LDB - NO-SHOW REPORT ; 07 May 99 11:13 AM
- +1 ;;5.3;Scheduling;**194,410,1015**;Aug 13, 1993;Build 21
- +2 ;IHS/ANMC/LJF 11/03/2000 changed SSN to HRCN
- +3 ; used IHS call for rebook date
- +4 ; added total # appts to % statement
- +5 ; removed page header for list template
- +6 ; removed table of contents from list template
- +7 ; chckd 4 temp HRCN in a loop;VA assumes numeric
- +8 ; 12/14/2000 added confidential message to heading
- +9 ; 12/22/2000 added patient died message
- +10 ; 3/23/2001 changed X ^DD(FUNC",2,1) to $$TIME^BDGF
- +11 ; 1/02/2002 removed automatic form feed before totals
- +12 ;
- +13 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
- +14 ;I 'SDABB D:SDIO'=IO TP^DGUTL ;IHS/ANMC/LJF 11/03/2000
- +15 ;IHS/ANMC/LJF 11/03/2000
- IF '$GET(VALM)
- IF 'SDABB
- IF SDIO'=IO
- DO TP^DGUTL
- +16 DO END^SDNOS
- QUIT
- +17 ;
- CL SET SDC="***TOT***"
- SET Q=SDCL(1)
- IF SDABB
- DO ABB
- QUIT
- +1 ;
- +2 ;IHS/ANMC/LJF 1/02/2002
- +3 ;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
- +4 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 TOT
- SET SDTOT=0
- WRITE !!
- IF SDIO=IO(0)
- DO SCR
- IF SDEND
- QUIT
- +5 ;
- +6 IF SDEND
- QUIT
- SET SDTOT1=1
- DO SDTOT^SDNOS2
- SET SDTOT1=0
- +7 QUIT
- +8 ;
- HDR ;D NOW^%DTC S Y=% X ^DD("DD") W @IOF,Y,?70,"PAGE " S P1=P1+1 W P1 ;IHS/ANMC/LJF 11/03/2000
- +1 ;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 ;IHS/ANMC/LJF 11/03/2000
- +2 ;IHS/ANMC/LJF 11/03/2000
- IF '$GET(VALM)
- DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- WRITE @IOF,Y,?70,"PAGE "
- SET P1=P1+1
- WRITE P1
- +3 ;IHS/ANMC/LJF 11/03/2000
- IF '$GET(VALM)
- WRITE !,?30,"NO SHOW REPORT",$SELECT(SDTOT!SDTOT1:" TOTALS",1:""),!
- DO LINE^SDNOS1A
- +4 ;IHS/ANMC/LJF 12/14/2000
- WRITE !?15,$$CONF^BSDU
- +5 ;IHS/ANMC/LJF 11/03/2000
- WRITE !!,?2,"FOR PERIOD COVERING: "
- SET Y=SDBD
- DO D^DIQ
- SET SDBG=Y
- WRITE ?30,SDBG
- +6 IF $DATA(SDED)
- SET Y=SDED
- DO D^DIQ
- WRITE " TO ",Y
- +7 DO DIV^SDNOS1A
- IF SDABB
- DO HDR3
- QUIT
- +8 ;
- HDR1 ;Q:SDIO=IO&(SDEND) W !,"DATE",?23,"TIME",?32,"PATIENT",?63,"SSN",!,"----",?23,"----",?32,"-------",?63,"---" ;IHS/ANMC/LJF 11/03/2000
- +1 ;IHS/ANMC/LJF 11/03/2000
- IF SDIO=IO&(SDEND)
- QUIT
- WRITE !,"DATE",?23,"TIME",?32,"PATIENT",?63,"HRCN",!,"----",?23,"----",?32,"-------",?63,"----"
- +2 QUIT
- +3 ;
- 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 ;
- +2 ;IHS/ANMC/LJF 11/03/2000 C3 could be temporary chart #
- 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
- +1 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="")!(SDEND)
- QUIT
- SET SDX=^(C3)
- DO WR2
- +2 ;
- +3 QUIT
- +4 ;
- 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 IF $PIECE(Y3,".",2)]""&('SDHD)
- WRITE !!
- IF $LENGTH(Y2)>7
- WRITE ?22
- IF $LENGTH(Y2)<8
- WRITE ?23
- WRITE Y2,?32,SDPT,?63,C3
- +7 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")
- +8 SET SDHD=0
- SET 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,! ;IHS/ANMC/LJF 11/03/2000
- +1 ;IHS/ANMC/LJF 11/03/2000
- IF $PIECE(SDX,U)["A"
- WRITE !,?32,"REBOOKED TO "
- SET SDRB=$PIECE(SDX,U,2)
- SET SDRB=$$RBKDT^BSDN1(SDRB,+$PIECE(SDX,U,4))
- SET Y=SDRB
- XECUTE ^DD("DD")
- WRITE Y,!
- +2 QUIT
- +3 ;
- 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 ;I 'SDABB W !!!,SDPR," of appointments for ",SDC," were NO-SHOWS for this period" Q ;IHS/ANMC/LJF 11/03/2000
- +11 ;IHS/ANMC/LJF 11/03/2000 total appts
- NEW X
- SET X=^UTILITY($JOB,"SDNO",SDDIV,SDC,"***SDNMS***")+^UTILITY($JOB,"SDNO",SDDIV,SDC,"***TOT***")
- +12 ;IHS/ANMC/LJF 11/03/2000
- IF 'SDABB
- WRITE !!!,SDPR," of "_X_" appointments for ",SDC," were NO-SHOWS for this period"
- QUIT
- +13 IF SDABB
- WRITE !,SDC,?40,$JUSTIFY(SDT4,5),?50,$JUSTIFY(SDT5,5),?60,$JUSTIFY(SDT6,5),?70,$JUSTIFY(SDPR,5)
- +14 QUIT
- +15 ;
- 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
