BGP9DPH ; IHS/CMI/LAB - AREA REPORT HEADER 01 Jul 2008 7:54 PM ;
;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
;
;HEADERS FOR REPORTS
CALC(N,O) ;ENTRY POINT
NEW Z
;I O=0!(N=0)!(O="")!(N="") Q "**"
;NEW X,X2,X3
;S X=N,X2=1,X3=0 D COMMA^%DTC S N=X
;S X=O,X2=1,X3=0 D COMMA^%DTC S O=X
;I +O=0 Q "**"
;S Z=(((N-O)/O)*100),Z=$FN(Z,"+,",1)
S Z=N-O,Z=$FN(Z,"+,",1)
Q Z
C(X,X2,X3) ;
D COMMA^%DTC
Q X
H2 ;EP
Q:$G(BGPSUMON)
S BGPX="",BGPX=$$C(BGPCYN,0,8),$E(BGPX,9)=$J(BGPCYP,5,1),$E(BGPX,16)=$$C(BGPPRN,0,8),$E(BGPX,24)=$J(BGPPRP,5,1),$E(BGPX,32)=$J($$CALC(BGPCYP,BGPPRP),6),$E(BGPX,39)=$$C(BGPBLN,0,8),$E(BGPX,47)=$J(BGPBLP,5,1)
S $E(BGPX,55)=$J($$CALC(BGPCYP,BGPBLP),6)
W ?20,BGPX
Q
H6 ;EP
Q:$G(BGPSUMON)
W !,"Age specific Exercise Education Provided",!!,$$CTR(BGPHD1,80),!
W !?40,"Age Distribution"
W !?25,"0-9",?30,"10-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs",!
Q
H3 ;EP
Q:$G(BGPSUMON)
W !!,$$CTR(BGPHD1,80)
W !?40,"Age Distribution"
W !?25,"<15",?30,"15-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs",!
Q
H4 ;EP
Q:$G(BGPSUMON)
W !!,$$CTR(BGPHD1,80)
W !?40,"Age Distribution"
W !?35,"<12",?46,"12-17",?58,"=>18",!
Q
H5 ;
Q:$G(BGPSUMON)
W !,"Age specific Tobacco Use Prevalence",!,$$CTR(BGPHD1,80)
W !?40,"Age Distribution"
W !?25,"0-9",?30,"10-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs"
Q
H1 ;EP
Q:$G(BGPSUMON)
W !!?21,"REPORT",?31,"%",?35,"PREV YR",?46,"%",?49,"CHG from",?59,"BASE",?69,"%",?72,"CHG from"
W !?21,"PERIOD",?35,"PERIOD",?49,"PREV YR %",?59,"PERIOD",?72,"BASE %"
Q
H9 ;EP
Q:$G(BGPSUMON)
W !!,$$CTR(BGPHD1,80)
W !?40,"Age Distribution"
W !?25,"0-5",?30,"6-11",?37,"12-19",?44,"20-34",?51,"35-44",?58,"45-54",?65,"55-74",?72,">74 yrs",!
Q
G:'BGPGPG HEADER1
K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQUIT=1 Q
W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
I $G(BGPGUI) W "ZZZZZZZ",! ;maw
W $P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
I BGPRTYPE=4,$G(BGP9RPTH)="C" W $$CTR("*** IHS 2009 Selected Measures with Community Specified Report ***",80),!
I BGPRTYPE=4,$G(BGP9RPTH)="A" W $$CTR("*** IHS 2009 Selected Measures with All Communities Report ***",80),!
I BGPRTYPE=4,$G(BGP9RPTH)="P" W $$CTR("*** IHS 2009 Selected Measures with Patient Panel Population Report ***",80),!
I BGPRTYPE=1,$G(BGPNGR09) W $$CTR("*** IHS 2010 National GPRA & PART Report, Run Using 2009 Logic ***",80),! G N
I BGPRTYPE=1,$G(BGPDESGP) W $$CTR("*** IHS 2009 National GPRA & PART Report by Designated Provider ***",80),!
I BGPRTYPE=1,'$G(BGP9GPU) W $$CTR("*** IHS 2009 National GPRA & PART Report ***",80),!
I BGPRTYPE=1,$G(BGP9GPU) W $$CTR("*** IHS 2009 GPRA & PART Performance Report ***",80),!
W:BGPRTYPE=3 $$CTR("*** IHS 2009 HEDIS Clinical Performance ***",80),!
W:BGPRTYPE=5 $$CTR("*** IHS 2009 ELDER CARE Clinical Performance ***",80),!
I BGPRTYPE=7 W $$CTR("IHS 2009 Other National Measures Report ***",80),!
N I $G(BGPAREAA) W $$CTR("AREA AGGREGATE",80),!
I '$G(BGPAREAA) W $$CTR($P(^DIC(4,DUZ(2),0),U),80),!
I $G(BGPDESGP) W $$CTR("Designated Provider: "_$P(^VA(200,BGPDESGP,0),U),80),!
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W $$CTR(X,80),!
S X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) W $$CTR(X,80),!
S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) W $$CTR(X,80),!
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
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR(0)="E" D ^DIR
Q
;----------
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")
;----------
BGP9DPH ; IHS/CMI/LAB - AREA REPORT HEADER 01 Jul 2008 7:54 PM ;
+1 ;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
+2 ;
+3 ;HEADERS FOR REPORTS
CALC(N,O) ;ENTRY POINT
+1 NEW Z
+2 ;I O=0!(N=0)!(O="")!(N="") Q "**"
+3 ;NEW X,X2,X3
+4 ;S X=N,X2=1,X3=0 D COMMA^%DTC S N=X
+5 ;S X=O,X2=1,X3=0 D COMMA^%DTC S O=X
+6 ;I +O=0 Q "**"
+7 ;S Z=(((N-O)/O)*100),Z=$FN(Z,"+,",1)
+8 SET Z=N-O
SET Z=$FNUMBER(Z,"+,",1)
+9 QUIT Z
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
H2 ;EP
+1 IF $GET(BGPSUMON)
QUIT
+2 SET BGPX=""
SET BGPX=$$C(BGPCYN,0,8)
SET $EXTRACT(BGPX,9)=$JUSTIFY(BGPCYP,5,1)
SET $EXTRACT(BGPX,16)=$$C(BGPPRN,0,8)
SET $EXTRACT(BGPX,24)=$JUSTIFY(BGPPRP,5,1)
SET $EXTRACT(BGPX,32)=$JUSTIFY($$CALC(BGPCYP,BGPPRP),6)
SET $EXTRACT(BGPX,39)=$$C(BGPBLN,0,8)
SET $EXTRACT(BGPX,47)=$JUSTIFY(BGPBLP,5,1)
+3 SET $EXTRACT(BGPX,55)=$JUSTIFY($$CALC(BGPCYP,BGPBLP),6)
+4 WRITE ?20,BGPX
+5 QUIT
H6 ;EP
+1 IF $GET(BGPSUMON)
QUIT
+2 WRITE !,"Age specific Exercise Education Provided",!!,$$CTR(BGPHD1,80),!
+3 WRITE !?40,"Age Distribution"
+4 WRITE !?25,"0-9",?30,"10-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs",!
+5 QUIT
H3 ;EP
+1 IF $GET(BGPSUMON)
QUIT
+2 WRITE !!,$$CTR(BGPHD1,80)
+3 WRITE !?40,"Age Distribution"
+4 WRITE !?25,"<15",?30,"15-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs",!
+5 QUIT
H4 ;EP
+1 IF $GET(BGPSUMON)
QUIT
+2 WRITE !!,$$CTR(BGPHD1,80)
+3 WRITE !?40,"Age Distribution"
+4 WRITE !?35,"<12",?46,"12-17",?58,"=>18",!
+5 QUIT
H5 ;
+1 IF $GET(BGPSUMON)
QUIT
+2 WRITE !,"Age specific Tobacco Use Prevalence",!,$$CTR(BGPHD1,80)
+3 WRITE !?40,"Age Distribution"
+4 WRITE !?25,"0-9",?30,"10-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs"
+5 QUIT
H1 ;EP
+1 IF $GET(BGPSUMON)
QUIT
+2 WRITE !!?21,"REPORT",?31,"%",?35,"PREV YR",?46,"%",?49,"CHG from",?59,"BASE",?69,"%",?72,"CHG from"
+3 WRITE !?21,"PERIOD",?35,"PERIOD",?49,"PREV YR %",?59,"PERIOD",?72,"BASE %"
+4 QUIT
H9 ;EP
+1 IF $GET(BGPSUMON)
QUIT
+2 WRITE !!,$$CTR(BGPHD1,80)
+3 WRITE !?40,"Age Distribution"
+4 WRITE !?25,"0-5",?30,"6-11",?37,"12-19",?44,"20-34",?51,"35-44",?58,"45-54",?65,"55-74",?72,">74 yrs",!
+5 QUIT
+1 IF 'BGPGPG
GOTO HEADER1
+2 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BGPQUIT=1
QUIT
+1 IF $DATA(IOF)
WRITE @IOF
SET BGPGPG=BGPGPG+1
+2 ;maw
IF $GET(BGPGUI)
WRITE "ZZZZZZZ",!
+3 WRITE $PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
+4 IF BGPRTYPE=4
IF $GET(BGP9RPTH)="C"
WRITE $$CTR("*** IHS 2009 Selected Measures with Community Specified Report ***",80),!
+5 IF BGPRTYPE=4
IF $GET(BGP9RPTH)="A"
WRITE $$CTR("*** IHS 2009 Selected Measures with All Communities Report ***",80),!
+6 IF BGPRTYPE=4
IF $GET(BGP9RPTH)="P"
WRITE $$CTR("*** IHS 2009 Selected Measures with Patient Panel Population Report ***",80),!
+7 IF BGPRTYPE=1
IF $GET(BGPNGR09)
WRITE $$CTR("*** IHS 2010 National GPRA & PART Report, Run Using 2009 Logic ***",80),!
GOTO N
+8 IF BGPRTYPE=1
IF $GET(BGPDESGP)
WRITE $$CTR("*** IHS 2009 National GPRA & PART Report by Designated Provider ***",80),!
+9 IF BGPRTYPE=1
IF '$GET(BGP9GPU)
WRITE $$CTR("*** IHS 2009 National GPRA & PART Report ***",80),!
+10 IF BGPRTYPE=1
IF $GET(BGP9GPU)
WRITE $$CTR("*** IHS 2009 GPRA & PART Performance Report ***",80),!
+11 IF BGPRTYPE=3
WRITE $$CTR("*** IHS 2009 HEDIS Clinical Performance ***",80),!
+12 IF BGPRTYPE=5
WRITE $$CTR("*** IHS 2009 ELDER CARE Clinical Performance ***",80),!
+13 IF BGPRTYPE=7
WRITE $$CTR("IHS 2009 Other National Measures Report ***",80),!
N IF $GET(BGPAREAA)
WRITE $$CTR("AREA AGGREGATE",80),!
+1 IF '$GET(BGPAREAA)
WRITE $$CTR($PIECE(^DIC(4,DUZ(2),0),U),80),!
+2 IF $GET(BGPDESGP)
WRITE $$CTR("Designated Provider: "_$PIECE(^VA(200,BGPDESGP,0),U),80),!
+3 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
WRITE $$CTR(X,80),!
+4 SET X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
WRITE $$CTR(X,80),!
+5 SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
WRITE $$CTR(X,80),!
+6 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+7 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 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
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 ;----------
