BGP8DSPN ; IHS/CMI/LAB - IHS summary page ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
START ;
I BGPRTYPE'=1 Q
I $G(BGPNPL) Q ;not on gpra pat list
I $G(BGPCPPL) Q ;not on comp list
S BGPQUIT=""
D HEADER
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY NON",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
.I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
.S BGPC1=$O(^BGPSCAT("C",BGPC,0))
.D W^BGP8DP("",0,1,BGPPTYPE)
.D W^BGP8DP($P(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARY NON",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
..S BGPPC=$O(^TMP($J,"SUMMARY NON",BGPC,BGPO,0))
..I BGPPTYPE="P",$Y>(BGPIOSL-4) D HEADER Q:BGPQUIT
..I $P(^BGPINDRC(BGPPC,0),U,4)["014.A"!($P(^BGPINDRC(BGPPC,0),U,4)["023.")!($P(^BGPINDRC(BGPPC,0),U,4)["016.A.5")!($P($G(^BGPINDRC(BGPPC,19)),U,13)) D I 1
...D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,4),0,1,BGPPTYPE,1,1)
...;I $P(^BGPINDRC(BGPPC,15),U,7)]"" D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,7),0,1,BGPPTYPE,1,1) ;W !?1,$P(^BGPINDRC(BGPPC,15),U,7)
...I BGPPTYPE="P" D
....D W^BGP8DP($J($P(^TMP($J,"SUMMARY NON",BGPC,BGPO,BGPPC),U),7,0),0,0,BGPPTYPE,1,35)
....D W^BGP8DP($J($P(^TMP($J,"SUMMARY NON",BGPC,BGPO,BGPPC),U,2),7,0),0,0,BGPPTYPE,1,45)
....D W^BGP8DP($J($P(^TMP($J,"SUMMARY NON",BGPC,BGPO,BGPPC),U,3),7,0),0,0,BGPPTYPE,1,55)
....;D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,2),0,0,BGPPTYPE,1,57)
....;D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,3),0,0,BGPPTYPE,1,68)
...I BGPPTYPE="D" D
....D W^BGP8DP($P(^TMP($J,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U),0,0,BGPPTYPE,2)
....D W^BGP8DP($P(^TMP($J,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U,2),0,0,BGPPTYPE,3)
....D W^BGP8DP($P(^TMP($J,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U,3),0,0,BGPPTYPE,4)
....;D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,2),0,0,BGPPTYPE,5)
....;D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,3),0,0,BGPPTYPE,6)
....;D S(X,1,1)
..E D
...D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,4),0,1,BGPPTYPE,1,1)
...I $P(^BGPINDRC(BGPPC,15),U,7)]"" D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,7),0,1,BGPPTYPE,1,1) ;W !?1,$P(^BGPINDRC(BGPPC,15),U,7)
...I BGPPTYPE="P" D
....D W^BGP8DP($J($P(^TMP($J,"SUMMARY NON",BGPC,BGPO,BGPPC),U),7,1)_"%",0,0,BGPPTYPE,1,35)
....D W^BGP8DP($J($P(^TMP($J,"SUMMARY NON",BGPC,BGPO,BGPPC),U,2),7,1)_"%",0,0,BGPPTYPE,1,45)
....D W^BGP8DP($J($P(^TMP($J,"SUMMARY NON",BGPC,BGPO,BGPPC),U,3),7,1)_"%",0,0,BGPPTYPE,1,55)
....;D W^BGP8DP($TR($P(^BGPINDRC(BGPPC,15),U,2),"$","^"),0,0,BGPPTYPE,1,57)
....;D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,3),0,0,BGPPTYPE,1,68)
...I BGPPTYPE="D" D
....D W^BGP8DP($P(^TMP($J,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U)_"%",0,0,BGPPTYPE,2,35)
....D W^BGP8DP($P(^TMP($J,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U,2)_"%",0,0,BGPPTYPE,3,45)
....D W^BGP8DP($P(^TMP($J,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U,3)_"%",0,0,BGPPTYPE,4,55)
....;D W^BGP8DP($TR($P(^BGPINDRC(BGPPC,15),U,2),"$","^"),0,0,BGPPTYPE,5,57)
....;D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,3),0,0,BGPPTYPE,6,68)
...I $P(^BGPINDRC(BGPPC,15),U,9)]""!($P(^BGPINDRC(BGPPC,15),U,10)]"")!($P(^BGPINDRC(BGPPC,15),U,11)]"") D
....D W^BGP8DP($TR($P(^BGPINDRC(BGPPC,15),U,10),"$","^"),0,0,BGPPTYPE,5,57),W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,11),0,0,BGPPTYPE,6,68)
....D W^BGP8DP("",0,0,BGPPTYPE)
I BGPPTYPE="P",$Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
D W^BGP8DP(" *Non-GPRA measure included in the IHS GPRA report submitted to OMB to",0,2,BGPPTYPE)
D W^BGP8DP("provide context to other GPRA measures.",0,1,BGPPTYPE)
D W^BGP8DP("",0,1,BGPPTYPE)
Q
;
D HEADER^BGP8DPH
D H1
Q
;
H1 ;
S X="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY" D W^BGP8DP(X,1,1,BGPPTYPE)
I $G(BGPAREAA) D W^BGP8DP("Area",0,1,BGPPTYPE,2,35),W^BGP8DP("Area",0,0,BGPPTYPE,3,45),W^BGP8DP("Area",0,0,BGPPTYPE,4,55) ;,W^BGP8DP("Nat'l",0,0,BGPPTYPE,5,57),W^BGP8DP("2020",0,0,BGPPTYPE,6,68)
I '$G(BGPAREAA) D W^BGP8DP("Site",0,1,BGPPTYPE,2,35),W^BGP8DP("Site",0,0,BGPPTYPE,3,45),W^BGP8DP("Site",0,0,BGPPTYPE,4,55) ;,W^BGP8DP("Nat'l",0,0,BGPPTYPE,5,57),W^BGP8DP("2020",0,0,BGPPTYPE,6,68)
D W^BGP8DP("Current",0,1,BGPPTYPE,2,35),W^BGP8DP("Previous",0,0,BGPPTYPE,3,45),W^BGP8DP("Baseline",0,0,BGPPTYPE,4,55) ;,W^BGP8DP("2017",0,0,BGPPTYPE,5,57),W^BGP8DP("Target",0,0,BGPPTYPE,6,68)
D W^BGP8DP($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")
;----------
BGP8DSPN ; IHS/CMI/LAB - IHS summary page ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
START ;
+1 IF BGPRTYPE'=1
QUIT
+2 ;not on gpra pat list
IF $GET(BGPNPL)
QUIT
+3 ;not on comp list
IF $GET(BGPCPPL)
QUIT
+4 SET BGPQUIT=""
+5 DO HEADER
+6 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARY NON",BGPC))
IF BGPC'=+BGPC!(BGPQUIT)
QUIT
Begin DoDot:1
+7 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+8 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+9 DO W^BGP8DP("",0,1,BGPPTYPE)
+10 DO W^BGP8DP($PIECE(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
+11 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARY NON",BGPC,BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:2
+12 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY NON",BGPC,BGPO,0))
+13 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-4)
DO HEADER
IF BGPQUIT
QUIT
+14 IF $PIECE(^BGPINDRC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDRC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDRC(BGPPC,0),U,4)["016.A.5")!($PIECE($GET(^BGPINDRC(BGPPC,19)),U,13))
Begin DoDot:3
+15 DO W^BGP8DP($PIECE(^BGPINDRC(BGPPC,15),U,4),0,1,BGPPTYPE,1,1)
+16 ;I $P(^BGPINDRC(BGPPC,15),U,7)]"" D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,7),0,1,BGPPTYPE,1,1) ;W !?1,$P(^BGPINDRC(BGPPC,15),U,7)
+17 IF BGPPTYPE="P"
Begin DoDot:4
+18 DO W^BGP8DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY NON",BGPC,BGPO,BGPPC),U),7,0),0,0,BGPPTYPE,1,35)
+19 DO W^BGP8DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY NON",BGPC,BGPO,BGPPC),U,2),7,0),0,0,BGPPTYPE,1,45)
+20 DO W^BGP8DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY NON",BGPC,BGPO,BGPPC),U,3),7,0),0,0,BGPPTYPE,1,55)
+21 ;D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,2),0,0,BGPPTYPE,1,57)
+22 ;D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,3),0,0,BGPPTYPE,1,68)
End DoDot:4
+23 IF BGPPTYPE="D"
Begin DoDot:4
+24 DO W^BGP8DP($PIECE(^TMP($JOB,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U),0,0,BGPPTYPE,2)
+25 DO W^BGP8DP($PIECE(^TMP($JOB,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U,2),0,0,BGPPTYPE,3)
+26 DO W^BGP8DP($PIECE(^TMP($JOB,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U,3),0,0,BGPPTYPE,4)
+27 ;D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,2),0,0,BGPPTYPE,5)
+28 ;D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,3),0,0,BGPPTYPE,6)
+29 ;D S(X,1,1)
End DoDot:4
End DoDot:3
IF 1
+30 IF '$TEST
Begin DoDot:3
+31 DO W^BGP8DP($PIECE(^BGPINDRC(BGPPC,15),U,4),0,1,BGPPTYPE,1,1)
+32 ;W !?1,$P(^BGPINDRC(BGPPC,15),U,7)
IF $PIECE(^BGPINDRC(BGPPC,15),U,7)]""
DO W^BGP8DP($PIECE(^BGPINDRC(BGPPC,15),U,7),0,1,BGPPTYPE,1,1)
+33 IF BGPPTYPE="P"
Begin DoDot:4
+34 DO W^BGP8DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY NON",BGPC,BGPO,BGPPC),U),7,1)_"%",0,0,BGPPTYPE,1,35)
+35 DO W^BGP8DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY NON",BGPC,BGPO,BGPPC),U,2),7,1)_"%",0,0,BGPPTYPE,1,45)
+36 DO W^BGP8DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY NON",BGPC,BGPO,BGPPC),U,3),7,1)_"%",0,0,BGPPTYPE,1,55)
+37 ;D W^BGP8DP($TR($P(^BGPINDRC(BGPPC,15),U,2),"$","^"),0,0,BGPPTYPE,1,57)
+38 ;D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,3),0,0,BGPPTYPE,1,68)
End DoDot:4
+39 IF BGPPTYPE="D"
Begin DoDot:4
+40 DO W^BGP8DP($PIECE(^TMP($JOB,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U)_"%",0,0,BGPPTYPE,2,35)
+41 DO W^BGP8DP($PIECE(^TMP($JOB,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U,2)_"%",0,0,BGPPTYPE,3,45)
+42 DO W^BGP8DP($PIECE(^TMP($JOB,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U,3)_"%",0,0,BGPPTYPE,4,55)
+43 ;D W^BGP8DP($TR($P(^BGPINDRC(BGPPC,15),U,2),"$","^"),0,0,BGPPTYPE,5,57)
+44 ;D W^BGP8DP($P(^BGPINDRC(BGPPC,15),U,3),0,0,BGPPTYPE,6,68)
End DoDot:4
+45 IF $PIECE(^BGPINDRC(BGPPC,15),U,9)]""!($PIECE(^BGPINDRC(BGPPC,15),U,10)]"")!($PIECE(^BGPINDRC(BGPPC,15),U,11)]"")
Begin DoDot:4
+46 DO W^BGP8DP($TRANSLATE($PIECE(^BGPINDRC(BGPPC,15),U,10),"$","^"),0,0,BGPPTYPE,5,57)
DO W^BGP8DP($PIECE(^BGPINDRC(BGPPC,15),U,11),0,0,BGPPTYPE,6,68)
+47 DO W^BGP8DP("",0,0,BGPPTYPE)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+48 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-2)
DO HEADER
IF BGPQUIT
QUIT
+49 DO W^BGP8DP(" *Non-GPRA measure included in the IHS GPRA report submitted to OMB to",0,2,BGPPTYPE)
+50 DO W^BGP8DP("provide context to other GPRA measures.",0,1,BGPPTYPE)
+51 DO W^BGP8DP("",0,1,BGPPTYPE)
+52 QUIT
+53 ;
+1 DO HEADER^BGP8DPH
+2 DO H1
+3 QUIT
+4 ;
H1 ;
+1 SET X="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY"
DO W^BGP8DP(X,1,1,BGPPTYPE)
+2 ;,W^BGP8DP("Nat'l",0,0,BGPPTYPE,5,57),W^BGP8DP("2020",0,0,BGPPTYPE,6,68)
IF $GET(BGPAREAA)
DO W^BGP8DP("Area",0,1,BGPPTYPE,2,35)
DO W^BGP8DP("Area",0,0,BGPPTYPE,3,45)
DO W^BGP8DP("Area",0,0,BGPPTYPE,4,55)
+3 ;,W^BGP8DP("Nat'l",0,0,BGPPTYPE,5,57),W^BGP8DP("2020",0,0,BGPPTYPE,6,68)
IF '$GET(BGPAREAA)
DO W^BGP8DP("Site",0,1,BGPPTYPE,2,35)
DO W^BGP8DP("Site",0,0,BGPPTYPE,3,45)
DO W^BGP8DP("Site",0,0,BGPPTYPE,4,55)
+4 ;,W^BGP8DP("2017",0,0,BGPPTYPE,5,57),W^BGP8DP("Target",0,0,BGPPTYPE,6,68)
DO W^BGP8DP("Current",0,1,BGPPTYPE,2,35)
DO W^BGP8DP("Previous",0,0,BGPPTYPE,3,45)
DO W^BGP8DP("Baseline",0,0,BGPPTYPE,4,55)
+5 DO W^BGP8DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+6 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 ;----------
