source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVRPPCD3.m@ 1604

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1WVRPPCD3 ;HCIOFO/FT,JR-REPORT: PROCEDURES STATISTICS; ;7/23/01 13:33
2 ;;1.0;WOMEN'S HEALTH;**12**;Sep 30, 1998
3 ;
4 ; This routine uses the following IAs:
5 ; <NONE>
6 ;
7FLATFL ;EP
8 ;---> WRITE OUT RESULTS AND PECENTAGES IN A FLAT FILE.
9 ;---> PIECE VALUES: 1=PROC TYPE, 2=NORMAL PATS, 3=NORMAL PATS%
10 ;---> 4=NORMAL PROC 5=NORMAL PROC% 6=ABNORM PATS
11 ;---> 7=ABNORM PATS% 8=ABNORM PROC 9=ABNORM PROC%
12 ;---> 10=NO RES PATS 11=NO RES PATS% 12=NO RES PROC
13 ;---> 13=NO RES PROC% 14=TOTAL PATS 15=TOTAL PROC,
14 ;---> 16=AGE GROUP, 17=NORM VETS PROC.
15 ;---> 18=NORM VETS PATIENTS, 19=ABN VETS PROC.
16 ;---> 20=ABN VETS PATIENTS, 21=NO RES VETS PROC
17 ;---> 22=NO RES VETS PATIENTS 23=TOT # VET PATIENTS
18 ;---> 24=TOT VET PROCEDURES
19 S FE=""
20 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
21 .S M=0,(WVPN,X)=$P($G(^WV(790.2,N,0)),U)
22 .F S M=$O(^TMP("WVRES",$J,FE,FI,N,M)) Q:'M D
23 ..S X=WVPN,(T,P)=0,J=""
24 ..S PA=$G(^TMP("WVRES",$J,FE,FI,N,M,"VT","PA"))
25 ..S CM=$G(^TMP("WVRES",$J,FE,FI,N,M,"CM","PA",0))
26 ..S CM2=$G(^TMP("WVRES",$J,FE,FI,N,M,"CM","PA",2))
27 ..S (TR2,JR2,TR,JR)="" F I=0,1,2 D
28 ...S X=X_U_^TMP("WVRES",$J,FE,FI,N,M,I,"P")
29 ...S X=X_U_$J((^TMP("WVRES",$J,FE,FI,N,M,I,"P")*100/^TMP("WVRES",$J,FE,FI,N,M,"P")),1,0)
30 ...S X=X_U_^TMP("WVRES",$J,FE,FI,N,M,I,"T")
31 ...S X=X_U_$J((^TMP("WVRES",$J,FE,FI,N,M,I,"T")*100/^TMP("WVRES",$J,FE,FI,N,M,"T")),1,0)
32 ...S J=J_U_$G(^TMP("WVRES",$J,FE,FI,N,M,I,"VT","T")) ;# of procedures total/result
33 ...S J=J_U_$G(^TMP("WVRES",$J,FE,FI,N,M,I,"VT","P")) ;# of pat having this procedure
34 ...S T=T+$G(^TMP("WVRES",$J,FE,FI,N,M,I,"VT","T"))
35 ...S JR=$G(JR)_U_$G(^TMP("WVRES",$J,FE,FI,N,M,I,"CM","T",0)) ;# of procedures total/result
36 ...S JR=JR_U_$G(^TMP("WVRES",$J,FE,FI,N,M,I,"CM","P",0)) ;# of pat having this procedure
37 ...S TR=TR+$G(^TMP("WVRES",$J,FE,FI,N,M,I,"CM","T",0))
38 ...S JR2=$G(JR2)_U_$G(^TMP("WVRES",$J,FE,FI,N,M,I,"CM","T",2)) ;# of procedures total/result
39 ...S JR2=JR2_U_$G(^TMP("WVRES",$J,FE,FI,N,M,I,"CM","P",2)) ;# of pat having this procedure
40 ...S TR2=TR2+$G(^TMP("WVRES",$J,FE,FI,N,M,I,"CM","T",2))
41 ..S X=X_U_^TMP("WVRES",$J,FE,FI,N,M,"P")_U_^TMP("WVRES",$J,FE,FI,N,M,"T")_U_M_J_U_T_U_PA_JR_U_TR_U_CM_JR2_U_TR2_U_CM2
42 ..S ^TMP("WVRES",$J,"R",FE,FI,WVPN,M)=X
43 .;--->
44 .;---> NOW GET TOTALS FOR THIS PROCEDURE.
45 .N A,B,C,D,E,F,G,H,I,J,K,L,M,O,WA,WB,WC,WD,WE,WF,WG,WH,WI,WJ,WK,WL
46 .S (A,B,C,D,E,F,G,H,I,K,L,M,R,O,WA,WB,WC,WD,WE,WF,WG,WH,WI,WJ,WK,WL)=0
47 .F S M=$O(^TMP("WVRES",$J,"R",FE,FI,WVPN,M)) Q:'M D
48 ..S J=$O(^WV(790.2,"B",WVPN,""))
49 ..S Y=^TMP("WVRES",$J,"R",FE,FI,WVPN,M)
50 ..S A=A+$P(Y,U,2),B=B+$P(Y,U,4),C=C+$P(Y,U,6)
51 ..S D=D+$P(Y,U,8),E=E+$P(Y,U,10),F=F+$P(Y,U,12)
52 ..S H=H+$P(Y,U,17),I=I+$P(Y,U,18),K=K+$P(Y,U,19)
53 ..S L=L+$P(Y,U,20),R=R+$P(Y,U,21),O=O+$P(Y,U,22)
54 ..S WA=WA+$P(Y,U,25),WB=WB+$P(Y,U,26),WC=WC+$P(Y,U,27)
55 ..S WD=WD+$P(Y,U,28),WE=WE+$P(Y,U,29),WF=WF+$P(Y,U,30)
56 ..S WG=WG+$P(Y,U,33),WH=WH+$P(Y,U,34),WI=WI+$P(Y,U,35)
57 ..S WJ=WJ+$P(Y,U,36),WK=WK+$P(Y,U,37),WL=WL+$P(Y,U,38)
58 .S X=WVPN_U_A_U_$J(A*100/^TMP("WVRES",$J,FE,FI,N,"P"),1,0)
59 .S X=X_U_B_U_$J(B*100/^TMP("WVRES",$J,FE,FI,N,"T"),1,0)
60 .S X=X_U_C_U_$J(C*100/^TMP("WVRES",$J,FE,FI,N,"P"),1,0)
61 .S X=X_U_D_U_$J(D*100/^TMP("WVRES",$J,FE,FI,N,"T"),1,0)
62 .S X=X_U_E_U_$J(E*100/^TMP("WVRES",$J,FE,FI,N,"P"),1,0)
63 .S X=X_U_F_U_$J(F*100/^TMP("WVRES",$J,FE,FI,N,"T"),1,0)
64 .S X=X_U_^TMP("WVRES",$J,FE,FI,N,"P")_U_^TMP("WVRES",$J,FE,FI,N,"T")_U_"ALL"
65 .S J=U_H_U_I_U_K_U_L_U_R_U_O_U
66 .S J=J_$G(^TMP("WVRES",$J,FE,FI,N,"VT","T"))_U_$G(^TMP("WVRES",$J,FE,FI,N,"VT","PA"))
67 .S J=J_U_WA_U_WB_U_WC_U_WD_U_WE_U_WF
68 .S J=J_U_$G(^TMP("WVRES",$J,FE,FI,N,"CM","T",0))_U_$G(^TMP("WVRES",$J,FE,FI,N,"CM","PA",0))
69 .S J=J_U_WG_U_WH_U_WI_U_WJ_U_WK_U_WL
70 .S J=J_U_$G(^TMP("WVRES",$J,FE,FI,N,"CM","T",2))_U_$G(^TMP("WVRES",$J,FE,FI,N,"CM","PA",2))
71 .S ^TMP("WVRES",$J,"R",FE,FI,WVPN,"ALL")=X_J
72 Q
73NOFAC ; List records with no health care facility
74 W:$Y>0 @IOF
75 W !!,"The following Women's Health procedures are not associated with a facility:",!
76 N WVAN,WVCMN,WVIEN,WVNODE,WVPN
77 S WVIEN=0
78 F S WVIEN=$O(^TMP("WVNOHCF",$J,WVIEN)) Q:'WVIEN!(WVPOP) D
79 .S WVNODE=$G(^WV(790.1,WVIEN,0))
80 .S WVAN=$P(WVNODE,U,1) ;accession #
81 .S:WVAN="" WVAN="IEN is "_WVIEN
82 .S WVPN=+$P(WVNODE,U,2)
83 .S WVCMN=$$CMGR^WVUTL1(WVPN)
84 .I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D NOFACHDR
85 .W !,"Accession #: "_WVAN,?30,"Case Manager: "_WVCMN
86 .Q
87 Q
88NOFACHDR ; No Facility Header
89 W:$Y>0 @IOF
90 Q
91FACLIST ; create array to identify facilities chosen
92 N WVIEN,WVIEN1,WVNAME
93 K WVSB1
94 I '$D(WVSB("ALL")) D
95 .S WVIEN=0
96 .F S WVIEN=$O(WVSB(WVIEN)) Q:'WVIEN D
97 ..S WVIEN1=$P($G(^WV(790.02,WVIEN,0)),U,1)
98 ..Q:'WVIEN1!(WVIEN'=WVIEN1)
99 ..S WVNAME=$$INSTTX^WVUTL6(WVIEN)
100 ..Q:WVNAME=""
101 ..S WVSB1(WVNAME,WVIEN)=""
102 ..Q
103 .Q
104 I $D(WVSB("ALL")) D
105 .S WVIEN=0
106 .F S WVIEN=$O(^WV(790.02,WVIEN)) Q:'WVIEN D
107 ..S WVIEN1=$P($G(^WV(790.02,WVIEN,0)),U,1)
108 ..Q:'WVIEN1!(WVIEN'=WVIEN1)
109 ..S WVNAME=$$INSTTX^WVUTL6(WVIEN)
110 ..Q:WVNAME=""
111 ..S WVSB1(WVNAME,WVIEN)=""
112 ..Q
113 .Q
114 Q
Note: See TracBrowser for help on using the repository browser.