- BGP7DP50 ; IHS/CMI/LAB - print ind H ;
- ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- ;
- ;
- I1AGEP ;EP
- W:'$G(BGPSUMON) !,"CURRENT REPORT PERIOD"
- W:'$G(BGPSUMON) !,BGPHD2
- S T=23 F X=1:1:6 S V=$P(BGPDAC(X),U) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"# w/ Tobacco Screening"
- S T=23 F X=1:1:6 S V=$P(BGPDAC(X),U,2) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"% w/ Tobacco Screening"
- S T=22 F X=1:1:6 S V=$P(BGPDAC(X),U,3) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- W:'$G(BGPSUMON) !!,"# Tobacco Users"
- S T=23 F X=1:1:6 S V=$P(BGPDAC(X),U,4) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"% Tobacco Users w/ % of ",!," Total Screened"
- S T=22 F X=1:1:6 S V=$P(BGPDAC(X),U,5) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- W:'$G(BGPSUMON) !!,"A. # Smokers"
- S T=23 F X=1:1:6 S V=$P(BGPDAC(X),U,6) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"A. % Smokers w/ % of",!," Total Tobacco Users"
- S T=22 F X=1:1:6 S V=$P(BGPDAC(X),U,7) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- W:'$G(BGPSUMON) !!,"B. # Smokeless"
- S T=23 F X=1:1:6 S V=$P(BGPDAC(X),U,8) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"B. % Smokeless w/ % of",!," Total Tobacco Users"
- S T=22 F X=1:1:6 S V=$P(BGPDAC(X),U,9) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- ;W:'$G(BGPSUMON) !!,"A. # Smokers receiving",!,"Cessation Counseling"
- ;S T=23 F X=1:1:6 S V=$P(BGPDAC(X),U,10) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- ;W:'$G(BGPSUMON) !,"A. % Smokers w/ % of",!," Tobacco Users" w/% of",!," Tobacco Users" receiving",!,"Cessation Counseling"
- ;S T=22 F X=1:1:6 S V=$P(BGPDAC(X),U,11) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- W:'$G(BGPSUMON) !!,"# ETS/Smk Home"
- S T=23 F X=1:1:6 S V=$P(BGPDAC(X),U,12) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"% ETS/Smk Home w/ % of",!," Total Screened"
- S T=22 F X=1:1:6 S V=$P(BGPDAC(X),U,13) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- PR ;
- I $Y>(BGPIOSL-12) I '$G(BGPSUMON) D HEADER^BGP7DPH Q:BGPQUIT W !,^BGPINDG(BGPIC,53,1,0) W:$D(^BGPINDG(BGPIC,53,2,0)) !,^BGPINDG(BGPIC,53,2,0) D H3
- W:'$G(BGPSUMON) !!,"PREVIOUS YEAR PERIOD"
- W:'$G(BGPSUMON) !,BGPHD2
- S T=23 F X=1:1:6 S V=$P(BGPDAP(X),U) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"# w/ Tobacco Screening"
- S T=23 F X=1:1:6 S V=$P(BGPDAP(X),U,2) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"% w/ Tobacco Screening"
- S T=22 F X=1:1:6 S V=$P(BGPDAP(X),U,3) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- W:'$G(BGPSUMON) !!,"# Tobacco Users"
- S T=23 F X=1:1:6 S V=$P(BGPDAP(X),U,4) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"% Tobacco Users w/ % of",!," Total Screened"
- S T=22 F X=1:1:6 S V=$P(BGPDAP(X),U,5) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- W:'$G(BGPSUMON) !!,"A. # Smokers"
- S T=23 F X=1:1:6 S V=$P(BGPDAP(X),U,6) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"A. % Smokers w/ % of",!," Total Tobacco Users"
- S T=22 F X=1:1:6 S V=$P(BGPDAP(X),U,7) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- W:'$G(BGPSUMON) !!,"B. # Smokeless"
- S T=23 F X=1:1:6 S V=$P(BGPDAP(X),U,8) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"B. % Smokeless w/ % of",!," Total Tobacco Users"
- S T=22 F X=1:1:6 S V=$P(BGPDAP(X),U,9) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- ;W:'$G(BGPSUMON) !!,"A. # Smokers receiving",!,"Cessation Counseling"
- ;S T=23 F X=1:1:6 S V=$P(BGPDAP(X),U,10) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- ;W:'$G(BGPSUMON) !,"A. % Smokers w/% of",!," Tobacco Users" w/% of",!," Tobacco Users" receiving",!,"Cessation Counseling"
- ;S T=22 F X=1:1:6 S V=$P(BGPDAP(X),U,11) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- W:'$G(BGPSUMON) !!,"# ETS/Smk Home"
- S T=23 F X=1:1:6 S V=$P(BGPDAP(X),U,12) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"% ETS/Smk Home w/ % of",!," Total Screened"
- S T=22 F X=1:1:6 S V=$P(BGPDAP(X),U,13) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- PB ;
- I $Y>(BGPIOSL-12) I '$G(BGPSUMON) D HEADER^BGP7DPH Q:BGPQUIT W !,^BGPINDG(BGPIC,53,1,0) W:$D(^BGPINDG(BGPIC,53,2,0)) !,^BGPINDG(BGPIC,53,2,0) D H3
- I $Y>(BGPIOSL-12) I '$G(BGPSUMON) D HEADER^BGP7DPH Q:BGPQUIT W !,^BGPINDG(BGPIC,53,1,0) W:$D(^BGPINDG(BGPIC,53,2,0)) !,^BGPINDG(BGPIC,53,2,0) D H3
- ;percentage changes
- W:'$G(BGPSUMON) !!,"CHANGE FROM PREV YR %"
- W:'$G(BGPSUMON) !,"# w/ Tobacco Screening"
- S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,3),O=$P(BGPDAP(X),U,3) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- W:'$G(BGPSUMON) !,"Tobacco Users"
- S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,5),O=$P(BGPDAP(X),U,5) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- W:'$G(BGPSUMON) !,"A. # Smokers"
- S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,7),O=$P(BGPDAP(X),U,7) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- W:'$G(BGPSUMON) !,"B. # Smokeless"
- S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,9),O=$P(BGPDAP(X),U,9) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- ;W:'$G(BGPSUMON) !,"Counseling"
- ;S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,11),O=$P(BGPDAP(X),U,11) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- W:'$G(BGPSUMON) !,"ETS"
- S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,13),O=$P(BGPDAP(X),U,13) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- BL ;
- I $Y>(BGPIOSL-12) I '$G(BGPSUMON) D HEADER^BGP7DPH Q:BGPQUIT W:'$G(BGPSUMON) !,^BGPINDG(BGPIC,53,1,0) W:$D(^BGPINDG(BGPIC,53,2,0)) !,^BGPINDG(BGPIC,53,2,0) D H3
- W:'$G(BGPSUMON) !!,"BASELINE REPORT PERIOD"
- W:'$G(BGPSUMON) !,BGPHD2
- S T=23 F X=1:1:6 S V=$P(BGPDAB(X),U) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"# w/ Tobacco Screening"
- S T=23 F X=1:1:6 S V=$P(BGPDAB(X),U,2) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"% w/ Tobacco Screening"
- S T=22 F X=1:1:6 S V=$P(BGPDAB(X),U,3) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- W:'$G(BGPSUMON) !!,"# Tobacco Users"
- S T=23 F X=1:1:6 S V=$P(BGPDAB(X),U,4) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"% Tobacco Users w/ % of ",!," Total Screened"
- S T=22 F X=1:1:6 S V=$P(BGPDAB(X),U,5) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- W:'$G(BGPSUMON) !!,"A. # Smokers"
- S T=23 F X=1:1:6 S V=$P(BGPDAB(X),U,6) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"A. % Smokers w/ % of",!," Total Tobacco Users"
- S T=22 F X=1:1:6 S V=$P(BGPDAB(X),U,7) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- W:'$G(BGPSUMON) !!,"B. # Smokeless"
- S T=23 F X=1:1:6 S V=$P(BGPDAB(X),U,8) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"B. % Smokeless w/ % of",!," Total Tobacco Users"
- S T=22 F X=1:1:6 S V=$P(BGPDAB(X),U,9) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- ;W:'$G(BGPSUMON) !!,"A. # Smokers receiving",!,"Cessation Counseling"
- ;S T=23 F X=1:1:6 S V=$P(BGPDAB(X),U,10) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- ;W:'$G(BGPSUMON) !,"A. % Smokers w/% of",!," Tobacco Users" w/% of",!," Tobacco Users" receiving",!,"Cessation Counseling"
- ;S T=22 F X=1:1:6 S V=$P(BGPDAB(X),U,11) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- W:'$G(BGPSUMON) !!,"# ETS/Smk Home"
- S T=23 F X=1:1:6 S V=$P(BGPDAB(X),U,12) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- W:'$G(BGPSUMON) !,"% ETS/Smk Home w/ % of",!," Total Screened"
- S T=22 F X=1:1:6 S V=$P(BGPDAB(X),U,13) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- BP ;
- ;percentage changes
- W:'$G(BGPSUMON) !!,"CHANGE FROM BASE YR %"
- W:'$G(BGPSUMON) !,"w/ Tobacco Screening"
- S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,3),O=$P(BGPDAB(X),U,3) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- W:'$G(BGPSUMON) !,"Tobacco Users"
- S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,5),O=$P(BGPDAB(X),U,5) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- W:'$G(BGPSUMON) !,"A. # Smokers"
- S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,7),O=$P(BGPDAB(X),U,7) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- W:'$G(BGPSUMON) !,"B. # Smokeless"
- S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,9),O=$P(BGPDAB(X),U,9) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- ;W:'$G(BGPSUMON) !,"Counseling"
- ;S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,11),O=$P(BGPDAB(X),U,11) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- W:'$G(BGPSUMON) !,"ETS"
- S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,13),O=$P(BGPDAB(X),U,13) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- Q
- SETN ;set numerator fields
- S BGPCYN=$$V^BGP7DP1C(1,BGPRPT,N,P)
- S BGPPRN=$$V^BGP7DP1C(2,BGPRPT,N,P)
- S BGPBLN=$$V^BGP7DP1C(3,BGPRPT,N,P)
- S BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
- S BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
- S BGPBLP=$S(BGPBLD:((BGPBLN/BGPBLD)*100),1:"")
- Q
- V(T,R,N,P) ;EP
- I $G(BGPAREAA) G VA
- I T=1 Q $P($G(^BGPGPDCG(R,N)),U,P)
- I T=2 Q $P($G(^BGPGPDPG(R,N)),U,P)
- I T=3 Q $P($G(^BGPGPDBG(R,N)),U,P)
- Q ""
- VA ;
- NEW X,V,C S X=0,C="" F S X=$O(BGPSUL(X)) Q:X'=+X D
- .I T=1 S C=C+$P($G(^BGPGPDCG(X,N)),U,P)
- .I T=2 S C=C+$P($G(^BGPGPDPG(X,N)),U,P)
- .I T=3 S C=C+$P($G(^BGPGPDBG(X,N)),U,P)
- .Q
- Q C
- ;
- C(X,X2,X3) ;
- D COMMA^%DTC
- Q X
- CTR(X,Y) ;EP - Center X in a field Y wide.
- Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
- ;----------
- H3 ;EP
- Q:$G(BGPSUMON)
- W !!,$$CTR(BGPHD1,80)
- W !?40,"Age Distribution"
- W !?25,"5-13",?30,"14-17",?37,"18-24",?44,"25-44",?51,"45-64",?58,"65+",!
- Q
- BGP7DP50 ; IHS/CMI/LAB - print ind H ;
- +1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- +2 ;
- +3 ;
- I1AGEP ;EP
- +1 IF '$GET(BGPSUMON)
- WRITE !,"CURRENT REPORT PERIOD"
- +2 IF '$GET(BGPSUMON)
- WRITE !,BGPHD2
- +3 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAC(X),U)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +4 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Tobacco Screening"
- +5 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAC(X),U,2)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +6 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Tobacco Screening"
- +7 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAC(X),U,3)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- +8 IF '$GET(BGPSUMON)
- WRITE !!,"# Tobacco Users"
- +9 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAC(X),U,4)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +10 IF '$GET(BGPSUMON)
- WRITE !,"% Tobacco Users w/ % of ",!," Total Screened"
- +11 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAC(X),U,5)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- +12 IF '$GET(BGPSUMON)
- WRITE !!,"A. # Smokers"
- +13 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAC(X),U,6)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +14 IF '$GET(BGPSUMON)
- WRITE !,"A. % Smokers w/ % of",!," Total Tobacco Users"
- +15 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAC(X),U,7)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- +16 IF '$GET(BGPSUMON)
- WRITE !!,"B. # Smokeless"
- +17 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAC(X),U,8)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +18 IF '$GET(BGPSUMON)
- WRITE !,"B. % Smokeless w/ % of",!," Total Tobacco Users"
- +19 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAC(X),U,9)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- +20 ;W:'$G(BGPSUMON) !!,"A. # Smokers receiving",!,"Cessation Counseling"
- +21 ;S T=23 F X=1:1:6 S V=$P(BGPDAC(X),U,10) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- +22 ;W:'$G(BGPSUMON) !,"A. % Smokers w/ % of",!," Tobacco Users" w/% of",!," Tobacco Users" receiving",!,"Cessation Counseling"
- +23 ;S T=22 F X=1:1:6 S V=$P(BGPDAC(X),U,11) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- +24 IF '$GET(BGPSUMON)
- WRITE !!,"# ETS/Smk Home"
- +25 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAC(X),U,12)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +26 IF '$GET(BGPSUMON)
- WRITE !,"% ETS/Smk Home w/ % of",!," Total Screened"
- +27 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAC(X),U,13)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- PR ;
- +1 IF $Y>(BGPIOSL-12)
- IF '$GET(BGPSUMON)
- DO HEADER^BGP7DPH
- IF BGPQUIT
- QUIT
- WRITE !,^BGPINDG(BGPIC,53,1,0)
- IF $DATA(^BGPINDG(BGPIC,53,2,0))
- WRITE !,^BGPINDG(BGPIC,53,2,0)
- DO H3
- +2 IF '$GET(BGPSUMON)
- WRITE !!,"PREVIOUS YEAR PERIOD"
- +3 IF '$GET(BGPSUMON)
- WRITE !,BGPHD2
- +4 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAP(X),U)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +5 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Tobacco Screening"
- +6 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAP(X),U,2)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +7 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Tobacco Screening"
- +8 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAP(X),U,3)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- +9 IF '$GET(BGPSUMON)
- WRITE !!,"# Tobacco Users"
- +10 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAP(X),U,4)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +11 IF '$GET(BGPSUMON)
- WRITE !,"% Tobacco Users w/ % of",!," Total Screened"
- +12 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAP(X),U,5)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- +13 IF '$GET(BGPSUMON)
- WRITE !!,"A. # Smokers"
- +14 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAP(X),U,6)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +15 IF '$GET(BGPSUMON)
- WRITE !,"A. % Smokers w/ % of",!," Total Tobacco Users"
- +16 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAP(X),U,7)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- +17 IF '$GET(BGPSUMON)
- WRITE !!,"B. # Smokeless"
- +18 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAP(X),U,8)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +19 IF '$GET(BGPSUMON)
- WRITE !,"B. % Smokeless w/ % of",!," Total Tobacco Users"
- +20 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAP(X),U,9)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- +21 ;W:'$G(BGPSUMON) !!,"A. # Smokers receiving",!,"Cessation Counseling"
- +22 ;S T=23 F X=1:1:6 S V=$P(BGPDAP(X),U,10) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- +23 ;W:'$G(BGPSUMON) !,"A. % Smokers w/% of",!," Tobacco Users" w/% of",!," Tobacco Users" receiving",!,"Cessation Counseling"
- +24 ;S T=22 F X=1:1:6 S V=$P(BGPDAP(X),U,11) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- +25 IF '$GET(BGPSUMON)
- WRITE !!,"# ETS/Smk Home"
- +26 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAP(X),U,12)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +27 IF '$GET(BGPSUMON)
- WRITE !,"% ETS/Smk Home w/ % of",!," Total Screened"
- +28 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAP(X),U,13)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- PB ;
- +1 IF $Y>(BGPIOSL-12)
- IF '$GET(BGPSUMON)
- DO HEADER^BGP7DPH
- IF BGPQUIT
- QUIT
- WRITE !,^BGPINDG(BGPIC,53,1,0)
- IF $DATA(^BGPINDG(BGPIC,53,2,0))
- WRITE !,^BGPINDG(BGPIC,53,2,0)
- DO H3
- +2 IF $Y>(BGPIOSL-12)
- IF '$GET(BGPSUMON)
- DO HEADER^BGP7DPH
- IF BGPQUIT
- QUIT
- WRITE !,^BGPINDG(BGPIC,53,1,0)
- IF $DATA(^BGPINDG(BGPIC,53,2,0))
- WRITE !,^BGPINDG(BGPIC,53,2,0)
- DO H3
- +3 ;percentage changes
- +4 IF '$GET(BGPSUMON)
- WRITE !!,"CHANGE FROM PREV YR %"
- +5 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Tobacco Screening"
- +6 SET T=22
- FOR X=1:1:6
- SET N=$PIECE(BGPDAC(X),U,3)
- SET O=$PIECE(BGPDAP(X),U,3)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY($FNUMBER((N-O),"+,",1),6)
- SET T=T+7
- +7 IF '$GET(BGPSUMON)
- WRITE !,"Tobacco Users"
- +8 SET T=22
- FOR X=1:1:6
- SET N=$PIECE(BGPDAC(X),U,5)
- SET O=$PIECE(BGPDAP(X),U,5)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY($FNUMBER((N-O),"+,",1),6)
- SET T=T+7
- +9 IF '$GET(BGPSUMON)
- WRITE !,"A. # Smokers"
- +10 SET T=22
- FOR X=1:1:6
- SET N=$PIECE(BGPDAC(X),U,7)
- SET O=$PIECE(BGPDAP(X),U,7)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY($FNUMBER((N-O),"+,",1),6)
- SET T=T+7
- +11 IF '$GET(BGPSUMON)
- WRITE !,"B. # Smokeless"
- +12 SET T=22
- FOR X=1:1:6
- SET N=$PIECE(BGPDAC(X),U,9)
- SET O=$PIECE(BGPDAP(X),U,9)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY($FNUMBER((N-O),"+,",1),6)
- SET T=T+7
- +13 ;W:'$G(BGPSUMON) !,"Counseling"
- +14 ;S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,11),O=$P(BGPDAP(X),U,11) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- +15 IF '$GET(BGPSUMON)
- WRITE !,"ETS"
- +16 SET T=22
- FOR X=1:1:6
- SET N=$PIECE(BGPDAC(X),U,13)
- SET O=$PIECE(BGPDAP(X),U,13)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY($FNUMBER((N-O),"+,",1),6)
- SET T=T+7
- BL ;
- +1 IF $Y>(BGPIOSL-12)
- IF '$GET(BGPSUMON)
- DO HEADER^BGP7DPH
- IF BGPQUIT
- QUIT
- IF '$GET(BGPSUMON)
- WRITE !,^BGPINDG(BGPIC,53,1,0)
- IF $DATA(^BGPINDG(BGPIC,53,2,0))
- WRITE !,^BGPINDG(BGPIC,53,2,0)
- DO H3
- +2 IF '$GET(BGPSUMON)
- WRITE !!,"BASELINE REPORT PERIOD"
- +3 IF '$GET(BGPSUMON)
- WRITE !,BGPHD2
- +4 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAB(X),U)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +5 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Tobacco Screening"
- +6 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAB(X),U,2)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +7 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Tobacco Screening"
- +8 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAB(X),U,3)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- +9 IF '$GET(BGPSUMON)
- WRITE !!,"# Tobacco Users"
- +10 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAB(X),U,4)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +11 IF '$GET(BGPSUMON)
- WRITE !,"% Tobacco Users w/ % of ",!," Total Screened"
- +12 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAB(X),U,5)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- +13 IF '$GET(BGPSUMON)
- WRITE !!,"A. # Smokers"
- +14 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAB(X),U,6)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +15 IF '$GET(BGPSUMON)
- WRITE !,"A. % Smokers w/ % of",!," Total Tobacco Users"
- +16 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAB(X),U,7)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- +17 IF '$GET(BGPSUMON)
- WRITE !!,"B. # Smokeless"
- +18 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAB(X),U,8)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +19 IF '$GET(BGPSUMON)
- WRITE !,"B. % Smokeless w/ % of",!," Total Tobacco Users"
- +20 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAB(X),U,9)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- +21 ;W:'$G(BGPSUMON) !!,"A. # Smokers receiving",!,"Cessation Counseling"
- +22 ;S T=23 F X=1:1:6 S V=$P(BGPDAB(X),U,10) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+7
- +23 ;W:'$G(BGPSUMON) !,"A. % Smokers w/% of",!," Tobacco Users" w/% of",!," Tobacco Users" receiving",!,"Cessation Counseling"
- +24 ;S T=22 F X=1:1:6 S V=$P(BGPDAB(X),U,11) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+7
- +25 IF '$GET(BGPSUMON)
- WRITE !!,"# ETS/Smk Home"
- +26 SET T=23
- FOR X=1:1:6
- SET V=$PIECE(BGPDAB(X),U,12)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+7
- +27 IF '$GET(BGPSUMON)
- WRITE !,"% ETS/Smk Home w/ % of",!," Total Screened"
- +28 SET T=22
- FOR X=1:1:6
- SET V=$PIECE(BGPDAB(X),U,13)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+7
- BP ;
- +1 ;percentage changes
- +2 IF '$GET(BGPSUMON)
- WRITE !!,"CHANGE FROM BASE YR %"
- +3 IF '$GET(BGPSUMON)
- WRITE !,"w/ Tobacco Screening"
- +4 SET T=22
- FOR X=1:1:6
- SET N=$PIECE(BGPDAC(X),U,3)
- SET O=$PIECE(BGPDAB(X),U,3)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY($FNUMBER((N-O),"+,",1),6)
- SET T=T+7
- +5 IF '$GET(BGPSUMON)
- WRITE !,"Tobacco Users"
- +6 SET T=22
- FOR X=1:1:6
- SET N=$PIECE(BGPDAC(X),U,5)
- SET O=$PIECE(BGPDAB(X),U,5)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY($FNUMBER((N-O),"+,",1),6)
- SET T=T+7
- +7 IF '$GET(BGPSUMON)
- WRITE !,"A. # Smokers"
- +8 SET T=22
- FOR X=1:1:6
- SET N=$PIECE(BGPDAC(X),U,7)
- SET O=$PIECE(BGPDAB(X),U,7)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY($FNUMBER((N-O),"+,",1),6)
- SET T=T+7
- +9 IF '$GET(BGPSUMON)
- WRITE !,"B. # Smokeless"
- +10 SET T=22
- FOR X=1:1:6
- SET N=$PIECE(BGPDAC(X),U,9)
- SET O=$PIECE(BGPDAB(X),U,9)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY($FNUMBER((N-O),"+,",1),6)
- SET T=T+7
- +11 ;W:'$G(BGPSUMON) !,"Counseling"
- +12 ;S T=22 F X=1:1:6 S N=$P(BGPDAC(X),U,11),O=$P(BGPDAB(X),U,11) W:'$G(BGPSUMON) ?T,$J($FN((N-O),"+,",1),6) S T=T+7
- +13 IF '$GET(BGPSUMON)
- WRITE !,"ETS"
- +14 SET T=22
- FOR X=1:1:6
- SET N=$PIECE(BGPDAC(X),U,13)
- SET O=$PIECE(BGPDAB(X),U,13)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY($FNUMBER((N-O),"+,",1),6)
- SET T=T+7
- +15 QUIT
- SETN ;set numerator fields
- +1 SET BGPCYN=$$V^BGP7DP1C(1,BGPRPT,N,P)
- +2 SET BGPPRN=$$V^BGP7DP1C(2,BGPRPT,N,P)
- +3 SET BGPBLN=$$V^BGP7DP1C(3,BGPRPT,N,P)
- +4 SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
- +5 SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
- +6 SET BGPBLP=$SELECT(BGPBLD:((BGPBLN/BGPBLD)*100),1:"")
- +7 QUIT
- V(T,R,N,P) ;EP
- +1 IF $GET(BGPAREAA)
- GOTO VA
- +2 IF T=1
- QUIT $PIECE($GET(^BGPGPDCG(R,N)),U,P)
- +3 IF T=2
- QUIT $PIECE($GET(^BGPGPDPG(R,N)),U,P)
- +4 IF T=3
- QUIT $PIECE($GET(^BGPGPDBG(R,N)),U,P)
- +5 QUIT ""
- VA ;
- +1 NEW X,V,C
- SET X=0
- SET C=""
- FOR
- SET X=$ORDER(BGPSUL(X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +2 IF T=1
- SET C=C+$PIECE($GET(^BGPGPDCG(X,N)),U,P)
- +3 IF T=2
- SET C=C+$PIECE($GET(^BGPGPDPG(X,N)),U,P)
- +4 IF T=3
- SET C=C+$PIECE($GET(^BGPGPDBG(X,N)),U,P)
- +5 QUIT
- End DoDot:1
- +6 QUIT C
- +7 ;
- C(X,X2,X3) ;
- +1 DO COMMA^%DTC
- +2 QUIT X
- CTR(X,Y) ;EP - Center X in a field Y wide.
- +1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
- +2 ;----------
- H3 ;EP
- +1 IF $GET(BGPSUMON)
- QUIT
- +2 WRITE !!,$$CTR(BGPHD1,80)
- +3 WRITE !?40,"Age Distribution"
- +4 WRITE !?25,"5-13",?30,"14-17",?37,"18-24",?44,"25-44",?51,"45-64",?58,"65+",!
- +5 QUIT