Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP9DHW

BGP9DHW.m

Go to the documentation of this file. 
  1. BGP9DHW ; IHS/CMI/LAB - NATL COMP EXPORT 13 Nov 2006 12:31 PM ; 
  1.  ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
  1.  ;
  1.  ;
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR("IHS 2009 National GPRA & PART Height and Weight Local Data File",80),!
  1. INTRO ;
  1.  D XIT
  1.  D TERM^VALM0
  1.  S BGPCTRL=$O(^BGPCTRL("B",2009,0))
  1.  F X=1:1:18 W !,^BGPCTRL(BGPCTRL,73,X,0)
  1.  D EOP
  1.  S X=18 F  S X=$O(^BGPCTRL(BGPCTRL,73,X)) Q:X'=+X  D
  1.  .W !,^BGPCTRL(BGPCTRL,73,X,0)
  1.  W ! K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR
  1.  ;
  1.  D TAXCHK^BGP9XTCN
  1. TP ;get time period
  1.  D XIT
  1.  S BGPRTYPE=1,BGP9RPTH=""
  1.  S X=$O(^BGPCTRL("B",2009,0))
  1.  S Y=^BGPCTRL(X,0)
  1.  S BGPBD=$P(Y,U,8),BGPED=$P(Y,U,9)
  1.  S BGPPBD=$P(Y,U,10),BGPPED=$P(Y,U,11)
  1.  S BGPBBD=$P(Y,U,12),BGPBED=$P(Y,U,13)
  1.  S BGPPER=$P(Y,U,14),BGPQTR=3
  1.  ;BEGIN TEST STUFF
  1.  G NT  ;comment out when testing in TEHR
  1.  W !!,"for testing purposes only, please enter a report year",!
  1.  D F
  1.  I BGPPER="" W !!,"no year entered..bye" D XIT Q
  1.  S BGPQTR=3
  1.  S BGPBD=$E(BGPPER,1,3)_"0101",BGPED=$E(BGPPER,1,3)_"1231"
  1.  S BGPPBD=($E(BGPPER,1,3)-1)_"0101",BGPPED=($E(BGPPER,1,3)-1)_"1231"
  1.  W !!,"for testing purposes only, please enter a BASELINE year",!
  1.  D B
  1.  I BGPBPER="" W !!,"no year entered..bye" D XIT Q
  1.  S BGPBBD=$E(BGPBPER,1,3)_"0101",BGPBED=$E(BGPBPER,1,3)_"1231"
  1. NT ;END TEST STUFF
  1.  W !!,"The date ranges for this report are:"
  1.  W !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
  1.  W !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
  1.  W !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
  1. BEN ;
  1.  S BGPBEN=1 W !!,"The beneficiary population for this report is AI/AN only."
  1. COMM ;
  1.  W !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report.  You should have created this taxonomy using QMAN.",!
  1.  K BGPTAX
  1.  S BGPTAXI=""
  1.  D ^XBFMK
  1.  S DIC("S")="I $P(^(0),U,15)=9999999.05",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Community Taxonomy: "
  1.  S B=$P($G(^BGPSITE(DUZ(2),0)),U,5) I B S DIC("B")=$P(^ATXAX(B,0),U)
  1.  D ^DIC K DIC
  1.  I Y=-1 D XIT Q
  1.  S BGPTAXI=+Y
  1. COM1 ;
  1.  S X=0
  1.  F  S X=$O(^ATXAX(BGPTAXI,21,X)) Q:'X  D
  1.  .S BGPTAX($P(^ATXAX(BGPTAXI,21,X,0),U))=""
  1.  .Q
  1.  I '$D(BGPTAX) W !!,"There are no communities in that taxonomy." G COMM
  1.  S X=0,G=0
  1.  F  S X=$O(^ATXAX(BGPTAXI,21,X)) Q:'X  D
  1.  .S C=$P(^ATXAX(BGPTAXI,21,X,0),U)
  1.  .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
  1.  .Q
  1.  I G D  I BGPQUIT D XIT Q
  1.  .W !!,"These communities may have been renamed or there may be patients"
  1.  .W !,"who have been reassigned from this community to a new community and this"
  1.  .W !,"could reduce your patient population."
  1.  .S BGPQUIT=0
  1.  .S DIR(0)="Y",DIR("A")="Do you want to cancel the report and review the communities" KILL DA D ^DIR KILL DIR
  1.  .I $D(DIRUT) S BGPQUIT=1
  1.  .I Y S BGPQUIT=1
  1.  .Q
  1. MFIC K BGPQUIT
  1.  I $P($G(^BGPSITE(DUZ(2),0)),U,8)=1 D  I BGPMFITI="" G COMM
  1.  .S BGPMFITI=""
  1.  .W !!,"Specify the LOCATION taxonomy to determine which patient visits will be"
  1.  .W !,"used to determine whether a patient is in the denominators for the report."
  1.  .W !,"You should have created this taxonomy using QMAN.",!
  1.  .K BGPMFIT
  1.  .S BGPMFITI=""
  1.  .D ^XBFMK
  1.  .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: "
  1.  .S B=$P($G(^BGPSITE(DUZ(2),0)),U,9) I B S DIC("B")=$P(^ATXAX(B,0),U)
  1.  .D ^DIC
  1.  .I Y=-1 Q
  1.  .S BGPMFITI=+Y
  1. HOME ;
  1.  S BGPHOME=$P($G(^BGPSITE(DUZ(2),0)),U,2)
  1. AI ;gather all gpra measures
  1.  S X=0 F  S X=$O(^BGPINDN("GPRA",1,X)) Q:X'=+X  S BGPIND(X)=""
  1.  S BGPINDT="G"
  1. EXPORT ;export to area or not?
  1.  S BGPYWCHW=2
  1.  S BGPEXPT=1,BGPYWCHW=0
  1. EISSEX ;
  1.  S BGPEXCEL=""
  1.  S BGPUF=$$GETDIR^BGP9UTL2()
  1.  I BGPEXPT,BGPUF="" W:'$D(ZTQUEUED) !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written." D PAUSE^BGP9CL,XIT Q
  1.  ;
  1. CHW ;
  1.  S BGPYWCHW=2 D  I BGPONEF="" G COMM
  1.  .S BGPHWNOW=$$NOW^XLFDT() S BGPHWNOW=$P(BGPHWNOW,".")_"."_$$RZERO^BGP9UTL($P(BGPHWNOW,".",2),6)
  1.  .I BGPUF="" W:'$D(ZTQUEUED) !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written." Q
  1.  .S BGPFN="CRSHW"_$P(^AUTTLOC(DUZ(2),0),U,10)_$$D^BGP9UTL(BGPBD)_$$D^BGP9UTL(BGPED)_$$D^BGP9UTL(BGPHWNOW)_"_001_of_001"_".TXT"
  1.  .D ONEF
  1.  .Q
  1. SUM ;display summary of this report
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR("SUMMARY OF NATIONAL GPRA & PART HEIGHT AND WEIGHT")
  1.  W !,$$CTR("LOCAL DATA FILE TO BE GENERATED")
  1.  W !!,"The date ranges for this report are:"
  1.  W !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
  1.  W !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
  1.  W !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
  1.  W !!,"The COMMUNITY Taxonomy to be used is: ",$P(^ATXAX(BGPTAXI,0),U)
  1.  I $G(BGPMFITI) W !!,"The MFI Location Taxonomy to be used is: ",$P(^ATXAX(BGPMFITI,0),U)
  1.  W !!,"The height and weight data file will be named: ",!,BGPFN
  1.  W !,"and will reside in the ",BGPUF," directory."
  1.  I BGPONEF="M" D
  1.  .W !,"Since you opted to create multiple files, if additional files are"
  1.  .W !,"generated they will all have the same name as the one listed above"
  1.  .W !,"with the last 10 characters of the filename being the number of "
  1.  .W !,"files (e.g. 001_of_003)."
  1.  ;I BGPHOME W !,"The HOME location is: ",$P(^DIC(4,BGPHOME,0),U)," ",$P(^AUTTLOC(BGPHOME,0),U,10)
  1.  ;I 'BGPHOME W !,"No HOME Location selected."
  1.  S BGPROT="P",BGPDELT="" ;D PT^BGP9DSL
  1.  I BGPROT="" G BEN
  1. ZIS ;call to XBDBQUE
  1.  D REPORT^BGP9UTL
  1.  I $G(BGPQUIT) D XIT Q
  1.  I BGPRPT="" D XIT Q
  1.  K IOP,%ZIS I BGPROT="D",BGPDELT="F" D NODEV,XIT Q
  1.  K IOP,%ZIS W !! S %ZIS=$S(BGPDELT'="S":"PQM",1:"PM") D ^%ZIS
  1.  I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDCN(" D ^DIK K DIK D XIT Q
  1.  I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDPN(" D ^DIK K DIK D XIT Q
  1.  I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDBN(" D ^DIK K DIK D XIT Q
  1.  I $D(IO("Q")) G TSKMN
  1. DRIVER ;
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  D ^BGP9D1
  1.  D HWSF
  1.  U IO
  1.  D PRINT^BGP9DHW
  1.  D ^%ZISC
  1.  D KITM
  1.  Q
  1.  ;
  1. ONEF ;
  1.  S BGPONEF=""
  1.  W !!!,"A Height/Weight Export file will be created.  You can choose"
  1.  W !,"to create one file of data or multiple files of data.  If you are"
  1.  W !,"planning to review this data using Microsoft Excel please keep in"
  1.  W !,"mind that Excel can only handle 65,536 records per file.  If you"
  1.  W !,"expect that your site has more than 65,536 records you will need"
  1.  W !,"to create multiple files in order to use this data in Excel.  If"
  1.  W !,"you choose to create one file it will be called:"
  1.  W !?5,BGPFN,!?5,"and will reside in the ",BGPUF," directory."
  1.  W !,"If you have multiple files generated they will all have the"
  1.  W !,"same name with the last 10 characters of the filename being"
  1.  W !,"the number of files (e.g. 001_of_003)."
  1.  ; 
  1.  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
  1.  I $D(DIRUT) Q
  1.  S BGPONEF=Y
  1.  Q
  1. NODEV ;
  1.  S XBRP="",XBRC="NODEV1^BGP9DHW",XBRX="XIT^BGP9DHW",XBNS="BGP"
  1.  D ^XBDBQUE
  1.  Q
  1.  ;
  1. NODEV1 ;
  1.  D ^BGP9D1
  1.  D HWSF
  1.  D PRINT^BGP9DHW
  1.  D ^%ZISC
  1.  D KITM
  1.  D XIT
  1.  Q
  1. TSKMN ;EP ENTRY POINT FROM TASKMAN
  1.  S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST
  1.  I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))
  1.  I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL
  1.  K ZTSAVE S ZTSAVE("BGP*")=""
  1.  S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^BGP9DHW",ZTDTH="",ZTDESC="NATIONAL GPRA LOCAL HW DATA" D ^%ZTLOAD D XIT Q
  1.  Q
  1.  ;
  1. XIT ;
  1.  D ^%ZISC
  1.  D EN^XBVK("BGP") I $D(ZTQUEUED) S ZTREQ="@"
  1.  K DIRUT,DUOUT,DIR,DOD
  1.  K DIADD,DLAYGO
  1.  D KILL^AUPNPAT
  1.  K X,X1,X2,X3,X4,X5,X6
  1.  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
  1.  K N,N1,N2,N3,N4,N5,N6
  1.  K BD,ED
  1.  D KILL^AUPNPAT
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)
  1.  NEW DIR,X
  1.  K DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR(0)="E" D ^DIR KILL DIR
  1.  Q
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1.  ;
  1. CHKY ;
  1.  W !!,"The baseline year and the previous year time periods are the same.",!!
  1.  S DIR(0)="Y",DIR("A")="Do you want to change the baseline year",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) S Y="" Q
  1.  Q
  1. F ;fiscal year
  1.  S (BGPPER,BGPVDT)=""
  1.  W !!,"Enter the year for the report.  Use a 4 digit ",!,"year, e.g. 2009"
  1.  S DIR(0)="D^::EP"
  1.  S DIR("A")="Enter year"
  1.  S DIR("?")="This report is compiled for a period.  Enter a valid date."
  1.  D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1.  I $D(DUOUT) S DIRUT=1 Q
  1.  S BGPVDT=Y
  1.  I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F
  1.  S BGPPER=BGPVDT
  1.  Q
  1. B ;fiscal year
  1.  S (BGPBPER,BGPVDT)=""
  1.  W !!,"Enter the BASELINE year for the report.  Use a 4 digit ",!,"year, e.g. 2000"
  1.  S DIR(0)="D^::EP"
  1.  S DIR("A")="Enter BASELINE year"
  1.  S DIR("?")="This report is compiled for a period.  Enter a valid date."
  1.  D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1.  I $D(DUOUT) S DIRUT=1 Q
  1.  S BGPVDT=Y
  1.  I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F
  1.  S BGPBPER=BGPVDT
  1.  Q
  1. HWSF ;EP
  1.  I '$D(ZTQUEUED) W !!,"Writing out Ht/Wt file...."
  1.  K BGPFILES
  1.  ;count up total # of records and divide by 65,536
  1.  I BGPONEF="O" D HWSF1 Q
  1.  S BGPX=0,BGPTOT=0 F  S BGPX=$O(^BGPGPDCN(BGPRPT,88888,BGPX)) Q:BGPX'=+BGPX  S BGPTOT=BGPTOT+1
  1.  S BGPNF1=BGPTOT/65536
  1.  S BGPNF=$S($P(BGPNF1,".",2)]"":$P(BGPNF1,".")+1,1:BGPNF1)
  1.  S BGPNF=$P(BGPNF,".")
  1.  S BGPX=0,BGPLX=0
  1.  F BGPZ=1:1:BGPNF D
  1.  .S BGPFN="CRSHW"_$P(^AUTTLOC(DUZ(2),0),U,10)_$$D^BGP9UTL(BGPBD)_$$D^BGP9UTL(BGPED)_$$D^BGP9UTL(BGPHWNOW)_"_"_$$LZERO^BGP9UTL(BGPZ,3)_"_of_"_$$LZERO^BGP9UTL(BGPNF,3)_".TXT"
  1.  .S BGPFILES(BGPZ)=BGPFN
  1.  .S Y=$$OPEN^%ZISH(BGPUF,BGPFN,"W")
  1.  .I Y=1 W:'$D(ZTQUEUED) !!,"Cannot open host file." Q
  1.  .U IO
  1.  .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",!
  1.  .S BGPC=1,BGPX=$S(BGPLX:BGPLX,1:0)
  1.  .F  S BGPX=$O(^BGPGPDCN(BGPRPT,88888,BGPX)) Q:BGPX'=+BGPX!(BGPC>65535)  D
  1.  ..W $G(^BGPGPDCN(BGPRPT,88888,BGPX,0)),!
  1.  ..S BGPC=BGPC+1
  1.  ..S BGPLX=BGPX
  1.  .D ^%ZISC
  1.  Q
  1. HWSF1 ;EP
  1.  ;write out one file only
  1.  S BGPZ=1,BGPFN="CRSHW"_$P(^AUTTLOC(DUZ(2),0),U,10)_$$D^BGP9UTL(BGPBD)_$$D^BGP9UTL(BGPED)_$$D^BGP9UTL(BGPHWNOW)_"_001_of_001.TXT"
  1.  S BGPFILES(1)=BGPFN
  1.  I '$D(ZTQUEUED) U IO W !?10,BGPFN
  1.  S Y=$$OPEN^%ZISH(BGPUF,BGPFN,"W")
  1.  I Y=1 W:'$D(ZTQUEUED) !!,"Cannot open host file." Q
  1.  U IO
  1.  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",!
  1.  S BGPC=1,BGPX=0
  1.  F  S BGPX=$O(^BGPGPDCN(BGPRPT,88888,BGPX)) Q:BGPX'=+BGPX  D
  1.  .W $G(^BGPGPDCN(BGPRPT,88888,BGPX,0)),!
  1.  .S BGPC=BGPC+1
  1.  D ^%ZISC
  1.  Q
  1. KITM ;EP - kill tmp globals
  1.  K ^TMP($J)
  1.  K ^XTMP("BGP9D",BGPJ,BGPH)
  1.  K ^XTMP("BGP9DNP",BGPJ,BGPH)
  1.  K ^XTMP("BGP08CPL",BGPJ,BGPH)
  1.  Q
  1. PRINT ;EP
  1.  S BGPQUIT=0,BGPGPG=0
  1.  S BGPIOSL=$S($G(BGPGUI):55,1:$G(IOSL))
  1.  D HEADER
  1.  W !
  1.  W !?10,"Community Taxonomy Name: ",$P(^ATXAX(BGPTAXI,0),U)
  1.  W !?10,"The following communities are included in this report:",! D
  1.  .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
  1.  .S BGPZZ=0,C=0 F BGPZZ=1:3:BGPN D  Q:BGPQUIT
  1.  ..I $Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
  1.  ..W !?10,$E($P(BGPY,";",BGPZZ),1,20),?30,$E($P(BGPY,";",(BGPZZ+1)),1,20),?60,$E($P(BGPY,";",(BGPZZ+2)),1,20)
  1.  ..Q
  1.  Q:BGPQUIT
  1.  I $G(BGPMFITI) W !!?10,"MFI Visit Location Taxonomy Name: ",$P(^ATXAX(BGPMFITI,0),U)
  1.  I $G(BGPMFITI) W !?10,"The following Locations are used for patient visits in this report:",! D
  1.  .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)
  1.  .S BGPZZ=0,C=0 F BGPZZ=1:3:BGPN D  Q:BGPQUIT
  1.  ..I $Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
  1.  ..W !?10,$E($P(BGPY,";",BGPZZ),1,20),?30,$E($P(BGPY,";",(BGPZZ+1)),1,20),?60,$E($P(BGPY,";",(BGPZZ+2)),1,20)
  1.  ..Q
  1.  I $Y>(IOSL-3) D HEADER Q:BGPQUIT
  1.  W !!,"Delimited Height and Weight File(s): "
  1.  S BGPX=0 F  S BGPX=$O(BGPFILES(BGPX)) Q:BGPX'=+BGPX  D
  1.  .I $Y>(IOSL-2) D HEADER Q:BGPQUIT
  1.  .W !?5,BGPFILES(BGPX)
  1.  I $Y>(IOSL-2) D HEADER Q:BGPQUIT
  1.  W !!,"Directory Name: ",BGPUF
  1.  K BGPX,BGPQUIT
  1.  Q
  1.  G:'BGPGPG HEADER1
  1.  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
  1. HEADER1 ;
  1.  W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
  1.  I $G(BGPGUI) W "ZZZZZZZ",!  ;maw
  1.  W $P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
  1.  W $$CTR("*** IHS 2009 National GPRA & PART Height and Weight Local Data File ***",80),!
  1.  W !!,$$CTR($$RPTVER^BGP9BAN,80)
  1.  W !,$$CTR("Date File Run: "_$$FMTE^XLFDT(DT),80)
  1.  W !,$$CTR("Site where Run: "_$P(^DIC(4,DUZ(2),0),U),80)
  1.  W !,$$CTR("File Generated by: "_$$USR,80)
  1.  S X="Report Period:  "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W !,$$CTR(X,80)
  1.  W !,$TR($J("",80)," ","-"),!
  1.  Q