BGPDPC ; IHS/CMI/LAB - IHS gpra print ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
;
IC ;EP - diabetes prevalence
D HEADER^BGPDPH
W !!,"Indicator C: Increase the quality, availability, and effectiveness of ",!,"educational services designed to prevent disease and improve the health and",!,"quality of life."
W !,"Increase the proportion of persons who are provided patient education",!,"on diet and exercise.",!
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT
W !,"Provision of Diet and Exercise Education",!
D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,10,1),"!",1)+$P($$V(BGPRPT,10,1),"!",2),BGPCYN=$P($$V(BGPRPT,29,10),"!",1)+$P($$V(BGPRPT,29,10),"!",2),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,80,1),"!",1)+$P($$V(BGPRPT,80,1),"!",2),BGP98N=$P($$V(BGPRPT,99,10),"!",1)+$P($$V(BGPRPT,99,10),"!",2),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,40,1),"!",1)+$P($$V(BGPRPT,40,1),"!",2),BGPPRN=$P($$V(BGPRPT,59,10),"!",1)+$P($$V(BGPRPT,59,10),"!",2),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !,"# active users",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
W !,"# w/ Education provided w/in 1 yr of",!,"end of time period"
D H2^BGPDPH
FEMP ;
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,10,1),"!",2),BGPCYN=$P($$V(BGPRPT,29,10),"!",2),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,80,1),"!",2),BGP98N=$P($$V(BGPRPT,99,10),"!",2),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,40,1),"!",2),BGPPRN=$P($$V(BGPRPT,59,10),"!",2),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!!,"# FEMALE active users",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
W !,"# w/ Education provided w/in 1 yr of",!,"end of time period"
D H2^BGPDPH
MALEP ;
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,10,1),"!",1),BGPCYN=$P($$V(BGPRPT,29,10),"!",1),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,80,1),"!",1),BGP98N=$P($$V(BGPRPT,99,10),"!",1),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,40,1),"!",1),BGPPRN=$P($$V(BGPRPT,59,10),"!",1),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!!,"# MALE active users",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
W !,"# w/ Education provided w/in 1 yr of",!,"end of time period"
D H2^BGPDPH
C5A ;
AGE11 ;EP
S BGPHD1="TOTAL ACTIVE USERS"
D HEADER^BGPDPH Q:BGPQUIT D H6^BGPDPH
W !,"CURRENT REPORTING PERIOD"
W !,"Total # active users"
S T=23 F X=2:1:9 S Y=$$V(BGPRPT,29,X) S V=$P(Y,"!")+$P(Y,"!",2) W ?T,$$C(V,0,6) S T=T+7
W !,"# w/Education"
S T=23 F X=11:1:18 S Y=$$V(BGPRPT,29,X),V=$P(Y,"!")+$P(Y,"!",2) W ?T,$$C(V,0,6) S T=T+7
K BGPX
S BGPNODE=10 D CHG1
I $Y>(IOSL-8) D HEADER^BGPDPH Q:BGPQUIT D H6^BGPDPH
W !!,"PREVIOUS YEAR PERIOD"
W !,"Total # active users"
S T=23 F X=2:1:9 S Y=$$V(BGPRPT,59,X) S V=$P(Y,"!")+$P(Y,"!",2) W ?T,$$C(V,0,6) S T=T+7
W !,"# w/Education"
S T=23 F X=11:1:18 S Y=$$V(BGPRPT,59,X),V=$P(Y,"!")+$P(Y,"!",2) W ?T,$$C(V,0,6) S T=T+7
S BGPNODE=40 D CHG1
I $Y>(IOSL-8) D HEADER^BGPDPH Q:BGPQUIT D H6^BGPDPH
W !!,"BASELINE REPORTING PERIOD"
W !,"Total # active users"
S T=23 F X=2:1:9 S Y=$$V(BGPRPT,99,X) S V=$P(Y,"!")+$P(Y,"!",2) W ?T,$$C(V,0,6) S T=T+7
W !,"# w/Education"
S T=23 F X=11:1:18 S Y=$$V(BGPRPT,99,X),V=$P(Y,"!")+$P(Y,"!",2) W ?T,$$C(V,0,6) S T=T+7
S BGPNODE=80 D CHG1
D CHG
FAGEP ;
S BGPHD1="FEMALE ACTIVE USERS"
D HEADER^BGPDPH Q:BGPQUIT D H6^BGPDPH
W !,"CURRENT REPORTING PERIOD"
W !,"# FEMALE active users"
S T=23 F X=2:1:9 S Y=$$V(BGPRPT,29,X) S V=$P(Y,"!",2) W ?T,$$C(V,0,6) S T=T+7
W !,"# w/Education"
S T=23 F X=11:1:18 S Y=$$V(BGPRPT,29,X),V=$P(Y,"!",2) W ?T,$$C(V,0,6) S T=T+7
K BGPX W !,"% w/Education" S T=23 F X=11:1:18 S N=$$V(BGPRPT,29,X),D=$$V(BGPRPT,29,(X-9)),N1=$P(N,"!",2),D1=$P(D,"!",2),%=$S('D1:"",1:(N1/D1)*100) W ?T,$S(%="":" .",1:$J(%,5,1)) S T=T+7 S $P(BGPX(X),U)=%
I $Y>(IOSL-8) D HEADER^BGPDPH Q:BGPQUIT D H6^BGPDPH
W !!,"PREVIOUS YEAR PERIOD"
W !,"# FEMALE active users"
S T=23 F X=2:1:9 S Y=$$V(BGPRPT,59,X) S V=$P(Y,"!",2) W ?T,$$C(V,0,6) S T=T+7
W !,"# w/Education"
S T=23 F X=11:1:18 S Y=$$V(BGPRPT,59,X),V=$P(Y,"!",2) W ?T,$$C(V,0,6) S T=T+7
W !,"% w/Education" S T=23 F X=11:1:18 S N=$$V(BGPRPT,59,X),D=$$V(BGPRPT,59,(X-9)),N1=$P(N,"!",2),D1=$P(D,"!",2),%=$S('D1:"",1:(N1/D1)*100) W ?T,$S(%="":" .",1:$J(%,5,1)) S T=T+7 S $P(BGPX(X),U,3)=%
I $Y>(IOSL-8) D HEADER^BGPDPH Q:BGPQUIT D H6^BGPDPH
W !!,"BASELINE REPORTING PERIOD"
W !,"# FEMALE active users"
S T=23 F X=2:1:9 S Y=$$V(BGPRPT,99,X) S V=$P(Y,"!",2) W ?T,$$C(V,0,6) S T=T+7
W !,"# w/Education"
S T=23 F X=11:1:18 S Y=$$V(BGPRPT,99,X),V=$P(Y,"!",2) W ?T,$$C(V,0,6) S T=T+7
W !,"% w/Education" S T=23 F X=11:1:18 S N=$$V(BGPRPT,99,X),D=$$V(BGPRPT,99,(X-9)),N1=$P(N,"!",2),D1=$P(D,"!",2),%=$S('D1:"",1:(N1/D1)*100) W ?T,$S(%="":" .",1:$J(%,5,1)) S T=T+7 S $P(BGPX(X),U,2)=%
D CHG
MAGEP ;
S BGPHD1="MALE ACTIVE USERS"
D HEADER^BGPDPH Q:BGPQUIT D H6^BGPDPH
W !,"CURRENT REPORTING PERIOD"
W !,"# MALE active users"
S T=23 F X=2:1:9 S Y=$$V(BGPRPT,29,X) S V=$P(Y,"!",1) W ?T,$$C(V,0,6) S T=T+7
W !,"# w/Education"
S T=23 F X=11:1:18 S Y=$$V(BGPRPT,29,X),V=$P(Y,"!",1) W ?T,$$C(V,0,6) S T=T+7
K BGPX W !,"% w/Education" S T=23 F X=11:1:18 S N=$$V(BGPRPT,29,X),D=$$V(BGPRPT,29,(X-9)),N1=$P(N,"!",1),D1=$P(D,"!",1),%=$S('D1:"",1:(N1/D1)*100) W ?T,$S(%="":" .",1:$J(%,5,1)) S T=T+7 S $P(BGPX(X),U)=%
I $Y>(IOSL-8) D HEADER^BGPDPH Q:BGPQUIT D H6^BGPDPH
W !!,"PREVIOUS YEAR PERIOD"
W !,"# MALE active users"
S T=23 F X=2:1:9 S Y=$$V(BGPRPT,59,X) S V=$P(Y,"!",1) W ?T,$$C(V,0,6) S T=T+7
W !,"# w/Education"
S T=23 F X=11:1:18 S Y=$$V(BGPRPT,59,X),V=$P(Y,"!",1) W ?T,$$C(V,0,6) S T=T+7
W !,"% w/Education" S T=23 F X=11:1:18 S N=$$V(BGPRPT,59,X),D=$$V(BGPRPT,59,(X-9)),N1=$P(N,"!",1),D1=$P(D,"!",1),%=$S('D1:"",1:(N1/D1)*100) W ?T,$S(%="":" .",1:$J(%,5,1)) S T=T+7 S $P(BGPX(X),U,3)=%
I $Y>(IOSL-8) D HEADER^BGPDPH Q:BGPQUIT D H6^BGPDPH
W !!,"BASELINE REPORTING PERIOD"
W !,"# MALE active users"
S T=23 F X=2:1:9 S Y=$$V(BGPRPT,99,X) S V=$P(Y,"!",1) W ?T,$$C(V,0,6) S T=T+7
W !,"# w/Education"
S T=23 F X=11:1:18 S Y=$$V(BGPRPT,99,X),V=$P(Y,"!",1) W ?T,$$C(V,0,6) S T=T+7
W !,"% w/Education" S T=23 F X=11:1:18 S N=$$V(BGPRPT,99,X),D=$$V(BGPRPT,99,(X-9)),N1=$P(N,"!",1),D1=$P(D,"!",1),%=$S('D1:"",1:(N1/D1)*100) W ?T,$S(%="":" .",1:$J(%,5,1)) S T=T+7 S $P(BGPX(X),U,2)=%
D CHG
Q
CHG1 ;
W !,"% w/Education" S T=23 F X=11:1:18 S N=$$V(BGPRPT,BGPNODE,X),D=$$V(BGPRPT,BGPNODE,(X-9)),N1=$P(N,"!")+$P(N,"!",2),D1=$P(D,"!")+$P(D,"!",2),%=$S('D1:"",1:(N1/D1)*100) W ?T,$S(%="":" .",1:$J(%,5,1)) S T=T+7 D
.S A=$S(BGPNODE=10:1,BGPNODE=40:3,BGPNODE=80:2,1:"") S $P(BGPX(X),U,A)=%
Q
CHG ;
S T=23 W !!,"% Change from prev yr" S X=0 F S X=$O(BGPX(X)) Q:X'=+X S N=$P(BGPX(X),U),O=$P(BGPX(X),U,3) W ?T,$J($$CALC(N,O),6) S T=T+7
S T=23 W !!,"% Change from base yr" S X=0 F S X=$O(BGPX(X)) Q:X'=+X S N=$P(BGPX(X),U),O=$P(BGPX(X),U,2) W ?T,$J($$CALC(N,O),6) S T=T+7
Q
CALC(N,O) ;ENTRY POINT
NEW Z
I O=0!(N=0)!(O="")!(N="") Q "**"
NEW X,X2,X3
S X=N,X2=1,X3=0 D COMMA^%DTC S N=X
S X=O,X2=1,X3=0 D COMMA^%DTC S O=X
I +O=0 Q "**"
S Z=(((N-O)/O)*100),Z=$FN(Z,"+,",1)
Q Z
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
BGPDPC ; IHS/CMI/LAB - IHS gpra print ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
+3 ;
IC ;EP - diabetes prevalence
+1 DO HEADER^BGPDPH
+2 WRITE !!,"Indicator C: Increase the quality, availability, and effectiveness of ",!,"educational services designed to prevent disease and improve the health and",!,"quality of life."
+3 WRITE !,"Increase the proportion of persons who are provided patient education",!,"on diet and exercise.",!
+4 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
+5 WRITE !,"Provision of Diet and Exercise Education",!
+6 DO H1^BGPDPH
+7 SET BGPCYD=$PIECE($$V(BGPRPT,10,1),"!",1)+$PIECE($$V(BGPRPT,10,1),"!",2)
SET BGPCYN=$PIECE($$V(BGPRPT,29,10),"!",1)+$PIECE($$V(BGPRPT,29,10),"!",2)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+8 SET BGP98D=$PIECE($$V(BGPRPT,80,1),"!",1)+$PIECE($$V(BGPRPT,80,1),"!",2)
SET BGP98N=$PIECE($$V(BGPRPT,99,10),"!",1)+$PIECE($$V(BGPRPT,99,10),"!",2)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+9 SET BGPPRD=$PIECE($$V(BGPRPT,40,1),"!",1)+$PIECE($$V(BGPRPT,40,1),"!",2)
SET BGPPRN=$PIECE($$V(BGPRPT,59,10),"!",1)+$PIECE($$V(BGPRPT,59,10),"!",2)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+10 WRITE !,"# active users",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
+11 WRITE !,"# w/ Education provided w/in 1 yr of",!,"end of time period"
+12 DO H2^BGPDPH
FEMP ;
+1 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
DO H1^BGPDPH
+2 SET BGPCYD=$PIECE($$V(BGPRPT,10,1),"!",2)
SET BGPCYN=$PIECE($$V(BGPRPT,29,10),"!",2)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+3 SET BGP98D=$PIECE($$V(BGPRPT,80,1),"!",2)
SET BGP98N=$PIECE($$V(BGPRPT,99,10),"!",2)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+4 SET BGPPRD=$PIECE($$V(BGPRPT,40,1),"!",2)
SET BGPPRN=$PIECE($$V(BGPRPT,59,10),"!",2)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+5 WRITE !!!,"# FEMALE active users",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
+6 WRITE !,"# w/ Education provided w/in 1 yr of",!,"end of time period"
+7 DO H2^BGPDPH
MALEP ;
+1 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
DO H1^BGPDPH
+2 SET BGPCYD=$PIECE($$V(BGPRPT,10,1),"!",1)
SET BGPCYN=$PIECE($$V(BGPRPT,29,10),"!",1)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+3 SET BGP98D=$PIECE($$V(BGPRPT,80,1),"!",1)
SET BGP98N=$PIECE($$V(BGPRPT,99,10),"!",1)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+4 SET BGPPRD=$PIECE($$V(BGPRPT,40,1),"!",1)
SET BGPPRN=$PIECE($$V(BGPRPT,59,10),"!",1)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+5 WRITE !!!,"# MALE active users",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
+6 WRITE !,"# w/ Education provided w/in 1 yr of",!,"end of time period"
+7 DO H2^BGPDPH
C5A ;
AGE11 ;EP
+1 SET BGPHD1="TOTAL ACTIVE USERS"
+2 DO HEADER^BGPDPH
IF BGPQUIT
QUIT
DO H6^BGPDPH
+3 WRITE !,"CURRENT REPORTING PERIOD"
+4 WRITE !,"Total # active users"
+5 SET T=23
FOR X=2:1:9
SET Y=$$V(BGPRPT,29,X)
SET V=$PIECE(Y,"!")+$PIECE(Y,"!",2)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+6 WRITE !,"# w/Education"
+7 SET T=23
FOR X=11:1:18
SET Y=$$V(BGPRPT,29,X)
SET V=$PIECE(Y,"!")+$PIECE(Y,"!",2)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+8 KILL BGPX
+9 SET BGPNODE=10
DO CHG1
+10 IF $Y>(IOSL-8)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
DO H6^BGPDPH
+11 WRITE !!,"PREVIOUS YEAR PERIOD"
+12 WRITE !,"Total # active users"
+13 SET T=23
FOR X=2:1:9
SET Y=$$V(BGPRPT,59,X)
SET V=$PIECE(Y,"!")+$PIECE(Y,"!",2)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+14 WRITE !,"# w/Education"
+15 SET T=23
FOR X=11:1:18
SET Y=$$V(BGPRPT,59,X)
SET V=$PIECE(Y,"!")+$PIECE(Y,"!",2)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+16 SET BGPNODE=40
DO CHG1
+17 IF $Y>(IOSL-8)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
DO H6^BGPDPH
+18 WRITE !!,"BASELINE REPORTING PERIOD"
+19 WRITE !,"Total # active users"
+20 SET T=23
FOR X=2:1:9
SET Y=$$V(BGPRPT,99,X)
SET V=$PIECE(Y,"!")+$PIECE(Y,"!",2)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+21 WRITE !,"# w/Education"
+22 SET T=23
FOR X=11:1:18
SET Y=$$V(BGPRPT,99,X)
SET V=$PIECE(Y,"!")+$PIECE(Y,"!",2)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+23 SET BGPNODE=80
DO CHG1
+24 DO CHG
FAGEP ;
+1 SET BGPHD1="FEMALE ACTIVE USERS"
+2 DO HEADER^BGPDPH
IF BGPQUIT
QUIT
DO H6^BGPDPH
+3 WRITE !,"CURRENT REPORTING PERIOD"
+4 WRITE !,"# FEMALE active users"
+5 SET T=23
FOR X=2:1:9
SET Y=$$V(BGPRPT,29,X)
SET V=$PIECE(Y,"!",2)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+6 WRITE !,"# w/Education"
+7 SET T=23
FOR X=11:1:18
SET Y=$$V(BGPRPT,29,X)
SET V=$PIECE(Y,"!",2)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+8 KILL BGPX
WRITE !,"% w/Education"
SET T=23
FOR X=11:1:18
SET N=$$V(BGPRPT,29,X)
SET D=$$V(BGPRPT,29,(X-9))
SET N1=$PIECE(N,"!",2)
SET D1=$PIECE(D,"!",2)
SET %=$SELECT('D1:"",1:(N1/D1)*100)
WRITE ?T,$SELECT(%="":" .",1:$JUSTIFY(%,5,1))
SET T=T+7
SET $PIECE(BGPX(X),U)=%
+9 IF $Y>(IOSL-8)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
DO H6^BGPDPH
+10 WRITE !!,"PREVIOUS YEAR PERIOD"
+11 WRITE !,"# FEMALE active users"
+12 SET T=23
FOR X=2:1:9
SET Y=$$V(BGPRPT,59,X)
SET V=$PIECE(Y,"!",2)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+13 WRITE !,"# w/Education"
+14 SET T=23
FOR X=11:1:18
SET Y=$$V(BGPRPT,59,X)
SET V=$PIECE(Y,"!",2)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+15 WRITE !,"% w/Education"
SET T=23
FOR X=11:1:18
SET N=$$V(BGPRPT,59,X)
SET D=$$V(BGPRPT,59,(X-9))
SET N1=$PIECE(N,"!",2)
SET D1=$PIECE(D,"!",2)
SET %=$SELECT('D1:"",1:(N1/D1)*100)
WRITE ?T,$SELECT(%="":" .",1:$JUSTIFY(%,5,1))
SET T=T+7
SET $PIECE(BGPX(X),U,3)=%
+16 IF $Y>(IOSL-8)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
DO H6^BGPDPH
+17 WRITE !!,"BASELINE REPORTING PERIOD"
+18 WRITE !,"# FEMALE active users"
+19 SET T=23
FOR X=2:1:9
SET Y=$$V(BGPRPT,99,X)
SET V=$PIECE(Y,"!",2)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+20 WRITE !,"# w/Education"
+21 SET T=23
FOR X=11:1:18
SET Y=$$V(BGPRPT,99,X)
SET V=$PIECE(Y,"!",2)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+22 WRITE !,"% w/Education"
SET T=23
FOR X=11:1:18
SET N=$$V(BGPRPT,99,X)
SET D=$$V(BGPRPT,99,(X-9))
SET N1=$PIECE(N,"!",2)
SET D1=$PIECE(D,"!",2)
SET %=$SELECT('D1:"",1:(N1/D1)*100)
WRITE ?T,$SELECT(%="":" .",1:$JUSTIFY(%,5,1))
SET T=T+7
SET $PIECE(BGPX(X),U,2)=%
+23 DO CHG
MAGEP ;
+1 SET BGPHD1="MALE ACTIVE USERS"
+2 DO HEADER^BGPDPH
IF BGPQUIT
QUIT
DO H6^BGPDPH
+3 WRITE !,"CURRENT REPORTING PERIOD"
+4 WRITE !,"# MALE active users"
+5 SET T=23
FOR X=2:1:9
SET Y=$$V(BGPRPT,29,X)
SET V=$PIECE(Y,"!",1)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+6 WRITE !,"# w/Education"
+7 SET T=23
FOR X=11:1:18
SET Y=$$V(BGPRPT,29,X)
SET V=$PIECE(Y,"!",1)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+8 KILL BGPX
WRITE !,"% w/Education"
SET T=23
FOR X=11:1:18
SET N=$$V(BGPRPT,29,X)
SET D=$$V(BGPRPT,29,(X-9))
SET N1=$PIECE(N,"!",1)
SET D1=$PIECE(D,"!",1)
SET %=$SELECT('D1:"",1:(N1/D1)*100)
WRITE ?T,$SELECT(%="":" .",1:$JUSTIFY(%,5,1))
SET T=T+7
SET $PIECE(BGPX(X),U)=%
+9 IF $Y>(IOSL-8)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
DO H6^BGPDPH
+10 WRITE !!,"PREVIOUS YEAR PERIOD"
+11 WRITE !,"# MALE active users"
+12 SET T=23
FOR X=2:1:9
SET Y=$$V(BGPRPT,59,X)
SET V=$PIECE(Y,"!",1)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+13 WRITE !,"# w/Education"
+14 SET T=23
FOR X=11:1:18
SET Y=$$V(BGPRPT,59,X)
SET V=$PIECE(Y,"!",1)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+15 WRITE !,"% w/Education"
SET T=23
FOR X=11:1:18
SET N=$$V(BGPRPT,59,X)
SET D=$$V(BGPRPT,59,(X-9))
SET N1=$PIECE(N,"!",1)
SET D1=$PIECE(D,"!",1)
SET %=$SELECT('D1:"",1:(N1/D1)*100)
WRITE ?T,$SELECT(%="":" .",1:$JUSTIFY(%,5,1))
SET T=T+7
SET $PIECE(BGPX(X),U,3)=%
+16 IF $Y>(IOSL-8)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
DO H6^BGPDPH
+17 WRITE !!,"BASELINE REPORTING PERIOD"
+18 WRITE !,"# MALE active users"
+19 SET T=23
FOR X=2:1:9
SET Y=$$V(BGPRPT,99,X)
SET V=$PIECE(Y,"!",1)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+20 WRITE !,"# w/Education"
+21 SET T=23
FOR X=11:1:18
SET Y=$$V(BGPRPT,99,X)
SET V=$PIECE(Y,"!",1)
WRITE ?T,$$C(V,0,6)
SET T=T+7
+22 WRITE !,"% w/Education"
SET T=23
FOR X=11:1:18
SET N=$$V(BGPRPT,99,X)
SET D=$$V(BGPRPT,99,(X-9))
SET N1=$PIECE(N,"!",1)
SET D1=$PIECE(D,"!",1)
SET %=$SELECT('D1:"",1:(N1/D1)*100)
WRITE ?T,$SELECT(%="":" .",1:$JUSTIFY(%,5,1))
SET T=T+7
SET $PIECE(BGPX(X),U,2)=%
+23 DO CHG
+24 QUIT
CHG1 ;
+1 WRITE !,"% w/Education"
SET T=23
FOR X=11:1:18
SET N=$$V(BGPRPT,BGPNODE,X)
SET D=$$V(BGPRPT,BGPNODE,(X-9))
SET N1=$PIECE(N,"!")+$PIECE(N,"!",2)
SET D1=$PIECE(D,"!")+$PIECE(D,"!",2)
SET %=$SELECT('D1:"",1:(N1/D1)*100)
WRITE ?T,$SELECT(%="":" .",1:$JUSTIFY(%,5,1))
SET T=T+7
Begin DoDot:1
+2 SET A=$SELECT(BGPNODE=10:1,BGPNODE=40:3,BGPNODE=80:2,1:"")
SET $PIECE(BGPX(X),U,A)=%
End DoDot:1
+3 QUIT
CHG ;
+1 SET T=23
WRITE !!,"% Change from prev yr"
SET X=0
FOR
SET X=$ORDER(BGPX(X))
IF X'=+X
QUIT
SET N=$PIECE(BGPX(X),U)
SET O=$PIECE(BGPX(X),U,3)
WRITE ?T,$JUSTIFY($$CALC(N,O),6)
SET T=T+7
+2 SET T=23
WRITE !!,"% Change from base yr"
SET X=0
FOR
SET X=$ORDER(BGPX(X))
IF X'=+X
QUIT
SET N=$PIECE(BGPX(X),U)
SET O=$PIECE(BGPX(X),U,2)
WRITE ?T,$JUSTIFY($$CALC(N,O),6)
SET T=T+7
+3 QUIT
CALC(N,O) ;ENTRY POINT
+1 NEW Z
+2 IF O=0!(N=0)!(O="")!(N="")
QUIT "**"
+3 NEW X,X2,X3
+4 SET X=N
SET X2=1
SET X3=0
DO COMMA^%DTC
SET N=X
+5 SET X=O
SET X2=1
SET X3=0
DO COMMA^%DTC
SET O=X
+6 IF +O=0
QUIT "**"
+7 SET Z=(((N-O)/O)*100)
SET Z=$FNUMBER(Z,"+,",1)
+8 QUIT Z
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
