BGP3DSPD ; IHS/CMI/LAB - IHS summary page ;
;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
;
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
D W^BGP3DP("GPRA DEVELOPMENTAL MEASURES",0,2,BGPPTYPE)
D W^BGP3DP("---------------------------",0,1,BGPPTYPE)
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY DEVEL",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^BGP3DP("",0,1,BGPPTYPE)
.D W^BGP3DP($P(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
..S BGPPC=$O(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,0))
..Q:$P($G(^BGPINDHC(BGPPC,22)),U,13) ;part measure displays last
..I BGPPTYPE="P",$Y>(BGPIOSL-4) D HEADER Q:BGPQUIT
..I $P(^BGPINDHC(BGPPC,0),U,4)["014.A"!($P(^BGPINDHC(BGPPC,0),U,4)["023.")!($P(^BGPINDHC(BGPPC,0),U,4)="016.A.1")!($P(^BGPINDHC(BGPPC,0),U,4)="016.A.5")!($P($G(^BGPINDHC(BGPPC,19)),U,13)) D I 1
...D W^BGP3DP($P(^BGPINDHC(BGPPC,22),U,4),0,1,BGPPTYPE,1,1)
...I $P(^BGPINDHC(BGPPC,22),U,7)]"" D W^BGP3DP($P(^BGPINDHC(BGPPC,22),U,7),0,1,BGPPTYPE,1,1) ;W !?1,$P(^BGPINDHC(BGPPC,22),U,7)
...I $P(^BGPINDHC(BGPPC,22),U,12)]"" D W^BGP3DP($P(^BGPINDHC(BGPPC,22),U,12),0,1,BGPPTYPE,1,1)
...I BGPPTYPE="P" D
....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U),7,0),0,0,BGPPTYPE,1,28)
....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,2),7,0),0,0,BGPPTYPE,1,36)
....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,3),7,0),0,0,BGPPTYPE,1,43)
....;D W^BGP3DP($P(^BGPINDHC(BGPPC,22),U,2),0,0,BGPPTYPE,1,57)
...I BGPPTYPE="D" D
....D W^BGP3DP($P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U),0,0,BGPPTYPE,2)
....D W^BGP3DP($P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2),0,0,BGPPTYPE,3)
....D W^BGP3DP($P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3),0,0,BGPPTYPE,4)
....D W^BGP3DP($P(^BGPINDHC(BGPPC,22),U,2),0,0,BGPPTYPE,5)
....;D S(X,1,1)
..E D
...D W^BGP3DP($P(^BGPINDHC(BGPPC,22),U,4),0,1,BGPPTYPE,1,1)
...I $P(^BGPINDHC(BGPPC,22),U,7)]"" D W^BGP3DP($P(^BGPINDHC(BGPPC,22),U,7),0,1,BGPPTYPE,1,1) ;W !?1,$P(^BGPINDHC(BGPPC,22),U,7)
...I $P(^BGPINDHC(BGPPC,22),U,12)]"" D W^BGP3DP($P(^BGPINDHC(BGPPC,22),U,12),0,1,BGPPTYPE,1,1) ;W !?1,$P(^BGPINDHC(BGPPC,22),U,7)
...I BGPPTYPE="P" D
....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U),7,1)_"%",0,0,BGPPTYPE,1,28)
....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,2),7,1)_"%",0,0,BGPPTYPE,1,36)
....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,3),7,1)_"%",0,0,BGPPTYPE,1,43)
....;D W^BGP3DP($TR($P(^BGPINDHC(BGPPC,22),U,2),"$","^"),0,0,BGPPTYPE,1,57)
...I BGPPTYPE="D" D
....D W^BGP3DP($P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U)_"%",0,0,BGPPTYPE,2,28)
....D W^BGP3DP($P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2)_"%",0,0,BGPPTYPE,3,36)
....D W^BGP3DP($P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3)_"%",0,0,BGPPTYPE,4,43)
....;D W^BGP3DP($TR($P(^BGPINDHC(BGPPC,22),U,2),"$","^"),0,0,BGPPTYPE,5,57)
...I $P(^BGPINDHC(BGPPC,22),U,9)]""!($P(^BGPINDHC(BGPPC,22),U,10)]"")!($P(^BGPINDHC(BGPPC,22),U,11)]"") D
....;D W^BGP3DP($TR($P(^BGPINDHC(BGPPC,22),U,10),"$","^"),0,0,BGPPTYPE,5,57),W^BGP3DP($P(^BGPINDHC(BGPPC,22),U,11),0,0,BGPPTYPE,6,68)
....D W^BGP3DP("",0,0,BGPPTYPE)
I BGPPTYPE="P",$Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
D W^BGP3DP("* Not GPRA Developmental measure but included to show percentage of",0,2,BGPPTYPE)
D W^BGP3DP("refusals with respect to GPRA Developmental measure.",0,1,BGPPTYPE)
D W^BGP3DP("",0,1,BGPPTYPE)
Q
;D PART
;Q
;
D HEADER^BGP3DPH
D H1
Q
H1 ;
S X="GPRA DEVELOPMENTAL CLINICAL PERFORMANCE SUMMARY" D W^BGP3DP(X,1,1,BGPPTYPE)
I $G(BGPAREAA) D W^BGP3DP("Area",0,1,BGPPTYPE,2,29),W^BGP3DP("Area",0,0,BGPPTYPE,3,38),W^BGP3DP("Area",0,0,BGPPTYPE,4,47) ;,W^BGP3DP("Nat'l",0,0,BGPPTYPE,5,57)
I '$G(BGPAREAA) D W^BGP3DP("Site",0,1,BGPPTYPE,2,29),W^BGP3DP("Site",0,0,BGPPTYPE,3,38),W^BGP3DP("Site",0,0,BGPPTYPE,4,47) ;,W^BGP3DP("Nat'l",0,0,BGPPTYPE,5,57)
D W^BGP3DP("Current",0,1,BGPPTYPE,2,29),W^BGP3DP("Previous",0,0,BGPPTYPE,3,37),W^BGP3DP("Baseline",0,0,BGPPTYPE,4,46) ;,W^BGP3DP("2012",0,0,BGPPTYPE,5,57)
D W^BGP3DP($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):14,1:8)
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY 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 DEVEL",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
..S BGPPC=$O(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,0))
..Q:'$P($G(^BGPINDHC(BGPPC,22)),U,13) ;part measures only
..I $Y>(BGPIOSL-4) D HEADERP Q:BGPQUIT
..I $P(^BGPINDHC(BGPPC,0),U,4)["014.A"!($P(^BGPINDHC(BGPPC,0),U,4)["023.")!($P(^BGPINDHC(BGPPC,0),U,4)["016")!($P($G(^BGPINDHC(BGPPC,19)),U,13)) D I 1
...W !,$P(^BGPINDHC(BGPPC,22),U,4)
...I $P(^BGPINDHC(BGPPC,22),U,7)]"" W !,$P(^BGPINDHC(BGPPC,22),U,7)
...I $P(^BGPINDHC(BGPPC,22),U,12)]"" W !,$P(^BGPINDHC(BGPPC,22),U,12)
...W ?28,$J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U),7,0)
...W ?36,$J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,2),7,0)
...W ?43,$J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,3),7,0)
...W ?53,$P(^BGPINDHC(BGPPC,22),U,P1),?64,$P(^BGPINDHC(BGPPC,22),U,2),?73,$P(^BGPINDHC(BGPPC,22),U,3)
..E D
...W !,$P(^BGPINDHC(BGPPC,22),U,4)
...I $P(^BGPINDHC(BGPPC,22),U,7)]"" W !,$P(^BGPINDHC(BGPPC,22),U,7)
...I $P(^BGPINDHC(BGPPC,22),U,12)]"" W !,$P(^BGPINDHC(BGPPC,22),U,12)
...W ?28,$J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U),7,1),"%"
...W ?36,$J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,2),7,1),"%"
...W ?43,$J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,3),7,1),"%"
...W ?53,$TR($P(^BGPINDHC(BGPPC,22),U,P1),"$","^"),?64,$TR($P(^BGPINDHC(BGPPC,22),U,2),"$","^"),?73,$P(^BGPINDHC(BGPPC,22),U,3)
...I $P(^BGPINDHC(BGPPC,22),U,9)]""!($P(^BGPINDHC(BGPPC,22),U,10)]"")!($P(^BGPINDHC(BGPPC,22),U,11)]"") W !?53,$TR($P(^BGPINDHC(BGPPC,22),U,9),"$","^"),?64,$TR($P(^BGPINDHC(BGPPC,22),U,10),"$","^"),?73,$P(^BGPINDHC(BGPPC,22),U,11)
I $Y>(BGPIOSL-9) D HEADERP Q:BGPQUIT
W !
I $G(BGPNGR09) D
.W !," * PART 2014 target represented here is a preliminary target since it will be"
.W !,"adjusted for FY 2013 actual results and FY 2014 appropriations."
W !,$S($G(BGPNGR09):"**",1:"*")," Federally Administered Activities measure. National 2012 rate is for federal"
W !,"sites only."
W ! Q
;
D HEADER^BGP3DPH
D H1P
Q
H1P ;
S X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE SUMMARY" W !,$$CTR(X,80)
I $G(BGPAREAA) W !?28," Area",?36," Area",?45," Area",?53,$S($G(BGPNGR09):"PART",1:"PART"),?64,"Nat'l",?73,"2013"
I '$G(BGPAREAA) W !?28," Site",?36," Site",?45," Site",?53,$S($G(BGPNGR09):"PART",1:"PART"),?64,"Nat'l",?73,"2013"
W !?28,"Current",?36,"Previous",?45,"Baseline",?53,"Target",?64,"2012",?73,"Target"
W !,$TR($J("",80)," ","-")
W !!,"PART MEASURE"
W !,"------------"
W !
Q
BGP3DSPD ; IHS/CMI/LAB - IHS summary page ;
+1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
+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 DO W^BGP3DP("GPRA DEVELOPMENTAL MEASURES",0,2,BGPPTYPE)
+7 DO W^BGP3DP("---------------------------",0,1,BGPPTYPE)
+8 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARY DEVEL",BGPC))
IF BGPC'=+BGPC!(BGPQUIT)
QUIT
Begin DoDot:1
+9 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+10 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+11 DO W^BGP3DP("",0,1,BGPPTYPE)
+12 DO W^BGP3DP($PIECE(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
+13 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:2
+14 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,0))
+15 ;part measure displays last
IF $PIECE($GET(^BGPINDHC(BGPPC,22)),U,13)
QUIT
+16 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-4)
DO HEADER
IF BGPQUIT
QUIT
+17 IF $PIECE(^BGPINDHC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDHC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDHC(BGPPC,0),U,4)="016.A.1")!($PIECE(^BGPINDHC(BGPPC,0),U,4)="016.A.5")!($PIECE($GET(^BGPINDHC(BGPPC,19)),U,13))
Begin DoDot:3
+18 DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,22),U,4),0,1,BGPPTYPE,1,1)
+19 ;W !?1,$P(^BGPINDHC(BGPPC,22),U,7)
IF $PIECE(^BGPINDHC(BGPPC,22),U,7)]""
DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,22),U,7),0,1,BGPPTYPE,1,1)
+20 IF $PIECE(^BGPINDHC(BGPPC,22),U,12)]""
DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,22),U,12),0,1,BGPPTYPE,1,1)
+21 IF BGPPTYPE="P"
Begin DoDot:4
+22 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U),7,0),0,0,BGPPTYPE,1,28)
+23 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,2),7,0),0,0,BGPPTYPE,1,36)
+24 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,3),7,0),0,0,BGPPTYPE,1,43)
+25 ;D W^BGP3DP($P(^BGPINDHC(BGPPC,22),U,2),0,0,BGPPTYPE,1,57)
End DoDot:4
+26 IF BGPPTYPE="D"
Begin DoDot:4
+27 DO W^BGP3DP($PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U),0,0,BGPPTYPE,2)
+28 DO W^BGP3DP($PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2),0,0,BGPPTYPE,3)
+29 DO W^BGP3DP($PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3),0,0,BGPPTYPE,4)
+30 DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,22),U,2),0,0,BGPPTYPE,5)
+31 ;D S(X,1,1)
End DoDot:4
End DoDot:3
IF 1
+32 IF '$TEST
Begin DoDot:3
+33 DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,22),U,4),0,1,BGPPTYPE,1,1)
+34 ;W !?1,$P(^BGPINDHC(BGPPC,22),U,7)
IF $PIECE(^BGPINDHC(BGPPC,22),U,7)]""
DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,22),U,7),0,1,BGPPTYPE,1,1)
+35 ;W !?1,$P(^BGPINDHC(BGPPC,22),U,7)
IF $PIECE(^BGPINDHC(BGPPC,22),U,12)]""
DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,22),U,12),0,1,BGPPTYPE,1,1)
+36 IF BGPPTYPE="P"
Begin DoDot:4
+37 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U),7,1)_"%",0,0,BGPPTYPE,1,28)
+38 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,2),7,1)_"%",0,0,BGPPTYPE,1,36)
+39 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,3),7,1)_"%",0,0,BGPPTYPE,1,43)
+40 ;D W^BGP3DP($TR($P(^BGPINDHC(BGPPC,22),U,2),"$","^"),0,0,BGPPTYPE,1,57)
End DoDot:4
+41 IF BGPPTYPE="D"
Begin DoDot:4
+42 DO W^BGP3DP($PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U)_"%",0,0,BGPPTYPE,2,28)
+43 DO W^BGP3DP($PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2)_"%",0,0,BGPPTYPE,3,36)
+44 DO W^BGP3DP($PIECE(^TMP($JOB,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3)_"%",0,0,BGPPTYPE,4,43)
+45 ;D W^BGP3DP($TR($P(^BGPINDHC(BGPPC,22),U,2),"$","^"),0,0,BGPPTYPE,5,57)
End DoDot:4
+46 IF $PIECE(^BGPINDHC(BGPPC,22),U,9)]""!($PIECE(^BGPINDHC(BGPPC,22),U,10)]"")!($PIECE(^BGPINDHC(BGPPC,22),U,11)]"")
Begin DoDot:4
+47 ;D W^BGP3DP($TR($P(^BGPINDHC(BGPPC,22),U,10),"$","^"),0,0,BGPPTYPE,5,57),W^BGP3DP($P(^BGPINDHC(BGPPC,22),U,11),0,0,BGPPTYPE,6,68)
+48 DO W^BGP3DP("",0,0,BGPPTYPE)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+49 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-2)
DO HEADER
IF BGPQUIT
QUIT
+50 DO W^BGP3DP("* Not GPRA Developmental measure but included to show percentage of",0,2,BGPPTYPE)
+51 DO W^BGP3DP("refusals with respect to GPRA Developmental measure.",0,1,BGPPTYPE)
+52 DO W^BGP3DP("",0,1,BGPPTYPE)
+53 QUIT
+54 ;D PART
+55 ;Q
+56 ;
+1 DO HEADER^BGP3DPH
+2 DO H1
+3 QUIT
H1 ;
+1 SET X="GPRA DEVELOPMENTAL CLINICAL PERFORMANCE SUMMARY"
DO W^BGP3DP(X,1,1,BGPPTYPE)
+2 ;,W^BGP3DP("Nat'l",0,0,BGPPTYPE,5,57)
IF $GET(BGPAREAA)
DO W^BGP3DP("Area",0,1,BGPPTYPE,2,29)
DO W^BGP3DP("Area",0,0,BGPPTYPE,3,38)
DO W^BGP3DP("Area",0,0,BGPPTYPE,4,47)
+3 ;,W^BGP3DP("Nat'l",0,0,BGPPTYPE,5,57)
IF '$GET(BGPAREAA)
DO W^BGP3DP("Site",0,1,BGPPTYPE,2,29)
DO W^BGP3DP("Site",0,0,BGPPTYPE,3,38)
DO W^BGP3DP("Site",0,0,BGPPTYPE,4,47)
+4 ;,W^BGP3DP("2012",0,0,BGPPTYPE,5,57)
DO W^BGP3DP("Current",0,1,BGPPTYPE,2,29)
DO W^BGP3DP("Previous",0,0,BGPPTYPE,3,37)
DO W^BGP3DP("Baseline",0,0,BGPPTYPE,4,46)
+5 DO W^BGP3DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+6 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 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 DEVEL",BGPC,BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:2
+9 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,0))
+10 ;part measures only
IF '$PIECE($GET(^BGPINDHC(BGPPC,22)),U,13)
QUIT
+11 IF $Y>(BGPIOSL-4)
DO HEADERP
IF BGPQUIT
QUIT
+12 IF $PIECE(^BGPINDHC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDHC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDHC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDHC(BGPPC,19)),U,13))
Begin DoDot:3
+13 WRITE !,$PIECE(^BGPINDHC(BGPPC,22),U,4)
+14 IF $PIECE(^BGPINDHC(BGPPC,22),U,7)]""
WRITE !,$PIECE(^BGPINDHC(BGPPC,22),U,7)
+15 IF $PIECE(^BGPINDHC(BGPPC,22),U,12)]""
WRITE !,$PIECE(^BGPINDHC(BGPPC,22),U,12)
+16 WRITE ?28,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U),7,0)
+17 WRITE ?36,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,2),7,0)
+18 WRITE ?43,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,3),7,0)
+19 WRITE ?53,$PIECE(^BGPINDHC(BGPPC,22),U,P1),?64,$PIECE(^BGPINDHC(BGPPC,22),U,2),?73,$PIECE(^BGPINDHC(BGPPC,22),U,3)
End DoDot:3
IF 1
+20 IF '$TEST
Begin DoDot:3
+21 WRITE !,$PIECE(^BGPINDHC(BGPPC,22),U,4)
+22 IF $PIECE(^BGPINDHC(BGPPC,22),U,7)]""
WRITE !,$PIECE(^BGPINDHC(BGPPC,22),U,7)
+23 IF $PIECE(^BGPINDHC(BGPPC,22),U,12)]""
WRITE !,$PIECE(^BGPINDHC(BGPPC,22),U,12)
+24 WRITE ?28,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U),7,1),"%"
+25 WRITE ?36,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,2),7,1),"%"
+26 WRITE ?43,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,3),7,1),"%"
+27 WRITE ?53,$TRANSLATE($PIECE(^BGPINDHC(BGPPC,22),U,P1),"$","^"),?64,$TRANSLATE($PIECE(^BGPINDHC(BGPPC,22),U,2),"$","^"),?73,$PIECE(^BGPINDHC(BGPPC,22),U,3)
+28 IF $PIECE(^BGPINDHC(BGPPC,22),U,9)]""!($PIECE(^BGPINDHC(BGPPC,22),U,10)]"")!($PIECE(^BGPINDHC(BGPPC,22),U,11)]"")
WRITE !?53,$TRANSLATE($PIECE(^BGPINDHC(BGPPC,22),U,9),"$","^"),?64,$TRANSLATE($PIECE(^BGPINDHC(BGPPC,22),U,10),"$","^"),?73,$PIECE(^BGPINDHC(BGPPC,22),U,11)
End DoDot:3
End DoDot:2
End DoDot:1
+29 IF $Y>(BGPIOSL-9)
DO HEADERP
IF BGPQUIT
QUIT
+30 WRITE !
+31 IF $GET(BGPNGR09)
Begin DoDot:1
+32 WRITE !," * PART 2014 target represented here is a preliminary target since it will be"
+33 WRITE !,"adjusted for FY 2013 actual results and FY 2014 appropriations."
End DoDot:1
+34 WRITE !,$SELECT($GET(BGPNGR09):"**",1:"*")," Federally Administered Activities measure. National 2012 rate is for federal"
+35 WRITE !,"sites only."
+36 WRITE !
QUIT
+37 ;
+1 DO HEADER^BGP3DPH
+2 DO H1P
+3 QUIT
H1P ;
+1 SET X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE SUMMARY"
WRITE !,$$CTR(X,80)
+2 IF $GET(BGPAREAA)
WRITE !?28," Area",?36," Area",?45," Area",?53,$SELECT($GET(BGPNGR09):"PART",1:"PART"),?64,"Nat'l",?73,"2013"
+3 IF '$GET(BGPAREAA)
WRITE !?28," Site",?36," Site",?45," Site",?53,$SELECT($GET(BGPNGR09):"PART",1:"PART"),?64,"Nat'l",?73,"2013"
+4 WRITE !?28,"Current",?36,"Previous",?45,"Baseline",?53,"Target",?64,"2012",?73,"Target"
+5 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+6 WRITE !!,"PART MEASURE"
+7 WRITE !,"------------"
+8 WRITE !
+9 QUIT
