WVRPPCD1 ;HCIOFO/FT,JR-REPORT: PROCEDURE STATISTICS; ;7/24/01  13:55
 ;;1.0;WOMEN'S HEALTH;**4,12**;Sep 30, 1998
 ;;  Original routine created by IHS/ANMC/MWR
 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
 ;;  DISPLAY CODE FOR PROCEDURE STATISTICS REPORT.  CALLED BY WVRPPCD.
 ;
 ; This routine uses the following IAs:
 ; <NONE>
 ;
DISPLAY ;EP
 ;---> WVTITLE=TITLE AT TOP OF DISPLAY HEADER.
 ;---> WVSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
 ;---> WVCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
 ;
 U IO
 W:$E(IOST)="C" @IOF
 S WVTITLE="* * *  WOMEN'S HEALTH: PROCEDURE STATISTICS REPORT  * * *"
 D CENTERT^WVUTL5(.WVTITLE)
 S WVSUBH="SUBHEAD^WVRPPCD1"
 D TOPHEAD^WVUTL7
 S (WVPOP,N)=0
 ;
DISPLAY1 ;EP
 N WVFAC,WVSB1
 S FE="",WVFAC=0
 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
 .I WVFAC'=FI D:WVCRT&(WVFAC) DIRZ^WVUTL3 Q:WVPOP  S WVFAC=FI D HEADER3 Q:$G(ZTSTOP)=1
 .S N=0 F  S N=$O(^TMP("WVAR",$J,FE,FI,N)) Q:N=""!(WVPOP)  D
 ..I $Y+12>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP  D  Q:$G(ZTSTOP)=1
 ...S WVPAGE=WVPAGE+1
 ...D HEADER3 Q:$G(ZTSTOP)=1
 ..S Y=^TMP("WVAR",$J,FE,FI,N)
 ..S WVARJ=$S($P(Y,U)["MAMMOGRAM":1,$P(Y,U)["ULTRASOUND":1,1:0)
 ..S WVAGRP=$$WVAGRP($P(Y,U,16))
 ..;---> QUIT IF DISPLAYING "ALL AGES" ONLY (NOT GROUPED BY AGE).
 ..Q:WVAGRP=1
 ..S WVPCD="< "_$P(Y,U)_": "_WVAGRP_" >",WVPCDL=$L(WVPCD)
 ..S X=$E(WVLINE,1,31-(WVPCDL/2))
 ..W !!?2,X,WVPCD,X
 ..I WVARJ W !?68," CREDIT"
 ..W !?28,"COUNT",?43,"VETS",?56,"NON-VETS"
 ..I WVARJ W ?66," REG.   NO CR"
 ..W !?26,"----------",?40,"----------",?55,"----------"
 ..I WVARJ W ?67,"-----  -----"
 ..D VERTICAL
 ..Q
 .Q
 I WVPOP!($G(ZTSTOP)=1) D ^%ZISC Q
 D FACLIST^WVRPPCD3
 N WVNAME,WVIEN,WVCNT,WVCNT1
 S WVNAME="",WVCNT=0
 F  S WVNAME=$O(WVSB1(WVNAME)) Q:WVNAME=""  D
 .S WVIEN=0
 .F  S WVIEN=$O(WVSB1(WVNAME,WVIEN)) Q:'WVIEN  D
 ..Q:$D(^TMP("WVAR",$J,WVNAME,WVIEN))
 ..S WVCNT=WVCNT+1
 ..Q
 .Q
 I WVCNT=0 G JUMP2
 I '$D(^TMP("WVAR",$J)) G JUMP1
 I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3 D  Q:WVPOP
 .D:WVPOP ^%ZISC
 .Q
JUMP1 ;
 S WVNAME="",WVCNT1=0
 F  S WVNAME=$O(WVSB1(WVNAME)) Q:WVNAME=""!(WVPOP)!($G(ZTSTOP)=1)  D
 .S WVIEN=0
 .F  S WVIEN=$O(WVSB1(WVNAME,WVIEN)) Q:'WVIEN!(WVPOP)!($G(ZTSTOP)=1)  D
 ..Q:$D(^TMP("WVAR",$J,WVNAME,WVIEN))
 ..S WVCNT1=WVCNT1+1,WVPAGE=1
 ..D HEADER4
 ..Q:$G(ZTSTOP)=1
 ..Q:WVCNT=WVCNT1
 ..I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3
 ..Q
 .Q
JUMP2 ;
 I WVPOP!($G(ZTSTOP)=1) D ^%ZISC Q
 I $O(^TMP("WVNOHCF",$J,0))'>0 D ENDREP^WVUTL7() Q
 I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3 D  Q:WVPOP
 .D:WVPOP ^%ZISC
 .Q
JUMP3 ;
 D NOFAC^WVRPPCD3 ;records with no facility
 D ENDREP^WVUTL7()
 Q
 ;
VERTICAL ;EP
 ;---> DISPLAY IN VERTICAL FORMAT.
 F X=1:1:24 S:$P(Y,U,X)="" $P(Y,U,X)=0
 F X=25:1:40 S:$P(Y,U,X)'>0 $P(Y,U,X)=""
 D PG
 W !?14,$S($P(Y,U)="PREGNANCY TEST":"NOT PREG",1:"NORMAL:")
 W ?24,$J($P(Y,U,4),5),?30,"(",$J($P(Y,U,5),3),"%)"
 W ?38,$J($P(Y,U,17),5),?44,PG(1),?47,$J($P(Y,U,4)-$P(Y,U,17),8)
 W ?59,PG(2)
 I WVARJ W ?64,$J($P(Y,U,25),5),?72,$J($P(Y,U,33),5)
 W !?2,"PROCEDURES"
 W ?14,$S($P(Y,U)="PREGNANCY TEST":"PREGNANT:",1:"ABNORMAL:")
 W ?24,$J($P(Y,U,8),5),?30,"(",$J($P(Y,U,9),3),"%)"
 W ?38,$J($P(Y,U,19),5),?44,PG(3),?47,$J($P(Y,U,8)-$P(Y,U,19),8)
 W ?59,PG(4)
 I WVARJ W ?64,$J($P(Y,U,27),5),?72,$J($P(Y,U,35),5)
 W !?14,"NO RESULT:",?24,$J($P(Y,U,12),5),?30,"(",$J($P(Y,U,13),3),"%)"
 W ?38,$J($P(Y,U,21),5),?44,PG(5),?47,$J($P(Y,U,12)-$P(Y,U,21),8)
 W ?59,PG(6)
 I WVARJ W ?64,$J($P(Y,U,29),5),?72,$J($P(Y,U,37),5)
 W !?14,"TOTAL:",?24,$J($P(Y,U,15),5),?38,$J($P(Y,U,23),5)
 W ?44,PG(7),?47,$J($P(Y,U,15)-$P(Y,U,23),8)
 W ?59,PG(8)
 I WVARJ W ?64,$J($P(Y,U,31),5),?72,$J($P(Y,U,39),5)
 W !!?14,$S($P(Y,U)="PREGNANCY TEST":"NOT PREG:",1:"NORMAL:")
 W ?24,$J($P(Y,U,2),5),?30,"(",$J($P(Y,U,3),3),"%)"
 W ?38,$J($P(Y,U,18),5),?44,PG(9),?47,$J($P(Y,U,2)-$P(Y,U,18),8)
 W ?59,PG(10)
 I WVARJ W ?64,$J($P(Y,U,26),5),?72,$J($P(Y,U,34),5)
 W !?2,"PATIENTS"
 W ?14,$S($P(Y,U)="PREGNANCY TEST":"PREGNANT:",1:"ABNORMAL:")
 W ?24,$J($P(Y,U,6),5),?30,"(",$J($P(Y,U,7),3),"%)"
 W ?38,$J($P(Y,U,20),5),?44,PG(11),?47,$J($P(Y,U,6)-$P(Y,U,20),8)
 W ?59,PG(12)
 I WVARJ W ?64,$J($P(Y,U,28),5),?72,$J($P(Y,U,36),5)
 W !?14,"NO RESULT:",?24,$J($P(Y,U,10),5),?30,"(",$J($P(Y,U,11),3),"%)"
 W ?38,$J($P(Y,U,22),5),?44,PG(13),?47,$J($P(Y,U,10)-$P(Y,U,22),8)
 W ?59,PG(14)
 I WVARJ W ?64,$J($P(Y,U,30),5),?72,$J($P(Y,U,38),5)
 W !?14,"TOTAL:",?24,$J($P(Y,U,14),5),?38,$J($P(Y,U,24),5)
 W ?44,PG(15),?47,$J($P(Y,U,14)-$P(Y,U,24),8)
 W ?59,PG(16)
 I WVARJ W ?64,$J($P(Y,U,32),5),?72,$J($P(Y,U,40),5)
 Q
PG ;FIGURES %'S FOR VETS & NON VETS
 F JC=1:1:25 S PG(JC)=0
 I $P(Y,U,4)'=0 S PG(1)=100*$P(Y,U,17)/$P(Y,U,4)
 I $P(Y,U,8)'=0 S PG(3)=100*$P(Y,U,19)/$P(Y,U,8)
 I $P(Y,U,12)'=0 S PG(5)=100*$P(Y,U,21)/$P(Y,U,12)
 I $P(Y,U,15)'=0 S PG(7)=100*$P(Y,U,23)/$P(Y,U,15)
 I $P(Y,U,2)'=0 S PG(9)=100*$P(Y,U,18)/$P(Y,U,2)
 I $P(Y,U,6)'=0 S PG(11)=100*$P(Y,U,20)/$P(Y,U,6)
 I $P(Y,U,10)'=0 S PG(13)=100*$P(Y,U,22)/$P(Y,U,10)
 I $P(Y,U,14)'=0 S PG(15)=100*$P(Y,U,24)/$P(Y,U,14) D T
 S PG(2)=$S($P(Y,U,4)'=0:100-PG(1),1:0)
 S PG(4)=$S($P(Y,U,8)'=0:100-PG(3),1:0)
 S PG(6)=$S($P(Y,U,12)'=0:100-PG(5),1:0)
 S PG(8)=$S($P(Y,U,15)'=0:100-PG(7),1:0)
 S PG(10)=$S($P(Y,U,2)'=0:100-PG(9),1:0)
 S PG(12)=$S($P(Y,U,6)'=0:100-PG(11),1:0)
 S PG(14)=$S($P(Y,U,10)'=0:100-PG(13),1:0)
 S PG(16)=$S($P(Y,U,14)'=0:100-PG(15),1:0)
 ;PAD %'S WITH BLANKS
 F JC=1:1:16 S PG(JC)="  "_PG(JC) D
 .S PG(JC)=$E(PG(JC),$L(PG(JC))-2,$L(PG(JC)))
 .S PG(JC)="("_PG(JC)_"%)"
 Q
T ;ELIMINTE DECIMAL POINT IN %
 N S F S=1,3,5,7,9,11,13,15 D
 .S:$E($P(PG(S),".",2))'<.5 PG(S)=PG(S)+1 S PG(S)=$P(PG(S),".")
 Q
 ;
WVAGRP(AGE) ;EP
 ;Q:AGE="ALL" "All ages"
 Q:AGE="ALL" $S(WVAGRP'=1:"Total for selected ages",1:"All ages")
 Q:AGE=1 1
 N I,X,Y,Z S X=WVAGRG
 F I=1:1:$L(X,",")  S Y=$P($P(X,",",I),"-",2)  Q:AGE'>Y
 S Z=$P($P(X,",",I),"-")
 Q:AGE<Z "Under "_Y_" yrs"
 Q:AGE>Y "Over "_Y_" yrs"
 Q $P(X,",",I)_" yrs"
 ;---> PUT A FINAL CHECK IN HERE??  *COMEBACK
 Q "Unknown age"
 ;
 ;
SUBHEAD ;EP
 ;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.
 W !?5,"NOTE: Patient numbers are not intended to total.  "
 W "Patients may be"
 W !,"           included in more than one category.",!
 W $$REPEAT^XLFSTR("=",80)
 Q
HEADER3 ;EP
 ;---> REQUIRED VARIABLES: WVBEGDT,WVCRT,WVENDDT,WVPAGE,WVTITLE,DUZ(2)
 ;---> OPTIONAL VARIABLE:  WVSUBH (SUBHEADER).
 N X
 W:$Y>0 @IOF
 W !,WVTITLE,?70,"page: ",WVPAGE
 W !,$$RUNDT^WVUTL1A("C")
 W !!,"Facility: ",$$INSTTX^WVUTL6($S($G(WVFAC):WVFAC,1:DUZ(2)))
 W ?53,"From: ",$$SLDT2^WVUTL5(WVBEGDT)
 W " to ",$$SLDT2^WVUTL5(WVENDDT)
 W !,$$REPEAT^XLFSTR("=",80)
 I $D(WVSUBH) D @WVSUBH
 I $D(ZTQUEUED) D STOPCHK^WVUTL10(1) Q:$G(ZTSTOP)=1
 Q
HEADER4 ; Header and message for facilities without data
 N X
 W:$Y>0 @IOF
 W !,WVTITLE,?70,"page: ",WVPAGE
 W !,$$RUNDT^WVUTL1A("C")
 W !!,"Facility: "_WVNAME
 W ?53,"From: ",$$SLDT2^WVUTL5(WVBEGDT)
 W " to ",$$SLDT2^WVUTL5(WVENDDT)
 W !,$$REPEAT^XLFSTR("=",80)
 I $D(ZTQUEUED) D STOPCHK^WVUTL10(1) Q:$G(ZTSTOP)=1
 W !!?5,"No records match the selected criteria for this facility.",!
 Q