Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP2EOY

BGP2EOY.m

Go to the documentation of this file. 
  1. BGP2EOY ; IHS/CMI/LAB - IHS summary page 17 Jun 2010 11:57 AM 04 Jun 2012 2:01 PM ;
  1.  ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
  1.  ;EXECUTIVE ORDER SUMMARY SHEET FOR LOCAL REPORT
  1.  ;
  1. START ;
  1.  ;
  1.  S BGPQUIT="",BGPGPG=0
  1.  I BGPPTYPE="D" G DEL
  1.  D HEADER
  1.  S BGPC=0 F  S BGPC=$O(^TMP($J,"SUMMARY",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT)  D
  1.  .I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
  1.  .S BGPC1=$O(^BGPSCAT("E",BGPC,0))
  1.  .W !
  1.  .W !,$P(^BGPSCAT(BGPC1,0),U)
  1.  .S BGPO="" F  S BGPO=$O(^TMP($J,"SUMMARY",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT)  D
  1.  ..S BGPPC=$O(^TMP($J,"SUMMARY",BGPC,BGPO,0))
  1.  ..I $Y>(BGPIOSL-4) D HEADER Q:BGPQUIT
  1.  ..D
  1.  ...W !?2,$P(^BGPEOMIB(BGPPC,14),U,4)
  1.  ...I $P(^BGPEOMIB(BGPPC,14),U,7)]"" W !,$P(^BGPEOMIB(BGPPC,14),U,7)
  1.  ...I $P(^BGPEOMIB(BGPPC,14),U,12)]"" W !,$P(^BGPEOMIB(BGPPC,14),U,12)
  1.  ...W ?26,$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U),7,1),"%"
  1.  ...W ?34,$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,1),"%"
  1.  ...W ?41,$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,1),"%"
  1.  ...W ?56,$TR($P(^BGPEOMIB(BGPPC,14),U,2),"$","^"),?67,$TR($P(^BGPEOMIB(BGPPC,14),U,8),"$","^")
  1.  ...I $P(^BGPEOMIB(BGPPC,14),U,9)]""!($P(^BGPEOMIB(BGPPC,14),U,10)]"")!($P(^BGPEOMIB(BGPPC,14),U,11)]"") W !?56,$TR($P(^BGPEOMIB(BGPPC,14),U,9),"$","^"),?67,$TR($P(^BGPEOMIB(BGPPC,14),U,10),"$","^")
  1.  W !!,"* Represents national rates as of November 12, 2009 for all federal, one Navajo"
  1.  W !,"tribal facility, six Oklahoma tribal facilities, and four Portland tribal"
  1.  W !,"facilities."
  1.  W !!,"**The rates shown in the ""HEDIS or JCAHO"" column represent the most recent"
  1.  W !,"rate available, which may be different from the CRS report period.  The "
  1.  W !,"abbreviations after the rate represent:  HMCD-HEDIS Medicaid, HCOM-HEDIS "
  1.  W !,"Commercial, HMCR-HEDIS Medicare, and JCO-JCAHO."
  1.  D AREASUMP
  1.  Q
  1.  ;
  1.  D HEADER^BGP2EOP
  1.  D H1
  1.  Q
  1.  ;
  1. H1 ;
  1.  S X="EO QUALITY TRANSPARENCY MEASURES CLINICAL PERFORMANCE SUMMARY" W !,$$CTR(X,80)
  1.  I $G(BGPAREAA) W !?26," Area",?34," Area",?43," Area",?56,"Nat'l",?67,"HEDIS or"
  1.  I '$G(BGPAREAA) W !?26," Site",?34," Site",?43," Site",?56,"Nat'l",?67,"HEDIS or"
  1.  W !?26,"Current",?34,"Previous",?43,"Baseline",?56,"2009*",?67,"JCAHO**"
  1.  W !,$TR($J("",80)," ","-")
  1.  ;W !
  1.  Q
  1. AREASUMP ;
  1.  I '$G(BGPAREAA) Q
  1.  S BGPQUIT="",BGPGPG=0
  1.  D HEADERAS
  1.  S BGPC=0 F  S BGPC=$O(^TMP($J,"SUMMARY DETAIL PAGE",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT)  D
  1.  .I $Y>(BGPIOSL-3) D HEADERAS Q:BGPQUIT
  1.  .S BGPC1=$O(^BGPSCAT("E",BGPC,0))
  1.  .W !
  1.  .W !,$P(^BGPSCAT(BGPC1,0),U)
  1.  .S BGPO="" F  S BGPO=$O(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT)  D
  1.  ..S BGPPC=$O(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,0))
  1.  ..I $Y>(BGPIOSL-3) D HEADERAS Q:BGPQUIT
  1.  ..W !!,$P(^BGPEOMIB(BGPPC,14),U,4)
  1.  ..I $P(^BGPEOMIB(BGPPC,14),U,7)]"" W !,$P(^BGPEOMIB(BGPPC,14),U,7)
  1.  ..I $P(^BGPEOMIB(BGPPC,14),U,12)]"" W !,$P(^BGPEOMIB(BGPPC,14),U,12)
  1.  ..S F=$O(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,0))
  1.  ..S F=$P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
  1.  ..W ?46,F,$S($P(^BGPEOMIB(BGPPC,0),U,4)["014.A"!($P(^BGPEOMIB(BGPPC,0),U,4)["023.")!($P(^BGPEOMIB(BGPPC,0),U,4)="016.A.1"):"",1:"%"),?56,$P(^BGPEOMIB(BGPPC,14),U,2),?67,$P(^BGPEOMIB(BGPPC,14),U,8)
  1.  ..I $P(^BGPEOMIB(BGPPC,14),U,9)]""!($P(^BGPEOMIB(BGPPC,14),U,10)]"")!($P(^BGPEOMIB(BGPPC,14),U,11)]"") W !?55,$TR($P(^BGPEOMIB(BGPPC,14),U,9),"$","^"),?64,$TR($P(^BGPEOMIB(BGPPC,14),U,10),"$","^"),?73,$P(^BGPEOMIB(BGPPC,14),U,11)
  1.  ..S BGPSN=0 F  S BGPSN=$O(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN!(BGPQUIT)  D
  1.  ...S BGPSASU=$P(^BGPEOCB(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)) S BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPEOCB(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
  1.  ...D
  1.  ....I $Y>(BGPIOSL-3) D HEADERAS Q:BGPQUIT  W !
  1.  ....W !?1,BGPSASU,?8,$E(BGPSNAM,1,12)
  1.  ....W ?20,$J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U),7,1),"%"
  1.  ....W ?29,$J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1),"%"
  1.  ....W ?38,$J($P(^TMP($J,"SUMMARY DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1),"%"
  1.  W !!,"* Represents national rates as of November 12, 2009 for all federal, one Navajo"
  1.  W !,"tribal facility, six Oklahoma tribal facilities, and four Portland tribal"
  1.  W !,"facilities." W !!,"**The rates shown in the ""HEDIS or JCAHO"" column represent the most recent"
  1.  W !,"rate available, which may be different from the CRS report period.  The "
  1.  W !,"abbreviations after the rate represent:  HMCD-HEDIS Medicaid, HCOM-HEDIS "
  1.  W !,"Commercial, HMCR-HEDIS Medicare, and JCO-JCAHO."
  1.  Q
  1.  ;
  1. HEADERAS ;EP
  1.  D HEADER^BGP2EOP
  1.  D H1AS
  1.  Q
  1.  ;
  1. H1AS ;
  1.  S X="EO QUALITY TRANSPARENCY MEASURES CLINICAL PERFORMANCE DETAIL" W !,$$CTR(X,80)
  1.  W !?26," Site",?34," Site",?43," Site",?56,"Nat'l",?67,"HEDIS or"
  1.  W !?26,"Current",?34,"Previous",?43,"Baseline",?56,"2009*",?67,"JCAHO**"
  1.  W !,$TR($J("",80)," ","-")
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;
  1. DEL ;
  1.  D DELH1
  1.  S BGPC=0 F  S BGPC=$O(^TMP($J,"SUMMARYDEL",BGPC)) Q:BGPC'=+BGPC  D
  1.  .S X=" " D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  .S BGPC1=$O(^BGPSCAT("E",BGPC,0))
  1.  .S X=$P(^BGPSCAT(BGPC1,0),U,1) D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  .S BGPO="" F  S BGPO=$O(^TMP($J,"SUMMARYDEL",BGPC,BGPO)) Q:BGPO=""  D
  1.  ..S BGPPC=$O(^TMP($J,"SUMMARYDEL",BGPC,BGPO,0))
  1.  ..S X=""
  1.  ..D
  1.  ...S X=$P(^BGPEOMIB(BGPPC,14),U,4)
  1.  ...I $P(^BGPEOMIB(BGPPC,14),U,7)]"" D W^BGP2EOH(X,0,1,BGPPTYPE) S X=$P(^BGPEOMIB(BGPPC,14),U,7)
  1.  ...I $P(^BGPEOMIB(BGPPC,14),U,12)]"" D W^BGP2EOH(X,0,1,BGPPTYPE) S X=$P(^BGPEOMIB(BGPPC,14),U,12)
  1.  ...S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)_"%"
  1.  ...S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)_"%"
  1.  ...S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)_"%"
  1.  ...S $P(X,U,5)=$TR($P(^BGPEOMIB(BGPPC,14),U,2),"$","^")
  1.  ...S $P(X,U,6)=$TR($P(^BGPEOMIB(BGPPC,14),U,8),"$","^")
  1.  ...D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  ...S X="" I $P(^BGPEOMIB(BGPPC,14),U,9)]""!($P(^BGPEOMIB(BGPPC,14),U,10)]"")!($P(^BGPEOMIB(BGPPC,14),U,11)]"") S $P(X,U,5)=$TR($P(^BGPEOMIB(BGPPC,14),U,9),"$","^"),$P(X,U,6)=$TR($P(^BGPEOMIB(BGPPC,14),U,10),"$","^") D
  1.  ...I X]"" D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  ;S X=" " D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  D W^BGP2EOH("* Represents national rates as of November 12, 2009 for all federal, one Navajo",0,2,BGPPTYPE)
  1.  D W^BGP2EOH("tribal facility, six Oklahoma tribal facilities, and four Portland tribal",0,1,BGPPTYPE)
  1.  D W^BGP2EOH("facilities.",0,1,BGPPTYPE)
  1.  D W^BGP2EOH("**The rates shown in the ""HEDIS or JCAHO"" column represent the most recent",0,2,BGPPTYPE)
  1.  D W^BGP2EOH("rate available, which may be different from the CRS report period.  The ",0,1,BGPPTYPE)
  1.  D W^BGP2EOH("abbreviations after the rate represent:  HMCD-HEDIS Medicaid, HCOM-HEDIS ",0,1,BGPPTYPE)
  1.  D W^BGP2EOH("Commercial, HMCR-HEDIS Medicare, and JCO-JCAHO.",0,1,BGPPTYPE)
  1.  I $G(BGPAREAA) D AREASUMD
  1.  Q
  1.  ;
  1. DELH1 ;
  1.  ;
  1.  S X="EO QUALITY TRANSPARENCY MEASURES CLINICAL PERFORMANCE SUMMARY" D W^BGP2EOH(X,0,2,BGPPTYPE)
  1.  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^BGP2EOH(X,0,1,BGPPTYPE)
  1.  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^BGP2EOH(X,0,1,BGPPTYPE)
  1.  S X="",$P(X,U,2)="Current",$P(X,U,3)="Previous",$P(X,U,4)="Baseline",$P(X,U,5)="2009*",$P(X,U,6)="JCAHO**" D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  S X=$TR($J("",80)," ","-") D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  Q
  1.  ;
  1. H2 ;
  1.  S X=" " D W^BGP2EOH(X,0,2,BGPPTYPE)
  1.  S X="EXECUTIVE ORDER QUALITY TRANSPARENCY MEASURES CLINICAL PERFORMANCE DETAIL" D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  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^BGP2EOH(X,0,1,BGPPTYPE)
  1.  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)="2009*",$P(X,U,7)="JCAHO**" D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  S X=$TR($J("",80)," ","-") D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  Q
  1. AREASUMD ;
  1. SDP ;
  1.  I '$G(BGPAREAA) Q  ;area only
  1.  S BGPQUIT="",BGPGPG=0
  1.  S BGPSUMP=1
  1.  ;S X=" " D W^BGP2EOH(X,0,2,BGPPTYPE)
  1.  D HEADER^BGP2EOP
  1.  D H2
  1.  S BGPC=0 F  S BGPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC)) Q:BGPC'=+BGPC  D
  1.  .S X=" " D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  .S BGPC1=$O(^BGPSCAT("E",BGPC,0))
  1.  .S X=$P(^BGPSCAT(BGPC1,0),U,1) D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  .S BGPO="" F  S BGPO=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO)) Q:BGPO=""  D
  1.  ..S BGPPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,0))
  1.  ..S X=" " D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  ..S XX=" "_$P(^BGPEOMIB(BGPPC,14),U,4)
  1.  ..I $P(^BGPEOMIB(BGPPC,14),U,7)]"" D W^BGP2EOH(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPEOMIB(BGPPC,14),U,7)
  1.  ..I $P(^BGPEOMIB(BGPPC,14),U,12)]"" D W^BGP2EOH(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPEOMIB(BGPPC,14),U,12)
  1.  ..S F=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,0))
  1.  ..S F=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
  1.  ..S $P(XX,U,5)=F_$S($P(^BGPEOMIB(BGPPC,0),U,4)["014.A"!($P(^BGPEOMIB(BGPPC,0),U,4)["023.")!($P(^BGPEOMIB(BGPPC,0),U,4)="016.A.1"):"",1:"%")
  1.  ..S $P(XX,U,6)=$P(^BGPEOMIB(BGPPC,14),U,2),$P(XX,U,7)=$P(^BGPEOMIB(BGPPC,14),U,8)
  1.  ..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
  1.  ...S BGPSASU=$P(^BGPEOCB(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPEOCB(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
  1.  ...D
  1.  ....S $P(X,U,1)=BGPSASU_" "_BGPSNAM
  1.  ....S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
  1.  ....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
  1.  ....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
  1.  ...I BGPCNT=1 D W^BGP2EOH(XX,0,1,BGPPTYPE) D
  1.  ....S Y="" I $P(^BGPEOMIB(BGPPC,14),U,9)]""!($P(^BGPEOMIB(BGPPC,14),U,10)]"")!($P(^BGPEOMIB(BGPPC,14),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPEOMIB(BGPPC,14),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPEOMIB(BGPPC,14),U,10),"$","^") D
  1.  .....S $P(Y,U,8)=$P(^BGPEOMIB(BGPPC,14),U,11)
  1.  ....I Y]"" D W^BGP2EOH(Y,0,1,BGPPTYPE)
  1.  ...D W^BGP2EOH(X,0,1,BGPPTYPE)
  1.  D W^BGP2EOH("* Represents national rates as of November 12, 2009 for all federal, one Navajo",0,2,BGPPTYPE)
  1.  D W^BGP2EOH("tribal facility, six Oklahoma tribal facilities, and four Portland tribal",0,1,BGPPTYPE)
  1.  D W^BGP2EOH("facilities.",0,1,BGPPTYPE)
  1.  D W^BGP2EOH("**The rates shown in the ""HEDIS or JCAHO"" column represent the most recent",0,2,BGPPTYPE)
  1.  D W^BGP2EOH("rate available, which may be different from the CRS report period.  The ",0,1,BGPPTYPE)
  1.  D W^BGP2EOH("abbreviations after the rate represent:  HMCD-HEDIS Medicaid, HCOM-HEDIS ",0,1,BGPPTYPE)
  1.  D W^BGP2EOH("Commercial, HMCR-HEDIS Medicare, and JCO-JCAHO.",0,1,BGPPTYPE)
  1.  Q