source: FOIAVistA/tag/r/QUASAR-ACKQ/ACKQCDRP.m@ 634

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

initial load of FOIAVistA 6/30/08 version

File size: 7.1 KB
Line 
1ACKQCDRP ;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 ;
14OPTN ;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 ;
36DEV ; 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 ;
47DQ ;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 ;
58EXIT ; 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 ;
66COMPS ; 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 ;
82COMPD ; 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 ;
98PRINT ; 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
103CDR ; 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 ;
116DHD ;
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
128HD4 ; Header for CDR statistics.
129 N X
130 W !?5,"CDR ACCOUNT",?63,"% WORKLOAD"
131 D LINE
132 Q
133LINE S X="",$P(X,"-",IOM)="-" W !,X
134 Q
135CHKDIV ; 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
161CHKSITE ; 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
166GETDT ; Select month for report.
167 N DIR,X,Y
168GDT1 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
178DATHLP ; 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
182LM(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"
186DIVCDR(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
190SITECDR(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
Note: See TracBrowser for help on using the repository browser.