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

BGP7DSPD.m

Go to the documentation of this file.
  1. BGP7DSPD ; IHS/CMI/LAB - IHS summary page ;
  1. ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
  1. ;
  1. START ;
  1. I BGPRTYPE'=1 Q
  1. I $G(BGPNPL) Q ;not on gpra pat list
  1. I $G(BGPCPPL) Q ;not on comp list
  1. S BGPQUIT=""
  1. D HEADER
  1. D W^BGP7DP("GPRA DEVELOPMENTAL MEASURES",0,2,BGPPTYPE)
  1. D W^BGP7DP("---------------------------",0,1,BGPPTYPE)
  1. S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY 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^BGP7DP("",0,1,BGPPTYPE)
  1. .D W^BGP7DP($P(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
  1. .S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
  1. ..S BGPPC=$O(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,0))
  1. ..Q:$P($G(^BGPINDGC(BGPPC,22)),U,13) ;part measure displays last
  1. ..I BGPPTYPE="P",$Y>(BGPIOSL-4) D HEADER Q:BGPQUIT
  1. ..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
  1. ...D W^BGP7DP($P(^BGPINDGC(BGPPC,22),U,4),0,1,BGPPTYPE,1,1)
  1. ...I $P(^BGPINDGC(BGPPC,22),U,7)]"" D W^BGP7DP($P(^BGPINDGC(BGPPC,22),U,7),0,1,BGPPTYPE,1,1) ;W !?1,$P(^BGPINDGC(BGPPC,22),U,7)
  1. ...I $P(^BGPINDGC(BGPPC,22),U,12)]"" D W^BGP7DP($P(^BGPINDGC(BGPPC,22),U,12),0,1,BGPPTYPE,1,1)
  1. ...I BGPPTYPE="P" D
  1. ....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U),7,0),0,0,BGPPTYPE,1,28)
  1. ....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,2),7,0),0,0,BGPPTYPE,1,36)
  1. ....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,3),7,0),0,0,BGPPTYPE,1,43)
  1. ....;D W^BGP7DP($P(^BGPINDGC(BGPPC,22),U,2),0,0,BGPPTYPE,1,57)
  1. ...I BGPPTYPE="D" D
  1. ....D W^BGP7DP($P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U),0,0,BGPPTYPE,2)
  1. ....D W^BGP7DP($P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2),0,0,BGPPTYPE,3)
  1. ....D W^BGP7DP($P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3),0,0,BGPPTYPE,4)
  1. ....D W^BGP7DP($P(^BGPINDGC(BGPPC,22),U,2),0,0,BGPPTYPE,5)
  1. ....;D S(X,1,1)
  1. ..E D
  1. ...D W^BGP7DP($P(^BGPINDGC(BGPPC,22),U,4),0,1,BGPPTYPE,1,1)
  1. ...I $P(^BGPINDGC(BGPPC,22),U,7)]"" D W^BGP7DP($P(^BGPINDGC(BGPPC,22),U,7),0,1,BGPPTYPE,1,1) ;W !?1,$P(^BGPINDGC(BGPPC,22),U,7)
  1. ...I $P(^BGPINDGC(BGPPC,22),U,12)]"" D W^BGP7DP($P(^BGPINDGC(BGPPC,22),U,12),0,1,BGPPTYPE,1,1) ;W !?1,$P(^BGPINDGC(BGPPC,22),U,7)
  1. ...I BGPPTYPE="P" D
  1. ....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U),7,1)_"%",0,0,BGPPTYPE,1,28)
  1. ....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,2),7,1)_"%",0,0,BGPPTYPE,1,36)
  1. ....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,3),7,1)_"%",0,0,BGPPTYPE,1,43)
  1. ....;D W^BGP7DP($TR($P(^BGPINDGC(BGPPC,22),U,2),"$","^"),0,0,BGPPTYPE,1,57)
  1. ...I BGPPTYPE="D" D
  1. ....D W^BGP7DP($P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U)_"%",0,0,BGPPTYPE,2,28)
  1. ....D W^BGP7DP($P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,2)_"%",0,0,BGPPTYPE,3,36)
  1. ....D W^BGP7DP($P(^TMP($J,"SUMMARYDEL DEVEL",BGPC,BGPO,BGPPC),U,3)_"%",0,0,BGPPTYPE,4,43)
  1. ....;D W^BGP7DP($TR($P(^BGPINDGC(BGPPC,22),U,2),"$","^"),0,0,BGPPTYPE,5,57)
  1. ...I $P(^BGPINDGC(BGPPC,22),U,9)]""!($P(^BGPINDGC(BGPPC,22),U,10)]"")!($P(^BGPINDGC(BGPPC,22),U,11)]"") D
  1. ....;D W^BGP7DP($TR($P(^BGPINDGC(BGPPC,22),U,10),"$","^"),0,0,BGPPTYPE,5,57),W^BGP7DP($P(^BGPINDGC(BGPPC,22),U,11),0,0,BGPPTYPE,6,68)
  1. ....D W^BGP7DP("",0,0,BGPPTYPE)
  1. I BGPPTYPE="P",$Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
  1. D W^BGP7DP("* Not GPRA Developmental measure but included to show percentage of",0,2,BGPPTYPE)
  1. D W^BGP7DP("refusals with respect to GPRA Developmental measure.",0,1,BGPPTYPE)
  1. D W^BGP7DP("",0,1,BGPPTYPE)
  1. Q
  1. ;D PART
  1. ;Q
  1. ;
  1. D HEADER^BGP7DPH
  1. D H1
  1. Q
  1. H1 ;
  1. S X="GPRA DEVELOPMENTAL CLINICAL PERFORMANCE SUMMARY" D W^BGP7DP(X,1,1,BGPPTYPE)
  1. I $G(BGPAREAA) D W^BGP7DP("Area",0,1,BGPPTYPE,2,29),W^BGP7DP("Area",0,0,BGPPTYPE,3,38),W^BGP7DP("Area",0,0,BGPPTYPE,4,47) ;,W^BGP7DP("Nat'l",0,0,BGPPTYPE,5,57)
  1. I '$G(BGPAREAA) D W^BGP7DP("Site",0,1,BGPPTYPE,2,29),W^BGP7DP("Site",0,0,BGPPTYPE,3,38),W^BGP7DP("Site",0,0,BGPPTYPE,4,47) ;,W^BGP7DP("Nat'l",0,0,BGPPTYPE,5,57)
  1. D W^BGP7DP("Current",0,1,BGPPTYPE,2,29),W^BGP7DP("Previous",0,0,BGPPTYPE,3,37),W^BGP7DP("Baseline",0,0,BGPPTYPE,4,46) ;,W^BGP7DP("2016",0,0,BGPPTYPE,5,57)
  1. D W^BGP7DP($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):14,1:8)
  1. S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY 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 DEVEL",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
  1. ..S BGPPC=$O(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,0))
  1. ..Q:'$P($G(^BGPINDGC(BGPPC,22)),U,13) ;part measures only
  1. ..I $Y>(BGPIOSL-4) D HEADERP Q:BGPQUIT
  1. ..I $P(^BGPINDGC(BGPPC,0),U,4)["014.A"!($P(^BGPINDGC(BGPPC,0),U,4)["023.")!($P(^BGPINDGC(BGPPC,0),U,4)["016")!($P($G(^BGPINDGC(BGPPC,19)),U,13)) D I 1
  1. ...W !,$P(^BGPINDGC(BGPPC,22),U,4)
  1. ...I $P(^BGPINDGC(BGPPC,22),U,7)]"" W !,$P(^BGPINDGC(BGPPC,22),U,7)
  1. ...I $P(^BGPINDGC(BGPPC,22),U,12)]"" W !,$P(^BGPINDGC(BGPPC,22),U,12)
  1. ...W ?28,$J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U),7,0)
  1. ...W ?36,$J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,2),7,0)
  1. ...W ?43,$J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,3),7,0)
  1. ...W ?53,$P(^BGPINDGC(BGPPC,22),U,P1),?64,$P(^BGPINDGC(BGPPC,22),U,2),?73,$P(^BGPINDGC(BGPPC,22),U,3)
  1. ..E D
  1. ...W !,$P(^BGPINDGC(BGPPC,22),U,4)
  1. ...I $P(^BGPINDGC(BGPPC,22),U,7)]"" W !,$P(^BGPINDGC(BGPPC,22),U,7)
  1. ...I $P(^BGPINDGC(BGPPC,22),U,12)]"" W !,$P(^BGPINDGC(BGPPC,22),U,12)
  1. ...W ?28,$J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U),7,1),"%"
  1. ...W ?36,$J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,2),7,1),"%"
  1. ...W ?43,$J($P(^TMP($J,"SUMMARY DEVEL",BGPC,BGPO,BGPPC),U,3),7,1),"%"
  1. ...W ?53,$TR($P(^BGPINDGC(BGPPC,22),U,P1),"$","^"),?64,$TR($P(^BGPINDGC(BGPPC,22),U,2),"$","^"),?73,$P(^BGPINDGC(BGPPC,22),U,3)
  1. ...I $P(^BGPINDGC(BGPPC,22),U,9)]""!($P(^BGPINDGC(BGPPC,22),U,10)]"")!($P(^BGPINDGC(BGPPC,22),U,11)]"") W !?53,$TR($P(^BGPINDGC(BGPPC,22),U,9),"$","^"),?64,$TR($P(^BGPINDGC(BGPPC,22),U,10),"$","^"),?73,$P(^BGPINDGC(BGPPC,22),U,11)
  1. I $Y>(BGPIOSL-9) D HEADERP Q:BGPQUIT
  1. W !
  1. I $G(BGPNGR09) D
  1. .W !," * PART 2017 target represented here is a preliminary target since it will be"
  1. .W !,"adjusted for FY 2017 actual results and FY 2017 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. ;
  1. HEADERP ;EP
  1. D HEADER^BGP7DPH
  1. D H1P
  1. Q
  1. H1P ;
  1. S X="GPRA DEVELOPMENTAL & PART MEASURES CLINICAL PERFORMANCE SUMMARY" W !,$$CTR(X,80)
  1. I $G(BGPAREAA) W !?28," Area",?36," Area",?45," Area",?53,$S($G(BGPNGR09):"PART",1:"PART"),?64,"Nat'l",?73,"2016"
  1. I '$G(BGPAREAA) W !?28," Site",?36," Site",?45," Site",?53,$S($G(BGPNGR09):"PART",1:"PART"),?64,"Nat'l",?73,"2016"
  1. W !?28,"Current",?36,"Previous",?45,"Baseline",?53,"Target",?64,"2016",?73,"Target"
  1. W !,$TR($J("",80)," ","-")
  1. W !!,"PART MEASURE"
  1. W !,"------------"
  1. W !
  1. Q