1 | WVRPPCD1 ;HCIOFO/FT,JR-REPORT: PROCEDURE STATISTICS; ;7/24/01 13:55
|
---|
2 | ;;1.0;WOMEN'S HEALTH;**4,12**;Sep 30, 1998
|
---|
3 | ;; Original routine created by IHS/ANMC/MWR
|
---|
4 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
---|
5 | ;; DISPLAY CODE FOR PROCEDURE STATISTICS REPORT. CALLED BY WVRPPCD.
|
---|
6 | ;
|
---|
7 | ; This routine uses the following IAs:
|
---|
8 | ; <NONE>
|
---|
9 | ;
|
---|
10 | DISPLAY ;EP
|
---|
11 | ;---> WVTITLE=TITLE AT TOP OF DISPLAY HEADER.
|
---|
12 | ;---> WVSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
|
---|
13 | ;---> WVCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
|
---|
14 | ;
|
---|
15 | U IO
|
---|
16 | W:$E(IOST)="C" @IOF
|
---|
17 | S WVTITLE="* * * WOMEN'S HEALTH: PROCEDURE STATISTICS REPORT * * *"
|
---|
18 | D CENTERT^WVUTL5(.WVTITLE)
|
---|
19 | S WVSUBH="SUBHEAD^WVRPPCD1"
|
---|
20 | D TOPHEAD^WVUTL7
|
---|
21 | S (WVPOP,N)=0
|
---|
22 | ;
|
---|
23 | DISPLAY1 ;EP
|
---|
24 | N WVFAC,WVSB1
|
---|
25 | S FE="",WVFAC=0
|
---|
26 | F S FE=$O(^TMP("WVAR",$J,FE)) Q:FE=""!(WVPOP)!($G(ZTSTOP)=1) S FI=0 F S FI=$O(^TMP("WVAR",$J,FE,FI)) Q:'FI!(WVPOP)!($G(ZTSTOP)=1) D
|
---|
27 | .I WVFAC'=FI D:WVCRT&(WVFAC) DIRZ^WVUTL3 Q:WVPOP S WVFAC=FI D HEADER3 Q:$G(ZTSTOP)=1
|
---|
28 | .S N=0 F S N=$O(^TMP("WVAR",$J,FE,FI,N)) Q:N=""!(WVPOP) D
|
---|
29 | ..I $Y+12>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D Q:$G(ZTSTOP)=1
|
---|
30 | ...S WVPAGE=WVPAGE+1
|
---|
31 | ...D HEADER3 Q:$G(ZTSTOP)=1
|
---|
32 | ..S Y=^TMP("WVAR",$J,FE,FI,N)
|
---|
33 | ..S WVARJ=$S($P(Y,U)["MAMMOGRAM":1,$P(Y,U)["ULTRASOUND":1,1:0)
|
---|
34 | ..S WVAGRP=$$WVAGRP($P(Y,U,16))
|
---|
35 | ..;---> QUIT IF DISPLAYING "ALL AGES" ONLY (NOT GROUPED BY AGE).
|
---|
36 | ..Q:WVAGRP=1
|
---|
37 | ..S WVPCD="< "_$P(Y,U)_": "_WVAGRP_" >",WVPCDL=$L(WVPCD)
|
---|
38 | ..S X=$E(WVLINE,1,31-(WVPCDL/2))
|
---|
39 | ..W !!?2,X,WVPCD,X
|
---|
40 | ..I WVARJ W !?68," CREDIT"
|
---|
41 | ..W !?28,"COUNT",?43,"VETS",?56,"NON-VETS"
|
---|
42 | ..I WVARJ W ?66," REG. NO CR"
|
---|
43 | ..W !?26,"----------",?40,"----------",?55,"----------"
|
---|
44 | ..I WVARJ W ?67,"----- -----"
|
---|
45 | ..D VERTICAL
|
---|
46 | ..Q
|
---|
47 | .Q
|
---|
48 | I WVPOP!($G(ZTSTOP)=1) D ^%ZISC Q
|
---|
49 | D FACLIST^WVRPPCD3
|
---|
50 | N WVNAME,WVIEN,WVCNT,WVCNT1
|
---|
51 | S WVNAME="",WVCNT=0
|
---|
52 | F S WVNAME=$O(WVSB1(WVNAME)) Q:WVNAME="" D
|
---|
53 | .S WVIEN=0
|
---|
54 | .F S WVIEN=$O(WVSB1(WVNAME,WVIEN)) Q:'WVIEN D
|
---|
55 | ..Q:$D(^TMP("WVAR",$J,WVNAME,WVIEN))
|
---|
56 | ..S WVCNT=WVCNT+1
|
---|
57 | ..Q
|
---|
58 | .Q
|
---|
59 | I WVCNT=0 G JUMP2
|
---|
60 | I '$D(^TMP("WVAR",$J)) G JUMP1
|
---|
61 | I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3 D Q:WVPOP
|
---|
62 | .D:WVPOP ^%ZISC
|
---|
63 | .Q
|
---|
64 | JUMP1 ;
|
---|
65 | S WVNAME="",WVCNT1=0
|
---|
66 | F S WVNAME=$O(WVSB1(WVNAME)) Q:WVNAME=""!(WVPOP)!($G(ZTSTOP)=1) D
|
---|
67 | .S WVIEN=0
|
---|
68 | .F S WVIEN=$O(WVSB1(WVNAME,WVIEN)) Q:'WVIEN!(WVPOP)!($G(ZTSTOP)=1) D
|
---|
69 | ..Q:$D(^TMP("WVAR",$J,WVNAME,WVIEN))
|
---|
70 | ..S WVCNT1=WVCNT1+1,WVPAGE=1
|
---|
71 | ..D HEADER4
|
---|
72 | ..Q:$G(ZTSTOP)=1
|
---|
73 | ..Q:WVCNT=WVCNT1
|
---|
74 | ..I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3
|
---|
75 | ..Q
|
---|
76 | .Q
|
---|
77 | JUMP2 ;
|
---|
78 | I WVPOP!($G(ZTSTOP)=1) D ^%ZISC Q
|
---|
79 | I $O(^TMP("WVNOHCF",$J,0))'>0 D ENDREP^WVUTL7() Q
|
---|
80 | I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3 D Q:WVPOP
|
---|
81 | .D:WVPOP ^%ZISC
|
---|
82 | .Q
|
---|
83 | JUMP3 ;
|
---|
84 | D NOFAC^WVRPPCD3 ;records with no facility
|
---|
85 | D ENDREP^WVUTL7()
|
---|
86 | Q
|
---|
87 | ;
|
---|
88 | VERTICAL ;EP
|
---|
89 | ;---> DISPLAY IN VERTICAL FORMAT.
|
---|
90 | F X=1:1:24 S:$P(Y,U,X)="" $P(Y,U,X)=0
|
---|
91 | F X=25:1:40 S:$P(Y,U,X)'>0 $P(Y,U,X)=""
|
---|
92 | D PG
|
---|
93 | W !?14,$S($P(Y,U)="PREGNANCY TEST":"NOT PREG",1:"NORMAL:")
|
---|
94 | W ?24,$J($P(Y,U,4),5),?30,"(",$J($P(Y,U,5),3),"%)"
|
---|
95 | W ?38,$J($P(Y,U,17),5),?44,PG(1),?47,$J($P(Y,U,4)-$P(Y,U,17),8)
|
---|
96 | W ?59,PG(2)
|
---|
97 | I WVARJ W ?64,$J($P(Y,U,25),5),?72,$J($P(Y,U,33),5)
|
---|
98 | W !?2,"PROCEDURES"
|
---|
99 | W ?14,$S($P(Y,U)="PREGNANCY TEST":"PREGNANT:",1:"ABNORMAL:")
|
---|
100 | W ?24,$J($P(Y,U,8),5),?30,"(",$J($P(Y,U,9),3),"%)"
|
---|
101 | W ?38,$J($P(Y,U,19),5),?44,PG(3),?47,$J($P(Y,U,8)-$P(Y,U,19),8)
|
---|
102 | W ?59,PG(4)
|
---|
103 | I WVARJ W ?64,$J($P(Y,U,27),5),?72,$J($P(Y,U,35),5)
|
---|
104 | W !?14,"NO RESULT:",?24,$J($P(Y,U,12),5),?30,"(",$J($P(Y,U,13),3),"%)"
|
---|
105 | W ?38,$J($P(Y,U,21),5),?44,PG(5),?47,$J($P(Y,U,12)-$P(Y,U,21),8)
|
---|
106 | W ?59,PG(6)
|
---|
107 | I WVARJ W ?64,$J($P(Y,U,29),5),?72,$J($P(Y,U,37),5)
|
---|
108 | W !?14,"TOTAL:",?24,$J($P(Y,U,15),5),?38,$J($P(Y,U,23),5)
|
---|
109 | W ?44,PG(7),?47,$J($P(Y,U,15)-$P(Y,U,23),8)
|
---|
110 | W ?59,PG(8)
|
---|
111 | I WVARJ W ?64,$J($P(Y,U,31),5),?72,$J($P(Y,U,39),5)
|
---|
112 | W !!?14,$S($P(Y,U)="PREGNANCY TEST":"NOT PREG:",1:"NORMAL:")
|
---|
113 | W ?24,$J($P(Y,U,2),5),?30,"(",$J($P(Y,U,3),3),"%)"
|
---|
114 | W ?38,$J($P(Y,U,18),5),?44,PG(9),?47,$J($P(Y,U,2)-$P(Y,U,18),8)
|
---|
115 | W ?59,PG(10)
|
---|
116 | I WVARJ W ?64,$J($P(Y,U,26),5),?72,$J($P(Y,U,34),5)
|
---|
117 | W !?2,"PATIENTS"
|
---|
118 | W ?14,$S($P(Y,U)="PREGNANCY TEST":"PREGNANT:",1:"ABNORMAL:")
|
---|
119 | W ?24,$J($P(Y,U,6),5),?30,"(",$J($P(Y,U,7),3),"%)"
|
---|
120 | W ?38,$J($P(Y,U,20),5),?44,PG(11),?47,$J($P(Y,U,6)-$P(Y,U,20),8)
|
---|
121 | W ?59,PG(12)
|
---|
122 | I WVARJ W ?64,$J($P(Y,U,28),5),?72,$J($P(Y,U,36),5)
|
---|
123 | W !?14,"NO RESULT:",?24,$J($P(Y,U,10),5),?30,"(",$J($P(Y,U,11),3),"%)"
|
---|
124 | W ?38,$J($P(Y,U,22),5),?44,PG(13),?47,$J($P(Y,U,10)-$P(Y,U,22),8)
|
---|
125 | W ?59,PG(14)
|
---|
126 | I WVARJ W ?64,$J($P(Y,U,30),5),?72,$J($P(Y,U,38),5)
|
---|
127 | W !?14,"TOTAL:",?24,$J($P(Y,U,14),5),?38,$J($P(Y,U,24),5)
|
---|
128 | W ?44,PG(15),?47,$J($P(Y,U,14)-$P(Y,U,24),8)
|
---|
129 | W ?59,PG(16)
|
---|
130 | I WVARJ W ?64,$J($P(Y,U,32),5),?72,$J($P(Y,U,40),5)
|
---|
131 | Q
|
---|
132 | PG ;FIGURES %'S FOR VETS & NON VETS
|
---|
133 | F JC=1:1:25 S PG(JC)=0
|
---|
134 | I $P(Y,U,4)'=0 S PG(1)=100*$P(Y,U,17)/$P(Y,U,4)
|
---|
135 | I $P(Y,U,8)'=0 S PG(3)=100*$P(Y,U,19)/$P(Y,U,8)
|
---|
136 | I $P(Y,U,12)'=0 S PG(5)=100*$P(Y,U,21)/$P(Y,U,12)
|
---|
137 | I $P(Y,U,15)'=0 S PG(7)=100*$P(Y,U,23)/$P(Y,U,15)
|
---|
138 | I $P(Y,U,2)'=0 S PG(9)=100*$P(Y,U,18)/$P(Y,U,2)
|
---|
139 | I $P(Y,U,6)'=0 S PG(11)=100*$P(Y,U,20)/$P(Y,U,6)
|
---|
140 | I $P(Y,U,10)'=0 S PG(13)=100*$P(Y,U,22)/$P(Y,U,10)
|
---|
141 | I $P(Y,U,14)'=0 S PG(15)=100*$P(Y,U,24)/$P(Y,U,14) D T
|
---|
142 | S PG(2)=$S($P(Y,U,4)'=0:100-PG(1),1:0)
|
---|
143 | S PG(4)=$S($P(Y,U,8)'=0:100-PG(3),1:0)
|
---|
144 | S PG(6)=$S($P(Y,U,12)'=0:100-PG(5),1:0)
|
---|
145 | S PG(8)=$S($P(Y,U,15)'=0:100-PG(7),1:0)
|
---|
146 | S PG(10)=$S($P(Y,U,2)'=0:100-PG(9),1:0)
|
---|
147 | S PG(12)=$S($P(Y,U,6)'=0:100-PG(11),1:0)
|
---|
148 | S PG(14)=$S($P(Y,U,10)'=0:100-PG(13),1:0)
|
---|
149 | S PG(16)=$S($P(Y,U,14)'=0:100-PG(15),1:0)
|
---|
150 | ;PAD %'S WITH BLANKS
|
---|
151 | F JC=1:1:16 S PG(JC)=" "_PG(JC) D
|
---|
152 | .S PG(JC)=$E(PG(JC),$L(PG(JC))-2,$L(PG(JC)))
|
---|
153 | .S PG(JC)="("_PG(JC)_"%)"
|
---|
154 | Q
|
---|
155 | T ;ELIMINTE DECIMAL POINT IN %
|
---|
156 | N S F S=1,3,5,7,9,11,13,15 D
|
---|
157 | .S:$E($P(PG(S),".",2))'<.5 PG(S)=PG(S)+1 S PG(S)=$P(PG(S),".")
|
---|
158 | Q
|
---|
159 | ;
|
---|
160 | WVAGRP(AGE) ;EP
|
---|
161 | ;Q:AGE="ALL" "All ages"
|
---|
162 | Q:AGE="ALL" $S(WVAGRP'=1:"Total for selected ages",1:"All ages")
|
---|
163 | Q:AGE=1 1
|
---|
164 | N I,X,Y,Z S X=WVAGRG
|
---|
165 | F I=1:1:$L(X,",") S Y=$P($P(X,",",I),"-",2) Q:AGE'>Y
|
---|
166 | S Z=$P($P(X,",",I),"-")
|
---|
167 | Q:AGE<Z "Under "_Y_" yrs"
|
---|
168 | Q:AGE>Y "Over "_Y_" yrs"
|
---|
169 | Q $P(X,",",I)_" yrs"
|
---|
170 | ;---> PUT A FINAL CHECK IN HERE?? *COMEBACK
|
---|
171 | Q "Unknown age"
|
---|
172 | ;
|
---|
173 | ;
|
---|
174 | SUBHEAD ;EP
|
---|
175 | ;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.
|
---|
176 | W !?5,"NOTE: Patient numbers are not intended to total. "
|
---|
177 | W "Patients may be"
|
---|
178 | W !," included in more than one category.",!
|
---|
179 | W $$REPEAT^XLFSTR("=",80)
|
---|
180 | Q
|
---|
181 | HEADER3 ;EP
|
---|
182 | ;---> REQUIRED VARIABLES: WVBEGDT,WVCRT,WVENDDT,WVPAGE,WVTITLE,DUZ(2)
|
---|
183 | ;---> OPTIONAL VARIABLE: WVSUBH (SUBHEADER).
|
---|
184 | N X
|
---|
185 | W:$Y>0 @IOF
|
---|
186 | W !,WVTITLE,?70,"page: ",WVPAGE
|
---|
187 | W !,$$RUNDT^WVUTL1A("C")
|
---|
188 | W !!,"Facility: ",$$INSTTX^WVUTL6($S($G(WVFAC):WVFAC,1:DUZ(2)))
|
---|
189 | W ?53,"From: ",$$SLDT2^WVUTL5(WVBEGDT)
|
---|
190 | W " to ",$$SLDT2^WVUTL5(WVENDDT)
|
---|
191 | W !,$$REPEAT^XLFSTR("=",80)
|
---|
192 | I $D(WVSUBH) D @WVSUBH
|
---|
193 | I $D(ZTQUEUED) D STOPCHK^WVUTL10(1) Q:$G(ZTSTOP)=1
|
---|
194 | Q
|
---|
195 | HEADER4 ; Header and message for facilities without data
|
---|
196 | N X
|
---|
197 | W:$Y>0 @IOF
|
---|
198 | W !,WVTITLE,?70,"page: ",WVPAGE
|
---|
199 | W !,$$RUNDT^WVUTL1A("C")
|
---|
200 | W !!,"Facility: "_WVNAME
|
---|
201 | W ?53,"From: ",$$SLDT2^WVUTL5(WVBEGDT)
|
---|
202 | W " to ",$$SLDT2^WVUTL5(WVENDDT)
|
---|
203 | W !,$$REPEAT^XLFSTR("=",80)
|
---|
204 | I $D(ZTQUEUED) D STOPCHK^WVUTL10(1) Q:$G(ZTSTOP)=1
|
---|
205 | W !!?5,"No records match the selected criteria for this facility.",!
|
---|
206 | Q
|
---|