Routine: BGP7DP1H

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

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

 ;HIV SCREENING AGE DIST

I1AGE ;EP  special age tallies

 Q:$G(BGPSUMON)

 Q:BGPRTYPE'=9

 I BGPINDG="W",BGPRTYPE=4 G FEM

 S BGPHD1="USER POPULATION PATIENTS ",BGPHD2="Total # User Pop"

 K BGPDAC,BGPDAP,BGPDAB S (BGPCC,BGPDD)=0 F BGPX="G.1","G.2","G.3","G.4","G.5","G.6","G.7","G.8","G.9","G.10","G.11","G.12","G.13" D I1AGE1

 D I1AGEP

 Q:BGPQUIT

 S BGPHD1="MALE USER POPULATION",BGPHD2="Total MALE User Pop"

 K BGPDAC,BGPDAP,BGPDAB S (BGPCC,BGPDD)=0 F BGPX="H.1","H.2","H.3","H.4","H.5","H.6","H.7","H.8","H.9","H.10","H.11","H.12","H.13" D I1AGE1

 D I1AGEP

 Q:BGPQUIT

FEM ;

 S BGPHD1="FEMALE USER POPULATION",BGPHD2="Total FEMALE User Pop"

 K BGPDAC,BGPDAP,BGPDAB S (BGPCC,BGPDD)=0 F BGPX="I.1","I.2","I.3","I.4","I.5","I.6","I.7","I.8","I.9","I.10","I.11","I.12","I.13" D I1AGE1

 D I1AGEP

I1AGE1 ;

 S BGPCC=BGPCC+1

 S BGPZ="A",BGPP1=2,BGPP2=3 D AGES

 S BGPZ="B",BGPP1=4,BGPP2=5 D AGES

 S BGPZ="C",BGPP1=6,BGPP2=7 D AGES

 S BGPZ="D",BGPP1=8,BGPP2=9 D AGES

 ;S BGPZ="E",BGPP1=10,BGPP2=11 D AGES

AGES ;

 S BGPF="E-2."_BGPX_BGPZ S BGPPC=$O(^BGPINDGC("C",BGPF,0))

 I BGPZ="A" D

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

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

 .S $P(BGPDAC(BGPCC),U)=$$V^BGP7DP1C(1,BGPRPT,N,P)

 .S $P(BGPDAP(BGPCC),U)=$$V^BGP7DP1C(2,BGPRPT,N,P)

 .S $P(BGPDAB(BGPCC),U)=$$V^BGP7DP1C(3,BGPRPT,N,P)

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

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

 S BGPBLD=$$V^BGP7DP1C(3,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP7DP1C(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(^BGPINDGC(BGPPC,0),U,9)

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

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

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

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

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

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

 S BGPBLN=$$V^BGP7DP1C(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:"")

 D SETN1^BGP7DP1C

I1AGEP ;

 S BGPYSTP=1

 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

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

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

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

 S T=23 F X=1:1:$S(BGPPTYPE="P":8,1:13) S V=$P(BGPDAC(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+7

 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=23 F X=1:1:$S(BGPPTYPE="P":8,1:13) S V=$P(BGPDAC(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+7

 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=23 F X=1:1:$S(BGPPTYPE="P":8,1:13) S V=$P(BGPDAC(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+7

 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=23 F X=1:1:$S(BGPPTYPE="P":8,1:13) S V=$P(BGPDAC(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+7

 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=23 F X=1:1:$S(BGPPTYPE="P":8,1:13) S V=$P(BGPDAC(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+7

 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=23 F X=1:1:$S(BGPPTYPE="P":8,1:13) S V=$P(BGPDAC(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+7

 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=23 F X=1:1:$S(BGPPTYPE="P":8,1:13) S V=$P(BGPDAC(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+7

 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=23 F X=1:1:$S(BGPPTYPE="P":8,1:13) S V=$P(BGPDAC(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+7

 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=23 F X=1:1:$S(BGPPTYPE="P":8,1:13) S V=$P(BGPDAC(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+7

 ;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=23 F X=1:1:$S(BGPPTYPE="P":8,1:13) S V=$P(BGPDAC(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+7

 ;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=23 F X=1:1:$S(BGPPTYPE="P":8,1:13) S V=$P(BGPDAC(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+7

 I BGPPTYPE="P" D SNDPG^BGP7DP1I

 D I1AGEP^BGP7DP1J

C(X,X2,X3) ;

 D COMMA^%DTC

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)

SB(X) ;EP - Strip

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

Q X

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

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

 +2       ;

 +3       ;HIV SCREENING AGE DIST

I1AGE     ;EP  special age tallies

 +1        IF $GET(BGPSUMON)

               QUIT

 +2        IF BGPRTYPE'=9

               QUIT

 +3        IF BGPINDG="W"

               IF BGPRTYPE=4

                   GOTO FEM

 +4        SET BGPHD1="USER POPULATION PATIENTS "

           SET BGPHD2="Total # User Pop"

 +5        KILL BGPDAC,BGPDAP,BGPDAB

           SET (BGPCC,BGPDD)=0

           FOR BGPX="G.1","G.2","G.3","G.4","G.5","G.6","G.7","G.8","G.9","G.10","G.11","G.12","G.13"

               DO I1AGE1

 +6        DO I1AGEP

 +7        IF BGPQUIT

               QUIT

 +8        SET BGPHD1="MALE USER POPULATION"

           SET BGPHD2="Total MALE User Pop"

 +9        KILL BGPDAC,BGPDAP,BGPDAB

           SET (BGPCC,BGPDD)=0

           FOR BGPX="H.1","H.2","H.3","H.4","H.5","H.6","H.7","H.8","H.9","H.10","H.11","H.12","H.13"

               DO I1AGE1

 +10       DO I1AGEP

 +11       IF BGPQUIT

               QUIT

FEM       ;

 +1        SET BGPHD1="FEMALE USER POPULATION"

           SET BGPHD2="Total FEMALE User Pop"

 +2        KILL BGPDAC,BGPDAP,BGPDAB

           SET (BGPCC,BGPDD)=0

           FOR BGPX="I.1","I.2","I.3","I.4","I.5","I.6","I.7","I.8","I.9","I.10","I.11","I.12","I.13"

               DO I1AGE1

 +3        DO I1AGEP

 +4        QUIT

I1AGE1    ;

 +1       ;

 +2        SET BGPCC=BGPCC+1

 +3        SET BGPZ="A"

           SET BGPP1=2

           SET BGPP2=3

           DO AGES

 +4        SET BGPZ="B"

           SET BGPP1=4

           SET BGPP2=5

           DO AGES

 +5        SET BGPZ="C"

           SET BGPP1=6

           SET BGPP2=7

           DO AGES

 +6        SET BGPZ="D"

           SET BGPP1=8

           SET BGPP2=9

           DO AGES

 +7       ;S BGPZ="E",BGPP1=10,BGPP2=11 D AGES

 +8        QUIT

AGES      ;

 +1        SET BGPF="E-2."_BGPX_BGPZ

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

 +2        IF BGPZ="A"

               Begin DoDot:1

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

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

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

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

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

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

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

               End DoDot:1

 +8        SET BGPCYD=$$V^BGP7DP1C(1,BGPRPT,N,P,1)

           IF $GET(BGPAREAA)

               DO SETEXA^BGP7DP1C(1,N,P)

 +9        SET BGPPRD=$$V^BGP7DP1C(2,BGPRPT,N,P,1)

           IF $GET(BGPAREAA)

               DO SETEXA^BGP7DP1C(2,N,P)

 +10       SET BGPBLD=$$V^BGP7DP1C(3,BGPRPT,N,P,1)

           IF $GET(BGPAREAA)

               DO SETEXA^BGP7DP1C(3,N,P)

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

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

 +13       SET Q=1

 +14       IF J["B"

               SET Q=2

 +15       IF J["C"

               SET Q=2

 +16       IF J["D"

               SET Q=2

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

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

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

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

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

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

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

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

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

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

 +22       SET BGPCYN=$$V^BGP7DP1C(1,BGPRPT,N,P,2)

 +23       SET BGPPRN=$$V^BGP7DP1C(2,BGPRPT,N,P,2)

 +24       SET BGPBLN=$$V^BGP7DP1C(3,BGPRPT,N,P,2)

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

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

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

 +28       DO SETN1^BGP7DP1C

 +29       QUIT

I1AGEP    ;

 +1        SET BGPYSTP=1

 +2        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

 +3        IF BGPPTYPE'="P"

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

               DO AH

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

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

 +6        SET T=23

           FOR X=1:1:$SELECT(BGPPTYPE="P":8,1:13)

               SET V=$PIECE(BGPDAC(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+7

 +7        IF BGPPTYPE="P"

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

 +8        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)

 +9        SET T=23

           FOR X=1:1:$SELECT(BGPPTYPE="P":8,1:13)

               SET V=$PIECE(BGPDAC(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+7

 +10       IF BGPPTYPE="P"

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

 +11       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)

 +12       SET T=23

           FOR X=1:1:$SELECT(BGPPTYPE="P":8,1:13)

               SET V=$PIECE(BGPDAC(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+7

 +13       IF BGPPTYPE="D"

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

 +14       IF BGPPTYPE="P"

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

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

 +15       SET T=23

           FOR X=1:1:$SELECT(BGPPTYPE="P":8,1:13)

               SET V=$PIECE(BGPDAC(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+7

 +16       IF BGPPTYPE="D"

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

 +17       IF BGPPTYPE="P"

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

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

 +18       SET T=23

           FOR X=1:1:$SELECT(BGPPTYPE="P":8,1:13)

               SET V=$PIECE(BGPDAC(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+7

 +19       IF BGPPTYPE="D"

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

 +20       IF BGPPTYPE="P"

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

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

 +21       SET T=23

           FOR X=1:1:$SELECT(BGPPTYPE="P":8,1:13)

               SET V=$PIECE(BGPDAC(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+7

 +22       IF BGPPTYPE="D"

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

 +23       IF BGPPTYPE="P"

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

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

 +24       SET T=23

           FOR X=1:1:$SELECT(BGPPTYPE="P":8,1:13)

               SET V=$PIECE(BGPDAC(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+7

 +25       IF BGPPTYPE="D"

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

 +26       IF BGPPTYPE="P"

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

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

 +27       SET T=23

           FOR X=1:1:$SELECT(BGPPTYPE="P":8,1:13)

               SET V=$PIECE(BGPDAC(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+7

 +28       IF BGPPTYPE="D"

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

 +29       IF BGPPTYPE="P"

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

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

 +30       SET T=23

           FOR X=1:1:$SELECT(BGPPTYPE="P":8,1:13)

               SET V=$PIECE(BGPDAC(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+7

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

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

 +33      ;S T=23 F X=1:1:$S(BGPPTYPE="P":8,1:13) S V=$P(BGPDAC(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+7

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

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

 +36      ;S T=23 F X=1:1:$S(BGPPTYPE="P":8,1:13) S V=$P(BGPDAC(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+7

 +37       IF BGPPTYPE="P"

               DO SNDPG^BGP7DP1I

 +38       DO I1AGEP^BGP7DP1J

 +39       QUIT

C(X,X2,X3) ;

 +1        DO COMMA^%DTC

 +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

SB(X)     ;EP - Strip

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

 +2        QUIT X

BGP7DP1H.m