source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVRPSCR2.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1WVRPSCR2 ;HCIOFO/JWR,FT-WVRPSCR cont'd, Gathers Pap Regimens info. ;6/17/99 11:46
2 ;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998
3EN ;---> NOW COLLATE DATA FROM ^TMP ARRAY INTO LOCAL WVTMP REPORT ARRAY.
4 ;---> FIRST, SEED LOCAL ARRAY WITH ZEROS.
5 K WVPR
6 ;
7 ;---> COLLATE DATA.
8 S J="" F S J=$O(^TMP("WVP",$J,J)) Q:J="" D
9 .S N=0 F S N=$O(^TMP("WVP",$J,J,N)) Q:'N D
10 ..F M=1,28 S WVJTYP=$S(M=1:"PAPR",1:"MAM") D
11 ...Q:$D(^TMP("WVP",$J,J,N,1,M)) ;DON'T INCLUDE IF PATIENT HAD ANY ABNOR
12 ...S P=0,Q=0
13 ...F S P=$O(^TMP("WVP",$J,J,N,0,M,P)) Q:'P S Q=Q+1
14 ...Q:'Q
15 ...I '$D(WVPR(WVJTYP,J,M,Q)) S WVPR(WVJTYP,J,M,Q)=1 Q
16 ...S WVPR(WVJTYP,J,M,Q)=WVPR(WVJTYP,J,M,Q)+1
17 ;
18 ;---> STORE ALL NODES >5 IN THE 5+ NODE.
19 F M=1,28 S WVJTYP=$S(M=1:"PAPR",1:"MAM") D
20 .S J="" F S J=$O(^TMP("WVP",$J,J)) Q:J="" D
21 ..S Q=5
22 ..F S Q=$O(WVPR(WVJTYP,J,M,Q)) Q:'Q D
23 ...S WVPR(WVJTYP,J,M,5)=$G(WVPR(WVJTYP,J,M,5))+WVPR(WVJTYP,J,M,Q)
24 ;
25 ;---> FIGURE PERCENTAGES OF WOMEN AND STORE IN ARRAY.
26 F M=1,28 S WVJTYP=$S(M=1:"PAPR",1:"MAM") D
27 .S J="" F S J=$O(WVPR(WVJTYP,J)) Q:J="" D
28 ..F Q=1:1:5 I $D(WVPR(WVJTYP,J,M,Q)) S $P(WVPR(WVJTYP,J,M,Q),U,2)=$J((+WVPR(WVJTYP,J,M,Q)/WVTOT),0,2)
29 ;
30PRINT N BLANK,DATA
31 S $P(BLANK," ",41)="",CN=7.001
32 S WVJST=0 F M=1,28 S WVJTYP=$S(M=1:"PAPR",1:"MAM") S:M=28 CN=16.001 D
33 .S J="" F S J=$O(WVPR(WVJTYP,J)) Q:J="" D
34 ..Q:'$D(WVPR(WVJTYP,J,M))
35 ..N P F Q=1:1:5 S DATA=$G(WVPR(WVJTYP,J,M,Q)) D
36 ...S P(1)=$P(DATA,U),P(2)=$P(DATA,U,2)*100 S:P(1)="" P(1)=0
37 ...S P("NO")=$G(P("NO"))_$E(BLANK,1,6-$L(P(1)))_P(1)
38 ...S P("PCT")=$G(P("PCT"))_$E(BLANK,1,5-$L(P(2)))_P(2)_"%"
39 ..S ^TMP("WV",$J,CN,0)=" "_J_$E(BLANK,1,36-$L(J))_"# of Women "_P("NO")
40 ..S CN=CN+.001
41 ..S ^TMP("WV",$J,CN,0)=$E(BLANK,1,37)_"% of Women "_P("PCT")
42 ..S CN=CN+.001
43 ..S ^TMP("WV",$J,CN,0)=""
44 ..S CN=CN+.001
45 Q
46HDR ;
47 Q:N>7.9&(N'>16)
48 S WVJHDR=$S(N<8:"PAP REGIMEN",N>16:"AGE GROUPS ",1:" ")
49 W !!," ",WVJHDR," 1 2 3 4 5+"
50 W !," ----------- ----- ----- ----- ----- -----"
51 Q
52ACTIVE(WVBEGIN,WVEND,WVAGRG) ; Count active patients in WV PATIENT file (#790).
53 ; Active is defined as not having a DATE INACTIVE (#.24) field
54 ; value or that value falls within the date range selected.
55 ; WVBEGIN - start of date range in FM format
56 ; WVEND - end of date range in FM format
57 N WVLOOP,WVNODE,WVACTIVE,WVAGE
58 S (WVLOOP,WVACTIVE)=0
59 ; check if date range exists
60 I 'WVBEGIN!('WVEND)!(WVAGRG="") S WVACTIVE=1 Q WVACTIVE
61 F S WVLOOP=$O(^WV(790,WVLOOP)) Q:'WVLOOP D
62 .S WVNODE=$G(^WV(790,WVLOOP,0))
63 .Q:WVNODE=""
64 .S WVAGE=+$$AGE^WVUTL9(WVLOOP)
65 .I WVAGRG'=1 Q:((WVAGE<$P(WVAGRG,"-"))!(WVAGE>$P(WVAGRG,"-",2)))
66 .I +$P(WVNODE,U,24)'>0 S WVACTIVE=WVACTIVE+1 Q ;active
67 .Q:$P(WVNODE,U,24)<WVBEGIN ;inactive before date range
68 .I $P(WVNODE,U,24)>WVEND S WVACTIVE=WVACTIVE+1 Q ;inactive after range
69 .S WVACTIVE=WVACTIVE+1 ;active at some time within range
70 .Q
71 S:WVACTIVE=0 WVACTIVE=1
72 Q WVACTIVE
73 ;
Note: See TracBrowser for help on using the repository browser.