source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVRPPCD2.m@ 767

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

initial load of WorldVistAEHR

File size: 7.7 KB
Line 
1WVRPPCD2 ;HCIOFO/FT,JR-REPORT: PROCEDURES STATISTICS; ;7/24/01 14:11
2 ;;1.0;WOMEN'S HEALTH;**12**;Sep 30, 1998
3 ;; Original routine created by IHS/ANMC/MWR
4 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
5 ;; COLLATING CODE CALLED BY WVRPPCD.
6 ;
7 ; This routine uses the following IAs:
8 ; <NONE>
9 ;
10SORT ;EP
11 ;---> SORT AND STORE LOCAL ARRAY IN ^TMP("WV",$J,1,
12 K ^TMP("WV",$J),WVRES,^TMP("WVX",$J),^TMP("WVNOHCF",$J)
13 I $D(ZTQUEUED) S ZTREQ="@"
14 ;---> WVBEGDT1=ONE SECOND BEFORE BEGIN DATE.
15 ;---> WVENDDT1=THE LAST SECOND OF END DATE.
16 N FE,FI,I,WVDFN,WVHCFN,WVHIEN,WVIEN,WVPCD,WVZSTOP,Y
17 S WVBEGDT1=WVBEGDT-.0001,WVENDDT1=WVENDDT+.9999
18 S WVDATE=WVBEGDT1,WVZSTOP=0
19 F S WVDATE=$O(^WV(790.1,"D",WVDATE)) Q:'WVDATE!(WVDATE>WVENDDT1)!($G(ZTSTOP)=1) D
20 .S WVIEN=0
21 .F S WVIEN=$O(^WV(790.1,"D",WVDATE,WVIEN)) Q:'WVIEN!($G(ZTSTOP)=1) D
22 ..S WVZSTOP=WVZSTOP+1
23 ..;If background task, then every 100 records check if user wants to
24 ..;stop the task.
25 ..I $D(ZTQUEUED),WVZSTOP#100=0 D STOPCHK^WVUTL10(0) Q:$G(ZTSTOP)=1
26 ..S Y=^WV(790.1,WVIEN,0)
27 ..;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
28 ..Q:$P(Y,U,5)=8
29 ..S WVDFN=$P(Y,U,2),WVPCD=$P(Y,U,4),WVHCF=$P(Y,U,10) ;patient ien, procedure ien, facility ien
30 ..I 'WVHCF S ^TMP("WVNOHCF",$J,WVIEN)="" Q ;no facility
31 ..S WVHCFN=$$FACNAME(WVHCF)
32 ..I WVHCFN="" S ^TMP("WVNOHCF",$J,WVIEN)="" Q ;no facility name
33 ..S WVAGE=$$WVAGE(WVDFN,$P(Y,U,12),WVAGRG)
34 ..;---> QUIT IF PATIENT'S AGE IS UNKNOWN OR OUTSIDE OF AGE RANGE.
35 ..Q:'WVAGE
36 ..;---> QUIT IF NOT SELECTING FOR ALL PROCEDURES AND IF THIS IS
37 ..;---> NOT ONE OF THE SELECTED PROCEDURES.
38 ..I '$D(WVARR("ALL")) Q:'$D(WVARR(WVPCD))
39 ..;---> Quit if Facility is not one selected by user
40 ..I '$D(WVSB("ALL")) Q:'$D(WVSB(WVHCF))
41 ..;---> FOR WVRES: 0=NORMAL, 1=ABNORMAL, 2=NO RESULT.
42 ..S WVRES=$$NORMAL^WVUTL4($P(Y,U,5))
43 ..; Below 5 Lines added to gather Rad Credit for rept
44 ..S WVJRC=$P($G(^WV(790.1,WVIEN,0)),U,35) I WVJRC'="" D
45 ...I '$D(^TMP("WVX",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)) D Q
46 ....S ^TMP("WVX",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)=1
47 ...S X=^TMP("WVX",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)+1
48 ...S ^TMP("WVX",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)=X
49 ..I '$D(^TMP("WV",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)) D Q
50 ...S ^TMP("WV",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)=1
51 ..S X=^TMP("WV",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)+1
52 ..S ^TMP("WV",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)=X
53 ..Q
54 .Q
55 Q:$G(ZTSTOP)=1 ;user stopped the background task
56 ;
57TOTALS ;EP
58 ;---> N=WVPCD, Q=WVAGE, M=WVDFN, P=WVRES (0,1,2), FI=WVHCF(internal)
59 ;---> FE=WVHCF(external)
60 N I,M,N,P,Q
61 S FE=""
62 F S FE=$O(^TMP("WV",$J,FE)) Q:FE="" S FI=0 F S FI=$O(^TMP("WV",$J,FE,FI)) Q:'FI S N=0 F S N=$O(^TMP("WV",$J,FE,FI,N)) Q:N="" D
63 .S Q=0
64 .F S Q=$O(^TMP("WV",$J,FE,FI,N,Q)) Q:Q="" D
65 ..F I=0,1,2 S ^TMP("WVRES",$J,FE,FI,N,Q,I,"P")=0 S ^TMP("WVRES",$J,FE,FI,N,Q,I,"T")=0
66 ..S M=0,(^TMP("WVRES",$J,FE,FI,N,Q,"P"),^TMP("WVRES",$J,FE,FI,N,Q,"T"),^TMP("WVRES",$J,FE,FI,N,Q,"VT","P"),^TMP("WVRES",$J,FE,FI,N,Q,"VT","T"))=0
67 ..F S M=$O(^TMP("WV",$J,FE,FI,N,Q,M)) Q:M="" D
68 ...S P=-1,^TMP("WVRES",$J,FE,FI,N,Q,"P")=^TMP("WVRES",$J,FE,FI,N,Q,"P")+1
69 ...I $$GET1^DIQ(2,M,1901,"I")="Y" S ^TMP("WVRES",$J,FE,FI,N,Q,"VT","PA")=$G(^TMP("WVRES",$J,FE,FI,N,Q,"VT","PA"))+1
70 ...F S P=$O(^TMP("WV",$J,FE,FI,N,Q,M,P)) Q:P="" D
71 ....S ^TMP("WVRES",$J,FE,FI,N,Q,P,"P")=^TMP("WVRES",$J,FE,FI,N,Q,P,"P")+1
72 ....S ^TMP("WVRES",$J,FE,FI,N,Q,P,"T")=^TMP("WVRES",$J,FE,FI,N,Q,P,"T")+^TMP("WV",$J,FE,FI,N,Q,M,P)
73 ....I $$GET1^DIQ(2,M,1901,"I")="Y" D
74 .....S ^TMP("WVRES",$J,FE,FI,N,Q,P,"VT","P")=$G(^TMP("WVRES",$J,FE,FI,N,Q,P,"VT","P"))+1
75 .....S ^TMP("WVRES",$J,FE,FI,N,Q,P,"VT","T")=$G(^TMP("WVRES",$J,FE,FI,N,Q,P,"VT","T"))+^TMP("WV",$J,FE,FI,N,Q,M,P)
76 ....F WVJRC=0,2 D
77 .....I $G(^TMP("WVX",$J,FE,FI,N,Q,M,P,WVJRC))'="" S ^TMP("WVRES",$J,FE,FI,N,Q,"CM","PA",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,Q,"CM","PA",WVJRC))+1 D
78 ......S ^TMP("WVRES",$J,FE,FI,N,Q,P,"CM","P",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,Q,P,"CM","P",WVJRC))+1
79 ......S ^TMP("WVRES",$J,FE,FI,N,Q,P,"CM","T",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,Q,P,"CM","T",WVJRC))+^TMP("WVX",$J,FE,FI,N,Q,M,P,WVJRC)
80 ;---> NOW COMPUTE TOTAL #PROCEDURES FOR EACH PROCEDURE, EACH AGE GROUP.
81 S FE=""
82 F S FE=$O(^TMP("WVRES",$J,FE)) Q:FE="" S FI=0 F S FI=$O(^TMP("WVRES",$J,FE,FI)) Q:'FI S N=0 F S N=$O(^TMP("WVRES",$J,FE,FI,N)) Q:'N D
83 .S Q=0 F S Q=$O(^TMP("WVRES",$J,FE,FI,N,Q)) Q:'Q D
84 ..S M=-1 F S M=$O(^TMP("WVRES",$J,FE,FI,N,Q,M)) Q:M=""!(M'?1N.N) D
85 ...S ^TMP("WVRES",$J,FE,FI,N,Q,"T")=^TMP("WVRES",$J,FE,FI,N,Q,"T")+^TMP("WVRES",$J,FE,FI,N,Q,M,"T")
86 ...;S ^TMP("WVRES",$J,FE,FI,N,Q,"P")=^TMP("WVRES",$J,FE,FI,N,Q,"P")+^TMP("WVRES",$J,FE,FI,N,Q,M,"P")
87 ...S ^TMP("WVRES",$J,FE,FI,N,Q,"VT","T")=$G(^TMP("WVRES",$J,FE,FI,N,Q,"VT","T"))+$G(^TMP("WVRES",$J,FE,FI,N,Q,M,"VT","T"))
88 ...S ^TMP("WVRES",$J,FE,FI,N,Q,"VT","P")=$G(^TMP("WVRES",$J,FE,FI,N,Q,"VT","P"))+$G(^TMP("WVRES",$J,FE,FI,N,Q,M,"VT","P"))
89 ...;*******************************************
90 ...F WVJRC=0,2 D
91 ....S ^TMP("WVRES",$J,FE,FI,N,Q,"CM","T",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,Q,"CM","T",WVJRC))+$G(^TMP("WVRES",$J,FE,FI,N,Q,M,"CM","T",WVJRC))
92 ....S ^TMP("WVRES",$J,FE,FI,N,Q,"CM","P",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,Q,"CM","P",WVJRC))+$G(^TMP("WVRES",$J,FE,FI,N,Q,M,"CM","P",WVJRC))
93 ...;*******************************************
94 ;
95 ;
96 ;-> NOW COMPUTE TOTAL #PROCEDURES FOR EACH PROCEDURE.
97 ;-> ^TMP("WVRES",$J,FE,FI,N,"P")=TOTAL PATIENTS WHO RECEIVED THIS PROCEDURE
98 ;-> ^TMP("WVRES",$J,FE,FI,N,"T")=TOTAL TIMES THIS PROCEDURE WAS PERFORMED
99 S FE=""
100 F S FE=$O(^TMP("WVRES",$J,FE)) Q:FE="" S FI=0 F S FI=$O(^TMP("WVRES",$J,FE,FI)) Q:'FI S N=0 F S N=$O(^TMP("WVRES",$J,FE,FI,N)) Q:'N D
101 .S Q=0,^TMP("WVRES",$J,FE,FI,N,"P")=0,^TMP("WVRES",$J,FE,FI,N,"T")=0,^TMP("WVRES",$J,FE,FI,N,"VT","P")=0
102 .S ^TMP("WVRES",$J,FE,FI,N,"VT","T")=0,^TMP("WVRES",$J,FE,FI,N,"VT","PA")=0
103 .F WVJRC=0,2 S ^TMP("WVRES",$J,FE,FI,N,"CM","T",WVJRC)=0,^TMP("WVRES",$J,FE,FI,N,"CM","PA",WVJRC)=0
104 .F S Q=$O(^TMP("WVRES",$J,FE,FI,N,Q)) Q:'Q D
105 ..S ^TMP("WVRES",$J,FE,FI,N,"P")=^TMP("WVRES",$J,FE,FI,N,"P")+^TMP("WVRES",$J,FE,FI,N,Q,"P")
106 ..S ^TMP("WVRES",$J,FE,FI,N,"T")=^TMP("WVRES",$J,FE,FI,N,"T")+^TMP("WVRES",$J,FE,FI,N,Q,"T")
107 ..S ^TMP("WVRES",$J,FE,FI,N,"VT","P")=^TMP("WVRES",$J,FE,FI,N,"VT","P")+$G(^TMP("WVRES",$J,FE,FI,N,Q,"VT","P"))
108 ..S ^TMP("WVRES",$J,FE,FI,N,"VT","T")=^TMP("WVRES",$J,FE,FI,N,"VT","T")+$G(^TMP("WVRES",$J,FE,FI,N,Q,"VT","T"))
109 ..S ^TMP("WVRES",$J,FE,FI,N,"VT","PA")=^TMP("WVRES",$J,FE,FI,N,"VT","PA")+$G(^TMP("WVRES",$J,FE,FI,N,Q,"VT","PA"))
110 ..F WVJRC=0,2 D
111 ...S ^TMP("WVRES",$J,FE,FI,N,"CM","P",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,"CM","P",WVJRC))+$G(^TMP("WVRES",$J,FE,FI,N,Q,"CM","P",WVJRC))
112 ...S ^TMP("WVRES",$J,FE,FI,N,"CM","T",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,"CM","T",WVJRC))+$G(^TMP("WVRES",$J,FE,FI,N,Q,"CM","T",WVJRC))
113 ...S ^TMP("WVRES",$J,FE,FI,N,"CM","PA",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,"CM","PA",WVJRC))+$G(^TMP("WVRES",$J,FE,FI,N,Q,"CM","PA",WVJRC))
114 ;
115 D FLATFL^WVRPPCD3
116 Q
117 ;
118WVAGE(DFN,DATE,X) ;EP
119 ;---> SET AGE CATEGORY.
120 ;---> REQUIRED VARIABLES: DATE=DATE PATIENT RECEIVED THIS PROCEDURE.
121 ;---> DFN, X=WVAGRG (AGE RANGE).
122 ;---> IF NOT DISPLAY BY AGE, SET ALL WVAGE=1
123 Q:X=1 1
124 N AGE,Y,Z
125 S AGE=$P($$AGEAT^WVUTL1(DFN,DATE),"y/o")
126 ;---> RETURN 0 IF PATIENT'S AGE IS UNKNOWN.
127 Q:'+AGE 0
128 ;
129 F I=1:1:$L(X,",") S Y=$P($P(X,",",I),"-",2) Q:AGE'>Y
130 S Z=$P($P(X,",",I),"-")
131 ;---> RETURN 0 IF PATIENT IS OUTSIDE DATE RANGE.
132 Q:(AGE<Z!(AGE>Y)) 0
133 Q Y
134FACNAME(IEN) ; Return Facility name
135 ; Check if ien has been looked up already.
136 I $G(WVHIEN(IEN))]"" Q $G(WVHIEN(IEN))
137 N NAME
138 S NAME=$$INSTTX^WVUTL6(IEN) ;get facility name
139 I NAME="" Q ""
140 S WVHIEN(IEN)=NAME ;update local array with name and ien
141 Q NAME
142 ;
Note: See TracBrowser for help on using the repository browser.