BGP4DSP ; IHS/CMI/LAB - IHS summary page 16 Nov 2010 7:12 AM ;
;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
;
START ;
I BGPRTYPE'=1 Q
I $G(BGPNPL) Q ;not on gpra pat list
I $G(BGPCPPL) Q ;not on comp list
S BGPQUIT=""
D HEADER
NEW P8,P4,P7,P12
S P8=$S('$G(BGPNGR09):8,1:8) ;CHANGE 1:8 TO 1:13
S P4=$S('$G(BGPNGR09):4,1:4) ;CHANGE 1:4 TO 1:14
S P7=$S('$G(BGPNGR09):7,1:7) ;CHANGE 1:7 TO 1:15
S P12=$S('$G(BGPNGR09):12,1:12) ;CHANGE 1:12 TO 1:16
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
.I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
.S BGPC1=$O(^BGPSCAT("C",BGPC,0))
.D W^BGP4DP("",0,1,BGPPTYPE)
.D W^BGP4DP($P(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE) ;W !,$P(^BGPSCAT(BGPC1,0),U)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARY",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
..S BGPPC=$O(^TMP($J,"SUMMARY",BGPC,BGPO,0))
..Q:$P($G(^BGPINDJC(BGPPC,22)),U,13) ;part measure displays last
..I BGPPTYPE="P" D
...I $Y>(BGPIOSL-4) D HEADER Q:BGPQUIT
...I $P(^BGPINDJC(BGPPC,0),U,4)["014.A"!($P(^BGPINDJC(BGPPC,0),U,4)["023.")!($P(^BGPINDJC(BGPPC,0),U,4)="016.A.1")!($P(^BGPINDJC(BGPPC,0),U,4)="016.A.5")!($P($G(^BGPINDJC(BGPPC,19)),U,13)) D I 1
....D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P4),0,1,BGPPTYPE)
....I $P(^BGPINDJC(BGPPC,14),U,P7)]"" D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P7),0,1,BGPPTYPE)
....I $P(^BGPINDJC(BGPPC,14),U,P12)]"" D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P12),0,1,BGPPTYPE)
....D W^BGP4DP($J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U),7,0),0,0,BGPPTYPE,2,26)
....D W^BGP4DP($J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,0),0,0,BGPPTYPE,3,34)
....D W^BGP4DP($J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,0),0,0,BGPPTYPE,4,41)
....D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P8),0,0,BGPPTYPE,5,53)
....D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,2),0,0,BGPPTYPE,6,64)
....D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,3),0,0,BGPPTYPE,7,73)
...E D
....D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P4),0,1,BGPPTYPE,1)
....I $P(^BGPINDJC(BGPPC,14),U,P7)]"" D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P7),0,1,BGPPTYPE) ;W !,$P(^BGPINDJC(BGPPC,14),U,P7)
....I $P(^BGPINDJC(BGPPC,14),U,P12)]"" D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P12),0,1,BGPPTYPE) ;W !,$P(^BGPINDJC(BGPPC,14),U,P12)
....D W^BGP4DP($J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U),7,1)_"%",0,0,BGPPTYPE,2,26)
....D W^BGP4DP($J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,1)_"%",0,0,BGPPTYPE,3,34)
....D W^BGP4DP($J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,1)_"%",0,0,BGPPTYPE,4,41)
....D W^BGP4DP($TR($P(^BGPINDJC(BGPPC,14),U,P8),"$","^"),0,0,BGPPTYPE,5,53)
....D W^BGP4DP($TR($P(^BGPINDJC(BGPPC,14),U,2),"$","^"),0,0,BGPPTYPE,6,64)
....D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,3),0,0,BGPPTYPE,7,73)
....I $P(^BGPINDJC(BGPPC,14),U,9)]""!($P(^BGPINDJC(BGPPC,14),U,10)]"")!($P(^BGPINDJC(BGPPC,14),U,11)]"") D
.....D W^BGP4DP($TR($P(^BGPINDJC(BGPPC,14),U,9),"$","^"),0,1,BGPPTYPE,5,53),W^BGP4DP($TR($P(^BGPINDJC(BGPPC,14),U,10),"$","^"),0,0,BGPPTYPE,6,64),W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,11),0,0,7,73)
..I BGPPTYPE="D" D
...S X=""
...I $P(^BGPINDJC(BGPPC,0),U,4)["014.A"!($P(^BGPINDJC(BGPPC,0),U,4)["023.")!($P(^BGPINDJC(BGPPC,0),U,4)="016.A.1")!($P(^BGPINDJC(BGPPC,0),U,4)="016.A.5")!($P($G(^BGPINDJC(BGPPC,19)),U,13)) D I 1
....S X=$P(^BGPINDJC(BGPPC,14),U,P4)
....I $P(^BGPINDJC(BGPPC,14),U,P7)]"" D W^BGP4DP(X,0,1,BGPPTYPE) S X=$P(^BGPINDJC(BGPPC,14),U,P7)
....I $P(^BGPINDJC(BGPPC,14),U,P12)]"" D W^BGP4DP(X,0,1,BGPPTYPE) S X=$P(^BGPINDJC(BGPPC,14),U,P12)
....S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)
....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)
....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)
....S $P(X,U,5)=$P(^BGPINDJC(BGPPC,14),U,P8)
....S $P(X,U,6)=$P(^BGPINDJC(BGPPC,14),U,2),$P(X,U,7)=$P(^BGPINDJC(BGPPC,14),U,3)
....D W^BGP4DP(X,0,1,BGPPTYPE)
...E D
....S X=$P(^BGPINDJC(BGPPC,14),U,P4)
....I $P(^BGPINDJC(BGPPC,14),U,P7)]"" D W^BGP4DP(X,0,1,BGPPTYPE) S X=$P(^BGPINDJC(BGPPC,14),U,P7)
....I $P(^BGPINDJC(BGPPC,14),U,P12)]"" D W^BGP4DP(X,0,1,BGPPTYPE) S X=$P(^BGPINDJC(BGPPC,14),U,P12)
....S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)_"%"
....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)_"%"
....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)_"%"
....S $P(X,U,5)=$TR($P(^BGPINDJC(BGPPC,14),U,P8),"$","^")
....S $P(X,U,6)=$TR($P(^BGPINDJC(BGPPC,14),U,2),"$","^"),$P(X,U,7)=$P(^BGPINDJC(BGPPC,14),U,3)
....D W^BGP4DP(X,0,1,BGPPTYPE)
....S X="" I $P(^BGPINDJC(BGPPC,14),U,9)]""!($P(^BGPINDJC(BGPPC,14),U,10)]"")!($P(^BGPINDJC(BGPPC,14),U,11)]"") S $P(X,U,5)=$TR($P(^BGPINDJC(BGPPC,14),U,9),"$","^"),$P(X,U,6)=$TR($P(^BGPINDJC(BGPPC,14),U,10),"$","^") D
.....S $P(X,U,7)=$P(^BGPINDJC(BGPPC,14),U,11)
.....I X]"" D W^BGP4DP(X,0,1,BGPPTYPE)
I BGPPTYPE="P" I $Y>(BGPIOSL-9) D HEADER Q:BGPQUIT
;I $G(BGPNGR09) D FOOTER10 Q
;D W^BGP4DP("* GPRA 2014 targets represented here are preliminary targets since",0,1,BGPPTYPE)
;D W^BGP4DP("IHS is awaiting notification of final targets.",0,1,BGPPTYPE)
D W^BGP4DP(" * Measure definition changed in 2013.",0,2,BGPPTYPE)
D W^BGP4DP("** Measure definition changed in 2014.",0,1,BGPPTYPE)
;D W^BGP4DP(" + Site Previous and Site Baseline values are not applicable for this measure.",0,1,BGPPTYPE)
D W^BGP4DP("",0,1,BGPPTYPE)
;D PART
Q
W !," * GPRA 2014 targets represented here are preliminary targets since they will"
W !,"be adjusted for FY 2014 actual results and FY 2014 appropriations."
W !," * Measure definition changed in 2007."
W !,"*** Not official GPRA measure but included to show percentage of refusals with",!,"respect to GPRA measure."
;W !," + Site Previous and Site Baseline values are not applicable for this measure."
W !
Q
;
D HEADER^BGP4DPH
D H1
Q
H1 ;
S X="OFFICIAL GPRA/GPRAMA MEASURES CLINICAL PERFORMANCE SUMMARY" D W^BGP4DP(X,1,1,BGPPTYPE)
I $G(BGPAREAA) D W^BGP4DP("Area",0,1,BGPPTYPE,2,27),W^BGP4DP("Area",0,0,BGPPTYPE,3,35) D
.D W^BGP4DP("Area",0,0,BGPPTYPE,4,44),W^BGP4DP($S('$G(BGPNGR09):"GPRA",1:"GPRA"),0,0,BGPPTYPE,5,53),W^BGP4DP("Nat'l",0,0,BGPPTYPE,6,64),W^BGP4DP("2020",0,0,BGPPTYPE,7,73) ;CHANGE 1:"GPRA" TO 1:"GPRA"
I '$G(BGPAREAA) D W^BGP4DP("Site",0,1,BGPPTYPE,2,27),W^BGP4DP("Site",0,0,BGPPTYPE,3,35) D
.D W^BGP4DP("Site",0,0,BGPPTYPE,4,44),W^BGP4DP($S('$G(BGPNGR09):"GPRA",1:"GPRA"),0,0,BGPPTYPE,5,53),W^BGP4DP("Nat'l",0,0,BGPPTYPE,6,64),W^BGP4DP("2020",0,0,BGPPTYPE,7,73) ;CHANGE 1:"GPRA" TO 1:"GPRA"
D W^BGP4DP("Current",0,1,BGPPTYPE,2,26),W^BGP4DP("Previous",0,0,BGPPTYPE,3,34) D
.D W^BGP4DP("Baseline",0,0,BGPPTYPE,4,43),W^BGP4DP("Target"_$S($G(BGPNGR09):"",1:""),0,0,BGPPTYPE,5,53),W^BGP4DP("2013",0,0,BGPPTYPE,6,64),W^BGP4DP("Target",0,0,BGPPTYPE,7,73) ;CHANGE 09 TO "*" IF NEEDED
D W^BGP4DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
PART ;
D HEADERP
S P1=$S($G(BGPNGR09):8,1:8) ;CHANGE 1:14 TO 1:8
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
.I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADERP Q:BGPQUIT
.S BGPC1=$O(^BGPSCAT("C",BGPC,0))
.;W !
.;W !,$P(^BGPSCAT(BGPC1,0),U)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARY",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
..S BGPPC=$O(^TMP($J,"SUMMARY",BGPC,BGPO,0))
..Q:'$P($G(^BGPINDJC(BGPPC,22)),U,13) ;part measures only
..I BGPPTYPE="P" D
...I BGPPTYPE,$Y>(BGPIOSL-4) D HEADERP Q:BGPQUIT
...I $P(^BGPINDJC(BGPPC,0),U,4)["014.A"!($P(^BGPINDJC(BGPPC,0),U,4)["023.")!($P(^BGPINDJC(BGPPC,0),U,4)="016.A.1")!($P(^BGPINDJC(BGPPC,0),U,4)="016.A.5")!($P($G(^BGPINDJC(BGPPC,19)),U,13)) D I 1
....D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P4),0,1,BGPPTYPE)
....I $P(^BGPINDJC(BGPPC,14),U,P7)]"" D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P7),0,1,BGPPTYPE)
....I $P(^BGPINDJC(BGPPC,14),U,P12)]"" D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P12),0,1,BGPPTYPE)
....D W^BGP4DP($J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U),7,0),0,0,BGPPTYPE,2,26)
....D W^BGP4DP($J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,0),0,0,BGPPTYPE,3,34)
....D W^BGP4DP($J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,0),0,0,BGPPTYPE,4,44)
....D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P8),0,0,BGPPTYPE,5,53)
....D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,2),0,0,BGPPTYPE,6,64)
....D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,3),0,0,BGPPTYPE,7,73)
...E D
....D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P4),0,1,BGPPTYPE,1)
....I $P(^BGPINDJC(BGPPC,14),U,P7)]"" D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P7),0,1,BGPPTYPE) ;W !,$P(^BGPINDJC(BGPPC,14),U,P7)
....I $P(^BGPINDJC(BGPPC,14),U,P12)]"" D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,P12),0,1,BGPPTYPE) ;W !,$P(^BGPINDJC(BGPPC,14),U,P12)
....D W^BGP4DP($J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U),7,1)_"%",0,0,BGPPTYPE,2,26)
....D W^BGP4DP($J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,1)_"%",0,0,BGPPTYPE,3,34)
....D W^BGP4DP($J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,1)_"%",0,0,BGPPTYPE,4,44)
....D W^BGP4DP($TR($P(^BGPINDJC(BGPPC,14),U,P8),"$","^"),0,0,BGPPTYPE,5,53)
....D W^BGP4DP($TR($P(^BGPINDJC(BGPPC,14),U,2),"$","^"),0,0,BGPPTYPE,6,64)
....D W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,3),0,0,BGPPTYPE,7,73)
....I $P(^BGPINDJC(BGPPC,14),U,9)]""!($P(^BGPINDJC(BGPPC,14),U,10)]"")!($P(^BGPINDJC(BGPPC,14),U,11)]"") D
.....D W^BGP4DP($TR($P(^BGPINDJC(BGPPC,14),U,9),"$","^"),0,1,BGPPTYPE,5,53),W^BGP4DP($TR($P(^BGPINDJC(BGPPC,14),U,10),"$","^"),0,0,BGPPTYPE,6,64),W^BGP4DP($P(^BGPINDJC(BGPPC,14),U,11),0,0,7,73)
..I BGPPTYPE="D" D
...S X=""
...I $P(^BGPINDJC(BGPPC,0),U,4)["014.A"!($P(^BGPINDJC(BGPPC,0),U,4)["023.")!($P(^BGPINDJC(BGPPC,0),U,4)="016.A.1")!($P(^BGPINDJC(BGPPC,0),U,4)="016.A.5")!($P($G(^BGPINDJC(BGPPC,19)),U,13)) D I 1
....S X=$P(^BGPINDJC(BGPPC,14),U,P4)
....I $P(^BGPINDJC(BGPPC,14),U,P7)]"" D W^BGP4DP(X,0,1,BGPPTYPE) S X=$P(^BGPINDJC(BGPPC,14),U,P7)
....I $P(^BGPINDJC(BGPPC,14),U,P12)]"" D W^BGP4DP(X,0,1,BGPPTYPE) S X=$P(^BGPINDJC(BGPPC,14),U,P12)
....S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)
....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)
....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)
....S $P(X,U,5)=$P(^BGPINDJC(BGPPC,14),U,P8)
....S $P(X,U,6)=$P(^BGPINDJC(BGPPC,14),U,2),$P(X,U,7)=$P(^BGPINDJC(BGPPC,14),U,3)
....D W^BGP4DP(X,0,1,BGPPTYPE)
...E D
....S X=$P(^BGPINDJC(BGPPC,14),U,P4)
....I $P(^BGPINDJC(BGPPC,14),U,P7)]"" D W^BGP4DP(X,0,1,BGPPTYPE) S X=$P(^BGPINDJC(BGPPC,14),U,P7)
....I $P(^BGPINDJC(BGPPC,14),U,P12)]"" D W^BGP4DP(X,0,1,BGPPTYPE) S X=$P(^BGPINDJC(BGPPC,14),U,P12)
....S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)_"%"
....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)_"%"
....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)_"%"
....S $P(X,U,5)=$TR($P(^BGPINDJC(BGPPC,14),U,P8),"$","^")
....S $P(X,U,6)=$TR($P(^BGPINDJC(BGPPC,14),U,2),"$","^"),$P(X,U,7)=$P(^BGPINDJC(BGPPC,14),U,3)
....D W^BGP4DP(X,0,1,BGPPTYPE)
....S X="" I $P(^BGPINDJC(BGPPC,14),U,9)]""!($P(^BGPINDJC(BGPPC,14),U,10)]"")!($P(^BGPINDJC(BGPPC,14),U,11)]"") S $P(X,U,5)=$TR($P(^BGPINDJC(BGPPC,14),U,9),"$","^"),$P(X,U,6)=$TR($P(^BGPINDJC(BGPPC,14),U,10),"$","^") D
.....S $P(X,U,7)=$P(^BGPINDJC(BGPPC,14),U,11)
.....I X]"" D W^BGP4DP(X,0,1,BGPPTYPE)
I BGPPTYPE="P",$Y>(BGPIOSL-9) D HEADERP Q:BGPQUIT
D W^BGP4DP("",0,1,BGPPTYPE)
;I $G(BGPNGR09) D
;.D W^BGP4DP(" * PART 2014 target represented here is a preliminary target since it will be",0,1,BGPPTYPE)
;.D W^BGP4DP("adjusted for FY 2014 actual results and FY 2014 appropriations.",0,1,BGPPTYPE)
D W^BGP4DP($S($G(BGPNGR09):"*",1:"*")_" Federally Administered Activities measure. National 2013 rate is for federal",0,1,BGPPTYPE) ;CHANGE NGR09 TO "**"
D W^BGP4DP("sites only.",0,1,BGPPTYPE)
D W^BGP4DP("",0,1,BGPPTYPE)
Q
;
D HEADER^BGP4DPH
D H1P
Q
H1P ;
S X="OFFICIAL GPRA/GPRAMA MEASURES CLINICAL PERFORMANCE SUMMARY" D W^BGP4DP(X,1,1,BGPPTYPE)
I $G(BGPAREAA) D W^BGP4DP("Area",0,1,BGPPTYPE,2,27),W^BGP4DP("Area",0,0,BGPPTYPE,3,35) D
.D W^BGP4DP("Area",0,0,BGPPTYPE,4,44),W^BGP4DP($S('$G(BGPNGR09):"PART",1:"PART"),0,0,BGPPTYPE,5,53),W^BGP4DP("Nat'l",0,0,BGPPTYPE,6,63),W^BGP4DP("2020",0,0,BGPPTYPE,7,73)
I '$G(BGPAREAA) D W^BGP4DP("Site",0,1,BGPPTYPE,2,27),W^BGP4DP("Site",0,0,BGPPTYPE,3,35) D
.D W^BGP4DP("Site",0,0,BGPPTYPE,4,44),W^BGP4DP($S('$G(BGPNGR09):"PART",1:"PART"),0,0,BGPPTYPE,5,53),W^BGP4DP("Nat'l",0,0,BGPPTYPE,6,63),W^BGP4DP("2020",0,0,BGPPTYPE,7,73)
D W^BGP4DP("Current",0,1,BGPPTYPE,2,26),W^BGP4DP("Previous",0,0,BGPPTYPE,3,34) D
.D W^BGP4DP("Baseline",0,0,BGPPTYPE,4,43),W^BGP4DP("Target"_$S($G(BGPNGR09):"",1:""),0,0,BGPPTYPE,5,53),W^BGP4DP("2013",0,0,BGPPTYPE,6,63),W^BGP4DP("Target",0,0,BGPPTYPE,7,73)
D W^BGP4DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
D W^BGP4DP("PART MEASURE",0,2,BGPPTYPE)
D W^BGP4DP("------------",0,1,BGPPTYPE)
D W^BGP4DP("",0,1,BGPPTYPE)
Q
BGP4DSP ; IHS/CMI/LAB - IHS summary page 16 Nov 2010 7:12 AM ;
+1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
+2 ;
START ;
+1 IF BGPRTYPE'=1
QUIT
+2 ;not on gpra pat list
IF $GET(BGPNPL)
QUIT
+3 ;not on comp list
IF $GET(BGPCPPL)
QUIT
+4 SET BGPQUIT=""
+5 DO HEADER
+6 NEW P8,P4,P7,P12
+7 ;CHANGE 1:8 TO 1:13
SET P8=$SELECT('$GET(BGPNGR09):8,1:8)
+8 ;CHANGE 1:4 TO 1:14
SET P4=$SELECT('$GET(BGPNGR09):4,1:4)
+9 ;CHANGE 1:7 TO 1:15
SET P7=$SELECT('$GET(BGPNGR09):7,1:7)
+10 ;CHANGE 1:12 TO 1:16
SET P12=$SELECT('$GET(BGPNGR09):12,1:12)
+11 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARY",BGPC))
IF BGPC'=+BGPC!(BGPQUIT)
QUIT
Begin DoDot:1
+12 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+13 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+14 DO W^BGP4DP("",0,1,BGPPTYPE)
+15 ;W !,$P(^BGPSCAT(BGPC1,0),U)
DO W^BGP4DP($PIECE(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
+16 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARY",BGPC,BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:2
+17 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY",BGPC,BGPO,0))
+18 ;part measure displays last
IF $PIECE($GET(^BGPINDJC(BGPPC,22)),U,13)
QUIT
+19 IF BGPPTYPE="P"
Begin DoDot:3
+20 IF $Y>(BGPIOSL-4)
DO HEADER
IF BGPQUIT
QUIT
+21 IF $PIECE(^BGPINDJC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDJC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDJC(BGPPC,0),U,4)="016.A.1")!($PIECE(^BGPINDJC(BGPPC,0),U,4)="016.A.5")!($PIECE($GET(^BGPINDJC(BGPPC,19)),U,13))
Begin DoDot:4
+22 DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P4),0,1,BGPPTYPE)
+23 IF $PIECE(^BGPINDJC(BGPPC,14),U,P7)]""
DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P7),0,1,BGPPTYPE)
+24 IF $PIECE(^BGPINDJC(BGPPC,14),U,P12)]""
DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P12),0,1,BGPPTYPE)
+25 DO W^BGP4DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U),7,0),0,0,BGPPTYPE,2,26)
+26 DO W^BGP4DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,0),0,0,BGPPTYPE,3,34)
+27 DO W^BGP4DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,0),0,0,BGPPTYPE,4,41)
+28 DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P8),0,0,BGPPTYPE,5,53)
+29 DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,2),0,0,BGPPTYPE,6,64)
+30 DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,3),0,0,BGPPTYPE,7,73)
End DoDot:4
IF 1
+31 IF '$TEST
Begin DoDot:4
+32 DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P4),0,1,BGPPTYPE,1)
+33 ;W !,$P(^BGPINDJC(BGPPC,14),U,P7)
IF $PIECE(^BGPINDJC(BGPPC,14),U,P7)]""
DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P7),0,1,BGPPTYPE)
+34 ;W !,$P(^BGPINDJC(BGPPC,14),U,P12)
IF $PIECE(^BGPINDJC(BGPPC,14),U,P12)]""
DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P12),0,1,BGPPTYPE)
+35 DO W^BGP4DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U),7,1)_"%",0,0,BGPPTYPE,2,26)
+36 DO W^BGP4DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,1)_"%",0,0,BGPPTYPE,3,34)
+37 DO W^BGP4DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,1)_"%",0,0,BGPPTYPE,4,41)
+38 DO W^BGP4DP($TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,P8),"$","^"),0,0,BGPPTYPE,5,53)
+39 DO W^BGP4DP($TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,2),"$","^"),0,0,BGPPTYPE,6,64)
+40 DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,3),0,0,BGPPTYPE,7,73)
+41 IF $PIECE(^BGPINDJC(BGPPC,14),U,9)]""!($PIECE(^BGPINDJC(BGPPC,14),U,10)]"")!($PIECE(^BGPINDJC(BGPPC,14),U,11)]"")
Begin DoDot:5
+42 DO W^BGP4DP($TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,9),"$","^"),0,1,BGPPTYPE,5,53)
DO W^BGP4DP($TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,10),"$","^"),0,0,BGPPTYPE,6,64)
DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,11),0,0,7,73)
End DoDot:5
End DoDot:4
End DoDot:3
+43 IF BGPPTYPE="D"
Begin DoDot:3
+44 SET X=""
+45 IF $PIECE(^BGPINDJC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDJC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDJC(BGPPC,0),U,4)="016.A.1")!($PIECE(^BGPINDJC(BGPPC,0),U,4)="016.A.5")!($PIECE($GET(^BGPINDJC(BGPPC,19)),U,13))
Begin DoDot:4
+46 SET X=$PIECE(^BGPINDJC(BGPPC,14),U,P4)
+47 IF $PIECE(^BGPINDJC(BGPPC,14),U,P7)]""
DO W^BGP4DP(X,0,1,BGPPTYPE)
SET X=$PIECE(^BGPINDJC(BGPPC,14),U,P7)
+48 IF $PIECE(^BGPINDJC(BGPPC,14),U,P12)]""
DO W^BGP4DP(X,0,1,BGPPTYPE)
SET X=$PIECE(^BGPINDJC(BGPPC,14),U,P12)
+49 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)
+50 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)
+51 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)
+52 SET $PIECE(X,U,5)=$PIECE(^BGPINDJC(BGPPC,14),U,P8)
+53 SET $PIECE(X,U,6)=$PIECE(^BGPINDJC(BGPPC,14),U,2)
SET $PIECE(X,U,7)=$PIECE(^BGPINDJC(BGPPC,14),U,3)
+54 DO W^BGP4DP(X,0,1,BGPPTYPE)
End DoDot:4
IF 1
+55 IF '$TEST
Begin DoDot:4
+56 SET X=$PIECE(^BGPINDJC(BGPPC,14),U,P4)
+57 IF $PIECE(^BGPINDJC(BGPPC,14),U,P7)]""
DO W^BGP4DP(X,0,1,BGPPTYPE)
SET X=$PIECE(^BGPINDJC(BGPPC,14),U,P7)
+58 IF $PIECE(^BGPINDJC(BGPPC,14),U,P12)]""
DO W^BGP4DP(X,0,1,BGPPTYPE)
SET X=$PIECE(^BGPINDJC(BGPPC,14),U,P12)
+59 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)_"%"
+60 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)_"%"
+61 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)_"%"
+62 SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,P8),"$","^")
+63 SET $PIECE(X,U,6)=$TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,2),"$","^")
SET $PIECE(X,U,7)=$PIECE(^BGPINDJC(BGPPC,14),U,3)
+64 DO W^BGP4DP(X,0,1,BGPPTYPE)
+65 SET X=""
IF $PIECE(^BGPINDJC(BGPPC,14),U,9)]""!($PIECE(^BGPINDJC(BGPPC,14),U,10)]"")!($PIECE(^BGPINDJC(BGPPC,14),U,11)]"")
SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,9),"$","^")
SET $PIECE(X,U,6)=$TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,10),"$","^")
Begin DoDot:5
+66 SET $PIECE(X,U,7)=$PIECE(^BGPINDJC(BGPPC,14),U,11)
+67 IF X]""
DO W^BGP4DP(X,0,1,BGPPTYPE)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+68 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-9)
DO HEADER
IF BGPQUIT
QUIT
+69 ;I $G(BGPNGR09) D FOOTER10 Q
+70 ;D W^BGP4DP("* GPRA 2014 targets represented here are preliminary targets since",0,1,BGPPTYPE)
+71 ;D W^BGP4DP("IHS is awaiting notification of final targets.",0,1,BGPPTYPE)
+72 DO W^BGP4DP(" * Measure definition changed in 2013.",0,2,BGPPTYPE)
+73 DO W^BGP4DP("** Measure definition changed in 2014.",0,1,BGPPTYPE)
+74 ;D W^BGP4DP(" + Site Previous and Site Baseline values are not applicable for this measure.",0,1,BGPPTYPE)
+75 DO W^BGP4DP("",0,1,BGPPTYPE)
+76 ;D PART
+77 QUIT
+1 WRITE !," * GPRA 2014 targets represented here are preliminary targets since they will"
+2 WRITE !,"be adjusted for FY 2014 actual results and FY 2014 appropriations."
+3 WRITE !," * Measure definition changed in 2007."
+4 WRITE !,"*** Not official GPRA measure but included to show percentage of refusals with",!,"respect to GPRA measure."
+5 ;W !," + Site Previous and Site Baseline values are not applicable for this measure."
+6 WRITE !
+7 QUIT
+8 ;
+1 DO HEADER^BGP4DPH
+2 DO H1
+3 QUIT
H1 ;
+1 SET X="OFFICIAL GPRA/GPRAMA MEASURES CLINICAL PERFORMANCE SUMMARY"
DO W^BGP4DP(X,1,1,BGPPTYPE)
+2 IF $GET(BGPAREAA)
DO W^BGP4DP("Area",0,1,BGPPTYPE,2,27)
DO W^BGP4DP("Area",0,0,BGPPTYPE,3,35)
Begin DoDot:1
+3 ;CHANGE 1:"GPRA" TO 1:"GPRA"
DO W^BGP4DP("Area",0,0,BGPPTYPE,4,44)
DO W^BGP4DP($SELECT('$GET(BGPNGR09):"GPRA",1:"GPRA"),0,0,BGPPTYPE,5,53)
DO W^BGP4DP("Nat'l",0,0,BGPPTYPE,6,64)
DO W^BGP4DP("2020",0,0,BGPPTYPE,7,73)
End DoDot:1
+4 IF '$GET(BGPAREAA)
DO W^BGP4DP("Site",0,1,BGPPTYPE,2,27)
DO W^BGP4DP("Site",0,0,BGPPTYPE,3,35)
Begin DoDot:1
+5 ;CHANGE 1:"GPRA" TO 1:"GPRA"
DO W^BGP4DP("Site",0,0,BGPPTYPE,4,44)
DO W^BGP4DP($SELECT('$GET(BGPNGR09):"GPRA",1:"GPRA"),0,0,BGPPTYPE,5,53)
DO W^BGP4DP("Nat'l",0,0,BGPPTYPE,6,64)
DO W^BGP4DP("2020",0,0,BGPPTYPE,7,73)
End DoDot:1
+6 DO W^BGP4DP("Current",0,1,BGPPTYPE,2,26)
DO W^BGP4DP("Previous",0,0,BGPPTYPE,3,34)
Begin DoDot:1
+7 ;CHANGE 09 TO "*" IF NEEDED
DO W^BGP4DP("Baseline",0,0,BGPPTYPE,4,43)
DO W^BGP4DP("Target"_$SELECT($GET(BGPNGR09):"",1:""),0,0,BGPPTYPE,5,53)
DO W^BGP4DP("2013",0,0,BGPPTYPE,6,64)
DO W^BGP4DP("Target",0,0,BGPPTYPE,7,73)
End DoDot:1
+8 DO W^BGP4DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+9 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
PART ;
+1 DO HEADERP
+2 ;CHANGE 1:14 TO 1:8
SET P1=$SELECT($GET(BGPNGR09):8,1:8)
+3 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARY",BGPC))
IF BGPC'=+BGPC!(BGPQUIT)
QUIT
Begin DoDot:1
+4 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADERP
IF BGPQUIT
QUIT
+5 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+6 ;W !
+7 ;W !,$P(^BGPSCAT(BGPC1,0),U)
+8 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARY",BGPC,BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:2
+9 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY",BGPC,BGPO,0))
+10 ;part measures only
IF '$PIECE($GET(^BGPINDJC(BGPPC,22)),U,13)
QUIT
+11 IF BGPPTYPE="P"
Begin DoDot:3
+12 IF BGPPTYPE
IF $Y>(BGPIOSL-4)
DO HEADERP
IF BGPQUIT
QUIT
+13 IF $PIECE(^BGPINDJC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDJC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDJC(BGPPC,0),U,4)="016.A.1")!($PIECE(^BGPINDJC(BGPPC,0),U,4)="016.A.5")!($PIECE($GET(^BGPINDJC(BGPPC,19)),U,13))
Begin DoDot:4
+14 DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P4),0,1,BGPPTYPE)
+15 IF $PIECE(^BGPINDJC(BGPPC,14),U,P7)]""
DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P7),0,1,BGPPTYPE)
+16 IF $PIECE(^BGPINDJC(BGPPC,14),U,P12)]""
DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P12),0,1,BGPPTYPE)
+17 DO W^BGP4DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U),7,0),0,0,BGPPTYPE,2,26)
+18 DO W^BGP4DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,0),0,0,BGPPTYPE,3,34)
+19 DO W^BGP4DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,0),0,0,BGPPTYPE,4,44)
+20 DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P8),0,0,BGPPTYPE,5,53)
+21 DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,2),0,0,BGPPTYPE,6,64)
+22 DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,3),0,0,BGPPTYPE,7,73)
End DoDot:4
IF 1
+23 IF '$TEST
Begin DoDot:4
+24 DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P4),0,1,BGPPTYPE,1)
+25 ;W !,$P(^BGPINDJC(BGPPC,14),U,P7)
IF $PIECE(^BGPINDJC(BGPPC,14),U,P7)]""
DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P7),0,1,BGPPTYPE)
+26 ;W !,$P(^BGPINDJC(BGPPC,14),U,P12)
IF $PIECE(^BGPINDJC(BGPPC,14),U,P12)]""
DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,P12),0,1,BGPPTYPE)
+27 DO W^BGP4DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U),7,1)_"%",0,0,BGPPTYPE,2,26)
+28 DO W^BGP4DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,1)_"%",0,0,BGPPTYPE,3,34)
+29 DO W^BGP4DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,1)_"%",0,0,BGPPTYPE,4,44)
+30 DO W^BGP4DP($TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,P8),"$","^"),0,0,BGPPTYPE,5,53)
+31 DO W^BGP4DP($TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,2),"$","^"),0,0,BGPPTYPE,6,64)
+32 DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,3),0,0,BGPPTYPE,7,73)
+33 IF $PIECE(^BGPINDJC(BGPPC,14),U,9)]""!($PIECE(^BGPINDJC(BGPPC,14),U,10)]"")!($PIECE(^BGPINDJC(BGPPC,14),U,11)]"")
Begin DoDot:5
+34 DO W^BGP4DP($TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,9),"$","^"),0,1,BGPPTYPE,5,53)
DO W^BGP4DP($TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,10),"$","^"),0,0,BGPPTYPE,6,64)
DO W^BGP4DP($PIECE(^BGPINDJC(BGPPC,14),U,11),0,0,7,73)
End DoDot:5
End DoDot:4
End DoDot:3
+35 IF BGPPTYPE="D"
Begin DoDot:3
+36 SET X=""
+37 IF $PIECE(^BGPINDJC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDJC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDJC(BGPPC,0),U,4)="016.A.1")!($PIECE(^BGPINDJC(BGPPC,0),U,4)="016.A.5")!($PIECE($GET(^BGPINDJC(BGPPC,19)),U,13))
Begin DoDot:4
+38 SET X=$PIECE(^BGPINDJC(BGPPC,14),U,P4)
+39 IF $PIECE(^BGPINDJC(BGPPC,14),U,P7)]""
DO W^BGP4DP(X,0,1,BGPPTYPE)
SET X=$PIECE(^BGPINDJC(BGPPC,14),U,P7)
+40 IF $PIECE(^BGPINDJC(BGPPC,14),U,P12)]""
DO W^BGP4DP(X,0,1,BGPPTYPE)
SET X=$PIECE(^BGPINDJC(BGPPC,14),U,P12)
+41 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)
+42 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)
+43 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)
+44 SET $PIECE(X,U,5)=$PIECE(^BGPINDJC(BGPPC,14),U,P8)
+45 SET $PIECE(X,U,6)=$PIECE(^BGPINDJC(BGPPC,14),U,2)
SET $PIECE(X,U,7)=$PIECE(^BGPINDJC(BGPPC,14),U,3)
+46 DO W^BGP4DP(X,0,1,BGPPTYPE)
End DoDot:4
IF 1
+47 IF '$TEST
Begin DoDot:4
+48 SET X=$PIECE(^BGPINDJC(BGPPC,14),U,P4)
+49 IF $PIECE(^BGPINDJC(BGPPC,14),U,P7)]""
DO W^BGP4DP(X,0,1,BGPPTYPE)
SET X=$PIECE(^BGPINDJC(BGPPC,14),U,P7)
+50 IF $PIECE(^BGPINDJC(BGPPC,14),U,P12)]""
DO W^BGP4DP(X,0,1,BGPPTYPE)
SET X=$PIECE(^BGPINDJC(BGPPC,14),U,P12)
+51 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)_"%"
+52 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)_"%"
+53 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)_"%"
+54 SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,P8),"$","^")
+55 SET $PIECE(X,U,6)=$TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,2),"$","^")
SET $PIECE(X,U,7)=$PIECE(^BGPINDJC(BGPPC,14),U,3)
+56 DO W^BGP4DP(X,0,1,BGPPTYPE)
+57 SET X=""
IF $PIECE(^BGPINDJC(BGPPC,14),U,9)]""!($PIECE(^BGPINDJC(BGPPC,14),U,10)]"")!($PIECE(^BGPINDJC(BGPPC,14),U,11)]"")
SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,9),"$","^")
SET $PIECE(X,U,6)=$TRANSLATE($PIECE(^BGPINDJC(BGPPC,14),U,10),"$","^")
Begin DoDot:5
+58 SET $PIECE(X,U,7)=$PIECE(^BGPINDJC(BGPPC,14),U,11)
+59 IF X]""
DO W^BGP4DP(X,0,1,BGPPTYPE)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+60 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-9)
DO HEADERP
IF BGPQUIT
QUIT
+61 DO W^BGP4DP("",0,1,BGPPTYPE)
+62 ;I $G(BGPNGR09) D
+63 ;.D W^BGP4DP(" * PART 2014 target represented here is a preliminary target since it will be",0,1,BGPPTYPE)
+64 ;.D W^BGP4DP("adjusted for FY 2014 actual results and FY 2014 appropriations.",0,1,BGPPTYPE)
+65 ;CHANGE NGR09 TO "**"
DO W^BGP4DP($SELECT($GET(BGPNGR09):"*",1:"*")_" Federally Administered Activities measure. National 2013 rate is for federal",0,1,BGPPTYPE)
+66 DO W^BGP4DP("sites only.",0,1,BGPPTYPE)
+67 DO W^BGP4DP("",0,1,BGPPTYPE)
+68 QUIT
+69 ;
+1 DO HEADER^BGP4DPH
+2 DO H1P
+3 QUIT
H1P ;
+1 SET X="OFFICIAL GPRA/GPRAMA MEASURES CLINICAL PERFORMANCE SUMMARY"
DO W^BGP4DP(X,1,1,BGPPTYPE)
+2 IF $GET(BGPAREAA)
DO W^BGP4DP("Area",0,1,BGPPTYPE,2,27)
DO W^BGP4DP("Area",0,0,BGPPTYPE,3,35)
Begin DoDot:1
+3 DO W^BGP4DP("Area",0,0,BGPPTYPE,4,44)
DO W^BGP4DP($SELECT('$GET(BGPNGR09):"PART",1:"PART"),0,0,BGPPTYPE,5,53)
DO W^BGP4DP("Nat'l",0,0,BGPPTYPE,6,63)
DO W^BGP4DP("2020",0,0,BGPPTYPE,7,73)
End DoDot:1
+4 IF '$GET(BGPAREAA)
DO W^BGP4DP("Site",0,1,BGPPTYPE,2,27)
DO W^BGP4DP("Site",0,0,BGPPTYPE,3,35)
Begin DoDot:1
+5 DO W^BGP4DP("Site",0,0,BGPPTYPE,4,44)
DO W^BGP4DP($SELECT('$GET(BGPNGR09):"PART",1:"PART"),0,0,BGPPTYPE,5,53)
DO W^BGP4DP("Nat'l",0,0,BGPPTYPE,6,63)
DO W^BGP4DP("2020",0,0,BGPPTYPE,7,73)
End DoDot:1
+6 DO W^BGP4DP("Current",0,1,BGPPTYPE,2,26)
DO W^BGP4DP("Previous",0,0,BGPPTYPE,3,34)
Begin DoDot:1
+7 DO W^BGP4DP("Baseline",0,0,BGPPTYPE,4,43)
DO W^BGP4DP("Target"_$SELECT($GET(BGPNGR09):"",1:""),0,0,BGPPTYPE,5,53)
DO W^BGP4DP("2013",0,0,BGPPTYPE,6,63)
DO W^BGP4DP("Target",0,0,BGPPTYPE,7,73)
End DoDot:1
+8 DO W^BGP4DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+9 DO W^BGP4DP("PART MEASURE",0,2,BGPPTYPE)
+10 DO W^BGP4DP("------------",0,1,BGPPTYPE)
+11 DO W^BGP4DP("",0,1,BGPPTYPE)
+12 QUIT
