BGP2DHW.m

BGP2DHW ; IHS/CMI/LAB - NATL COMP EXPORT 13 Nov 2006 12:31 PM ;

 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 ;

 ;

 W:$D(IOF) @IOF

 W !,$$CTR("IHS 2012 National GPRA & PART Height and Weight Local Data File",80),!

INTRO ;

 D XIT

 D TERM^VALM0

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

 F X=1:1:18 W !,^BGPCTRL(BGPCTRL,73,X,0)

 D EOP

 S X=18 F  S X=$O(^BGPCTRL(BGPCTRL,73,X)) Q:X'=+X  D

 .W !,^BGPCTRL(BGPCTRL,73,X,0)

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

 ;

 D TAXCHK^BGP2XTCN

 S X=$$DEMOCHK^BGP2UTL2()

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

TP ;get time period

 D XIT

 S BGPRTYPE=1,BGPYRPTH=""

 S X=$O(^BGPCTRL("B",2012,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 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)

BEN ;

 S BGPBEN=1 W !!,"The beneficiary population for this report is AI/AN only."

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 K DIC

 I Y=-1 D XIT Q

 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 ;

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

AI ;gather all gpra measures

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

 S BGPINDW="G"

EXPORT ;export to area or not?

 S BGPYWCHW=2

 S BGPEXPT=1,BGPYWCHW=0

EISSEX ;

 S BGPEXCEL=""

 S BGPUF=$$GETDIR^BGP2UTL2()

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

 ;

CHW ;

 S BGPYWCHW=2 D  I BGPONEF="" G COMM

 .S BGPHWNOW=$$NOW^XLFDT() S BGPHWNOW=$P(BGPHWNOW,".")_"."_$$RZERO^BGP2UTL($P(BGPHWNOW,".",2),6)

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

 .S BGPFN="CRSHW"_$P(^AUTTLOC(DUZ(2),0),U,10)_$$D^BGP2UTL(BGPBD)_$$D^BGP2UTL(BGPED)_$$D^BGP2UTL(BGPHWNOW)_"_001_of_001"_".TXT"

 .D ONEF

 .Q

SUM ;display summary of this report

 W:$D(IOF) @IOF

 W !,$$CTR("SUMMARY OF NATIONAL GPRA & PART HEIGHT AND WEIGHT")

 W !,$$CTR("LOCAL DATA FILE 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)

 W !!,"The height and weight data file will be named: ",!,BGPFN

 W !,"and will reside in the ",BGPUF," directory."

 I BGPONEF="M" D

 .W !,"Since you opted to create multiple files, if additional files are"

 .W !,"generated they will all have the same name as the one listed above"

 .W !,"with the last 10 characters of the filename being the number of "

 .W !,"files (e.g. 001_of_003)."

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

 S BGPROT="P",BGPDELT="" ;D PT^BGP2DSL

 I BGPROT="" G BEN

ZIS ;call to XBDBQUE

 D REPORT^BGP2UTL

 I $G(BGPQUIT) D XIT Q

 I BGPRPT="" D XIT Q

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

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

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

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

DRIVER ;

 I $D(ZTQUEUED) S ZTREQ="@"

 D ^BGP2D1

 D HWSF

 U IO

 D PRINT^BGP2DHW

 D ^%ZISC

 D KITM

 Q

 ;

ONEF ;

 S BGPONEF=""

 W !!!,"A Height/Weight Export file will be created.  You can choose"

 W !,"to create one file of data or multiple files of data.  If you are"

 W !,"planning to review this data using Microsoft Excel please keep in"

 W !,"mind that Excel can only handle 65,536 records per file.  If you"

 W !,"expect that your site has more than 65,536 records you will need"

 W !,"to create multiple files in order to use this data in Excel.  If"

 W !,"you choose to create one file it will be called:"

 W !?5,BGPFN,!?5,"and will reside in the ",BGPUF," directory."

 W !,"If you have multiple files generated they will all have the"

 W !,"same name with the last 10 characters of the filename being"

 W !,"the number of files (e.g. 001_of_003)."

 ; 

 S DIR(0)="S^O:ONE File of data;M:MULTIPLE Files of data",DIR("A")="Do you want to create one file or multiple files",DIR("B")="M" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) Q

 S BGPONEF=Y

 Q

NODEV ;

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

 D ^XBDBQUE

 Q

 ;

NODEV1 ;

 D ^BGP2D1

 D HWSF

 D PRINT^BGP2DHW

 D ^%ZISC

 D KITM

 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^BGP2DHW",ZTDTH="",ZTDESC="NATIONAL GPRA LOCAL HW DATA" 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)

 NEW DIR,X

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

 S (BGPPER,BGPVDT)=""

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

 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

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

HWSF ;EP

 I '$D(ZTQUEUED) W !!,"Writing out Ht/Wt file...."

 K BGPFILES

 ;count up total # of records and divide by 65,536

 I BGPONEF="O" D HWSF1 Q

 S BGPX=0,BGPTOT=0 F  S BGPX=$O(^BGPGPDCW(BGPRPT,88888,BGPX)) Q:BGPX'=+BGPX  S BGPTOT=BGPTOT+1

 S BGPNF1=BGPTOT/65536

 S BGPNF=$S($P(BGPNF1,".",2)]"":$P(BGPNF1,".")+1,1:BGPNF1)

 S BGPNF=$P(BGPNF,".")

 S BGPX=0,BGPLX=0

 F BGPZ=1:1:BGPNF D

 .S BGPFN="CRSHW"_$P(^AUTTLOC(DUZ(2),0),U,10)_$$D^BGP2UTL(BGPBD)_$$D^BGP2UTL(BGPED)_$$D^BGP2UTL(BGPHWNOW)_"_"_$$LZERO^BGP2UTL(BGPZ,3)_"_of_"_$$LZERO^BGP2UTL(BGPNF,3)_".TXT"

 .S BGPFILES(BGPZ)=BGPFN

 .S Y=$$OPEN^%ZISH(BGPUF,BGPFN,"W")

 .I Y=1 W:'$D(ZTQUEUED) !!,"Cannot open host file." Q

 .U IO

 .W "SERVICE UNIT^ASUFAC^UNIQUE DB ID^DATE RUN^BEG DATE^END DATE^PATIENT UID^DOB^TRIBE CODE^GENDER^STATE OF RESIDENCE^UNIQUE VISIT ID^DATE OF VISIT^TIME OF VISIT^HT CM^WT KG",!

 .S BGPC=1,BGPX=$S(BGPLX:BGPLX,1:0)

 .F  S BGPX=$O(^BGPGPDCW(BGPRPT,88888,BGPX)) Q:BGPX'=+BGPX!(BGPC>65535)  D

 ..W $G(^BGPGPDCW(BGPRPT,88888,BGPX,0)),!

 ..S BGPC=BGPC+1

 ..S BGPLX=BGPX

 .D ^%ZISC

 Q

HWSF1 ;EP

 ;write out one file only

 S BGPZ=1,BGPFN="CRSHW"_$P(^AUTTLOC(DUZ(2),0),U,10)_$$D^BGP2UTL(BGPBD)_$$D^BGP2UTL(BGPED)_$$D^BGP2UTL(BGPHWNOW)_"_001_of_001.TXT"

 S BGPFILES(1)=BGPFN

 I '$D(ZTQUEUED) U IO W !?10,BGPFN

 S Y=$$OPEN^%ZISH(BGPUF,BGPFN,"W")

 I Y=1 W:'$D(ZTQUEUED) !!,"Cannot open host file." Q

 U IO

 W "SERVICE UNIT^ASUFAC^UNIQUE DB ID^DATE RUN^BEG DATE^END DATE^PATIENT UID^DOB^TRIBE CODE^GENDER^STATE OF RESIDENCE^UNIQUE VISIT ID^DATE OF VISIT^TIME OF VISIT^HT CM^WT KG",!

 S BGPC=1,BGPX=0

 F  S BGPX=$O(^BGPGPDCW(BGPRPT,88888,BGPX)) Q:BGPX'=+BGPX  D

 .W $G(^BGPGPDCW(BGPRPT,88888,BGPX,0)),!

 .S BGPC=BGPC+1

 D ^%ZISC

 Q

KITM ;EP - kill tmp globals

 K ^TMP($J)

 K ^XTMP("BGP2D",BGPJ,BGPH)

 K ^XTMP("BGP2DNP",BGPJ,BGPH)

 K ^XTMP("BGP28CPL",BGPJ,BGPH)

 Q

PRINT ;EP

 S BGPQUIT=0,BGPGPG=0

 S BGPIOSL=$S($G(BGPGUI):55,1:$G(IOSL))

 D HEADER

 W !

 W !?10,"Community Taxonomy Name: ",$P(^ATXAX(BGPTAXI,0),U)

 W !?10,"The following communities are included in this report:",! D

 .S BGPZZ="",BGPN=0,BGPY="" F  S BGPZZ=$O(BGPTAX(BGPZZ)) Q:BGPZZ=""!(BGPQUIT)  S BGPN=BGPN+1,BGPY=BGPY_$S(BGPN=1:"",1:";")_BGPZZ

 .S BGPZZ=0,C=0 F BGPZZ=1:3:BGPN D  Q:BGPQUIT

 ..I $Y>(BGPIOSL-2) D HEADER Q:BGPQUIT

 ..W !?10,$E($P(BGPY,";",BGPZZ),1,20),?30,$E($P(BGPY,";",(BGPZZ+1)),1,20),?60,$E($P(BGPY,";",(BGPZZ+2)),1,20)

 ..Q

 Q:BGPQUIT

 I $G(BGPMFITI) W !!?10,"MFI Visit Location Taxonomy Name: ",$P(^ATXAX(BGPMFITI,0),U)

 I $G(BGPMFITI) W !?10,"The following Locations are used for patient visits in this report:",! D

 .S BGPZZ="",BGPN=0,BGPY="" F  S BGPZZ=$O(^ATXAX(BGPMFITI,21,"B",BGPZZ)) Q:BGPZZ=""  S BGPN=BGPN+1,BGPY=BGPY_$S(BGPN=1:"",1:";")_$P($G(^DIC(4,BGPZZ,0)),U)

 .S BGPZZ=0,C=0 F BGPZZ=1:3:BGPN D  Q:BGPQUIT

 ..I $Y>(BGPIOSL-2) D HEADER Q:BGPQUIT

 ..W !?10,$E($P(BGPY,";",BGPZZ),1,20),?30,$E($P(BGPY,";",(BGPZZ+1)),1,20),?60,$E($P(BGPY,";",(BGPZZ+2)),1,20)

 ..Q

 I $Y>(IOSL-3) D HEADER Q:BGPQUIT

 W !!,"Delimited Height and Weight File(s): "

 S BGPX=0 F  S BGPX=$O(BGPFILES(BGPX)) Q:BGPX'=+BGPX  D

 .I $Y>(IOSL-2) D HEADER Q:BGPQUIT

 .W !?5,BGPFILES(BGPX)

 I $Y>(IOSL-2) D HEADER Q:BGPQUIT

 W !!,"Directory Name: ",BGPUF

 K BGPX,BGPQUIT

 Q

HEADER ;EP

 G:'BGPGPG HEADER1

 K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQUIT=1 Q

HEADER1 ;

 I BGPGPG W:$D(IOF) @IOF

 I $G(BGPGUI),BGPGPG W "ZZZZZZZ",!  ;maw

 S BGPGPG=BGPGPG+1

 W $P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!

 W $$CTR("*** IHS 2012 National GPRA & PART Height and Weight Local Data File ***",80),!

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

 W !,$$CTR("Date File Run: "_$$FMTE^XLFDT(DT),80)

 W !,$$CTR("Site where Run: "_$P(^DIC(4,DUZ(2),0),U),80)

 W !,$$CTR("File Generated by: "_$$USR,80)

 S X="Report Period:  "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W !,$$CTR(X,80)

 W !,$TR($J("",80)," ","-"),!

 Q

BGP2DHW   ; IHS/CMI/LAB - NATL COMP EXPORT 13 Nov 2006 12:31 PM ;

 +1       ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 +2       ;

 +3       ;

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        WRITE !,$$CTR("IHS 2012 National GPRA & PART Height and Weight Local Data File",80),!

INTRO     ;

 +1        DO XIT

 +2        DO TERM^VALM0

 +3        SET BGPCTRL=$ORDER(^BGPCTRL("B",2012,0))

 +4        FOR X=1:1:18

               WRITE !,^BGPCTRL(BGPCTRL,73,X,0)

 +5        DO EOP

 +6        SET X=18

           FOR 

               SET X=$ORDER(^BGPCTRL(BGPCTRL,73,X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +7                WRITE !,^BGPCTRL(BGPCTRL,73,X,0)

               End DoDot:1

 +8        WRITE !

           KILL DIR

           SET DIR(0)="E"

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

           DO ^DIR

           KILL DIR

 +9       ;

 +10       DO TAXCHK^BGP2XTCN

 +11       SET X=$$DEMOCHK^BGP2UTL2()

 +12       IF 'X

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

               DO PAUSE^BGP2DU

               DO XIT

               QUIT 

TP        ;get time period

 +1        DO XIT

 +2        SET BGPRTYPE=1

           SET BGPYRPTH=""

 +3        SET X=$ORDER(^BGPCTRL("B",2012,0))

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

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

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

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

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

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

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

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

           SET BGPQTR=3

 +9       ;BEGIN TEST STUFF

 +10      ;comment out when testing in TEHR

           GOTO NT

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

 +12       DO F

 +13       IF BGPPER=""

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

               DO XIT

               QUIT 

 +14       SET BGPQTR=3

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

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

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

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

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

 +18       DO B

 +19       IF BGPBPER=""

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

               DO XIT

               QUIT 

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

BEN       ;

 +1        SET BGPBEN=1

           WRITE !!,"The beneficiary population for this report is AI/AN only."

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

           KILL DIC

 +8        IF Y=-1

               DO XIT

               QUIT 

 +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 

MFIC       KILL BGPQUIT

 +1        IF $PIECE($GET(^BGPSITE(DUZ(2),0)),U,8)=1

               Begin DoDot:1

 +2                SET BGPMFITI=""

 +3                WRITE !!,"Specify the LOCATION taxonomy to determine which patient visits will be"

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

 +5                WRITE !,"You should have created this taxonomy using QMAN.",!

 +6                KILL BGPMFIT

 +7                SET BGPMFITI=""

 +8                DO ^XBFMK

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

                   SET DIC="^ATXAX("

                   SET DIC(0)="AEMQ"

                   SET DIC("A")="Enter the Name of the Location/Facility Taxonomy: "

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

                   IF B

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

 +11               DO ^DIC

 +12               IF Y=-1

                       QUIT 

 +13               SET BGPMFITI=+Y

               End DoDot:1

               IF BGPMFITI=""

                   GOTO COMM

HOME      ;

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

AI        ;gather all gpra measures

 +1        SET X=0

           FOR 

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

               IF X'=+X

                   QUIT 

               SET BGPIND(X)=""

 +2        SET BGPINDW="G"

EXPORT    ;export to area or not?

 +1        SET BGPYWCHW=2

 +2        SET BGPEXPT=1

           SET BGPYWCHW=0

EISSEX    ;

 +1        SET BGPEXCEL=""

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

 +3        IF BGPEXPT

               IF BGPUF=""

                   IF '$DATA(ZTQUEUED)

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

                   DO PAUSE^BGP2DU

                   DO XIT

                   QUIT 

 +4       ;

CHW       ;

 +1        SET BGPYWCHW=2

           Begin DoDot:1

 +2            SET BGPHWNOW=$$NOW^XLFDT()

               SET BGPHWNOW=$PIECE(BGPHWNOW,".")_"."_$$RZERO^BGP2UTL($PIECE(BGPHWNOW,".",2),6)

 +3            IF BGPUF=""

                   IF '$DATA(ZTQUEUED)

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

                   QUIT 

 +4            SET BGPFN="CRSHW"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_$$D^BGP2UTL(BGPBD)_$$D^BGP2UTL(BGPED)_$$D^BGP2UTL(BGPHWNOW)_"_001_of_001"_".TXT"

 +5            DO ONEF

 +6            QUIT 

           End DoDot:1

           IF BGPONEF=""

               GOTO COMM

SUM       ;display summary of this report

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !,$$CTR("SUMMARY OF NATIONAL GPRA & PART HEIGHT AND WEIGHT")

 +3        WRITE !,$$CTR("LOCAL DATA FILE TO BE GENERATED")

 +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        WRITE !!,"The COMMUNITY Taxonomy to be used is: ",$PIECE(^ATXAX(BGPTAXI,0),U)

 +9        IF $GET(BGPMFITI)

               WRITE !!,"The MFI Location Taxonomy to be used is: ",$PIECE(^ATXAX(BGPMFITI,0),U)

 +10       WRITE !!,"The height and weight data file will be named: ",!,BGPFN

 +11       WRITE !,"and will reside in the ",BGPUF," directory."

 +12       IF BGPONEF="M"

               Begin DoDot:1

 +13               WRITE !,"Since you opted to create multiple files, if additional files are"

 +14               WRITE !,"generated they will all have the same name as the one listed above"

 +15               WRITE !,"with the last 10 characters of the filename being the number of "

 +16               WRITE !,"files (e.g. 001_of_003)."

               End DoDot:1

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

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

 +19      ;D PT^BGP2DSL

           SET BGPROT="P"

           SET BGPDELT=""

 +20       IF BGPROT=""

               GOTO BEN

ZIS       ;call to XBDBQUE

 +1        DO REPORT^BGP2UTL

 +2        IF $GET(BGPQUIT)

               DO XIT

               QUIT 

 +3        IF BGPRPT=""

               DO XIT

               QUIT 

 +4        KILL IOP,%ZIS

           IF BGPROT="D"

               IF BGPDELT="F"

                   DO NODEV

                   DO XIT

                   QUIT 

 +5        KILL IOP,%ZIS

           WRITE !!

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

           DO ^%ZIS

 +6        IF POP

               WRITE !,"Report Aborted"

               SET DA=BGPRPT

               SET DIK="^BGPGPDCW("

               DO ^DIK

               KILL DIK

               DO XIT

               QUIT 

 +7        IF POP

               WRITE !,"Report Aborted"

               SET DA=BGPRPT

               SET DIK="^BGPGPDPW("

               DO ^DIK

               KILL DIK

               DO XIT

               QUIT 

 +8        IF POP

               WRITE !,"Report Aborted"

               SET DA=BGPRPT