source: FOIAVistA/trunk/r/QUASAR-ACKQ/ACKQR3.m@ 707

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

initial load of FOIAVistA 6/30/08 version
File size: 9.3 KB
Line 
1ACKQR3 ;AUG/JLTP BIR/PTD HCIOFO/AG-Visits by Diagnosis ; [ 03/27/99 10:02 AM ]
2 ;;3.0;QUASAR;**8**;Feb 11, 2000
3 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
4 ;
5OPTN ;Introduce option.
6 W @IOF,!,"This option produces a report listing clinic visits for a date range"
7 W !,"sorted by ICD-9CM diagnostic codes.",!
8 ;
9 ; get division
10 S ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI") G:+ACKDIV=0 EXIT
11 ; get date range
12 D DTRANGE^ACKQRU G:$D(DIRUT) EXIT
13 S ACKRDR="Visits from "_ACKXBD_" to "_ACKXED
14 ;
15 ; determine the type of report
16 ; returns ACKASB="A","S" or "B"
17 ; ACKSS=1-6 (1=one clinician etc.)
18 ; ACKSTF(x) selected staff members
19 D PARAMS^ACKQRU G:$D(DIRUT) EXIT
20 ;
21DEV ; get device
22 W !!,"The right margin for this report is 80."
23 W !,"You can queue it to run at a later time.",!
24 K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS
25 I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G EXIT
26 ; queue selected
27 I $D(IO("Q")) D G EXIT
28 . K IO("Q")
29 . S ZTRTN="DQ^ACKQR3",ZTDESC="QUASAR - A&SP VISITS BY DIAGNOSIS"
30 . S ZTSAVE("ACK*")="" D ^%ZTLOAD D HOME^%ZIS K ZTSK
31 ;
32DQ ;Entry point when queued.
33 ; variables required at this point are:-
34 ; ACKDIV() - selected divisions
35 ; ACKBD,ACKXBD - beginning of date range (internal,external)
36 ; ACKED,ACKXED - end of date range (internal,external)
37 ; ACKASB - A=audio,S=speech,B=both
38 ; ACKSS - type of report (1=one clinicians etc)
39 ; ACKSTF() - selected clinicians
40 U IO
41 D NOW^%DTC S ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%),ACKPG=0
42 K ^TMP("ACKQR3",$J),ACKT,ACKT2 S ACKT=0,ACKT2=0
43 ; walk down the visits using the date index
44 S ACKD=ACKBD F S ACKD=$O(^ACK(509850.6,"B",ACKD)) Q:'ACKD!(ACKD>ACKED) D
45 . S ACKV=0 F S ACKV=$O(^ACK(509850.6,"B",ACKD,ACKV)) Q:'ACKV D STORE
46 D PRINT
47 ;
48EXIT ;ALWAYS EXIT HERE
49 K ACK2,ACKASB,ACKBD,ACKC,ACKCDT,ACKCL,ACKCLI,ACKCLN,ACKCLNC,ACKCPT
50 K ACKSORT,ACKD,ACKED,ACKHDR2,ACKI,ACKLINE,ACKLR,ACKOOP,ACKP,ACKPC
51 K ACKPCP,ACKPG,ACKRDR,ACKSS,ACKSTAFF,ACKSTF,ACKT,ACKV,ACKVSC,ACKXBD
52 K ACKXED,ACKT2,ACKCT,ACKDIVX,ACKOK,ACKHDR,ACKDIV,ACKHDR5,ACKVDIV
53 K ACKSORT,ACKICDN,ACKTMP,ACKICD9,ACKTXT
54 K %DT,%I,%ZIS,%T,DIRUT,DTOUT,DUOUT,I,JJ,SS,X,Y,ZTDESC,ZTIO,ZTRTN
55 K ZTSAVE,ZTSK,^TMP("ACKQR3",$J)
56 W:$E(IOST)="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
57 Q
58STORE ;
59 S ACKHDR=^ACK(509850.6,ACKV,0)
60 S ACKHDR5=^ACK(509850.6,ACKV,5)
61 ; get Division and make sure it was selected
62 S ACKVDIV=+$P(ACKHDR5,U,1)
63 I '$D(ACKDIV(ACKVDIV)) Q
64 ;
65 S ACKCLNC=+$P(ACKHDR,U,6) ;clinic IEN
66 S ACK2=$G(^ACK(509850.6,ACKV,2))
67 S ACKVSC=$P(ACK2,U) ; visit stop code
68 ; determine sort value for visit stop code (will return zero
69 ; if the visit is not to be included in the report)
70 S ACKSORT=$$STOPSORT^ACKQRU(ACKASB,ACKVSC) Q:'ACKSORT
71 ; check that the staff member for the visit was selected for this report
72 I (ACKSS=3)!(ACKSS=6) S ACKLR=$P(ACK2,U,4) ; student
73 I ACKSS'=3,ACKSS'=6 S ACKLR=$$LEADROLE^ACKQUTL2(ACKV) ; determine lead role
74 Q:$S(ACKCLNC=0:1,ACKLR="":1,1:0)
75 Q:'$D(ACKSTF(ACKLR))
76 ; count the Diagnosis codes for the visit
77 S ACKP=0 F S ACKP=$O(^ACK(509850.6,ACKV,1,ACKP)) Q:'ACKP D
78 . S ACKICDN=$$GET1^DIQ(509850.63,ACKP_","_ACKV_",",.01,"I","","")
79 . I '$D(^TMP("ACKQR3",$J,"ICD9",1,80,ACKICDN_",")) D GETDIAG(ACKICDN)
80 . S X=^TMP("ACKQR3",$J,"ICD9",1,80,ACKICDN_",",.01)
81 . I X="" Q
82 . ; add to count of Diagnosis codes for staff member
83 . S ACKCT=+$G(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,X))
84 . S ^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,X)=ACKCT+1
85 . ; add to count of Diagnosis codes for the stop code within the division
86 . S ^TMP("ACKQR3",$J,0,ACKVDIV,ACKSORT,X)=$G(^TMP("ACKQR3",$J,0,ACKVDIV,ACKSORT,X))+1
87 . ; add to count of Diagnosis codes totals for all divisions
88 . S ^TMP("ACKQR3",$J,2,ACKSORT,X)=$G(^TMP("ACKQR3",$J,2,ACKSORT,X))+1
89 . ; add to the total count for the stop code, division, and the grand total
90 . S ACKT(ACKVDIV,ACKSORT)=$G(ACKT(ACKVDIV,ACKSORT))+1
91 . S ACKT(ACKVDIV)=$G(ACKT(ACKVDIV))+1
92 . S ACKT2(ACKSORT)=$G(ACKT2(ACKSORT))+1,ACKT2=$G(ACKT2)+1
93 Q
94GETDIAG(ACKICDN) ; get Diagnosis data and place in ^TMP
95 N ACKTMP,ACKMSG,ACKICD9,ACKQDTXT
96 S ACKTMP=$NA(^TMP("ACKQR3",$J,"ICD9",1))
97 D GETS^DIQ(80,ACKICDN_",",".01","",ACKTMP,"ACKMSG")
98 S ACKICD9=^TMP("ACKQR3",$J,"ICD9",1,80,ACKICDN_",",.01)
99 S ACKQDTXT=$$DIAGTXT^ACKQUTL8(ACKICDN,"")
100 S ^TMP("ACKQR3",$J,"ICD9",1,80,ACKICDN_",",3)=ACKQDTXT
101 S ^TMP("ACKQR3",$J,"ICD9",2,ACKICD9)=ACKICDN
102 Q
103ICDDESC(ACKICD9) ; get the description of an ICD9 from the ^TMP file
104 N ACKICDN S ACKICDN=^TMP("ACKQR3",$J,"ICD9",2,ACKICD9)
105 Q ^TMP("ACKQR3",$J,"ICD9",1,80,ACKICDN_",",3)
106 ;
107PRINT ; print the report for each Division
108 S ACKVDIV=""
109 I '$D(^TMP("ACKQR3",$J,1)) D Q
110 . D HDR
111 . W !!,"No data found for report specifications.",!!
112 . D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
113 F S ACKVDIV=$O(ACKDIV(ACKVDIV)) Q:ACKVDIV="" D PRINT2 Q:$D(DIRUT)
114 I '$D(DIRUT) D TOTALS
115 Q
116PRINT2 ; print for a single division
117 I '$D(^TMP("ACKQR3",$J,1,ACKVDIV)) D Q
118 . D HDR W !!,"No data found for report specifications.",!!
119 . D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
120 D HDR
121 S ACKSORT=""
122 F S ACKSORT=$O(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT)) Q:ACKSORT=""!($D(DIRUT)) D
123 .I $Y>(IOSL-9) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
124 .W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
125 .S ACKCLN=""
126 .F S ACKCLN=$O(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLN)) Q:ACKCLN=""!($D(DIRUT)) D
127 ..I $Y>(IOSL-7) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
128 ..W !!?2,"CLINIC: ",$$GET1^DIQ(44,ACKCLN_",",.01)
129 ..S ACKSTF=""
130 ..F S ACKSTF=$O(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF)) Q:ACKSTF=""!($D(DIRUT)) D
131 ...I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
132 ...W !!?2,$S("1^4"[ACKSS:"CLINICIAN: ","2^5"[ACKSS:"OTHER PROVIDER: ",1:"STUDENT: ")
133 ...W $$CONVERT^ACKQUTL4(ACKSTF)
134 ...S ACKPC=""
135 ...F S ACKPC=$O(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC)) Q:ACKPC=""!($D(DIRUT)) D
136 ....I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
137 ....W !?5,ACKPC,?15,$$ICDDESC(ACKPC),?55,"COUNT: "
138 ....W $J(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC),4)
139 Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
140SUMM ;
141 Q:'$D(^TMP("ACKQR3",$J,0)) D SUMHD
142 S ACKSORT=""
143 F S ACKSORT=$O(^TMP("ACKQR3",$J,0,ACKVDIV,ACKSORT)) Q:ACKSORT=""!($D(DIRUT)) D
144 .I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
145 .W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
146 .S ACKPC=""
147 .F S ACKPC=$O(^TMP("ACKQR3",$J,0,ACKVDIV,ACKSORT,ACKPC)) Q:ACKPC=""!($D(DIRUT)) D
148 ..I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
149 ..W !?5,ACKPC,?15,$$ICDDESC(ACKPC),?55,"COUNT: "
150 ..W $J(^TMP("ACKQR3",$J,0,ACKVDIV,ACKSORT,ACKPC),4)
151 .I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
152 .Q:$D(DIRUT)
153 .W !!,"Total For ",$$STOPNM^ACKQRU(ACKSORT)
154 .W ?62,$J(ACKT(ACKVDIV,ACKSORT),4)
155 I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
156 Q:$D(DIRUT) W !!,"Total For Division: "_$$DIVNAME(ACKVDIV),?62,$J(ACKT(ACKVDIV),4)
157 Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
158 Q
159TOTALS ; print the final page of totals for all divisions
160 Q:'$D(^TMP("ACKQR3",$J,2))
161 I $O(ACKT(""))=$O(ACKT(""),-1) Q ; there must be only one division!
162 D TOTLHD S ACKTXT="DIVISIONS: "
163 S ACKVDIV="" F S ACKVDIV=$O(ACKT(ACKVDIV)) Q:ACKVDIV="" D Q:$D(DIRUT)
164 . I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
165 . W !,ACKTXT,?12,$$DIVNAME(ACKVDIV) S ACKTXT=""
166 S ACKSORT=""
167 F S ACKSORT=$O(^TMP("ACKQR3",$J,2,ACKSORT)) Q:ACKSORT=""!($D(DIRUT)) D
168 .I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
169 .W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
170 .S ACKPC=""
171 .F S ACKPC=$O(^TMP("ACKQR3",$J,2,ACKSORT,ACKPC)) Q:ACKPC=""!($D(DIRUT)) D
172 ..I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
173 ..W !?5,ACKPC,?15,$$ICDDESC(ACKPC),?55,"COUNT: "
174 ..W $J(^TMP("ACKQR3",$J,2,ACKSORT,ACKPC),4)
175 .I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
176 .Q:$D(DIRUT)
177 .W !!,"Total For ",$$STOPNM^ACKQRU(ACKSORT)
178 .W ?62,$J(ACKT2(ACKSORT),4)
179 I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
180 Q:$D(DIRUT) W !!,"Grand Total:",?62,$J(ACKT2,4)
181 Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
182 Q
183HDR ;
184 W:($E(IOST)="C")!(ACKPG>0) @IOF
185 S ACKPG=ACKPG+1
186 W "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
187 W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
188 W ! D CNTR^ACKQUTL("Diagnostic Code Statistics")
189 W ! D CNTR^ACKQUTL("for")
190 I ACKSS<4 S X=$$STAFFNM($O(ACKSTF(0))) W ! D CNTR^ACKQUTL(X)
191 I ACKSS=4 W ! D CNTR^ACKQUTL("All Clinicians")
192 I ACKSS=5 W ! D CNTR^ACKQUTL("All Other Providers")
193 I ACKSS=6 W ! D CNTR^ACKQUTL("All Students")
194 W ! D CNTR^ACKQUTL("Covering "_ACKRDR)
195 I ACKVDIV]"" W ! D CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
196 S X="",$P(X,"-",IOM)="-" W !,X
197 Q
198SUMHD ;
199 W:($E(IOST)="C")!(ACKPG>0) @IOF
200 S ACKPG=ACKPG+1
201 W "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
202 W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
203 W ! D CNTR^ACKQUTL("Diagnostic Code Statistics")
204 W ! D CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
205 W ! D CNTR^ACKQUTL("Summary")
206 S X="",$P(X,"-",IOM)="-" W !,X
207 Q
208TOTLHD ;
209 W:($E(IOST)="C")!(ACKPG>0) @IOF
210 S ACKPG=ACKPG+1
211 W "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
212 W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
213 W ! D CNTR^ACKQUTL("Diagnostic Code Statistics")
214 W ! D CNTR^ACKQUTL("Summary")
215 S X="",$P(X,"-",IOM)="-" W !,X
216 Q
217 ;
218DIVNAME(ACKVDIV) ; get division name
219 Q $$GET1^DIQ(40.8,ACKVDIV_",",.01)
220 ;
221STAFFNM(ACKSTF) ; get staff name
222 Q $$MIXC^ACKQUTL($$CONVERT^ACKQUTL4(ACKSTF))
223 ;
Note: See TracBrowser for help on using the repository browser.