- 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
- Q
- 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
- Q
- 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
- Q
- 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
- Q
- 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)
- Q
- 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