- BGP9DSP ; IHS/CMI/LAB - IHS summary page ;
- ;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
- ;
- START ;
- I BGPRTYPE'=1 Q
- I $G(BGPNPL) Q ;not on gpra pat list
- I $G(BGPCPPL) Q ;not on comp list
- S BGPQUIT="",BGPGPG=0
- D HEADER
- NEW P8,P4,P7,P12
- S P8=$S('$G(BGPNGR09):8,1:13)
- S P4=$S('$G(BGPNGR09):4,1:14)
- S P7=$S('$G(BGPNGR09):7,1:15)
- S P12=$S('$G(BGPNGR09):12,1:16)
- S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
- .I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- .S BGPC1=$O(^BGPSCAT("C",BGPC,0))
- .W !
- .W !,$P(^BGPSCAT(BGPC1,0),U)
- .S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARY",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
- ..S BGPPC=$O(^TMP($J,"SUMMARY",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 !,$P(^BGPINDNC(BGPPC,14),U,P4)
- ...I $P(^BGPINDNC(BGPPC,14),U,P7)]"" W !,$P(^BGPINDNC(BGPPC,14),U,P7)
- ...I $P(^BGPINDNC(BGPPC,14),U,P12)]"" W !,$P(^BGPINDNC(BGPPC,14),U,P12)
- ...W ?26,$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U),7,0)
- ...W ?34,$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,0)
- ...W ?41,$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,0)
- ...W ?53,$P(^BGPINDNC(BGPPC,14),U,P8),?64,$P(^BGPINDNC(BGPPC,14),U,2),?73,$P(^BGPINDNC(BGPPC,14),U,3)
- ..E D
- ...W !,$P(^BGPINDNC(BGPPC,14),U,P4)
- ...I $P(^BGPINDNC(BGPPC,14),U,P7)]"" W !,$P(^BGPINDNC(BGPPC,14),U,P7)
- ...I $P(^BGPINDNC(BGPPC,14),U,P12)]"" W !,$P(^BGPINDNC(BGPPC,14),U,P12)
- ...W ?26,$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U),7,1),"%"
- ...W ?34,$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,1),"%"
- ...W ?41,$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,1),"%"
- ...W ?53,$TR($P(^BGPINDNC(BGPPC,14),U,P8),"$","^"),?64,$TR($P(^BGPINDNC(BGPPC,14),U,2),"$","^"),?73,$P(^BGPINDNC(BGPPC,14),U,3)
- ...I $P(^BGPINDNC(BGPPC,14),U,9)]""!($P(^BGPINDNC(BGPPC,14),U,10)]"")!($P(^BGPINDNC(BGPPC,14),U,11)]"") W !?53,$TR($P(^BGPINDNC(BGPPC,14),U,9),"$","^"),?64,$TR($P(^BGPINDNC(BGPPC,14),U,10),"$","^"),?73,$P(^BGPINDNC(BGPPC,14),U,11)
- I $Y>(BGPIOSL-9) D HEADER Q:BGPQUIT
- I $G(BGPNGR09) D FOOTER10 Q
- W !," * Measure definition changed in 2007."
- W !,"** Not official GPRA measure but included to show percentage of refusals with",!,"respect to GPRA measure."
- W !," + Site Previous and Site Baseline values are not applicable for this measure."
- W !
- Q
- W !," * GPRA 2010 targets represented here are preliminary targets since they will"
- W !,"be adjusted for FY 2009 actual results and FY 2010 appropriations."
- W !," ** Measure definition changed in 2007."
- W !,"*** Not official GPRA measure but included to show percentage of refusals with",!,"respect to GPRA measure."
- W !," + Site Previous and Site Baseline values are not applicable for this measure."
- W !
- Q
- ;
- D HEADER^BGP9DPH
- D H1
- Q
- H1 ;
- S X="OFFICIAL GPRA MEASURES CLINICAL PERFORMANCE SUMMARY" W !,$$CTR(X,80)
- I $G(BGPAREAA) W !?26," Area",?34," Area",?43," Area",?53,$S('$G(BGPNGR09):"GPRA09",1:"GPRA10"),?64,"Nat'l",?73,"2010"
- I '$G(BGPAREAA) W !?26," Site",?34," Site",?43," Site",?53,$S('$G(BGPNGR09):"GPRA09",1:"GPRA10"),?64,"Nat'l",?73,"2010"
- W !?26,"Current",?34,"Previous",?43,"Baseline",?53,"Target"_$S($G(BGPNGR09):"*",1:""),?64,"2008",?73,"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")
- ;----------
- BGP9DSP ; IHS/CMI/LAB - IHS summary page ;
- +1 ;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
- +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=""
- SET BGPGPG=0
- +5 DO HEADER
- +6 NEW P8,P4,P7,P12
- +7 SET P8=$SELECT('$GET(BGPNGR09):8,1:13)
- +8 SET P4=$SELECT('$GET(BGPNGR09):4,1:14)
- +9 SET P7=$SELECT('$GET(BGPNGR09):7,1:15)
- +10 SET P12=$SELECT('$GET(BGPNGR09):12,1:16)
- +11 SET BGPC=0
- FOR
- SET BGPC=$ORDER(^TMP($JOB,"SUMMARY",BGPC))
- IF BGPC'=+BGPC!(BGPQUIT)
- QUIT
- Begin DoDot:1
- +12 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +13 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
- +14 WRITE !
- +15 WRITE !,$PIECE(^BGPSCAT(BGPC1,0),U)
- +16 SET BGPO=""
- FOR
- SET BGPO=$ORDER(^TMP($JOB,"SUMMARY",BGPC,BGPO))
- IF BGPO=""!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +17 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY",BGPC,BGPO,0))
- +18 IF $Y>(BGPIOSL-4)
- DO HEADER
- IF BGPQUIT
- QUIT
- +19 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
- +20 WRITE !,$PIECE(^BGPINDNC(BGPPC,14),U,P4)
- +21 IF $PIECE(^BGPINDNC(BGPPC,14),U,P7)]""
- WRITE !,$PIECE(^BGPINDNC(BGPPC,14),U,P7)
- +22 IF $PIECE(^BGPINDNC(BGPPC,14),U,P12)]""
- WRITE !,$PIECE(^BGPINDNC(BGPPC,14),U,P12)
- +23 WRITE ?26,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U),7,0)
- +24 WRITE ?34,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,0)
- +25 WRITE ?41,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,0)
- +26 WRITE ?53,$PIECE(^BGPINDNC(BGPPC,14),U,P8),?64,$PIECE(^BGPINDNC(BGPPC,14),U,2),?73,$PIECE(^BGPINDNC(BGPPC,14),U,3)
- End DoDot:3
- IF 1
- +27 IF '$TEST
- Begin DoDot:3
- +28 WRITE !,$PIECE(^BGPINDNC(BGPPC,14),U,P4)
- +29 IF $PIECE(^BGPINDNC(BGPPC,14),U,P7)]""
- WRITE !,$PIECE(^BGPINDNC(BGPPC,14),U,P7)
- +30 IF $PIECE(^BGPINDNC(BGPPC,14),U,P12)]""
- WRITE !,$PIECE(^BGPINDNC(BGPPC,14),U,P12)
- +31 WRITE ?26,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U),7,1),"%"
- +32 WRITE ?34,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,1),"%"
- +33 WRITE ?41,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,1),"%"
- +34 WRITE ?53,$TRANSLATE($PIECE(^BGPINDNC(BGPPC,14),U,P8),"$","^"),?64,$TRANSLATE($PIECE(^BGPINDNC(BGPPC,14),U,2),"$","^"),?73,$PIECE(^BGPINDNC(BGPPC,14),U,3)
- +35 IF $PIECE(^BGPINDNC(BGPPC,14),U,9)]""!($PIECE(^BGPINDNC(BGPPC,14),U,10)]"")!($PIECE(^BGPINDNC(BGPPC,14),U,11)]"")
- WRITE !?53,$TRANSLATE($PIECE(^BGPINDNC(BGPPC,14),U,9),"$","^"),?64,$TRANSLATE($PIECE(^BGPINDNC(BGPPC,14),U,10),"$","^"),?73,$PIECE(^BGPINDNC(BGPPC,14),U,11)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +36 IF $Y>(BGPIOSL-9)
- DO HEADER
- IF BGPQUIT
- QUIT
- +37 IF $GET(BGPNGR09)
- DO FOOTER10
- QUIT
- +38 WRITE !," * Measure definition changed in 2007."
- +39 WRITE !,"** Not official GPRA measure but included to show percentage of refusals with",!,"respect to GPRA measure."
- +40 WRITE !," + Site Previous and Site Baseline values are not applicable for this measure."
- +41 WRITE !
- +42 QUIT
- +1 WRITE !," * GPRA 2010 targets represented here are preliminary targets since they will"
- +2 WRITE !,"be adjusted for FY 2009 actual results and FY 2010 appropriations."
- +3 WRITE !," ** Measure definition changed in 2007."
- +4 WRITE !,"*** Not official GPRA measure but included to show percentage of refusals with",!,"respect to GPRA measure."
- +5 WRITE !," + Site Previous and Site Baseline values are not applicable for this measure."
- +6 WRITE !
- +7 QUIT
- +8 ;
- +1 DO HEADER^BGP9DPH
- +2 DO H1
- +3 QUIT
- H1 ;
- +1 SET X="OFFICIAL GPRA MEASURES CLINICAL PERFORMANCE SUMMARY"
- WRITE !,$$CTR(X,80)
- +2 IF $GET(BGPAREAA)
- WRITE !?26," Area",?34," Area",?43," Area",?53,$SELECT('$GET(BGPNGR09):"GPRA09",1:"GPRA10"),?64,"Nat'l",?73,"2010"
- +3 IF '$GET(BGPAREAA)
- WRITE !?26," Site",?34," Site",?43," Site",?53,$SELECT('$GET(BGPNGR09):"GPRA09",1:"GPRA10"),?64,"Nat'l",?73,"2010"
- +4 WRITE !?26,"Current",?34,"Previous",?43,"Baseline",?53,"Target"_$SELECT($GET(BGPNGR09):"*",1:""),?64,"2008",?73,"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 ;----------
