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
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
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
SET DIK="^BGPGPDBW("
DO ^DIK
KILL DIK
DO XIT
QUIT
+9 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 DO ^BGP2D1
+3 DO HWSF
+4 USE IO
+5 DO PRINT^BGP2DHW
+6 DO ^%ZISC
+7 DO KITM
+8 QUIT
+9 ;
ONEF ;
+1 SET BGPONEF=""
+2 WRITE !!!,"A Height/Weight Export file will be created. You can choose"
+3 WRITE !,"to create one file of data or multiple files of data. If you are"
+4 WRITE !,"planning to review this data using Microsoft Excel please keep in"
+5 WRITE !,"mind that Excel can only handle 65,536 records per file. If you"
+6 WRITE !,"expect that your site has more than 65,536 records you will need"
+7 WRITE !,"to create multiple files in order to use this data in Excel. If"
+8 WRITE !,"you choose to create one file it will be called:"
+9 WRITE !?5,BGPFN,!?5,"and will reside in the ",BGPUF," directory."
+10 WRITE !,"If you have multiple files generated they will all have the"
+11 WRITE !,"same name with the last 10 characters of the filename being"
+12 WRITE !,"the number of files (e.g. 001_of_003)."
+13 ;
+14 SET DIR(0)="S^O:ONE File of data;M:MULTIPLE Files of data"
SET DIR("A")="Do you want to create one file or multiple files"
SET DIR("B")="M"
KILL DA
DO ^DIR
KILL DIR
+15 IF $DATA(DIRUT)
QUIT
+16 SET BGPONEF=Y
+17 QUIT
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^BGP2DHW"
SET XBRX="XIT^BGP2DHW"
SET XBNS="BGP"
+2 DO ^XBDBQUE
+3 QUIT
+4 ;
NODEV1 ;
+1 DO ^BGP2D1
+2 DO HWSF
+3 DO PRINT^BGP2DHW
+4 DO ^%ZISC
+5 DO KITM
+6 DO XIT
+7 QUIT
TSKMN ;EP ENTRY POINT FROM TASKMAN
+1 SET ZTIO=$SELECT($DATA(ION):ION,1:IO)
IF $DATA(IOST)#2
IF IOST]""
SET ZTIO=ZTIO_";"_IOST
+2 IF $GET(IO("DOC"))]""
SET ZTIO=ZTIO_";"_$GET(IO("DOC"))
+3 IF $DATA(IOM)#2
IF IOM
SET ZTIO=ZTIO_";"_IOM
IF $DATA(IOSL)#2
IF IOSL
SET ZTIO=ZTIO_";"_IOSL
+4 KILL ZTSAVE
SET ZTSAVE("BGP*")=""
+5 SET ZTCPU=$GET(IOCPU)
SET ZTRTN="DRIVER^BGP2DHW"
SET ZTDTH=""
SET ZTDESC="NATIONAL GPRA LOCAL HW DATA"
DO ^%ZTLOAD
DO XIT
QUIT
+6 QUIT
+7 ;
XIT ;
+1 DO ^%ZISC
+2 DO EN^XBVK("BGP")
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 KILL DIRUT,DUOUT,DIR,DOD
+4 KILL DIADD,DLAYGO
+5 DO KILL^AUPNPAT
+6 KILL X,X1,X2,X3,X4,X5,X6
+7 KILL 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
+8 KILL N,N1,N2,N3,N4,N5,N6
+9 KILL BD,ED
+10 DO KILL^AUPNPAT
+11 DO ^XBFMK
+12 QUIT
+13 ;
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)
QUIT
+3 NEW DIR,X
+4 KILL DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
KILL DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
+3 ;
CHKY ;
+1 WRITE !!,"The baseline year and the previous year time periods are the same.",!!
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to change the baseline year"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET Y=""
QUIT
+4 QUIT
F ;fiscal year
+1 SET (BGPPER,BGPVDT)=""
+2 WRITE !!,"Enter the year for the report. Use a 4 digit ",!,"year, e.g. 2012"
+3 SET DIR(0)="D^::EP"
+4 SET DIR("A")="Enter year"
+5 SET DIR("?")="This report is compiled for a period. Enter a valid date."
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
QUIT
+8 IF $DATA(DUOUT)
SET DIRUT=1
QUIT
+9 SET BGPVDT=Y
+10 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO F
+11 SET BGPPER=BGPVDT
+12 QUIT
B ;fiscal year
+1 SET (BGPBPER,BGPVDT)=""
+2 WRITE !!,"Enter the BASELINE year for the report. Use a 4 digit ",!,"year, e.g. 2000"
+3 SET DIR(0)="D^::EP"
+4 SET DIR("A")="Enter BASELINE year"
+5 SET DIR("?")="This report is compiled for a period. Enter a valid date."
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
QUIT
+8 IF $DATA(DUOUT)
SET DIRUT=1
QUIT
+9 SET BGPVDT=Y
+10 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO F
+11 SET BGPBPER=BGPVDT
+12 QUIT
HWSF ;EP
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Writing out Ht/Wt file...."
+2 KILL BGPFILES
+3 ;count up total # of records and divide by 65,536
+4 IF BGPONEF="O"
DO HWSF1
QUIT
+5 SET BGPX=0
SET BGPTOT=0
FOR
SET BGPX=$ORDER(^BGPGPDCW(BGPRPT,88888,BGPX))
IF BGPX'=+BGPX
QUIT
SET BGPTOT=BGPTOT+1
+6 SET BGPNF1=BGPTOT/65536
+7 SET BGPNF=$SELECT($PIECE(BGPNF1,".",2)]"":$PIECE(BGPNF1,".")+1,1:BGPNF1)
+8 SET BGPNF=$PIECE(BGPNF,".")
+9 SET BGPX=0
SET BGPLX=0
+10 FOR BGPZ=1:1:BGPNF
Begin DoDot:1
+11 SET BGPFN="CRSHW"_$PIECE(^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"
+12 SET BGPFILES(BGPZ)=BGPFN
+13 SET Y=$$OPEN^%ZISH(BGPUF,BGPFN,"W")
+14 IF Y=1
IF '$DATA(ZTQUEUED)
WRITE !!,"Cannot open host file."
QUIT
+15 USE IO
+16 WRITE "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",!
+17 SET BGPC=1
SET BGPX=$SELECT(BGPLX:BGPLX,1:0)
+18 FOR
SET BGPX=$ORDER(^BGPGPDCW(BGPRPT,88888,BGPX))
IF BGPX'=+BGPX!(BGPC>65535)
QUIT
Begin DoDot:2
+19 WRITE $GET(^BGPGPDCW(BGPRPT,88888,BGPX,0)),!
+20 SET BGPC=BGPC+1
+21 SET BGPLX=BGPX
End DoDot:2
+22 DO ^%ZISC
End DoDot:1
+23 QUIT
HWSF1 ;EP
+1 ;write out one file only
+2 SET BGPZ=1
SET BGPFN="CRSHW"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_$$D^BGP2UTL(BGPBD)_$$D^BGP2UTL(BGPED)_$$D^BGP2UTL(BGPHWNOW)_"_001_of_001.TXT"
+3 SET BGPFILES(1)=BGPFN
+4 IF '$DATA(ZTQUEUED)
USE IO
WRITE !?10,BGPFN
+5 SET Y=$$OPEN^%ZISH(BGPUF,BGPFN,"W")
+6 IF Y=1
IF '$DATA(ZTQUEUED)
WRITE !!,"Cannot open host file."
QUIT
+7 USE IO
+8 WRITE "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",!
+9 SET BGPC=1
SET BGPX=0
+10 FOR
SET BGPX=$ORDER(^BGPGPDCW(BGPRPT,88888,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:1
+11 WRITE $GET(^BGPGPDCW(BGPRPT,88888,BGPX,0)),!
+12 SET BGPC=BGPC+1
End DoDot:1
+13 DO ^%ZISC
+14 QUIT
KITM ;EP - kill tmp globals
+1 KILL ^TMP($JOB)
+2 KILL ^XTMP("BGP2D",BGPJ,BGPH)
+3 KILL ^XTMP("BGP2DNP",BGPJ,BGPH)
+4 KILL ^XTMP("BGP28CPL",BGPJ,BGPH)
+5 QUIT
PRINT ;EP
+1 SET BGPQUIT=0
SET BGPGPG=0
+2 SET BGPIOSL=$SELECT($GET(BGPGUI):55,1:$GET(IOSL))
+3 DO HEADER
+4 WRITE !
+5 WRITE !?10,"Community Taxonomy Name: ",$PIECE(^ATXAX(BGPTAXI,0),U)
+6 WRITE !?10,"The following communities are included in this report:",!
Begin DoDot:1
+7 SET BGPZZ=""
SET BGPN=0
SET BGPY=""
FOR
SET BGPZZ=$ORDER(BGPTAX(BGPZZ))
IF BGPZZ=""!(BGPQUIT)
QUIT
SET BGPN=BGPN+1
SET BGPY=BGPY_$SELECT(BGPN=1:"",1:";")_BGPZZ
+8 SET BGPZZ=0
SET C=0
FOR BGPZZ=1:3:BGPN
Begin DoDot:2
+9 IF $Y>(BGPIOSL-2)
DO HEADER
IF BGPQUIT
QUIT
+10 WRITE !?10,$EXTRACT($PIECE(BGPY,";",BGPZZ),1,20),?30,$EXTRACT($PIECE(BGPY,";",(BGPZZ+1)),1,20),?60,$EXTRACT($PIECE(BGPY,";",(BGPZZ+2)),1,20)
+11 QUIT
End DoDot:2
IF BGPQUIT
QUIT
End DoDot:1
+12 IF BGPQUIT
QUIT
+13 IF $GET(BGPMFITI)
WRITE !!?10,"MFI Visit Location Taxonomy Name: ",$PIECE(^ATXAX(BGPMFITI,0),U)
+14 IF $GET(BGPMFITI)
WRITE !?10,"The following Locations are used for patient visits in this report:",!
Begin DoDot:1
+15 SET BGPZZ=""
SET BGPN=0
SET BGPY=""
FOR
SET BGPZZ=$ORDER(^ATXAX(BGPMFITI,21,"B",BGPZZ))
IF BGPZZ=""
QUIT
SET BGPN=BGPN+1
SET BGPY=BGPY_$SELECT(BGPN=1:"",1:";")_$PIECE($GET(^DIC(4,BGPZZ,0)),U)
+16 SET BGPZZ=0
SET C=0
FOR BGPZZ=1:3:BGPN
Begin DoDot:2
+17 IF $Y>(BGPIOSL-2)
DO HEADER
IF BGPQUIT
QUIT
+18 WRITE !?10,$EXTRACT($PIECE(BGPY,";",BGPZZ),1,20),?30,$EXTRACT($PIECE(BGPY,";",(BGPZZ+1)),1,20),?60,$EXTRACT($PIECE(BGPY,";",(BGPZZ+2)),1,20)
+19 QUIT
End DoDot:2
IF BGPQUIT
QUIT
End DoDot:1
+20 IF $Y>(IOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+21 WRITE !!,"Delimited Height and Weight File(s): "
+22 SET BGPX=0
FOR
SET BGPX=$ORDER(BGPFILES(BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:1
+23 IF $Y>(IOSL-2)
DO HEADER
IF BGPQUIT
QUIT
+24 WRITE !?5,BGPFILES(BGPX)
End DoDot:1
+25 IF $Y>(IOSL-2)
DO HEADER
IF BGPQUIT
QUIT
+26 WRITE !!,"Directory Name: ",BGPUF
+27 KILL BGPX,BGPQUIT
+28 QUIT
+1 IF 'BGPGPG
GOTO HEADER1
+2 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BGPQUIT=1
QUIT
+1 IF BGPGPG
IF $DATA(IOF)
WRITE @IOF
+2 ;maw
IF $GET(BGPGUI)
IF BGPGPG
WRITE "ZZZZZZZ",!
+3 SET BGPGPG=BGPGPG+1
+4 WRITE $PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
+5 WRITE $$CTR("*** IHS 2012 National GPRA & PART Height and Weight Local Data File ***",80),!
+6 WRITE !!,$$CTR($$RPTVER^BGP2BAN,80)
+7 WRITE !,$$CTR("Date File Run: "_$$FMTE^XLFDT(DT),80)
+8 WRITE !,$$CTR("Site where Run: "_$PIECE(^DIC(4,DUZ(2),0),U),80)
+9 WRITE !,$$CTR("File Generated by: "_$$USR,80)
+10 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
WRITE !,$$CTR(X,80)
+11 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+12 QUIT
