- BGP6DP1K ; IHS/CMI/LAB - print ind 1 ;
- ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- ;
- BL ;EP
- I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP6DPH Q:BGPQUIT D W^BGP6DP(^BGPINDM(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDM(BGPIC,53,2,0)) W^BGP6DP(^BGPINDM(BGPIC,53,2,0),0,1,BGPPTYPE) D AH^BGP6DP1H
- D W^BGP6DP("BASELINE REPORT PERIOD",0,$S(BGPPTYPE="P":1,1:2),BGPPTYPE)
- D W^BGP6DP(BGPHD2,0,1,BGPPTYPE)
- S T=28 F X=9:1:13 S V=$P(BGPDAB(X),U) D W^BGP6DP($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^BGP6DP("# w/HIV screening-No",0,2,BGPPTYPE)
- D W^BGP6DP($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^BGP6DP($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^BGP6DP("% w/HIV screening-No",0,1,BGPPTYPE)
- D W^BGP6DP($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^BGP6DP($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^BGP6DP("A. # w/ positive result w/ % of Total Screened",0,2,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP6DP("A. # w/ positive result w/",0,2,BGPPTYPE),W^BGP6DP(" % of Total Screened",0,1,BGPPTYPE)
- S T=28 F X=9:1:13 S V=$P(BGPDAP(X),U,4) D W^BGP6DP($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^BGP6DP("A. % # w/ positive result w/ % of Total Screened",0,1,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP6DP("A. % # w/ positive result w/",0,1,BGPPTYPE),W^BGP6DP(" % of Total Screened",0,1,BGPPTYPE)
- S T=28 F X=9:1:13 S V=$P(BGPDAP(X),U,5) D W^BGP6DP($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^BGP6DP("B. # w/ negative result w/ % of Total Screened",0,2,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP6DP("B. # w/ negative result w/",0,2,BGPPTYPE),W^BGP6DP(" % of Total Screened",0,1,BGPPTYPE)
- S T=28 F X=9:1:13 S V=$P(BGPDAP(X),U,6) D W^BGP6DP($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^BGP6DP("B. % # w/ negative result w/ % of Total Screened",0,1,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP6DP("B. % # w/ negative result w/",0,1,BGPPTYPE),W^BGP6DP(" % of Total Screened",0,1,BGPPTYPE)
- S T=28 F X=9:1:13 S V=$P(BGPDAP(X),U,7) D W^BGP6DP($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^BGP6DP("C. # w/ No result w/ % of Total Screened",0,2,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP6DP("C. # w/ No result w/",0,2,BGPPTYPE),W^BGP6DP(" % of Total Screened",0,1,BGPPTYPE)
- S T=28 F X=9:1:13 S V=$P(BGPDAP(X),U,8) D W^BGP6DP($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^BGP6DP("C. % # w/ No result w/ % of Total Screened",0,1,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP6DP("C. % # w/ No result w/",0,1,BGPPTYPE),W^BGP6DP(" % of Total Screened",0,1,BGPPTYPE)
- S T=28 F X=9:1:13 S V=$P(BGPDAP(X),U,9) D W^BGP6DP($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^BGP6DP("# w/HIV screening",0,2,BGPPTYPE)
- ;D W^BGP6DP($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^BGP6DP($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^BGP6DP("% w/HIV screening",0,1,BGPPTYPE)
- ;D W^BGP6DP($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^BGP6DP($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^BGP6DP("CHANGE FROM BASELINE YR %",0,2,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP6DP("# w/HIV screening-No",0,2,BGPPTYPE)
- D W^BGP6DP($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^BGP6DP(Y,0,0,BGPPTYPE,X+1,T) S T=T+9
- I BGPPTYPE="D" D W^BGP6DP("A. # w/ positive result w/ % of Total Screened",0,1,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP6DP("A. # w/ positive result w/",0,1,BGPPTYPE),W^BGP6DP(" % 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^BGP6DP(Y,0,0,BGPPTYPE,X+1,T) S T=T+9
- I BGPPTYPE="D" D W^BGP6DP("B. # w/ negative result w/ % of Total Screened",0,1,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP6DP("B. # w/ negative result w/",0,1,BGPPTYPE),W^BGP6DP(" % 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^BGP6DP(Y,0,0,BGPPTYPE,X+1,T) S T=T+9
- I BGPPTYPE="D" D W^BGP6DP("C. # w/ No result w/ % of Total Screened",0,1,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP6DP("C. # w/ No result w/",0,1,BGPPTYPE),W^BGP6DP(" % 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^BGP6DP(Y,0,0,BGPPTYPE,X+1,T) S T=T+9
- ;I BGPPTYPE="P" D W^BGP6DP("% w/HIV screening",0,1,BGPPTYPE)
- ;D W^BGP6DP($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^BGP6DP(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^BGP6DP(BGPHD1,1,2,BGPPTYPE)
- D W^BGP6DP("Age Specific HIV Screening",0,1,BGPPTYPE)
- I BGPPTYPE="P",BGPYSTP=0 G G2
- D W^BGP6DP("<13",0,1,BGPPTYPE,2,25)
- D W^BGP6DP("13-14",0,0,BGPPTYPE,3,30)
- D W^BGP6DP("15-19",0,0,BGPPTYPE,4,37)
- D W^BGP6DP("20-24",0,0,BGPPTYPE,5,44)
- D W^BGP6DP("25-29",0,0,BGPPTYPE,6,51)
- D W^BGP6DP("30-34",0,0,BGPPTYPE,7,58)
- D W^BGP6DP("35-39",0,0,BGPPTYPE,8,65)
- D W^BGP6DP("40-44",0,0,BGPPTYPE,9,72)
- I BGPPTYPE="P",BGPYSTP=1 Q
- G2 ;
- D W^BGP6DP("45-49",0,$S(BGPPTYPE="P":1,1:0),BGPPTYPE,10,28)
- D W^BGP6DP("50-54",0,0,BGPPTYPE,11,37)
- D W^BGP6DP("55-59",0,0,BGPPTYPE,12,46)
- D W^BGP6DP("60-64",0,0,BGPPTYPE,13,55)
- D W^BGP6DP(">65",0,0,BGPPTYPE,14,65)
- Q
- BGP6DP1K ; IHS/CMI/LAB - print ind 1 ;
- +1 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- +2 ;
- BL ;EP
- +1 IF '$GET(BGPSUMON)
- IF BGPPTYPE="P"
- DO HEADER^BGP6DPH
- IF BGPQUIT
- QUIT
- DO W^BGP6DP(^BGPINDM(BGPIC,53,1,0),0,1,BGPPTYPE)
- IF $DATA(^BGPINDM(BGPIC,53,2,0))
- DO W^BGP6DP(^BGPINDM(BGPIC,53,2,0),0,1,BGPPTYPE)
- DO AH^BGP6DP1H
- +2 DO W^BGP6DP("BASELINE REPORT PERIOD",0,$SELECT(BGPPTYPE="P":1,1:2),BGPPTYPE)
- +3 DO W^BGP6DP(BGPHD2,0,1,BGPPTYPE)
- +4 SET T=28
- FOR X=9:1:13
- SET V=$PIECE(BGPDAB(X),U)
- DO W^BGP6DP($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^BGP6DP("# w/HIV screening-No",0,2,BGPPTYPE)
- +6 DO W^BGP6DP($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^BGP6DP($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^BGP6DP("% w/HIV screening-No",0,1,BGPPTYPE)
- +9 DO W^BGP6DP($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^BGP6DP($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^BGP6DP("A. # w/ positive result w/ % of Total Screened",0,2,BGPPTYPE)
- +12 IF BGPPTYPE="P"
- DO W^BGP6DP("A. # w/ positive result w/",0,2,BGPPTYPE)
- DO W^BGP6DP(" % of Total Screened",0,1,BGPPTYPE)
- +13 SET T=28
- FOR X=9:1:13
- SET V=$PIECE(BGPDAP(X),U,4)
- DO W^BGP6DP($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^BGP6DP("A. % # w/ positive result w/ % of Total Screened",0,1,BGPPTYPE)
- +15 IF BGPPTYPE="P"
- DO W^BGP6DP("A. % # w/ positive result w/",0,1,BGPPTYPE)
- DO W^BGP6DP(" % of Total Screened",0,1,BGPPTYPE)
- +16 SET T=28
- FOR X=9:1:13
- SET V=$PIECE(BGPDAP(X),U,5)
- DO W^BGP6DP($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^BGP6DP("B. # w/ negative result w/ % of Total Screened",0,2,BGPPTYPE)
- +18 IF BGPPTYPE="P"
- DO W^BGP6DP("B. # w/ negative result w/",0,2,BGPPTYPE)
- DO W^BGP6DP(" % of Total Screened",0,1,BGPPTYPE)
- +19 SET T=28
- FOR X=9:1:13
- SET V=$PIECE(BGPDAP(X),U,6)
- DO W^BGP6DP($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^BGP6DP("B. % # w/ negative result w/ % of Total Screened",0,1,BGPPTYPE)
- +21 IF BGPPTYPE="P"
- DO W^BGP6DP("B. % # w/ negative result w/",0,1,BGPPTYPE)
- DO W^BGP6DP(" % of Total Screened",0,1,BGPPTYPE)
- +22 SET T=28
- FOR X=9:1:13
- SET V=$PIECE(BGPDAP(X),U,7)
- DO W^BGP6DP($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^BGP6DP("C. # w/ No result w/ % of Total Screened",0,2,BGPPTYPE)
- +24 IF BGPPTYPE="P"
- DO W^BGP6DP("C. # w/ No result w/",0,2,BGPPTYPE)
- DO W^BGP6DP(" % of Total Screened",0,1,BGPPTYPE)
- +25 SET T=28
- FOR X=9:1:13
- SET V=$PIECE(BGPDAP(X),U,8)
- DO W^BGP6DP($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^BGP6DP("C. % # w/ No result w/ % of Total Screened",0,1,BGPPTYPE)
- +27 IF BGPPTYPE="P"
- DO W^BGP6DP("C. % # w/ No result w/",0,1,BGPPTYPE)
- DO W^BGP6DP(" % of Total Screened",0,1,BGPPTYPE)
- +28 SET T=28
- FOR X=9:1:13
- SET V=$PIECE(BGPDAP(X),U,9)
- DO W^BGP6DP($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^BGP6DP("# w/HIV screening",0,2,BGPPTYPE)
- +30 ;D W^BGP6DP($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^BGP6DP($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^BGP6DP("% w/HIV screening",0,1,BGPPTYPE)
- +33 ;D W^BGP6DP($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^BGP6DP($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^BGP6DP("CHANGE FROM BASELINE YR %",0,2,BGPPTYPE)
- +37 IF BGPPTYPE="P"
- DO W^BGP6DP("# w/HIV screening-No",0,2,BGPPTYPE)
- +38 DO W^BGP6DP($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^BGP6DP(Y,0,0,BGPPTYPE,X+1,T)
- SET T=T+9
- +40 IF BGPPTYPE="D"
- DO W^BGP6DP("A. # w/ positive result w/ % of Total Screened",0,1,BGPPTYPE)
- +41 IF BGPPTYPE="P"
- DO W^BGP6DP("A. # w/ positive result w/",0,1,BGPPTYPE)
- DO W^BGP6DP(" % 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^BGP6DP(Y,0,0,BGPPTYPE,X+1,T)
- SET T=T+9
- +43 IF BGPPTYPE="D"
- DO W^BGP6DP("B. # w/ negative result w/ % of Total Screened",0,1,BGPPTYPE)
- +44 IF BGPPTYPE="P"
- DO W^BGP6DP("B. # w/ negative result w/",0,1,BGPPTYPE)
- DO W^BGP6DP(" % 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^BGP6DP(Y,0,0,BGPPTYPE,X+1,T)
- SET T=T+9
- +46 IF BGPPTYPE="D"
- DO W^BGP6DP("C. # w/ No result w/ % of Total Screened",0,1,BGPPTYPE)
- +47 IF BGPPTYPE="P"
- DO W^BGP6DP("C. # w/ No result w/",0,1,BGPPTYPE)
- DO W^BGP6DP(" % 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^BGP6DP(Y,0,0,BGPPTYPE,X+1,T)
- SET T=T+9
- +49 ;I BGPPTYPE="P" D W^BGP6DP("% w/HIV screening",0,1,BGPPTYPE)
- +50 ;D W^BGP6DP($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^BGP6DP(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^BGP6DP(BGPHD1,1,2,BGPPTYPE)
- +3 DO W^BGP6DP("Age Specific HIV Screening",0,1,BGPPTYPE)
- +4 IF BGPPTYPE="P"
- IF BGPYSTP=0
- GOTO G2
- +5 DO W^BGP6DP("<13",0,1,BGPPTYPE,2,25)
- +6 DO W^BGP6DP("13-14",0,0,BGPPTYPE,3,30)
- +7 DO W^BGP6DP("15-19",0,0,BGPPTYPE,4,37)
- +8 DO W^BGP6DP("20-24",0,0,BGPPTYPE,5,44)
- +9 DO W^BGP6DP("25-29",0,0,BGPPTYPE,6,51)
- +10 DO W^BGP6DP("30-34",0,0,BGPPTYPE,7,58)
- +11 DO W^BGP6DP("35-39",0,0,BGPPTYPE,8,65)
- +12 DO W^BGP6DP("40-44",0,0,BGPPTYPE,9,72)
- +13 IF BGPPTYPE="P"
- IF BGPYSTP=1
- QUIT
- G2 ;
- +1 DO W^BGP6DP("45-49",0,$SELECT(BGPPTYPE="P":1,1:0),BGPPTYPE,10,28)
- +2 DO W^BGP6DP("50-54",0,0,BGPPTYPE,11,37)
- +3 DO W^BGP6DP("55-59",0,0,BGPPTYPE,12,46)
- +4 DO W^BGP6DP("60-64",0,0,BGPPTYPE,13,55)
- +5 DO W^BGP6DP(">65",0,0,BGPPTYPE,14,65)
- +6 QUIT
