- BGP9SDPN ; IHS/CMI/LAB - IHS summary page ;
- ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
- ;
- START ;
- I '$G(BGPAREAA) Q
- I BGPRTYPE'=1 Q
- S BGPQUIT="",BGPGPG=0
- D HEADER
- S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY DETAIL PAGE NON",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 DETAIL PAGE NON",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
- ..S BGPPC=$O(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,0))
- ..I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- ..W !!?1,$P(^BGPINDNC(BGPPC,15),U,4)
- ..I $P(^BGPINDNC(BGPPC,15),U,7)]"" W !,$P(^BGPINDNC(BGPPC,15),U,7)
- ..I $P(^BGPINDNC(BGPPC,15),U,12)]"" W !,$P(^BGPINDNC(BGPPC,15),U,12)
- ..S F=$O(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,0))
- ..S F=$P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,F),U,4)
- ..W ?46,F,$S($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)):"",1:"%")
- ..W ?55,$P(^BGPINDNC(BGPPC,15),U,2),?65,$P(^BGPINDNC(BGPPC,15),U,3)
- ..I $P(^BGPINDNC(BGPPC,15),U,9)]""!($P(^BGPINDNC(BGPPC,15),U,10)]"")!($P(^BGPINDNC(BGPPC,15),U,11)]"") W !?55,$TR($P(^BGPINDNC(BGPPC,15),U,10),"$","^"),?65,$P(^BGPINDNC(BGPPC,15),U,11)
- ..S BGPSN=0 F S BGPSN=$O(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN!(BGPQUIT) D
- ...S BGPSASU=$P(^BGPGPDCN(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)) S BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCN(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
- ...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
- ....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- ....W !?2,BGPSASU,?8,$E(BGPSNAM,1,12)
- ....W ?20,$J($P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U),7,0)
- ....W ?29,$J($P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0)
- ....W ?38,$J($P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0)
- ...E D
- ....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- ....W !?2,BGPSASU,?8,$E(BGPSNAM,1,12)
- ....W ?20,$J($P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U),7,1),"%"
- ....W ?29,$J($P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1),"%"
- ....W ?38,$J($P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1),"%"
- I $Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
- W !!," *Non-GPRA measure included in the IHS GPRA report submitted to OMB to"
- W !,"provide context to other GPRA measures."
- W !
- Q
- ;
- D HEADER^BGP9DPH
- D H1
- Q
- H1 ;
- I BGPRTYPE=1 S X="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE DETAIL" W !,$$CTR(X,80)
- W !?22," Site",?32,"Site",?40,"Site",?46,"Area",?55,"Nat'l",?66,"2010"
- W !?22,"Current",?32,"Prev",?40,"Base",?46,"Current",?55,"2008",?66,"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")
- ;----------
- BGP9SDPN ; IHS/CMI/LAB - IHS summary page ;
- +1 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
- +2 ;
- START ;
- +1 IF '$GET(BGPAREAA)
- QUIT
- +2 IF BGPRTYPE'=1
- QUIT
- +3 SET BGPQUIT=""
- SET BGPGPG=0
- +4 DO HEADER
- +5 SET BGPC=0
- FOR
- SET BGPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC))
- IF BGPC'=+BGPC!(BGPQUIT)
- QUIT
- Begin DoDot:1
- +6 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +7 SET BGPC1=$ORDER(^BGPSCAT("D",BGPC,0))
- +8 WRITE !
- +9 WRITE !,$PIECE(^BGPSCAT(BGPC1,0),U)
- +10 SET BGPO=""
- FOR
- SET BGPO=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO))
- IF BGPO=""!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +11 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,0))
- +12 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +13 WRITE !!?1,$PIECE(^BGPINDNC(BGPPC,15),U,4)
- +14 IF $PIECE(^BGPINDNC(BGPPC,15),U,7)]""
- WRITE !,$PIECE(^BGPINDNC(BGPPC,15),U,7)
- +15 IF $PIECE(^BGPINDNC(BGPPC,15),U,12)]""
- WRITE !,$PIECE(^BGPINDNC(BGPPC,15),U,12)
- +16 SET F=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,0))
- +17 SET F=$PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,F),U,4)
- +18 WRITE ?46,F,$SELECT($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)):"",1:"%")
- +19 WRITE ?55,$PIECE(^BGPINDNC(BGPPC,15),U,2),?65,$PIECE(^BGPINDNC(BGPPC,15),U,3)
- +20 IF $PIECE(^BGPINDNC(BGPPC,15),U,9)]""!($PIECE(^BGPINDNC(BGPPC,15),U,10)]"")!($PIECE(^BGPINDNC(BGPPC,15),U,11)]"")
- WRITE !?55,$TRANSLATE($PIECE(^BGPINDNC(BGPPC,15),U,10),"$","^"),?65,$PIECE(^BGPINDNC(BGPPC,15),U,11)
- +21 SET BGPSN=0
- FOR
- SET BGPSN=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN))
- IF BGPSN'=+BGPSN!(BGPQUIT)
- QUIT
- Begin DoDot:3
- +22 SET BGPSASU=$PIECE(^BGPGPDCN(BGPSN,0),U,9)
- SET X=$ORDER(^AUTTLOC("C",BGPSASU,0))
- SET BGPSNAM=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
- SET BGPSNAM=$SELECT($PIECE(^BGPGPDCN(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
- +23 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:4
- +24 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +25 WRITE !?2,BGPSASU,?8,$EXTRACT(BGPSNAM,1,12)
- +26 WRITE ?20,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U),7,0)
- +27 WRITE ?29,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0)
- +28 WRITE ?38,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0)
- End DoDot:4
- IF 1
- +29 IF '$TEST
- Begin DoDot:4
- +30 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +31 WRITE !?2,BGPSASU,?8,$EXTRACT(BGPSNAM,1,12)
- +32 WRITE ?20,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U),7,1),"%"
- +33 WRITE ?29,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1),"%"
- +34 WRITE ?38,$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1),"%"
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +35 IF $Y>(BGPIOSL-2)
- DO HEADER
- IF BGPQUIT
- QUIT
- +36 WRITE !!," *Non-GPRA measure included in the IHS GPRA report submitted to OMB to"
- +37 WRITE !,"provide context to other GPRA measures."
- +38 WRITE !
- +39 QUIT
- +40 ;
- +1 DO HEADER^BGP9DPH
- +2 DO H1
- +3 QUIT
- H1 ;
- +1 IF BGPRTYPE=1
- SET X="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE DETAIL"
- WRITE !,$$CTR(X,80)
- +2 WRITE !?22," Site",?32,"Site",?40,"Site",?46,"Area",?55,"Nat'l",?66,"2010"
- +3 WRITE !?22,"Current",?32,"Prev",?40,"Base",?46,"Current",?55,"2008",?66,"Target"
- +4 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
- +5 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 ;----------
