BGP8DP1L ; IHS/CMI/LAB - print ind 1 12 Nov 2010 7:38 AM ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
;HIV SCREENING AGE DIST
I1AGE ;EP special age tallies
Q:$G(BGPSUMON)
S BGPHD1="Active Clinical Pts 5+ w/Persistent Asthma",BGPHD2="Active Clinical Pts 5+ ",BGPHD3=" w/ Persistent Asthma"
K BGPDAC,BGPDAP,BGPDAB
S (BGPX,BGPDD)=0 F BGPXX=12:1:22 D I1AGE1
D I1AGEP
Q
I1AGE1 ;
;
I BGPXX=12 S BGPP1=2,BGPP2=3
I BGPXX=13 S BGPP1=4,BGPP2=5
I BGPXX=14 S BGPP1=6,BGPP2=7
I BGPXX=15 S BGPP1=8,BGPP2=9
I BGPXX=16 S BGPP1=10,BGPP2=11
I BGPXX=17 S BGPP1=12,BGPP2=13
I BGPXX=18 S BGPP1=14,BGPP2=15
I BGPXX=19 S BGPP1=16,BGPP2=17
I BGPXX=20 S BGPP1=18,BGPP2=19
I BGPXX=21 S BGPP1=20,BGPP2=21
I BGPXX=22 S BGPP1=22,BGPP2=23
S BGPZ="A",BGPX=1 D AGES
S BGPZ="B",BGPX=2 D AGES
S BGPZ="C",BGPX=3 D AGES
S BGPZ="D",BGPX=4 D AGES
Q
AGES ;
S BGPF="AA.A."_BGPXX_BGPZ S BGPPC=$O(^BGPINDRC("C",BGPF,0))
D
.S BGPDF=$P(^BGPINDRC(BGPPC,0),U,8)
.S BGPNP=$P(^DD(90560.03,BGPDF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)
.S $P(BGPDAC(BGPX),U)=$$V^BGP8DP1C(1,BGPRPT,N,P)
.S $P(BGPDAP(BGPX),U)=$$V^BGP8DP1C(2,BGPRPT,N,P)
.S $P(BGPDAB(BGPX),U)=$$V^BGP8DP1C(3,BGPRPT,N,P)
;S BGPCYD=$$V^BGP8DP1C(1,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP8DP1C(1,N,P)
;S BGPPRD=$$V^BGP8DP1C(2,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP8DP1C(2,N,P)
;S BGPBLD=$$V^BGP8DP1C(3,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP8DP1C(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(^BGPINDRC(BGPPC,0),U,9)
S BGPNP=$P(^DD(90560.03,BGPNF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)
S $P(BGPDAC(BGPX),U,BGPP1)=$$V^BGP8DP1C(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^BGP8DP1C(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^BGP8DP1C(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^BGP8DP1C(1,BGPRPT,N,P,2)
;S BGPPRN=$$V^BGP8DP1C(2,BGPRPT,N,P,2)
;S BGPBLN=$$V^BGP8DP1C(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:"")
Q
I1AGEP ;
S BGPYSTP=1
I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP8DPH Q:BGPQUIT D W^BGP8DP(^BGPINDR(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDR(BGPIC,53,2,0)) W^BGP8DP(^BGPINDR(BGPIC,53,2,0),0,1,BGPPTYPE) D AH
I BGPPTYPE'="P" D W^BGP8DP("",0,2,BGPPTYPE) D AH
D W^BGP8DP("CURRENT REPORT PERIOD",0,1,BGPPTYPE)
D W^BGP8DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
I BGPPTYPE="P" D W^BGP8DP(BGPHD3,0,1,BGPPTYPE)
S BGPARR="BGPDAC" D I1AGEP1
I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP8DPH Q:BGPQUIT D W^BGP8DP(^BGPINDR(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDR(BGPIC,53,2,0)) W^BGP8DP(^BGPINDR(BGPIC,53,2,0),0,1,BGPPTYPE) D AH
I BGPPTYPE'="P" D W^BGP8DP("",0,2,BGPPTYPE) D AH
D W^BGP8DP("PREVIOUS REPORT PERIOD",0,1,BGPPTYPE)
D W^BGP8DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
I BGPPTYPE="P" D W^BGP8DP(BGPHD3,0,1,BGPPTYPE)
S BGPARR="BGPDAP" D I1AGEP1
I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP8DPH Q:BGPQUIT D W^BGP8DP(^BGPINDR(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDR(BGPIC,53,2,0)) W^BGP8DP(^BGPINDR(BGPIC,53,2,0),0,1,BGPPTYPE) D AH
I BGPPTYPE'="P" D W^BGP8DP("",0,2,BGPPTYPE) D AH
D W^BGP8DP("BASELINE REPORT PERIOD",0,1,BGPPTYPE)
D W^BGP8DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
I BGPPTYPE="P" D W^BGP8DP(BGPHD3,0,1,BGPPTYPE)
S BGPARR="BGPDAB" D I1AGEP1
Q
I1AGEP1 ;
S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U) D W^BGP8DP($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^BGP8DP("# w/ Management Plan",0,2,BGPPTYPE)
S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,2) D W^BGP8DP($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^BGP8DP("% w/ Management Plan",0,1,BGPPTYPE)
S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,3) D W^BGP8DP($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^BGP8DP("# w/ Severity Documented",0,2,BGPPTYPE)
S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,4) D W^BGP8DP($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^BGP8DP("% w/ Severity Documented",0,1,BGPPTYPE)
S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,5) D W^BGP8DP($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^BGP8DP("% w/ Control Documented",0,2,BGPPTYPE)
S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,6) D W^BGP8DP($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^BGP8DP("% w/ Control Documented",0,1,BGPPTYPE)
S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,7) D W^BGP8DP($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^BGP8DP("# w/ Symptom Free Days Assessed",0,2,BGPPTYPE)
S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,8) D W^BGP8DP($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^BGP8DP("% w/ Symptom Free Days Assessed",0,1,BGPPTYPE)
S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,9) D W^BGP8DP($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^BGP8DP("# w/ Symptom Free Days 0-5",0,2,BGPPTYPE)
S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,10) D W^BGP8DP($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^BGP8DP("% w/ Symptom Free Days 0-5",0,1,BGPPTYPE)
S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,11) D W^BGP8DP($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^BGP8DP("# w/ Symptom Free Days 6-12",0,2,BGPPTYPE)
S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,12) D W^BGP8DP($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^BGP8DP("% w/ Symptom Free Days 6-12",0,1,BGPPTYPE)
S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,13) D W^BGP8DP($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^BGP8DP("# w/ Symptom Free Days 13-14",0,2,BGPPTYPE)
S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,14) D W^BGP8DP($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^BGP8DP("% w/ Symptom Free Days 13-14",0,1,BGPPTYPE)
S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,15) D W^BGP8DP($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^BGP8DP("# w/ School/Work Days Missed",0,2,BGPPTYPE)
I BGPPTYPE="P" D W^BGP8DP("# w/ School/Work Days",0,2,BGPPTYPE),W^BGP8DP(" Missed",0,1,BGPPTYPE)
S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,16) D W^BGP8DP($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^BGP8DP("% w/ School/Work Days Missed",0,1,BGPPTYPE)
I BGPPTYPE="P" D W^BGP8DP("% w/ School/Work Days",0,1,BGPPTYPE),W^BGP8DP(" Missed",0,1,BGPPTYPE)
S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,17) D W^BGP8DP($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^BGP8DP("# w/ School/Work Days Missed 0-2",0,2,BGPPTYPE)
I BGPPTYPE="P" D W^BGP8DP("# w/ School/Work Days",0,2,BGPPTYPE),W^BGP8DP(" Missed 0-2",0,1,BGPPTYPE)
S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,18) D W^BGP8DP($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^BGP8DP("% w/ School/Work Days Missed 0-2",0,1,BGPPTYPE)
I BGPPTYPE="P" D W^BGP8DP("% w/ School/Work Days",0,1,BGPPTYPE),W^BGP8DP(" Missed 0-2",0,1,BGPPTYPE)
S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,19) D W^BGP8DP($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^BGP8DP("# w/ School/Work Days Missed 3-7",0,2,BGPPTYPE)
I BGPPTYPE="P" D W^BGP8DP("# w/ School/Work Days",0,2,BGPPTYPE),W^BGP8DP(" Missed 3-7",0,1,BGPPTYPE)
S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,20) D W^BGP8DP($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^BGP8DP("% w/ School/Work Days Missed 3-7",0,1,BGPPTYPE)
I BGPPTYPE="P" D W^BGP8DP("% w/ School/Work Days",0,1,BGPPTYPE),W^BGP8DP(" Missed 3-7",0,1,BGPPTYPE)
S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,21) D W^BGP8DP($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^BGP8DP("# w/ School/Work Days Missed 8-14",0,2,BGPPTYPE)
I BGPPTYPE="P" D W^BGP8DP("# w/ School/Work Days",0,2,BGPPTYPE),W^BGP8DP(" Missed 8-14",0,1,BGPPTYPE)
S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,22) D W^BGP8DP($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^BGP8DP("% w/ School/Work Days Missed 8-14",0,1,BGPPTYPE)
I BGPPTYPE="P" D W^BGP8DP("% w/ School/Work Days",0,1,BGPPTYPE),W^BGP8DP(" Missed 8-14",0,1,BGPPTYPE)
S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,23) D W^BGP8DP($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^BGP8DP("CHANGE FROM "_$S(BGPARR="BGPDAP":"PREVIOUS YR %",1:"BASELINE YR %"),0,2,BGPPTYPE)
.S L="# w/ Management Plan",P=3 D PBY
.S L="# w/ Severity Documented",P=5 D PBY
.S L="# w/ Control Documented",P=7 D PBY
.I BGPPTYPE="P" D W^BGP8DP("# w/ Symptom Free Days",0,1,BGPPTYPE) S L=" Assessed",P=9 D PBY
.I BGPPTYPE="D" S L="# w/ Symptom Free Days",P=9 D PBY
.S L="# w/ Symptom Free Days 0-5",P=11 D PBY
.S L="# w/ Symptom Free Days 6-12",P=13 D PBY
.S L="# w/ Symptom Free Days 13-14",P=15 D PBY
.I BGPPTYPE="P" D W^BGP8DP("# w/School/Work Days",0,1,BGPPTYPE) S L=" Missed",P=17 D PBY
.I BGPPTYPE="D" S L="# w/School/Work Days Missed",P=17 D PBY
.I BGPPTYPE="P" D W^BGP8DP("# w/School/Work Days",0,1,BGPPTYPE) S L=" Missed 0-2",P=19 D PBY
.I BGPPTYPE="D" S L="# w/School/Work Days Missed 0-2",P=19 D PBY
.I BGPPTYPE="P" D W^BGP8DP("# w/School/Work Days",0,1,BGPPTYPE) S L=" Missed 3-7",P=21 D PBY
.I BGPPTYPE="D" S L="# w/School/Work Days Missed 3-7",P=21 D PBY
.I BGPPTYPE="P" D W^BGP8DP("# w/School/Work Days",0,1,BGPPTYPE) S L=" Missed 8-14",P=23 D PBY
.I BGPPTYPE="D" S L="# w/School/Work Days Missed 8-14",P=23 D PBY
.Q
Q
PBY ;
D W^BGP8DP(L,0,1,BGPPTYPE)
S T=30 F X=1:1:4 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^BGP8DP(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^BGP8DP(BGPHD1,1,2,BGPPTYPE)
;D W^BGP8DP("Asthma Assessments",0,1,BGPPTYPE)
D W^BGP8DP(" 5-14",0,1,BGPPTYPE,2,34)
D W^BGP8DP("15-34",0,0,BGPPTYPE,3,45)
D W^BGP8DP("35-64",0,0,BGPPTYPE,4,56)
D W^BGP8DP("65+",0,0,BGPPTYPE,5,67)
Q
SB(X) ;EP - Strip
X ^DD("FUNC",$O(^DD("FUNC","B","STRIPBLANKS",0)),1)
Q X
BGP8DP1L ; IHS/CMI/LAB - print ind 1 12 Nov 2010 7:38 AM ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
+3 ;HIV SCREENING AGE DIST
I1AGE ;EP special age tallies
+1 IF $GET(BGPSUMON)
QUIT
+2 SET BGPHD1="Active Clinical Pts 5+ w/Persistent Asthma"
SET BGPHD2="Active Clinical Pts 5+ "
SET BGPHD3=" w/ Persistent Asthma"
+3 KILL BGPDAC,BGPDAP,BGPDAB
+4 SET (BGPX,BGPDD)=0
FOR BGPXX=12:1:22
DO I1AGE1
+5 DO I1AGEP
+6 QUIT
I1AGE1 ;
+1 ;
+2 IF BGPXX=12
SET BGPP1=2
SET BGPP2=3
+3 IF BGPXX=13
SET BGPP1=4
SET BGPP2=5
+4 IF BGPXX=14
SET BGPP1=6
SET BGPP2=7
+5 IF BGPXX=15
SET BGPP1=8
SET BGPP2=9
+6 IF BGPXX=16
SET BGPP1=10
SET BGPP2=11
+7 IF BGPXX=17
SET BGPP1=12
SET BGPP2=13
+8 IF BGPXX=18
SET BGPP1=14
SET BGPP2=15
+9 IF BGPXX=19
SET BGPP1=16
SET BGPP2=17
+10 IF BGPXX=20
SET BGPP1=18
SET BGPP2=19
+11 IF BGPXX=21
SET BGPP1=20
SET BGPP2=21
+12 IF BGPXX=22
SET BGPP1=22
SET BGPP2=23
+13 SET BGPZ="A"
SET BGPX=1
DO AGES
+14 SET BGPZ="B"
SET BGPX=2
DO AGES
+15 SET BGPZ="C"
SET BGPX=3
DO AGES
+16 SET BGPZ="D"
SET BGPX=4
DO AGES
+17 QUIT
AGES ;
+1 SET BGPF="AA.A."_BGPXX_BGPZ
SET BGPPC=$ORDER(^BGPINDRC("C",BGPF,0))
+2 Begin DoDot:1
+3 SET BGPDF=$PIECE(^BGPINDRC(BGPPC,0),U,8)
+4 SET BGPNP=$PIECE(^DD(90560.03,BGPDF,0),U,4)
SET N=$PIECE(BGPNP,";")
SET P=$PIECE(BGPNP,";",2)
+5 SET $PIECE(BGPDAC(BGPX),U)=$$V^BGP8DP1C(1,BGPRPT,N,P)
+6 SET $PIECE(BGPDAP(BGPX),U)=$$V^BGP8DP1C(2,BGPRPT,N,P)
+7 SET $PIECE(BGPDAB(BGPX),U)=$$V^BGP8DP1C(3,BGPRPT,N,P)
End DoDot:1
+8 ;S BGPCYD=$$V^BGP8DP1C(1,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP8DP1C(1,N,P)
+9 ;S BGPPRD=$$V^BGP8DP1C(2,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP8DP1C(2,N,P)
+10 ;S BGPBLD=$$V^BGP8DP1C(3,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP8DP1C(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(^BGPINDRC(BGPPC,0),U,9)
+18 SET BGPNP=$PIECE(^DD(90560.03,BGPNF,0),U,4)
SET N=$PIECE(BGPNP,";")
SET P=$PIECE(BGPNP,";",2)
+19 SET $PIECE(BGPDAC(BGPX),U,BGPP1)=$$V^BGP8DP1C(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^BGP8DP1C(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^BGP8DP1C(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^BGP8DP1C(1,BGPRPT,N,P,2)
+23 ;S BGPPRN=$$V^BGP8DP1C(2,BGPRPT,N,P,2)
+24 ;S BGPBLN=$$V^BGP8DP1C(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 QUIT
I1AGEP ;
+1 SET BGPYSTP=1
+2 IF '$GET(BGPSUMON)
IF BGPPTYPE="P"
DO HEADER^BGP8DPH
IF BGPQUIT
QUIT
DO W^BGP8DP(^BGPINDR(BGPIC,53,1,0),0,1,BGPPTYPE)
IF $DATA(^BGPINDR(BGPIC,53,2,0))
DO W^BGP8DP(^BGPINDR(BGPIC,53,2,0),0,1,BGPPTYPE)
DO AH
+3 IF BGPPTYPE'="P"
DO W^BGP8DP("",0,2,BGPPTYPE)
DO AH
+4 DO W^BGP8DP("CURRENT REPORT PERIOD",0,1,BGPPTYPE)
+5 DO W^BGP8DP($SELECT(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
+6 IF BGPPTYPE="P"
DO W^BGP8DP(BGPHD3,0,1,BGPPTYPE)
+7 SET BGPARR="BGPDAC"
DO I1AGEP1
+8 IF '$GET(BGPSUMON)
IF BGPPTYPE="P"
DO HEADER^BGP8DPH
IF BGPQUIT
QUIT
DO W^BGP8DP(^BGPINDR(BGPIC,53,1,0),0,1,BGPPTYPE)
IF $DATA(^BGPINDR(BGPIC,53,2,0))
DO W^BGP8DP(^BGPINDR(BGPIC,53,2,0),0,1,BGPPTYPE)
DO AH
+9 IF BGPPTYPE'="P"
DO W^BGP8DP("",0,2,BGPPTYPE)
DO AH
+10 DO W^BGP8DP("PREVIOUS REPORT PERIOD",0,1,BGPPTYPE)
+11 DO W^BGP8DP($SELECT(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
+12 IF BGPPTYPE="P"
DO W^BGP8DP(BGPHD3,0,1,BGPPTYPE)
+13 SET BGPARR="BGPDAP"
DO I1AGEP1
+14 IF '$GET(BGPSUMON)
IF BGPPTYPE="P"
DO HEADER^BGP8DPH
IF BGPQUIT
QUIT
DO W^BGP8DP(^BGPINDR(BGPIC,53,1,0),0,1,BGPPTYPE)
IF $DATA(^BGPINDR(BGPIC,53,2,0))
DO W^BGP8DP(^BGPINDR(BGPIC,53,2,0),0,1,BGPPTYPE)
DO AH
+15 IF BGPPTYPE'="P"
DO W^BGP8DP("",0,2,BGPPTYPE)
DO AH
+16 DO W^BGP8DP("BASELINE REPORT PERIOD",0,1,BGPPTYPE)
+17 DO W^BGP8DP($SELECT(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
+18 IF BGPPTYPE="P"
DO W^BGP8DP(BGPHD3,0,1,BGPPTYPE)
+19 SET BGPARR="BGPDAB"
DO I1AGEP1
+20 QUIT
I1AGEP1 ;
+1 SET T=30
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U)
DO W^BGP8DP($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^BGP8DP("# w/ Management Plan",0,2,BGPPTYPE)
+3 SET T=31
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,2)
DO W^BGP8DP($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^BGP8DP("% w/ Management Plan",0,1,BGPPTYPE)
+5 SET T=30
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,3)
DO W^BGP8DP($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^BGP8DP("# w/ Severity Documented",0,2,BGPPTYPE)
+7 SET T=31
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,4)
DO W^BGP8DP($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^BGP8DP("% w/ Severity Documented",0,1,BGPPTYPE)
+9 SET T=30
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,5)
DO W^BGP8DP($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^BGP8DP("% w/ Control Documented",0,2,BGPPTYPE)
+11 SET T=31
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,6)
DO W^BGP8DP($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^BGP8DP("% w/ Control Documented",0,1,BGPPTYPE)
+13 SET T=30
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,7)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+14 DO W^BGP8DP("# w/ Symptom Free Days Assessed",0,2,BGPPTYPE)
+15 SET T=31
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,8)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+16 DO W^BGP8DP("% w/ Symptom Free Days Assessed",0,1,BGPPTYPE)
+17 SET T=30
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,9)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+18 DO W^BGP8DP("# w/ Symptom Free Days 0-5",0,2,BGPPTYPE)
+19 SET T=31
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,10)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+20 DO W^BGP8DP("% w/ Symptom Free Days 0-5",0,1,BGPPTYPE)
+21 SET T=30
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,11)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+22 DO W^BGP8DP("# w/ Symptom Free Days 6-12",0,2,BGPPTYPE)
+23 SET T=31
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,12)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+24 DO W^BGP8DP("% w/ Symptom Free Days 6-12",0,1,BGPPTYPE)
+25 SET T=30
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,13)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+26 DO W^BGP8DP("# w/ Symptom Free Days 13-14",0,2,BGPPTYPE)
+27 SET T=31
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,14)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+28 DO W^BGP8DP("% w/ Symptom Free Days 13-14",0,1,BGPPTYPE)
+29 SET T=30
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,15)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+30 IF BGPPTYPE="D"
DO W^BGP8DP("# w/ School/Work Days Missed",0,2,BGPPTYPE)
+31 IF BGPPTYPE="P"
DO W^BGP8DP("# w/ School/Work Days",0,2,BGPPTYPE)
DO W^BGP8DP(" Missed",0,1,BGPPTYPE)
+32 SET T=31
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,16)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+33 IF BGPPTYPE="D"
DO W^BGP8DP("% w/ School/Work Days Missed",0,1,BGPPTYPE)
+34 IF BGPPTYPE="P"
DO W^BGP8DP("% w/ School/Work Days",0,1,BGPPTYPE)
DO W^BGP8DP(" Missed",0,1,BGPPTYPE)
+35 SET T=30
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,17)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+36 IF BGPPTYPE="D"
DO W^BGP8DP("# w/ School/Work Days Missed 0-2",0,2,BGPPTYPE)
+37 IF BGPPTYPE="P"
DO W^BGP8DP("# w/ School/Work Days",0,2,BGPPTYPE)
DO W^BGP8DP(" Missed 0-2",0,1,BGPPTYPE)
+38 SET T=31
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,18)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+39 IF BGPPTYPE="D"
DO W^BGP8DP("% w/ School/Work Days Missed 0-2",0,1,BGPPTYPE)
+40 IF BGPPTYPE="P"
DO W^BGP8DP("% w/ School/Work Days",0,1,BGPPTYPE)
DO W^BGP8DP(" Missed 0-2",0,1,BGPPTYPE)
+41 SET T=30
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,19)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+42 IF BGPPTYPE="D"
DO W^BGP8DP("# w/ School/Work Days Missed 3-7",0,2,BGPPTYPE)
+43 IF BGPPTYPE="P"
DO W^BGP8DP("# w/ School/Work Days",0,2,BGPPTYPE)
DO W^BGP8DP(" Missed 3-7",0,1,BGPPTYPE)
+44 SET T=31
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,20)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+45 IF BGPPTYPE="D"
DO W^BGP8DP("% w/ School/Work Days Missed 3-7",0,1,BGPPTYPE)
+46 IF BGPPTYPE="P"
DO W^BGP8DP("% w/ School/Work Days",0,1,BGPPTYPE)
DO W^BGP8DP(" Missed 3-7",0,1,BGPPTYPE)
+47 SET T=30
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,21)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+48 IF BGPPTYPE="D"
DO W^BGP8DP("# w/ School/Work Days Missed 8-14",0,2,BGPPTYPE)
+49 IF BGPPTYPE="P"
DO W^BGP8DP("# w/ School/Work Days",0,2,BGPPTYPE)
DO W^BGP8DP(" Missed 8-14",0,1,BGPPTYPE)
+50 SET T=31
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,22)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$$C(V,0,6),1:$SELECT(V:V,1:0)),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+51 IF BGPPTYPE="D"
DO W^BGP8DP("% w/ School/Work Days Missed 8-14",0,1,BGPPTYPE)
+52 IF BGPPTYPE="P"
DO W^BGP8DP("% w/ School/Work Days",0,1,BGPPTYPE)
DO W^BGP8DP(" Missed 8-14",0,1,BGPPTYPE)
+53 SET T=30
FOR X=1:1:4
SET V=$PIECE(@BGPARR@(X),U,23)
DO W^BGP8DP($SELECT(BGPPTYPE="P":$JUSTIFY(V,6,1),1:$$SB($JUSTIFY(V,6,1))),0,0,BGPPTYPE,X+1,T)
SET T=T+11
+54 IF BGPARR="BGPDAP"!(BGPARR="BGPDAB")
Begin DoDot:1
+55 DO W^BGP8DP("CHANGE FROM "_$SELECT(BGPARR="BGPDAP":"PREVIOUS YR %",1:"BASELINE YR %"),0,2,BGPPTYPE)
+56 SET L="# w/ Management Plan"
SET P=3
DO PBY
+57 SET L="# w/ Severity Documented"
SET P=5
DO PBY
+58 SET L="# w/ Control Documented"
SET P=7
DO PBY
+59 IF BGPPTYPE="P"
DO W^BGP8DP("# w/ Symptom Free Days",0,1,BGPPTYPE)
SET L=" Assessed"
SET P=9
DO PBY
+60 IF BGPPTYPE="D"
SET L="# w/ Symptom Free Days"
SET P=9
DO PBY
+61 SET L="# w/ Symptom Free Days 0-5"
SET P=11
DO PBY
+62 SET L="# w/ Symptom Free Days 6-12"
SET P=13
DO PBY
+63 SET L="# w/ Symptom Free Days 13-14"
SET P=15
DO PBY
+64 IF BGPPTYPE="P"
DO W^BGP8DP("# w/School/Work Days",0,1,BGPPTYPE)
SET L=" Missed"
SET P=17
DO PBY
+65 IF BGPPTYPE="D"
SET L="# w/School/Work Days Missed"
SET P=17
DO PBY
+66 IF BGPPTYPE="P"
DO W^BGP8DP("# w/School/Work Days",0,1,BGPPTYPE)
SET L=" Missed 0-2"
SET P=19
DO PBY
+67 IF BGPPTYPE="D"
SET L="# w/School/Work Days Missed 0-2"
SET P=19
DO PBY
+68 IF BGPPTYPE="P"
DO W^BGP8DP("# w/School/Work Days",0,1,BGPPTYPE)
SET L=" Missed 3-7"
SET P=21
DO PBY
+69 IF BGPPTYPE="D"
SET L="# w/School/Work Days Missed 3-7"
SET P=21
DO PBY
+70 IF BGPPTYPE="P"
DO W^BGP8DP("# w/School/Work Days",0,1,BGPPTYPE)
SET L=" Missed 8-14"
SET P=23
DO PBY
+71 IF BGPPTYPE="D"
SET L="# w/School/Work Days Missed 8-14"
SET P=23
DO PBY
+72 QUIT
End DoDot:1
+73 QUIT
PBY ;
+1 DO W^BGP8DP(L,0,1,BGPPTYPE)
+2 SET T=30
FOR X=1:1:4
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^BGP8DP(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^BGP8DP(BGPHD1,1,2,BGPPTYPE)
+3 ;D W^BGP8DP("Asthma Assessments",0,1,BGPPTYPE)
+4 DO W^BGP8DP(" 5-14",0,1,BGPPTYPE,2,34)
+5 DO W^BGP8DP("15-34",0,0,BGPPTYPE,3,45)
+6 DO W^BGP8DP("35-64",0,0,BGPPTYPE,4,56)
+7 DO W^BGP8DP("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
