source: WorldVistAEHR/trunk/r/QUASAR-ACKQ/ACKQR1.m@ 691

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

initial load of WorldVistAEHR
File size: 7.4 KB
RevLine 
[613]1ACKQR1 ;AUG/JLTP,AEM BIR/PTD HCIOFO/AG -Patients by City [ 12/07/95 9:52 AM ]
2 ;;3.0;QUASAR;;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 generates a patient count report for a selected date range."
7 W !,"The report shows the number of patients seen, sorted by city of residence.",!
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 ;
16DEV W !!,"The right margin for this report is 80."
17 W !,"You can queue it to run at a later time.",!
18 K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS
19 I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G EXIT
20 ; queue selected
21 I $D(IO("Q")) D G EXIT
22 . K IO("Q")
23 . S ZTRTN="DQ^ACKQR1",ZTDESC="QUASAR - A&SP PATIENTS BY CITY"
24 . S ZTSAVE("ACK*")="" D ^%ZTLOAD D HOME^%ZIS K ZTSK
25 ;
26DQ ;Entry point when queued.
27 ; variables required at this point are:-
28 ; ACKDIV() - selected divisions
29 ; ACKBD,ACKXBD - beginning of date range (internal,external)
30 ; ACKED,ACKXED - end of date range (internal,external)
31 ;
32 U IO
33 S ACKLINE="",$P(ACKLINE,"-",IOM)="-"
34 D NOW^%DTC S ACKXDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%)
35 K ^TMP("ACKQR1",$J)
36 ; walk down the visits using the date index
37 S ACKD=ACKBD F S ACKD=$O(^ACK(509850.6,"B",ACKD)) Q:'ACKD!(ACKD>ACKED) D
38 . S ACKV=0 F S ACKV=$O(^ACK(509850.6,"B",ACKD,ACKV)) Q:'ACKV D STORE
39 D PRINT
40 ;
41EXIT ;ALWAYS EXIT HERE
42 K %DT,%T,%ZIS,ACKBD,ACKCL,ACKCSC,ACKCTY,ACKD,ACKED,ACKI
43 K ACKLINE,ACKPG,ACKRDR,ACKST,ACKTOT,ACKUNIQ,ACKV,ACKX,ACKXBD
44 K ACKXDT,ACKXED,DFN,ACKDIV,ACKHDR,ACK2,ACKHDR5,ACKVDIV,ACKVSC
45 K ACKSORT,ACKCT,ACKNEW,ACKTXT
46 K DIRUT,DTOUT,DUOUT,VA,VAERR,VAPA,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE
47 K ZTSK,^TMP("ACKQR1",$J)
48 W:$E(IOST)="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
49 Q
50STORE ;
51 S ACKHDR=^ACK(509850.6,ACKV,0),ACK2=$G(^ACK(509850.6,ACKV,2))
52 S ACKHDR5=^ACK(509850.6,ACKV,5)
53 ; get division and check against selected divisions
54 S ACKVDIV=$P(ACKHDR5,U,1)
55 I '$D(ACKDIV(ACKVDIV)) Q
56 ; get visit stop code
57 S ACKVSC=$P(ACK2,U,1)
58 ; get sort value for visit stop
59 S ACKSORT=$$STOPSORT^ACKQRU("B",ACKVSC)
60 ; get patient data
61 S DFN=+$P(ACKHDR,U,2)
62 D ADD^VADPT
63 S ACKCTY=VAPA(4)
64 S ACKST=$$STATEABR(+VAPA(5))
65 Q:ACKCTY=""!(ACKST="")
66 ; get visit clinic
67 S ACKCL=$P(ACKHDR,U,6)
68 ;
69 ; add to temp file counts
70 ;
71 ; add to totals for city,state for the division
72 I '$D(^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY,DFN)) D
73 . S ACKCT=+$G(^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY))
74 . S ^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY)=ACKCT+1
75 . S ^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY,DFN)=""
76 ;
77 ; add to totals for for the stop code in the division
78 I '$D(^TMP("ACKQR1",$J,2,ACKVDIV,ACKSORT,DFN)) D
79 . S ACKCT=+$G(^TMP("ACKQR1",$J,2,ACKVDIV,ACKSORT))
80 . S ^TMP("ACKQR1",$J,2,ACKVDIV,ACKSORT)=ACKCT+1
81 . S ^TMP("ACKQR1",$J,2,ACKVDIV,ACKSORT,DFN)=""
82 ;
83 ; add to totals for the city,state across all divisions
84 I '$D(^TMP("ACKQR1",$J,3,ACKSORT,ACKST,ACKCTY,DFN)) D
85 . S ACKCT=+$G(^TMP("ACKQR1",$J,3,ACKSORT,ACKST,ACKCTY))
86 . S ^TMP("ACKQR1",$J,3,ACKSORT,ACKST,ACKCTY)=ACKCT+1
87 . S ^TMP("ACKQR1",$J,3,ACKSORT,ACKST,ACKCTY,DFN)=""
88 ;
89 ; add to totals for the stop code across all divisions
90 I '$D(^TMP("ACKQR1",$J,4,ACKSORT,DFN)) D
91 . S ACKCT=+$G(^TMP("ACKQR1",$J,4,ACKSORT))
92 . S ^TMP("ACKQR1",$J,4,ACKSORT)=ACKCT+1
93 . S ^TMP("ACKQR1",$J,4,ACKSORT,DFN)=""
94 ;
95 Q
96PRINT ;
97 S ACKPG=0,ACKVDIV=""
98 F S ACKVDIV=$O(ACKDIV(ACKVDIV)) Q:ACKVDIV="" D PRINT2 Q:$D(DIRUT)
99 I '$D(DIRUT) D TOTALS
100 Q
101PRINT2 ; print data for a single division
102 I '$D(^TMP("ACKQR1",$J,1,ACKVDIV)) D Q
103 . D HDR W !!,"No data found for report specifications.",!!
104 . I $E(IOST)="C" D PAUSE^ACKQUTL Q:$D(DIRUT)
105 D HDR
106 S ACKCL=""
107 F S ACKCL=$O(^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL)) Q:ACKCL=""!($D(DIRUT)) D
108 .I $Y>(IOSL-7) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
109 .W !!,"CLINIC: ",$$CLINICNM(ACKCL)
110 .S ACKSORT=""
111 .F S ACKSORT=$O(^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT)) Q:ACKSORT=""!($D(DIRUT)) D
112 ..I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
113 ..W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
114 ..S ACKST=""
115 ..F S ACKST=$O(^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST)) Q:ACKST=""!($D(DIRUT)) D
116 ...S ACKCTY=""
117 ...F S ACKCTY=$O(^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY)) Q:ACKCTY=""!($D(DIRUT)) D
118 ....S ACKUNIQ=^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY)
119 ....I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
120 ....W !,?5,ACKCTY_", "_ACKST,":",?35,$J(ACKUNIQ,5)," patient"_$S(ACKUNIQ=1:"",1:"s")
121SCTOTS ;
122 Q:'$D(^TMP("ACKQR1",$J,2))
123 S ACKNEW=0
124 I $Y>(IOSL-8) S ACKNEW=1 D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
125 W !
126 I 'ACKNEW W !,ACKLINE ; don't print this line if we've just thrown a page
127 W !,"STOP CODE TOTALS:",!
128 S ACKSORT=""
129 F S ACKSORT=$O(^TMP("ACKQR1",$J,2,ACKVDIV,ACKSORT)) Q:ACKSORT="" D
130 . W !,$$STOPNM^ACKQRU(ACKSORT)
131 . S ACKTOT=+$G(^TMP("ACKQR1",$J,2,ACKVDIV,ACKSORT))
132 . W ?35,$J(ACKTOT,5)," patient"_$S(ACKTOT=1:"",1:"s")
133 ;
134 Q:$D(DIRUT)
135 I $E(IOST)="C" D PAUSE^ACKQUTL Q:$D(DIRUT)
136 Q
137 ;
138TOTALS ; print the final page of totals across all divisions
139 Q:'$D(^TMP("ACKQR1",$J,3))
140 I $O(ACKDIV(""))=$O(ACKDIV(""),-1) Q ; there must be only one division
141 D TOTLHD S ACKTXT="DIVISIONS:"
142 S ACKVDIV="" F S ACKVDIV=$O(ACKDIV(ACKVDIV)) Q:ACKVDIV="" D Q:$D(DIRUT)
143 . I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
144 . W !,ACKTXT,?12,$$DIVNAME(ACKVDIV) S ACKTXT=""
145 S ACKSORT=""
146 F S ACKSORT=$O(^TMP("ACKQR1",$J,3,ACKSORT)) Q:ACKSORT="" D Q:$D(DIRUT)
147 . I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
148 . W !!,"STOP CODE:",$$STOPNM^ACKQRU(ACKSORT)
149 . S ACKST=""
150 . F S ACKST=$O(^TMP("ACKQR1",$J,3,ACKSORT,ACKST)) Q:ACKST="" D Q:$D(DIRUT)
151 . . S ACKCTY=""
152 . . F S ACKCTY=$O(^TMP("ACKQR1",$J,3,ACKSORT,ACKST,ACKCTY)) Q:ACKCTY="" D Q:$D(DIRUT)
153 . . . I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
154 . . . S ACKCT=^TMP("ACKQR1",$J,3,ACKSORT,ACKST,ACKCTY)
155 . . . W !?5,ACKCTY,", ",ACKST,":",?35,$J(ACKCT,5)," patient",$S(ACKCT=1:"",1:"s")
156 Q:'$D(^TMP("ACKQR1",$J,4))
157 S ACKNEW=0
158 I $Y>(IOSL-8) S ACKNEW=1 D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
159 W !
160 I 'ACKNEW W !,ACKLINE ; don't print this line if we've just thrown a page
161 W !,"STOP CODE TOTALS:",!
162 S ACKSORT=""
163 F S ACKSORT=$O(^TMP("ACKQR1",$J,4,ACKSORT)) Q:ACKSORT="" D
164 . W !,$$STOPNM^ACKQRU(ACKSORT),":"
165 . S ACKTOT=+$G(^TMP("ACKQR1",$J,4,ACKSORT))
166 . W ?35,$J(ACKTOT,5)," patient"_$S(ACKTOT=1:"",1:"s")
167 ;
168 Q:$D(DIRUT)
169 I $E(IOST)="C" D PAUSE^ACKQUTL Q:$D(DIRUT)
170 Q
171HDR ;
172 W:($E(IOST)="C")!(ACKPG>0) @IOF
173 S ACKPG=ACKPG+1
174 W "Printed: ",ACKXDT,?(IOM-8),"Page: ",ACKPG,!
175 W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
176 W ! D CNTR^ACKQUTL("Unique Patients by City")
177 W ! D CNTR^ACKQUTL(ACKRDR)
178 I ACKVDIV]"" W ! D CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
179 W !,ACKLINE
180 Q
181 ;
182TOTLHD ; print header for totals page
183 S ACKPG=ACKPG+1
184 W @IOF,"Printed: ",ACKXDT,?(IOM-8),"Page: ",ACKPG,!
185 W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
186 W ! D CNTR^ACKQUTL("Unique Patients by City")
187 W ! D CNTR^ACKQUTL(ACKRDR)
188 W ! D CNTR^ACKQUTL("Summary")
189 W !,ACKLINE
190 Q
191 ;
192DIVNAME(ACKVDIV) ; determine division name
193 Q $$GET1^DIQ(40.8,ACKVDIV_",",.01)
194 ;
195CLINICNM(ACKCL) ; determine clinic name
196 Q $$GET1^DIQ(44,ACKCL_",",.01)
197 ;
198STATEABR(ACKST) ; get State abbreviation
199 Q $$GET1^DIQ(5,ACKST_",",1)
200 ;
Note: See TracBrowser for help on using the repository browser.