BGP3SDP ; IHS/CMI/LAB - IHS summary page 11 Dec 2006 1:24 PM ;
;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
;
START ;
I '$G(BGPAREAA) Q
I BGPRTYPE'=1 Q
S BGPQUIT="",BGPGPG=0
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 DETAIL PAGE",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
.I $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 DETAIL PAGE",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
..S BGPPC=$O(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,0))
..Q:$P($G(^BGPINDHC(BGPPC,22)),U,13)
..I BGPPTYPE="P" D
...I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
...D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,P4),0,2,BGPPTYPE,,1)
...I $P(^BGPINDHC(BGPPC,14),U,P7)]"" D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,P7),0,1,BGPPTYPE)
...I $P(^BGPINDHC(BGPPC,14),U,P12)]"" D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,P12),0,1,BGPPTYPE)
...S F=$O(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,0))
...S F=$P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
...D W^BGP3DP(F_$S($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"):"",1:"%"),0,0,BGPPTYPE,,46)
...D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,P8),0,0,BGPPTYPE,,55)
...D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,2),0,0,BGPPTYPE,,65)
...D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,3),0,0,BGPPTYPE,,74)
...I $P(^BGPINDHC(BGPPC,14),U,9)]""!($P(^BGPINDHC(BGPPC,14),U,10)]"")!($P(^BGPINDHC(BGPPC,14),U,11)]"") D
....D W^BGP3DP($TR($P(^BGPINDHC(BGPPC,14),U,9),"$","^"),0,0,BGPPTYPE,,55)
....D W^BGP3DP($TR($P(^BGPINDHC(BGPPC,14),U,10),"$","^"),0,0,BGPPTYPE,,64)
....;D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,11),0,0,BGPPTYPE,,73)
...S BGPSN=0 F S BGPSN=$O(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN!(BGPQUIT) D
....S BGPSASU=$P(^BGPGPDCH(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)) S BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCH(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
....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") D I 1
.....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
.....D W^BGP3DP(BGPSASU,0,1,BGPPTYPE,,2),W^BGP3DP($E(BGPSNAM,1,12),0,0,BGPPTYPE,,8)
.....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,0),0,0,BGPPTYPE,,20)
.....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0),0,0,BGPPTYPE,,29)
.....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0),0,0,BGPPTYPE,,38)
....E D
.....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
.....D W^BGP3DP(BGPSASU,0,1,BGPPTYPE,,2),W^BGP3DP($E(BGPSNAM,1,12),0,0,BGPPTYPE,,8)
.....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,1)_"%",0,0,BGPPTYPE,,20)
.....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1)_"%",0,0,BGPPTYPE,,29)
.....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1)_"%",0,0,BGPPTYPE,,38)
..I BGPPTYPE="D" D
...D W^BGP3DP("",0,1,BGPPTYPE)
...S XX=" "_$P(^BGPINDHC(BGPPC,14),U,4)
...I $P(^BGPINDHC(BGPPC,14),U,7)]"" D W^BGP3DP(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPINDHC(BGPPC,14),U,7)
...I $P(^BGPINDHC(BGPPC,14),U,12)]"" D W^BGP3DP(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPINDHC(BGPPC,14),U,12)
...S F=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,0))
...S F=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
...S $P(XX,U,5)=F_$S($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)):"",1:"%")
...S $P(XX,U,6)=$P(^BGPINDHC(BGPPC,14),U,P8)
...S $P(XX,U,7)=$P(^BGPINDHC(BGPPC,14),U,2) ;,$P(XX,U,7)=$P(^BGPINDHC(BGPPC,14),U,3)
...S $P(XX,U,8)=$P(^BGPINDHC(BGPPC,14),U,3)
...;S $P(XX,U,6)=$P(^BGPINDNC(BGPPC,14),U,P8),$P(XX,U,7)=$P(^BGPINDNC(BGPPC,14),U,2),$P(XX,U,8)=$P(^BGPINDNC(BGPPC,14),U,3)
...S BGPSN=0,BGPCNT=0 F S BGPSN=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN S BGPCNT=BGPCNT+1 D
....S BGPSASU=$P(^BGPGPDCH(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCH(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
....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
.....S X="",$P(X,U,1)=BGPSASU_" "_BGPSNAM
.....S $P(X,U,2)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U)
.....S $P(X,U,3)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)
.....S $P(X,U,4)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)
.....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",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",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
.....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
.....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
....I BGPCNT=1 D W^BGP3DP(XX,0,1,BGPPTYPE,1)
....S Y="" I $P(^BGPINDHC(BGPPC,14),U,9)]""!($P(^BGPINDHC(BGPPC,14),U,10)]"")!($P(^BGPINDHC(BGPPC,14),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPINDHC(BGPPC,14),U,9),"$","^") D
.....S $P(Y,U,8)=$P(^BGPINDHC(BGPPC,14),U,11)
....I Y]"" D W^BGP3DP(Y,0,1,BGPPTYPE,1) ;D S(Y,1,1)
....D W^BGP3DP(X,0,1,BGPPTYPE,1) ;D S(X,1,1)
...;D W^BGP3DP(" ",0,1,BGPPTYPE) ;S X=" " D S(X,1,1)
I BGPPTYPE="P",$Y>(BGPIOSL-9) D HEADER Q:BGPQUIT
;I $G(BGPNGR09) D FOOTER10^BGP3DSP Q
D W^BGP3DP(" * Measure definition changed in 2007.",0,2,BGPPTYPE)
D W^BGP3DP("** Measure definition changed in 2013.",0,2,BGPPTYPE)
;D W^BGP3DP("** Not official GPRA measure but included to show percentage of refusals with",0,2,BGPPTYPE),W^BGP3DP("respect to GPRA measure.",0,1,BGPPTYPE)
;D W^BGP3DP(" + Site Previous and Site Baseline values are not applicable for this measure.",0,2,BGPPTYPE)
D W^BGP3DP("",0,0,BGPPTYPE)
;D PART
Q
;
D HEADER^BGP3DPH
D H1
Q
H1 ;
S X="OFFICIAL GPRA/GPRAMA MEASURES CLINICAL PERFORMANCE DETAIL" D W^BGP3DP(X,1,1,BGPPTYPE)
D W^BGP3DP("Site",0,1,BGPPTYPE,2,21),W^BGP3DP("Site",0,0,BGPPTYPE,3,32),W^BGP3DP("Site",0,0,BGPPTYPE,4,40),W^BGP3DP("Area",0,0,BGPPTYPE,5,46) D
.D W^BGP3DP($S('$G(BGPNGR09):"GPRA",1:"GPRA"),0,0,BGPPTYPE,6,55),W^BGP3DP("Nat'l",0,0,BGPPTYPE,7,64),W^BGP3DP("2020",0,0,BGPPTYPE,8,74)
D W^BGP3DP("Current",0,1,BGPPTYPE,2,21),W^BGP3DP("Prev",0,0,BGPPTYPE,3,32),W^BGP3DP("Base",0,0,BGPPTYPE,4,40) D
.D W^BGP3DP("Current",0,0,BGPPTYPE,5,46),W^BGP3DP("Target"_$S($G(BGPNGR09):"",1:""),0,0,BGPPTYPE,6,55),W^BGP3DP("2012",0,0,BGPPTYPE,7,65),W^BGP3DP("Target",0,0,BGPPTYPE,8,74)
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):8,1:8)
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY DETAIL PAGE",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 DETAIL PAGE",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
..S BGPPC=$O(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,0))
..Q:'$P($G(^BGPINDHC(BGPPC,22)),U,13)
..I BGPPTYPE="P" D
...I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
...D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,P4),0,2,BGPPTYPE,,1)
...I $P(^BGPINDHC(BGPPC,14),U,P7)]"" D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,P7),0,1,BGPPTYPE)
...I $P(^BGPINDHC(BGPPC,14),U,P12)]"" D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,P12),0,1,BGPPTYPE)
...S F=$O(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,0))
...S F=$P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
...D W^BGP3DP(F_$S($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"):"",1:"%"),0,0,BGPPTYPE,,46)
...D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,P8),0,0,BGPPTYPE,,56)
...D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,2),0,0,BGPPTYPE,,65)
...;D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,3),0,0,BGPPTYPE,,74)
...I $P(^BGPINDHC(BGPPC,14),U,9)]""!($P(^BGPINDHC(BGPPC,14),U,10)]"")!($P(^BGPINDHC(BGPPC,14),U,11)]"") D
....D W^BGP3DP($TR($P(^BGPINDHC(BGPPC,14),U,9),"$","^"),0,0,BGPPTYPE,,55)
....D W^BGP3DP($TR($P(^BGPINDHC(BGPPC,14),U,10),"$","^"),0,0,BGPPTYPE,,64)
....;D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,11),0,0,BGPPTYPE,,73)
...S BGPSN=0 F S BGPSN=$O(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN!(BGPQUIT) D
....S BGPSASU=$P(^BGPGPDCH(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)) S BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCH(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
....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") D I 1
.....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
.....D W^BGP3DP(BGPSASU,0,1,BGPPTYPE,,2),W^BGP3DP($E(BGPSNAM,1,12),0,0,BGPPTYPE,,8)
.....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,0),0,0,BGPPTYPE,,20)
.....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0),0,0,BGPPTYPE,,29)
.....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0),0,0,BGPPTYPE,,38)
....E D
.....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
.....D W^BGP3DP(BGPSASU,0,1,BGPPTYPE,,2),W^BGP3DP($E(BGPSNAM,1,12),0,0,BGPPTYPE,,8)
.....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,1)_"%",0,0,BGPPTYPE,,20)
.....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1)_"%",0,0,BGPPTYPE,,29)
.....D W^BGP3DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1)_"%",0,0,BGPPTYPE,,38)
..I BGPPTYPE="D" D
...D W^BGP3DP("",0,1,BGPPTYPE)
...S XX=" "_$P(^BGPINDHC(BGPPC,14),U,4)
...I $P(^BGPINDHC(BGPPC,14),U,7)]"" D W^BGP3DP(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPINDHC(BGPPC,14),U,7)
...I $P(^BGPINDHC(BGPPC,14),U,12)]"" D W^BGP3DP(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPINDHC(BGPPC,14),U,12)
...S F=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,0))
...S F=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
...S $P(XX,U,5)=F_$S($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($G(^BGPINDHC(BGPPC,19)),U,13)):"",1:"%")
...S $P(XX,U,6)=$P(^BGPINDHC(BGPPC,14),U,8),$P(XX,U,7)=$P(^BGPINDHC(BGPPC,14),U,2)
...S BGPSN=0,BGPCNT=0 F S BGPSN=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN S BGPCNT=BGPCNT+1 D
....S BGPSASU=$P(^BGPGPDCH(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCH(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
....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
.....S X="",$P(X,U,1)=BGPSASU_" "_BGPSNAM
.....S $P(X,U,2)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U)
.....S $P(X,U,3)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)
.....S $P(X,U,4)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)
.....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",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",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
.....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
.....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
.....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,4)_"%"
.....;S $P(X,U,5)=$P(^BGPINDHC(BGPPC,14),U,2),$P(X,U,6)=$P(^BGPINDHC(BGPPC,14),U,3)
.....;I BGPCNT=1 D S(XX,1,1) D
.....I BGPCNT=1 D W^BGP3DP(XX,0,1,BGPPTYPE,1)
.....;S Y="" I $P(^BGPINDHC(BGPPC,14),U,9)]""!($P(^BGPINDHC(BGPPC,14),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDHC(BGPPC,14),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDHC(BGPPC,14),U,10),"$","^")
.....S Y="" I $P(^BGPINDHC(BGPPC,14),U,9)]""!($P(^BGPINDHC(BGPPC,14),U,10)]"")!($P(^BGPINDHC(BGPPC,14),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPINDHC(BGPPC,14),U,9),"$","^") D
......S $P(Y,U,8)=$P(^BGPINDHC(BGPPC,14),U,11)
.....I Y]"" D W^BGP3DP(Y,0,1,BGPPTYPE,1) ;D S(Y,1,1)
....D W^BGP3DP(X,0,1,BGPPTYPE,1) ;D S(X,1,1)
...D W^BGP3DP(" ",0,1,BGPPTYPE) ;S X=" " D S(X,1,1)
I BGPPTYPE="P",$Y>(BGPIOSL-5) D HEADERP Q:BGPQUIT
D W^BGP3DP("",0,0,BGPPTYPE)
;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."
D W^BGP3DP($S($G(BGPNGR09):"*",1:"*")_" Federally Administered Activities measure. National 2012 rate is for federal",0,2,BGPPTYPE)
D W^BGP3DP("sites only.",0,1,BGPPTYPE)
D W^BGP3DP("",0,1,BGPPTYPE)
Q
;
D HEADER^BGP3DPH
D H1P
Q
H1P ;
S X="OFFICIAL GPRA/GPRAMA MEASURES CLINICAL PERFORMANCE DETAIL" D W^BGP3DP(X,1,1,BGPPTYPE)
D W^BGP3DP("Site",0,1,BGPPTYPE,2,22),W^BGP3DP("Site",0,0,BGPPTYPE,3,32) D
.D W^BGP3DP("Site",0,0,BGPPTYPE,4,40),W^BGP3DP("Area",0,0,BGPPTYPE,5,46),W^BGP3DP("PART",0,0,BGPPTYPE,6,55),W^BGP3DP("Nat'l",0,0,BGPPTYPE,7,64) ;,W^BGP3DP("2013",0,0,BGPPTYPE,8,74)
D W^BGP3DP("Current",0,1,BGPPTYPE,2,22),W^BGP3DP("Prev",0,0,BGPPTYPE,3,32) D
.D W^BGP3DP("Base",0,0,BGPPTYPE,4,40),W^BGP3DP("Current",0,0,BGPPTYPE,5,46),W^BGP3DP("Target",0,0,BGPPTYPE,6,55),W^BGP3DP("2012",0,0,BGPPTYPE,7,64) ;,W^BGP3DP("Target",0,0,BGPPTYPE,8,74)
D W^BGP3DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
D W^BGP3DP("PART MEASURE",0,2,BGPPTYPE)
D W^BGP3DP("------------",0,1,BGPPTYPE)
D W^BGP3DP("",0,1,BGPPTYPE)
Q
BGP3SDP ; IHS/CMI/LAB - IHS summary page 11 Dec 2006 1:24 PM ;
+1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
+2 ;
START ;
+1 IF '$GET(BGPAREAA)
QUIT
+2 IF BGPRTYPE'=1
QUIT
+3 SET BGPQUIT=""
SET BGPGPG=0
+4 DO HEADER
+5 NEW P8,P4,P7,P12
+6 ;CHANGE 1:8 TO 1:13
SET P8=$SELECT('$GET(BGPNGR09):8,1:8)
+7 ;CHANGE 1:4 TO 1:14
SET P4=$SELECT('$GET(BGPNGR09):4,1:4)
+8 ;CHANGE 1:7 TO 1:15
SET P7=$SELECT('$GET(BGPNGR09):7,1:7)
+9 ;CHANGE 1:12 TO 1:16
SET P12=$SELECT('$GET(BGPNGR09):12,1:12)
+10 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC))
IF BGPC'=+BGPC!(BGPQUIT)
QUIT
Begin DoDot:1
+11 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+12 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+13 DO W^BGP3DP("",0,1,BGPPTYPE)
+14 DO W^BGP3DP($PIECE(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
+15 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:2
+16 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,0))
+17 IF $PIECE($GET(^BGPINDHC(BGPPC,22)),U,13)
QUIT
+18 IF BGPPTYPE="P"
Begin DoDot:3
+19 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+20 DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,14),U,P4),0,2,BGPPTYPE,,1)
+21 IF $PIECE(^BGPINDHC(BGPPC,14),U,P7)]""
DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,14),U,P7),0,1,BGPPTYPE)
+22 IF $PIECE(^BGPINDHC(BGPPC,14),U,P12)]""
DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,14),U,P12),0,1,BGPPTYPE)
+23 SET F=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,0))
+24 SET F=$PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
+25 DO W^BGP3DP(F_$SELECT($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"):"",1:"%"),0,0,BGPPTYPE,,46)
+26 DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,14),U,P8),0,0,BGPPTYPE,,55)
+27 DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,14),U,2),0,0,BGPPTYPE,,65)
+28 DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,14),U,3),0,0,BGPPTYPE,,74)
+29 IF $PIECE(^BGPINDHC(BGPPC,14),U,9)]""!($PIECE(^BGPINDHC(BGPPC,14),U,10)]"")!($PIECE(^BGPINDHC(BGPPC,14),U,11)]"")
Begin DoDot:4
+30 DO W^BGP3DP($TRANSLATE($PIECE(^BGPINDHC(BGPPC,14),U,9),"$","^"),0,0,BGPPTYPE,,55)
+31 DO W^BGP3DP($TRANSLATE($PIECE(^BGPINDHC(BGPPC,14),U,10),"$","^"),0,0,BGPPTYPE,,64)
+32 ;D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,11),0,0,BGPPTYPE,,73)
End DoDot:4
+33 SET BGPSN=0
FOR
SET BGPSN=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN))
IF BGPSN'=+BGPSN!(BGPQUIT)
QUIT
Begin DoDot:4
+34 SET BGPSASU=$PIECE(^BGPGPDCH(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(^BGPGPDCH(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
+35 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")
Begin DoDot:5
+36 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+37 DO W^BGP3DP(BGPSASU,0,1,BGPPTYPE,,2)
DO W^BGP3DP($EXTRACT(BGPSNAM,1,12),0,0,BGPPTYPE,,8)
+38 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,0),0,0,BGPPTYPE,,20)
+39 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0),0,0,BGPPTYPE,,29)
+40 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0),0,0,BGPPTYPE,,38)
End DoDot:5
IF 1
+41 IF '$TEST
Begin DoDot:5
+42 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+43 DO W^BGP3DP(BGPSASU,0,1,BGPPTYPE,,2)
DO W^BGP3DP($EXTRACT(BGPSNAM,1,12),0,0,BGPPTYPE,,8)
+44 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,1)_"%",0,0,BGPPTYPE,,20)
+45 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1)_"%",0,0,BGPPTYPE,,29)
+46 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1)_"%",0,0,BGPPTYPE,,38)
End DoDot:5
End DoDot:4
End DoDot:3
+47 IF BGPPTYPE="D"
Begin DoDot:3
+48 DO W^BGP3DP("",0,1,BGPPTYPE)
+49 SET XX=" "_$PIECE(^BGPINDHC(BGPPC,14),U,4)
+50 IF $PIECE(^BGPINDHC(BGPPC,14),U,7)]""
DO W^BGP3DP(XX,0,1,BGPPTYPE)
SET XX=" "_$PIECE(^BGPINDHC(BGPPC,14),U,7)
+51 IF $PIECE(^BGPINDHC(BGPPC,14),U,12)]""
DO W^BGP3DP(XX,0,1,BGPPTYPE)
SET XX=" "_$PIECE(^BGPINDHC(BGPPC,14),U,12)
+52 SET F=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,0))
+53 SET F=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
+54 SET $PIECE(XX,U,5)=F_$SELECT($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(BGP
PC,19)),U,13)):"",1:"%")
+55 SET $PIECE(XX,U,6)=$PIECE(^BGPINDHC(BGPPC,14),U,P8)
+56 ;,$P(XX,U,7)=$P(^BGPINDHC(BGPPC,14),U,3)
SET $PIECE(XX,U,7)=$PIECE(^BGPINDHC(BGPPC,14),U,2)
+57 SET $PIECE(XX,U,8)=$PIECE(^BGPINDHC(BGPPC,14),U,3)
+58 ;S $P(XX,U,6)=$P(^BGPINDNC(BGPPC,14),U,P8),$P(XX,U,7)=$P(^BGPINDNC(BGPPC,14),U,2),$P(XX,U,8)=$P(^BGPINDNC(BGPPC,14),U,3)
+59 SET BGPSN=0
SET BGPCNT=0
FOR
SET BGPSN=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN))
IF BGPSN'=+BGPSN
QUIT
SET BGPCNT=BGPCNT+1
Begin DoDot:4
+60 SET BGPSASU=$PIECE(^BGPGPDCH(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(^BGPGPDCH(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
+61 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:5
+62 SET X=""
SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+63 SET $PIECE(X,U,2)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U)
+64 SET $PIECE(X,U,3)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)
+65 SET $PIECE(X,U,4)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)
+66 ;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,4)
End DoDot:5
IF 1
+67 IF '$TEST
Begin DoDot:5
+68 SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+69 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
+70 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
+71 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
End DoDot:5
+72 IF BGPCNT=1
DO W^BGP3DP(XX,0,1,BGPPTYPE,1)
+73 SET Y=""
IF $PIECE(^BGPINDHC(BGPPC,14),U,9)]""!($PIECE(^BGPINDHC(BGPPC,14),U,10)]"")!($PIECE(^BGPINDHC(BGPPC,14),U,11)]"")
SET $PIECE(Y,U,6)=$TRANSLATE($PIECE(^BGPINDHC(BGPPC,14),U,9),"$","^")
Begin DoDot:5
+74 SET $PIECE(Y,U,8)=$PIECE(^BGPINDHC(BGPPC,14),U,11)
End DoDot:5
+75 ;D S(Y,1,1)
IF Y]""
DO W^BGP3DP(Y,0,1,BGPPTYPE,1)
+76 ;D S(X,1,1)
DO W^BGP3DP(X,0,1,BGPPTYPE,1)
End DoDot:4
+77 ;D W^BGP3DP(" ",0,1,BGPPTYPE) ;S X=" " D S(X,1,1)
End DoDot:3
End DoDot:2
End DoDot:1
+78 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-9)
DO HEADER
IF BGPQUIT
QUIT
+79 ;I $G(BGPNGR09) D FOOTER10^BGP3DSP Q
+80 DO W^BGP3DP(" * Measure definition changed in 2007.",0,2,BGPPTYPE)
+81 DO W^BGP3DP("** Measure definition changed in 2013.",0,2,BGPPTYPE)
+82 ;D W^BGP3DP("** Not official GPRA measure but included to show percentage of refusals with",0,2,BGPPTYPE),W^BGP3DP("respect to GPRA measure.",0,1,BGPPTYPE)
+83 ;D W^BGP3DP(" + Site Previous and Site Baseline values are not applicable for this measure.",0,2,BGPPTYPE)
+84 DO W^BGP3DP("",0,0,BGPPTYPE)
+85 ;D PART
+86 QUIT
+87 ;
+1 DO HEADER^BGP3DPH
+2 DO H1
+3 QUIT
H1 ;
+1 SET X="OFFICIAL GPRA/GPRAMA MEASURES CLINICAL PERFORMANCE DETAIL"
DO W^BGP3DP(X,1,1,BGPPTYPE)
+2 DO W^BGP3DP("Site",0,1,BGPPTYPE,2,21)
DO W^BGP3DP("Site",0,0,BGPPTYPE,3,32)
DO W^BGP3DP("Site",0,0,BGPPTYPE,4,40)
DO W^BGP3DP("Area",0,0,BGPPTYPE,5,46)
Begin DoDot:1
+3 DO W^BGP3DP($SELECT('$GET(BGPNGR09):"GPRA",1:"GPRA"),0,0,BGPPTYPE,6,55)
DO W^BGP3DP("Nat'l",0,0,BGPPTYPE,7,64)
DO W^BGP3DP("2020",0,0,BGPPTYPE,8,74)
End DoDot:1
+4 DO W^BGP3DP("Current",0,1,BGPPTYPE,2,21)
DO W^BGP3DP("Prev",0,0,BGPPTYPE,3,32)
DO W^BGP3DP("Base",0,0,BGPPTYPE,4,40)
Begin DoDot:1
+5 DO W^BGP3DP("Current",0,0,BGPPTYPE,5,46)
DO W^BGP3DP("Target"_$SELECT($GET(BGPNGR09):"",1:""),0,0,BGPPTYPE,6,55)
DO W^BGP3DP("2012",0,0,BGPPTYPE,7,65)
DO W^BGP3DP("Target",0,0,BGPPTYPE,8,74)
End DoDot:1
+6 DO W^BGP3DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+7 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 ;----------
+3 ;----------
PART ;
+1 DO HEADERP
+2 SET P1=$SELECT($GET(BGPNGR09):8,1:8)
+3 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",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 DETAIL PAGE",BGPC,BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:2
+9 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,0))
+10 IF '$PIECE($GET(^BGPINDHC(BGPPC,22)),U,13)
QUIT
+11 IF BGPPTYPE="P"
Begin DoDot:3
+12 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+13 DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,14),U,P4),0,2,BGPPTYPE,,1)
+14 IF $PIECE(^BGPINDHC(BGPPC,14),U,P7)]""
DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,14),U,P7),0,1,BGPPTYPE)
+15 IF $PIECE(^BGPINDHC(BGPPC,14),U,P12)]""
DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,14),U,P12),0,1,BGPPTYPE)
+16 SET F=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,0))
+17 SET F=$PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
+18 DO W^BGP3DP(F_$SELECT($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"):"",1:"%"),0,0,BGPPTYPE,,46)
+19 DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,14),U,P8),0,0,BGPPTYPE,,56)
+20 DO W^BGP3DP($PIECE(^BGPINDHC(BGPPC,14),U,2),0,0,BGPPTYPE,,65)
+21 ;D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,3),0,0,BGPPTYPE,,74)
+22 IF $PIECE(^BGPINDHC(BGPPC,14),U,9)]""!($PIECE(^BGPINDHC(BGPPC,14),U,10)]"")!($PIECE(^BGPINDHC(BGPPC,14),U,11)]"")
Begin DoDot:4
+23 DO W^BGP3DP($TRANSLATE($PIECE(^BGPINDHC(BGPPC,14),U,9),"$","^"),0,0,BGPPTYPE,,55)
+24 DO W^BGP3DP($TRANSLATE($PIECE(^BGPINDHC(BGPPC,14),U,10),"$","^"),0,0,BGPPTYPE,,64)
+25 ;D W^BGP3DP($P(^BGPINDHC(BGPPC,14),U,11),0,0,BGPPTYPE,,73)
End DoDot:4
+26 SET BGPSN=0
FOR
SET BGPSN=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN))
IF BGPSN'=+BGPSN!(BGPQUIT)
QUIT
Begin DoDot:4
+27 SET BGPSASU=$PIECE(^BGPGPDCH(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(^BGPGPDCH(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
+28 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")
Begin DoDot:5
+29 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+30 DO W^BGP3DP(BGPSASU,0,1,BGPPTYPE,,2)
DO W^BGP3DP($EXTRACT(BGPSNAM,1,12),0,0,BGPPTYPE,,8)
+31 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,0),0,0,BGPPTYPE,,20)
+32 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0),0,0,BGPPTYPE,,29)
+33 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0),0,0,BGPPTYPE,,38)
End DoDot:5
IF 1
+34 IF '$TEST
Begin DoDot:5
+35 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+36 DO W^BGP3DP(BGPSASU,0,1,BGPPTYPE,,2)
DO W^BGP3DP($EXTRACT(BGPSNAM,1,12),0,0,BGPPTYPE,,8)
+37 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,1)_"%",0,0,BGPPTYPE,,20)
+38 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1)_"%",0,0,BGPPTYPE,,29)
+39 DO W^BGP3DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1)_"%",0,0,BGPPTYPE,,38)
End DoDot:5
End DoDot:4
End DoDot:3
+40 IF BGPPTYPE="D"
Begin DoDot:3
+41 DO W^BGP3DP("",0,1,BGPPTYPE)
+42 SET XX=" "_$PIECE(^BGPINDHC(BGPPC,14),U,4)
+43 IF $PIECE(^BGPINDHC(BGPPC,14),U,7)]""
DO W^BGP3DP(XX,0,1,BGPPTYPE)
SET XX=" "_$PIECE(^BGPINDHC(BGPPC,14),U,7)
+44 IF $PIECE(^BGPINDHC(BGPPC,14),U,12)]""
DO W^BGP3DP(XX,0,1,BGPPTYPE)
SET XX=" "_$PIECE(^BGPINDHC(BGPPC,14),U,12)
+45 SET F=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,0))
+46 SET F=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
+47 SET $PIECE(XX,U,5)=F_$SELECT($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($GET(^BGPINDHC(BGPPC,19)),U,13)):"",1:"%")
+48 SET $PIECE(XX,U,6)=$PIECE(^BGPINDHC(BGPPC,14),U,8)
SET $PIECE(XX,U,7)=$PIECE(^BGPINDHC(BGPPC,14),U,2)
+49 SET BGPSN=0
SET BGPCNT=0
FOR
SET BGPSN=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN))
IF BGPSN'=+BGPSN
QUIT
SET BGPCNT=BGPCNT+1
Begin DoDot:4
+50 SET BGPSASU=$PIECE(^BGPGPDCH(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(^BGPGPDCH(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
+51 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:5
+52 SET X=""
SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+53 SET $PIECE(X,U,2)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U)
+54 SET $PIECE(X,U,3)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)
+55 SET $PIECE(X,U,4)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)
+56 ;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,4)
End DoDot:5
IF 1
+57 IF '$TEST
Begin DoDot:5
+58 SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+59 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
+60 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
+61 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
+62 ;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,4)_"%"
+63 ;S $P(X,U,5)=$P(^BGPINDHC(BGPPC,14),U,2),$P(X,U,6)=$P(^BGPINDHC(BGPPC,14),U,3)
+64 ;I BGPCNT=1 D S(XX,1,1) D
+65 IF BGPCNT=1
DO W^BGP3DP(XX,0,1,BGPPTYPE,1)
+66 ;S Y="" I $P(^BGPINDHC(BGPPC,14),U,9)]""!($P(^BGPINDHC(BGPPC,14),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDHC(BGPPC,14),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDHC(BGPPC,14),U,10),"$","^")
+67 SET Y=""
IF $PIECE(^BGPINDHC(BGPPC,14),U,9)]""!($PIECE(^BGPINDHC(BGPPC,14),U,10)]"")!($PIECE(^BGPINDHC(BGPPC,14),U,11)]"")
SET $PIECE(Y,U,6)=$TRANSLATE($PIECE(^BGPINDHC(BGPPC,14),U,9),"$","^")
Begin DoDot:6
+68 SET $PIECE(Y,U,8)=$PIECE(^BGPINDHC(BGPPC,14),U,11)
End DoDot:6
+69 ;D S(Y,1,1)
IF Y]""
DO W^BGP3DP(Y,0,1,BGPPTYPE,1)
End DoDot:5
+70 ;D S(X,1,1)
DO W^BGP3DP(X,0,1,BGPPTYPE,1)
End DoDot:4
+71 ;S X=" " D S(X,1,1)
DO W^BGP3DP(" ",0,1,BGPPTYPE)
End DoDot:3
End DoDot:2
End DoDot:1
+72 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-5)
DO HEADERP
IF BGPQUIT
QUIT
+73 DO W^BGP3DP("",0,0,BGPPTYPE)
+74 ;I $G(BGPNGR09) D
+75 ;.W !," * PART 2014 target represented here is a preliminary target since it will be"
+76 ;.W !,"adjusted for FY 2013 actual results and FY 2014 appropriations."
+77 DO W^BGP3DP($SELECT($GET(BGPNGR09):"*",1:"*")_" Federally Administered Activities measure. National 2012 rate is for federal",0,2,BGPPTYPE)
+78 DO W^BGP3DP("sites only.",0,1,BGPPTYPE)
+79 DO W^BGP3DP("",0,1,BGPPTYPE)
+80 QUIT
+81 ;
+1 DO HEADER^BGP3DPH
+2 DO H1P
+3 QUIT
H1P ;
+1 SET X="OFFICIAL GPRA/GPRAMA MEASURES CLINICAL PERFORMANCE DETAIL"
DO W^BGP3DP(X,1,1,BGPPTYPE)
+2 DO W^BGP3DP("Site",0,1,BGPPTYPE,2,22)
DO W^BGP3DP("Site",0,0,BGPPTYPE,3,32)
Begin DoDot:1
+3 ;,W^BGP3DP("2013",0,0,BGPPTYPE,8,74)
DO W^BGP3DP("Site",0,0,BGPPTYPE,4,40)
DO W^BGP3DP("Area",0,0,BGPPTYPE,5,46)
DO W^BGP3DP("PART",0,0,BGPPTYPE,6,55)
DO W^BGP3DP("Nat'l",0,0,BGPPTYPE,7,64)
End DoDot:1
+4 DO W^BGP3DP("Current",0,1,BGPPTYPE,2,22)
DO W^BGP3DP("Prev",0,0,BGPPTYPE,3,32)
Begin DoDot:1
+5 ;,W^BGP3DP("Target",0,0,BGPPTYPE,8,74)
DO W^BGP3DP("Base",0,0,BGPPTYPE,4,40)
DO W^BGP3DP("Current",0,0,BGPPTYPE,5,46)
DO W^BGP3DP("Target",0,0,BGPPTYPE,6,55)
DO W^BGP3DP("2012",0,0,BGPPTYPE,7,64)
End DoDot:1
+6 DO W^BGP3DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+7 DO W^BGP3DP("PART MEASURE",0,2,BGPPTYPE)
+8 DO W^BGP3DP("------------",0,1,BGPPTYPE)
+9 DO W^BGP3DP("",0,1,BGPPTYPE)
+10 QUIT
