BGP4DP1L.m

BGP4DP1L ; IHS/CMI/LAB - print ind 1 12 Nov 2010 7:38 AM ;

 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 ;

 ;HIV SCREENING AGE DIST

I1AGE ;EP  special age tallies

 Q:$G(BGPSUMON)

 S BGPHD1="Active Clinical Pts =>5 w/Persistent Asthma",BGPHD2="Active Clinical Pts =>5 ",BGPHD3=" w/persistent asthma"

 K BGPDAC,BGPDAP,BGPDAB

 S (BGPX,BGPDD)=0 F BGPXX=12:1:22 D I1AGE1

 D I1AGEP

 Q

I1AGE1 ;

 ;

 I BGPXX=12 S BGPP1=2,BGPP2=3

 I BGPXX=13 S BGPP1=4,BGPP2=5

 I BGPXX=14 S BGPP1=6,BGPP2=7

 I BGPXX=15 S BGPP1=8,BGPP2=9

 I BGPXX=16 S BGPP1=10,BGPP2=11

 I BGPXX=17 S BGPP1=12,BGPP2=13

 I BGPXX=18 S BGPP1=14,BGPP2=15

 I BGPXX=19 S BGPP1=16,BGPP2=17

 I BGPXX=20 S BGPP1=18,BGPP2=19

 I BGPXX=21 S BGPP1=20,BGPP2=21

 I BGPXX=22 S BGPP1=22,BGPP2=23

 S BGPZ="A",BGPX=1 D AGES

 S BGPZ="B",BGPX=2 D AGES

 S BGPZ="C",BGPX=3 D AGES

 S BGPZ="D",BGPX=4 D AGES

 Q

AGES ;

 S BGPF="AA.A."_BGPXX_BGPZ S BGPPC=$O(^BGPINDJC("C",BGPF,0))

 D

 .S BGPDF=$P(^BGPINDJC(BGPPC,0),U,8)

 .S BGPNP=$P(^DD(90552.03,BGPDF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)

 .S $P(BGPDAC(BGPX),U)=$$V^BGP4DP1C(1,BGPRPT,N,P)

 .S $P(BGPDAP(BGPX),U)=$$V^BGP4DP1C(2,BGPRPT,N,P)

 .S $P(BGPDAB(BGPX),U)=$$V^BGP4DP1C(3,BGPRPT,N,P)

 ;S BGPCYD=$$V^BGP4DP1C(1,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP4DP1C(1,N,P)

 ;S BGPPRD=$$V^BGP4DP1C(2,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP4DP1C(2,N,P)

 ;S BGPBLD=$$V^BGP4DP1C(3,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP4DP1C(3,N,P)

 ;set 2nd piece to numerator and 3rd to %

 S J=$P(BGPF,".",3)

 S Q=1

 ;I J["B" S Q=2

 ;I J["C" S Q=2

 ;I J["D" S Q=2

 S BGPNF=$P(^BGPINDJC(BGPPC,0),U,9)

 S BGPNP=$P(^DD(90552.03,BGPNF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)

 S $P(BGPDAC(BGPX),U,BGPP1)=$$V^BGP4DP1C(1,BGPRPT,N,P),$P(BGPDAC(BGPX),U,BGPP2)=$S($P(BGPDAC(BGPX),U,Q):($P(BGPDAC(BGPX),U,BGPP1)/$P(BGPDAC(BGPX),U,Q)*100),1:"")

 S $P(BGPDAP(BGPX),U,BGPP1)=$$V^BGP4DP1C(2,BGPRPT,N,P),$P(BGPDAP(BGPX),U,BGPP2)=$S($P(BGPDAP(BGPX),U,Q):($P(BGPDAP(BGPX),U,BGPP1)/$P(BGPDAP(BGPX),U,Q)*100),1:"")

 S $P(BGPDAB(BGPX),U,BGPP1)=$$V^BGP4DP1C(3,BGPRPT,N,P),$P(BGPDAB(BGPX),U,BGPP2)=$S($P(BGPDAB(BGPX),U,Q):($P(BGPDAB(BGPX),U,BGPP1)/$P(BGPDAB(BGPX),U,Q)*100),1:"")

 ;S BGPCYN=$$V^BGP4DP1C(1,BGPRPT,N,P,2)

 ;S BGPPRN=$$V^BGP4DP1C(2,BGPRPT,N,P,2)

 ;S BGPBLN=$$V^BGP4DP1C(3,BGPRPT,N,P,2)

 ;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

I1AGEP ;

 S BGPYSTP=1

 I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP4DPH Q:BGPQUIT  D W^BGP4DP(^BGPINDJ(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDJ(BGPIC,53,2,0)) W^BGP4DP(^BGPINDJ(BGPIC,53,2,0),0,1,BGPPTYPE) D AH

 I BGPPTYPE'="P" D W^BGP4DP("",0,2,BGPPTYPE) D AH

 D W^BGP4DP("CURRENT REPORT PERIOD",0,1,BGPPTYPE)

 D W^BGP4DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP4DP(BGPHD3,0,1,BGPPTYPE)

 S BGPARR="BGPDAC" D I1AGEP1

 I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP4DPH Q:BGPQUIT  D W^BGP4DP(^BGPINDJ(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDJ(BGPIC,53,2,0)) W^BGP4DP(^BGPINDJ(BGPIC,53,2,0),0,1,BGPPTYPE) D AH

 I BGPPTYPE'="P" D W^BGP4DP("",0,2,BGPPTYPE) D AH

 D W^BGP4DP("PREVIOUS REPORT PERIOD",0,1,BGPPTYPE)

 D W^BGP4DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP4DP(BGPHD3,0,1,BGPPTYPE)

 S BGPARR="BGPDAP" D I1AGEP1

 I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP4DPH Q:BGPQUIT  D W^BGP4DP(^BGPINDJ(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDJ(BGPIC,53,2,0)) W^BGP4DP(^BGPINDJ(BGPIC,53,2,0),0,1,BGPPTYPE) D AH

 I BGPPTYPE'="P" D W^BGP4DP("",0,2,BGPPTYPE) D AH

 D W^BGP4DP("BASELINE REPORT PERIOD",0,1,BGPPTYPE)

 D W^BGP4DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP4DP(BGPHD3,0,1,BGPPTYPE)

 S BGPARR="BGPDAB" D I1AGEP1

 Q

I1AGEP1 ;

 S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U) D W^BGP4DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("# w/management plan",0,2,BGPPTYPE)

 S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,2) D W^BGP4DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("% w/managment plan",0,1,BGPPTYPE)

 S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,3) D W^BGP4DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("# w/severity documented",0,2,BGPPTYPE)

 S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,4) D W^BGP4DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("% w/severity documented",0,1,BGPPTYPE)

 S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,5) D W^BGP4DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("% w/control documented",0,2,BGPPTYPE)

 S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,6) D W^BGP4DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("% w/control documented",0,1,BGPPTYPE)

 S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,7) D W^BGP4DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("# w/# symptom free days",0,2,BGPPTYPE)

 S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,8) D W^BGP4DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("% w/# symptom free days",0,1,BGPPTYPE)

 S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,9) D W^BGP4DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("# w/# symptom free days 0-5",0,2,BGPPTYPE)

 S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,10) D W^BGP4DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("% w/# symptom free days 0-5",0,1,BGPPTYPE)

 S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,11) D W^BGP4DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("# w/# symptom free days 6-12",0,2,BGPPTYPE)

 S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,12) D W^BGP4DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("% w/# symptom free days 6-12",0,1,BGPPTYPE)

 S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,13) D W^BGP4DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("# w/# symptom free days 13-14",0,2,BGPPTYPE)

 S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,14) D W^BGP4DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11

 D W^BGP4DP("% w/# symptom free days 13-14",0,1,BGPPTYPE)

 S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,15) D W^BGP4DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11

 I BGPPTYPE="D" D W^BGP4DP("# w/# school/work days missed",0,2,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP4DP("# w/# school/work days",0,2,BGPPTYPE),W^BGP4DP(" missed",0,1,BGPPTYPE)

 S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,16) D W^BGP4DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11

 I BGPPTYPE="D" D W^BGP4DP("% w/# school/work days missed",0,1,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP4DP("% w/# school/work days",0,1,BGPPTYPE),W^BGP4DP(" missed",0,1,BGPPTYPE)

 S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,17) D W^BGP4DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11

 I BGPPTYPE="D" D W^BGP4DP("# w/# school/work days missed 0-2",0,2,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP4DP("# w/# school/work days",0,2,BGPPTYPE),W^BGP4DP(" missed 0-2",0,1,BGPPTYPE)

 S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,18) D W^BGP4DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11

 I BGPPTYPE="D" D W^BGP4DP("% w/# school/work days missed 0-2",0,1,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP4DP("% w/# school/work days",0,1,BGPPTYPE),W^BGP4DP(" missed 0-2",0,1,BGPPTYPE)

 S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,19) D W^BGP4DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11

 I BGPPTYPE="D" D W^BGP4DP("# w/# school/work days missed 3-7",0,2,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP4DP("# w/# school/work days",0,2,BGPPTYPE),W^BGP4DP(" missed 3-7",0,1,BGPPTYPE)

 S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,20) D W^BGP4DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11

 I BGPPTYPE="D" D W^BGP4DP("% w/# school/work days missed 3-7",0,1,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP4DP("% w/# school/work days",0,1,BGPPTYPE),W^BGP4DP(" missed 3-7",0,1,BGPPTYPE)

 S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,21) D W^BGP4DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11

 I BGPPTYPE="D" D W^BGP4DP("# w/# school/work days missed 8-14",0,2,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP4DP("# w/# school/work days",0,2,BGPPTYPE),W^BGP4DP(" missed 8-14",0,1,BGPPTYPE)

 S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,22) D W^BGP4DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11

 I BGPPTYPE="D" D W^BGP4DP("% w/# school/work days missed 8-14",0,1,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP4DP("% w/# school/work days",0,1,BGPPTYPE),W^BGP4DP(" missed 8-14",0,1,BGPPTYPE)

 S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,23) D W^BGP4DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11

 I BGPARR="BGPDAP"!(BGPARR="BGPDAB") D

 .D W^BGP4DP("CHANGE FROM "_$S(BGPARR="BGPDAP":"PREVIOUS YR %",1:"BASELINE YR %"),0,2,BGPPTYPE)

 .S L="# w/mangagement plan",P=3 D PBY

 .S L="# w/severity documented",P=5 D PBY

 .S L="# w/control documented",P=7 D PBY

 .S L="# w/# symptom free days",P=9 D PBY

 .S L="# w/# symptom free days 0-5",P=11 D PBY

 .S L="# w/# symptom free days 6-12",P=13 D PBY

 .S L="# w/# symptom free days 13-14",P=15 D PBY

 .I BGPPTYPE="P" D W^BGP4DP("# w/school/work days",0,1,BGPPTYPE) S L=" missed",P=17 D PBY

 .I BGPPTYPE="D" S L="# w/school/work days missed",P=17 D PBY

 .I BGPPTYPE="P" D W^BGP4DP("# w/school/work days",0,1,BGPPTYPE) S L=" missed 0-2",P=19 D PBY

 .I BGPPTYPE="D" S L="# w/school/work days missed 0-2",P=19 D PBY

 .I BGPPTYPE="P" D W^BGP4DP("# w/school/work days",0,1,BGPPTYPE) S L=" missed 3-7",P=21 D PBY

 .I BGPPTYPE="D" S L="# w/school/work days missed 3-7",P=21 D PBY

 .I BGPPTYPE="P" D W^BGP4DP("# w/school/work days",0,1,BGPPTYPE) S L=" missed 8-14",P=23 D PBY

 .I BGPPTYPE="D" S L="# w/school/work days missed 8-14",P=23 D PBY

 .Q

 Q

PBY ;

 D W^BGP4DP(L,0,1,BGPPTYPE)

 S T=30 F X=1:1:4 S N=$P(BGPDAC(X),U,P),O=$P(@BGPARR@(X),U,3) S:N="" N=0 S:O="" O=0 S Y=$S(BGPPTYPE="P":$J($FN((N-O),"+,",1),6),1:$$SB($J((N-O),6,1))) D W^BGP4DP(Y,0,0,BGPPTYPE,X+1,T) S T=T+11

 Q

C(X,X2,X3) ;

 D COMMA^%DTC

 Q X

AH ;EP

 Q:$G(BGPSUMON)

 D W^BGP4DP(BGPHD1,1,2,BGPPTYPE)

 ;D W^BGP4DP("Asthma Assessments",0,1,BGPPTYPE)

 D W^BGP4DP(" 5-14",0,1,BGPPTYPE,2,34)

 D W^BGP4DP("15-34",0,0,BGPPTYPE,3,45)

 D W^BGP4DP("35-64",0,0,BGPPTYPE,4,56)

 D W^BGP4DP("65+",0,0,BGPPTYPE,5,67)

 Q

SB(X) ;EP - Strip

 X ^DD("FUNC",$O(^DD("FUNC","B","STRIPBLANKS",0)),1)

 Q X

BGP4DP1L  ; IHS/CMI/LAB - print ind 1 12 Nov 2010 7:38 AM ;

 +1       ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 +2       ;

 +3       ;HIV SCREENING AGE DIST

I1AGE     ;EP  special age tallies

 +1        IF $GET(BGPSUMON)

               QUIT 

 +2        SET BGPHD1="Active Clinical Pts =>5 w/Persistent Asthma"

           SET BGPHD2="Active Clinical Pts =>5 "

           SET BGPHD3=" w/persistent asthma"

 +3        KILL BGPDAC,BGPDAP,BGPDAB

 +4        SET (BGPX,BGPDD)=0

           FOR BGPXX=12:1:22

               DO I1AGE1

 +5        DO I1AGEP

 +6        QUIT 

I1AGE1    ;

 +1       ;

 +2        IF BGPXX=12

               SET BGPP1=2

               SET BGPP2=3

 +3        IF BGPXX=13

               SET BGPP1=4

               SET BGPP2=5

 +4        IF BGPXX=14

               SET BGPP1=6

               SET BGPP2=7

 +5        IF BGPXX=15

               SET BGPP1=8

               SET BGPP2=9

 +6        IF BGPXX=16

               SET BGPP1=10

               SET BGPP2=11

 +7        IF BGPXX=17

               SET BGPP1=12

               SET BGPP2=13

 +8        IF BGPXX=18

               SET BGPP1=14

               SET BGPP2=15

 +9        IF BGPXX=19

               SET BGPP1=16

               SET BGPP2=17

 +10       IF BGPXX=20

               SET BGPP1=18

               SET BGPP2=19

 +11       IF BGPXX=21

               SET BGPP1=20

               SET BGPP2=21

 +12       IF BGPXX=22

               SET BGPP1=22

               SET BGPP2=23

 +13       SET BGPZ="A"

           SET BGPX=1

           DO AGES

 +14       SET BGPZ="B"

           SET BGPX=2

           DO AGES

 +15       SET BGPZ="C"

           SET BGPX=3

           DO AGES

 +16       SET BGPZ="D"

           SET BGPX=4

           DO AGES

 +17       QUIT 

AGES      ;

 +1        SET BGPF="AA.A."_BGPXX_BGPZ

           SET BGPPC=$ORDER(^BGPINDJC("C",BGPF,0))

 +2        Begin DoDot:1

 +3            SET BGPDF=$PIECE(^BGPINDJC(BGPPC,0),U,8)

 +4            SET BGPNP=$PIECE(^DD(90552.03,BGPDF,0),U,4)

               SET N=$PIECE(BGPNP,";")

               SET P=$PIECE(BGPNP,";",2)

 +5            SET $PIECE(BGPDAC(BGPX),U)=$$V^BGP4DP1C(1,BGPRPT,N,P)

 +6            SET $PIECE(BGPDAP(BGPX),U)=$$V^BGP4DP1C(2,BGPRPT,N,P)

 +7            SET $PIECE(BGPDAB(BGPX),U)=$$V^BGP4DP1C(3,BGPRPT,N,P)

           End DoDot:1

 +8       ;S BGPCYD=$$V^BGP4DP1C(1,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP4DP1C(1,N,P)

 +9       ;S BGPPRD=$$V^BGP4DP1C(2,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP4DP1C(2,N,P)

 +10      ;S BGPBLD=$$V^BGP4DP1C(3,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP4DP1C(3,N,P)

 +11      ;set 2nd piece to numerator and 3rd to %

 +12       SET J=$PIECE(BGPF,".",3)

 +13       SET Q=1

 +14      ;I J["B" S Q=2

 +15      ;I J["C" S Q=2

 +16      ;I J["D" S Q=2

 +17       SET BGPNF=$PIECE(^BGPINDJC(BGPPC,0),U,9)

 +18       SET BGPNP=$PIECE(^DD(90552.03,BGPNF,0),U,4)

           SET N=$PIECE(BGPNP,";")

           SET P=$PIECE(BGPNP,";",2)

 +19       SET $PIECE(BGPDAC(BGPX),U,BGPP1)=$$V^BGP4DP1C(1,BGPRPT,N,P)

           SET $PIECE(BGPDAC(BGPX),U,BGPP2)=$SELECT($PIECE(BGPDAC(BGPX),U,Q):($PIECE(BGPDAC(BGPX),U,BGPP1)/$PIECE(BGPDAC(BGPX),U,Q)*100),1:"")

 +20       SET $PIECE(BGPDAP(BGPX),U,BGPP1)=$$V^BGP4DP1C(2,BGPRPT,N,P)

           SET $PIECE(BGPDAP(BGPX),U,BGPP2)=$SELECT($PIECE(BGPDAP(BGPX),U,Q):($PIECE(BGPDAP(BGPX),U,BGPP1)/$PIECE(BGPDAP(BGPX),U,Q)*100),1:"")

 +21       SET $PIECE(BGPDAB(BGPX),U,BGPP1)=$$V^BGP4DP1C(3,BGPRPT,N,P)

           SET $PIECE(BGPDAB(BGPX),U,BGPP2)=$SELECT($PIECE(BGPDAB(BGPX),U,Q):($PIECE(BGPDAB(BGPX),U,BGPP1)/$PIECE(BGPDAB(BGPX),U,Q)*100),1:"")

 +22      ;S BGPCYN=$$V^BGP4DP1C(1,BGPRPT,N,P,2)

 +23      ;S BGPPRN=$$V^BGP4DP1C(2,BGPRPT,N,P,2)

 +24      ;S BGPBLN=$$V^BGP4DP1C(3,BGPRPT,N,P,2)

 +25      ;S BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")

 +26      ;S BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")

 +27      ;S BGPBLP=$S(BGPBLD:((BGPBLN/BGPBLD)*100),1:"")

 +28       QUIT 

I1AGEP    ;

 +1        SET BGPYSTP=1

 +2        IF '$GET(BGPSUMON)

               IF BGPPTYPE="P"

                   DO HEADER^BGP4DPH

                   IF BGPQUIT

                       QUIT 

                   DO W^BGP4DP(^BGPINDJ(BGPIC,53,1,0),0,1,BGPPTYPE)

                   IF $DATA(^BGPINDJ(BGPIC,53,2,0))

                       DO W^BGP4DP(^BGPINDJ(BGPIC,53,2,0),0,1,BGPPTYPE)

                   DO AH

 +3        IF BGPPTYPE'="P"

               DO W^BGP4DP("",0,2,BGPPTYPE)

               DO AH

 +4        DO W^BGP4DP("CURRENT REPORT PERIOD",0,1,BGPPTYPE)

 +5        DO W^BGP4DP($SELECT(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)

 +6        IF BGPPTYPE="P"

               DO W^BGP4DP(BGPHD3,0,1,BGPPTYPE)

 +7        SET BGPARR="BGPDAC"

           DO I1AGEP1

 +8        IF '$GET(BGPSUMON)

               IF BGPPTYPE="P"

                   DO HEADER^BGP4DPH

                   IF BGPQUIT

                       QUIT 

                   DO W^BGP4DP(^BGPINDJ(BGPIC,53,1,0),0,1,BGPPTYPE)

                   IF $DATA(^BGPINDJ(BGPIC,53,2,0))

                       DO W^BGP4DP(^BGPINDJ(BGPIC,53,2,0),0,1,BGPPTYPE)

                   DO AH

 +9        IF BGPPTYPE'="P"

               DO W^BGP4DP("",0,2,BGPPTYPE)

               DO AH

 +10       DO W^BGP4DP("PREVIOUS REPORT PERIOD",0,1,BGPPTYPE)

 +11       DO W^BGP4DP($SELECT(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)

 +12       IF BGPPTYPE="P"

               DO W^BGP4DP(BGPHD3,0,1,BGPPTYPE)

 +13       SET BGPARR="BGPDAP"

           DO I1AGEP1

 +14       IF '$GET(BGPSUMON)

               IF BGPPTYPE="P"

                   DO HEADER^BGP4DPH

                   IF BGPQUIT

                       QUIT 

                   DO W^BGP4DP(^BGPINDJ(BGPIC,53,1,0),0,1,BGPPTYPE)

                   IF $DATA(^BGPINDJ(BGPIC,53,2,0))

                       DO W^BGP4DP(^BGPINDJ(BGPIC,53,2,0),0,1,BGPPTYPE)

                   DO AH

 +15       IF BGPPTYPE'="P"

               DO W^BGP4DP("",0,2,BGPPTYPE)

               DO AH

 +16       DO W^BGP4DP("BASELINE REPORT PERIOD",0,1,BGPPTYPE)

 +17       DO W^BGP4DP($SELECT(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)

 +18       IF BGPPTYPE="P"

               DO W^BGP4DP(BGPHD3,0,1,BGPPTYPE)

 +19       SET BGPARR="BGPDAB"

           DO I1AGEP1

 +20       QUIT 

I1AGEP1   ;

 +1        SET T=30

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +2        DO W^BGP4DP("# w/management plan",0,2,BGPPTYPE)

 +3        SET T=31

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,2)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +4        DO W^BGP4DP("% w/managment plan",0,1,BGPPTYPE)

 +5        SET T=30

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,3)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +6        DO W^BGP4DP("# w/severity documented",0,2,BGPPTYPE)

 +7        SET T=31

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,4)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +8        DO W^BGP4DP("% w/severity documented",0,1,BGPPTYPE)

 +9        SET T=30

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,5)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +10       DO W^BGP4DP("% w/control documented",0,2,BGPPTYPE)

 +11       SET T=31

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,6)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +12       DO W^BGP4DP("% w/control documented",0,1,BGPPTYPE)

 +13       SET T=30

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,7)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +14       DO W^BGP4DP("# w/# symptom free days",0,2,BGPPTYPE)

 +15       SET T=31

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,8)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +16       DO W^BGP4DP("% w/# symptom free days",0,1,BGPPTYPE)

 +17       SET T=30

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,9)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +18       DO W^BGP4DP("# w/# symptom free days 0-5",0,2,BGPPTYPE)

 +19       SET T=31

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,10)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +20       DO W^BGP4DP("% w/# symptom free days 0-5",0,1,BGPPTYPE)

 +21       SET T=30

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,11)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +22       DO W^BGP4DP("# w/# symptom free days 6-12",0,2,BGPPTYPE)

 +23       SET T=31

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,12)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +24       DO W^BGP4DP("% w/# symptom free days 6-12",0,1,BGPPTYPE)

 +25       SET T=30

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,13)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +26       DO W^BGP4DP("# w/# symptom free days 13-14",0,2,BGPPTYPE)

 +27       SET T=31

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,14)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +28       DO W^BGP4DP("% w/# symptom free days 13-14",0,1,BGPPTYPE)

 +29       SET T=30

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,15)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +30       IF BGPPTYPE="D"

               DO W^BGP4DP("# w/# school/work days missed",0,2,BGPPTYPE)

 +31       IF BGPPTYPE="P"

               DO W^BGP4DP("# w/# school/work days",0,2,BGPPTYPE)

               DO W^BGP4DP(" missed",0,1,BGPPTYPE)

 +32       SET T=31

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,16)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +33       IF BGPPTYPE="D"

               DO W^BGP4DP("% w/# school/work days missed",0,1,BGPPTYPE)

 +34       IF BGPPTYPE="P"

               DO W^BGP4DP("% w/# school/work days",0,1,BGPPTYPE)

               DO W^BGP4DP(" missed",0,1,BGPPTYPE)

 +35       SET T=30

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,17)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +36       IF BGPPTYPE="D"

               DO W^BGP4DP("# w/# school/work days missed 0-2",0,2,BGPPTYPE)

 +37       IF BGPPTYPE="P"

               DO W^BGP4DP("# w/# school/work days",0,2,BGPPTYPE)

               DO W^BGP4DP(" missed 0-2",0,1,BGPPTYPE)

 +38       SET T=31

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,18)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +39       IF BGPPTYPE="D"

               DO W^BGP4DP("% w/# school/work days missed 0-2",0,1,BGPPTYPE)

 +40       IF BGPPTYPE="P"

               DO W^BGP4DP("% w/# school/work days",0,1,BGPPTYPE)

               DO W^BGP4DP(" missed 0-2",0,1,BGPPTYPE)

 +41       SET T=30

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,19)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +42       IF BGPPTYPE="D"

               DO W^BGP4DP("# w/# school/work days missed 3-7",0,2,BGPPTYPE)

 +43       IF BGPPTYPE="P"

               DO W^BGP4DP("# w/# school/work days",0,2,BGPPTYPE)

               DO W^BGP4DP(" missed 3-7",0,1,BGPPTYPE)

 +44       SET T=31

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,20)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +45       IF BGPPTYPE="D"

               DO W^BGP4DP("% w/# school/work days missed 3-7",0,1,BGPPTYPE)

 +46       IF BGPPTYPE="P"

               DO W^BGP4DP("% w/# school/work days",0,1,BGPPTYPE)

               DO W^BGP4DP(" missed 3-7",0,1,BGPPTYPE)

 +47       SET T=30

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,21)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +48       IF BGPPTYPE="D"

               DO W^BGP4DP("# w/# school/work days missed 8-14",0,2,BGPPTYPE)

 +49       IF BGPPTYPE="P"

               DO W^BGP4DP("# w/# school/work days",0,2,BGPPTYPE)

               DO W^BGP4DP(" missed 8-14",0,1,BGPPTYPE)

 +50       SET T=31

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,22)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +51       IF BGPPTYPE="D"

               DO W^BGP4DP("% w/# school/work days missed 8-14",0,1,BGPPTYPE)

 +52       IF BGPPTYPE="P"

               DO W^BGP4DP("% w/# school/work days",0,1,BGPPTYPE)

               DO W^BGP4DP(" missed 8-14",0,1,BGPPTYPE)

 +53       SET T=30

           FOR X=1:1:4

               SET V=$PIECE(@BGPARR@(X),U,23)

               DO W^BGP4DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +54       IF BGPARR="BGPDAP"!(BGPARR="BGPDAB")

               Begin DoDot:1

 +55               DO W^BGP4DP("CHANGE FROM "_$SELECT(BGPARR="BGPDAP":"PREVIOUS YR %",1:"BASELINE YR %"),0,2,BGPPTYPE)

 +56               SET L="# w/mangagement plan"

                   SET P=3

                   DO PBY

 +57               SET L="# w/severity documented"

                   SET P=5

                   DO PBY

 +58               SET L="# w/control documented"

                   SET P=7

                   DO PBY

 +59               SET L="# w/# symptom free days"

                   SET P=9

                   DO PBY

 +60               SET L="# w/# symptom free days 0-5"

                   SET P=11

                   DO PBY

 +61               SET L="# w/# symptom free days 6-12"

                   SET P=13

                   DO PBY

 +62               SET L="# w/# symptom free days 13-14"

                   SET P=15

                   DO PBY

 +63               IF BGPPTYPE="P"

                       DO W^BGP4DP("# w/school/work days",0,1,BGPPTYPE)

                       SET L=" missed"

                       SET P=17

                       DO PBY

 +64               IF BGPPTYPE="D"

                       SET L="# w/school/work days missed"

                       SET P=17

                       DO PBY

 +65               IF BGPPTYPE="P"

                       DO W^BGP4DP("# w/school/work days",0,1,BGPPTYPE)

                       SET L=" missed 0-2"

                       SET P=19

                       DO PBY

 +66               IF BGPPTYPE="D"

                       SET L="# w/school/work days missed 0-2"

                       SET P=19

                       DO PBY

 +67               IF BGPPTYPE="P"

                       DO W^BGP4DP("# w/school/work days",0,1,BGPPTYPE)

                       SET L=" missed 3-7"

                       SET P=21

                       DO PBY

 +68               IF BGPPTYPE="D"

                       SET L="# w/school/work days missed 3-7"

                       SET P=21

                       DO PBY

 +69               IF BGPPTYPE="P"

                       DO W^BGP4DP("# w/school/work days",0,1,BGPPTYPE)

                       SET L=" missed 8-14"

                       SET P=23

                       DO PBY

 +70               IF BGPPTYPE="D"

                       SET L="# w/school/work days missed 8-14"

                       SET P=23

                       DO PBY

 +71               QUIT 

               End DoDot:1

 +72       QUIT 

PBY       ;

 +1        DO W^BGP4DP(L,0,1,BGPPTYPE)

 +2        SET T=30

           FOR X=1:1:4

               SET N=$PIECE(BGPDAC(X),U,P)

               SET O=$PIECE(@BGPARR@(X),U,3)

               IF N=""

                   SET N=0

               IF O=""

                   SET O=0

               SET Y=$SELECT(BGPPTYPE="P":$JUSTIFY($FNUMBER((N-O),"+,",1),6),1:$$SB($JUSTIFY((N-O),6,1)))

               DO W^BGP4DP(Y,0,0,BGPPTYPE,X+1,T)

               SET T=T+11

 +3        QUIT 

C(X,X2,X3) ;

 +1        DO COMMA^%DTC

 +2        QUIT X

AH        ;EP

 +1        IF $GET(BGPSUMON)

               QUIT 

 +2        DO W^BGP4DP(BGPHD1,1,2,BGPPTYPE)

 +3       ;D W^BGP4DP("Asthma Assessments",0,1,BGPPTYPE)

 +4        DO W^BGP4DP(" 5-14",0,1,BGPPTYPE,2,34)

 +5        DO W^BGP4DP("15-34",0,0,BGPPTYPE,3,45)

 +6        DO W^BGP4DP("35-64",0,0,BGPPTYPE,4,56)

 +7        DO W^BGP4DP("65+",0,0,BGPPTYPE,5,67)

 +8        QUIT 

SB(X)     ;EP - Strip

 +1        XECUTE ^DD("FUNC",$ORDER(^DD("FUNC","B","STRIPBLANKS",0)),1)

 +2        QUIT X