BGP8EOD.m

BGP8EOD ; IHS/CMI/LAB - IHS GPRA 08 REPORT DRIVER ;

 ;;8.0;IHS CLINICAL REPORTING;**3**;MAR 12, 2008

 ;

 ;

 W:$D(IOF) @IOF

 W !!,$$CTR("IHS Executive Order Quality Transparency Measures Report",80),!

 D XIT

CHOICE ;

 W !,"Please select the type of report would you like to run:"

 W !!?8,"H  Hard-coded Report:  Report with all parameters set to the"

 W !?11,"same as the National GPRA Report (report period of "

 W !?11,"July 1, 2007 - June 30, 2008, baseline period of July 1, 1999"

 W !?11,"- June 30, 2008, and AI/AN patients only)"

 W !!?8,"U  User-defined Report:  You select the report and baseline"

 W !?11,"periods and beneficiary population"

 W !

 S DIR(0)="F^1:1",DIR("A")="Select a Report Option"

 S DIR("B")="H",DIR("?")="Enter an H for Hard-coded or a U for User-defined"

 D ^DIR

 I $D(DIRUT) D XIT Q

 KILL DIR

 S Y=$$UP^XLFSTR(Y) I Y'="U",Y'="H" W !!,"Please enter an H for Hard-coded or a U for User-defined." G CHOICE

 S BGPRTC=Y

INTRO ;

 S BGPFYI=$O(^BGPCTRL("B",2008,0))

 I BGPRTC="H" D  G COMM

 .W !!,"This will produce an Executive Order Quality Transparency Measures report"

 .W !,"for all performance measures.  You will be asked to provide the"

 .W !,"community taxonomy to determine which patients will be included."

 .W !,"This report will be run for the Report Period July 1, 2007 through "

 .W !,"June 30, 2008 with a Baseline Year of July 1, 1999 through June 30, 2000."

 .W !,"This report will include beneficiary population of American Indian/Alaska"

 .W !,"Native only."

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

 .W !,"at the export prompt, a report will be produced in export format for the "

 .W !,"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."

 .W !

 .K DIR S DIR(0)="E",DIR("A")="Press Enter to Continue" D ^DIR K DIR,DUOUT,DIRUT

 .S BGPINDZ="A" S X=0 F  S X=$O(^BGPEOME(X)) Q:X'=+X  S BGPIND(X)=""

 .S BGPRTYPE=8

 .S (BGPBD,BGPED,BGPTP)=""

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

 .S Y=^BGPCTRL(X,0)

 .S BGPBD=$P(Y,U,8),BGPED=$P(Y,U,9)

 .S BGPPBD=$P(Y,U,10),BGPPED=$P(Y,U,11)

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

 .S BGPPER=$P(Y,U,14),BGPQTR=3

 .;BEGIN TEST STUFF

 .G NT  ;COMMENT OUT THIS LINE WHEN TESTING IN TEHR

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

 .D F

 .I BGPPER="" W !!,"no year entered..bye" D XIT 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)

 .S BGPBEN=1,BGPBENF(0)="Indian/Alaskan Native (Classification 01)" W !!,"Beneficiary Population is set to American Indian/Alaskan Native Only."

 .D TAXCHK^BGP8XTEO

 I BGPRTC="U" D

 .S BGPX=0,BGPC=3 F  S BGPX=$O(^BGPCTRL(BGPFYI,65,BGPX)) Q:BGPX'=+BGPX  D

 ..I BGPC>22 D EOP W !! S BGPC=0

 ..W ^BGPCTRL(BGPFYI,65,BGPX,0),! S BGPC=BGPC+1

 .W !

 K DIR S DIR(0)="E",DIR("A")="Press Enter to Continue" D ^DIR K DIR,DUOUT,DIRUT

 S DIR(0)="S^S:Selected set of Measures;A:All Measures",DIR("A")="Run the report on",DIR("B")="S" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D XIT Q

 S BGPINDZ=Y

 I BGPINDZ="S" D EN^BGP8EOSI I '$D(BGPIND) W !!,"No measures selected" G CHOICE

 I BGPINDZ="A" S X=0 F  S X=$O(^BGPEOME(X)) Q:X'=+X  S BGPIND(X)=""

 D TAXCHK^BGP8XTEO

TP ;get time period

 S BGPRTYPE=8

 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 date range",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 S BGPBD=$$FMADD^XLFDT(BGPPER,-364),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. 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,"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 ;

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

 D ^XBFMK

 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 X="^" G CHOICE

 I Y=-1 G CHOICE

 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

MFIC K BGPQUIT

 I $P($G(^BGPSITE(DUZ(2),0)),U,8)=1 D  I BGPMFITI="" G COMM

 .S BGPMFITI=""

 .W !!,"Specify the LOCATION taxonomy to determine which patient visits will be"

 .W !,"used to determine whether a patient is in the denominators for the report."

 .W !,"You should have created this taxonomy using QMAN.",!

 .K BGPMFIT

 .S BGPMFITI=""

 .D ^XBFMK

 .S DIC("S")="I $P(^(0),U,15)=9999999.06",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Location/Facility Taxonomy: "

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

 .D ^DIC

 .I Y=-1 Q

 .S BGPMFITI=+Y

HOME ;

 ;I BGPRTC="H" G EXPORT

 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 BEN

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

 D LISTS

BEN ;

 S BGPBEN=""

 I BGPRTC="H" S BGPBEN=1 G EXPORT

 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 COMM

 S BGPBEN=Y

EXPORT ;export to area or not?

 S BGPEXPT="" I BGPINDZ'="A" G SUM

 I BGPINDZ="A" 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:BGPRTC="U" BEN G:BGPRTC="H" COMM

 S BGPEXPT=Y

SUM ;display summary of this report

 S BGPUF=""

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

 W:$D(IOF) @IOF

 W !,$$CTR("SUMMARY OF CRS 08 EXECUTIVE ORDER REPORT TO BE GENERATED")

 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)

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

 I $G(BGPMFITI) W !!,"The MFI Location Taxonomy to be used is: ",$P(^ATXAX(BGPMFITI,0),U)

 D PT^BGP8EOSL

 I BGPROT="" G BEN

ZIS ;call to XBDBQUE

 D REPORT^BGP8EOUT

 I $G(BGPQUIT) D XIT Q

 I BGPRPT="" D XIT Q

 I BGPEXPT D

 .W !!,"A file will be created called BG08",$P(^AUTTLOC(DUZ(2),0),U,10)_".EO"_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.",!

 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="^BGPEOCE(" D ^DIK K DIK D XIT Q

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

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

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

DRIVER ;

 D ^BGP8D1

 U IO

 D ^BGP8EOP

 D ^%ZISC

 I BGPEXPT D GS^BGP8EOUT

 D XIT

 Q

 ;

NODEV ;

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

 D ^XBDBQUE

 Q

 ;

NODEV1 ;

 D ^BGP8D1

 D ^BGP8EOP

 D ^%ZISC

 I BGPEXPT D GS^BGP8EOUT

 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^BGP8EOD",ZTDTH="",ZTDESC="EO 2008 REPORT" 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)!$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")

 ;----------

 ;

LISTS ;any lists with measures?

 K BGPLIST

 W !!,"PATIENT LISTS"

 I '$D(^XUSEC("BGPZ PATIENT LISTS",DUZ)) W !!,"You do not have the security access to print patient lists.",!,"Please see your supervisor or program manager if you feel you should have",!,"the BGPZ PATIENT LISTS security key.",! D  Q

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

 S DIR(0)="Y",DIR("A")="Do you want patient lists for any of the measures",DIR("B")="N" KILL DA D ^DIR KILL DIR

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

 I Y=0 Q

 K BGPLIST

 D EN^BGP8EOSL

 I '$D(BGPLIST) W !!,"No lists selected.",!

 I $D(BGPLIST) D RT^BGP8EOSL I '$D(BGPLIST)!($D(BGPQUIT)) G LISTS ;get report type for each list

 Q

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

 S (BGPPER,BGPVDT)=""

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

 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 ;

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

 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, 2008 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/2008 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. 11/30/2005)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) Q

 S (BGPPER,BGPVDT)=Y

 Q

B ;fiscal year

 S (BGPBPER,BGPVDT)=""

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

 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

BGP8EOD   ; IHS/CMI/LAB - IHS GPRA 08 REPORT DRIVER ;

 +1       ;;8.0;IHS CLINICAL REPORTING;**3**;MAR 12, 2008

 +2       ;

 +3       ;

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        WRITE !!,$$CTR("IHS Executive Order Quality Transparency Measures Report",80),!

 +6        DO XIT

CHOICE    ;

 +1        WRITE !,"Please select the type of report would you like to run:"

 +2        WRITE !!?8,"H  Hard-coded Report:  Report with all parameters set to the"

 +3        WRITE !?11,"same as the National GPRA Report (report period of "

 +4        WRITE !?11,"July 1, 2007 - June 30, 2008, baseline period of July 1, 1999"

 +5        WRITE !?11,"- June 30, 2008, and AI/AN patients only)"

 +6        WRITE !!?8,"U  User-defined Report:  You select the report and baseline"

 +7        WRITE !?11,"periods and beneficiary population"

 +8        WRITE !

 +9        SET DIR(0)="F^1:1"

           SET DIR("A")="Select a Report Option"

 +10       SET DIR("B")="H"

           SET DIR("?")="Enter an H for Hard-coded or a U for User-defined"

 +11       DO ^DIR

 +12       IF $DATA(DIRUT)

               DO XIT

               QUIT 

 +13       KILL DIR

 +14       SET Y=$$UP^XLFSTR(Y)

           IF Y'="U"

               IF Y'="H"

                   WRITE !!,"Please enter an H for Hard-coded or a U for User-defined."

                   GOTO CHOICE

 +15       SET BGPRTC=Y

INTRO     ;

 +1        SET BGPFYI=$ORDER(^BGPCTRL("B",2008,0))

 +2        IF BGPRTC="H"

               Begin DoDot:1

 +3                WRITE !!,"This will produce an Executive Order Quality Transparency Measures report"

 +4                WRITE !,"for all performance measures.  You will be asked to provide the"

 +5                WRITE !,"community taxonomy to determine which patients will be included."

 +6                WRITE !,"This report will be run for the Report Period July 1, 2007 through "

 +7                WRITE !,"June 30, 2008 with a Baseline Year of July 1, 1999 through June 30, 2000."

 +8                WRITE !,"This report will include beneficiary population of American Indian/Alaska"

 +9                WRITE !,"Native only."

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

 +11               WRITE !,"at the export prompt, a report will be produced in export format for the "

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

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

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

 +15               WRITE !

 +16               KILL DIR

                   SET DIR(0)="E"

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

                   DO ^DIR

                   KILL DIR,DUOUT,DIRUT

 +17               SET BGPINDZ="A"

                   SET X=0

                   FOR 

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

                       IF X'=+X

                           QUIT 

                       SET BGPIND(X)=""

 +18               SET BGPRTYPE=8

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

 +20               SET X=$ORDER(^BGPCTRL("B",2008,0))

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

 +22               SET BGPBD=$PIECE(Y,U,8)

                   SET BGPED=$PIECE(Y,U,9)

 +23               SET BGPPBD=$PIECE(Y,U,10)

                   SET BGPPED=$PIECE(Y,U,11)

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

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

 +25               SET BGPPER=$PIECE(Y,U,14)

                   SET BGPQTR=3

 +26      ;BEGIN TEST STUFF

 +27      ;COMMENT OUT THIS LINE WHEN TESTING IN TEHR

                   GOTO NT

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

 +29               DO F

 +30               IF BGPPER=""

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

                       DO XIT

                       QUIT 

 +31               SET BGPQTR=3

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

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

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

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

 +34               WRITE !!,"for testing purposes only, please enter a BASELINE year",!

 +35               DO B

 +36               IF BGPBPER=""

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

                       DO XIT

                       QUIT 

 +37               SET BGPBBD=$EXTRACT(BGPBPER,1,3)_"0101"

                   SET BGPBED=$EXTRACT(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)

 +5                SET BGPBEN=1

                   SET BGPBENF(0)="Indian/Alaskan Native (Classification 01)"

                   WRITE !!,"Beneficiary Population is set to American Indian/Alaskan Native Only."

 +6                DO TAXCHK^BGP8XTEO

               End DoDot:1

               GOTO COMM

 +7        IF BGPRTC="U"

               Begin DoDot:1

 +8                SET BGPX=0

                   SET BGPC=3

                   FOR 

                       SET BGPX=$ORDER(^BGPCTRL(BGPFYI,65,BGPX))

                       IF BGPX'=+BGPX

                           QUIT 

                       Begin DoDot:2

 +9                        IF BGPC>22

                               DO EOP

                               WRITE !!

                               SET BGPC=0

 +10                       WRITE ^BGPCTRL(BGPFYI,65,BGPX,0),!

                           SET BGPC=BGPC+1

                       End DoDot:2

 +11               WRITE !

               End DoDot:1

 +12       KILL DIR

           SET DIR(0)="E"

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

           DO ^DIR

           KILL DIR,DUOUT,DIRUT

 +13       SET DIR(0)="S^S:Selected set of Measures;A:All Measures"

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

           SET DIR("B")="S"

           KILL DA

           DO ^DIR

           KILL DIR

 +14       IF $DATA(DIRUT)

               DO XIT

               QUIT 

 +15       SET BGPINDZ=Y

 +16       IF BGPINDZ="S"

               DO EN^BGP8EOSI

               IF '$DATA(BGPIND)

                   WRITE !!,"No measures selected"

                   GOTO CHOICE

 +17       IF BGPINDZ="A"

               SET X=0

               FOR 

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

                   IF X'=+X

                       QUIT 

                   SET BGPIND(X)=""

 +18       DO TAXCHK^BGP8XTEO

TP        ;get time period

 +1        SET BGPRTYPE=8

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

 +3        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 date range"

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

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               DO XIT

               QUIT 

 +5        SET BGPQTR=Y

 +6        IF BGPQTR=5

               DO ENDDATE

 +7        IF BGPQTR'=5

               DO F

 +8        IF BGPPER=""

               WRITE !,"Year not entered.",!

               GOTO TP

 +9        IF BGPQTR=1

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

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

 +10       IF BGPQTR=2

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

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

 +11       IF BGPQTR=3

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

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

 +12       IF BGPQTR=4

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

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

 +13       IF BGPQTR=5

               SET BGPBD=$$FMADD^XLFDT(BGPPER,-364)

               SET BGPED=BGPPER

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

 +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,"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        WRITE !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report.  You should have created this taxonomy using QMAN.",!

 +2        KILL BGPTAX

 +3        SET BGPTAXI=""

 +4        DO ^XBFMK

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

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

           IF B

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

 +7        DO ^DIC

 +8        IF X="^"

               GOTO CHOICE

 +9        IF Y=-1

               GOTO CHOICE

 +10       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))