1 | ACKQCDRP ;AUG/JLTP BIR/PTD HCIOFO/AG -Print CDR Report ; [ 03/28/96 10:45 AM ]
|
---|
2 | ;;3.0;QUASAR;;Feb 11, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
---|
4 | ;
|
---|
5 | ; This routine prints the CDR report either for a Site, or for an
|
---|
6 | ; individual Division, for a specific Month.
|
---|
7 | ;
|
---|
8 | K ACKDIV ; initialise Division array
|
---|
9 | ;
|
---|
10 | ; get CDR Generate flag (by site or division)
|
---|
11 | S ACKCDRP=$$GET1^DIQ(509850.8,"1,",.1,"I") ; either 'S' or 'D'
|
---|
12 | I ACKCDRP'="S",ACKCDRP'="D" G EXIT
|
---|
13 | ;
|
---|
14 | OPTN ;Introduce option.
|
---|
15 | I ACKCDRP="S" D
|
---|
16 | . S ACKTXT(1)="This option prints the A&SP Service Cost Distribution report for your site,"
|
---|
17 | . S ACKTXT(2)="for a given month."
|
---|
18 | I ACKCDRP="D" D
|
---|
19 | . S ACKTXT(1)="This option prints the A&SP Service Cost Distribution report for a Division"
|
---|
20 | . S ACKTXT(2)="or multiple Divisions, for a given month."
|
---|
21 | W @IOF,!,ACKTXT(1),!,ACKTXT(2),!
|
---|
22 | ;
|
---|
23 | ; prompt for Division(s)
|
---|
24 | I ACKCDRP="D" S ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI") G:+ACKDIV=0 EXIT
|
---|
25 | ;
|
---|
26 | ; prompt for month
|
---|
27 | D GETDT G:$D(DIRUT) EXIT
|
---|
28 | S MON=$E(ACKM,1,5),ACKEM=MON_"99",ACKDA=+$$SITE^VASITE()_MON
|
---|
29 | S ACKBFY=$$BFY^ACKQUTL(ACKM)
|
---|
30 | ;
|
---|
31 | ; determine whether the cdr has been generated
|
---|
32 | S ACKEXIT=0
|
---|
33 | I ACKCDRP="D" D CHKDIV G:ACKEXIT EXIT
|
---|
34 | I ACKCDRP="S" D CHKSITE G:ACKEXIT EXIT
|
---|
35 | ;
|
---|
36 | DEV ; select output device
|
---|
37 | W !!,"The right margin for this report is 80."
|
---|
38 | W !,"You can queue it to run at a later time.",!
|
---|
39 | K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS
|
---|
40 | I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G EXIT
|
---|
41 | ; if requested, add report to queue
|
---|
42 | I $D(IO("Q")) D G EXIT
|
---|
43 | . K IO("Q")
|
---|
44 | . S ZTRTN="DQ^ACKQCDRP",ZTDESC="QUASAR - Print A&SP Cost Distribution Report"
|
---|
45 | . S ZTSAVE("ACK*")="" D ^%ZTLOAD D HOME^%ZIS K ZTSK
|
---|
46 | ;
|
---|
47 | DQ ;Entry point when queued.
|
---|
48 | U IO
|
---|
49 | D NOW^%DTC
|
---|
50 | S ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%),ACKPG=0
|
---|
51 | K ^TMP("ACKQCDRP",$J)
|
---|
52 | ;
|
---|
53 | ; print the report
|
---|
54 | I ACKCDRP="S" D COMPS,PRINT ; print for the site
|
---|
55 | I ACKCDRP="D" D ; print for each division
|
---|
56 | . S ACKDIV="" F S ACKDIV=$O(ACKDIV(ACKDIV)) Q:ACKDIV="" D COMPD,PRINT
|
---|
57 | ;
|
---|
58 | EXIT ; ALWAYS EXIT HERE
|
---|
59 | K %I,ACKBFY,ACKCDT,ACKDA,ACKEM,ACKM,ACKPG,AS,CDR,CPT,DIR,DIRUT,DTOUT
|
---|
60 | K DUOUT,I,ICD,LN,T,X,XAS,Y,ZIP,^TMP("ACKQCDRP",$J)
|
---|
61 | K ACKTXT,ACKCDRP,ACKCDR,ACKCDRNM,ACKPCNT,ACKTOT,ACKTMP,ACKIEN,ACKTGT,ACKMSG
|
---|
62 | K ACKMORE,ACKCDRX,ACKEXIT,ACKDIV
|
---|
63 | W:$E(IOST)="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
---|
64 | Q
|
---|
65 | ;
|
---|
66 | COMPS ; compile data for the site
|
---|
67 | ; walk down the CDR data for the site in the Workload file.
|
---|
68 | K ACKTGT,ACKMSG
|
---|
69 | S ACKFROM="" S ACKTOT=0,ACKMORE=0
|
---|
70 | F D Q:'ACKMORE
|
---|
71 | . S ACKMORE=0
|
---|
72 | . D LIST^DIC(509850.74,","_ACKDA_",",".01;.02","I",1,.ACKFROM,"","","","","ACKTGT","ACKMSG")
|
---|
73 | . I $P(ACKTGT("DILIST",0),U,1)=1 D ; one found
|
---|
74 | . . S ACKMORE=$P(ACKTGT("DILIST",0),U,3) ; there are more
|
---|
75 | . . S ACKCDR=ACKTGT("DILIST","ID",1,.01) ; cdr number
|
---|
76 | . . S ACKPCNT=ACKTGT("DILIST","ID",1,.02) ; percentage
|
---|
77 | . . S ACKIEN=$$FIND1^DIC(509850,"","O",ACKCDR,"B","","")
|
---|
78 | . . S ACKCDRNM=$$GET1^DIQ(509850,ACKIEN_",",1,"E") ; cdr description
|
---|
79 | . . S ^TMP("ACKQCDRP",$J,1,+ACKCDR)=ACKCDR_U_ACKCDRNM_U_ACKPCNT
|
---|
80 | Q
|
---|
81 | ;
|
---|
82 | COMPD ; compile data for a division
|
---|
83 | ; walk down the CDR data for the division in the Workload file.
|
---|
84 | K ACKTGT,ACKMSG,^TMP("ACKQCDRP",$J,1)
|
---|
85 | S ACKFROM="" S ACKTOT=0,ACKMORE=0
|
---|
86 | F D Q:'ACKMORE Q:$D(DIRUT)
|
---|
87 | . S ACKMORE=0
|
---|
88 | . D LIST^DIC(509850.754,","_ACKDIV_","_ACKDA_",",".01;54.02","I",1,.ACKFROM,"","","","","ACKTGT","ACKMSG")
|
---|
89 | . I $P(ACKTGT("DILIST",0),U,1)=1 D ; one found
|
---|
90 | . . S ACKMORE=$P(ACKTGT("DILIST",0),U,3) ; there are more
|
---|
91 | . . S ACKCDR=ACKTGT("DILIST","ID",1,.01) ; cdr number
|
---|
92 | . . S ACKPCNT=ACKTGT("DILIST","ID",1,54.02) ; percentage
|
---|
93 | . . S ACKIEN=$$FIND1^DIC(509850,"","O",ACKCDR,"B","","")
|
---|
94 | . . S ACKCDRNM=$$GET1^DIQ(509850,ACKIEN_",",1,"E") ; cdr description
|
---|
95 | . . S ^TMP("ACKQCDRP",$J,1,+ACKCDR)=ACKCDR_U_ACKCDRNM_U_ACKPCNT
|
---|
96 | Q
|
---|
97 | ;
|
---|
98 | PRINT ; Print/display results for the Site/Division.
|
---|
99 | I ACKPG>0,$E(IOST)="C" D PAUSE^ACKQUTL Q:$D(DIRUT)
|
---|
100 | D DHD
|
---|
101 | I '$D(^TMP("ACKQCDRP",$J,1)) D LINE W !!,"No data found for report specifications." D:$E(IOST)="C" PAUSE^ACKQUTL Q
|
---|
102 | D HD4
|
---|
103 | CDR ; CDR information for site/Division
|
---|
104 | S ACKCDR="" F S ACKCDR=$O(^TMP("ACKQCDRP",$J,1,ACKCDR)) Q:ACKCDR="" D Q:$D(DIRUT)
|
---|
105 | . I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D DHD,HD4
|
---|
106 | . S ACKTMP=^TMP("ACKQCDRP",$J,1,ACKCDR)
|
---|
107 | . S ACKCDRX=$P(ACKTMP,U,1),ACKCDRNM=$P(ACKTMP,U,2),ACKPCNT=$P(ACKTMP,U,3)
|
---|
108 | . W !?5,ACKCDRX,?15,ACKCDRNM,?65,$J(ACKPCNT,6,2)
|
---|
109 | . S ACKTOT=ACKTOT+ACKPCNT
|
---|
110 | ;
|
---|
111 | ; print total
|
---|
112 | Q:$D(DIRUT)
|
---|
113 | W !!?5,"Total:",?65,$J(ACKTOT,6,2)
|
---|
114 | Q
|
---|
115 | ;
|
---|
116 | DHD ;
|
---|
117 | N X
|
---|
118 | W:($E(IOST)="C")!(ACKPG>0) @IOF
|
---|
119 | S ACKPG=ACKPG+1
|
---|
120 | W "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
|
---|
121 | W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
|
---|
122 | W ! D CNTR^ACKQUTL("Cost Distribution Report")
|
---|
123 | I ACKCDRP="S" W ! D CNTR^ACKQUTL("for")
|
---|
124 | I ACKCDRP="D" W ! D CNTR^ACKQUTL("for Division : "_$$GET1^DIQ(40.8,ACKDIV_",",.01,"E"))
|
---|
125 | W ! D CNTR^ACKQUTL($$XDAT^ACKQUTL(ACKM))
|
---|
126 | W !
|
---|
127 | Q
|
---|
128 | HD4 ; Header for CDR statistics.
|
---|
129 | N X
|
---|
130 | W !?5,"CDR ACCOUNT",?63,"% WORKLOAD"
|
---|
131 | D LINE
|
---|
132 | Q
|
---|
133 | LINE S X="",$P(X,"-",IOM)="-" W !,X
|
---|
134 | Q
|
---|
135 | CHKDIV ; Check the CDR has been generated for one Division for the month
|
---|
136 | N ACKERR S ACKERR=0
|
---|
137 | S ACKDIV="" F S ACKDIV=$O(ACKDIV(ACKDIV)) Q:ACKDIV="" D
|
---|
138 | . I '$$DIVCDR(ACKDA,ACKDIV) D
|
---|
139 | . . S ACKERR=ACKERR+1,ACKERR(ACKERR)=ACKDIV
|
---|
140 | . . K ACKDIV(ACKDIV)
|
---|
141 | ;
|
---|
142 | ; none left to be printed
|
---|
143 | I $O(ACKDIV(""))="" D S ACKEXIT=1 D:$E(IOST)="C" PAUSE^ACKQUTL Q
|
---|
144 | . W !!,"The CDR has not been generated for "_$$XDAT^ACKQUTL(ACKM)
|
---|
145 | . W " for any of the selected",!,"Divisions",!!
|
---|
146 | ;
|
---|
147 | ; at least one error
|
---|
148 | I ACKERR D
|
---|
149 | . W !!,"The CDR has not been generated for "_$$XDAT^ACKQUTL(ACKM)
|
---|
150 | . W " for the following Division"_$S(ACKERR>1:"s",1:"")
|
---|
151 | . F I=1:1:ACKERR W !?5,$$GET1^DIQ(40.8,ACKERR(I)_",",.01,"E")
|
---|
152 | ;
|
---|
153 | ; now list the Divisions that will be printed
|
---|
154 | W !!,"The CDR for "_$$XDAT^ACKQUTL(ACKM)_" will now print for the following Division"
|
---|
155 | W $S($O(ACKDIV(""))=$O(ACKDIV(""),-1):"",1:"s")
|
---|
156 | S ACKDIV="" F S ACKDIV=$O(ACKDIV(ACKDIV)) Q:ACKDIV="" D
|
---|
157 | . W !?5,$$GET1^DIQ(40.8,ACKDIV_",",.01,"E")
|
---|
158 | ;
|
---|
159 | ; End
|
---|
160 | Q
|
---|
161 | CHKSITE ; Check the CDR has been generated for the selected month
|
---|
162 | I '$$SITECDR(ACKDA) D
|
---|
163 | . W !!,"The CDR has not been generated for "_$$XDAT^ACKQUTL(ACKM)_".",!
|
---|
164 | . S ACKEXIT=1
|
---|
165 | Q
|
---|
166 | GETDT ; Select month for report.
|
---|
167 | N DIR,X,Y
|
---|
168 | GDT1 K DIR
|
---|
169 | S DIR(0)="D^::APE",DIR("A")="Select Month & Year"
|
---|
170 | S DIR("B")=$$XDAT^ACKQUTL($$LM(DT)),DIR("?")="^D HELP^%DTC"
|
---|
171 | S DIR("??")="^D DATHLP^ACKQCDRP"
|
---|
172 | D ^DIR
|
---|
173 | I Y?1"^"1.E W !,"Jumping not allowed.",! G GDT1
|
---|
174 | Q:$D(DIRUT)
|
---|
175 | S ACKM=$E(Y,1,5)_"00"
|
---|
176 | I ACKM>DT W !,"Can't run Cost Distribution Report for future months!",! G GDT1
|
---|
177 | Q
|
---|
178 | DATHLP ; Extended help - select month for CDR report.
|
---|
179 | W !?5,"Enter a date, in the past, for which you wish to"
|
---|
180 | W !?5,"print the Cost Distribution Report."
|
---|
181 | Q
|
---|
182 | LM(X) ;Find month previous to X.
|
---|
183 | N M,D,Y S M=$E(X,4,5),D=$E(X,6,7),Y=$E(X,1,3),M=M-1
|
---|
184 | S:M<1 M=12,Y=Y-1 S:M<10 M="0"_M
|
---|
185 | Q Y_M_"00"
|
---|
186 | DIVCDR(ACKDA,ACKDIV) ; check if CDR generated for ACKDA (month) and ACKDIV
|
---|
187 | N ACKTGT,ACKMSG,ACKFRM
|
---|
188 | D LIST^DIC(509850.754,","_ACKDIV_","_ACKDA_",","","",1,.ACKFRM,"","","","","ACKTGT","ACKMSG")
|
---|
189 | Q $P(ACKTGT("DILIST",0),U,1)=1
|
---|
190 | SITECDR(ACKDA) ; check is CDR generated for ACKDA (month) for the site
|
---|
191 | N ACKTGT,ACKMSG,ACKFRM
|
---|
192 | D LIST^DIC(509850.74,","_ACKDA_",","","",1,.ACKFRM,"","","","","ACKTGT","ACKMSG")
|
---|
193 | Q $P(ACKTGT("DILIST",0),U,1)=1
|
---|