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