source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDNOS1.m@ 1446

Last change on this file since 1446 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1SDNOS1 ;ALB/LDB - NO-SHOW REPORT ; 07 May 99 11:13 AM
2 ;;5.3;Scheduling;**194,410**;Aug 13, 1993
3 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
4 I 'SDABB D:SDIO'=IO TP^DGUTL
5 D END^SDNOS Q
6 ;
7CL S SDC="***TOT***",Q=SDCL(1) I SDABB D ABB Q
8 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
9 Q:SDEND S SDTOT1=1 D SDTOT^SDNOS2 S SDTOT1=0
10 Q
11 ;
12HDR D NOW^%DTC S Y=% X ^DD("DD") W @IOF,Y,?70,"PAGE " S P1=P1+1 W P1
13 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
14 I $D(SDED) S Y=SDED D D^DIQ W " TO ",Y
15 D DIV^SDNOS1A D:SDABB HDR3 Q
16 ;
17HDR1 Q:SDIO=IO&(SDEND) W !,"DATE",?23,"TIME",?32,"PATIENT",?63,"SSN",!,"----",?23,"----",?32,"-------",?63,"---"
18 Q
19 ;
20WR 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
21 Q
22 ;
23NONE W !!!,"*** NO NO-SHOWS OCCURRED IN THIS CLINIC DURING THIS TIME FRAME ***" Q
24 ;
25WR1 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
26 Q
27 ;
28WR2 S X=C1 X ^DD("FUNC",2,1) S Y2=X
29 S X=C1 D DW^%DTC S SDOW=X,Y=C1 X ^DD("DD") S Y1=$P(Y,"@")
30 Q:SDEND
31 I $Y+6>IOSL D:SDIO=IO(0) SCR Q:SDEND D HDR,HDR1 S SDHD=1 Q:SDEND
32 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
33 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
34 I $P(Y3,".",2)]""&('SDHD) W !! W:$L(Y2)>7 ?22 W:$L(Y2)<8 ?23 W Y2,?32,SDPT,?63,C3
35 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")
36 S SDHD=0,Y3=C1
37WR3 I $P(SDX,U)["A" W !,?32,"REBOOKED ON " S SDRB=$P(SDX,U,2),Y=SDRB X ^DD("DD") W Y,!
38 Q
39 ;
40TOT I 'SDABB F C1=0:0 S C1=$O(^UTILITY($J,"SDNO",SDDIV,SDC,C1)) Q:(C1?1"***".E)!(C1="")!SDEND D TOTAL
41 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***"))
42 S SDT5=+$G(^UTILITY($J,"SDNO",SDDIV,SDC,"***NA***","***TOT***"))
43 S SDT6=+^UTILITY($J,"SDNO",SDDIV,SDC,"***TOT***")
44 Q:SDEND
45 D:$Y+6>IOSL&(SDIO=IO(0)) SCR Q:SDEND
46 D:$Y+6>IOSL HDR
47 I 'SDABB W !,?27,"___",?45,"___",?75,"___",!!,?27,SDT4,?47,SDT5,?75,SDT6
48 I 'SDABB D:$Y+6>IOSL&(SDIO=IO(0)) SCR Q:SDEND D:$Y+6>IOSL HDR
49 S SDPR=$S(^UTILITY($J,"SDNO",SDDIV,SDC,"***TOT***"):$J((^("***TOT***")/^UTILITY($J,"SDNO",SDDIV,SDC,"***SDNMS***")*100),2,0),1:0)_"%"
50 I 'SDABB W !!!,SDPR," of appointments for ",SDC," were NO-SHOWS for this period" Q
51 I SDABB W !,SDC,?40,$J(SDT4,5),?50,$J(SDT5,5),?60,$J(SDT6,5),?70,$J(SDPR,5)
52 Q
53 ;
54TOTAL 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***"))
55 S:SDT1 SDOK=1
56 S SDT2=+$G(^UTILITY($J,"SDNO",SDDIV,SDC,C1,"***NA***","***TOT***"))
57 I SDT1!(SDT2) D WTOT
58 Q
59 ;
60WTOT 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,!
61 Q
62 ;
63HDR2 W !!,?23,"TOTAL NO-SHOWS W/NO",?45,"TOTAL NO-SHOWS W/",?65,"TOTAL NO-SHOWS"
64 W:'SDTOT1 !,"DATE" W:SDTOT1 ! W ?23,"REBOOKED APPTS.",?45,"REBOOKED APPTS." D LINE^SDNOS1A
65 Q
66 ;
67SCR I $E(IOST,1,2)="C-" D OUT^SDUTL Q
68 Q
69 ;
70ABB ;Print abbreviated no-show report (clinic totals only)
71 S (SDTOT,SDTOT1)=1 D HDR
72 F C=0:1 S SDC=$O(^UTILITY($J,"SDNO",SDDIV,SDC)) Q:(SDC?1"***".E)!(SDC="")!SDEND D
73 .I (^UTILITY($J,"SDNO",SDDIV,SDC,"***TOT***")>0&'Q)!Q D:$Y>(IOSL-2) ABBHD Q:SDEND D TOT
74 .Q
75 Q:SDEND D:$E(IOST,1,2)="C-" SCR Q:SDEND D SDTOT^SDNOS2
76 Q
77 ;
78ABBHD I $E(IOST,1,2)="C-" D OUT^SDUTL Q
79 D HDR,HDR3 Q
80 ;
81HDR3 N SDLINE,SDI
82 S SDLINE="",$P(SDLINE,"-",31)=""
83 W ?40,"Without",?50,"With",!?40,"Rebooked",?50,"Rebooked",?60,"Total"
84 W ?70,"Percent",!,"Clinic",?40,"Appts.",?50,"Appts.",?60,"No-Shows"
85 W ?70,"No-Shows",!,SDLINE F SDI=1:1:4 W ?(30+(10*SDI)),$E(SDLINE,1,8)
86 Q
Note: See TracBrowser for help on using the repository browser.