BGP9DSPO ; IHS/CMI/LAB - IHS summary page ;
;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
;
START ;
I BGPRTYPE'=7 Q
I $G(BGPNPL) Q ;not on gpra pat list
I $G(BGPCPPL) Q ;not on comp list
S BGPQUIT="",BGPGPG=0
D HEADER
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY OTHER",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
.I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
.S BGPC1=$O(^BGPSCAT("D",BGPC,0))
.W !
.W !,$P(^BGPSCAT(BGPC1,0),U)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARY OTHER",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
..S BGPPC=$O(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,0))
..I $Y>(BGPIOSL-4) D HEADER Q:BGPQUIT
..I $P(^BGPINDNC(BGPPC,0),U,4)["014."!($P(^BGPINDNC(BGPPC,0),U,4)["023.")!($P(^BGPINDNC(BGPPC,0),U,4)["016")!($P($G(^BGPINDNC(BGPPC,19)),U,13)) D I 1
...W !?1,$P(^BGPINDNC(BGPPC,19),U,4)
...I $P(^BGPINDNC(BGPPC,19),U,7)]"" W !?1,$P(^BGPINDNC(BGPPC,19),U,7)
...W ?26,$J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U),7,0)
...W ?34,$J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,2),7,0)
...W ?41,$J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,3),7,0)
...W ?57,$P(^BGPINDNC(BGPPC,19),U,2),?68,$P(^BGPINDNC(BGPPC,19),U,3)
..E D
...W !?1,$P(^BGPINDNC(BGPPC,19),U,4)
...I $P(^BGPINDNC(BGPPC,19),U,7)]"" W !?1,$P(^BGPINDNC(BGPPC,19),U,7)
...W ?26,$J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U),7,1),"%"
...W ?34,$J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,2),7,1),"%"
...W ?41,$J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,3),7,1),"%"
...W ?57,$TR($P(^BGPINDNC(BGPPC,19),U,2),"$","^"),?68,$P(^BGPINDNC(BGPPC,19),U,3)
...I $P(^BGPINDNC(BGPPC,19),U,9)]""!($P(^BGPINDNC(BGPPC,19),U,10)]"")!($P(^BGPINDNC(BGPPC,19),U,11)]"") W !?57,$TR($P(^BGPINDNC(BGPPC,19),U,10),"$","^"),?68,$P(^BGPINDNC(BGPPC,19),U,11)
I $Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
W !
Q
;
D HEADER^BGP9DPH
D H1
Q
H1 ;
S X="SELECTED OTHER NATIONAL MEASURES CLINICAL PERFORMANCE SUMMARY" W !,$$CTR(X,80)
I $G(BGPAREAA) W !?26," Area",?34," Area",?43," Area",?57,"Nat'l",?68,"2010"
I '$G(BGPAREAA) W !?26," Site",?34," Site",?43," Site",?57,"Nat'l",?68,"2010"
W !?26,"Current",?34,"Previous",?43,"Baseline",?57,"2008",?68,"Target"
W !,$TR($J("",80)," ","-")
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")
;----------
BGP9DSPO ; IHS/CMI/LAB - IHS summary page ;
+1 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
+2 ;
START ;
+1 IF BGPRTYPE'=7
QUIT
+2 ;not on gpra pat list
IF $GET(BGPNPL)
QUIT
+3 ;not on comp list
IF $GET(BGPCPPL)
QUIT
+4 SET BGPQUIT=""
SET BGPGPG=0
+5 DO HEADER
+6 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARY OTHER",BGPC))
IF BGPC'=+BGPC!(BGPQUIT)
QUIT
Begin DoDot:1
+7 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+8 SET BGPC1=$ORDER(^BGPSCAT("D",BGPC,0))
+9 WRITE !
+10 WRITE !,$PIECE(^BGPSCAT(BGPC1,0),U)
+11 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:2
+12 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,0))
+13 IF $Y>(BGPIOSL-4)
DO HEADER
IF BGPQUIT
QUIT
+14 IF $PIECE(^BGPINDNC(BGPPC,0),U,4)["014."!($PIECE(^BGPINDNC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDNC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDNC(BGPPC,19)),U,13))
Begin DoDot:3
+15 WRITE !?1,$PIECE(^BGPINDNC(BGPPC,19),U,4)
+16 IF $PIECE(^BGPINDNC(BGPPC,19),U,7)]""
WRITE !?1,$PIECE(^BGPINDNC(BGPPC,19),U,7)
+17 WRITE ?26,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U),7,0)
+18 WRITE ?34,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,2),7,0)
+19 WRITE ?41,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,3),7,0)
+20 WRITE ?57,$PIECE(^BGPINDNC(BGPPC,19),U,2),?68,$PIECE(^BGPINDNC(BGPPC,19),U,3)
End DoDot:3
IF 1
+21 IF '$TEST
Begin DoDot:3
+22 WRITE !?1,$PIECE(^BGPINDNC(BGPPC,19),U,4)
+23 IF $PIECE(^BGPINDNC(BGPPC,19),U,7)]""
WRITE !?1,$PIECE(^BGPINDNC(BGPPC,19),U,7)
+24 WRITE ?26,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U),7,1),"%"
+25 WRITE ?34,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,2),7,1),"%"
+26 WRITE ?41,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,3),7,1),"%"
+27 WRITE ?57,$TRANSLATE($PIECE(^BGPINDNC(BGPPC,19),U,2),"$","^"),?68,$PIECE(^BGPINDNC(BGPPC,19),U,3)
+28 IF $PIECE(^BGPINDNC(BGPPC,19),U,9)]""!($PIECE(^BGPINDNC(BGPPC,19),U,10)]"")!($PIECE(^BGPINDNC(BGPPC,19),U,11)]"")
WRITE !?57,$TRANSLATE($PIECE(^BGPINDNC(BGPPC,19),U,10),"$","^"),?68,$PIECE(^BGPINDNC(BGPPC,19),U,11)
End DoDot:3
End DoDot:2
End DoDot:1
+29 IF $Y>(BGPIOSL-2)
DO HEADER
IF BGPQUIT
QUIT
+30 WRITE !
+31 QUIT
+32 ;
+1 DO HEADER^BGP9DPH
+2 DO H1
+3 QUIT
H1 ;
+1 SET X="SELECTED OTHER NATIONAL MEASURES CLINICAL PERFORMANCE SUMMARY"
WRITE !,$$CTR(X,80)
+2 IF $GET(BGPAREAA)
WRITE !?26," Area",?34," Area",?43," Area",?57,"Nat'l",?68,"2010"
+3 IF '$GET(BGPAREAA)
WRITE !?26," Site",?34," Site",?43," Site",?57,"Nat'l",?68,"2010"
+4 WRITE !?26,"Current",?34,"Previous",?43,"Baseline",?57,"2008",?68,"Target"
+5 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+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 ;----------
