- BGP7DP1N ; IHS/CMI/LAB - print ind 1 12 Nov 2010 7:38 AM ;
- ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- ;
- ;mta age dist x 2
- I1AGE ;EP special age tallies
- Q:$G(BGPSUMON)
- Q:BGPRTYPE'=4
- I BGPINDG'="S",BGPINDG'="A" Q
- S BGPHD1="Active Clinical Pts 5+ w/Persistent Asthma and LABA Rx",BGPHD2="Active Clinical Pts 5+ w/ Persistent",BGPHD3=" Asthma and LABA Rx"
- K BGPDAC,BGPDAP,BGPDAB
- S (BGPX,BGPDD)=0 F BGPXX=2 D I1AGE1
- D I1AGEP
- Q
- I1AGE1 ;
- ;
- I BGPXX=2 S BGPP1=2,BGPP2=3
- 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="MTA.C."_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)
- ;set 2nd piece to numerator and 3rd to %
- S J=$P(BGPF,".",3)
- S Q=1
- 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:"")
- 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
- 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
- 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:4 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
- I BGPPTYPE="D" D W^BGP7DP("# w/o 2+ Inhaled Steroid Rx",0,2,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP7DP("# w/o 2+ Inhaled",0,2,BGPPTYPE),W^BGP7DP(" Steroid Rx",0,1,BGPPTYPE)
- S T=31 F X=1:1:4 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
- I BGPPTYPE="D" D W^BGP7DP("% w/o 2+ Inhaled Steroid Rx",0,1,BGPPTYPE)
- I BGPPTYPE="P" D W^BGP7DP("% w/o 2+ Inhaled",0,1,BGPPTYPE),W^BGP7DP(" Steroid Rx",0,1,BGPPTYPE)
- S T=30 F X=1:1:4 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
- I BGPARR="BGPDAP"!(BGPARR="BGPDAB") D
- .D W^BGP7DP("CHANGE FROM "_$S(BGPARR="BGPDAP":"PREVIOUS YR %",1:"BASELINE YR %"),0,2,BGPPTYPE)
- .I BGPPTYPE="P" D W^BGP7DP("# w/o 2+ Inhaled",0,1,BGPPTYPE) S L=" Steroid Rx",P=3 D PBY
- .I BGPPTYPE="D" S L="# w/o 2+ Inhaled Steroid Rx",P=3 D PBY
- Q
- PBY ;
- D W^BGP7DP(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^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(" 5-14",0,1,BGPPTYPE,2,34)
- D W^BGP7DP("15-34",0,0,BGPPTYPE,3,45)
- D W^BGP7DP("35-64",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
- BGP7DP1N ; 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 ;mta age dist x 2
- I1AGE ;EP special age tallies
- +1 IF $GET(BGPSUMON)
- QUIT
- +2 IF BGPRTYPE'=4
- QUIT
- +3 IF BGPINDG'="S"
- IF BGPINDG'="A"
- QUIT
- +4 SET BGPHD1="Active Clinical Pts 5+ w/Persistent Asthma and LABA Rx"
- SET BGPHD2="Active Clinical Pts 5+ w/ Persistent"
- SET BGPHD3=" Asthma and LABA Rx"
- +5 KILL BGPDAC,BGPDAP,BGPDAB
- +6 SET (BGPX,BGPDD)=0
- FOR BGPXX=2
- DO I1AGE1
- +7 DO I1AGEP
- +8 QUIT
- I1AGE1 ;
- +1 ;
- +2 IF BGPXX=2
- SET BGPP1=2
- SET BGPP2=3
- +3 SET BGPZ="A"
- SET BGPX=1
- DO AGES
- +4 SET BGPZ="B"
- SET BGPX=2
- DO AGES
- +5 SET BGPZ="C"
- SET BGPX=3
- DO AGES
- +6 SET BGPZ="D"
- SET BGPX=4
- DO AGES
- +7 QUIT
- AGES ;
- +1 SET BGPF="MTA.C."_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 2nd piece to numerator and 3rd to %
- +9 SET J=$PIECE(BGPF,".",3)
- +10 SET Q=1
- +11 SET BGPNF=$PIECE(^BGPINDGC(BGPPC,0),U,9)
- +12 SET BGPNP=$PIECE(^DD(90558.03,BGPNF,0),U,4)
- SET N=$PIECE(BGPNP,";")
- SET P=$PIECE(BGPNP,";",2)
- +13 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:"")
- +14 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:"")
- +15 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:"")
- +16 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 IF BGPPTYPE="P"
- DO 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 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 IF BGPPTYPE="P"
- DO W^BGP7DP(BGPHD3,0,1,BGPPTYPE)
- +13 SET BGPARR="BGPDAP"
- DO I1AGEP1
- +14 ;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
- +15 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 IF BGPPTYPE="P"
- DO W^BGP7DP(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^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 IF BGPPTYPE="D"
- DO W^BGP7DP("# w/o 2+ Inhaled Steroid Rx",0,2,BGPPTYPE)
- +3 IF BGPPTYPE="P"
- DO W^BGP7DP("# w/o 2+ Inhaled",0,2,BGPPTYPE)
- DO W^BGP7DP(" Steroid Rx",0,1,BGPPTYPE)
- +4 SET T=31
- FOR X=1:1:4
- 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
- +5 IF BGPPTYPE="D"
- DO W^BGP7DP("% w/o 2+ Inhaled Steroid Rx",0,1,BGPPTYPE)
- +6 IF BGPPTYPE="P"
- DO W^BGP7DP("% w/o 2+ Inhaled",0,1,BGPPTYPE)
- DO W^BGP7DP(" Steroid Rx",0,1,BGPPTYPE)
- +7 SET T=30
- FOR X=1:1:4
- 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
- +8 IF BGPARR="BGPDAP"!(BGPARR="BGPDAB")
- Begin DoDot:1
- +9 DO W^BGP7DP("CHANGE FROM "_$SELECT(BGPARR="BGPDAP":"PREVIOUS YR %",1:"BASELINE YR %"),0,2,BGPPTYPE)
- +10 IF BGPPTYPE="P"
- DO W^BGP7DP("# w/o 2+ Inhaled",0,1,BGPPTYPE)
- SET L=" Steroid Rx"
- SET P=3
- DO PBY
- +11 IF BGPPTYPE="D"
- SET L="# w/o 2+ Inhaled Steroid Rx"
- SET P=3
- DO PBY
- End DoDot:1
- +12 QUIT
- PBY ;
- +1 DO W^BGP7DP(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^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 DO W^BGP7DP(" 5-14",0,1,BGPPTYPE,2,34)
- +4 DO W^BGP7DP("15-34",0,0,BGPPTYPE,3,45)
- +5 DO W^BGP7DP("35-64",0,0,BGPPTYPE,4,56)
- +6 DO W^BGP7DP("65+",0,0,BGPPTYPE,5,67)
- +7 QUIT
- SB(X) ;EP - Strip
- +1 XECUTE ^DD("FUNC",$ORDER(^DD("FUNC","B","STRIPBLANKS",0)),1)
- +2 QUIT X
