BGP7SDP.m

BGP7SDP ; IHS/CMI/LAB - IHS summary page 11 Dec 2006 1:24 PM ;

 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29

 ;

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^BGP7DP("",0,1,BGPPTYPE)

 .D W^BGP7DP($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(^BGPINDGC(BGPPC,22)),U,13)

 ..I BGPPTYPE="P" D

 ...I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT

 ...D W^BGP7DP($P(^BGPINDGC(BGPPC,14),U,P4),0,2,BGPPTYPE,,1)

 ...I $P(^BGPINDGC(BGPPC,14),U,P7)]"" D W^BGP7DP($P(^BGPINDGC(BGPPC,14),U,P7),0,1,BGPPTYPE)

 ...I $P(^BGPINDGC(BGPPC,14),U,P12)]"" D W^BGP7DP($P(^BGPINDGC(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^BGP7DP(F_$S($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"):"",1:"%"),0,0,BGPPTYPE,,46)

 ...D W^BGP7DP($P(^BGPINDGC(BGPPC,14),U,P8),0,0,BGPPTYPE,,55)

 ...D W^BGP7DP($P(^BGPINDGC(BGPPC,14),U,2),0,0,BGPPTYPE,,65)

 ...D W^BGP7DP($P(^BGPINDGC(BGPPC,14),U,3),0,0,BGPPTYPE,,74)

 ...I $P(^BGPINDGC(BGPPC,14),U,9)]""!($P(^BGPINDGC(BGPPC,14),U,10)]"")!($P(^BGPINDGC(BGPPC,14),U,11)]"") D

 ....D W^BGP7DP($TR($P(^BGPINDGC(BGPPC,14),U,9),"$","^"),0,0,BGPPTYPE,,55)

 ....D W^BGP7DP($TR($P(^BGPINDGC(BGPPC,14),U,10),"$","^"),0,0,BGPPTYPE,,64)

 ....;D W^BGP7DP($P(^BGPINDGC(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(^BGPGPDCG(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)) S BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCG(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)

 ....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") D  I 1

 .....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT

 .....D W^BGP7DP(BGPSASU,0,1,BGPPTYPE,,2),W^BGP7DP($E(BGPSNAM,1,12),0,0,BGPPTYPE,,8)

 .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,0),0,0,BGPPTYPE,,20)

 .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0),0,0,BGPPTYPE,,29)

 .....D W^BGP7DP($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^BGP7DP(BGPSASU,0,1,BGPPTYPE,,2),W^BGP7DP($E(BGPSNAM,1,12),0,0,BGPPTYPE,,8)

 .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,1)_"%",0,0,BGPPTYPE,,20)

 .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1)_"%",0,0,BGPPTYPE,,29)

 .....D W^BGP7DP($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^BGP7DP("",0,1,BGPPTYPE)

 ...S XX=" "_$P(^BGPINDGC(BGPPC,14),U,4)

 ...I $P(^BGPINDGC(BGPPC,14),U,7)]"" D W^BGP7DP(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPINDGC(BGPPC,14),U,7)

 ...I $P(^BGPINDGC(BGPPC,14),U,12)]"" D W^BGP7DP(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPINDGC(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(^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)):"",1:"%")

 ...S $P(XX,U,6)=$P(^BGPINDGC(BGPPC,14),U,P8)

 ...S $P(XX,U,7)=$P(^BGPINDGC(BGPPC,14),U,2) ;,$P(XX,U,7)=$P(^BGPINDGC(BGPPC,14),U,3)

 ...S $P(XX,U,8)=$P(^BGPINDGC(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(^BGPGPDCG(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCG(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)

 ....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

 .....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^BGP7DP(XX,0,1,BGPPTYPE,1)

 ....S Y="" I $P(^BGPINDGC(BGPPC,14),U,9)]""!($P(^BGPINDGC(BGPPC,14),U,10)]"")!($P(^BGPINDGC(BGPPC,14),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPINDGC(BGPPC,14),U,9),"$","^") D

 .....S $P(Y,U,8)=$P(^BGPINDGC(BGPPC,14),U,11)

 ....I Y]"" D W^BGP7DP(Y,0,1,BGPPTYPE,1)  ;D S(Y,1,1)

 ....D W^BGP7DP(X,0,1,BGPPTYPE,1)  ;D S(X,1,1)

 ...;D W^BGP7DP(" ",0,1,BGPPTYPE)  ;S X=" " D S(X,1,1)

 I BGPPTYPE="P",$Y>(BGPIOSL-9) D HEADER Q:BGPQUIT

 D W^BGP7DP(" * Measure definition changed in 2013.",0,2,BGPPTYPE)

 D W^BGP7DP("** Measure definition changed in 2014.",0,2,BGPPTYPE)

 D W^BGP7DP("",0,0,BGPPTYPE)

 Q

 ;

HEADER ;EP

 D HEADER^BGP7DPH

 D H1

 Q

H1 ;

 S X="OFFICIAL GPRA/GPRAMA MEASURES CLINICAL PERFORMANCE DETAIL" D W^BGP7DP(X,1,1,BGPPTYPE)

 D W^BGP7DP("Site",0,1,BGPPTYPE,2,21),W^BGP7DP("Site",0,0,BGPPTYPE,3,32),W^BGP7DP("Site",0,0,BGPPTYPE,4,40),W^BGP7DP("Area",0,0,BGPPTYPE,5,46) D

 .D W^BGP7DP($S('$G(BGPNGR09):"GPRA",1:"GPRA"),0,0,BGPPTYPE,6,55),W^BGP7DP("Nat'l",0,0,BGPPTYPE,7,64),W^BGP7DP("2020",0,0,BGPPTYPE,8,74)

 D W^BGP7DP("Current",0,1,BGPPTYPE,2,21),W^BGP7DP("Prev",0,0,BGPPTYPE,3,32),W^BGP7DP("Base",0,0,BGPPTYPE,4,40) D

 .D W^BGP7DP("Current",0,0,BGPPTYPE,5,46),W^BGP7DP("Target"_$S($G(BGPNGR09):"",1:""),0,0,BGPPTYPE,6,55),W^BGP7DP("2016",0,0,BGPPTYPE,7,65),W^BGP7DP("Target",0,0,BGPPTYPE,8,74)

 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):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(^BGPINDGC(BGPPC,22)),U,13)

 ..I BGPPTYPE="P" D

 ...I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT

 ...D W^BGP7DP($P(^BGPINDGC(BGPPC,14),U,P4),0,2,BGPPTYPE,,1)

 ...I $P(^BGPINDGC(BGPPC,14),U,P7)]"" D W^BGP7DP($P(^BGPINDGC(BGPPC,14),U,P7),0,1,BGPPTYPE)

 ...I $P(^BGPINDGC(BGPPC,14),U,P12)]"" D W^BGP7DP($P(^BGPINDGC(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^BGP7DP(F_$S($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"):"",1:"%"),0,0,BGPPTYPE,,46)

 ...D W^BGP7DP($P(^BGPINDGC(BGPPC,14),U,P8),0,0,BGPPTYPE,,56)

 ...D W^BGP7DP($P(^BGPINDGC(BGPPC,14),U,2),0,0,BGPPTYPE,,65)

 ...;D W^BGP7DP($P(^BGPINDGC(BGPPC,14),U,3),0,0,BGPPTYPE,,74)

 ...I $P(^BGPINDGC(BGPPC,14),U,9)]""!($P(^BGPINDGC(BGPPC,14),U,10)]"")!($P(^BGPINDGC(BGPPC,14),U,11)]"") D

 ....D W^BGP7DP($TR($P(^BGPINDGC(BGPPC,14),U,9),"$","^"),0,0,BGPPTYPE,,55)

 ....D W^BGP7DP($TR($P(^BGPINDGC(BGPPC,14),U,10),"$","^"),0,0,BGPPTYPE,,64)

 ....;D W^BGP7DP($P(^BGPINDGC(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(^BGPGPDCG(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)) S BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCG(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)

 ....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") D  I 1

 .....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT

 .....D W^BGP7DP(BGPSASU,0,1,BGPPTYPE,,2),W^BGP7DP($E(BGPSNAM,1,12),0,0,BGPPTYPE,,8)

 .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,0),0,0,BGPPTYPE,,20)

 .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0),0,0,BGPPTYPE,,29)

 .....D W^BGP7DP($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^BGP7DP(BGPSASU,0,1,BGPPTYPE,,2),W^BGP7DP($E(BGPSNAM,1,12),0,0,BGPPTYPE,,8)

 .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,1)_"%",0,0,BGPPTYPE,,20)

 .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1)_"%",0,0,BGPPTYPE,,29)

 .....D W^BGP7DP($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^BGP7DP("",0,1,BGPPTYPE)

 ...S XX=" "_$P(^BGPINDGC(BGPPC,14),U,4)

 ...I $P(^BGPINDGC(BGPPC,14),U,7)]"" D W^BGP7DP(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPINDGC(BGPPC,14),U,7)

 ...I $P(^BGPINDGC(BGPPC,14),U,12)]"" D W^BGP7DP(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPINDGC(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(^BGPINDGC(BGPPC,0),U,4)["014.A"!($P(^BGPINDGC(BGPPC,0),U,4)["023.")!($P(^BGPINDGC(BGPPC,0),U,4)="016.A.1")!($P($G(^BGPINDGC(BGPPC,19)),U,13)):"",1:"%")

 ...S $P(XX,U,6)=$P(^BGPINDGC(BGPPC,14),U,8),$P(XX,U,7)=$P(^BGPINDGC(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(^BGPGPDCG(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCG(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)

 ....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

 .....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(^BGPINDGC(BGPPC,14),U,2),$P(X,U,6)=$P(^BGPINDGC(BGPPC,14),U,3)

 .....;I BGPCNT=1 D S(XX,1,1) D

 .....I BGPCNT=1 D W^BGP7DP(XX,0,1,BGPPTYPE,1)

 .....;S Y="" I $P(^BGPINDGC(BGPPC,14),U,9)]""!($P(^BGPINDGC(BGPPC,14),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDGC(BGPPC,14),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDGC(BGPPC,14),U,10),"$","^")

 .....S Y="" I $P(^BGPINDGC(BGPPC,14),U,9)]""!($P(^BGPINDGC(BGPPC,14),U,10)]"")!($P(^BGPINDGC(BGPPC,14),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPINDGC(BGPPC,14),U,9),"$","^") D

 ......S $P(Y,U,8)=$P(^BGPINDGC(BGPPC,14),U,11)

 .....I Y]"" D W^BGP7DP(Y,0,1,BGPPTYPE,1)  ;D S(Y,1,1)

 ....D W^BGP7DP(X,0,1,BGPPTYPE,1)  ;D S(X,1,1)

 ...D W^BGP7DP(" ",0,1,BGPPTYPE)  ;S X=" " D S(X,1,1)

 I BGPPTYPE="P",$Y>(BGPIOSL-5) D HEADERP Q:BGPQUIT

 D W^BGP7DP("",0,0,BGPPTYPE)

 D W^BGP7DP($S($G(BGPNGR09):"*",1:"*")_" Federally Administered Activities measure.  National 2015 rate is for federal",0,2,BGPPTYPE)

 D W^BGP7DP("sites only.",0,1,BGPPTYPE)

 D W^BGP7DP("",0,1,BGPPTYPE)

 Q

 ;

HEADERP ;EP

 D HEADER^BGP7DPH

 D H1P

 Q

H1P ;

 S X="OFFICIAL GPRA/GPRAMA MEASURES CLINICAL PERFORMANCE DETAIL" D W^BGP7DP(X,1,1,BGPPTYPE)

 D W^BGP7DP("Site",0,1,BGPPTYPE,2,22),W^BGP7DP("Site",0,0,BGPPTYPE,3,32) D

 .D W^BGP7DP("Site",0,0,BGPPTYPE,4,40),W^BGP7DP("Area",0,0,BGPPTYPE,5,46),W^BGP7DP("PART",0,0,BGPPTYPE,6,55),W^BGP7DP("Nat'l",0,0,BGPPTYPE,7,64) ;,W^BGP7DP("2016",0,0,BGPPTYPE,8,74)

 D W^BGP7DP("Current",0,1,BGPPTYPE,2,22),W^BGP7DP("Prev",0,0,BGPPTYPE,3,32) D

 .D W^BGP7DP("Base",0,0,BGPPTYPE,4,40),W^BGP7DP("Current",0,0,BGPPTYPE,5,46),W^BGP7DP("Target",0,0,BGPPTYPE,6,55),W^BGP7DP("2016",0,0,BGPPTYPE,7,64)  ;,W^BGP7DP("Target",0,0,BGPPTYPE,8,74)

 D W^BGP7DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)

 D W^BGP7DP("PART MEASURE",0,2,BGPPTYPE)

 D W^BGP7DP("------------",0,1,BGPPTYPE)

 D W^BGP7DP("",0,1,BGPPTYPE)

 Q

BGP7SDP   ; IHS/CMI/LAB - IHS summary page 11 Dec 2006 1:24 PM ;

 +1       ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29

 +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^BGP7DP("",0,1,BGPPTYPE)

 +14               DO W^BGP7DP($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(^BGPINDGC(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^BGP7DP($PIECE(^BGPINDGC(BGPPC,14),U,P4),0,2,BGPPTYPE,,1)

 +21                               IF $PIECE(^BGPINDGC(BGPPC,14),U,P7)]""

                                       DO W^BGP7DP($PIECE(^BGPINDGC(BGPPC,14),U,P7),0,1,BGPPTYPE)

 +22                               IF $PIECE(^BGPINDGC(BGPPC,14),U,P12)]""

                                       DO W^BGP7DP($PIECE(^BGPINDGC(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^BGP7DP(F_$SELECT($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"):"",1:"%"),0,0,BGPPTYPE,,46)

 +26                               DO W^BGP7DP($PIECE(^BGPINDGC(BGPPC,14),U,P8),0,0,BGPPTYPE,,55)

 +27                               DO W^BGP7DP($PIECE(^BGPINDGC(BGPPC,14),U,2),0,0,BGPPTYPE,,65)

 +28                               DO W^BGP7DP($PIECE(^BGPINDGC(BGPPC,14),U,3),0,0,BGPPTYPE,,74)

 +29                               IF $PIECE(^BGPINDGC(BGPPC,14),U,9)]""!($PIECE(^BGPINDGC(BGPPC,14),U,10)]"")!($PIECE(^BGPINDGC(BGPPC,14),U,11)]"")

                                       Begin DoDot:4

 +30                                       DO W^BGP7DP($TRANSLATE($PIECE(^BGPINDGC(BGPPC,14),U,9),"$","^"),0,0,BGPPTYPE,,55)

 +31                                       DO W^BGP7DP($TRANSLATE($PIECE(^BGPINDGC(BGPPC,14),U,10),"$","^"),0,0,BGPPTYPE,,64)

 +32      ;D W^BGP7DP($P(^BGPINDGC(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(^BGPGPDCG(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(^BGPGPDCG(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)

 +35                                       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")

                                               Begin DoDot:5

 +36                                               IF $Y>(BGPIOSL-3)

                                                       DO HEADER

                                                       IF BGPQUIT

                                                           QUIT 

 +37                                               DO W^BGP7DP(BGPSASU,0,1,BGPPTYPE,,2)

                                                   DO W^BGP7DP($EXTRACT(BGPSNAM,1,12),0,0,BGPPTYPE,,8)

 +38                                               DO W^BGP7DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,0),0,0,BGPPTYPE,,20)

 +39                                               DO W^BGP7DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0),0,0,BGPPTYPE,,29)

 +40                                               DO W^BGP7DP($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^BGP7DP(BGPSASU,0,1,BGPPTYPE,,2)

                                                   DO W^BGP7DP($EXTRACT(BGPSNAM,1,12),0,0,BGPPTYPE,,8)

 +44                                               DO W^BGP7DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,1)_"%",0,0,BGPPTYPE,,20)

 +45                                               DO W^BGP7DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1)_"%",0,0,BGPPTYPE,,29)

 +46                                               DO W^BGP7DP($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^BGP7DP("",0,1,BGPPTYPE)

 +49                               SET XX=" "_$PIECE(^BGPINDGC(BGPPC,14),U,4)

 +50                               IF $PIECE(^BGPINDGC(BGPPC,14),U,7)]""

                                       DO W^BGP7DP(XX,0,1,BGPPTYPE)

                                       SET XX=" "_$PIECE(^BGPINDGC(BGPPC,14),U,7)

 +51                               IF $PIECE(^BGPINDGC(BGPPC,14),U,12)]""

                                       DO W^BGP7DP(XX,0,1,BGPPTYPE)

                                       SET XX=" "_$PIECE(^BGPINDGC(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(^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(BGP