BGP5DADB.m

BGP5DADB ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM 09 Apr 2015 10:03 AM ; 23 Jun 2015  12:38 PM

 ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143

 ;

 ;

 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_" Area Aggregate National GPRA/GPRAMA Dashboard Report",80)

INTRO ;

 D EXIT

 W !,"IHS 2015 Area GPRA Dashboard"

 W !!,"This will produce a National GPRA dashboard that will show current rates"

 W !,"for GPRA measures compared to National GPRA targets for both your Area"

 W !,"and each facility in the Area."

 W !!

 W !,"The CRSGPRANT export files will not be created; use the AGP menu option"

 W !,"to run the report that will create these files."

TP ;

 S BGPAREAA=1,BGPDASH=1

 S BGPRTYPE=1,BGPBEN=1,BGPYRPTH=""

 D FY

 I BGPPER="" W !,"Year not entered.",! Q

 S BGPRTYPE=1,BGPYRPTH="",BGPDASH=1,BGPDASHY=BGPPER

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

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

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

 S X=$O(^BGPCTRL("B",2015,0))

 S Y=^BGPCTRL(X,0)

 S BGPBBD=$P(Y,U,12),BGPBED=$P(Y,U,13)

 S BGPQTR=3

 ;BEGIN TEST STUFF

 G NT  ;comment out when testing in TEHR

 W !!,"for testing purposes only, please enter a report year",!

 D F

 I BGPPER="" W !!,"no year entered..bye" D EXIT Q

 S BGPQTR=3

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

 S BGPPBD=($E(BGPPER,1,3)-1)_"0101",BGPPED=($E(BGPPER,1,3)-1)_"1231"

 ;W !!,"for testing purposes only, please enter a BASELINE year",!

 ;D B

 ;I BGPBPER="" W !!,"no year entered..bye" D XIT Q

 ;S BGPBBD=$E(BGPBPER,1,3)_"0101",BGPBED=$E(BGPBPER,1,3)_"1231"

NT ;END TEST STUFF

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

 W !?5,"Report 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)

ASU ;

 S BGPSUCNT=0

 S BGPRPTT=""

 S DIR(0)="S^A:AREA Aggregate;F:One Facility",DIR("A")="Run Report for",DIR("B")="A" KILL DA D ^DIR KILL DIR

 G:$D(DIRUT) EXIT

 S BGPRPTT=Y

 W !!!,"You will now be able to select which sites to use in the",!,"area aggregate/facility 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(^BGPGPDCK(Y,0),U,9),X=$O(^AUTTLOC("C",X,0)) I X S BGPSUNM=$P(^DIC(4,X,0),U)

ZIS ;call to XBDBQUE

EISSEX ;

 S BGPEXCEL=0

 S BGPUF=$$GETDIR^BGP5UTL2()

 ;I ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["NT")!($P($G(^AUTTSITE(1,0)),U,21)=2) S BGPUF=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:"C:\EXPORT")

 ;I $P(^AUTTSITE(1,0),U,21)=1 S BGPUF="/usr/spool/uucppublic/"

 S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)

 D ^XBFMK

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

GI ;gather all gpra measures

 S X=0 F  S X=$O(^BGPINDK("GPRA",1,X)) Q:X'=+X  S BGPIND(X)=""

 S BGPINDK="G"

 D PT^BGP5DSL

 I BGPROT="" G ASU

 ;

 K IOP,%ZIS I BGPROT="D",BGPDELT="F" D NODEV,EXIT Q

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

 I POP D EXIT Q

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

DRIVER ;

 U IO

 D PRINT^BGP5PARP

 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^BGP5DADB",ZTDTH="",ZTDESC="GPRA REPORT" D ^%ZTLOAD D HOME^%ZIS D EXIT Q

 Q

 ;

EXIT ;

 D ^%ZISC

 D EN^XBVK("BGP") I $D(ZTQUEUED) S ZTREQ="@"

 D KILL^AUPNPAT

 D ^XBFMK

 Q

NODEV ;

 S XBRP="",XBRC="NODEV1^BGP5DADB",XBRX="EXIT^BGP5DADB",XBNS="BGP"

 D ^XBDBQUE

 Q

 ;

NODEV1 ;

 D PRINT^BGP5PARP

 ;I BGPRPTT="A",BGPIFTR,BGPEXCEL D GNT1^BGP5UTL

 D ^%ZISC

 D EXIT

 Q

 ;

B ;fiscal year

 S (BGPBPER,BGPVDT)=""

 W !!,"Enter the BASELINE year for the report.  Use a 4 digit ",!,"year, e.g. 2010"

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

 S DIR("A")="Enter BASELINE 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 BGPBPER=BGPVDT

 Q

F ;fiscal year

 S BGPPER=""

 W !

 S BGPVDT=""

 W !,"Enter the Fiscal Year (FY) for the report END date.  Use a 4 digit",!,"year, e.g. 2010, 2015"

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

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

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

 D ^DIR

 K DIC

 I $D(DUOUT) S DIRUT=1 S BGPQUIT="" Q

 S BGPVDT=Y

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

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

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

 ;----------

 ; 

SUMONLY ;EP

 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("IHS 2015 Area National GPRA/GPRAMA Report Clinical Performance Summaries")

 W !!,"This will produce ONLY the clinical performance summaries for the Area "

 W !,"National GPRA/GPRAMA Report for the 2015 GPRA year.  If you want the detailed "

 W !,"information included in the report, including performance measure "

 W !,"definitions and number of patients in each denominator and numerator"

 W !,"you need to run the AGP menu option."

 W !!,"The CRSGPRANT export files will not be created; use the AGP menu option "

 W !,"to run the report that will create these files."

 W !

 K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" D ^DIR K DIR

 S BGPSUMON=1

 G TP

FY ;calendar year

 S (BGPPER,BGPVDT,BGPNGR09)=""

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

 S DIR("A")="Run report for GPRA year 2015 or 2016"

 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

 I Y'=3150000,Y'=3160000 W !,"Must be 2015 or 2016" G F

 S BGPVDT=Y

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

 S BGPPER=BGPVDT

 I BGPPER="3160000" S BGPNGR09=1

 Q

BGP5DADB  ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM 09 Apr 2015 10:03 AM ; 23 Jun 2015  12:38 PM

 +1       ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143

 +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_" Area Aggregate National GPRA/GPRAMA Dashboard Report",80)

INTRO     ;

 +1        DO EXIT

 +2        WRITE !,"IHS 2015 Area GPRA Dashboard"

 +3        WRITE !!,"This will produce a National GPRA dashboard that will show current rates"

 +4        WRITE !,"for GPRA measures compared to National GPRA targets for both your Area"

 +5        WRITE !,"and each facility in the Area."

 +6        WRITE !!

 +7        WRITE !,"The CRSGPRANT export files will not be created; use the AGP menu option"

 +8        WRITE !,"to run the report that will create these files."

TP        ;

 +1        SET BGPAREAA=1

           SET BGPDASH=1

 +2        SET BGPRTYPE=1

           SET BGPBEN=1

           SET BGPYRPTH=""

 +3        DO FY

 +4        IF BGPPER=""

               WRITE !,"Year not entered.",!

               QUIT 

 +5        SET BGPRTYPE=1

           SET BGPYRPTH=""

           SET BGPDASH=1

           SET BGPDASHY=BGPPER

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

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

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

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

           SET BGPDASHP=$EXTRACT(BGPPED,1,3)_"0000"

 +9        SET X=$ORDER(^BGPCTRL("B",2015,0))

 +10       SET Y=^BGPCTRL(X,0)

 +11       SET BGPBBD=$PIECE(Y,U,12)

           SET BGPBED=$PIECE(Y,U,13)

 +12       SET BGPQTR=3

 +13      ;BEGIN TEST STUFF

 +14      ;comment out when testing in TEHR

           GOTO NT

 +15       WRITE !!,"for testing purposes only, please enter a report year",!

 +16       DO F

 +17       IF BGPPER=""

               WRITE !!,"no year entered..bye"

               DO EXIT

               QUIT 

 +18       SET BGPQTR=3

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

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

 +20       SET BGPPBD=($EXTRACT(BGPPER,1,3)-1)_"0101"

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

 +21      ;W !!,"for testing purposes only, please enter a BASELINE year",!

 +22      ;D B

 +23      ;I BGPBPER="" W !!,"no year entered..bye" D XIT Q

 +24      ;S BGPBBD=$E(BGPBPER,1,3)_"0101",BGPBED=$E(BGPBPER,1,3)_"1231"

NT        ;END TEST STUFF

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

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

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

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

ASU       ;

 +1        SET BGPSUCNT=0

 +2        SET BGPRPTT=""

 +3        SET DIR(0)="S^A:AREA Aggregate;F:One Facility"

           SET DIR("A")="Run Report for"

           SET DIR("B")="A"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO EXIT

 +5        SET BGPRPTT=Y

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

 +7        SET DIR(0)="E"

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

           KILL DA

           DO ^DIR

           KILL DIR

 +8        KILL BGPSUL

 +9        DO EN^BGP5ASL

 +10       IF '$DATA(BGPSUL)

               WRITE !!,"No sites selected"

               DO EXIT

               QUIT 

 +11       SET X=0

           SET C=0

           FOR 

               SET X=$ORDER(BGPSUL(X))

               IF X'=+X

                   QUIT 

               SET C=C+1

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

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

ZIS       ;call to XBDBQUE

EISSEX    ;

 +1        SET BGPEXCEL=0

 +2        SET BGPUF=$$GETDIR^BGP5UTL2()

 +3       ;I ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["NT")!($P($G(^AUTTSITE(1,0)),U,21)=2) S BGPUF=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:"C:\EXPORT")

 +4       ;I $P(^AUTTSITE(1,0),U,21)=1 S BGPUF="/usr/spool/uucppublic/"

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

 +6        DO ^XBFMK

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

GI        ;gather all gpra measures

 +1        SET X=0

           FOR 

               SET X=$ORDER(^BGPINDK("GPRA",1,X))

               IF X'=+X

                   QUIT 

               SET BGPIND(X)=""

 +2        SET BGPINDK="G"

 +3        DO PT^BGP5DSL

 +4        IF BGPROT=""

               GOTO ASU

 +5       ;

 +6        KILL IOP,%ZIS

           IF BGPROT="D"

               IF BGPDELT="F"

                   DO NODEV

                   DO EXIT

                   QUIT 

 +7        KILL IOP,%ZIS

           WRITE !!

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

           DO ^%ZIS

 +8        IF POP

               DO EXIT

               QUIT 

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

               GOTO TSKMN

DRIVER    ;

 +1        USE IO

 +2        DO PRINT^BGP5PARP

 +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^BGP5DADB"

           SET ZTDTH=""

           SET ZTDESC="GPRA REPORT"

           DO ^%ZTLOAD

           DO HOME^%ZIS

           DO EXIT

           QUIT 

 +6        QUIT 

 +7       ;

EXIT      ;

 +1        DO ^%ZISC

 +2        DO EN^XBVK("BGP")

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        DO KILL^AUPNPAT

 +4        DO ^XBFMK

 +5        QUIT 

NODEV     ;

 +1        SET XBRP=""

           SET XBRC="NODEV1^BGP5DADB"

           SET XBRX="EXIT^BGP5DADB"

           SET XBNS="BGP"

 +2        DO ^XBDBQUE

 +3        QUIT 

 +4       ;

NODEV1    ;

 +1        DO PRINT^BGP5PARP

 +2       ;I BGPRPTT="A",BGPIFTR,BGPEXCEL D GNT1^BGP5UTL

 +3        DO ^%ZISC

 +4        DO EXIT

 +5        QUIT 

 +6       ;

B         ;fiscal year

 +1        SET (BGPBPER,BGPVDT)=""

 +2        WRITE !!,"Enter the BASELINE year for the report.  Use a 4 digit ",!,"year, e.g. 2010"

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

 +4        SET DIR("A")="Enter BASELINE 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 BGPBPER=BGPVDT

 +12       QUIT 

F         ;fiscal year

 +1        SET BGPPER=""

 +2        WRITE !

 +3        SET BGPVDT=""

 +4        WRITE !,"Enter the Fiscal Year (FY) for the report END date.  Use a 4 digit",!,"year, e.g. 2010, 2015"

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

 +6        SET DIR("A")="Enter FY"

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

 +8        DO ^DIR

 +9        KILL DIC

 +10       IF $DATA(DUOUT)

               SET DIRUT=1

               SET BGPQUIT=""

               QUIT 

 +11       SET BGPVDT=Y

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

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

               GOTO F

 +13       SET BGPPER=BGPVDT

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

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

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

SUMONLY   ;EP

 +1        IF $DATA(IOF)

               WRITE @IOF

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

 +3        WRITE !,$$CTR("IHS 2015 Area National GPRA/GPRAMA Report Clinical Performance Summaries")

 +4        WRITE !!,"This will produce ONLY the clinical performance summaries for the Area "

 +5        WRITE !,"National GPRA/GPRAMA Report for the 2015 GPRA year.  If you want the detailed "

 +6        WRITE !,"information included in the report, including performance measure "

 +7        WRITE !,"definitions and number of patients in each denominator and numerator"

 +8        WRITE !,"you need to run the AGP menu option."

 +9        WRITE !!,"The CRSGPRANT export files will not be created; use the AGP menu option "

 +10       WRITE !,"to run the report that will create these files."

 +11       WRITE !

 +12       KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="PRESS ENTER"

           DO ^DIR

           KILL DIR

 +13       SET BGPSUMON=1

 +14       GOTO TP

FY        ;calendar year

 +1        SET (BGPPER,BGPVDT,BGPNGR09)=""

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

 +3        SET DIR("A")="Run report for GPRA year 2015 or 2016"

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

 +5        DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               QUIT 

 +7        IF $DATA(DUOUT)

               SET DIRUT=1

               QUIT 

 +8        IF Y'=3150000

               IF Y'=3160000

                   WRITE !,"Must be 2015 or 2016"

                   GOTO F

 +9        SET BGPVDT=Y

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

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

               GOTO F

 +11       SET BGPPER=BGPVDT

 +12       IF BGPPER="3160000"

               SET BGPNGR09=1

 +13       QUIT