- 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 ;----------
