source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPREP3.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.9 KB
RevLine 
[613]1DGPREP3 ;ALB/SCK - Pre-Registration calling statistics ; 1/2/97
2 ;;5.3;Registration;**109**;Aug 13, 1993
3 Q
4 ;
5EN ; Main entry point for pre-registration calling statistics
6 N X1,DIR,DGPBEG,DGPEND,DGPDSH,DGPN1,DGPDATA,VAUTD,DGPN2,DGPTOT,DGPE,DGPABRT,DGSNGLDV
7 ;
8 K DUOUT,DIRUT,^TMP("DGPRERPT",$J)
9 S DIR(0)="DA^::EX"
10 S X1=$P($$NOW^XLFDT,".")
11 S DIR("?",1)="Enter the beginning or ending date in an acceptable format"
12 S DIR("?")="The ending date cannot be before the beginning date."
13 S DIR("B")=$$FMTE^XLFDT(X1,1)
14 S DIR("A")="Enter beginning date for report: "
15 D ^DIR
16 I $D(DIRUT) G EXIT
17 S DGPBEG=Y
18AGN S DIR("A")="Enter ending date for report: "
19 D ^DIR
20 I $D(DIRUT) G EXIT
21 S DGPEND=Y
22 I DGPEND<DGPBEG D G AGN
23 . W !,"The ending date for this report cannot be earlier then the beginning date"
24 K DIR
25 ;
26 ; *** Select division
27 I $P($G(^DG(43,1,"GL")),U,2) D
28 . D DIVISION^VAUTOMA
29 E D
30 . S DGSNGLDV=1
31 . S VAUTD=1
32 ;
33 S %ZIS="Q" D ^%ZIS G:POP EXIT
34 I $D(IO("Q")) D G EXIT
35 . S ZTRTN="RPT^DGPREP3",ZTDESC="DISPLAY PRE-REG CALLING STATS"
36 . N ZTX
37 . F ZTX="DGPBEG","DGPEND","VAUTD(","VAUTD","DGSNGLDV" S ZTSAVE(ZTX)=""
38 . D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK
39 . D HOME^%ZIS
40 . K IO("Q"),ZTSK,ZTDESC,ZTRTN,ZTSAVE
41 ;
42 D WAIT^DICD
43RPT ; Build report data array
44 U IO
45 K ^TMP($J)
46 S $P(DGPDSH,"=",70)=""
47 S DGPTOT=0
48 ;
49 S DGPE=DGPEND+.9999
50 S DGPN1=DGPBEG-.1 F S DGPN1=$O(^DGS(41.43,"B",DGPN1)) Q:'DGPN1!(DGPN1>DGPE) D
51 . S DGPN2=0 F S DGPN2=$O(^DGS(41.43,"B",DGPN1,DGPN2)) Q:'DGPN2 D
52 .. S DGPDATA=$G(^DGS(41.43,DGPN2,0))
53 .. I +$P(DGPDATA,U,5)'>0 D
54 ... I $G(DGSNGLDV) S $P(DGPDATA,U,5)=$S($D(^DG(40.8,1)):1,1:0) Q
55 ... S $P(DGPDATA,U,5)="NO DIV"
56 .. I VAUTD=1!($D(VAUTD($P(DGPDATA,U,5)))) D
57 ... S DGPTOT=DGPTOT+1
58 ... I $P(DGPDATA,U,4)']"" S ^TMP("DGPRERPT",$J,$P(DGPDATA,U,5),"NONE")=$G(^TMP("DGPRERPT",$J,$P(DGPDATA,U,5),"NONE"))+1 Q
59 ... S ^TMP("DGPRERPT",$J,$P(DGPDATA,U,5),$P(DGPDATA,U,4))=$G(^TMP("DGPRERPT",$J,$P(DGPDATA,U,5),$P(DGPDATA,U,4)))+1
60 ;
61 D PRNT
62 ;
63EXIT ;
64 D:'$D(ZTQUEUED) ^%ZISC
65 K ^TMP("DGPERPT",$J),POP,ZTQUEUED
66 Q
67 ;
68PRNT ; Print report to selected device
69 N DGPDV,SBTOT,SB1,PAGE
70 ;
71 S PAGE=0
72 I '$D(^TMP("DGPRERPT",$J)) D G EXIT
73 . S DGPDV=""
74 . D HDR
75 . W !!?10,"No data available"
76 ;
77 S DGPDV="" F S DGPDV=$O(^TMP("DGPRERPT",$J,DGPDV)) Q:DGPDV']"" D G:$G(DGPABRT) EXIT
78 . D HDR Q:$G(DGPABRT)
79 . S SBTOT=0
80 . W !?10," BUSY: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"B")),5)
81 . W !?10," CONNECTED: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"C")),5)
82 . W !?10," DEATH: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"D")),5)
83 . W !?10," DON'T CALL: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"T")),5)
84 . W !?10," NO ANSWER: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"N")),5)
85 . W !?10," NO PHONE: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"P")),5)
86 . W !?10," UNCOOPERATIVE: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"U")),5)
87 . W !?10," WRONG NUMBER: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"W")),5)
88 . W !?10,"LEFT A CALLBACK MSG: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"M")),5)
89 . W !?10," CHANGE INFORMATION: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"X")),5)
90 . W !?10," PREVIOUSLY UPDATED: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"V")),5)
91 . W !?10," CALL BACK: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"K")),5)
92 . W !?10," NO STATUS: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"NONE")),5)
93 . W !?10," -------"
94 . S SB1="" F S SB1=$O(^TMP("DGPRERPT",$J,DGPDV,SB1)) Q:SB1']"" D
95 .. S SBTOT=$G(SBTOT)++$G(^TMP("DGPRERPT",$J,DGPDV,SB1))
96 . W !?10," Total for Division: ",$J(SBTOT,5)
97 Q
98 ;
99HDR ;
100 I PAGE>0,IOST?1"C-".E S DIR(0)="E" D ^DIR S DGPABRT='+$G(Y)
101 G:$G(DGPABRT) HDRQ
102 W @IOF
103 S PAGE=PAGE+1
104 W !!?5,"PRE-REGISTRATION CALL STATISTICS"
105 W:DGPDV]"" !?5,"FOR",$S($G(DGSNGLDV):": ",1:" DIVISION: ")
106 W $S(DGPDV="NO DIV":"NO DIVISION SPECIFIED",+DGPDV>0:$P($G(^DG(40.8,DGPDV,0)),U),1:"")
107 ;
108 W !?5,"FOR PERIOD COVERING "_$$FMTE^XLFDT(DGPBEG,"2D")_" TO "_$$FMTE^XLFDT(DGPEND,"2D")
109 W !!?5,DGPDSH
110HDRQ Q
Note: See TracBrowser for help on using the repository browser.