BGP0DPH.m

BGP0DPH ; IHS/CMI/LAB - AREA REPORT HEADER 01 Jul 2009 7:54 PM ;

 ;;10.0;IHS CLINICAL REPORTING;**1**;JUN 18, 2010

 ;

 ;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

HPA ;EP

 Q:$G(BGPSUMON)

 W !!,$$CTR(BGPHD1,80)

 W !?40,"Age Distribution"

 W !?25,"5-11",?30,"12-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-74",?72,">74 yrs",!

 Q

HEADER ;EP

 I BGPPTYPE="D" 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

HEADER1 ;

 I BGPPTYPE="P" W:$D(IOF) @IOF S BGPGPG=BGPGPG+1

 I $G(BGPGUI),BGPPTYPE="P" D W^BGP0EOH("ZZZZZZZ",0,0,BGPPTYPE),W^BGP0EOH("",0,1,BGPPTYPE)  ;GUI

 I BGPPTYPE="P" S X=$P(^VA(200,DUZ,0),U,2),$E(X,35)=$$FMTE^XLFDT(DT),$E(X,70)="Page "_BGPGPG D W^BGP0EOH(X,1,1,BGPPTYPE)

 I BGPPTYPE'="P" S X=$P(^VA(200,DUZ,0),U,2),$P(X,U,2)=$$FMTE^XLFDT(DT) D W^BGP0DP(X,0,1,BGPPTYPE)

 I BGPRTYPE=4,$G(BGP0RPTH)="C" D W^BGP0DP("*** IHS 2010 Selected Measures with Community Specified Report ***",1,1,BGPPTYPE)

 I BGPRTYPE=4,$G(BGP0RPTH)="A" D W^BGP0DP("*** IHS 2010 Selected Measures with All Communities Report ***",1,1,BGPPTYPE)

 I BGPRTYPE=4,$G(BGP0RPTH)="P" D W^BGP0DP("*** IHS 2010 Selected Measures with Patient Panel Population Report ***",1,1,BGPPTYPE)

 I BGPRTYPE=1!(BGPRTYPE=9),$G(BGPNGR09) D W^BGP0DP("*** IHS 2011 National GPRA & PART Report, Run Using 2010 Logic ***",1,1,BGPPTYPE) G N

 I BGPRTYPE=1!(BGPRTYPE=9),$G(BGPDESGP) D W^BGP0DP("*** IHS 2010 National GPRA & PART Report by Designated Provider ***",1,1,BGPPTYPE)

 I BGPRTYPE=1!(BGPRTYPE=9),'$G(BGP0GPU) D W^BGP0DP("*** IHS 2010 National GPRA & PART Report ***",1,1,BGPPTYPE)

 I BGPRTYPE=1!(BGPRTYPE=9),$G(BGP0GPU) D W^BGP0DP("*** IHS 2010 GPRA & PART Performance Report ***",1,1,BGPPTYPE)

 I BGPRTYPE=9 D W^BGP0DP("*** Developmental Measures ***",1,1,BGPPTYPE)

 D:BGPRTYPE=3 W^BGP0DP("*** IHS 2010 HEDIS Clinical Performance ***",1,1,BGPPTYPE)

 D:BGPRTYPE=5 W^BGP0DP("*** IHS 2010 ELDER CARE Clinical Performance ***",1,1,BGPPTYPE)

 I BGPRTYPE=7 D W^BGP0DP("IHS 2010 Other National Measures Report ***",1,1,BGPPTYPE)

N I $G(BGPAREAA) D W^BGP0DP("AREA AGGREGATE",1,1,BGPPTYPE)

 I '$G(BGPAREAA) D W^BGP0DP($P(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)

 I $G(BGPDESGP) D W^BGP0DP("Designated Provider: "_$P(^VA(200,BGPDESGP,0),U),1,1,BGPPTYPE)

 S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGP0DP(X,1,1,BGPPTYPE)

 S X="Previous Year Period:  "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D W^BGP0DP(X,1,1,BGPPTYPE)

 S X="Baseline Period:  "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D W^BGP0DP(X,1,1,BGPPTYPE)

 D W^BGP0DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)

 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")

 ;----------

BGP0DPH   ; IHS/CMI/LAB - AREA REPORT HEADER 01 Jul 2009 7:54 PM ;

 +1       ;;10.0;IHS CLINICAL REPORTING;**1**;JUN 18, 2010

 +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 

HPA       ;EP

 +1        IF $GET(BGPSUMON)

               QUIT 

 +2        WRITE !!,$$CTR(BGPHD1,80)

 +3        WRITE !?40,"Age Distribution"

 +4        WRITE !?25,"5-11",?30,"12-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-74",?72,">74 yrs",!

 +5        QUIT 

HEADER    ;EP

 +1        IF BGPPTYPE="D"

               QUIT 

 +2        IF 'BGPGPG

               GOTO HEADER1

 +3        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 

HEADER1   ;

 +1        IF BGPPTYPE="P"

               IF $DATA(IOF)

                   WRITE @IOF

               SET BGPGPG=BGPGPG+1

 +2       ;GUI

           IF $GET(BGPGUI)

               IF BGPPTYPE="P"

                   DO W^BGP0EOH("ZZZZZZZ",0,0,BGPPTYPE)

                   DO W^BGP0EOH("",0,1,BGPPTYPE)

 +3        IF BGPPTYPE="P"

               SET X=$PIECE(^VA(200,DUZ,0),U,2)

               SET $EXTRACT(X,35)=$$FMTE^XLFDT(DT)

               SET $EXTRACT(X,70)="Page "_BGPGPG

               DO W^BGP0EOH(X,1,1,BGPPTYPE)

 +4        IF BGPPTYPE'="P"

               SET X=$PIECE(^VA(200,DUZ,0),U,2)

               SET $PIECE(X,U,2)=$$FMTE^XLFDT(DT)

               DO W^BGP0DP(X,0,1,BGPPTYPE)

 +5        IF BGPRTYPE=4

               IF $GET(BGP0RPTH)="C"

                   DO W^BGP0DP("*** IHS 2010 Selected Measures with Community Specified Report ***",1,1,BGPPTYPE)

 +6        IF BGPRTYPE=4

               IF $GET(BGP0RPTH)="A"

                   DO W^BGP0DP("*** IHS 2010 Selected Measures with All Communities Report ***",1,1,BGPPTYPE)

 +7        IF BGPRTYPE=4

               IF $GET(BGP0RPTH)="P"

                   DO W^BGP0DP("*** IHS 2010 Selected Measures with Patient Panel Population Report ***",1,1,BGPPTYPE)

 +8        IF BGPRTYPE=1!(BGPRTYPE=9)

               IF $GET(BGPNGR09)

                   DO W^BGP0DP("*** IHS 2011 National GPRA & PART Report, Run Using 2010 Logic ***",1,1,BGPPTYPE)

                   GOTO N

 +9        IF BGPRTYPE=1!(BGPRTYPE=9)

               IF $GET(BGPDESGP)

                   DO W^BGP0DP("*** IHS 2010 National GPRA & PART Report by Designated Provider ***",1,1,BGPPTYPE)

 +10       IF BGPRTYPE=1!(BGPRTYPE=9)

               IF '$GET(BGP0GPU)

                   DO W^BGP0DP("*** IHS 2010 National GPRA & PART Report ***",1,1,BGPPTYPE)

 +11       IF BGPRTYPE=1!(BGPRTYPE=9)

               IF $GET(BGP0GPU)

                   DO W^BGP0DP("*** IHS 2010 GPRA & PART Performance Report ***",1,1,BGPPTYPE)

 +12       IF BGPRTYPE=9

               DO W^BGP0DP("*** Developmental Measures ***",1,1,BGPPTYPE)

 +13       IF BGPRTYPE=3

               DO W^BGP0DP("*** IHS 2010 HEDIS Clinical Performance ***",1,1,BGPPTYPE)

 +14       IF BGPRTYPE=5

               DO W^BGP0DP("*** IHS 2010 ELDER CARE Clinical Performance ***",1,1,BGPPTYPE)

 +15       IF BGPRTYPE=7

               DO W^BGP0DP("IHS 2010 Other National Measures Report ***",1,1,BGPPTYPE)

N          IF $GET(BGPAREAA)

               DO W^BGP0DP("AREA AGGREGATE",1,1,BGPPTYPE)

 +1        IF '$GET(BGPAREAA)

               DO W^BGP0DP($PIECE(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)

 +2        IF $GET(BGPDESGP)

               DO W^BGP0DP("Designated Provider: "_$PIECE(^VA(200,BGPDESGP,0),U),1,1,BGPPTYPE)

 +3        SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)

           DO W^BGP0DP(X,1,1,BGPPTYPE)

 +4        SET X="Previous Year Period:  "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)

           DO W^BGP0DP(X,1,1,BGPPTYPE)

 +5        SET X="Baseline Period:  "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)

           DO W^BGP0DP(X,1,1,BGPPTYPE)

 +6        DO W^BGP0DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)

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