BGP8EOY ; IHS/CMI/LAB - IHS summary page ; 17 Jun 2008 11:57 AM
;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008
;EXECUTIVE ORDER SUMMARY SHEET FOR LOCAL REPORT
;
START ;
;
S BGPQUIT="",BGPGPG=0
I BGPPTYPE="D" G DEL
D HEADER
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
.I $Y>(BGPIOSL-3) D HEADER 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",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
..S BGPPC=$O(^TMP($J,"SUMMARY",BGPC,BGPO,0))
..I $Y>(BGPIOSL-4) D HEADER Q:BGPQUIT
..D
...W !?2,$P(^BGPEOMIE(BGPPC,14),U,4)
...I $P(^BGPEOMIE(BGPPC,14),U,7)]"" W !,$P(^BGPEOMIE(BGPPC,14),U,7)
...I $P(^BGPEOMIE(BGPPC,14),U,12)]"" W !,$P(^BGPEOMIE(BGPPC,14),U,12)
...W ?26,$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U),7,1),"%"
...W ?34,$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,1),"%"
...W ?41,$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,1),"%"
...W ?56,$TR($P(^BGPEOMIE(BGPPC,14),U,2),"$","^"),?67,$TR($P(^BGPEOMIE(BGPPC,14),U,8),"$","^")
...I $P(^BGPEOMIE(BGPPC,14),U,9)]""!($P(^BGPEOMIE(BGPPC,14),U,10)]"")!($P(^BGPEOMIE(BGPPC,14),U,11)]"") W !?56,$TR($P(^BGPEOMIE(BGPPC,14),U,9),"$","^"),?67,$TR($P(^BGPEOMIE(BGPPC,14),U,10),"$","^")
W !
D AREASUMP
Q
;
D HEADER^BGP8EOP
D H1
Q
;
H1 ;
S X="EO QUALITY TRANSPARENCY MEASURES CLINICAL PERFORMANCE SUMMARY" W !,$$CTR(X,80)
I $G(BGPAREAA) W !?26," Area",?34," Area",?43," Area",?56,"Nat'l",?67,"HEDIS or"
I '$G(BGPAREAA) W !?26," Site",?34," Site",?43," Site",?56,"Nat'l",?67,"HEDIS or"
W !?26,"Current",?34,"Previous",?43,"Baseline",?56,"2008",?67,"JCAHO*"
W !,$TR($J("",80)," ","-")
W !!,"*The rates shown in the ""HEDIS or JCAHO"" column represent the most recent"
W !,"rate available, which may be different from the CRS report period. The "
W !,"abbreviations after the rate represent: HMCD-HEDIS Medicaid, HCOM-HEDIS "
W !,"Commercial, HMCR-HEDIS Medicare, and JCO-JCAHO."
;W !
Q
AREASUMP ;
I '$G(BGPAREAA) Q
S BGPQUIT="",BGPGPG=0
D HEADERAS
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY DETAIL PAGE",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
.I $Y>(BGPIOSL-3) D HEADERAS 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))
..I $Y>(BGPIOSL-3) D HEADERAS Q:BGPQUIT
..W !!,$P(^BGPEOMIE(BGPPC,14),U,4)
..I $P(^BGPEOMIE(BGPPC,14),U,7)]"" W !,$P(^BGPEOMIE(BGPPC,14),U,7)
..I $P(^BGPEOMIE(BGPPC,14),U,12)]"" W !,$P(^BGPEOMIE(BGPPC,14),U,12)
..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)
..W ?46,F,$S($P(^BGPEOMIE(BGPPC,0),U,4)["014."!($P(^BGPEOMIE(BGPPC,0),U,4)["023.")!($P(^BGPEOMIE(BGPPC,0),U,4)["016."):"",1:"%"),?56,$P(^BGPEOMIE(BGPPC,14),U,2),?67,$P(^BGPEOMIE(BGPPC,14),U,8)
..I $P(^BGPEOMIE(BGPPC,14),U,9)]""!($P(^BGPEOMIE(BGPPC,14),U,10)]"")!($P(^BGPEOMIE(BGPPC,14),U,11)]"") W !?55,$TR($P(^BGPEOMIE(BGPPC,14),U,9),"$","^"),?64,$TR($P(^BGPEOMIE(BGPPC,14),U,10),"$","^"),?73,$P(^BGPEOMIE(BGPPC,14),U,11)
..S BGPSN=0 F S BGPSN=$O(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN!(BGPQUIT) D
...S BGPSASU=$P(^BGPEOCE(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)) S BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPEOCE(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
...D
....I $Y>(BGPIOSL-3) D HEADERAS Q:BGPQUIT W !
....W !?1,BGPSASU,?8,$E(BGPSNAM,1,12)
....W ?20,$J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,1),"%"
....W ?29,$J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1),"%"
....W ?38,$J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1),"%"
W !
Q
;
D HEADER^BGP8EOP
D H1AS
Q
;
H1AS ;
S X="EO QUALITY TRANSPARENCY MEASURES CLINICAL PERFORMANCE DETAIL" W !,$$CTR(X,80)
W !?26," Site",?34," Site",?43," Site",?56,"Nat'l",?67,"HEDIS or"
W !?26,"Current",?34,"Previous",?43,"Baseline",?56,"2008",?67,"JCAHO*"
W !,$TR($J("",80)," ","-")
W !!,"*The rates shown in the ""HEDIS or JCAHO"" column represent the most recent"
W !,"rate available, which may be different from the CRS report period. The "
W !,"abbreviations after the rate represent: HMCD-HEDIS Medicaid, HCOM-HEDIS "
W !,"Commercial, HMCR-HEDIS Medicare, and JCO-JCAHO."
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")
;
DEL ;
D DELH1
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARYDEL",BGPC)) Q:BGPC'=+BGPC D
.S X=" " D W^BGP8EOH(X,0,1,BGPPTYPE)
.S BGPC1=$O(^BGPSCAT("C",BGPC,0))
.S X=$P(^BGPSCAT(BGPC1,0),U,1) D W^BGP8EOH(X,0,1,BGPPTYPE)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARYDEL",BGPC,BGPO)) Q:BGPO="" D
..S BGPPC=$O(^TMP($J,"SUMMARYDEL",BGPC,BGPO,0))
..S X=""
..D
...S X=$P(^BGPEOMIE(BGPPC,14),U,4)
...I $P(^BGPEOMIE(BGPPC,14),U,7)]"" D W^BGP8EOH(X,0,1,BGPPTYPE) S X=$P(^BGPEOMIE(BGPPC,14),U,7)
...I $P(^BGPEOMIE(BGPPC,14),U,12)]"" D W^BGP8EOH(X,0,1,BGPPTYPE) S X=$P(^BGPEOMIE(BGPPC,14),U,12)
...S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)_"%"
...S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)_"%"
...S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)_"%"
...S $P(X,U,5)=$TR($P(^BGPEOMIE(BGPPC,14),U,2),"$","^")
...S $P(X,U,6)=$TR($P(^BGPEOMIE(BGPPC,14),U,8),"$","^")
...D W^BGP8EOH(X,0,1,BGPPTYPE)
...S X="" I $P(^BGPEOMIE(BGPPC,14),U,9)]""!($P(^BGPEOMIE(BGPPC,14),U,10)]"")!($P(^BGPEOMIE(BGPPC,14),U,11)]"") S $P(X,U,5)=$TR($P(^BGPEOMIE(BGPPC,14),U,9),"$","^"),$P(X,U,6)=$TR($P(^BGPEOMIE(BGPPC,14),U,10),"$","^") D
...I X]"" D W^BGP8EOH(X,0,1,BGPPTYPE)
S X=" " D W^BGP8EOH(X,0,1,BGPPTYPE)
I $G(BGPAREAA) D AREASUMD
Q
;
DELH1 ;
;
S X="EO QUALITY TRANSPARENCY MEASURES CLINICAL PERFORMANCE SUMMARY" D W^BGP8EOH(X,0,2,BGPPTYPE)
I $G(BGPAREAA) S X="",$P(X,U,2)=" Area",$P(X,U,3)=" Area",$P(X,U,4)=" Area",$P(X,U,5)="Nat'l",$P(X,U,6)="HEDIS or" D W^BGP8EOH(X,0,1,BGPPTYPE)
I '$G(BGPAREAA) S X="",$P(X,U,2)=" Site",$P(X,U,3)=" Site",$P(X,U,4)=" Site",$P(X,U,5)="Nat'l",$P(X,U,6)="HEDIS or" D W^BGP8EOH(X,0,1,BGPPTYPE)
S X="",$P(X,U,2)="Current",$P(X,U,3)="Previous",$P(X,U,4)="Baseline",$P(X,U,5)="2008",$P(X,U,6)="JCAHO*" D W^BGP8EOH(X,0,1,BGPPTYPE)
S X=$TR($J("",80)," ","-") D W^BGP8EOH(X,0,1,BGPPTYPE)
D W^BGP8EOH("*The rates shown in the ""HEDIS or JCAHO"" column represent the most recent",0,2,BGPPTYPE)
D W^BGP8EOH("rate available, which may be different from the CRS report period. The ",0,1,BGPPTYPE)
D W^BGP8EOH("abbreviations after the rate represent: HMCD-HEDIS Medicaid, HCOM-HEDIS ",0,1,BGPPTYPE)
D W^BGP8EOH("Commercial, HMCR-HEDIS Medicare, and JCO-JCAHO.",0,1,BGPPTYPE)
Q
;
H2 ;
S X=" " D W^BGP8EOH(X,0,2,BGPPTYPE)
S X="EXECUTIVE ORDER QUALITY TRANSPARENCY MEASURES CLINICAL PERFORMANCE DETAIL" D W^BGP8EOH(X,0,1,BGPPTYPE)
S X="",$P(X,U,2)=" Site",$P(X,U,3)=" Site",$P(X,U,4)=" Site",$P(X,U,5)="Area",$P(X,U,6)="Nat'l",$P(X,U,7)="HEDIS or" D W^BGP8EOH(X,0,1,BGPPTYPE)
S X="",$P(X,U,2)="Current",$P(X,U,3)="Previous",$P(X,U,4)="Baseline",$P(X,U,5)="Current",$P(X,U,6)="2008",$P(X,U,7)="JCAHO*" D W^BGP8EOH(X,0,1,BGPPTYPE)
S X=$TR($J("",80)," ","-") D W^BGP8EOH(X,0,1,BGPPTYPE)
D W^BGP8EOH("*The rates shown in the ""HEDIS or JCAHO"" column represent the most recent",0,2,BGPPTYPE)
D W^BGP8EOH("rate available, which may be different from the CRS report period. The ",0,1,BGPPTYPE)
D W^BGP8EOH("abbreviations after the rate represent: HMCD-HEDIS Medicaid, HCOM-HEDIS ",0,1,BGPPTYPE)
D W^BGP8EOH("Commercial, HMCR-HEDIS Medicare, and JCO-JCAHO.",0,1,BGPPTYPE)
Q
AREASUMD ;
SDP ;
I '$G(BGPAREAA) Q ;area only
S BGPQUIT="",BGPGPG=0
S BGPSUMP=1
;S X=" " D W^BGP8EOH(X,0,2,BGPPTYPE)
D HEADER^BGP8EOP
D H2
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC)) Q:BGPC'=+BGPC D
.S X=" " D W^BGP8EOH(X,0,1,BGPPTYPE)
.S BGPC1=$O(^BGPSCAT("C",BGPC,0))
.S X=$P(^BGPSCAT(BGPC1,0),U,1) D W^BGP8EOH(X,0,1,BGPPTYPE)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO)) Q:BGPO="" D
..S BGPPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,0))
..S X=" " D W^BGP8EOH(X,0,1,BGPPTYPE)
..S XX=" "_$P(^BGPEOMIE(BGPPC,14),U,4)
..I $P(^BGPEOMIE(BGPPC,14),U,7)]"" D W^BGP8EOH(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPEOMIE(BGPPC,14),U,7)
..I $P(^BGPEOMIE(BGPPC,14),U,12)]"" D W^BGP8EOH(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPEOMIE(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(^BGPEOMIE(BGPPC,0),U,4)["014."!($P(^BGPEOMIE(BGPPC,0),U,4)["023.")!($P(^BGPEOMIE(BGPPC,0),U,4)["016."):"",1:"%")
..S $P(XX,U,6)=$P(^BGPEOMIE(BGPPC,14),U,2),$P(XX,U,7)=$P(^BGPEOMIE(BGPPC,14),U,8)
..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(^BGPEOCE(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPEOCE(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
...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^BGP8EOH(XX,0,1,BGPPTYPE) D
....S Y="" I $P(^BGPEOMIE(BGPPC,14),U,9)]""!($P(^BGPEOMIE(BGPPC,14),U,10)]"")!($P(^BGPEOMIE(BGPPC,14),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPEOMIE(BGPPC,14),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPEOMIE(BGPPC,14),U,10),"$","^") D
.....S $P(Y,U,8)=$P(^BGPEOMIE(BGPPC,14),U,11)
....I Y]"" D W^BGP8EOH(Y,0,1,BGPPTYPE)
...D W^BGP8EOH(X,0,1,BGPPTYPE)
Q
BGP8EOY ; IHS/CMI/LAB - IHS summary page ; 17 Jun 2008 11:57 AM
+1 ;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008
+2 ;EXECUTIVE ORDER SUMMARY SHEET FOR LOCAL REPORT
+3 ;
START ;
+1 ;
+2 SET BGPQUIT=""
SET BGPGPG=0
+3 IF BGPPTYPE="D"
GOTO DEL
+4 DO HEADER
+5 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARY",BGPC))
IF BGPC'=+BGPC!(BGPQUIT)
QUIT
Begin DoDot:1
+6 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+7 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+8 WRITE !
+9 WRITE !,$PIECE(^BGPSCAT(BGPC1,0),U)
+10 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARY",BGPC,BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:2
+11 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY",BGPC,BGPO,0))
+12 IF $Y>(BGPIOSL-4)
DO HEADER
IF BGPQUIT
QUIT
+13 Begin DoDot:3
+14 WRITE !?2,$PIECE(^BGPEOMIE(BGPPC,14),U,4)
+15 IF $PIECE(^BGPEOMIE(BGPPC,14),U,7)]""
WRITE !,$PIECE(^BGPEOMIE(BGPPC,14),U,7)
+16 IF $PIECE(^BGPEOMIE(BGPPC,14),U,12)]""
WRITE !,$PIECE(^BGPEOMIE(BGPPC,14),U,12)
+17 WRITE ?26,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U),7,1),"%"
+18 WRITE ?34,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,1),"%"
+19 WRITE ?41,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,1),"%"
+20 WRITE ?56,$TRANSLATE($PIECE(^BGPEOMIE(BGPPC,14),U,2),"$","^"),?67,$TRANSLATE($PIECE(^BGPEOMIE(BGPPC,14),U,8),"$","^")
+21 IF $PIECE(^BGPEOMIE(BGPPC,14),U,9)]""!($PIECE(^BGPEOMIE(BGPPC,14),U,10)]"")!($PIECE(^BGPEOMIE(BGPPC,14),U,11)]"")
WRITE !?56,$TRANSLATE($PIECE(^BGPEOMIE(BGPPC,14),U,9),"$","^"),?67,$TRANSLATE($PIECE(^BGPEOMIE(BGPPC,14),U,10),"$","^")
End DoDot:3
End DoDot:2
End DoDot:1
+22 WRITE !
+23 DO AREASUMP
+24 QUIT
+25 ;
+1 DO HEADER^BGP8EOP
+2 DO H1
+3 QUIT
+4 ;
H1 ;
+1 SET X="EO QUALITY TRANSPARENCY MEASURES CLINICAL PERFORMANCE SUMMARY"
WRITE !,$$CTR(X,80)
+2 IF $GET(BGPAREAA)
WRITE !?26," Area",?34," Area",?43," Area",?56,"Nat'l",?67,"HEDIS or"
+3 IF '$GET(BGPAREAA)
WRITE !?26," Site",?34," Site",?43," Site",?56,"Nat'l",?67,"HEDIS or"
+4 WRITE !?26,"Current",?34,"Previous",?43,"Baseline",?56,"2008",?67,"JCAHO*"
+5 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+6 WRITE !!,"*The rates shown in the ""HEDIS or JCAHO"" column represent the most recent"
+7 WRITE !,"rate available, which may be different from the CRS report period. The "
+8 WRITE !,"abbreviations after the rate represent: HMCD-HEDIS Medicaid, HCOM-HEDIS "
+9 WRITE !,"Commercial, HMCR-HEDIS Medicare, and JCO-JCAHO."
+10 ;W !
+11 QUIT
AREASUMP ;
+1 IF '$GET(BGPAREAA)
QUIT
+2 SET BGPQUIT=""
SET BGPGPG=0
+3 DO HEADERAS
+4 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC))
IF BGPC'=+BGPC!(BGPQUIT)
QUIT
Begin DoDot:1
+5 IF $Y>(BGPIOSL-3)
DO HEADERAS
IF BGPQUIT
QUIT
+6 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+7 WRITE !
+8 WRITE !,$PIECE(^BGPSCAT(BGPC1,0),U)
+9 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:2
+10 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,0))
+11 IF $Y>(BGPIOSL-3)
DO HEADERAS
IF BGPQUIT
QUIT
+12 WRITE !!,$PIECE(^BGPEOMIE(BGPPC,14),U,4)
+13 IF $PIECE(^BGPEOMIE(BGPPC,14),U,7)]""
WRITE !,$PIECE(^BGPEOMIE(BGPPC,14),U,7)
+14 IF $PIECE(^BGPEOMIE(BGPPC,14),U,12)]""
WRITE !,$PIECE(^BGPEOMIE(BGPPC,14),U,12)
+15 SET F=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,0))
+16 SET F=$PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
+17 WRITE ?46,F,$SELECT($PIECE(^BGPEOMIE(BGPPC,0),U,4)["014."!($PIECE(^BGPEOMIE(BGPPC,0),U,4)["023.")!($PIECE(^BGPEOMIE(BGPPC,0),U,4)["016."):"",1:"%"),?56,$PIECE(^BGPEOMIE(BGPPC,14),U,2),?67,$PIECE(^BGPEOMIE(BGPPC,14),U,8)
+18 IF $PIECE(^BGPEOMIE(BGPPC,14),U,9)]""!($PIECE(^BGPEOMIE(BGPPC,14),U,10)]"")!($PIECE(^BGPEOMIE(BGPPC,14),U,11)]"")
WRITE !?55,$TRANSLATE($PIECE(^BGPEOMIE(BGPPC,14),U,9),"$","^"),?64,$TRANSLATE($PIECE(^BGPEOMIE(BGPPC,14),U,10),"$","^"),?73,$PIECE(^BGPEOMIE(BGPPC,14),U,11)
+19 SET BGPSN=0
FOR
SET BGPSN=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN))
IF BGPSN'=+BGPSN!(BGPQUIT)
QUIT
Begin DoDot:3
+20 SET BGPSASU=$PIECE(^BGPEOCE(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(^BGPEOCE(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
+21 Begin DoDot:4
+22 IF $Y>(BGPIOSL-3)
DO HEADERAS
IF BGPQUIT
QUIT
WRITE !
+23 WRITE !?1,BGPSASU,?8,$EXTRACT(BGPSNAM,1,12)
+24 WRITE ?20,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,1),"%"
+25 WRITE ?29,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1),"%"
+26 WRITE ?38,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1),"%"
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+27 WRITE !
+28 QUIT
+29 ;
+1 DO HEADER^BGP8EOP
+2 DO H1AS
+3 QUIT
+4 ;
H1AS ;
+1 SET X="EO QUALITY TRANSPARENCY MEASURES CLINICAL PERFORMANCE DETAIL"
WRITE !,$$CTR(X,80)
+2 WRITE !?26," Site",?34," Site",?43," Site",?56,"Nat'l",?67,"HEDIS or"
+3 WRITE !?26,"Current",?34,"Previous",?43,"Baseline",?56,"2008",?67,"JCAHO*"
+4 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+5 WRITE !!,"*The rates shown in the ""HEDIS or JCAHO"" column represent the most recent"
+6 WRITE !,"rate available, which may be different from the CRS report period. The "
+7 WRITE !,"abbreviations after the rate represent: HMCD-HEDIS Medicaid, HCOM-HEDIS "
+8 WRITE !,"Commercial, HMCR-HEDIS Medicare, and JCO-JCAHO."
+9 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 ;
DEL ;
+1 DO DELH1
+2 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARYDEL",BGPC))
IF BGPC'=+BGPC
QUIT
Begin DoDot:1
+3 SET X=" "
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+4 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+5 SET X=$PIECE(^BGPSCAT(BGPC1,0),U,1)
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+6 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO))
IF BGPO=""
QUIT
Begin DoDot:2
+7 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,0))
+8 SET X=""
+9 Begin DoDot:3
+10 SET X=$PIECE(^BGPEOMIE(BGPPC,14),U,4)
+11 IF $PIECE(^BGPEOMIE(BGPPC,14),U,7)]""
DO W^BGP8EOH(X,0,1,BGPPTYPE)
SET X=$PIECE(^BGPEOMIE(BGPPC,14),U,7)
+12 IF $PIECE(^BGPEOMIE(BGPPC,14),U,12)]""
DO W^BGP8EOH(X,0,1,BGPPTYPE)
SET X=$PIECE(^BGPEOMIE(BGPPC,14),U,12)
+13 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)_"%"
+14 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)_"%"
+15 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)_"%"
+16 SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPEOMIE(BGPPC,14),U,2),"$","^")
+17 SET $PIECE(X,U,6)=$TRANSLATE($PIECE(^BGPEOMIE(BGPPC,14),U,8),"$","^")
+18 DO W^BGP8EOH(X,0,1,BGPPTYPE)
+19 SET X=""
IF $PIECE(^BGPEOMIE(BGPPC,14),U,9)]""!($PIECE(^BGPEOMIE(BGPPC,14),U,10)]"")!($PIECE(^BGPEOMIE(BGPPC,14),U,11)]"")
SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPEOMIE(BGPPC,14),U,9),"$","^")
SET $PIECE(X,U,6)=$TRANSLATE($PIECE(^BGPEOMIE(BGPPC,14),U,10),"$","^")
Begin DoDot:4
End DoDot:4
+20 IF X]""
DO W^BGP8EOH(X,0,1,BGPPTYPE)
End DoDot:3
End DoDot:2
End DoDot:1
+21 SET X=" "
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+22 IF $GET(BGPAREAA)
DO AREASUMD
+23 QUIT
+24 ;
DELH1 ;
+1 ;
+2 SET X="EO QUALITY TRANSPARENCY MEASURES CLINICAL PERFORMANCE SUMMARY"
DO W^BGP8EOH(X,0,2,BGPPTYPE)
+3 IF $GET(BGPAREAA)
SET X=""
SET $PIECE(X,U,2)=" Area"
SET $PIECE(X,U,3)=" Area"
SET $PIECE(X,U,4)=" Area"
SET $PIECE(X,U,5)="Nat'l"
SET $PIECE(X,U,6)="HEDIS or"
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+4 IF '$GET(BGPAREAA)
SET X=""
SET $PIECE(X,U,2)=" Site"
SET $PIECE(X,U,3)=" Site"
SET $PIECE(X,U,4)=" Site"
SET $PIECE(X,U,5)="Nat'l"
SET $PIECE(X,U,6)="HEDIS or"
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+5 SET X=""
SET $PIECE(X,U,2)="Current"
SET $PIECE(X,U,3)="Previous"
SET $PIECE(X,U,4)="Baseline"
SET $PIECE(X,U,5)="2008"
SET $PIECE(X,U,6)="JCAHO*"
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+6 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+7 DO W^BGP8EOH("*The rates shown in the ""HEDIS or JCAHO"" column represent the most recent",0,2,BGPPTYPE)
+8 DO W^BGP8EOH("rate available, which may be different from the CRS report period. The ",0,1,BGPPTYPE)
+9 DO W^BGP8EOH("abbreviations after the rate represent: HMCD-HEDIS Medicaid, HCOM-HEDIS ",0,1,BGPPTYPE)
+10 DO W^BGP8EOH("Commercial, HMCR-HEDIS Medicare, and JCO-JCAHO.",0,1,BGPPTYPE)
+11 QUIT
+12 ;
H2 ;
+1 SET X=" "
DO W^BGP8EOH(X,0,2,BGPPTYPE)
+2 SET X="EXECUTIVE ORDER QUALITY TRANSPARENCY MEASURES CLINICAL PERFORMANCE DETAIL"
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+3 SET X=""
SET $PIECE(X,U,2)=" Site"
SET $PIECE(X,U,3)=" Site"
SET $PIECE(X,U,4)=" Site"
SET $PIECE(X,U,5)="Area"
SET $PIECE(X,U,6)="Nat'l"
SET $PIECE(X,U,7)="HEDIS or"
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+4 SET X=""
SET $PIECE(X,U,2)="Current"
SET $PIECE(X,U,3)="Previous"
SET $PIECE(X,U,4)="Baseline"
SET $PIECE(X,U,5)="Current"
SET $PIECE(X,U,6)="2008"
SET $PIECE(X,U,7)="JCAHO*"
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+5 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+6 DO W^BGP8EOH("*The rates shown in the ""HEDIS or JCAHO"" column represent the most recent",0,2,BGPPTYPE)
+7 DO W^BGP8EOH("rate available, which may be different from the CRS report period. The ",0,1,BGPPTYPE)
+8 DO W^BGP8EOH("abbreviations after the rate represent: HMCD-HEDIS Medicaid, HCOM-HEDIS ",0,1,BGPPTYPE)
+9 DO W^BGP8EOH("Commercial, HMCR-HEDIS Medicare, and JCO-JCAHO.",0,1,BGPPTYPE)
+10 QUIT
AREASUMD ;
SDP ;
+1 ;area only
IF '$GET(BGPAREAA)
QUIT
+2 SET BGPQUIT=""
SET BGPGPG=0
+3 SET BGPSUMP=1
+4 ;S X=" " D W^BGP8EOH(X,0,2,BGPPTYPE)
+5 DO HEADER^BGP8EOP
+6 DO H2
+7 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC))
IF BGPC'=+BGPC
QUIT
Begin DoDot:1
+8 SET X=" "
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+9 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+10 SET X=$PIECE(^BGPSCAT(BGPC1,0),U,1)
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+11 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO))
IF BGPO=""
QUIT
Begin DoDot:2
+12 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,0))
+13 SET X=" "
DO W^BGP8EOH(X,0,1,BGPPTYPE)
+14 SET XX=" "_$PIECE(^BGPEOMIE(BGPPC,14),U,4)
+15 IF $PIECE(^BGPEOMIE(BGPPC,14),U,7)]""
DO W^BGP8EOH(XX,0,1,BGPPTYPE)
SET XX=" "_$PIECE(^BGPEOMIE(BGPPC,14),U,7)
+16 IF $PIECE(^BGPEOMIE(BGPPC,14),U,12)]""
DO W^BGP8EOH(XX,0,1,BGPPTYPE)
SET XX=" "_$PIECE(^BGPEOMIE(BGPPC,14),U,12)
+17 SET F=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,0))
+18 SET F=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
+19 SET $PIECE(XX,U,5)=F_$SELECT($PIECE(^BGPEOMIE(BGPPC,0),U,4)["014."!($PIECE(^BGPEOMIE(BGPPC,0),U,4)["023.")!($PIECE(^BGPEOMIE(BGPPC,0),U,4)["016."):"",1:"%")
+20 SET $PIECE(XX,U,6)=$PIECE(^BGPEOMIE(BGPPC,14),U,2)
SET $PIECE(XX,U,7)=$PIECE(^BGPEOMIE(BGPPC,14),U,8)
+21 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:3
+22 SET BGPSASU=$PIECE(^BGPEOCE(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(^BGPEOCE(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
+23 Begin DoDot:4
+24 SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+25 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
+26 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
+27 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
End DoDot:4
+28 IF BGPCNT=1
DO W^BGP8EOH(XX,0,1,BGPPTYPE)
Begin DoDot:4
+29 SET Y=""
IF $PIECE(^BGPEOMIE(BGPPC,14),U,9)]""!($PIECE(^BGPEOMIE(BGPPC,14),U,10)]"")!($PIECE(^BGPEOMIE(BGPPC,14),U,11)]"")
SET $PIECE(Y,U,6)=$TRANSLATE($PIECE(^BGPEOMIE(BGPPC,14),U,9),"$","^")
SET $PIECE(Y,U,7)=$TRANSLATE($PIECE(^BGPEOMIE(BGPPC,14),U,10),"$","^")
Begin DoDot:5
+30 SET $PIECE(Y,U,8)=$PIECE(^BGPEOMIE(BGPPC,14),U,11)
End DoDot:5
+31 IF Y]""
DO W^BGP8EOH(Y,0,1,BGPPTYPE)
End DoDot:4
+32 DO W^BGP8EOH(X,0,1,BGPPTYPE)
End DoDot:3
End DoDot:2
End DoDot:1
+33 QUIT
