Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: WVRPPCD3

WVRPPCD3.m

Go to the documentation of this file.
  1. WVRPPCD3 ;HCIOFO/FT,JR-REPORT: PROCEDURES STATISTICS; ;7/23/01 13:33
  1. ;;1.0;WOMEN'S HEALTH;**12**;Sep 30, 1998
  1. ;
  1. ; This routine uses the following IAs:
  1. ; <NONE>
  1. ;
  1. FLATFL ;EP
  1. ;---> WRITE OUT RESULTS AND PECENTAGES IN A FLAT FILE.
  1. ;---> PIECE VALUES: 1=PROC TYPE, 2=NORMAL PATS, 3=NORMAL PATS%
  1. ;---> 4=NORMAL PROC 5=NORMAL PROC% 6=ABNORM PATS
  1. ;---> 7=ABNORM PATS% 8=ABNORM PROC 9=ABNORM PROC%
  1. ;---> 10=NO RES PATS 11=NO RES PATS% 12=NO RES PROC
  1. ;---> 13=NO RES PROC% 14=TOTAL PATS 15=TOTAL PROC,
  1. ;---> 16=AGE GROUP, 17=NORM VETS PROC.
  1. ;---> 18=NORM VETS PATIENTS, 19=ABN VETS PROC.
  1. ;---> 20=ABN VETS PATIENTS, 21=NO RES VETS PROC
  1. ;---> 22=NO RES VETS PATIENTS 23=TOT # VET PATIENTS
  1. ;---> 24=TOT VET PROCEDURES
  1. S FE=""
  1. 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
  1. .S M=0,(WVPN,X)=$P($G(^WV(790.2,N,0)),U)
  1. .F S M=$O(^TMP("WVRES",$J,FE,FI,N,M)) Q:'M D
  1. ..S X=WVPN,(T,P)=0,J=""
  1. ..S PA=$G(^TMP("WVRES",$J,FE,FI,N,M,"VT","PA"))
  1. ..S CM=$G(^TMP("WVRES",$J,FE,FI,N,M,"CM","PA",0))
  1. ..S CM2=$G(^TMP("WVRES",$J,FE,FI,N,M,"CM","PA",2))
  1. ..S (TR2,JR2,TR,JR)="" F I=0,1,2 D
  1. ...S X=X_U_^TMP("WVRES",$J,FE,FI,N,M,I,"P")
  1. ...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)
  1. ...S X=X_U_^TMP("WVRES",$J,FE,FI,N,M,I,"T")
  1. ...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)
  1. ...S J=J_U_$G(^TMP("WVRES",$J,FE,FI,N,M,I,"VT","T")) ;# of procedures total/result
  1. ...S J=J_U_$G(^TMP("WVRES",$J,FE,FI,N,M,I,"VT","P")) ;# of pat having this procedure
  1. ...S T=T+$G(^TMP("WVRES",$J,FE,FI,N,M,I,"VT","T"))
  1. ...S JR=$G(JR)_U_$G(^TMP("WVRES",$J,FE,FI,N,M,I,"CM","T",0)) ;# of procedures total/result
  1. ...S JR=JR_U_$G(^TMP("WVRES",$J,FE,FI,N,M,I,"CM","P",0)) ;# of pat having this procedure
  1. ...S TR=TR+$G(^TMP("WVRES",$J,FE,FI,N,M,I,"CM","T",0))
  1. ...S JR2=$G(JR2)_U_$G(^TMP("WVRES",$J,FE,FI,N,M,I,"CM","T",2)) ;# of procedures total/result
  1. ...S JR2=JR2_U_$G(^TMP("WVRES",$J,FE,FI,N,M,I,"CM","P",2)) ;# of pat having this procedure
  1. ...S TR2=TR2+$G(^TMP("WVRES",$J,FE,FI,N,M,I,"CM","T",2))
  1. ..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
  1. ..S ^TMP("WVRES",$J,"R",FE,FI,WVPN,M)=X
  1. .;--->
  1. .;---> NOW GET TOTALS FOR THIS PROCEDURE.
  1. .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
  1. .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
  1. .F S M=$O(^TMP("WVRES",$J,"R",FE,FI,WVPN,M)) Q:'M D
  1. ..S J=$O(^WV(790.2,"B",WVPN,""))
  1. ..S Y=^TMP("WVRES",$J,"R",FE,FI,WVPN,M)
  1. ..S A=A+$P(Y,U,2),B=B+$P(Y,U,4),C=C+$P(Y,U,6)
  1. ..S D=D+$P(Y,U,8),E=E+$P(Y,U,10),F=F+$P(Y,U,12)
  1. ..S H=H+$P(Y,U,17),I=I+$P(Y,U,18),K=K+$P(Y,U,19)
  1. ..S L=L+$P(Y,U,20),R=R+$P(Y,U,21),O=O+$P(Y,U,22)
  1. ..S WA=WA+$P(Y,U,25),WB=WB+$P(Y,U,26),WC=WC+$P(Y,U,27)
  1. ..S WD=WD+$P(Y,U,28),WE=WE+$P(Y,U,29),WF=WF+$P(Y,U,30)
  1. ..S WG=WG+$P(Y,U,33),WH=WH+$P(Y,U,34),WI=WI+$P(Y,U,35)
  1. ..S WJ=WJ+$P(Y,U,36),WK=WK+$P(Y,U,37),WL=WL+$P(Y,U,38)
  1. .S X=WVPN_U_A_U_$J(A*100/^TMP("WVRES",$J,FE,FI,N,"P"),1,0)
  1. .S X=X_U_B_U_$J(B*100/^TMP("WVRES",$J,FE,FI,N,"T"),1,0)
  1. .S X=X_U_C_U_$J(C*100/^TMP("WVRES",$J,FE,FI,N,"P"),1,0)
  1. .S X=X_U_D_U_$J(D*100/^TMP("WVRES",$J,FE,FI,N,"T"),1,0)
  1. .S X=X_U_E_U_$J(E*100/^TMP("WVRES",$J,FE,FI,N,"P"),1,0)
  1. .S X=X_U_F_U_$J(F*100/^TMP("WVRES",$J,FE,FI,N,"T"),1,0)
  1. .S X=X_U_^TMP("WVRES",$J,FE,FI,N,"P")_U_^TMP("WVRES",$J,FE,FI,N,"T")_U_"ALL"
  1. .S J=U_H_U_I_U_K_U_L_U_R_U_O_U
  1. .S J=J_$G(^TMP("WVRES",$J,FE,FI,N,"VT","T"))_U_$G(^TMP("WVRES",$J,FE,FI,N,"VT","PA"))
  1. .S J=J_U_WA_U_WB_U_WC_U_WD_U_WE_U_WF
  1. .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))
  1. .S J=J_U_WG_U_WH_U_WI_U_WJ_U_WK_U_WL
  1. .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))
  1. .S ^TMP("WVRES",$J,"R",FE,FI,WVPN,"ALL")=X_J
  1. Q
  1. NOFAC ; List records with no health care facility
  1. W:$Y>0 @IOF
  1. W !!,"The following Women's Health procedures are not associated with a facility:",!
  1. N WVAN,WVCMN,WVIEN,WVNODE,WVPN
  1. S WVIEN=0
  1. F S WVIEN=$O(^TMP("WVNOHCF",$J,WVIEN)) Q:'WVIEN!(WVPOP) D
  1. .S WVNODE=$G(^WV(790.1,WVIEN,0))
  1. .S WVAN=$P(WVNODE,U,1) ;accession #
  1. .S:WVAN="" WVAN="IEN is "_WVIEN
  1. .S WVPN=+$P(WVNODE,U,2)
  1. .S WVCMN=$$CMGR^WVUTL1(WVPN)
  1. .I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D NOFACHDR
  1. .W !,"Accession #: "_WVAN,?30,"Case Manager: "_WVCMN
  1. .Q
  1. Q
  1. NOFACHDR ; No Facility Header
  1. W:$Y>0 @IOF
  1. Q
  1. FACLIST ; create array to identify facilities chosen
  1. N WVIEN,WVIEN1,WVNAME
  1. K WVSB1
  1. I '$D(WVSB("ALL")) D
  1. .S WVIEN=0
  1. .F S WVIEN=$O(WVSB(WVIEN)) Q:'WVIEN D
  1. ..S WVIEN1=$P($G(^WV(790.02,WVIEN,0)),U,1)
  1. ..Q:'WVIEN1!(WVIEN'=WVIEN1)
  1. ..S WVNAME=$$INSTTX^WVUTL6(WVIEN)
  1. ..Q:WVNAME=""
  1. ..S WVSB1(WVNAME,WVIEN)=""
  1. ..Q
  1. .Q
  1. I $D(WVSB("ALL")) D
  1. .S WVIEN=0
  1. .F S WVIEN=$O(^WV(790.02,WVIEN)) Q:'WVIEN D
  1. ..S WVIEN1=$P($G(^WV(790.02,WVIEN,0)),U,1)
  1. ..Q:'WVIEN1!(WVIEN'=WVIEN1)
  1. ..S WVNAME=$$INSTTX^WVUTL6(WVIEN)
  1. ..Q:WVNAME=""
  1. ..S WVSB1(WVNAME,WVIEN)=""
  1. ..Q
  1. .Q
  1. Q