BGP8DGPU.m

BGP8DGPU ; IHS/CMI/LAB - IHS AREA CLIN 05 REPORT DRIVER ;

 ;;18.1;IHS CLINICAL REPORTING;**1**;MAY 25, 2018;Build 65

 ;

 ;

 W:$D(IOF) @IOF

 W !,$$CTR("IHS GPRA/GPRAMA Performance Report for a User Selected Date Range",80)

INTRO ;

 D XIT

 W !!,"This will produce a National GPRA/GPRAMA report for a year period you specify."

 W !!,"You will be asked to provide: 1) the reporting period, 2) the baseline"

 W !,"period to compare data to, 3) the Community taxonomy and 4) the patient"

 W !,"population (i.e. AI/AN only, non AI/AN, or both) to determine which"

 W !,"patients will be included."

 W !!,"You can choose to export this data to the Area office.  If you"

 W !,"answer yes at the export prompt, a report will be produced in export format"

 W !,"for the Area Office to use in Area aggregated data.  Depending on site specific"

 W !,"configuration, the export file will either be automatically transmitted "

 W !,"directly to the Area or the site will have to send the file manually.",!

 K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR

 S BGPYGPU=1

 D TAXCHK^BGP8XTCN

 S X=$$DEMOCHK^BGP8UTL2()

 I 'X W !!,"Exiting Report....." D PAUSE^BGP8DU,XIT Q

 D XIT

ST ;

 W !!

 S DIR(0)="Y",DIR("A")="Do you want to run the report on a Patient Panel",DIR("B")="N" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D XIT Q

 I 'Y G DP

 ;get search template name

 W !!,"Please enter the search template name.  The template will contain a",!,"panel of patients defined by the user.",!

 S DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)" S DIC="^DIBT(",DIC("A")="Enter SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR

 I Y=-1 G XIT

 S BGPSEAT=+Y,BGPBEN=3

DP ;

 K DIR

 S BGPDESGP=""

 S DIR(0)="S^E:Entire Facility;P:One Designated Provider",DIR("A")="Run the report for",DIR("B")="E" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G ST

 I Y="E" G TP

 W !!

 S DIC("A")="Which Designated Provider: ",DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC K DIC,DA

 I X="^" D XIT Q

 I Y=-1 W !!,"provider is required, use an '^' to exit." G DP

 S BGPDESGP=+Y

TP ;get time period

 S BGPRTYPE=1,BGPYRPTH="",BGPYGPU=1

 ;

 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;5:User-Defined Report Period",DIR("A")="Enter the date range for your report" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D XIT Q

 S BGPQTR=Y

 I BGPQTR=5 D ENDDATE

 I BGPQTR'=5 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 BGPQTR=5 D

 .S D=$$FMADD^XLFDT(BGPPER,1)

 .I $E(BGPPER,4,7)'=1231 S BGPBD=($E(BGPPER,1,3)-1)_$E(D,4,7),BGPED=BGPPER,BGPPER=$E(BGPED,1,3)_"0000"

 .I $E(BGPPER,4,7)=1231 S BGPBD=$E(BGPPER,1,3)_$E(D,4,7),BGPED=BGPPER,BGPPER=$E(BGPED,1,3)_"0000"

 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. 2010"

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

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

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

 I BGPPBD=BGPBBD,BGPPED=BGPBED K Y D CHKY I Y K BGPBBD,BGPBED,BGPPBD,BGPPED G BY

COMM ;

 I $G(BGPSEAT) G COMQ

 ;W !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report.  You should have created this taxonomy using QMAN.",!

 K BGPTAX

 S BGPTAXI="",BGPCOMMI=""

 D ^XBFMK

 K DIR

 W ! S DIR(0)="Y",DIR("A")="Run Report for One Community",DIR("B")="N" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G BY

 I Y D  G:BGPCOMMI="" COMM  G:BGPCOMMI COMQ

 .S DIC="^AUTTCOM(",DIC(0)="AEMQ",DIC("A")="Which Community: " D ^DIC K DIC

 .I Y=-1 Q

 .S BGPCOMMI=+Y

 ;

 S DIC("S")="I $P(^(0),U,15)=9999999.05",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Community Taxonomy: "

 S B=$P($G(^BGPSITE(DUZ(2),0)),U,5) I B S DIC("B")=$P(^ATXAX(B,0),U)

 D ^DIC

 I Y=-1 G COMM

 S BGPTAXI=+Y

COM1 ;

 S X=0

 F  S X=$O(^ATXAX(BGPTAXI,21,X)) Q:'X  D

 .S BGPTAX($P(^ATXAX(BGPTAXI,21,X,0),U))=""

 .Q

 I '$D(BGPTAX) W !!,"There are no communities in that taxonomy." G COMM

 S X=0,G=0

 F  S X=$O(^ATXAX(BGPTAXI,21,X)) Q:'X  D

 .S C=$P(^ATXAX(BGPTAXI,21,X,0),U)

 .I '$D(^AUTTCOM("B",C)) W !!,"***  Warning: Community ",C," is in the taxonomy but was not",!,"found in the standard community table." S G=1

 .Q

 I G D  I BGPQUIT D XIT Q

 .W !!,"These communities may have been renamed or there may be patients"

 .W !,"who have been reassigned from this community to a new community and this"

 .W !,"could reduce your patient population."

 .S BGPQUIT=0

 .S DIR(0)="Y",DIR("A")="Do you want to cancel the report and review the communities" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) S BGPQUIT=1

 .I Y S BGPQUIT=1

 .Q

COMQ K BGPQUIT

 ;

 ;

BEN ;

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

 S BGPINDG="G"

 I $G(BGPSEAT) G HOME

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

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

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

 I $D(DIRUT) G COMM

 S BGPBEN=Y,BGPBENF=Y(0)

HOME ;

 S BGPHOME=$P($G(^BGPSITE(DUZ(2),0)),U,2)

 I BGPHOME="" W !!,"Home Location not found in Site File!!",!,"PHN Visits counts to Home will be calculated using clinic 11 only!!" H 2 G AI

 W !,"Your HOME location is defined as: ",$P(^DIC(4,BGPHOME,0),U)," asufac:  ",$P(^AUTTLOC(BGPHOME,0),U,10)

AI ;gather all gpra measures

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

 S BGPINDG="G"

EXPORT ;export to area or not?

 S BGPEXPT=""

 I $G(BGPDESGP) G EISSEX

 I $D(BGPSEAT) G EISSEX

 W ! S DIR(0)="Y",DIR("A")="Do you wish to export this data to Area" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G BEN

 S BGPEXPT=Y

EISSEX ;

 S BGPEXCEL=""

 S BGPUF=$$GETDIR^BGP8UTL2()

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

 I BGPEXPT,BGPUF="" W:'$D(ZTQUEUED) !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written." D PAUSE^BGP8DU,XIT Q

SUM ;display summary of this report

 W:$D(IOF) @IOF

 W !,$$CTR("SUMMARY OF IHS GPRA/GPRAMA PERFORMANCE REPORT TO BE GENERATED")

 W !,$$CTR($$RPTVER^BGP8BAN,80)

 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)

 I '$G(BGPSEAT),BGPTAXI W !!,"The COMMUNITY Taxonomy to be used is: ",$P(^ATXAX(BGPTAXI,0),U)

 I '$G(BGPSEAT),BGPCOMMI W !!,"The COMMUNITY to be included is: ",$P(^AUTTCOM(BGPCOMMI,0),U)

 I '$G(BGPSEAT) W !,"The Beneficiary Population is: ",BGPBENF

 I $G(BGPSEAT) W !!,"The Patient Population is: ",$P(^DIBT(BGPSEAT,0),U,1)

 I BGPHOME W !,"The HOME location is: ",$P(^DIC(4,BGPHOME,0),U)," ",$P(^AUTTLOC(BGPHOME,0),U,10)

 I 'BGPHOME W !,"No HOME Location selected."

 D TEXT^BGP8DSL

 I $D(DIRUT) G BEN

 D PT^BGP8DSL

 I BGPROT="" G BEN

ZIS ;call to XBDBQUE

 D REPORT^BGP8UTL

 I $G(BGPQUIT) D XIT Q

 I BGPRPT="" D XIT Q

 I BGPEXPT D

 .W !!,"A file will be created called BG"_$$FV^BGP8BAN()_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT," and will reside",!,"in the ",BGPUF," directory.",!

 .W !,"Depending on your site configuration, this file may need to be manually",!,"sent to your Area Office.",!

 I BGPEXCEL,BGPEXPT D

 .W !,"A file will be created called ",BGPFN,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!

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

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

 I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDCR(" D ^DIK K DIK D XIT Q

 I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDPR(" D ^DIK K DIK D XIT Q

 I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDBR(" D ^DIK K DIK D XIT Q

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

DRIVER ;

 I '$D(BGPSEAT) D ^BGP8D1

 I $D(BGPSEAT) D ^BGP8D10

 U IO

 D ^BGP8DP

 D ^%ZISC

 I BGPEXPT D GS^BGP8UTL

 D XIT

 Q

 ;

NODEV ;

 S XBRP="",XBRC="NODEV1^BGP8DGPU",XBRX="XIT^BGP8DGPU",XBNS="BGP"

 D ^XBDBQUE

 Q

 ;

NODEV1 ;

 I '$D(BGPSEAT) D ^BGP8D1

 I $D(BGPSEAT) D ^BGP8D10

 D ^BGP8DP

 D ^%ZISC

 I BGPEXPT D GS^BGP8UTL

 D XIT

 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^BGP8DGPU",ZTDTH="",ZTDESC="NATIONAL GPRA GPU REPORT 11" D ^%ZTLOAD D XIT Q

 Q

 ;

XIT ;

 D ^%ZISC

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

 K DIRUT,DUOUT,DIR,DOD

 K DIADD,DLAYGO

 D KILL^AUPNPAT

 K X,X1,X2,X3,X4,X5,X6

 K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 K N,N1,N2,N3,N4,N5,N6

 K BD,ED

 D KILL^AUPNPAT

 D ^XBFMK

 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 DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 S DIR(0)="E" D ^DIR KILL 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")

 ;----------

 ;

CHKY ;

 W !!,"The baseline year and the previous year time periods are the same.",!!

 S DIR(0)="Y",DIR("A")="Do you want to change the baseline year",DIR("B")="N" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) S Y="" Q

 Q

F ;calendar year

 S (BGPPER,BGPVDT)=""

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

 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

ENDDATE ;EP

 W !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2018)"

 W !,"will assume a year in the past, if you want to put in a future date,"

 W !,"remember to enter the full 4 digit year.  For example, if today is"

 W !,"January 4, 2010 and you type in 6/30/05 the system will assume the year"

 W !,"as 1905 since that is a date in the past.  You must type 6/30/2010 if you"

 W !,"want a date in the future."

 S (BGPPER,BGPVDT)=""

 W ! K DIR,X,Y S DIR(0)="D^::EP",DIR("A")="Enter End Date for the Report: (e.g. 04/30/2007)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) Q

 S (BGPPER,BGPVDT)=Y

 Q

BGP8DGPU  ; IHS/CMI/LAB - IHS AREA CLIN 05 REPORT DRIVER ;

 +1       ;;18.1;IHS CLINICAL REPORTING;**1**;MAY 25, 2018;Build 65

 +2       ;

 +3       ;

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        WRITE !,$$CTR("IHS GPRA/GPRAMA Performance Report for a User Selected Date Range",80)

INTRO     ;

 +1        DO XIT

 +2        WRITE !!,"This will produce a National GPRA/GPRAMA report for a year period you specify."

 +3        WRITE !!,"You will be asked to provide: 1) the reporting period, 2) the baseline"

 +4        WRITE !,"period to compare data to, 3) the Community taxonomy and 4) the patient"

 +5        WRITE !,"population (i.e. AI/AN only, non AI/AN, or both) to determine which"

 +6        WRITE !,"patients will be included."

 +7        WRITE !!,"You can choose to export this data to the Area office.  If you"

 +8        WRITE !,"answer yes at the export prompt, a report will be produced in export format"

 +9        WRITE !,"for the Area Office to use in Area aggregated data.  Depending on site specific"

 +10       WRITE !,"configuration, the export file will either be automatically transmitted "

 +11       WRITE !,"directly to the Area or the site will have to send the file manually.",!

 +12       KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="Press enter to continue"

           DO ^DIR

           KILL DIR

 +13       SET BGPYGPU=1

 +14       DO TAXCHK^BGP8XTCN

 +15       SET X=$$DEMOCHK^BGP8UTL2()

 +16       IF 'X

               WRITE !!,"Exiting Report....."

               DO PAUSE^BGP8DU

               DO XIT

               QUIT 

 +17       DO XIT

ST        ;

 +1        WRITE !!

 +2        SET DIR(0)="Y"

           SET DIR("A")="Do you want to run the report on a Patient Panel"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               DO XIT

               QUIT 

 +4        IF 'Y

               GOTO DP

 +5       ;get search template name

 +6        WRITE !!,"Please enter the search template name.  The template will contain a",!,"panel of patients defined by the user.",!

 +7        SET DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)"

           SET DIC="^DIBT("

           SET DIC("A")="Enter SEARCH TEMPLATE name: "

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA,DR,DICR

 +8        IF Y=-1

               GOTO XIT

 +9        SET BGPSEAT=+Y

           SET BGPBEN=3

DP        ;

 +1        KILL DIR

 +2        SET BGPDESGP=""

 +3        SET DIR(0)="S^E:Entire Facility;P:One Designated Provider"

           SET DIR("A")="Run the report for"

           SET DIR("B")="E"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO ST

 +5        IF Y="E"

               GOTO TP

 +6        WRITE !!

 +7        SET DIC("A")="Which Designated Provider: "

           SET DIC="^VA(200,"

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

 +8        IF X="^"

               DO XIT

               QUIT 

 +9        IF Y=-1

               WRITE !!,"provider is required, use an '^' to exit."

               GOTO DP

 +10       SET BGPDESGP=+Y

TP        ;get time period

 +1        SET BGPRTYPE=1

           SET BGPYRPTH=""

           SET BGPYGPU=1

 +2       ;

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

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

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

           KILL DA

           DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               DO XIT

               QUIT 

 +6        SET BGPQTR=Y

 +7        IF BGPQTR=5

               DO ENDDATE

 +8        IF BGPQTR'=5

               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 BGPQTR=5

               Begin DoDot:1

 +15               SET D=$$FMADD^XLFDT(BGPPER,1)

 +16               IF $EXTRACT(BGPPER,4,7)'=1231

                       SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_$EXTRACT(D,4,7)

                       SET BGPED=BGPPER

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

 +17               IF $EXTRACT(BGPPER,4,7)=1231

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

                       SET BGPED=BGPPER

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

               End DoDot:1

 +18       IF BGPED>DT

               Begin DoDot:1

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

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

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

 +22               IF $DATA(DIRUT)

                       SET BGPDO=1

                       QUIT 

 +23               IF Y

                       SET BGPDO=1

                       QUIT 

 +24               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. 2010"

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

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

 +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,"Report 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)

 +20       IF BGPPBD=BGPBBD

               IF BGPPED=BGPBED

                   KILL Y

                   DO CHKY

                   IF Y

                       KILL BGPBBD,BGPBED,BGPPBD,BGPPED

                       GOTO BY

COMM      ;

 +1        IF $GET(BGPSEAT)

               GOTO COMQ

 +2       ;W !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report.  You should have created this taxonomy using QMAN.",!

 +3        KILL BGPTAX

 +4        SET BGPTAXI=""

           SET BGPCOMMI=""

 +5        DO ^XBFMK

 +6        KILL DIR

 +7        WRITE !

           SET DIR(0)="Y"

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

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +8        IF $DATA(DIRUT)

               GOTO BY

 +9        IF Y

               Begin DoDot:1

 +10               SET DIC="^AUTTCOM("

                   SET DIC(0)="AEMQ"

                   SET DIC("A")="Which Community: "

                   DO ^DIC

                   KILL DIC

 +11               IF Y=-1

                       QUIT 

 +12               SET BGPCOMMI=+Y

               End DoDot:1

               IF BGPCOMMI=""

                   GOTO COMM

               IF BGPCOMMI

                   GOTO COMQ

 +13      ;

 +14       SET DIC("S")="I $P(^(0),U,15)=9999999.05"

           SET DIC="^ATXAX("

           SET DIC(0)="AEMQ"

           SET DIC("A")="Enter the Name of the Community Taxonomy: "

 +15       SET B=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,5)

           IF B

               SET DIC("B")=$PIECE(^ATXAX(B,0),U)

 +16       DO ^DIC

 +17       IF Y=-1

               GOTO COMM

 +18       SET BGPTAXI=+Y

COM1      ;

 +1        SET X=0

 +2        FOR 

               SET X=$ORDER(^ATXAX(BGPTAXI,21,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +3                SET BGPTAX($PIECE(^ATXAX(BGPTAXI,21,X,0),U))=""

 +4                QUIT 

               End DoDot:1

 +5        IF '$DATA(BGPTAX)

               WRITE !!,"There are no communities in that taxonomy."

               GOTO COMM

 +6        SET X=0

           SET G=0

 +7        FOR 

               SET X=$ORDER(^ATXAX(BGPTAXI,21,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +8                SET C=$PIECE(^ATXAX(BGPTAXI,21,X,0),U)

 +9                IF '$DATA(^AUTTCOM("B",C))

                       WRITE !!,"***  Warning: Community ",C," is in the taxonomy but was not",!,"found in the standard community table."

                       SET G=1

 +10               QUIT 

               End DoDot:1

 +11       IF G

               Begin DoDot:1

 +12               WRITE !!,"These communities may have been renamed or there may be patients"

 +13               WRITE !,"who have been reassigned from this community to a new community and this"

 +14               WRITE !,"could reduce your patient population."

 +15               SET BGPQUIT=0

 +16               SET DIR(0)="Y"

                   SET DIR("A")="Do you want to cancel the report and review the communities"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +17               IF $DATA(DIRUT)

                       SET BGPQUIT=1

 +18               IF Y

                       SET BGPQUIT=1

 +19               QUIT 

               End DoDot:1

               IF BGPQUIT

                   DO XIT

                   QUIT 

COMQ       KILL BGPQUIT

 +1       ;

 +2       ;

BEN       ;

 +1        SET X=0

           FOR 

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

               IF X'=+X

                   QUIT 

               SET BGPIND(X)=""

 +2        SET BGPINDG="G"

 +3        IF $GET(BGPSEAT)

               GOTO HOME

 +4        SET BGPBEN=""

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

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

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

           KILL DA

           DO ^DIR

           KILL DIR

 +8        IF $DATA(DIRUT)

               GOTO COMM

 +9        SET BGPBEN=Y

           SET BGPBENF=Y(0)

HOME      ;

 +1        SET BGPHOME=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,2)

 +2        IF BGPHOME=""

               WRITE !!,"Home Location not found in Site File!!",!,"PHN Visits counts to Home will be calculated using clinic 11 only!!"

               HANG 2

               GOTO AI

 +3        WRITE !,"Your HOME location is defined as: ",$PIECE(^DIC(4,BGPHOME,0),U)," asufac:  ",$PIECE(^AUTTLOC(BGPHOME,0),U,10)

AI        ;gather all gpra measures

 +1        SET X=0

           FOR 

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

               IF X'=+X

                   QUIT 

               SET BGPIND(X)=""

 +2        SET BGPINDG="G"

EXPORT    ;export to area or not?

 +1        SET BGPEXPT=""

 +2        IF $GET(BGPDESGP)

               GOTO EISSEX

 +3        IF $DATA(BGPSEAT)

               GOTO EISSEX

 +4        WRITE !

           SET DIR(0)="Y"

           SET DIR("A")="Do you wish to export this data to Area"

           KILL DA

           DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               GOTO BEN

 +6        SET BGPEXPT=Y

EISSEX    ;

 +1        SET BGPEXCEL=""

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

 +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        IF BGPEXPT

               IF BGPUF=""

                   IF '$DATA(ZTQUEUED)

                       WRITE !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written."

                   DO PAUSE^BGP8DU

                   DO XIT

                   QUIT 

SUM       ;display summary of this report

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !,$$CTR("SUMMARY OF IHS GPRA/GPRAMA PERFORMANCE REPORT TO BE GENERATED")

 +3        WRITE !,$$CTR($$RPTVER^BGP8BAN,80)

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

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

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

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

 +8        IF '$GET(BGPSEAT)

               IF BGPTAXI

                   WRITE !!,"The COMMUNITY Taxonomy to be used is: ",$PIECE(^ATXAX(BGPTAXI,0),U)