BGP5DHEA.m

BGP5DHEA ; IHS/CMI/LAB - ihs area AA ;

 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007

 ;

 ;

 W:$D(IOF) @IOF

 S BGPA=$E($P(^AUTTLOC(DUZ(2),0),U,10),1,2),BGPA=$O(^AUTTAREA("C",BGPA,0)) S BGPA=$S(BGPA:$P(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")

 W !!,$$CTR(BGPA_" IHS 2005 Area Aggregate HEDIS Performance Report",80)

INTRO ;

TP ;

 D EXIT

 S BGPAREAA=1

 S BGPRTYPE=3

 S (BGPBD,BGPED,BGPTP)=""

 S DIR(0)="S^1:January 1 - December 31;2:April 1 - March 31;3:July 1 - June 30;4:October 1 - September 30",DIR("A")="Enter the date range for your report" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D EXIT Q

 S BGPQTR=Y

 D F

 I BGPPER="" W !,"Year not entered.",! G TP

 I BGPQTR=1 S BGPBD=$E(BGPPER,1,3)_"0101",BGPED=$E(BGPPER,1,3)_"1231"

 I BGPQTR=2 S BGPBD=($E(BGPPER,1,3)-1)_"0401",BGPED=$E(BGPPER,1,3)_"0331"

 I BGPQTR=3 S BGPBD=($E(BGPPER,1,3)-1)_"0701",BGPED=$E(BGPPER,1,3)_"0630"

 I BGPQTR=4 S BGPBD=($E(BGPPER,1,3)-1)_"1001",BGPED=$E(BGPPER,1,3)_"0930"

 I BGPED>DT D  G:BGPDO=1 TP

 .W !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."

 .W !,"The end date of this report is in the future; your data will not be",!,"complete.",!

 .K DIR S BGPDO=0 S DIR(0)="Y",DIR("A")="Do you want to change your Current Report Dates?",DIR("B")="N" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) S BGPDO=1 Q

 .I Y S BGPDO=1 Q

 .Q

BY ;get baseline year

 S BGPVDT=""

 W !!,"Enter the Baseline Year to compare data to.",!,"Use a 4 digit year, e.g. 1999, 2000"

 S DIR(0)="D^::EP"

 S DIR("A")="Enter Year (e.g. 2000)"

 D ^DIR KILL DIR

 I $D(DIRUT) G TP

 I $D(DUOUT) S DIRUT=1 G TP

 S BGPVDT=Y

 I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G BY

 S X=$E(BGPPER,1,3)-$E(BGPVDT,1,3)

 S X=X_"0000"

 S BGPBBD=BGPBD-X,BGPBBD=$E(BGPBBD,1,3)_$E(BGPBD,4,7)

 S BGPBED=BGPED-X,BGPBED=$E(BGPBED,1,3)_$E(BGPED,4,7)

 S BGPPBD=($E(BGPBD,1,3)-1)_$E(BGPBD,4,7)

 S BGPPED=($E(BGPED,1,3)-1)_$E(BGPED,4,7)

 W !!,"The date ranges for this report are:"

 W !?5,"Reporting Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)

 W !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)

 W !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)

BEN ;

 S BGPBEN=""

 S DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)",DIR("A")="Select Beneficiary Population to include in this report"

 S DIR("B")="1" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G TP

 S BGPBEN=Y

ASU ;

 S BGPSUCNT=0

 S BGPRPTT=""

 W !!!,"You will now be able to select which sites to use in the",!,"area aggregate report.",!

 S DIR(0)="E",DIR("A")="Press Enter to Continue" KILL DA D ^DIR KILL DIR

 K BGPSUL

 D EN^BGP5ASL

 I '$D(BGPSUL) W !!,"No sites selected" D EXIT Q

 S X=0,C=0 F  S X=$O(BGPSUL(X)) Q:X'=+X  S C=C+1

 W !!,"A total of ",C," facilities have been selected.",!!

 I C=1 S BGPRPTT="F",BGPSUCNT=1,Y=$O(BGPSUL(0)),X=$P(^BGPHEDCV(Y,0),U,9),X=$O(^AUTTLOC("C",X,0)) I X S BGPSUNM=$P(^DIC(4,X,0),U)

 I C>1 S BGPRPTT="A"

ZIS ;call to XBDBQUE

 D ^XBFMK

 K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM

GI ;gather all gpra indicators

 S X=0 F  S X=$O(^BGPHEIV(X)) Q:X'=+X  S BGPIND(X)=""

 S BGPINDT="H"

 ;

 D PT^BGP5DHSL

 I BGPROT="" G ASU

 ;W !! S %ZIS="PQM" D ^%ZIS

 K IOP,%ZIS W !! S %ZIS=$S(BGPDELT'="S":"PQM",1:"PM") D ^%ZIS

 I $D(IO("Q")) G TSKMN

DRIVER ;

 U IO

 D PRINT^BGP5PHEP

 D ^%ZISC

 D EXIT

 Q

 ;

TSKMN ;EP ENTRY POINT FROM TASKMAN

 S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST

 I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))

 I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL

 K ZTSAVE S ZTSAVE("BGP*")=""

 S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^BGP5DHEA",ZTDTH="",ZTDESC="HEDIS REPORT" D ^%ZTLOAD D EXIT Q

 Q

 ;

FAC(S) ;

 NEW N S N=$O(^AUTTLOC("C",S,0))

 I N="" Q N

 Q $E($P(^DIC(4,N,0),U),1,15)

SU(S) ;

 NEW N S N=$O(^AUTTSU("C",S,0))

 I N="" Q N

 Q $E($P(^AUTTSU(N,0),U),1,15)

EXIT ;

 D EN^XBVK("BGP")

 D KILL^AUPNPAT

 D ^XBFMK

 Q

 ;

F ;fiscal year

 S (BGPPER,BGPVDT)=""

 W !!,"Enter the Calendar Year for the report END date.  Use a 4 digit",!,"year, e.g. 2004"

 S DIR(0)="D^::EP"

 S DIR("A")="Enter Year"

 S DIR("?")="This report is compiled for a period.  Enter a valid date."

 D ^DIR KILL DIR

 I $D(DIRUT) Q

 I $D(DUOUT) S DIRUT=1 Q

 S BGPVDT=Y

 I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F

 S BGPPER=BGPVDT

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

 ;----------

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

 ;----------

 ;

BGP5DHEA  ; IHS/CMI/LAB - ihs area AA ;

 +1       ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007

 +2       ;

 +3       ;

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        SET BGPA=$EXTRACT($PIECE(^AUTTLOC(DUZ(2),0),U,10),1,2)

           SET BGPA=$ORDER(^AUTTAREA("C",BGPA,0))

           SET BGPA=$SELECT(BGPA:$PIECE(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")

 +6        WRITE !!,$$CTR(BGPA_" IHS 2005 Area Aggregate HEDIS Performance Report",80)

INTRO     ;

TP        ;

 +1        DO EXIT

 +2        SET BGPAREAA=1

 +3        SET BGPRTYPE=3

 +4        SET (BGPBD,BGPED,BGPTP)=""

 +5        SET DIR(0)="S^1:January 1 - December 31;2:April 1 - March 31;3:July 1 - June 30;4:October 1 - September 30"

           SET DIR("A")="Enter the date range for your report"

           KILL DA

           DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               DO EXIT

               QUIT 

 +7        SET BGPQTR=Y

 +8        DO F

 +9        IF BGPPER=""

               WRITE !,"Year not entered.",!

               GOTO TP

 +10       IF BGPQTR=1

               SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"1231"

 +11       IF BGPQTR=2

               SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0401"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"0331"

 +12       IF BGPQTR=3

               SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0701"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"0630"

 +13       IF BGPQTR=4

               SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"1001"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"0930"

 +14       IF BGPED>DT

               Begin DoDot:1

 +15               WRITE !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."

 +16               WRITE !,"The end date of this report is in the future; your data will not be",!,"complete.",!

 +17               KILL DIR

                   SET BGPDO=0

                   SET DIR(0)="Y"

                   SET DIR("A")="Do you want to change your Current Report Dates?"

                   SET DIR("B")="N"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +18               IF $DATA(DIRUT)

                       SET BGPDO=1

                       QUIT 

 +19               IF Y

                       SET BGPDO=1

                       QUIT 

 +20               QUIT 

               End DoDot:1

               IF BGPDO=1

                   GOTO TP

BY        ;get baseline year

 +1        SET BGPVDT=""

 +2        WRITE !!,"Enter the Baseline Year to compare data to.",!,"Use a 4 digit year, e.g. 1999, 2000"

 +3        SET DIR(0)="D^::EP"

 +4        SET DIR("A")="Enter Year (e.g. 2000)"

 +5        DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               GOTO TP

 +7        IF $DATA(DUOUT)

               SET DIRUT=1

               GOTO TP

 +8        SET BGPVDT=Y

 +9        IF $EXTRACT(Y,4,7)'="0000"

               WRITE !!,"Please enter a year only!",!

               GOTO BY

 +10       SET X=$EXTRACT(BGPPER,1,3)-$EXTRACT(BGPVDT,1,3)

 +11       SET X=X_"0000"

 +12       SET BGPBBD=BGPBD-X

           SET BGPBBD=$EXTRACT(BGPBBD,1,3)_$EXTRACT(BGPBD,4,7)

 +13       SET BGPBED=BGPED-X

           SET BGPBED=$EXTRACT(BGPBED,1,3)_$EXTRACT(BGPED,4,7)

 +14       SET BGPPBD=($EXTRACT(BGPBD,1,3)-1)_$EXTRACT(BGPBD,4,7)

 +15       SET BGPPED=($EXTRACT(BGPED,1,3)-1)_$EXTRACT(BGPED,4,7)

 +16       WRITE !!,"The date ranges for this report are:"

 +17       WRITE !?5,"Reporting Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)

 +18       WRITE !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)

 +19       WRITE !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)

BEN       ;

 +1        SET BGPBEN=""

 +2        SET DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)"

           SET DIR("A")="Select Beneficiary Population to include in this report"

 +3        SET DIR("B")="1"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO TP

 +5        SET BGPBEN=Y

ASU       ;

 +1        SET BGPSUCNT=0

 +2        SET BGPRPTT=""

 +3        WRITE !!!,"You will now be able to select which sites to use in the",!,"area aggregate report.",!

 +4        SET DIR(0)="E"

           SET DIR("A")="Press Enter to Continue"

           KILL DA

           DO ^DIR

           KILL DIR

 +5        KILL BGPSUL

 +6        DO EN^BGP5ASL

 +7        IF '$DATA(BGPSUL)

               WRITE !!,"No sites selected"

               DO EXIT

               QUIT 

 +8        SET X=0

           SET C=0

           FOR 

               SET X=$ORDER(BGPSUL(X))

               IF X'=+X

                   QUIT 

               SET C=C+1

 +9        WRITE !!,"A total of ",C," facilities have been selected.",!!

 +10       IF C=1

               SET BGPRPTT="F"

               SET BGPSUCNT=1

               SET Y=$ORDER(BGPSUL(0))

               SET X=$PIECE(^BGPHEDCV(Y,0),U,9)

               SET X=$ORDER(^AUTTLOC("C",X,0))

               IF X

                   SET BGPSUNM=$PIECE(^DIC(4,X,0),U)

 +11       IF C>1

               SET BGPRPTT="A"

ZIS       ;call to XBDBQUE

 +1        DO ^XBFMK

 +2        KILL DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM

GI        ;gather all gpra indicators

 +1        SET X=0

           FOR 

               SET X=$ORDER(^BGPHEIV(X))

               IF X'=+X

                   QUIT 

               SET BGPIND(X)=""

 +2        SET BGPINDT="H"

 +3       ;

 +4        DO PT^BGP5DHSL

 +5        IF BGPROT=""

               GOTO ASU

 +6       ;W !! S %ZIS="PQM" D ^%ZIS

 +7        KILL IOP,%ZIS

           WRITE !!

           SET %ZIS=$SELECT(BGPDELT'="S":"PQM",1:"PM")

           DO ^%ZIS

 +8        IF $DATA(IO("Q"))

               GOTO TSKMN

DRIVER    ;

 +1        USE IO

 +2        DO PRINT^BGP5PHEP

 +3        DO ^%ZISC

 +4        DO EXIT

 +5        QUIT 

 +6       ;

TSKMN     ;EP ENTRY POINT FROM TASKMAN

 +1        SET ZTIO=$SELECT($DATA(ION):ION,1:IO)

           IF $DATA(IOST)#2

               IF IOST]""

                   SET ZTIO=ZTIO_";"_IOST

 +2        IF $GET(IO("DOC"))]""

               SET ZTIO=ZTIO_";"_$GET(IO("DOC"))

 +3        IF $DATA(IOM)#2

               IF IOM

                   SET ZTIO=ZTIO_";"_IOM

                   IF $DATA(IOSL)#2

                       IF IOSL

                           SET ZTIO=ZTIO_";"_IOSL

 +4        KILL ZTSAVE

           SET ZTSAVE("BGP*")=""

 +5        SET ZTCPU=$GET(IOCPU)

           SET ZTRTN="DRIVER^BGP5DHEA"

           SET ZTDTH=""

           SET ZTDESC="HEDIS REPORT"

           DO ^%ZTLOAD

           DO EXIT

           QUIT 

 +6        QUIT 

 +7       ;

FAC(S)    ;

 +1        NEW N

           SET N=$ORDER(^AUTTLOC("C",S,0))

 +2        IF N=""

               QUIT N

 +3        QUIT $EXTRACT($PIECE(^DIC(4,N,0),U),1,15)

SU(S)     ;

 +1        NEW N

           SET N=$ORDER(^AUTTSU("C",S,0))

 +2        IF N=""

               QUIT N

 +3        QUIT $EXTRACT($PIECE(^AUTTSU(N,0),U),1,15)

EXIT      ;

 +1        DO EN^XBVK("BGP")

 +2        DO KILL^AUPNPAT

 +3        DO ^XBFMK

 +4        QUIT 

 +5       ;

F         ;fiscal year

 +1        SET (BGPPER,BGPVDT)=""

 +2        WRITE !!,"Enter the Calendar Year for the report END date.  Use a 4 digit",!,"year, e.g. 2004"

 +3        SET DIR(0)="D^::EP"

 +4        SET DIR("A")="Enter Year"

 +5        SET DIR("?")="This report is compiled for a period.  Enter a valid date."

 +6        DO ^DIR

           KILL DIR

 +7        IF $DATA(DIRUT)

               QUIT 

 +8        IF $DATA(DUOUT)

               SET DIRUT=1

               QUIT 

 +9        SET BGPVDT=Y

 +10       IF $EXTRACT(Y,4,7)'="0000"

               WRITE !!,"Please enter a year only!",!

               GOTO F

 +11       SET BGPPER=BGPVDT

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

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

 +3       ;