BGPDP29 ; IHS/CMI/LAB - IHS gpra print ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
I29 ;EP
OT ;
S BGPN=16,BGPNP=46,BGPNB=86,BGPP1=1,BGPP2="2-5" D PRN Q:BGPQUIT
S BGPN=16,BGPNP=46,BGPNB=86,BGPP1=2,BGPP2="6-11" D PRN Q:BGPQUIT
S BGPN=16,BGPNP=46,BGPNB=86,BGPP1=3,BGPP2="12-19" D PRN Q:BGPQUIT
S BGPN=16,BGPNP=46,BGPNB=86,BGPP1=4,BGPP2="20-24" D PRN Q:BGPQUIT
S BGPN=16,BGPNP=46,BGPNB=86,BGPP1=5,BGPP2="25-34" D PRN Q:BGPQUIT
S BGPN=20,BGPNP=50,BGPNB=90,BGPP1=3,BGPP2="35-44" D PRN Q:BGPQUIT
S BGPN=20,BGPNP=50,BGPNB=90,BGPP1=4,BGPP2="45-54" D PRN Q:BGPQUIT
S BGPN=20,BGPNP=50,BGPNB=90,BGPP1=5,BGPP2="55-64" D PRN Q:BGPQUIT
S BGPN=20,BGPNP=50,BGPNB=90,BGPP1=6,BGPP2="OVER 64" D PRN Q:BGPQUIT
Q
PRN ;
D HEADER^BGPDPH Q:BGPQUIT
W !,"Indicator 29: Child Obesity",!
W !,"Denominator is all active users "
D H1^BGPDPH
S BGPV=$$V(BGPRPT,BGPN,BGPP1),BGPCYD=$P($P(BGPV,"!",1),"~",1)+$P($P(BGPV,"!",2),"~",1),BGPCYN=$P($P(BGPV,"!",1),"~",2)+$P($P(BGPV,"!",2),"~",2),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98V=$$V(BGPRPT,BGPNB,BGPP1),BGP98D=$P($P(BGP98V,"!",1),"~",1)+$P($P(BGP98V,"!",2),"~",1),BGP98N=$P($P(BGP98V,"!",1),"~",2)+$P($P(BGP98V,"!",2),"~",2),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRV=$$V(BGPRPT,BGPNP,BGPP1),BGPPRD=$P($P(BGPPRV,"!",1),"~",1)+$P($P(BGPPRV,"!",2),"~",1),BGPPRN=$P($P(BGPPRV,"!",1),"~",2)+$P($P(BGPPRV,"!",2),"~",2),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !,"# "_BGPP2_" yr olds",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
W !,"# w/ BMI calculated"
D H2^BGPDPH
S BGPCYD=BGPCYN,BGPCYN=$P($P(BGPV,"!",1),"~",4)+$P($P(BGPV,"!",2),"~",4),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=BGP98N,BGP98N=$P($P(BGP98V,"!",1),"~",4)+$P($P(BGP98V,"!",2),"~",4),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=BGPPRN,BGPPRN=$P($P(BGPPRV,"!",1),"~",4)+$P($P(BGPPRV,"!",2),"~",4),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !,"# obese"
D H2^BGPDPH
S BGPCYN=$P($P(BGPV,"!",1),"~",3)+$P($P(BGPV,"!",2),"~",3),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98N=$P($P(BGP98V,"!",1),"~",3)+$P($P(BGP98V,"!",2),"~",3),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRN=$P($P(BGPPRV,"!",1),"~",3)+$P($P(BGPPRV,"!",2),"~",3),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !,"# overweight"
D H2^BGPDPH
PRNF ;
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT D H1^BGPDPH
S BGPV=$$V(BGPRPT,BGPN,BGPP1),BGPCYD=$P($P(BGPV,"!",2),"~",1),BGPCYN=$P($P(BGPV,"!",2),"~",2),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98V=$$V(BGPRPT,BGPNB,BGPP1),BGP98D=$P($P(BGP98V,"!",2),"~",1),BGP98N=$P($P(BGP98V,"!",2),"~",2),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRV=$$V(BGPRPT,BGPNP,BGPP1),BGPPRD=$P($P(BGPPRV,"!",2),"~",1),BGPPRN=$P($P(BGPPRV,"!",2),"~",2),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!!,"# FEMALE "_BGPP2_" yr olds",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
W !,"# w/ BMI calculated"
D H2^BGPDPH
S BGPCYD=BGPCYN,BGPCYN=$P($P(BGPV,"!",2),"~",4),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=BGP98N,BGP98N=$P($P(BGP98V,"!",2),"~",4),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=BGPPRN,BGPPRN=$P($P(BGPPRV,"!",2),"~",4),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !,"# obese"
D H2^BGPDPH
S BGPCYN=$P($P(BGPV,"!",2),"~",3),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98N=$P($P(BGP98V,"!",2),"~",3),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRN=$P($P(BGPPRV,"!",2),"~",3),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !,"# overweight"
D H2^BGPDPH
PRNM ;
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT D H1^BGPDPH
S BGPV=$$V(BGPRPT,BGPN,BGPP1),BGPCYD=$P($P(BGPV,"!",1),"~",1),BGPCYN=$P($P(BGPV,"!",1),"~",2),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98V=$$V(BGPRPT,BGPNB,BGPP1),BGP98D=$P($P(BGP98V,"!",1),"~",1),BGP98N=$P($P(BGP98V,"!",1),"~",2),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRV=$$V(BGPRPT,BGPNP,BGPP1),BGPPRD=$P($P(BGPPRV,"!",1),"~",1),BGPPRN=$P($P(BGPPRV,"!",1),"~",2),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!!,"# MALE "_BGPP2_" yr olds",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
W !,"# w/ BMI calculated"
D H2^BGPDPH
S BGPCYD=BGPCYN,BGPCYN=$P($P(BGPV,"!",1),"~",4),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=BGP98N,BGP98N=$P($P(BGP98V,"!",1),"~",4),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=BGPPRN,BGPPRN=$P($P(BGPPRV,"!",1),"~",4),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !,"# obese"
D H2^BGPDPH
S BGPCYN=$P($P(BGPV,"!",1),"~",3),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98N=$P($P(BGP98V,"!",1),"~",3),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRN=$P($P(BGPPRV,"!",1),"~",3),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !,"# overweight"
D H2^BGPDPH
Q
;
V(R,N,P) ;
NEW Y
I $G(BGPAREAA),'$G(BGPSUMR) G VA
Q $P($G(^BGPD(R,N)),U,P)
VA ;
NEW X,C,V,MT,FT,M,F,B S X=0,C="" F S X=$O(BGPSUL(X)) Q:X'=+X D
.S V=$P($G(^BGPD(X,N)),U,P)
.I C="" S C=V Q
.S MT=$P(C,"!"),FT=$P(C,"!",2),M=$P(V,"!"),F=$P(V,"!",2)
.F B=1:1:6 S $P(MT,"~",B)=$P(MT,"~",B)+$P(M,"~",B)
.F B=1:1:6 S $P(FT,"~",B)=$P(FT,"~",B)+$P(F,"~",B)
.S C=MT_"!"_FT
.Q
Q C
C(X,X2,X3) ;
D COMMA^%DTC
Q X
BGPDP29 ; IHS/CMI/LAB - IHS gpra print ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
I29 ;EP
OT ;
+1 SET BGPN=16
SET BGPNP=46
SET BGPNB=86
SET BGPP1=1
SET BGPP2="2-5"
DO PRN
IF BGPQUIT
QUIT
+2 SET BGPN=16
SET BGPNP=46
SET BGPNB=86
SET BGPP1=2
SET BGPP2="6-11"
DO PRN
IF BGPQUIT
QUIT
+3 SET BGPN=16
SET BGPNP=46
SET BGPNB=86
SET BGPP1=3
SET BGPP2="12-19"
DO PRN
IF BGPQUIT
QUIT
+4 SET BGPN=16
SET BGPNP=46
SET BGPNB=86
SET BGPP1=4
SET BGPP2="20-24"
DO PRN
IF BGPQUIT
QUIT
+5 SET BGPN=16
SET BGPNP=46
SET BGPNB=86
SET BGPP1=5
SET BGPP2="25-34"
DO PRN
IF BGPQUIT
QUIT
+6 SET BGPN=20
SET BGPNP=50
SET BGPNB=90
SET BGPP1=3
SET BGPP2="35-44"
DO PRN
IF BGPQUIT
QUIT
+7 SET BGPN=20
SET BGPNP=50
SET BGPNB=90
SET BGPP1=4
SET BGPP2="45-54"
DO PRN
IF BGPQUIT
QUIT
+8 SET BGPN=20
SET BGPNP=50
SET BGPNB=90
SET BGPP1=5
SET BGPP2="55-64"
DO PRN
IF BGPQUIT
QUIT
+9 SET BGPN=20
SET BGPNP=50
SET BGPNB=90
SET BGPP1=6
SET BGPP2="OVER 64"
DO PRN
IF BGPQUIT
QUIT
+10 QUIT
PRN ;
+1 DO HEADER^BGPDPH
IF BGPQUIT
QUIT
+2 WRITE !,"Indicator 29: Child Obesity",!
+3 WRITE !,"Denominator is all active users "
+4 DO H1^BGPDPH
+5 SET BGPV=$$V(BGPRPT,BGPN,BGPP1)
SET BGPCYD=$PIECE($PIECE(BGPV,"!",1),"~",1)+$PIECE($PIECE(BGPV,"!",2),"~",1)
SET BGPCYN=$PIECE($PIECE(BGPV,"!",1),"~",2)+$PIECE($PIECE(BGPV,"!",2),"~",2)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+6 SET BGP98V=$$V(BGPRPT,BGPNB,BGPP1)
SET BGP98D=$PIECE($PIECE(BGP98V,"!",1),"~",1)+$PIECE($PIECE(BGP98V,"!",2),"~",1)
SET BGP98N=$PIECE($PIECE(BGP98V,"!",1),"~",2)+$PIECE($PIECE(BGP98V,"!",2),"~",2)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+7 SET BGPPRV=$$V(BGPRPT,BGPNP,BGPP1)
SET BGPPRD=$PIECE($PIECE(BGPPRV,"!",1),"~",1)+$PIECE($PIECE(BGPPRV,"!",2),"~",1)
SET BGPPRN=$PIECE($PIECE(BGPPRV,"!",1),"~",2)+$PIECE($PIECE(BGPPRV,"!",2),"~",2)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+8 WRITE !,"# "_BGPP2_" yr olds",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
+9 WRITE !,"# w/ BMI calculated"
+10 DO H2^BGPDPH
+11 SET BGPCYD=BGPCYN
SET BGPCYN=$PIECE($PIECE(BGPV,"!",1),"~",4)+$PIECE($PIECE(BGPV,"!",2),"~",4)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+12 SET BGP98D=BGP98N
SET BGP98N=$PIECE($PIECE(BGP98V,"!",1),"~",4)+$PIECE($PIECE(BGP98V,"!",2),"~",4)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+13 SET BGPPRD=BGPPRN
SET BGPPRN=$PIECE($PIECE(BGPPRV,"!",1),"~",4)+$PIECE($PIECE(BGPPRV,"!",2),"~",4)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+14 WRITE !,"# obese"
+15 DO H2^BGPDPH
+16 SET BGPCYN=$PIECE($PIECE(BGPV,"!",1),"~",3)+$PIECE($PIECE(BGPV,"!",2),"~",3)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+17 SET BGP98N=$PIECE($PIECE(BGP98V,"!",1),"~",3)+$PIECE($PIECE(BGP98V,"!",2),"~",3)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+18 SET BGPPRN=$PIECE($PIECE(BGPPRV,"!",1),"~",3)+$PIECE($PIECE(BGPPRV,"!",2),"~",3)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+19 WRITE !,"# overweight"
+20 DO H2^BGPDPH
PRNF ;
+1 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
DO H1^BGPDPH
+2 SET BGPV=$$V(BGPRPT,BGPN,BGPP1)
SET BGPCYD=$PIECE($PIECE(BGPV,"!",2),"~",1)
SET BGPCYN=$PIECE($PIECE(BGPV,"!",2),"~",2)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+3 SET BGP98V=$$V(BGPRPT,BGPNB,BGPP1)
SET BGP98D=$PIECE($PIECE(BGP98V,"!",2),"~",1)
SET BGP98N=$PIECE($PIECE(BGP98V,"!",2),"~",2)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+4 SET BGPPRV=$$V(BGPRPT,BGPNP,BGPP1)
SET BGPPRD=$PIECE($PIECE(BGPPRV,"!",2),"~",1)
SET BGPPRN=$PIECE($PIECE(BGPPRV,"!",2),"~",2)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+5 WRITE !!!,"# FEMALE "_BGPP2_" yr olds",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
+6 WRITE !,"# w/ BMI calculated"
+7 DO H2^BGPDPH
+8 SET BGPCYD=BGPCYN
SET BGPCYN=$PIECE($PIECE(BGPV,"!",2),"~",4)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+9 SET BGP98D=BGP98N
SET BGP98N=$PIECE($PIECE(BGP98V,"!",2),"~",4)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+10 SET BGPPRD=BGPPRN
SET BGPPRN=$PIECE($PIECE(BGPPRV,"!",2),"~",4)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+11 WRITE !,"# obese"
+12 DO H2^BGPDPH
+13 SET BGPCYN=$PIECE($PIECE(BGPV,"!",2),"~",3)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+14 SET BGP98N=$PIECE($PIECE(BGP98V,"!",2),"~",3)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+15 SET BGPPRN=$PIECE($PIECE(BGPPRV,"!",2),"~",3)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+16 WRITE !,"# overweight"
+17 DO H2^BGPDPH
PRNM ;
+1 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
DO H1^BGPDPH
+2 SET BGPV=$$V(BGPRPT,BGPN,BGPP1)
SET BGPCYD=$PIECE($PIECE(BGPV,"!",1),"~",1)
SET BGPCYN=$PIECE($PIECE(BGPV,"!",1),"~",2)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+3 SET BGP98V=$$V(BGPRPT,BGPNB,BGPP1)
SET BGP98D=$PIECE($PIECE(BGP98V,"!",1),"~",1)
SET BGP98N=$PIECE($PIECE(BGP98V,"!",1),"~",2)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+4 SET BGPPRV=$$V(BGPRPT,BGPNP,BGPP1)
SET BGPPRD=$PIECE($PIECE(BGPPRV,"!",1),"~",1)
SET BGPPRN=$PIECE($PIECE(BGPPRV,"!",1),"~",2)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+5 WRITE !!!,"# MALE "_BGPP2_" yr olds",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
+6 WRITE !,"# w/ BMI calculated"
+7 DO H2^BGPDPH
+8 SET BGPCYD=BGPCYN
SET BGPCYN=$PIECE($PIECE(BGPV,"!",1),"~",4)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+9 SET BGP98D=BGP98N
SET BGP98N=$PIECE($PIECE(BGP98V,"!",1),"~",4)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+10 SET BGPPRD=BGPPRN
SET BGPPRN=$PIECE($PIECE(BGPPRV,"!",1),"~",4)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+11 WRITE !,"# obese"
+12 DO H2^BGPDPH
+13 SET BGPCYN=$PIECE($PIECE(BGPV,"!",1),"~",3)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+14 SET BGP98N=$PIECE($PIECE(BGP98V,"!",1),"~",3)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+15 SET BGPPRN=$PIECE($PIECE(BGPPRV,"!",1),"~",3)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+16 WRITE !,"# overweight"
+17 DO H2^BGPDPH
+18 QUIT
+19 ;
V(R,N,P) ;
+1 NEW Y
+2 IF $GET(BGPAREAA)
IF '$GET(BGPSUMR)
GOTO VA
+3 QUIT $PIECE($GET(^BGPD(R,N)),U,P)
VA ;
+1 NEW X,C,V,MT,FT,M,F,B
SET X=0
SET C=""
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
Begin DoDot:1
+2 SET V=$PIECE($GET(^BGPD(X,N)),U,P)
+3 IF C=""
SET C=V
QUIT
+4 SET MT=$PIECE(C,"!")
SET FT=$PIECE(C,"!",2)
SET M=$PIECE(V,"!")
SET F=$PIECE(V,"!",2)
+5 FOR B=1:1:6
SET $PIECE(MT,"~",B)=$PIECE(MT,"~",B)+$PIECE(M,"~",B)
+6 FOR B=1:1:6
SET $PIECE(FT,"~",B)=$PIECE(FT,"~",B)+$PIECE(F,"~",B)
+7 SET C=MT_"!"_FT
+8 QUIT
End DoDot:1
+9 QUIT C
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
