- BGP7DP1T ; 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)
- I BGPINDG="W" G FEM
- S BGPHD1="Active Clinical Pts 3-17",BGPHD2="Active Clinical Pts 3-17 "
- K BGPDAC,BGPDAP,BGPDAB
- S (BGPX,BGPDD)=0,BGPZZ="E" F BGPXX=1:1:4 D I1AGE1
- D I1AGEP
- S BGPHD1="Male Active Clinical Pts 3-17",BGPHD2="Male Active Clinical Pts 3-17 "
- K BGPDAC,BGPDAP,BGPDAB
- S (BGPX,BGPDD)=0,BGPZZ="G" F BGPXX=1:1:4 D I1AGE1
- D I1AGEP
- FEM ;
- S BGPHD1="Female Active Clinical Pts 3-17",BGPHD2="Female Active Clinical Pts 3-17 "
- K BGPDAC,BGPDAP,BGPDAB
- S (BGPX,BGPDD)=0,BGPZZ="I" F BGPXX=1:1:4 D I1AGE1
- D I1AGEP
- Q
- I1AGE1 ;
- ;
- I BGPXX=1 S BGPP1=2,BGPP2=3
- I BGPXX=2 S BGPP1=4,BGPP2=5
- I BGPXX=3 S BGPP1=6,BGPP2=7
- I BGPXX=4 S BGPP1=8,BGPP2=9
- ;I BGPXX=9 S BGPP1=10,BGPP2=11
- S BGPZ="A",BGPX=1 D AGES
- S BGPZ="B",BGPX=2 D AGES
- ;S BGPZ="C",BGPX=3 D AGES
- Q
- AGES ;
- S BGPF="WCC."_BGPZZ_"."_BGPXX_BGPZ S BGPPC=$O(^BGPINDGC("C",BGPF,0))
- 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(BGPX),U)=$$V^BGP7DP1C(1,BGPRPT,N,P)
- .S $P(BGPDAP(BGPX),U)=$$V^BGP7DP1C(2,BGPRPT,N,P)
- .S $P(BGPDAB(BGPX),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(BGPX),U,BGPP1)=$$V^BGP7DP1C(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^BGP7DP1C(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^BGP7DP1C(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^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($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
- ;I BGPPTYPE="P" D W^BGP7DP(BGPHD3,0,1,BGPPTYPE)
- S BGPARR="BGPDAC" D I1AGEP1
- ;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("PREVIOUS REPORT PERIOD",0,1,BGPPTYPE)
- D W^BGP7DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
- ;I BGPPTYPE="P" D W^BGP7DP(BGPHD3,0,1,BGPPTYPE)
- S BGPARR="BGPDAP" D I1AGEP1
- 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("BASELINE REPORT PERIOD",0,1,BGPPTYPE)
- D W^BGP7DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
- ;I BGPPTYPE="P" D W^BGP7DP(BGPHD3,0,1,BGPPTYPE)
- S BGPARR="BGPDAB" D I1AGEP1
- Q
- I1AGEP1 ;
- S T=30 F X=1:1:2 S V=$P(@BGPARR@(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+11
- D W^BGP7DP("# w/ Comprehensive Assessment",0,2,BGPPTYPE)
- S T=31 F X=1:1:2 S V=$P(@BGPARR@(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+11
- D W^BGP7DP("% w/ Comprehensive Assessment",0,1,BGPPTYPE)
- S T=30 F X=1:1:2 S V=$P(@BGPARR@(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+11
- D W^BGP7DP("# w/ BMI Documented",0,2,BGPPTYPE)
- S T=31 F X=1:1:2 S V=$P(@BGPARR@(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+11
- D W^BGP7DP("% w/ BMI Documented",0,1,BGPPTYPE)
- S T=30 F X=1:1:2 S V=$P(@BGPARR@(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+11
- D W^BGP7DP("% w/ Nutrition Counseling",0,2,BGPPTYPE)
- S T=31 F X=1:1:2 S V=$P(@BGPARR@(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+11
- D W^BGP7DP("% w/ Nutrition Counseling",0,1,BGPPTYPE)
- S T=30 F X=1:1:2 S V=$P(@BGPARR@(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+11
- I BGPPTYPE="D" D W^BGP7DP("# w/ Physical Activity Counseling",0,2,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP7DP("# w/ Physical Activity",0,2,BGPPTYPE),W^BGP7DP(" Counseling",0,1,BGPPTYPE)
- S T=31 F X=1:1:2 S V=$P(@BGPARR@(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+11
- I BGPPTYPE="D" D W^BGP7DP("% w/ Physical Activity Counseling",0,1,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP7DP("% w/ Physical Activity",0,1,BGPPTYPE),W^BGP7DP(" Counseling",0,1,BGPPTYPE)
- S T=30 F X=1:1:2 S V=$P(@BGPARR@(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+11
- I BGPARR="BGPDAP"!(BGPARR="BGPDAB") D
- .D W^BGP7DP("CHANGE FROM "_$S(BGPARR="BGPDAP":"PREVIOUS YR %",1:"BASELINE YR %"),0,2,BGPPTYPE)
- .S L="# w/ Comprehensive Assessment",P=3 D PBY
- .S L="# w/ BMI Documented",P=5 D PBY
- .S L="# w/ Nutrition Counseling",P=7 D PBY
- .I BGPPTYPE="P" D W^BGP7DP("# w/ Physical Activity",0,1,BGPPTYPE) S L=" Counseling",P=9 D PBY
- .I BGPPTYPE="D" S L="# w/ Physical Activity Counseling",P=9 D PBY
- .Q
- Q
- PBY ;
- D W^BGP7DP(L,0,1,BGPPTYPE)
- S T=30 F X=1:1:2 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^BGP7DP(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^BGP7DP(BGPHD1,1,2,BGPPTYPE)
- ;D W^BGP7DP("Asthma Assessments",0,1,BGPPTYPE)
- D W^BGP7DP(" 3 - 11",0,1,BGPPTYPE,2,34)
- D W^BGP7DP(" 12 - 17",0,0,BGPPTYPE,3,45)
- ;D W^BGP7DP("18+",0,0,BGPPTYPE,4,56)
- ;D W^BGP7DP("65+",0,0,BGPPTYPE,5,67)
- Q
- SB(X) ;EP - Strip
- X ^DD("FUNC",$O(^DD("FUNC","B","STRIPBLANKS",0)),1)
- Q X
- BGP7DP1T ; 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 BGPINDG="W"
- GOTO FEM
- +3 SET BGPHD1="Active Clinical Pts 3-17"
- SET BGPHD2="Active Clinical Pts 3-17 "
- +4 KILL BGPDAC,BGPDAP,BGPDAB
- +5 SET (BGPX,BGPDD)=0
- SET BGPZZ="E"
- FOR BGPXX=1:1:4
- DO I1AGE1
- +6 DO I1AGEP
- +7 SET BGPHD1="Male Active Clinical Pts 3-17"
- SET BGPHD2="Male Active Clinical Pts 3-17 "
- +8 KILL BGPDAC,BGPDAP,BGPDAB
- +9 SET (BGPX,BGPDD)=0
- SET BGPZZ="G"
- FOR BGPXX=1:1:4
- DO I1AGE1
- +10 DO I1AGEP
- FEM ;
- +1 SET BGPHD1="Female Active Clinical Pts 3-17"
- SET BGPHD2="Female Active Clinical Pts 3-17 "
- +2 KILL BGPDAC,BGPDAP,BGPDAB
- +3 SET (BGPX,BGPDD)=0
- SET BGPZZ="I"
- FOR BGPXX=1:1:4
- DO I1AGE1
- +4 DO I1AGEP
- +5 QUIT
- I1AGE1 ;
- +1 ;
- +2 IF BGPXX=1
- SET BGPP1=2
- SET BGPP2=3
- +3 IF BGPXX=2
- SET BGPP1=4
- SET BGPP2=5
- +4 IF BGPXX=3
- SET BGPP1=6
- SET BGPP2=7
- +5 IF BGPXX=4
- SET BGPP1=8
- SET BGPP2=9
- +6 ;I BGPXX=9 S BGPP1=10,BGPP2=11
- +7 SET BGPZ="A"
- SET BGPX=1
- DO AGES
- +8 SET BGPZ="B"
- SET BGPX=2
- DO AGES
- +9 ;S BGPZ="C",BGPX=3 D AGES
- +10 QUIT
- AGES ;
- +1 SET BGPF="WCC."_BGPZZ_"."_BGPXX_BGPZ
- SET BGPPC=$ORDER(^BGPINDGC("C",BGPF,0))
- +2 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(BGPX),U)=$$V^BGP7DP1C(1,BGPRPT,N,P)
- +6 SET $PIECE(BGPDAP(BGPX),U)=$$V^BGP7DP1C(2,BGPRPT,N,P)
- +7 SET $PIECE(BGPDAB(BGPX),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 ;I J["B" S Q=2
- +15 ;I J["C" S Q=2
- +16 ;I J["D" S 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(BGPX),U,BGPP1)=$$V^BGP7DP1C(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^BGP7DP1C(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^BGP7DP1C(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^BGP7DP1C(1,BGPRPT,N,P,2)
- +23 ;S BGPPRN=$$V^BGP7DP1C(2,BGPRPT,N,P,2)
- +24 ;S BGPBLN=$$V^BGP7DP1C(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 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($SELECT(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
- +6 ;I BGPPTYPE="P" D W^BGP7DP(BGPHD3,0,1,BGPPTYPE)
- +7 SET BGPARR="BGPDAC"
- DO I1AGEP1
- +8 ;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
- +9 IF BGPPTYPE'="P"
- DO W^BGP7DP("",0,2,BGPPTYPE)
- DO AH
- +10 DO W^BGP7DP("PREVIOUS REPORT PERIOD",0,1,BGPPTYPE)
- +11 DO W^BGP7DP($SELECT(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
- +12 ;I BGPPTYPE="P" D W^BGP7DP(BGPHD3,0,1,BGPPTYPE)
- +13 SET BGPARR="BGPDAP"
- DO I1AGEP1
- +14 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
- +15 IF BGPPTYPE'="P"
- DO W^BGP7DP("",0,2,BGPPTYPE)
- DO AH
- +16 DO W^BGP7DP("BASELINE REPORT PERIOD",0,1,BGPPTYPE)
- +17 DO W^BGP7DP($SELECT(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
- +18 ;I BGPPTYPE="P" D W^BGP7DP(BGPHD3,0,1,BGPPTYPE)
- +19 SET BGPARR="BGPDAB"
- DO I1AGEP1
- +20 QUIT
- I1AGEP1 ;
- +1 SET T=30
- FOR X=1:1:2
- SET V=$PIECE(@BGPARR@(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+11
- +2 DO W^BGP7DP("# w/ Comprehensive Assessment",0,2,BGPPTYPE)
- +3 SET T=31
- FOR X=1:1:2
- SET V=$PIECE(@BGPARR@(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+11
- +4 DO W^BGP7DP("% w/ Comprehensive Assessment",0,1,BGPPTYPE)
- +5 SET T=30
- FOR X=1:1:2
- SET V=$PIECE(@BGPARR@(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+11
- +6 DO W^BGP7DP("# w/ BMI Documented",0,2,BGPPTYPE)
- +7 SET T=31
- FOR X=1:1:2
- SET V=$PIECE(@BGPARR@(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+11
- +8 DO W^BGP7DP("% w/ BMI Documented",0,1,BGPPTYPE)
- +9 SET T=30
- FOR X=1:1:2
- SET V=$PIECE(@BGPARR@(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+11
- +10 DO W^BGP7DP("% w/ Nutrition Counseling",0,2,BGPPTYPE)
- +11 SET T=31
- FOR X=1:1:2
- SET V=$PIECE(@BGPARR@(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+11
- +12 DO W^BGP7DP("% w/ Nutrition Counseling",0,1,BGPPTYPE)
- +13 SET T=30
- FOR X=1:1:2
- SET V=$PIECE(@BGPARR@(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+11
- +14 IF BGPPTYPE="D"
- DO W^BGP7DP("# w/ Physical Activity Counseling",0,2,BGPPTYPE)
- +15 IF BGPPTYPE="P"
- DO W^BGP7DP("# w/ Physical Activity",0,2,BGPPTYPE)
- DO W^BGP7DP(" Counseling",0,1,BGPPTYPE)
- +16 SET T=31
- FOR X=1:1:2
- SET V=$PIECE(@BGPARR@(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+11
- +17 IF BGPPTYPE="D"
- DO W^BGP7DP("% w/ Physical Activity Counseling",0,1,BGPPTYPE)
- +18 IF BGPPTYPE="P"
- DO W^BGP7DP("% w/ Physical Activity",0,1,BGPPTYPE)
- DO W^BGP7DP(" Counseling",0,1,BGPPTYPE)
- +19 SET T=30
- FOR X=1:1:2
- SET V=$PIECE(@BGPARR@(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+11
- +20 IF BGPARR="BGPDAP"!(BGPARR="BGPDAB")
- Begin DoDot:1
- +21 DO W^BGP7DP("CHANGE FROM "_$SELECT(BGPARR="BGPDAP":"PREVIOUS YR %",1:"BASELINE YR %"),0,2,BGPPTYPE)
- +22 SET L="# w/ Comprehensive Assessment"
- SET P=3
- DO PBY
- +23 SET L="# w/ BMI Documented"
- SET P=5
- DO PBY
- +24 SET L="# w/ Nutrition Counseling"
- SET P=7
- DO PBY
- +25 IF BGPPTYPE="P"
- DO W^BGP7DP("# w/ Physical Activity",0,1,BGPPTYPE)
- SET L=" Counseling"
- SET P=9
- DO PBY
- +26 IF BGPPTYPE="D"
- SET L="# w/ Physical Activity Counseling"
- SET P=9
- DO PBY
- +27 QUIT
- End DoDot:1
- +28 QUIT
- PBY ;
- +1 DO W^BGP7DP(L,0,1,BGPPTYPE)
- +2 SET T=30
- FOR X=1:1:2
- 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^BGP7DP(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^BGP7DP(BGPHD1,1,2,BGPPTYPE)
- +3 ;D W^BGP7DP("Asthma Assessments",0,1,BGPPTYPE)
- +4 DO W^BGP7DP(" 3 - 11",0,1,BGPPTYPE,2,34)
- +5 DO W^BGP7DP(" 12 - 17",0,0,BGPPTYPE,3,45)
- +6 ;D W^BGP7DP("18+",0,0,BGPPTYPE,4,56)
- +7 ;D W^BGP7DP("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