BGP8NPL.m

BGP8NPL ; IHS/CMI/LAB - national patient list 20 Dec 2004 9:24 AM 30 Jun 2010 5:21 PM ;

 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 ;

 ;

 ;

 W:$D(IOF) @IOF

 W !,$$CTR("IHS GPRA/GPRAMA Performance Report Patient List",80)

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

INTRO ;

 D XIT

 W !!,"This will produce a list of patients who either met or did not meet a National"

 W !,"GPRA/GPRAMA Report performance measure or a list of both those patients"

 W !,"who met and those who did not meet a National GPRA/GPRAMA Report performance"

 W !,"measure.  You will be asked to select one or more performance measure"

 W !,"topics and then choose which performance measure numerators you "

 W !,"would like to report on.",!!

 W !,"You will also be asked to provide the community taxonomy to determine"

 W !,"which patients will be included, the beneficiary population of the"

 W !,"patients, and the Report Period and Baseline Year."

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

 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

 D TAXCHK^BGP8XTCN

 S X=$$DEMOCHK^BGP8UTL2()

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

TP ;get time period

 D XIT

 S BGPRTYPE=1,BGPYRPTH="",BGPNPL=1,BGPINDG="G",BGPYGPU=1

SI ;

 K DIRUT

 K BGPIND

 D EN^BGP8DSI

 I '$D(BGPIND) W !!,"No measures selected." H 3 D XIT Q

SI1 ;NOW SELECT ONE OR MORE W/IN THE TOPIC

 K BGPLIST,BGPX,BGPY,BGPINDL S BGPQ=0

 D TERM^VALM0

 ;REORDER IN AOI FORMAT

 K BGPINDO

 S BGPIND=0 F  S BGPIND=$O(BGPIND(BGPIND)) Q:BGPIND'=+BGPIND  S BGPINDO($P(^BGPINDR(BGPIND,12),U,6),BGPIND)=""

 S BGPORD=0 F  S BGPORD=$O(BGPINDO(BGPORD)) Q:BGPORD'=+BGPORD!(BGPQ)!($D(DIRUT))  D

 .S BGPIND=$O(BGPINDO(BGPORD,0))

 .S BGPCR=$S(BGPRTYPE=7:"AON",1:"AN")

 .K BGPX S BGPO=0,X=0,BGPC=0 F  S BGPO=$O(^BGPNPLR(BGPCR,BGPIND,BGPO)) Q:BGPO'=+BGPO!($D(DIRUT))  D

 ..S X=$O(^BGPNPLR(BGPCR,BGPIND,BGPO,0))

 ..;I BGPRTYPE=1,$P(^BGPNPLR(X,0),U,4)'="N" Q

 ..;I BGPRTYPE=7,$P(^BGPNPLR(X,0),U,4)'="O" Q

 ..S BGPX(BGPO,X)="",BGPC=BGPC+1

 .;display the choices

 .W !!!,"Please select one or more of these report choices within the",!,IORVON,$P(^BGPINDR(BGPIND,0),U,3),IORVOFF," performance measure topic.",!

 .K BGPY S X=0,BGPC=0,BGPO=0 F  S BGPO=$O(BGPX(BGPO)) Q:BGPO'=+BGPO!($D(DIRUT))  S X=0 F  S X=$O(BGPX(BGPO,X)) Q:X'=+X!($D(DIRUT))  S BGPC=BGPC+1 W !?5,BGPC,")",?9,$P(^BGPNPLR(X,0),U,3) S BGPY(BGPC)=X

 .S DIR(0)="L^1:"_BGPC,DIR("A")="Which item(s)"

 .D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 .I Y="" W !,"No REPORTS selected for this topic." Q

 .I $D(DIRUT) W !,"No REPORTs selected for this topic." Q

 .S BGPANS=Y,BGPC="" F BGPI=1:1 S BGPC=$P(BGPANS,",",BGPI) Q:BGPC=""  S BGPINDL(BGPIND,BGPY(BGPC))=""

 ;get report type

 I $D(DIRUT) G SI

 K BGPQUIT D RT^BGP8DSL I '$D(BGPLIST)!($D(BGPQUIT)) G SI

TP1 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) G SI

 S BGPQTR=Y

 I BGPQTR=5 D ENDDATE

 I BGPQTR'=5 D F

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

 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 TP1

 .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 TP1

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

 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 Y=-1 G BY

 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

 K BGPQUIT

 ;

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

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

SUM ;display summary of this report

 W:$D(IOF) @IOF

 I BGPRTYPE=7 W !,$$CTR("SUMMARY OF "_$S(BGPRTYPE=7:"OTHER ",1:"")_"NATIONAL GPRA REPORT TO BE GENERATED")

 I BGPRTYPE'=7 W !,$$CTR("SUMMARY OF NATIONAL GPRA/GPRAMA 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)

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

 D TEXT^BGP8DSL

 I $D(DIRUT) G BEN

 D PT^BGP8DSL

 I BGPROT="" G COMM

ZIS ;call to XBDBQUE

 D REPORT^BGP8UTL

 I $G(BGPQUIT) D XIT Q

 I BGPRPT="" D XIT Q

 S BGPUF=$$GETDIR^BGP8UTL2()

 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 ;

 D ^BGP8D1

 U IO

 D ^BGP8DP

 D ^%ZISC

 D XIT

 Q

 ;

NODEV ;

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

 D ^XBDBQUE

 Q

 ;

NODEV1 ;

 D ^BGP8D1

 D ^BGP8DP

 D ^%ZISC

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

 Q

 ;

XIT ;

 D ^%ZISC

 D EN^XBVK("BGP")

 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 ;

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

 ;

NONNPL ;EP

 W:$D(IOF) @IOF

 W !,$$CTR("IHS Other National Measures Performance Report Patient List",80)

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

INTRONON ;

 D XIT

 W !!,"This will produce a list of patients who either met or did not meet"

 W !,"an Other National Measures Report performance measure or a list of"

 W !,"both those patients who met and those who did not meet an Other National "

 W !,"Measures Report performance measure.  You will be asked to select one or "

 W !,"more performance measure topics and then choose which performance "

 W !,"measure numerators you would like to report on."

 W !!,"You will also be asked to provide the community taxonomy to determine"

 W !,"which patients will be included, the beneficiary population of the"

 W !,"patients, and the Report Period and Baseline Year."

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

 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

 D TAXCHK^BGP8XTCO

 S X=$$DEMOCHK^BGP8UTL2()

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

TPNON ;get time period

 D XIT

 S BGPRTYPE=7,BGPYRPTH="",BGPNPL=1,BGPINDG="G",BGPYGPU=1,BGPONMR=1,BGPRTC="U"

 G SI

BGP8NPL   ; IHS/CMI/LAB - national patient list 20 Dec 2004 9:24 AM 30 Jun 2010 5:21 PM ;

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

 +2       ;

 +3       ;

 +4       ;

 +5        IF $DATA(IOF)

               WRITE @IOF

 +6        WRITE !,$$CTR("IHS GPRA/GPRAMA Performance Report Patient List",80)

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

INTRO     ;

 +1        DO XIT

 +2        WRITE !!,"This will produce a list of patients who either met or did not meet a National"

 +3        WRITE !,"GPRA/GPRAMA Report performance measure or a list of both those patients"

 +4        WRITE !,"who met and those who did not meet a National GPRA/GPRAMA Report performance"

 +5        WRITE !,"measure.  You will be asked to select one or more performance measure"

 +6        WRITE !,"topics and then choose which performance measure numerators you "

 +7        WRITE !,"would like to report on.",!!

 +8        WRITE !,"You will also be asked to provide the community taxonomy to determine"

 +9        WRITE !,"which patients will be included, the beneficiary population of the"

 +10       WRITE !,"patients, and the Report Period and Baseline Year."

 +11       KILL DIR

           SET DIR(0)="E"

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

           DO ^DIR

           KILL DIR

 +12       IF '$DATA(^XUSEC("BGPZ PATIENT LISTS",DUZ))

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

               Begin DoDot:1

 +13               KILL DIR

                   SET DIR(0)="E"

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

                   DO ^DIR

                   KILL DIR

               End DoDot:1

               QUIT 

 +14       DO TAXCHK^BGP8XTCN

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

 +16       IF 'X

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

               DO PAUSE^BGP8DU

               DO XIT

               QUIT 

TP        ;get time period

 +1        DO XIT

 +2        SET BGPRTYPE=1

           SET BGPYRPTH=""

           SET BGPNPL=1

           SET BGPINDG="G"

           SET BGPYGPU=1

SI        ;

 +1        KILL DIRUT

 +2        KILL BGPIND

 +3        DO EN^BGP8DSI

 +4        IF '$DATA(BGPIND)

               WRITE !!,"No measures selected."

               HANG 3

               DO XIT

               QUIT 

SI1       ;NOW SELECT ONE OR MORE W/IN THE TOPIC

 +1        KILL BGPLIST,BGPX,BGPY,BGPINDL

           SET BGPQ=0

 +2        DO TERM^VALM0

 +3       ;REORDER IN AOI FORMAT

 +4        KILL BGPINDO

 +5        SET BGPIND=0

           FOR 

               SET BGPIND=$ORDER(BGPIND(BGPIND))

               IF BGPIND'=+BGPIND

                   QUIT 

               SET BGPINDO($PIECE(^BGPINDR(BGPIND,12),U,6),BGPIND)=""

 +6        SET BGPORD=0

           FOR 

               SET BGPORD=$ORDER(BGPINDO(BGPORD))

               IF BGPORD'=+BGPORD!(BGPQ)!($DATA(DIRUT))

                   QUIT 

               Begin DoDot:1

 +7                SET BGPIND=$ORDER(BGPINDO(BGPORD,0))

 +8                SET BGPCR=$SELECT(BGPRTYPE=7:"AON",1:"AN")

 +9                KILL BGPX

                   SET BGPO=0

                   SET X=0

                   SET BGPC=0

                   FOR 

                       SET BGPO=$ORDER(^BGPNPLR(BGPCR,BGPIND,BGPO))

                       IF BGPO'=+BGPO!($DATA(DIRUT))

                           QUIT 

                       Begin DoDot:2

 +10                       SET X=$ORDER(^BGPNPLR(BGPCR,BGPIND,BGPO,0))

 +11      ;I BGPRTYPE=1,$P(^BGPNPLR(X,0),U,4)'="N" Q

 +12      ;I BGPRTYPE=7,$P(^BGPNPLR(X,0),U,4)'="O" Q

 +13                       SET BGPX(BGPO,X)=""

                           SET BGPC=BGPC+1

                       End DoDot:2

 +14      ;display the choices

 +15               WRITE !!!,"Please select one or more of these report choices within the",!,IORVON,$PIECE(^BGPINDR(BGPIND,0),U,3),IORVOFF," performance measure topic.",!

 +16               KILL BGPY

                   SET X=0

                   SET BGPC=0

                   SET BGPO=0

                   FOR 

                       SET BGPO=$ORDER(BGPX(BGPO))

                       IF BGPO'=+BGPO!($DATA(DIRUT))

                           QUIT 

                       SET X=0

                       FOR 

                           SET X=$ORDER(BGPX(BGPO,X))

                           IF X'=+X!($DATA(DIRUT))

                               QUIT 

                           SET BGPC=BGPC+1

                           WRITE !?5,BGPC,")",?9,$PIECE(^BGPNPLR(X,0),U,3)

                           SET BGPY(BGPC)=X

 +17               SET DIR(0)="L^1:"_BGPC

                   SET DIR("A")="Which item(s)"

 +18               DO ^DIR

                   KILL DIR

                   IF $DATA(DUOUT)

                       SET DIRUT=1

 +19               IF Y=""

                       WRITE !,"No REPORTS selected for this topic."

                       QUIT 

 +20               IF $DATA(DIRUT)

                       WRITE !,"No REPORTs selected for this topic."

                       QUIT 

 +21               SET BGPANS=Y

                   SET BGPC=""

                   FOR BGPI=1:1

                       SET BGPC=$PIECE(BGPANS,",",BGPI)

                       IF BGPC=""

                           QUIT 

                       SET BGPINDL(BGPIND,BGPY(BGPC))=""

               End DoDot:1

 +22      ;get report type

 +23       IF $DATA(DIRUT)

               GOTO SI

 +24       KILL BGPQUIT

           DO RT^BGP8DSL

           IF '$DATA(BGPLIST)!($DATA(BGPQUIT))

               GOTO SI

TP1        SET (BGPBD,BGPED,BGPTP)=""

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

 +2        IF $DATA(DIRUT)

               GOTO SI

 +3        SET BGPQTR=Y

 +4        IF BGPQTR=5

               DO ENDDATE

 +5        IF BGPQTR'=5

               DO F

 +6        IF BGPPER=""

               WRITE !,"Year not entered.",!

               GOTO TP1

 +7        IF BGPQTR=1

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

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

 +8        IF BGPQTR=2

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

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

 +9        IF BGPQTR=3

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

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

 +10       IF BGPQTR=4

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

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

 +11       IF BGPQTR=5

               Begin DoDot:1

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

 +13               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"

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

 +15       IF BGPED>DT

               Begin DoDot:1

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

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

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

 +19               IF $DATA(DIRUT)

                       SET BGPDO=1

                       QUIT 

 +20               IF Y

                       SET BGPDO=1

                       QUIT 

 +21               QUIT 

               End DoDot:1

               IF BGPDO=1

                   GOTO TP1

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 TP1

 +7        IF $DATA(DUOUT)

               SET DIRUT=1

               GOTO TP1

 +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 Y=-1

               GOTO BY

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

 +20       KILL BGPQUIT

 +21      ;

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 COMM

 +5        SET BGPBEN=Y

           SET BGPBENF=Y(0)

HOME      ;

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

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

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

SUM       ;display summary of this report

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        IF BGPRTYPE=7

               WRITE !,$$CTR("SUMMARY OF "_$SELECT(BGPRTYPE=7:"OTHER ",1:"")_"NATIONAL GPRA REPORT TO BE GENERATED")

 +3        IF BGPRTYPE'=7

               WRITE !,$$CTR("SUMMARY OF NATIONAL GPRA/GPRAMA REPORT TO BE GENERATED")

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

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

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

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

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

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

 +10       DO TEXT^BGP8DSL

 +11       IF $DATA(DIRUT)

               GOTO BEN

 +12       DO PT^BGP8DSL

 +13       IF BGPROT=""

               GOTO COMM

ZIS       ;call to XBDBQUE

 +1        DO REPORT^BGP8UTL

 +2        IF $GET(BGPQUIT)

               DO XIT

               QUIT 

 +3        IF BGPRPT=""

               DO XIT

               QUIT 

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

 +5        KILL IOP,%ZIS

           IF BGPROT="D"

               IF BGPDELT="F"

                   DO NODEV

                   DO XIT

                   QUIT 

 +6        KILL IOP,%ZIS

           WRITE !!