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

BGP8SDPD.m

Go to the documentation of this file. 
  1. BGP8SDPD ; IHS/CMI/LAB - IHS summary page ;
  1.  ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
  1.  ;
  1. START ;
  1.  I '$G(BGPAREAA) Q
  1.  I BGPRTYPE'=1 Q
  1.  S BGPQUIT=""
  1.  D HEADER
  1.  D W^BGP8DP("GPRA DEVELOPMENTAL MEASURES",0,2,BGPPTYPE)
  1.  D W^BGP8DP("---------------------------",0,1,BGPPTYPE)
  1.  S BGPC=0 F  S BGPC=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT)  D
  1.  .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
  1.  .S BGPC1=$O(^BGPSCAT("C",BGPC,0))
  1.  .D W^BGP8DP("",0,1,BGPPTYPE)
  1.  .D W^BGP8DP($P(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
  1.  .S BGPO="" F  S BGPO=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT)  D
  1.  ..S BGPPC=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,0))
  1.  ..;Q:$P($G(^BGPINDRC(BGPPC,22)),U,13)  ;part measure displays last
  1.  ..I BGPPTYPE="P",$Y>(BGPIOSL-4) D HEADER Q:BGPQUIT
  1.  ..I BGPPTYPE="P" D
  1.  ...D W^BGP8DP($P(^BGPINDRC(BGPPC,22),U,4),0,2,BGPPTYPE,1,1)
  1.  ...I $P(^BGPINDRC(BGPPC,22),U,7)]"" D W^BGP8DP($P(^BGPINDRC(BGPPC,22),U,7),0,1,BGPPTYPE,1,1)  ;W !?1,$P(^BGPINDRC(BGPPC,22),U,7)
  1.  ...I $P(^BGPINDRC(BGPPC,22),U,12)]"" D W^BGP8DP($P(^BGPINDRC(BGPPC,22),U,12),0,1,BGPPTYPE,1,1)
  1.  ...S F=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,0))
  1.  ...S F=$P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,F),U,4)
  1.  ...D W^BGP8DP(F_$S($P(^BGPINDRC(BGPPC,0),U,4)["014.A"!($P(^BGPINDRC(BGPPC,0),U,4)["023.")!($P(^BGPINDRC(BGPPC,0),U,4)="016.A.1")!($P(^BGPINDRC(BGPPC,0),U,4)="016.A.5")!($P($G(^BGPINDRC(BGPPC,19)),U,13)):"",1:"%"),0,0,BGPPTYPE,5,60)
  1.  ...;D W^BGP8DP($P(^BGPINDRC(BGPPC,22),U,2),0,0,BGPPTYPE,6,60)  ;,?65,$P(^BGPINDRC(BGPPC,22),U,3)
  1.  ...I $P(^BGPINDRC(BGPPC,22),U,9)]""!($P(^BGPINDRC(BGPPC,22),U,10)]"")!($P(^BGPINDRC(BGPPC,22),U,11)]"") D W^BGP8DP($TR($P(^BGPINDRC(BGPPC,22),U,10),"$","^"),0,1,BGPPTYPE,6,60)
  1.  ...S BGPSN=0 F  S BGPSN=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN!(BGPQUIT)  D
  1.  ....S BGPSASU=$P(^BGPGPDCR(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)) S BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCR(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
  1.  ....I $P(^BGPINDRC(BGPPC,0),U,4)["014.A"!($P(^BGPINDRC(BGPPC,0),U,4)["023.")!($P(^BGPINDRC(BGPPC,0),U,4)="016.A.1")!($P($G(^BGPINDRC(BGPPC,19)),U,13)) D  I 1
  1.  .....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
  1.  .....D W^BGP8DP(BGPSASU,0,1,BGPPTYPE,1,2)
  1.  .....D W^BGP8DP($E(BGPSNAM,1,15),0,0,BGPPTYPE,2,9)
  1.  .....D W^BGP8DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U),7,0),0,0,BGPPTYPE,2,30)
  1.  .....D W^BGP8DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0),0,0,BGPPTYPE,3,40)
  1.  .....D W^BGP8DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0),0,0,BGPPTYPE,4,50)
  1.  ....E  D
  1.  .....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
  1.  .....D W^BGP8DP(BGPSASU,0,1,BGPPTYPE,1,2)
  1.  .....D W^BGP8DP($E(BGPSNAM,1,12),0,0,BGPPTYPE,2,8)
  1.  .....D W^BGP8DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U),7,1)_"%",0,0,BGPPTYPE,2,30)
  1.  .....D W^BGP8DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1)_"%",0,0,BGPPTYPE,3,40)
  1.  .....D W^BGP8DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1)_"%",0,0,BGPPTYPE,4,50)
  1.  ..I BGPPTYPE="D" D
  1.  ...D W^BGP8DP("",0,1,BGPPTYPE)
  1.  ...S XX=" "_$P(^BGPINDRC(BGPPC,22),U,4)
  1.  ...I $P(^BGPINDRC(BGPPC,22),U,7)]"" D W^BGP8DP(XX,0,1,BGPPTYPE,1) S XX=" "_$P(^BGPINDRC(BGPPC,22),U,7)
  1.  ...I $P(^BGPINDRC(BGPPC,22),U,12)]"" D W^BGP8DP(XX,0,1,BGPPTYPE,1) S XX=" "_$P(^BGPINDRC(BGPPC,22),U,12)
  1.  ...S F=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,0))
  1.  ...S F=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,F),U,4)
  1.  ...S $P(XX,U,5)=F_$S($P(^BGPINDRC(BGPPC,0),U,4)["014.A"!($P(^BGPINDRC(BGPPC,0),U,4)["023.")!($P(^BGPINDRC(BGPPC,0),U,4)="016.A.1")!($P($G(^BGPINDRC(BGPPC,19)),U,13)):"",1:"%")
  1.  ...S $P(XX,U,6)=$P(^BGPINDRC(BGPPC,22),U,2) ;,$P(XX,U,7)=$P(^BGPINDRC(BGPPC,22),U,3)
  1.  ...S BGPSN=0,BGPCNT=0 F  S BGPSN=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN  S BGPCNT=BGPCNT+1 D
  1.  ....S BGPSASU=$P(^BGPGPDCR(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCR(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
  1.  ....I $P(^BGPINDRC(BGPPC,0),U,4)["014.A"!($P(^BGPINDRC(BGPPC,0),U,4)["023.")!($P(^BGPINDRC(BGPPC,0),U,4)="016.A.1")!($P(^BGPINDRC(BGPPC,0),U,4)="016.A.5")!($P($G(^BGPINDRC(BGPPC,19)),U,13)) D  I 1
  1.  .....S X="",$P(X,U,1)=BGPSASU_" "_BGPSNAM
  1.  .....S $P(X,U,2)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U)
  1.  .....S $P(X,U,3)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2)
  1.  .....S $P(X,U,4)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3)
  1.  .....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,4)
  1.  ....E  D
  1.  .....S $P(X,U,1)=BGPSASU_" "_BGPSNAM
  1.  .....S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
  1.  .....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
  1.  .....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
  1.  .....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,4)_"%"
  1.  .....;S $P(X,U,5)=$P(^BGPINDRC(BGPPC,22),U,2),$P(X,U,6)=$P(^BGPINDRC(BGPPC,22),U,3)
  1.  .....;I BGPCNT=1 D S(XX,1,1) D
  1.  ....I BGPCNT=1 D W^BGP8DP(XX,0,1,BGPPTYPE,1)
  1.  ....S Y="" I $P(^BGPINDRC(BGPPC,22),U,9)]""!($P(^BGPINDRC(BGPPC,22),U,10)]"")!($P(^BGPINDRC(BGPPC,22),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPINDRC(BGPPC,22),U,9),"$","^") D
  1.  .....S $P(Y,U,8)=$P(^BGPINDRC(BGPPC,22),U,11)
  1.  ....I Y]"" D W^BGP8DP(Y,0,1,BGPPTYPE,1)  ;D S(Y,1,1)
  1.  ....D W^BGP8DP(X,0,1,BGPPTYPE,1)  ;D S(X,1,1)
  1.  D W^BGP8DP(" ",0,1,BGPPTYPE)  ;S X=" " D S(X,1,1)
  1.  I BGPPTYPE="P",$Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
  1.  D W^BGP8DP("* Not GPRA Developmental measure but included to show percentage of",0,2,BGPPTYPE)
  1.  D W^BGP8DP("refusals with respect to GPRA Developmental measure.",0,1,BGPPTYPE)
  1.  D W^BGP8DP("",0,1,BGPPTYPE)
  1.  Q
  1.  ;
  1.  D HEADER^BGP8DPH
  1.  D H1
  1.  Q
  1. H1 ;
  1.  S X="GPRA DEVELOPMENTAL MEASURES CLINICAL PERFORMANCE DETAIL" D W^BGP8DP(X,1,1,BGPPTYPE)
  1.  D W^BGP8DP("Site",0,1,BGPPTYPE,2,30),W^BGP8DP("Site",0,0,BGPPTYPE,3,40),W^BGP8DP("Site",0,0,BGPPTYPE,4,50),W^BGP8DP("Area",0,0,BGPPTYPE,5,60) ;,W^BGP8DP("Nat'l",0,0,BGPPTYPE,6,60)
  1.  D W^BGP8DP("Current",0,1,BGPPTYPE,2,30),W^BGP8DP("Prev",0,0,BGPPTYPE,3,40),W^BGP8DP("Base",0,0,BGPPTYPE,4,50),W^BGP8DP("Current",0,0,BGPPTYPE,5,60) ;W^BGP8DP("2017",0,0,BGPPTYPE,6,60)
  1.  D W^BGP8DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
  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. PART ;
  1.  D HEADERP
  1.  S P1=$S($G(BGPNGR09):8,1:8)
  1.  S BGPC=0 F  S BGPC=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT)  D
  1.  .I $Y>(BGPIOSL-3) D HEADERP Q:BGPQUIT
  1.  .S BGPC1=$O(^BGPSCAT("C",BGPC,0))
  1.  .;W !
  1.  .;W !,$P(^BGPSCAT(BGPC1,0),U)
  1.  .S BGPO="" F  S BGPO=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT)  D
  1.  ..S BGPPC=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,0))
  1.  ..Q:'$P($G(^BGPINDRC(BGPPC,22)),U,13)
  1.  ..I $Y>(BGPIOSL-3) D HEADERP Q:BGPQUIT
  1.  ..W !!?1,$P(^BGPINDRC(BGPPC,22),U,4)
  1.  ..I $P(^BGPINDRC(BGPPC,22),U,7)]"" W !,$P(^BGPINDRC(BGPPC,22),U,7)
  1.  ..I $P(^BGPINDRC(BGPPC,22),U,12)]"" W !,$P(^BGPINDRC(BGPPC,22),U,12)
  1.  ..S F=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,0))
  1.  ..S F=$P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,F),U,4)
  1.  ..W ?50,F,$S($P(^BGPINDRC(BGPPC,0),U,4)["014.A"!($P(^BGPINDRC(BGPPC,0),U,4)["023.")!($P(^BGPINDRC(BGPPC,0),U,4)="016.A.1"):"",1:"%"),?60,$P(^BGPINDRC(BGPPC,22),U,P1),?65,$P(^BGPINDRC(BGPPC,22),U,2),?74,$P(^BGPINDRC(BGPPC,22),U,3)
  1.  ..I $P(^BGPINDRC(BGPPC,22),U,9)]""!($P(^BGPINDRC(BGPPC,22),U,10)]"")!($P(^BGPINDRC(BGPPC,22),U,11)]"") W !?60,$TR($P(^BGPINDRC(BGPPC,22),U,9),"$","^"),?64,$TR($P(^BGPINDRC(BGPPC,22),U,10),"$","^"),?73,$P(^BGPINDRC(BGPPC,22),U,11)
  1.  ..S BGPSN=0 F  S BGPSN=$O(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN!(BGPQUIT)  D
  1.  ...S BGPSASU=$P(^BGPGPDCR(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)) S BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCR(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
  1.  ...I $P(^BGPINDRC(BGPPC,0),U,4)["014.A"!($P(^BGPINDRC(BGPPC,0),U,4)["023.")!($P(^BGPINDRC(BGPPC,0),U,4)="016.A.1") D  I 1
  1.  ....I $Y>(BGPIOSL-3) D HEADERP Q:BGPQUIT
  1.  ....W !?2,BGPSASU,?8,$E(BGPSNAM,1,12)
  1.  ....W ?20,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U),7,0)
  1.  ....W ?29,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0)
  1.  ....W ?38,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0)
  1.  ...E  D
  1.  ....I $Y>(BGPIOSL-3) D HEADERP Q:BGPQUIT
  1.  ....W !?2,BGPSASU,?8,$E(BGPSNAM,1,12)
  1.  ....W ?20,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U),7,1),"%"
  1.  ....W ?29,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1),"%"
  1.  ....W ?38,$J($P(^TMP($J,"SUMMARY DETAIL PAGE DEVEL",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1),"%"
  1.  I $Y>(BGPIOSL-5) D HEADERP Q:BGPQUIT
  1.  W !
  1.  ;I $G(BGPNGR09) D
  1.  ;.W !," * PART 2018 target represented here is a preliminary target since it will be"
  1.  ;.W !,"adjusted for FY 2018 actual results and FY 2018 appropriations."
  1.  W !,$S($G(BGPNGR09):"*",1:"*")," Federally Administered Activities measure.  National 2015 rate is for federal"
  1.  W !,"sites only."
  1.  W ! Q
  1.  Q
  1.  ;
  1. HEADERP ;EP
  1.  D HEADER^BGP8DPH
  1.  D H1P
  1.  Q
  1. H1P ;
  1.  I BGPRTYPE=1 S X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE DETAIL" W !,$$CTR(X,80)
  1.  W !?22," Site",?32,"Site",?40,"Site",?50,"Area",?60,$S($G(BGPNGR09):"PART10",1:"PART09"),?64,"Nat'l",?74,"2017"
  1.  W !?22,"Current",?32,"Prev",?40,"Base",?50,"Current",?60,"Target"_$S($G(BGPNGR09):"*",1:""),?65,"2017",?74,"Target"
  1.  W !,$TR($J("",80)," ","-")
  1.  W !!,"PART MEASURE"
  1.  W !,"------------"
  1.  Q