- BGP7DP60 ; IHS/CMI/LAB - print ind H 02 Feb 2017 1:59 PM ;
- ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- ;
- ;
- I1AGEP ;EP
- W:'$G(BGPSUMON) !,"CURRENT REPORT PERIOD"
- W:'$G(BGPSUMON) !,BGPHD2
- S T=30 F X=1:1:5 S V=$P(BGPDAC(X),U) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"# w/ Medical Nutrition",!?2,"Therapy"
- S T=30 F X=1:1:5 S V=$P(BGPDAC(X),U,2) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"% w/ Medical Nutrition",!?2,"Therapy"
- S T=29 F X=1:1:5 S V=$P(BGPDAC(X),U,3) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+9
- W:'$G(BGPSUMON) !!,"# w/ Specific Nutrition Educ",!?2,"Provided"
- S T=30 F X=1:1:5 S V=$P(BGPDAC(X),U,4) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"% w/ Specific Nutrition Educ",!?2,"Provided"
- S T=29 F X=1:1:5 S V=$P(BGPDAC(X),U,5) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+9
- W:'$G(BGPSUMON) !!,"# w/ Exercise Educ"
- S T=30 F X=1:1:5 S V=$P(BGPDAC(X),U,6) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"% w/ Exercise Educ"
- S T=29 F X=1:1:5 S V=$P(BGPDAC(X),U,7) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+9
- W:'$G(BGPSUMON) !!,"# w/ Other Exercise or",!?2,"Nutrition Educ"
- S T=30 F X=1:1:5 S V=$P(BGPDAC(X),U,8) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"% w/ Other Exercise or",!?2,"Nutrition Educ"
- S T=29 F X=1:1:5 S V=$P(BGPDAC(X),U,9) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+9
- PR ;
- I $Y>(BGPIOSL-12),'$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) !!,"PREVIOUS YEAR PERIOD"
- W:'$G(BGPSUMON) !,BGPHD2
- S T=30 F X=1:1:5 S V=$P(BGPDAP(X),U) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"# w/ Medical Nutrition",!?2,"Therapy"
- S T=30 F X=1:1:5 S V=$P(BGPDAP(X),U,2) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"% w/ Medical Nutrition",!?2,"Therapy"
- S T=29 F X=1:1:5 S V=$P(BGPDAP(X),U,3) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+9
- W:'$G(BGPSUMON) !!,"# w/ Specific Nutrition Educ",!?2,"Provided"
- S T=30 F X=1:1:5 S V=$P(BGPDAP(X),U,4) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"% w/ Specific Nutrition Educ",!?2,"Provided"
- S T=29 F X=1:1:5 S V=$P(BGPDAP(X),U,5) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+9
- W:'$G(BGPSUMON) !!,"# w/ Exercise Educ"
- S T=30 F X=1:1:5 S V=$P(BGPDAP(X),U,6) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"% w/ Exercise Educ"
- S T=29 F X=1:1:5 S V=$P(BGPDAP(X),U,7) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+9
- W:'$G(BGPSUMON) !!,"# w/ Other Exercise or",!?2,"Nutrition Educ"
- S T=30 F X=1:1:5 S V=$P(BGPDAP(X),U,8) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"% w/ Other Exercise or",!?2,"Nutrition Educ"
- S T=29 F X=1:1:5 S V=$P(BGPDAP(X),U,9) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+9
- PB ;
- I $Y>(BGPIOSL-12),'$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/ Medical Nutrition",!?2,"Therapy"
- S T=29 F X=1:1:5 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+9
- W:'$G(BGPSUMON) !,"# w/ Specific Nutrition Ed"
- S T=29 F X=1:1:5 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+9
- W:'$G(BGPSUMON) !,"# w/ Exercise Educ"
- S T=29 F X=1:1:5 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+9
- W:'$G(BGPSUMON) !,"# w/ Other Exercise or",!?2,"Nutrition Educ"
- S T=29 F X=1:1:5 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+9
- BL ;
- I $Y>(BGPIOSL-12),'$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) !!,"BASELINE REPORT PERIOD"
- W:'$G(BGPSUMON) !,BGPHD2
- S T=30 F X=1:1:5 S V=$P(BGPDAB(X),U) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"# w/ Medical Nutrition",!?2,"Therapy"
- S T=30 F X=1:1:5 S V=$P(BGPDAB(X),U,2) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"% w/ Medical Nutrition",!?2,"Therapy"
- S T=29 F X=1:1:5 S V=$P(BGPDAB(X),U,3) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+9
- W:'$G(BGPSUMON) !!,"# w/ Specific Nutrition Educ",!?2,"Provided"
- S T=30 F X=1:1:5 S V=$P(BGPDAB(X),U,4) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"% w/ Specific Nutrition Educ",!?2,"Provided"
- S T=29 F X=1:1:5 S V=$P(BGPDAB(X),U,5) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+9
- W:'$G(BGPSUMON) !!,"# w/ Exercise Educ"
- S T=30 F X=1:1:5 S V=$P(BGPDAB(X),U,6) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"% w/ Exercise Educ"
- S T=29 F X=1:1:5 S V=$P(BGPDAB(X),U,7) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+9
- W:'$G(BGPSUMON) !!,"# w/ Other Exercise or",!?2,"Nutrition Educ"
- S T=30 F X=1:1:5 S V=$P(BGPDAB(X),U,8) W:'$G(BGPSUMON) ?T,$$C(V,0,6) S T=T+9
- W:'$G(BGPSUMON) !,"% # w / Other Exercise or",!?2,"Nutrition Educ"
- S T=29 F X=1:1:5 S V=$P(BGPDAB(X),U,9) W:'$G(BGPSUMON) ?T,$J(V,6,1) S T=T+9
- BP ;
- ;percentage changes
- W:'$G(BGPSUMON) !!,"CHANGE FROM BASE YR %"
- W:'$G(BGPSUMON) !,"# w/ Medical Nutrition",!?2,"Therapy"
- S T=29 F X=1:1:5 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+9
- W:'$G(BGPSUMON) !,"# w/ Specific Nutrition Educ"
- S T=29 F X=1:1:5 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+9
- W:'$G(BGPSUMON) !,"# w/ Exercise Educ"
- S T=29 F X=1:1:5 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+9
- W:'$G(BGPSUMON) !,"# w/ Other Exercise or",!?2,"Nutrition Educ"
- S T=29 F X=1:1:5 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+9
- 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 !,BGPHD2,?32,"6-11",?39,"12-19",?48,"20-39",?57,"40-59",?66,"60+",!
- Q
- BGP7DP60 ; IHS/CMI/LAB - print ind H 02 Feb 2017 1:59 PM ;
- +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=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAC(X),U)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +4 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Medical Nutrition",!?2,"Therapy"
- +5 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAC(X),U,2)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +6 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Medical Nutrition",!?2,"Therapy"
- +7 SET T=29
- FOR X=1:1:5
- SET V=$PIECE(BGPDAC(X),U,3)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+9
- +8 IF '$GET(BGPSUMON)
- WRITE !!,"# w/ Specific Nutrition Educ",!?2,"Provided"
- +9 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAC(X),U,4)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +10 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Specific Nutrition Educ",!?2,"Provided"
- +11 SET T=29
- FOR X=1:1:5
- SET V=$PIECE(BGPDAC(X),U,5)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+9
- +12 IF '$GET(BGPSUMON)
- WRITE !!,"# w/ Exercise Educ"
- +13 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAC(X),U,6)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +14 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Exercise Educ"
- +15 SET T=29
- FOR X=1:1:5
- SET V=$PIECE(BGPDAC(X),U,7)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+9
- +16 IF '$GET(BGPSUMON)
- WRITE !!,"# w/ Other Exercise or",!?2,"Nutrition Educ"
- +17 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAC(X),U,8)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +18 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Other Exercise or",!?2,"Nutrition Educ"
- +19 SET T=29
- FOR X=1:1:5
- SET V=$PIECE(BGPDAC(X),U,9)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+9
- PR ;
- +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 !!,"PREVIOUS YEAR PERIOD"
- +3 IF '$GET(BGPSUMON)
- WRITE !,BGPHD2
- +4 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAP(X),U)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +5 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Medical Nutrition",!?2,"Therapy"
- +6 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAP(X),U,2)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +7 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Medical Nutrition",!?2,"Therapy"
- +8 SET T=29
- FOR X=1:1:5
- SET V=$PIECE(BGPDAP(X),U,3)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+9
- +9 IF '$GET(BGPSUMON)
- WRITE !!,"# w/ Specific Nutrition Educ",!?2,"Provided"
- +10 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAP(X),U,4)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +11 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Specific Nutrition Educ",!?2,"Provided"
- +12 SET T=29
- FOR X=1:1:5
- SET V=$PIECE(BGPDAP(X),U,5)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+9
- +13 IF '$GET(BGPSUMON)
- WRITE !!,"# w/ Exercise Educ"
- +14 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAP(X),U,6)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +15 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Exercise Educ"
- +16 SET T=29
- FOR X=1:1:5
- SET V=$PIECE(BGPDAP(X),U,7)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+9
- +17 IF '$GET(BGPSUMON)
- WRITE !!,"# w/ Other Exercise or",!?2,"Nutrition Educ"
- +18 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAP(X),U,8)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +19 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Other Exercise or",!?2,"Nutrition Educ"
- +20 SET T=29
- FOR X=1:1:5
- SET V=$PIECE(BGPDAP(X),U,9)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+9
- 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 ;percentage changes
- +3 IF '$GET(BGPSUMON)
- WRITE !!,"CHANGE FROM PREV YR %"
- +4 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Medical Nutrition",!?2,"Therapy"
- +5 SET T=29
- FOR X=1:1:5
- 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+9
- +6 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Specific Nutrition Ed"
- +7 SET T=29
- FOR X=1:1:5
- 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+9
- +8 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Exercise Educ"
- +9 SET T=29
- FOR X=1:1:5
- 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+9
- +10 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Other Exercise or",!?2,"Nutrition Educ"
- +11 SET T=29
- FOR X=1:1:5
- 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+9
- BL ;
- +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 !!,"BASELINE REPORT PERIOD"
- +3 IF '$GET(BGPSUMON)
- WRITE !,BGPHD2
- +4 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAB(X),U)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +5 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Medical Nutrition",!?2,"Therapy"
- +6 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAB(X),U,2)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +7 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Medical Nutrition",!?2,"Therapy"
- +8 SET T=29
- FOR X=1:1:5
- SET V=$PIECE(BGPDAB(X),U,3)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+9
- +9 IF '$GET(BGPSUMON)
- WRITE !!,"# w/ Specific Nutrition Educ",!?2,"Provided"
- +10 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAB(X),U,4)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +11 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Specific Nutrition Educ",!?2,"Provided"
- +12 SET T=29
- FOR X=1:1:5
- SET V=$PIECE(BGPDAB(X),U,5)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+9
- +13 IF '$GET(BGPSUMON)
- WRITE !!,"# w/ Exercise Educ"
- +14 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAB(X),U,6)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +15 IF '$GET(BGPSUMON)
- WRITE !,"% w/ Exercise Educ"
- +16 SET T=29
- FOR X=1:1:5
- SET V=$PIECE(BGPDAB(X),U,7)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+9
- +17 IF '$GET(BGPSUMON)
- WRITE !!,"# w/ Other Exercise or",!?2,"Nutrition Educ"
- +18 SET T=30
- FOR X=1:1:5
- SET V=$PIECE(BGPDAB(X),U,8)
- IF '$GET(BGPSUMON)
- WRITE ?T,$$C(V,0,6)
- SET T=T+9
- +19 IF '$GET(BGPSUMON)
- WRITE !,"% # w / Other Exercise or",!?2,"Nutrition Educ"
- +20 SET T=29
- FOR X=1:1:5
- SET V=$PIECE(BGPDAB(X),U,9)
- IF '$GET(BGPSUMON)
- WRITE ?T,$JUSTIFY(V,6,1)
- SET T=T+9
- BP ;
- +1 ;percentage changes
- +2 IF '$GET(BGPSUMON)
- WRITE !!,"CHANGE FROM BASE YR %"
- +3 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Medical Nutrition",!?2,"Therapy"
- +4 SET T=29
- FOR X=1:1:5
- 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+9
- +5 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Specific Nutrition Educ"
- +6 SET T=29
- FOR X=1:1:5
- 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+9
- +7 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Exercise Educ"
- +8 SET T=29
- FOR X=1:1:5
- 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+9
- +9 IF '$GET(BGPSUMON)
- WRITE !,"# w/ Other Exercise or",!?2,"Nutrition Educ"
- +10 SET T=29
- FOR X=1:1:5
- 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+9
- +11 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 !,BGPHD2,?32,"6-11",?39,"12-19",?48,"20-39",?57,"40-59",?66,"60+",!
- +5 QUIT