BGP9SDPD ; IHS/CMI/LAB - IHS summary page ;
;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
;
START ;
I '$G(BGPAREAA) Q
I BGPRTYPE'=1 Q
S BGPQUIT=""
D HEADER
W !!,"GPRA DEVELOPMENTAL MEASURES"
W !,"---------------------------"
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
.I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
.S BGPC1=$O(^BGPSCAT("D",BGPC,0))
.W !
.W !,$P(^BGPSCAT(BGPC1,0),U)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
..S BGPPC=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,0))
..I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
..Q:$P($G(^BGPINDNC(BGPPC,22)),U,13) ;part
..W !!?2,$P(^BGPINDNC(BGPPC,22),U,4)
..I $P(^BGPINDNC(BGPPC,22),U,7)]"" W !,$P(^BGPINDNC(BGPPC,22),U,7)
..I $P(^BGPINDNC(BGPPC,22),U,12)]"" W !,$P(^BGPINDNC(BGPPC,22),U,12)
..S F=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,0))
..S F=$P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,F),U,4)
..W ?50,F,$S($P(^BGPINDNC(BGPPC,0),U,4)["014."!($P(^BGPINDNC(BGPPC,0),U,4)["023.")!($P(^BGPINDNC(BGPPC,0),U,4)["016.")!($P($G(^BGPINDNC(BGPPC,19)),U,13)):"",1:"%")
..W ?60,$P(^BGPINDNC(BGPPC,22),U,2) ;,?65,$P(^BGPINDNC(BGPPC,22),U,3)
..I $P(^BGPINDNC(BGPPC,22),U,9)]""!($P(^BGPINDNC(BGPPC,22),U,10)]"")!($P(^BGPINDNC(BGPPC,22),U,11)]"") W !?60,$TR($P(^BGPINDNC(BGPPC,22),U,10),"$","^") ;,?65,$P(^BGPINDNC(BGPPC,22),U,11)
..S BGPSN=0 F S BGPSN=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN!(BGPQUIT) D
...S BGPSASU=$P(^BGPGPDCN(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)) S BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCN(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
...I $P(^BGPINDNC(BGPPC,0),U,4)["014."!($P(^BGPINDNC(BGPPC,0),U,4)["023.")!($P(^BGPINDNC(BGPPC,0),U,4)["016.")!($P($G(^BGPINDNC(BGPPC,19)),U,13)) D I 1
....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
....W !?2,BGPSASU,?8,$E(BGPSNAM,1,12)
....W ?20,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U),7,0)
....W ?29,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0)
....W ?38,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0)
...E D
....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
....W !?2,BGPSASU,?8,$E(BGPSNAM,1,12)
....W ?20,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U),7,1),"%"
....W ?29,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1),"%"
....W ?38,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1),"%"
I $Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
W !!,"* Not GPRA Developmental measure but included to show percentage of"
W !,"refusals with respect to GPRA Developmental measure."
W !
D PART
Q
;
D HEADER^BGP9DPH
D H1
Q
H1 ;
I BGPRTYPE=1 S X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE DETAIL" W !,$$CTR(X,80)
W !?22," Site",?32,"Site",?40,"Site",?50,"Area",?60,"Nat'l"
W !?22,"Current",?32,"Prev",?40,"Base",?50,"Current",?60,"2008"
W !,$TR($J("",80)," ","-")
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):14,1:8)
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
.I $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 DETAIL PAGE DEVEL",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
..S BGPPC=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,0))
..Q:'$P($G(^BGPINDNC(BGPPC,22)),U,13)
..I $Y>(BGPIOSL-3) D HEADERP Q:BGPQUIT
..W !!?1,$P(^BGPINDNC(BGPPC,22),U,4)
..I $P(^BGPINDNC(BGPPC,22),U,7)]"" W !,$P(^BGPINDNC(BGPPC,22),U,7)
..I $P(^BGPINDNC(BGPPC,22),U,12)]"" W !,$P(^BGPINDNC(BGPPC,22),U,12)
..S F=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,0))
..S F=$P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,F),U,4)
..W ?50,F,$S($P(^BGPINDNC(BGPPC,0),U,4)["014."!($P(^BGPINDNC(BGPPC,0),U,4)["023.")!($P(^BGPINDNC(BGPPC,0),U,4)["016."):"",1:"%"),?60,$P(^BGPINDNC(BGPPC,22),U,P1),?65,$P(^BGPINDNC(BGPPC,22),U,2),?74,$P(^BGPINDNC(BGPPC,22),U,3)
..I $P(^BGPINDNC(BGPPC,22),U,9)]""!($P(^BGPINDNC(BGPPC,22),U,10)]"")!($P(^BGPINDNC(BGPPC,22),U,11)]"") W !?60,$TR($P(^BGPINDNC(BGPPC,22),U,9),"$","^"),?64,$TR($P(^BGPINDNC(BGPPC,22),U,10),"$","^"),?73,$P(^BGPINDNC(BGPPC,22),U,11)
..S BGPSN=0 F S BGPSN=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN!(BGPQUIT) D
...S BGPSASU=$P(^BGPGPDCN(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)) S BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCN(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
...I $P(^BGPINDNC(BGPPC,0),U,4)["014."!($P(^BGPINDNC(BGPPC,0),U,4)["023.")!($P(^BGPINDNC(BGPPC,0),U,4)["016.") D I 1
....I $Y>(BGPIOSL-3) D HEADERP Q:BGPQUIT
....W !?2,BGPSASU,?8,$E(BGPSNAM,1,12)
....W ?20,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U),7,0)
....W ?29,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0)
....W ?38,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0)
...E D
....I $Y>(BGPIOSL-3) D HEADERP Q:BGPQUIT
....W !?2,BGPSASU,?8,$E(BGPSNAM,1,12)
....W ?20,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U),7,1),"%"
....W ?29,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1),"%"
....W ?38,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1),"%"
I $Y>(BGPIOSL-5) D HEADERP Q:BGPQUIT
W !
I $G(BGPNGR09) D
.W !," * PART 2010 target represented here is a preliminary target since it will be"
.W !,"adjusted for FY 2009 actual results and FY 2010 appropriations."
W !,$S($G(BGPNGR09):"**",1:"*")," Federally Administered Activities measure. National 2008 rate is for federal"
W !,"sites only."
W ! Q
Q
;
D HEADER^BGP9DPH
D H1P
Q
H1P ;
I BGPRTYPE=1 S X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE DETAIL" W !,$$CTR(X,80)
W !?22," Site",?32,"Site",?40,"Site",?50,"Area",?60,$S($G(BGPNGR09):"PART10",1:"PART09"),?64,"Nat'l",?74,"2010"
W !?22,"Current",?32,"Prev",?40,"Base",?50,"Current",?60,"Target"_$S($G(BGPNGR09):"*",1:""),?65,"2008",?74,"Target"
W !,$TR($J("",80)," ","-")
W !!,"PART MEASURE"
W !,"------------"
Q
BGP9SDPD ; IHS/CMI/LAB - IHS summary page ;
+1 ;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
+2 ;
START ;
+1 IF '$GET(BGPAREAA)
QUIT
+2 IF BGPRTYPE'=1
QUIT
+3 SET BGPQUIT=""
+4 DO HEADER
+5 WRITE !!,"GPRA DEVELOPMENTAL MEASURES"
+6 WRITE !,"---------------------------"
+7 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC))
IF BGPC'=+BGPC!(BGPQUIT)
QUIT
Begin DoDot:1
+8 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+9 SET BGPC1=$ORDER(^BGPSCAT("D",BGPC,0))
+10 WRITE !
+11 WRITE !,$PIECE(^BGPSCAT(BGPC1,0),U)
+12 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:2
+13 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,0))
+14 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+15 ;part
IF $PIECE($GET(^BGPINDNC(BGPPC,22)),U,13)
QUIT
+16 WRITE !!?2,$PIECE(^BGPINDNC(BGPPC,22),U,4)
+17 IF $PIECE(^BGPINDNC(BGPPC,22),U,7)]""
WRITE !,$PIECE(^BGPINDNC(BGPPC,22),U,7)
+18 IF $PIECE(^BGPINDNC(BGPPC,22),U,12)]""
WRITE !,$PIECE(^BGPINDNC(BGPPC,22),U,12)
+19 SET F=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,0))
+20 SET F=$PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,F),U,4)
+21 WRITE ?50,F,$SELECT($PIECE(^BGPINDNC(BGPPC,0),U,4)["014."!($PIECE(^BGPINDNC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDNC(BGPPC,0),U,4)["016.")!($PIECE($GET(^BGPINDNC(BGPPC,19)),U,13)):"",1:"%")
+22 ;,?65,$P(^BGPINDNC(BGPPC,22),U,3)
WRITE ?60,$PIECE(^BGPINDNC(BGPPC,22),U,2)
+23 ;,?65,$P(^BGPINDNC(BGPPC,22),U,11)
IF $PIECE(^BGPINDNC(BGPPC,22),U,9)]""!($PIECE(^BGPINDNC(BGPPC,22),U,10)]"")!($PIECE(^BGPINDNC(BGPPC,22),U,11)]"")
WRITE !?60,$TRANSLATE($PIECE(^BGPINDNC(BGPPC,22),U,10),"$","^")
+24 SET BGPSN=0
FOR
SET BGPSN=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN))
IF BGPSN'=+BGPSN!(BGPQUIT)
QUIT
Begin DoDot:3
+25 SET BGPSASU=$PIECE(^BGPGPDCN(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(^BGPGPDCN(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
+26 IF $PIECE(^BGPINDNC(BGPPC,0),U,4)["014."!($PIECE(^BGPINDNC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDNC(BGPPC,0),U,4)["016.")!($PIECE($GET(^BGPINDNC(BGPPC,19)),U,13))
Begin DoDot:4
+27 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+28 WRITE !?2,BGPSASU,?8,$EXTRACT(BGPSNAM,1,12)
+29 WRITE ?20,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U),7,0)
+30 WRITE ?29,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0)
+31 WRITE ?38,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0)
End DoDot:4
IF 1
+32 IF '$TEST
Begin DoDot:4
+33 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+34 WRITE !?2,BGPSASU,?8,$EXTRACT(BGPSNAM,1,12)
+35 WRITE ?20,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U),7,1),"%"
+36 WRITE ?29,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1),"%"
+37 WRITE ?38,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1),"%"
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+38 IF $Y>(BGPIOSL-2)
DO HEADER
IF BGPQUIT
QUIT
+39 WRITE !!,"* Not GPRA Developmental measure but included to show percentage of"
+40 WRITE !,"refusals with respect to GPRA Developmental measure."
+41 WRITE !
+42 DO PART
+43 QUIT
+44 ;
+1 DO HEADER^BGP9DPH
+2 DO H1
+3 QUIT
H1 ;
+1 IF BGPRTYPE=1
SET X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE DETAIL"
WRITE !,$$CTR(X,80)
+2 WRITE !?22," Site",?32,"Site",?40,"Site",?50,"Area",?60,"Nat'l"
+3 WRITE !?22,"Current",?32,"Prev",?40,"Base",?50,"Current",?60,"2008"
+4 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+5 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 SET P1=$SELECT($GET(BGPNGR09):14,1:8)
+3 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC))
IF BGPC'=+BGPC!(BGPQUIT)
QUIT
Begin DoDot:1
+4 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 DETAIL PAGE DEVEL",BGPC,BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:2
+9 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,0))
+10 IF '$PIECE($GET(^BGPINDNC(BGPPC,22)),U,13)
QUIT
+11 IF $Y>(BGPIOSL-3)
DO HEADERP
IF BGPQUIT
QUIT
+12 WRITE !!?1,$PIECE(^BGPINDNC(BGPPC,22),U,4)
+13 IF $PIECE(^BGPINDNC(BGPPC,22),U,7)]""
WRITE !,$PIECE(^BGPINDNC(BGPPC,22),U,7)
+14 IF $PIECE(^BGPINDNC(BGPPC,22),U,12)]""
WRITE !,$PIECE(^BGPINDNC(BGPPC,22),U,12)
+15 SET F=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,0))
+16 SET F=$PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,F),U,4)
+17 WRITE ?50,F,$SELECT($PIECE(^BGPINDNC(BGPPC,0),U,4)["014."!($PIECE(^BGPINDNC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDNC(BGPPC,0),U,4)["016."):"",1:"%"),?60,$PIECE(^BGPINDNC(BGPPC,22),U,P1),?65,$PIECE(^BGPINDNC(BGPPC,22),U,2),?74,...
... $PIECE(^BGPINDNC(BGPPC,22),U,3)
+18 IF $PIECE(^BGPINDNC(BGPPC,22),U,9)]""!($PIECE(^BGPINDNC(BGPPC,22),U,10)]"")!($PIECE(^BGPINDNC(BGPPC,22),U,11)]"")
WRITE !?60,$TRANSLATE($PIECE(^BGPINDNC(BGPPC,22),U,9),"$","^"),?64,$TRANSLATE($PIECE(^BGPINDNC(BGPPC,22),U,10),"$","^"),?73,$PIECE(^BGPINDNC(BGPPC,22),U,11)
+19 SET BGPSN=0
FOR
SET BGPSN=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN))
IF BGPSN'=+BGPSN!(BGPQUIT)
QUIT
Begin DoDot:3
+20 SET BGPSASU=$PIECE(^BGPGPDCN(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(^BGPGPDCN(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
+21 IF $PIECE(^BGPINDNC(BGPPC,0),U,4)["014."!($PIECE(^BGPINDNC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDNC(BGPPC,0),U,4)["016.")
Begin DoDot:4
+22 IF $Y>(BGPIOSL-3)
DO HEADERP
IF BGPQUIT
QUIT
+23 WRITE !?2,BGPSASU,?8,$EXTRACT(BGPSNAM,1,12)
+24 WRITE ?20,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U),7,0)
+25 WRITE ?29,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0)
+26 WRITE ?38,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0)
End DoDot:4
IF 1
+27 IF '$TEST
Begin DoDot:4
+28 IF $Y>(BGPIOSL-3)
DO HEADERP
IF BGPQUIT
QUIT
+29 WRITE !?2,BGPSASU,?8,$EXTRACT(BGPSNAM,1,12)
+30 WRITE ?20,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U),7,1),"%"
+31 WRITE ?29,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1),"%"
+32 WRITE ?38,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1),"%"
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+33 IF $Y>(BGPIOSL-5)
DO HEADERP
IF BGPQUIT
QUIT
+34 WRITE !
+35 IF $GET(BGPNGR09)
Begin DoDot:1
+36 WRITE !," * PART 2010 target represented here is a preliminary target since it will be"
+37 WRITE !,"adjusted for FY 2009 actual results and FY 2010 appropriations."
End DoDot:1
+38 WRITE !,$SELECT($GET(BGPNGR09):"**",1:"*")," Federally Administered Activities measure. National 2008 rate is for federal"
+39 WRITE !,"sites only."
+40 WRITE !
QUIT
+41 QUIT
+42 ;
+1 DO HEADER^BGP9DPH
+2 DO H1P
+3 QUIT
H1P ;
+1 IF BGPRTYPE=1
SET X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE DETAIL"
WRITE !,$$CTR(X,80)
+2 WRITE !?22," Site",?32,"Site",?40,"Site",?50,"Area",?60,$SELECT($GET(BGPNGR09):"PART10",1:"PART09"),?64,"Nat'l",?74,"2010"
+3 WRITE !?22,"Current",?32,"Prev",?40,"Base",?50,"Current",?60,"Target"_$SELECT($GET(BGPNGR09):"*",1:""),?65,"2008",?74,"Target"
+4 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+5 WRITE !!,"PART MEASURE"
+6 WRITE !,"------------"
+7 QUIT
