BGP7DP1K.m

BGP7DP1K ; IHS/CMI/LAB - print ind 1 ;

 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29

 ;

BL ;EP

 I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP7DPH Q:BGPQUIT  D W^BGP7DP(^BGPINDG(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDG(BGPIC,53,2,0)) W^BGP7DP(^BGPINDG(BGPIC,53,2,0),0,1,BGPPTYPE) D AH^BGP7DP1H

 D W^BGP7DP("BASELINE REPORT PERIOD",0,$S(BGPPTYPE="P":1,1:2),BGPPTYPE)

 D W^BGP7DP(BGPHD2,0,1,BGPPTYPE)

 S T=28 F X=9:1:13 S V=$P(BGPDAB(X),U) D W^BGP7DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+9

 I BGPPTYPE="P" D W^BGP7DP("# w/HIV screening-No",0,2,BGPPTYPE)

 D W^BGP7DP($S(BGPPTYPE="P":" Refusals (GPRA Dev.)",1:"# w/HIV screening-No Refusals (GPRA Dev.)"),0,$S(BGPPTYPE="P":1,1:2),BGPPTYPE,1,1)

 S T=28 F X=9:1:13 S V=$P(BGPDAB(X),U,2) D W^BGP7DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+9

 I BGPPTYPE="P" D W^BGP7DP("% w/HIV screening-No",0,1,BGPPTYPE)

 D W^BGP7DP($S(BGPPTYPE="P":" Refusals (GPRA Dev.)",1:"% w/HIV screening-No Refusals (GPRA Dev.)"),0,$S(BGPPTYPE="P":1,1:1),BGPPTYPE,1,1)

 S T=28 F X=9:1:13 S V=$P(BGPDAB(X),U,3) D W^BGP7DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+9

 I BGPPTYPE="D" D W^BGP7DP("A. # w/ positive result w/ % of Total Screened",0,2,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP7DP("A. # w/ positive result w/",0,2,BGPPTYPE),W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 S T=28 F X=9:1:13 S V=$P(BGPDAP(X),U,4) D W^BGP7DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+9

 I BGPPTYPE="D" D W^BGP7DP("A. % # w/ positive result w/ % of Total Screened",0,1,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP7DP("A. % # w/ positive result w/",0,1,BGPPTYPE),W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 S T=28 F X=9:1:13 S V=$P(BGPDAP(X),U,5) D W^BGP7DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+9

 I BGPPTYPE="D" D W^BGP7DP("B. # w/ negative result w/ % of Total Screened",0,2,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP7DP("B. # w/ negative result w/",0,2,BGPPTYPE),W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 S T=28 F X=9:1:13 S V=$P(BGPDAP(X),U,6) D W^BGP7DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+9

 I BGPPTYPE="D" D W^BGP7DP("B. % # w/ negative result w/ % of Total Screened",0,1,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP7DP("B. % # w/ negative result w/",0,1,BGPPTYPE),W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 S T=28 F X=9:1:13 S V=$P(BGPDAP(X),U,7) D W^BGP7DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+9

 I BGPPTYPE="D" D W^BGP7DP("C. # w/ No result w/ % of Total Screened",0,2,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP7DP("C. # w/ No result w/",0,2,BGPPTYPE),W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 S T=28 F X=9:1:13 S V=$P(BGPDAP(X),U,8) D W^BGP7DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+9

 I BGPPTYPE="D" D W^BGP7DP("C. % # w/ No result w/ % of Total Screened",0,1,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP7DP("C. % # w/ No result w/",0,1,BGPPTYPE),W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 S T=28 F X=9:1:13 S V=$P(BGPDAP(X),U,9) D W^BGP7DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+9

 ;I BGPPTYPE="P" D W^BGP7DP("# w/HIV screening",0,2,BGPPTYPE)

 ;D W^BGP7DP($S(BGPPTYPE="P":" Refusal",1:"# w/HIV screening Refusal"),0,$S(BGPPTYPE="P":1,1:2),BGPPTYPE,1,1)

 ;S T=28 F X=9:1:13 S V=$P(BGPDAB(X),U,10) D W^BGP7DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+9

 ;I BGPPTYPE="P" D W^BGP7DP("% w/HIV screening",0,1,BGPPTYPE)

 ;D W^BGP7DP($S(BGPPTYPE="P":" Refusal",1:"% w/HIV screening Refusal"),0,$S(BGPPTYPE="P":1,1:1),BGPPTYPE,1,1)

 ;S T=28 F X=9:1:13 S V=$P(BGPDAB(X),U,11) D W^BGP7DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+9

 ;

 D W^BGP7DP("CHANGE FROM BASELINE YR %",0,2,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP7DP("# w/HIV screening-No",0,2,BGPPTYPE)

 D W^BGP7DP($S(BGPPTYPE="P":" Refusals (GPRA Dev.)",1:"# w/HIV screening-No Refusals (GPRA Dev.)"),0,$S(BGPPTYPE="P":1,1:2),BGPPTYPE,1,1)

 S T=28 F X=9:1:13 S N=$P(BGPDAC(X),U,3),O=$P(BGPDAB(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^BGP7DP(Y,0,0,BGPPTYPE,X+1,T) S T=T+9

 I BGPPTYPE="D" D W^BGP7DP("A. # w/ positive result w/ % of Total Screened",0,1,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP7DP("A. # w/ positive result w/",0,1,BGPPTYPE),W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 S T=28 F X=9:1:13 S N=$P(BGPDAC(X),U,5),O=$P(BGPDAB(X),U,5) 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^BGP7DP(Y,0,0,BGPPTYPE,X+1,T) S T=T+9

 I BGPPTYPE="D" D W^BGP7DP("B. # w/ negative result w/ % of Total Screened",0,1,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP7DP("B. # w/ negative result w/",0,1,BGPPTYPE),W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 S T=28 F X=9:1:13 S N=$P(BGPDAC(X),U,7),O=$P(BGPDAB(X),U,7) 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^BGP7DP(Y,0,0,BGPPTYPE,X+1,T) S T=T+9

 I BGPPTYPE="D" D W^BGP7DP("C. # w/ No result w/ % of Total Screened",0,1,BGPPTYPE)

 I BGPPTYPE="P" D W^BGP7DP("C. # w/ No result w/",0,1,BGPPTYPE),W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 S T=28 F X=9:1:13 S N=$P(BGPDAC(X),U,9),O=$P(BGPDAB(X),U,9) 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^BGP7DP(Y,0,0,BGPPTYPE,X+1,T) S T=T+9

 ;I BGPPTYPE="P" D W^BGP7DP("% w/HIV screening",0,1,BGPPTYPE)

 ;D W^BGP7DP($S(BGPPTYPE="P":" Refusal",1:"% w/HIV screening Refusal"),0,$S(BGPPTYPE="P":1,1:1),BGPPTYPE,1,1)

 ;S T=28 F X=9:1:13 S N=$P(BGPDAC(X),U,11),O=$P(BGPDAB(X),U,11) 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^BGP7DP(Y,0,0,BGPPTYPE,X+1,T) S T=T+9

 Q

C(X,X2,X3) ;

 D COMMA^%DTC

 Q X

SB(X) ;EP - Strip leading and trailing blanks from X.

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

 Q X

AH ;EP

 Q:$G(BGPSUMON)

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

 D W^BGP7DP("Age Specific HIV Screening",0,1,BGPPTYPE)

 I BGPPTYPE="P",BGPYSTP=0 G G2

 D W^BGP7DP("<13",0,1,BGPPTYPE,2,25)

 D W^BGP7DP("13-14",0,0,BGPPTYPE,3,30)

 D W^BGP7DP("15-19",0,0,BGPPTYPE,4,37)

 D W^BGP7DP("20-24",0,0,BGPPTYPE,5,44)

 D W^BGP7DP("25-29",0,0,BGPPTYPE,6,51)

 D W^BGP7DP("30-34",0,0,BGPPTYPE,7,58)

 D W^BGP7DP("35-39",0,0,BGPPTYPE,8,65)

 D W^BGP7DP("40-44",0,0,BGPPTYPE,9,72)

 I BGPPTYPE="P",BGPYSTP=1 Q

G2 ;

 D W^BGP7DP("45-49",0,$S(BGPPTYPE="P":1,1:0),BGPPTYPE,10,28)

 D W^BGP7DP("50-54",0,0,BGPPTYPE,11,37)

 D W^BGP7DP("55-59",0,0,BGPPTYPE,12,46)

 D W^BGP7DP("60-64",0,0,BGPPTYPE,13,55)

 D W^BGP7DP(">65",0,0,BGPPTYPE,14,65)

 Q

BGP7DP1K  ; IHS/CMI/LAB - print ind 1 ;

 +1       ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29

 +2       ;

BL        ;EP

 +1        IF '$GET(BGPSUMON)

               IF BGPPTYPE="P"

                   DO HEADER^BGP7DPH

                   IF BGPQUIT

                       QUIT 

                   DO W^BGP7DP(^BGPINDG(BGPIC,53,1,0),0,1,BGPPTYPE)

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

                       DO W^BGP7DP(^BGPINDG(BGPIC,53,2,0),0,1,BGPPTYPE)

                   DO AH^BGP7DP1H

 +2        DO W^BGP7DP("BASELINE REPORT PERIOD",0,$SELECT(BGPPTYPE="P":1,1:2),BGPPTYPE)

 +3        DO W^BGP7DP(BGPHD2,0,1,BGPPTYPE)

 +4        SET T=28

           FOR X=9:1:13

               SET V=$PIECE(BGPDAB(X),U)

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

               SET T=T+9

 +5        IF BGPPTYPE="P"

               DO W^BGP7DP("# w/HIV screening-No",0,2,BGPPTYPE)

 +6        DO W^BGP7DP($SELECT(BGPPTYPE="P":" Refusals (GPRA Dev.)",1:"# w/HIV screening-No Refusals (GPRA Dev.)"),0,$SELECT(BGPPTYPE="P":1,1:2),BGPPTYPE,1,1)

 +7        SET T=28

           FOR X=9:1:13

               SET V=$PIECE(BGPDAB(X),U,2)

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

               SET T=T+9

 +8        IF BGPPTYPE="P"

               DO W^BGP7DP("% w/HIV screening-No",0,1,BGPPTYPE)

 +9        DO W^BGP7DP($SELECT(BGPPTYPE="P":" Refusals (GPRA Dev.)",1:"% w/HIV screening-No Refusals (GPRA Dev.)"),0,$SELECT(BGPPTYPE="P":1,1:1),BGPPTYPE,1,1)

 +10       SET T=28

           FOR X=9:1:13

               SET V=$PIECE(BGPDAB(X),U,3)

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

               SET T=T+9

 +11       IF BGPPTYPE="D"

               DO W^BGP7DP("A. # w/ positive result w/ % of Total Screened",0,2,BGPPTYPE)

 +12       IF BGPPTYPE="P"

               DO W^BGP7DP("A. # w/ positive result w/",0,2,BGPPTYPE)

               DO W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 +13       SET T=28

           FOR X=9:1:13

               SET V=$PIECE(BGPDAP(X),U,4)

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

               SET T=T+9

 +14       IF BGPPTYPE="D"

               DO W^BGP7DP("A. % # w/ positive result w/ % of Total Screened",0,1,BGPPTYPE)

 +15       IF BGPPTYPE="P"

               DO W^BGP7DP("A. % # w/ positive result w/",0,1,BGPPTYPE)

               DO W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 +16       SET T=28

           FOR X=9:1:13

               SET V=$PIECE(BGPDAP(X),U,5)

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

               SET T=T+9

 +17       IF BGPPTYPE="D"

               DO W^BGP7DP("B. # w/ negative result w/ % of Total Screened",0,2,BGPPTYPE)

 +18       IF BGPPTYPE="P"

               DO W^BGP7DP("B. # w/ negative result w/",0,2,BGPPTYPE)

               DO W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 +19       SET T=28

           FOR X=9:1:13

               SET V=$PIECE(BGPDAP(X),U,6)

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

               SET T=T+9

 +20       IF BGPPTYPE="D"

               DO W^BGP7DP("B. % # w/ negative result w/ % of Total Screened",0,1,BGPPTYPE)

 +21       IF BGPPTYPE="P"

               DO W^BGP7DP("B. % # w/ negative result w/",0,1,BGPPTYPE)

               DO W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 +22       SET T=28

           FOR X=9:1:13

               SET V=$PIECE(BGPDAP(X),U,7)

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

               SET T=T+9

 +23       IF BGPPTYPE="D"

               DO W^BGP7DP("C. # w/ No result w/ % of Total Screened",0,2,BGPPTYPE)

 +24       IF BGPPTYPE="P"

               DO W^BGP7DP("C. # w/ No result w/",0,2,BGPPTYPE)

               DO W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 +25       SET T=28

           FOR X=9:1:13

               SET V=$PIECE(BGPDAP(X),U,8)

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

               SET T=T+9

 +26       IF BGPPTYPE="D"

               DO W^BGP7DP("C. % # w/ No result w/ % of Total Screened",0,1,BGPPTYPE)

 +27       IF BGPPTYPE="P"

               DO W^BGP7DP("C. % # w/ No result w/",0,1,BGPPTYPE)

               DO W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 +28       SET T=28

           FOR X=9:1:13

               SET V=$PIECE(BGPDAP(X),U,9)

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

               SET T=T+9

 +29      ;I BGPPTYPE="P" D W^BGP7DP("# w/HIV screening",0,2,BGPPTYPE)

 +30      ;D W^BGP7DP($S(BGPPTYPE="P":" Refusal",1:"# w/HIV screening Refusal"),0,$S(BGPPTYPE="P":1,1:2),BGPPTYPE,1,1)

 +31      ;S T=28 F X=9:1:13 S V=$P(BGPDAB(X),U,10) D W^BGP7DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+9

 +32      ;I BGPPTYPE="P" D W^BGP7DP("% w/HIV screening",0,1,BGPPTYPE)

 +33      ;D W^BGP7DP($S(BGPPTYPE="P":" Refusal",1:"% w/HIV screening Refusal"),0,$S(BGPPTYPE="P":1,1:1),BGPPTYPE,1,1)

 +34      ;S T=28 F X=9:1:13 S V=$P(BGPDAB(X),U,11) D W^BGP7DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+9

 +35      ;

 +36       DO W^BGP7DP("CHANGE FROM BASELINE YR %",0,2,BGPPTYPE)

 +37       IF BGPPTYPE="P"

               DO W^BGP7DP("# w/HIV screening-No",0,2,BGPPTYPE)

 +38       DO W^BGP7DP($SELECT(BGPPTYPE="P":" Refusals (GPRA Dev.)",1:"# w/HIV screening-No Refusals (GPRA Dev.)"),0,$SELECT(BGPPTYPE="P":1,1:2),BGPPTYPE,1,1)

 +39       SET T=28

           FOR X=9:1:13

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

               SET O=$PIECE(BGPDAB(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^BGP7DP(Y,0,0,BGPPTYPE,X+1,T)

               SET T=T+9

 +40       IF BGPPTYPE="D"

               DO W^BGP7DP("A. # w/ positive result w/ % of Total Screened",0,1,BGPPTYPE)

 +41       IF BGPPTYPE="P"

               DO W^BGP7DP("A. # w/ positive result w/",0,1,BGPPTYPE)

               DO W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 +42       SET T=28

           FOR X=9:1:13

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

               SET O=$PIECE(BGPDAB(X),U,5)

               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^BGP7DP(Y,0,0,BGPPTYPE,X+1,T)

               SET T=T+9

 +43       IF BGPPTYPE="D"

               DO W^BGP7DP("B. # w/ negative result w/ % of Total Screened",0,1,BGPPTYPE)

 +44       IF BGPPTYPE="P"

               DO W^BGP7DP("B. # w/ negative result w/",0,1,BGPPTYPE)

               DO W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 +45       SET T=28

           FOR X=9:1:13

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

               SET O=$PIECE(BGPDAB(X),U,7)

               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^BGP7DP(Y,0,0,BGPPTYPE,X+1,T)

               SET T=T+9

 +46       IF BGPPTYPE="D"

               DO W^BGP7DP("C. # w/ No result w/ % of Total Screened",0,1,BGPPTYPE)

 +47       IF BGPPTYPE="P"

               DO W^BGP7DP("C. # w/ No result w/",0,1,BGPPTYPE)

               DO W^BGP7DP(" % of Total Screened",0,1,BGPPTYPE)

 +48       SET T=28

           FOR X=9:1:13

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

               SET O=$PIECE(BGPDAB(X),U,9)

               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^BGP7DP(Y,0,0,BGPPTYPE,X+1,T)

               SET T=T+9

 +49      ;I BGPPTYPE="P" D W^BGP7DP("% w/HIV screening",0,1,BGPPTYPE)

 +50      ;D W^BGP7DP($S(BGPPTYPE="P":" Refusal",1:"% w/HIV screening Refusal"),0,$S(BGPPTYPE="P":1,1:1),BGPPTYPE,1,1)

 +51      ;S T=28 F X=9:1:13 S N=$P(BGPDAC(X),U,11),O=$P(BGPDAB(X),U,11) 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^BGP7DP(Y,0,0,BGPPTYPE,X+1,T) S T=T+9

 +52       QUIT 

C(X,X2,X3) ;

 +1        DO COMMA^%DTC

 +2        QUIT X

SB(X)     ;EP - Strip leading and trailing blanks from X.

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

 +2        QUIT X

AH        ;EP

 +1        IF $GET(BGPSUMON)

               QUIT 

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

 +3        DO W^BGP7DP("Age Specific HIV Screening",0,1,BGPPTYPE)

 +4        IF BGPPTYPE="P"

               IF BGPYSTP=0

                   GOTO G2

 +5        DO W^BGP7DP("<13",0,1,BGPPTYPE,2,25)

 +6        DO W^BGP7DP("13-14",0,0,BGPPTYPE,3,30)

 +7        DO W^BGP7DP("15-19",0,0,BGPPTYPE,4,37)

 +8        DO W^BGP7DP("20-24",0,0,BGPPTYPE,5,44)

 +9        DO W^BGP7DP("25-29",0,0,BGPPTYPE,6,51)

 +10       DO W^BGP7DP("30-34",0,0,BGPPTYPE,7,58)

 +11       DO W^BGP7DP("35-39",0,0,BGPPTYPE,8,65)

 +12       DO W^BGP7DP("40-44",0,0,BGPPTYPE,9,72)

 +13       IF BGPPTYPE="P"

               IF BGPYSTP=1

                   QUIT 

G2        ;

 +1        DO W^BGP7DP("45-49",0,$SELECT(BGPPTYPE="P":1,1:0),BGPPTYPE,10,28)

 +2        DO W^BGP7DP("50-54",0,0,BGPPTYPE,11,37)

 +3        DO W^BGP7DP("55-59",0,0,BGPPTYPE,12,46)

 +4        DO W^BGP7DP("60-64",0,0,BGPPTYPE,13,55)

 +5        DO W^BGP7DP(">65",0,0,BGPPTYPE,14,65)

 +6        QUIT