BGP1PDLD ; IHS/CMI/LAB - IHS gpra print ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
S(Y,F,P) ;EP set up array
I '$G(F) S F=0
S %=$P(^TMP($J,"BGPDEL",0),U)+F,$P(^TMP($J,"BGPDEL",0),U)=%
I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""
S $P(^TMP($J,"BGPDEL",%),U,P)=Y
Q
C(X,X2,X3) ;
D COMMA^%DTC
Q X
DEVSUM ;EP
I BGPRTYPE'=1 Q ;national gpra only
Q:$G(BGPCPPL)
I $G(BGPNPL) Q ;not on lists
S BGPQUIT="",BGPGPG=0
S BGPSUMP=1
D:'$G(BGPSUMON) H1
D S("GPRA DEVELOPMENTAL MEASURES",1,1)
D S("---------------------------",1,1)
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARYDEL DEVEL",BGPC)) Q:BGPC'=+BGPC D
.S X=" " D S(X,1,1)
.S BGPC1=$O(^BGPSCAT("C",BGPC,0))
.S X=$P(^BGPSCAT(BGPC1,0),U,1) D S(X,1,1)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO)) Q:BGPO="" D
..S BGPPC=$O(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,0))
..Q:$P($G(^BGPINDBC(BGPPC,22)),U,13) ;part measures only
..S X=""
..I $P(^BGPINDBC(BGPPC,0),U,4)["014.A"!($P(^BGPINDBC(BGPPC,0),U,4)["023.")!($P(^BGPINDBC(BGPPC,0),U,4)["016")!($P($G(^BGPINDBC(BGPPC,19)),U,13)) D I 1
...S X=" "_$P(^BGPINDBC(BGPPC,22),U,4)
...I $P(^BGPINDBC(BGPPC,22),U,7)]"" D S(X,1,1) S X=" "_$P(^BGPINDBC(BGPPC,22),U,7)
...I $P(^BGPINDBC(BGPPC,22),U,12)]"" D S(X,1,1) S X=" "_$P(^BGPINDBC(BGPPC,22),U,12)
...S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U)
...S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2)
...S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3)
...S $P(X,U,5)=$P(^BGPINDBC(BGPPC,22),U,2),$P(X,U,6)=$P(^BGPINDBC(BGPPC,22),U,3)
...D S(X,1,1)
..E D
...S X=" "_$P(^BGPINDBC(BGPPC,22),U,4)
...I $P(^BGPINDBC(BGPPC,22),U,7)]"" D S(X,1,1) S X=" "_$P(^BGPINDBC(BGPPC,22),U,7)
...I $P(^BGPINDBC(BGPPC,22),U,12)]"" D S(X,1,1) S X=" "_$P(^BGPINDBC(BGPPC,22),U,12)
...S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U)_"%"
...S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2)_"%"
...S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3)_"%"
...S $P(X,U,5)=$TR($P(^BGPINDBC(BGPPC,22),U,2),"$","^"),$P(X,U,6)=$P(^BGPINDBC(BGPPC,22),U,3)
...D S(X,1,1)
...S X="" I $P(^BGPINDBC(BGPPC,22),U,9)]""!($P(^BGPINDBC(BGPPC,22),U,10)]"")!($P(^BGPINDBC(BGPPC,22),U,11)]"") S $P(X,U,5)=$TR($P(^BGPINDBC(BGPPC,22),U,10),"$","^") D
....S $P(X,U,6)=$P(^BGPINDBC(BGPPC,22),U,11)
...I X]"" D S(X,1,1)
S X=" " D S(X,1,1)
S X="* Not GPRA Developmental measure but included to show percentage of" D S(X,1,1)
D S("refusals with respect to GPRA Developmental measure.",1,1)
D PART
Q
;
H1 ;
S X=" " D S(X,2,1)
S X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE SUMMARY" D S(X,3,1)
I $G(BGPAREAA) S X="",$P(X,U,2)=" Area",$P(X,U,3)=" Area",$P(X,U,4)=" Area",$P(X,U,5)="Nat'l" D S(X,1,1)
I '$G(BGPAREAA) S X="",$P(X,U,2)=" Site",$P(X,U,3)=" Site",$P(X,U,4)=" Site",$P(X,U,5)="Nat'l" D S(X,1,1)
S X="",$P(X,U,2)="Current",$P(X,U,3)="Previous",$P(X,U,4)="Baseline",$P(X,U,5)="2010" D S(X,1,1)
S X=$TR($J("",80)," ","-") D S(X,1,1)
Q
PART ;
SUMMARY ;
I BGPRTYPE'=1 Q ;national gpra only
Q:$G(BGPCPPL)
I $G(BGPNPL) Q ;not on lists
S BGPQUIT="",BGPGPG=0
S BGPSUMP=1,BGPNON=0
D:'$G(BGPSUMON) H1P
D S("PART MEASURE",1,1)
D S("------------",1,1)
S P1=$S($G(BGPNGR09):14,1:14) ;1:14 TO 1:8 IF NEEDED
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARYDEL DEVEL",BGPC)) Q:BGPC'=+BGPC D
.;S X=" " D S(X,1,1)
.S BGPC1=$O(^BGPSCAT("C",BGPC,0))
.;S X=$P(^BGPSCAT(BGPC1,0),U,1) D S(X,1,1)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO)) Q:BGPO="" D
..S BGPPC=$O(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,0))
..Q:'$P($G(^BGPINDBC(BGPPC,22)),U,13)
..S X=""
..I $P(^BGPINDBC(BGPPC,0),U,4)["014.A"!($P(^BGPINDBC(BGPPC,0),U,4)["023.")!($P(^BGPINDBC(BGPPC,0),U,4)["016")!($P($G(^BGPINDBC(BGPPC,19)),U,13)) D I 1
...S X=$P(^BGPINDBC(BGPPC,22),U,4)
...I $P(^BGPINDBC(BGPPC,22),U,7)]"" D S(X,1,1) S X=$P(^BGPINDBC(BGPPC,22),U,7)
...I $P(^BGPINDBC(BGPPC,22),U,12)]"" D S(X,1,1) S X=$P(^BGPINDBC(BGPPC,22),U,12)
...S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U)
...S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2)
...S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3)
...S $P(X,U,5)=$P(^BGPINDBC(BGPPC,22),U,P1)
...S $P(X,U,6)=$P(^BGPINDBC(BGPPC,22),U,2),$P(X,U,7)=$P(^BGPINDBC(BGPPC,22),U,3)
...D S(X,1,1)
..E D
...S X=$P(^BGPINDBC(BGPPC,22),U,4)
...I $P(^BGPINDBC(BGPPC,22),U,7)]"" D S(X,1,1) S X=$P(^BGPINDBC(BGPPC,22),U,7)
...I $P(^BGPINDBC(BGPPC,22),U,12)]"" D S(X,1,1) S X=$P(^BGPINDBC(BGPPC,22),U,12)
...S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U)_"%"
...S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2)_"%"
...S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3)_"%"
...S $P(X,U,5)=$TR($P(^BGPINDBC(BGPPC,22),U,P1),"$","^")
...S $P(X,U,6)=$TR($P(^BGPINDBC(BGPPC,22),U,2),"$","^"),$P(X,U,7)=$P(^BGPINDBC(BGPPC,22),U,3)
...D S(X,1,1)
...S X="" I $P(^BGPINDBC(BGPPC,22),U,9)]""!($P(^BGPINDBC(BGPPC,22),U,10)]"")!($P(^BGPINDBC(BGPPC,22),U,11)]"") S $P(X,U,5)=$TR($P(^BGPINDBC(BGPPC,22),U,9),"$","^"),$P(X,U,6)=$TR($P(^BGPINDBC(BGPPC,22),U,10),"$","^") D
....S $P(X,U,7)=$P(^BGPINDBC(BGPPC,22),U,11)
...I X]"" D S(X,1,1)
S X=" " D S(X,1,1)
;I $G(BGPNGR09) D
;.S X=" * PART 2012 target represented here is a preliminary target since it will be" D S(X,2,1)
;.S X="adjusted for FY 2011 actual results and FY 2012 appropriations." D S(X,1,1)
S X=$S($G(BGPNGR09):"*",1:"*")_" Federally Administered Activities measure. National 2010 rate is for federal" D S(X,1,1)
S X="sites only." D S(X,1,1)
D S(" ",1,1)
Q
;
H1P ;
S X=" " D S(X,2,1)
S X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE SUMMARY" D S(X,3,1)
I $G(BGPAREAA) S X="",$P(X,U,2)=" Area",$P(X,U,3)=" Area",$P(X,U,4)=" Area",$P(X,U,5)=$S($G(BGPNGR09):"PART10",1:"PART09"),$P(X,U,6)="Nat'l",$P(X,U,7)="2011" D S(X,1,1)
I '$G(BGPAREAA) S X="",$P(X,U,2)=" Site",$P(X,U,3)=" Site",$P(X,U,4)=" Site",$P(X,U,5)=$S($G(BGPNGR09):"PART10",1:"PART09"),$P(X,U,6)="Nat'l",$P(X,U,7)="2011" D S(X,1,1)
S X="",$P(X,U,2)="Current",$P(X,U,3)="Previous",$P(X,U,4)="Baseline",$P(X,U,5)="Target"_$S($G(BGPNGR09):"",1:""),$P(X,U,6)="2010",$P(X,U,7)="Target" D S(X,1,1)
S X=$TR($J("",80)," ","-") D S(X,1,1)
Q
H2 ;
S X=" " D S(X,2,1)
S X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE DETAIL" D S(X,2,1)
S X="",$P(X,U,2)=" Site",$P(X,U,3)=" Site",$P(X,U,4)=" Site",$P(X,U,5)="Area",$P(X,U,6)="Nat'l" D S(X,1,1)
S X="",$P(X,U,2)="Current",$P(X,U,3)="Previous",$P(X,U,4)="Baseline",$P(X,U,5)="Current",$P(X,U,6)="2010" D S(X,1,1)
S X=$TR($J("",80)," ","-") D S(X,1,1)
Q
SDP ;EP
I BGPRTYPE'=1 Q ;national gpra only
I '$G(BGPAREAA) Q ;area only
S BGPQUIT="",BGPGPG=0
S BGPSUMP=1
S X=" " D S(X,2,1)
D HEADER^BGP1PDL
D H2
D S("GRPA DEVELOPMENTAL MEASURES",1,1)
D S("---------------------------",1,1)
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC)) Q:BGPC'=+BGPC D
.S X=" " D S(X,1,1)
.S BGPC1=$O(^BGPSCAT("C",BGPC,0))
.S X=$P(^BGPSCAT(BGPC1,0),U,1) D S(X,1,1)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO)) Q:BGPO="" D
..S BGPPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,0))
..Q:$P($G(^BGPINDBC(BGPPC,22)),U,13) ;NON-part measures only
..S X=" " D S(X,1,1)
..S XX=" "_$P(^BGPINDBC(BGPPC,22),U,4)
..I $P(^BGPINDBC(BGPPC,22),U,7)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDBC(BGPPC,22),U,7)
..I $P(^BGPINDBC(BGPPC,22),U,12)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDBC(BGPPC,22),U,12)
..S F=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,0))
..S F=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,F),U,4)
..S $P(XX,U,5)=F_$S($P(^BGPINDBC(BGPPC,0),U,4)["014.A"!($P(^BGPINDBC(BGPPC,0),U,4)["023.")!($P(^BGPINDBC(BGPPC,0),U,4)="016.A.1")!($P($G(^BGPINDBC(BGPPC,19)),U,13)):"",1:"%")
..S $P(XX,U,6)=$P(^BGPINDBC(BGPPC,22),U,2) ;,$P(XX,U,7)=$P(^BGPINDBC(BGPPC,22),U,3)
..S BGPSN=0,BGPCNT=0 F S BGPSN=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN S BGPCNT=BGPCNT+1 D
...S BGPSASU=$P(^BGPGPDCB(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCB(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
...I $P(^BGPINDBC(BGPPC,0),U,4)["014.A"!($P(^BGPINDBC(BGPPC,0),U,4)["023.")!($P(^BGPINDBC(BGPPC,0),U,4)["016")!($P($G(^BGPINDBC(BGPPC,19)),U,13)) D I 1
....S X="",$P(X,U,1)=BGPSASU_" "_BGPSNAM
....S $P(X,U,2)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U)
....S $P(X,U,3)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2)
....S $P(X,U,4)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3)
....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,4)
...E D
....S $P(X,U,1)=BGPSASU_" "_BGPSNAM
....S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,4)_"%"
....;S $P(X,U,5)=$P(^BGPINDBC(BGPPC,22),U,2),$P(X,U,6)=$P(^BGPINDBC(BGPPC,22),U,3)
...I BGPCNT=1 D S(XX,1,1) D
....;S Y="" I $P(^BGPINDBC(BGPPC,22),U,9)]""!($P(^BGPINDBC(BGPPC,22),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDBC(BGPPC,22),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDBC(BGPPC,22),U,10),"$","^")
....S Y="" I $P(^BGPINDBC(BGPPC,22),U,9)]""!($P(^BGPINDBC(BGPPC,22),U,10)]"")!($P(^BGPINDBC(BGPPC,22),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPINDBC(BGPPC,22),U,9),"$","^") D
.....S $P(Y,U,8)=$P(^BGPINDBC(BGPPC,22),U,11)
....I Y]"" D S(Y,1,1)
...D S(X,1,1)
S X=" " D S(X,1,1)
S X="* Not GPRA Developmental measure but included to show percentage of" D S(X,1,1)
D S("refusals with respect to GPRA Developmental measure.",1,1)
D S(" ",1,1)
D PARTSDP
Q
PARTSDP ;
D H2P
S P1=$S($G(BGPNGR09):8,1:8)
D S("PART MEASURE",1,1)
D S("------------",1,1)
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC)) Q:BGPC'=+BGPC D
.;S X=" " D S(X,1,1)
.S BGPC1=$O(^BGPSCAT("C",BGPC,0))
.;S X=$P(^BGPSCAT(BGPC1,0),U,1) D S(X,1,1)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO)) Q:BGPO="" D
..S BGPPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,0))
..Q:'$P($G(^BGPINDBC(BGPPC,22)),U,13) ;part only
..S X=" " D S(X,1,1)
..S XX=" "_$P(^BGPINDBC(BGPPC,22),U,4)
..I $P(^BGPINDBC(BGPPC,22),U,7)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDBC(BGPPC,22),U,7)
..I $P(^BGPINDBC(BGPPC,22),U,12)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDBC(BGPPC,22),U,12)
..S F=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,0))
..S F=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,F),U,4)
..S $P(XX,U,5)=F_$S($P(^BGPINDBC(BGPPC,0),U,4)["014.A"!($P(^BGPINDBC(BGPPC,0),U,4)["023.")!($P(^BGPINDBC(BGPPC,0),U,4)="016.A.1")!($P($G(^BGPINDBC(BGPPC,19)),U,13)):"",1:"%")
..S $P(XX,U,6)=$P(^BGPINDBC(BGPPC,22),U,P1),$P(XX,U,7)=$P(^BGPINDBC(BGPPC,22),U,2),$P(XX,U,8)=$P(^BGPINDBC(BGPPC,22),U,3)
..S BGPSN=0,BGPCNT=0 F S BGPSN=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN S BGPCNT=BGPCNT+1 D
...S BGPSASU=$P(^BGPGPDCB(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCB(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
...I $P(^BGPINDBC(BGPPC,0),U,4)["014.A"!($P(^BGPINDBC(BGPPC,0),U,4)["023.")!($P(^BGPINDBC(BGPPC,0),U,4)["016")!($P($G(^BGPINDBC(BGPPC,19)),U,13)) D I 1
....S X="",$P(X,U,1)=BGPSASU_" "_BGPSNAM
....S $P(X,U,2)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U)
....S $P(X,U,3)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2)
....S $P(X,U,4)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3)
....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,4)
...E D
....S $P(X,U,1)=BGPSASU_" "_BGPSNAM
....S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,4)_"%"
....;S $P(X,U,5)=$P(^BGPINDBC(BGPPC,22),U,2),$P(X,U,6)=$P(^BGPINDBC(BGPPC,22),U,3)
...I BGPCNT=1 D S(XX,1,1) D
....;S Y="" I $P(^BGPINDBC(BGPPC,22),U,9)]""!($P(^BGPINDBC(BGPPC,22),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDBC(BGPPC,22),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDBC(BGPPC,22),U,10),"$","^")
....S Y="" I $P(^BGPINDBC(BGPPC,22),U,9)]""!($P(^BGPINDBC(BGPPC,22),U,10)]"")!($P(^BGPINDBC(BGPPC,22),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPINDBC(BGPPC,22),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDBC(BGPPC,22),U,10),"$","^") D
.....S $P(Y,U,8)=$P(^BGPINDBC(BGPPC,22),U,11)
....I Y]"" D S(Y,1,1)
...D S(X,1,1)
S X=" " D S(X,1,1)
D FOOTER
Q
D S(" ",1,1)
;I $G(BGPNGR09) D
;.S X=" * PART 2012 target represented here is a preliminary target since it will be" D S(X,2,1)
;.S X="adjusted for FY 2011 actual results and FY 2012 appropriations." D S(X,1,1)
S X=$S($G(BGPNGR09):"*",1:"*")_" Federally Administered Activities measure. National 2010 rate is for federal" D S(X,1,1)
S X="sites only." D S(X,1,1)
D S(" ",1,1)
Q
H2P ;
S X=" " D S(X,2,1)
S X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE DETAIL" D S(X,2,1)
S X="",$P(X,U,2)=" Site",$P(X,U,3)=" Site",$P(X,U,4)=" Site",$P(X,U,5)="Area",$P(X,U,6)=$S($G(BGPNGR09):"PART10",1:"PART09"),$P(X,U,7)="Nat'l",$P(X,U,8)="2011" D S(X,1,1)
S X="",$P(X,U,2)="Current",$P(X,U,3)="Previous",$P(X,U,4)="Baseline",$P(X,U,5)="Current",$P(X,U,6)="Target"_$S($G(BGPNGR09):"",1:""),$P(X,U,7)="2010",$P(X,U,8)="Target" D S(X,1,1)
S X=$TR($J("",80)," ","-") D S(X,1,1)
Q
BGP1PDLD ; IHS/CMI/LAB - IHS gpra print ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
S(Y,F,P) ;EP set up array
+1 IF '$GET(F)
SET F=0
+2 SET %=$PIECE(^TMP($JOB,"BGPDEL",0),U)+F
SET $PIECE(^TMP($JOB,"BGPDEL",0),U)=%
+3 IF '$DATA(^TMP($JOB,"BGPDEL",%))
SET ^TMP($JOB,"BGPDEL",%)=""
+4 SET $PIECE(^TMP($JOB,"BGPDEL",%),U,P)=Y
+5 QUIT
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
DEVSUM ;EP
+1 ;national gpra only
IF BGPRTYPE'=1
QUIT
+2 IF $GET(BGPCPPL)
QUIT
+3 ;not on lists
IF $GET(BGPNPL)
QUIT
+4 SET BGPQUIT=""
SET BGPGPG=0
+5 SET BGPSUMP=1
+6 IF '$GET(BGPSUMON)
DO H1
+7 DO S("GPRA DEVELOPMENTAL MEASURES",1,1)
+8 DO S("---------------------------",1,1)
+9 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC))
IF BGPC'=+BGPC
QUIT
Begin DoDot:1
+10 SET X=" "
DO S(X,1,1)
+11 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+12 SET X=$PIECE(^BGPSCAT(BGPC1,0),U,1)
DO S(X,1,1)
+13 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO))
IF BGPO=""
QUIT
Begin DoDot:2
+14 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,0))
+15 ;part measures only
IF $PIECE($GET(^BGPINDBC(BGPPC,22)),U,13)
QUIT
+16 SET X=""
+17 IF $PIECE(^BGPINDBC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDBC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDBC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDBC(BGPPC,19)),U,13))
Begin DoDot:3
+18 SET X=" "_$PIECE(^BGPINDBC(BGPPC,22),U,4)
+19 IF $PIECE(^BGPINDBC(BGPPC,22),U,7)]""
DO S(X,1,1)
SET X=" "_$PIECE(^BGPINDBC(BGPPC,22),U,7)
+20 IF $PIECE(^BGPINDBC(BGPPC,22),U,12)]""
DO S(X,1,1)
SET X=" "_$PIECE(^BGPINDBC(BGPPC,22),U,12)
+21 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U)
+22 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2)
+23 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3)
+24 SET $PIECE(X,U,5)=$PIECE(^BGPINDBC(BGPPC,22),U,2)
SET $PIECE(X,U,6)=$PIECE(^BGPINDBC(BGPPC,22),U,3)
+25 DO S(X,1,1)
End DoDot:3
IF 1
+26 IF '$TEST
Begin DoDot:3
+27 SET X=" "_$PIECE(^BGPINDBC(BGPPC,22),U,4)
+28 IF $PIECE(^BGPINDBC(BGPPC,22),U,7)]""
DO S(X,1,1)
SET X=" "_$PIECE(^BGPINDBC(BGPPC,22),U,7)
+29 IF $PIECE(^BGPINDBC(BGPPC,22),U,12)]""
DO S(X,1,1)
SET X=" "_$PIECE(^BGPINDBC(BGPPC,22),U,12)
+30 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U)_"%"
+31 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2)_"%"
+32 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3)_"%"
+33 SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPINDBC(BGPPC,22),U,2),"$","^")
SET $PIECE(X,U,6)=$PIECE(^BGPINDBC(BGPPC,22),U,3)
+34 DO S(X,1,1)
+35 SET X=""
IF $PIECE(^BGPINDBC(BGPPC,22),U,9)]""!($PIECE(^BGPINDBC(BGPPC,22),U,10)]"")!($PIECE(^BGPINDBC(BGPPC,22),U,11)]"")
SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPINDBC(BGPPC,22),U,10),"$","^")
Begin DoDot:4
+36 SET $PIECE(X,U,6)=$PIECE(^BGPINDBC(BGPPC,22),U,11)
End DoDot:4
+37 IF X]""
DO S(X,1,1)
End DoDot:3
End DoDot:2
End DoDot:1
+38 SET X=" "
DO S(X,1,1)
+39 SET X="* Not GPRA Developmental measure but included to show percentage of"
DO S(X,1,1)
+40 DO S("refusals with respect to GPRA Developmental measure.",1,1)
+41 DO PART
+42 QUIT
+43 ;
H1 ;
+1 SET X=" "
DO S(X,2,1)
+2 SET X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE SUMMARY"
DO S(X,3,1)
+3 IF $GET(BGPAREAA)
SET X=""
SET $PIECE(X,U,2)=" Area"
SET $PIECE(X,U,3)=" Area"
SET $PIECE(X,U,4)=" Area"
SET $PIECE(X,U,5)="Nat'l"
DO S(X,1,1)
+4 IF '$GET(BGPAREAA)
SET X=""
SET $PIECE(X,U,2)=" Site"
SET $PIECE(X,U,3)=" Site"
SET $PIECE(X,U,4)=" Site"
SET $PIECE(X,U,5)="Nat'l"
DO S(X,1,1)
+5 SET X=""
SET $PIECE(X,U,2)="Current"
SET $PIECE(X,U,3)="Previous"
SET $PIECE(X,U,4)="Baseline"
SET $PIECE(X,U,5)="2010"
DO S(X,1,1)
+6 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
DO S(X,1,1)
+7 QUIT
PART ;
SUMMARY ;
+1 ;national gpra only
IF BGPRTYPE'=1
QUIT
+2 IF $GET(BGPCPPL)
QUIT
+3 ;not on lists
IF $GET(BGPNPL)
QUIT
+4 SET BGPQUIT=""
SET BGPGPG=0
+5 SET BGPSUMP=1
SET BGPNON=0
+6 IF '$GET(BGPSUMON)
DO H1P
+7 DO S("PART MEASURE",1,1)
+8 DO S("------------",1,1)
+9 ;1:14 TO 1:8 IF NEEDED
SET P1=$SELECT($GET(BGPNGR09):14,1:14)
+10 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC))
IF BGPC'=+BGPC
QUIT
Begin DoDot:1
+11 ;S X=" " D S(X,1,1)
+12 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+13 ;S X=$P(^BGPSCAT(BGPC1,0),U,1) D S(X,1,1)
+14 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO))
IF BGPO=""
QUIT
Begin DoDot:2
+15 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,0))
+16 IF '$PIECE($GET(^BGPINDBC(BGPPC,22)),U,13)
QUIT
+17 SET X=""
+18 IF $PIECE(^BGPINDBC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDBC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDBC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDBC(BGPPC,19)),U,13))
Begin DoDot:3
+19 SET X=$PIECE(^BGPINDBC(BGPPC,22),U,4)
+20 IF $PIECE(^BGPINDBC(BGPPC,22),U,7)]""
DO S(X,1,1)
SET X=$PIECE(^BGPINDBC(BGPPC,22),U,7)
+21 IF $PIECE(^BGPINDBC(BGPPC,22),U,12)]""
DO S(X,1,1)
SET X=$PIECE(^BGPINDBC(BGPPC,22),U,12)
+22 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U)
+23 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2)
+24 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3)
+25 SET $PIECE(X,U,5)=$PIECE(^BGPINDBC(BGPPC,22),U,P1)
+26 SET $PIECE(X,U,6)=$PIECE(^BGPINDBC(BGPPC,22),U,2)
SET $PIECE(X,U,7)=$PIECE(^BGPINDBC(BGPPC,22),U,3)
+27 DO S(X,1,1)
End DoDot:3
IF 1
+28 IF '$TEST
Begin DoDot:3
+29 SET X=$PIECE(^BGPINDBC(BGPPC,22),U,4)
+30 IF $PIECE(^BGPINDBC(BGPPC,22),U,7)]""
DO S(X,1,1)
SET X=$PIECE(^BGPINDBC(BGPPC,22),U,7)
+31 IF $PIECE(^BGPINDBC(BGPPC,22),U,12)]""
DO S(X,1,1)
SET X=$PIECE(^BGPINDBC(BGPPC,22),U,12)
+32 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U)_"%"
+33 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2)_"%"
+34 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3)_"%"
+35 SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPINDBC(BGPPC,22),U,P1),"$","^")
+36 SET $PIECE(X,U,6)=$TRANSLATE($PIECE(^BGPINDBC(BGPPC,22),U,2),"$","^")
SET $PIECE(X,U,7)=$PIECE(^BGPINDBC(BGPPC,22),U,3)
+37 DO S(X,1,1)
+38 SET X=""
IF $PIECE(^BGPINDBC(BGPPC,22),U,9)]""!($PIECE(^BGPINDBC(BGPPC,22),U,10)]"")!($PIECE(^BGPINDBC(BGPPC,22),U,11)]"")
SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPINDBC(BGPPC,22),U,9),"$","^")
SET $PIECE(X,U,6)=$TRANSLATE($PIECE(^BGPINDBC(BGPPC,22),U,10),"$","^")
Begin DoDot:4
+39 SET $PIECE(X,U,7)=$PIECE(^BGPINDBC(BGPPC,22),U,11)
End DoDot:4
+40 IF X]""
DO S(X,1,1)
End DoDot:3
End DoDot:2
End DoDot:1
+41 SET X=" "
DO S(X,1,1)
+42 ;I $G(BGPNGR09) D
+43 ;.S X=" * PART 2012 target represented here is a preliminary target since it will be" D S(X,2,1)
+44 ;.S X="adjusted for FY 2011 actual results and FY 2012 appropriations." D S(X,1,1)
+45 SET X=$SELECT($GET(BGPNGR09):"*",1:"*")_" Federally Administered Activities measure. National 2010 rate is for federal"
DO S(X,1,1)
+46 SET X="sites only."
DO S(X,1,1)
+47 DO S(" ",1,1)
+48 QUIT
+49 ;
H1P ;
+1 SET X=" "
DO S(X,2,1)
+2 SET X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE SUMMARY"
DO S(X,3,1)
+3 IF $GET(BGPAREAA)
SET X=""
SET $PIECE(X,U,2)=" Area"
SET $PIECE(X,U,3)=" Area"
SET $PIECE(X,U,4)=" Area"
SET $PIECE(X,U,5)=$SELECT($GET(BGPNGR09):"PART10",1:"PART09")
SET $PIECE(X,U,6)="Nat'l"
SET $PIECE(X,U,7)="2011"
DO S(X,1,1)
+4 IF '$GET(BGPAREAA)
SET X=""
SET $PIECE(X,U,2)=" Site"
SET $PIECE(X,U,3)=" Site"
SET $PIECE(X,U,4)=" Site"
SET $PIECE(X,U,5)=$SELECT($GET(BGPNGR09):"PART10",1:"PART09")
SET $PIECE(X,U,6)="Nat'l"
SET $PIECE(X,U,7)="2011"
DO S(X,1,1)
+5 SET X=""
SET $PIECE(X,U,2)="Current"
SET $PIECE(X,U,3)="Previous"
SET $PIECE(X,U,4)="Baseline"
SET $PIECE(X,U,5)="Target"_$SELECT($GET(BGPNGR09):"",1:"")
SET $PIECE(X,U,6)="2010"
SET $PIECE(X,U,7)="Target"
DO S(X,1,1)
+6 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
DO S(X,1,1)
+7 QUIT
H2 ;
+1 SET X=" "
DO S(X,2,1)
+2 SET X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE DETAIL"
DO S(X,2,1)
+3 SET X=""
SET $PIECE(X,U,2)=" Site"
SET $PIECE(X,U,3)=" Site"
SET $PIECE(X,U,4)=" Site"
SET $PIECE(X,U,5)="Area"
SET $PIECE(X,U,6)="Nat'l"
DO S(X,1,1)
+4 SET X=""
SET $PIECE(X,U,2)="Current"
SET $PIECE(X,U,3)="Previous"
SET $PIECE(X,U,4)="Baseline"
SET $PIECE(X,U,5)="Current"
SET $PIECE(X,U,6)="2010"
DO S(X,1,1)
+5 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
DO S(X,1,1)
+6 QUIT
SDP ;EP
+1 ;national gpra only
IF BGPRTYPE'=1
QUIT
+2 ;area only
IF '$GET(BGPAREAA)
QUIT
+3 SET BGPQUIT=""
SET BGPGPG=0
+4 SET BGPSUMP=1
+5 SET X=" "
DO S(X,2,1)
+6 DO HEADER^BGP1PDL
+7 DO H2
+8 DO S("GRPA DEVELOPMENTAL MEASURES",1,1)
+9 DO S("---------------------------",1,1)
+10 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC))
IF BGPC'=+BGPC
QUIT
Begin DoDot:1
+11 SET X=" "
DO S(X,1,1)
+12 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+13 SET X=$PIECE(^BGPSCAT(BGPC1,0),U,1)
DO S(X,1,1)
+14 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO))
IF BGPO=""
QUIT
Begin DoDot:2
+15 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,0))
+16 ;NON-part measures only
IF $PIECE($GET(^BGPINDBC(BGPPC,22)),U,13)
QUIT
+17 SET X=" "
DO S(X,1,1)
+18 SET XX=" "_$PIECE(^BGPINDBC(BGPPC,22),U,4)
+19 IF $PIECE(^BGPINDBC(BGPPC,22),U,7)]""
DO S(XX,1,1)
SET XX=" "_$PIECE(^BGPINDBC(BGPPC,22),U,7)
+20 IF $PIECE(^BGPINDBC(BGPPC,22),U,12)]""
DO S(XX,1,1)
SET XX=" "_$PIECE(^BGPINDBC(BGPPC,22),U,12)
+21 SET F=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,0))
+22 SET F=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,F),U,4)
+23 SET $PIECE(XX,U,5)=F_$SELECT($PIECE(^BGPINDBC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDBC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDBC(BGPPC,0),U,4)="016.A.1")!($PIECE($GET(^BGPINDBC(BGPPC,19)),U,13)):"",1:"%")
+24 ;,$P(XX,U,7)=$P(^BGPINDBC(BGPPC,22),U,3)
SET $PIECE(XX,U,6)=$PIECE(^BGPINDBC(BGPPC,22),U,2)
+25 SET BGPSN=0
SET BGPCNT=0
FOR
SET BGPSN=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN))
IF BGPSN'=+BGPSN
QUIT
SET BGPCNT=BGPCNT+1
Begin DoDot:3
+26 SET BGPSASU=$PIECE(^BGPGPDCB(BGPSN,0),U,9)
SET X=$ORDER(^AUTTLOC("C",BGPSASU,0))
SET BGPSNAM=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
SET BGPSNAM=$SELECT($PIECE(^BGPGPDCB(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
+27 IF $PIECE(^BGPINDBC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDBC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDBC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDBC(BGPPC,19)),U,13))
Begin DoDot:4
+28 SET X=""
SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+29 SET $PIECE(X,U,2)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U)
+30 SET $PIECE(X,U,3)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2)
+31 SET $PIECE(X,U,4)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3)
+32 ;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,4)
End DoDot:4
IF 1
+33 IF '$TEST
Begin DoDot:4
+34 SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+35 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
+36 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
+37 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
+38 ;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,4)_"%"
+39 ;S $P(X,U,5)=$P(^BGPINDBC(BGPPC,22),U,2),$P(X,U,6)=$P(^BGPINDBC(BGPPC,22),U,3)
End DoDot:4
+40 IF BGPCNT=1
DO S(XX,1,1)
Begin DoDot:4
+41 ;S Y="" I $P(^BGPINDBC(BGPPC,22),U,9)]""!($P(^BGPINDBC(BGPPC,22),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDBC(BGPPC,22),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDBC(BGPPC,22),U,10),"$","^")
+42 SET Y=""
IF $PIECE(^BGPINDBC(BGPPC,22),U,9)]""!($PIECE(^BGPINDBC(BGPPC,22),U,10)]"")!($PIECE(^BGPINDBC(BGPPC,22),U,11)]"")
SET $PIECE(Y,U,6)=$TRANSLATE($PIECE(^BGPINDBC(BGPPC,22),U,9),"$","^")
Begin DoDot:5
+43 SET $PIECE(Y,U,8)=$PIECE(^BGPINDBC(BGPPC,22),U,11)
End DoDot:5
+44 IF Y]""
DO S(Y,1,1)
End DoDot:4
+45 DO S(X,1,1)
End DoDot:3
End DoDot:2
End DoDot:1
+46 SET X=" "
DO S(X,1,1)
+47 SET X="* Not GPRA Developmental measure but included to show percentage of"
DO S(X,1,1)
+48 DO S("refusals with respect to GPRA Developmental measure.",1,1)
+49 DO S(" ",1,1)
+50 DO PARTSDP
+51 QUIT
PARTSDP ;
+1 DO H2P
+2 SET P1=$SELECT($GET(BGPNGR09):8,1:8)
+3 DO S("PART MEASURE",1,1)
+4 DO S("------------",1,1)
+5 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC))
IF BGPC'=+BGPC
QUIT
Begin DoDot:1
+6 ;S X=" " D S(X,1,1)
+7 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+8 ;S X=$P(^BGPSCAT(BGPC1,0),U,1) D S(X,1,1)
+9 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO))
IF BGPO=""
QUIT
Begin DoDot:2
+10 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,0))
+11 ;part only
IF '$PIECE($GET(^BGPINDBC(BGPPC,22)),U,13)
QUIT
+12 SET X=" "
DO S(X,1,1)
+13 SET XX=" "_$PIECE(^BGPINDBC(BGPPC,22),U,4)
+14 IF $PIECE(^BGPINDBC(BGPPC,22),U,7)]""
DO S(XX,1,1)
SET XX=" "_$PIECE(^BGPINDBC(BGPPC,22),U,7)
+15 IF $PIECE(^BGPINDBC(BGPPC,22),U,12)]""
DO S(XX,1,1)
SET XX=" "_$PIECE(^BGPINDBC(BGPPC,22),U,12)
+16 SET F=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,0))
+17 SET F=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,F),U,4)
+18 SET $PIECE(XX,U,5)=F_$SELECT($PIECE(^BGPINDBC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDBC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDBC(BGPPC,0),U,4)="016.A.1")!($PIECE($GET(^BGPINDBC(BGPPC,19)),U,13)):"",1:"%")
+19 SET $PIECE(XX,U,6)=$PIECE(^BGPINDBC(BGPPC,22),U,P1)
SET $PIECE(XX,U,7)=$PIECE(^BGPINDBC(BGPPC,22),U,2)
SET $PIECE(XX,U,8)=$PIECE(^BGPINDBC(BGPPC,22),U,3)
+20 SET BGPSN=0
SET BGPCNT=0
FOR
SET BGPSN=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN))
IF BGPSN'=+BGPSN
QUIT
SET BGPCNT=BGPCNT+1
Begin DoDot:3
+21 SET BGPSASU=$PIECE(^BGPGPDCB(BGPSN,0),U,9)
SET X=$ORDER(^AUTTLOC("C",BGPSASU,0))
SET BGPSNAM=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
SET BGPSNAM=$SELECT($PIECE(^BGPGPDCB(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
+22 IF $PIECE(^BGPINDBC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDBC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDBC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDBC(BGPPC,19)),U,13))
Begin DoDot:4
+23 SET X=""
SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+24 SET $PIECE(X,U,2)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U)
+25 SET $PIECE(X,U,3)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2)
+26 SET $PIECE(X,U,4)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3)
+27 ;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,4)
End DoDot:4
IF 1
+28 IF '$TEST
Begin DoDot:4
+29 SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+30 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
+31 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
+32 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
+33 ;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,4)_"%"
+34 ;S $P(X,U,5)=$P(^BGPINDBC(BGPPC,22),U,2),$P(X,U,6)=$P(^BGPINDBC(BGPPC,22),U,3)
End DoDot:4
+35 IF BGPCNT=1
DO S(XX,1,1)
Begin DoDot:4
+36 ;S Y="" I $P(^BGPINDBC(BGPPC,22),U,9)]""!($P(^BGPINDBC(BGPPC,22),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDBC(BGPPC,22),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDBC(BGPPC,22),U,10),"$","^")
+37 SET Y=""
IF $PIECE(^BGPINDBC(BGPPC,22),U,9)]""!($PIECE(^BGPINDBC(BGPPC,22),U,10)]"")!($PIECE(^BGPINDBC(BGPPC,22),U,11)]"")
SET $PIECE(Y,U,6)=$TRANSLATE($PIECE(^BGPINDBC(BGPPC,22),U,9),"$","^")
SET $PIECE(Y,U,7)=$TRANSLATE($PIECE(^BGPINDBC(BGPPC,22),U,10),"$","^")
Begin DoDot:5
+38 SET $PIECE(Y,U,8)=$PIECE(^BGPINDBC(BGPPC,22),U,11)
End DoDot:5
+39 IF Y]""
DO S(Y,1,1)
End DoDot:4
+40 DO S(X,1,1)
End DoDot:3
End DoDot:2
End DoDot:1
+41 SET X=" "
DO S(X,1,1)
+42 DO FOOTER
+43 QUIT
+1 DO S(" ",1,1)
+2 ;I $G(BGPNGR09) D
+3 ;.S X=" * PART 2012 target represented here is a preliminary target since it will be" D S(X,2,1)
+4 ;.S X="adjusted for FY 2011 actual results and FY 2012 appropriations." D S(X,1,1)
+5 SET X=$SELECT($GET(BGPNGR09):"*",1:"*")_" Federally Administered Activities measure. National 2010 rate is for federal"
DO S(X,1,1)
+6 SET X="sites only."
DO S(X,1,1)
+7 DO S(" ",1,1)
+8 QUIT
H2P ;
+1 SET X=" "
DO S(X,2,1)
+2 SET X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE DETAIL"
DO S(X,2,1)
+3 SET X=""
SET $PIECE(X,U,2)=" Site"
SET $PIECE(X,U,3)=" Site"
SET $PIECE(X,U,4)=" Site"
SET $PIECE(X,U,5)="Area"
SET $PIECE(X,U,6)=$SELECT($GET(BGPNGR09):"PART10",1:"PART09")
SET $PIECE(X,U,7)="Nat'l"
SET $PIECE(X,U,8)="2011"
DO S(X,1,1)
+4 SET X=""
SET $PIECE(X,U,2)="Current"
SET $PIECE(X,U,3)="Previous"
SET $PIECE(X,U,4)="Baseline"
SET $PIECE(X,U,5)="Current"
SET $PIECE(X,U,6)="Target"_$SELECT($GET(BGPNGR09):"",1:"")
SET $PIECE(X,U,7)="2010"
SET $PIECE(X,U,8)="Target"
DO S(X,1,1)
+5 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
DO S(X,1,1)
+6 QUIT
