BGP0DAR ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM 09 Apr 2010 10:03 AM ;
;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
;
;
W:$D(IOF) @IOF
S BGPA=$E($P(^AUTTLOC(DUZ(2),0),U,10),1,2),BGPA=$O(^AUTTAREA("C",BGPA,0)) S BGPA=$S(BGPA:$P(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")
W !!,$$CTR(BGPA_" Area Aggregate National GPRA & PART Report",80)
INTRO ;
D EXIT
TP ;
S BGPAREAA=1
S BGPRTYPE=1,BGPBEN=1,BGP0RPTH=""
S X=$O(^BGPCTRL("B",2010,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
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 EXIT 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 EXIT 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)
ASU ;
S BGPSUCNT=0
S BGPRPTT=""
S DIR(0)="S^A:AREA Aggregate;F:One Facility",DIR("A")="Run Report for",DIR("B")="A" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) EXIT
S BGPRPTT=Y
W !!!,"You will now be able to select which sites to use in the",!,"area aggregate/facility report.",!
S DIR(0)="E",DIR("A")="Press Enter to Continue" KILL DA D ^DIR KILL DIR
K BGPSUL
D EN^BGP0ASL
I '$D(BGPSUL) W !!,"No sites selected" D EXIT Q
S X=0,C=0 F S X=$O(BGPSUL(X)) Q:X'=+X S C=C+1
W !!,"A total of ",C," facilities have been selected.",!!
;I C=1 S BGPRPTT="F",BGPSUCNT=1,Y=$O(BGPSUL(0)),X=$P(^BGPGPDCT(Y,0),U,9),X=$O(^AUTTLOC("C",X,0)) I X S BGPSUNM=$P(^DIC(4,X,0),U)
ZIS ;call to XBDBQUE
EISSEX ;
S BGPEXCEL=$S($G(BGPSUMON):0,1:1)
S BGPUF=$$GETDIR^BGP0UTL2()
;I ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["NT")!($P($G(^AUTTSITE(1,0)),U,21)=2) S BGPUF=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:"C:\EXPORT")
;I $P(^AUTTSITE(1,0),U,21)=1 S BGPUF="/usr/spool/uucppublic/"
I BGPEXCEL=1 D
.S BGPNOW=$$NOW^XLFDT() S BGPNOW=$$NOW^XLFDT() S BGPNOW=$P(BGPNOW,".")_"."_$$RZERO^BGP0UTL($P(BGPNOW,".",2),6)
.S BGPC=0,X=0 F S X=$O(BGPSUL(X)) Q:X'=+X S BGPC=BGPC+1
.I BGPUF="" W:'$D(ZTQUEUED) !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written." Q
.S BGPFGNT1="CRSGPRANT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
.S BGPFGNT2="CRSGPRANT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
.S BGPFDEV1="CRSGPRADEVNT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
.S BGPFDEV2="CRSGPRADEVNT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
.;S BGPFGNT3="CRSGPRANT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
.;S BGPFGNT4="CRSGPRANT4"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
.Q
S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
I BGPEXCEL D
.W !!,"A file will be created called ",BGPFGNT1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFGNT2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFDEV1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFDEV2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
. S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
D ^XBFMK
K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
GI ;gather all gpra measures
S X=0 F S X=$O(^BGPINDT("GPRA",1,X)) Q:X'=+X S BGPIND(X)=""
S BGPINDT="G"
D PT^BGP0DSL
I BGPROT="" G ASU
;
K IOP,%ZIS I BGPROT="D",BGPDELT="F" D NODEV,EXIT Q
K IOP,%ZIS W !! S %ZIS=$S(BGPDELT'="S":"PQM",1:"PM") D ^%ZIS
I POP D EXIT Q
I $D(IO("Q")) G TSKMN
DRIVER ;
U IO
D PRINT^BGP0PARP
I BGPRPTT="A",BGPIFTR=1,BGPEXCEL D GNT1^BGP0UTL
D ^%ZISC
D EXIT
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^BGP0DAR",ZTDTH="",ZTDESC="GPRA REPORT" D ^%ZTLOAD D HOME^%ZIS D EXIT Q
Q
;
EXIT ;
D ^%ZISC
D EN^XBVK("BGP") I $D(ZTQUEUED) S ZTREQ="@"
D KILL^AUPNPAT
D ^XBFMK
Q
NODEV ;
S XBRP="",XBRC="NODEV1^BGP0DAR",XBRX="EXIT^BGP0DAR",XBNS="BGP"
D ^XBDBQUE
Q
;
NODEV1 ;
D PRINT^BGP0PARP
I BGPRPTT="A",BGPIFTR,BGPEXCEL D GNT1^BGP0UTL
D ^%ZISC
D EXIT
Q
;
B ;fiscal year
S (BGPBPER,BGPVDT)=""
W !!,"Enter the BASELINE year for the report. Use a 4 digit ",!,"year, e.g. 2010"
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
F ;fiscal year
S BGPPER=""
W !
S BGPVDT=""
W !,"Enter the Fiscal Year (FY) for the report END date. Use a 4 digit",!,"year, e.g. 2009, 2010"
S DIR(0)="D^::EP"
S DIR("A")="Enter FY"
S DIR("?")="This report is compiled for a period. Enter a valid date."
D ^DIR
K DIC
I $D(DUOUT) S DIRUT=1 S BGPQUIT="" Q
S BGPVDT=Y
I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F
S BGPPER=BGPVDT,BGPBD=($E(BGPVDT,1,3)-1)_"1001",BGPED=$E(BGPVDT,1,3)_"0930"
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 DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR(0)="E" D ^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")
;----------
;
SUMONLY ;EP
W:$D(IOF) @IOF
S BGPA=$E($P(^AUTTLOC(DUZ(2),0),U,10),1,2),BGPA=$O(^AUTTAREA("C",BGPA,0)) S BGPA=$S(BGPA:$P(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")
W !,$$CTR("IHS 2010 Area National GPRA & PART Report Clinical Performance Summaries")
W !!,"This will produce ONLY the clinical performance summaries for the Area "
W !,"National GPRA & PART Report for the 2010 GPRA year. If you want the detailed "
W !,"information included in the report, including performance measure "
W !,"definitions and number of patients in each denominator and numerator"
W !,"you need to run the AGP menu option."
W !!,"The CRSGPRANT export files will not be created; use the AGP menu option "
W !,"to run the report that will create these files."
W !
K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" D ^DIR K DIR
S BGPSUMON=1
G TP
BGP0DAR ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM 09 Apr 2010 10:03 AM ;
+1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 SET BGPA=$EXTRACT($PIECE(^AUTTLOC(DUZ(2),0),U,10),1,2)
SET BGPA=$ORDER(^AUTTAREA("C",BGPA,0))
SET BGPA=$SELECT(BGPA:$PIECE(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")
+6 WRITE !!,$$CTR(BGPA_" Area Aggregate National GPRA & PART Report",80)
INTRO ;
+1 DO EXIT
TP ;
+1 SET BGPAREAA=1
+2 SET BGPRTYPE=1
SET BGPBEN=1
SET BGP0RPTH=""
+3 SET X=$ORDER(^BGPCTRL("B",2010,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 ;comment out when testing in TEHR
GOTO NT
+10 WRITE !!,"for testing purposes only, please enter a report year",!
+11 DO F
+12 IF BGPPER=""
WRITE !!,"no year entered..bye"
DO EXIT
QUIT
+13 SET BGPQTR=3
+14 SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"
SET BGPED=$EXTRACT(BGPPER,1,3)_"1231"
+15 SET BGPPBD=($EXTRACT(BGPPER,1,3)-1)_"0101"
SET BGPPED=($EXTRACT(BGPPER,1,3)-1)_"1231"
+16 WRITE !!,"for testing purposes only, please enter a BASELINE year",!
+17 DO B
+18 IF BGPBPER=""
WRITE !!,"no year entered..bye"
DO EXIT
QUIT
+19 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)
ASU ;
+1 SET BGPSUCNT=0
+2 SET BGPRPTT=""
+3 SET DIR(0)="S^A:AREA Aggregate;F:One Facility"
SET DIR("A")="Run Report for"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO EXIT
+5 SET BGPRPTT=Y
+6 WRITE !!!,"You will now be able to select which sites to use in the",!,"area aggregate/facility report.",!
+7 SET DIR(0)="E"
SET DIR("A")="Press Enter to Continue"
KILL DA
DO ^DIR
KILL DIR
+8 KILL BGPSUL
+9 DO EN^BGP0ASL
+10 IF '$DATA(BGPSUL)
WRITE !!,"No sites selected"
DO EXIT
QUIT
+11 SET X=0
SET C=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
SET C=C+1
+12 WRITE !!,"A total of ",C," facilities have been selected.",!!
+13 ;I C=1 S BGPRPTT="F",BGPSUCNT=1,Y=$O(BGPSUL(0)),X=$P(^BGPGPDCT(Y,0),U,9),X=$O(^AUTTLOC("C",X,0)) I X S BGPSUNM=$P(^DIC(4,X,0),U)
ZIS ;call to XBDBQUE
EISSEX ;
+1 SET BGPEXCEL=$SELECT($GET(BGPSUMON):0,1:1)
+2 SET BGPUF=$$GETDIR^BGP0UTL2()
+3 ;I ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["NT")!($P($G(^AUTTSITE(1,0)),U,21)=2) S BGPUF=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:"C:\EXPORT")
+4 ;I $P(^AUTTSITE(1,0),U,21)=1 S BGPUF="/usr/spool/uucppublic/"
+5 IF BGPEXCEL=1
Begin DoDot:1
+6 SET BGPNOW=$$NOW^XLFDT()
SET BGPNOW=$$NOW^XLFDT()
SET BGPNOW=$PIECE(BGPNOW,".")_"."_$$RZERO^BGP0UTL($PIECE(BGPNOW,".",2),6)
+7 SET BGPC=0
SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
SET BGPC=BGPC+1
+8 IF BGPUF=""
IF '$DATA(ZTQUEUED)
WRITE !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written."
QUIT
+9 SET BGPFGNT1="CRSGPRANT1"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
+10 SET BGPFGNT2="CRSGPRANT2"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
+11 SET BGPFDEV1="CRSGPRADEVNT1"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
+12 SET BGPFDEV2="CRSGPRADEVNT2"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
+13 ;S BGPFGNT3="CRSGPRANT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
+14 ;S BGPFGNT4="CRSGPRANT4"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
+15 QUIT
End DoDot:1
+16 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
+17 IF BGPEXCEL
Begin DoDot:1
+18 WRITE !!,"A file will be created called ",BGPFGNT1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+19 WRITE !!,"A file will be created called ",BGPFGNT2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+20 WRITE !!,"A file will be created called ",BGPFDEV1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+21 WRITE !!,"A file will be created called ",BGPFDEV2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+22 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
End DoDot:1
+23 DO ^XBFMK
+24 KILL DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
GI ;gather all gpra measures
+1 SET X=0
FOR
SET X=$ORDER(^BGPINDT("GPRA",1,X))
IF X'=+X
QUIT
SET BGPIND(X)=""
+2 SET BGPINDT="G"
+3 DO PT^BGP0DSL
+4 IF BGPROT=""
GOTO ASU
+5 ;
+6 KILL IOP,%ZIS
IF BGPROT="D"
IF BGPDELT="F"
DO NODEV
DO EXIT
QUIT
+7 KILL IOP,%ZIS
WRITE !!
SET %ZIS=$SELECT(BGPDELT'="S":"PQM",1:"PM")
DO ^%ZIS
+8 IF POP
DO EXIT
QUIT
+9 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 USE IO
+2 DO PRINT^BGP0PARP
+3 IF BGPRPTT="A"
IF BGPIFTR=1
IF BGPEXCEL
DO GNT1^BGP0UTL
+4 DO ^%ZISC
+5 DO EXIT
+6 QUIT
+7 ;
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^BGP0DAR"
SET ZTDTH=""
SET ZTDESC="GPRA REPORT"
DO ^%ZTLOAD
DO HOME^%ZIS
DO EXIT
QUIT
+6 QUIT
+7 ;
EXIT ;
+1 DO ^%ZISC
+2 DO EN^XBVK("BGP")
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 DO KILL^AUPNPAT
+4 DO ^XBFMK
+5 QUIT
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^BGP0DAR"
SET XBRX="EXIT^BGP0DAR"
SET XBNS="BGP"
+2 DO ^XBDBQUE
+3 QUIT
+4 ;
NODEV1 ;
+1 DO PRINT^BGP0PARP
+2 IF BGPRPTT="A"
IF BGPIFTR
IF BGPEXCEL
DO GNT1^BGP0UTL
+3 DO ^%ZISC
+4 DO EXIT
+5 QUIT
+6 ;
B ;fiscal year
+1 SET (BGPBPER,BGPVDT)=""
+2 WRITE !!,"Enter the BASELINE year for the report. Use a 4 digit ",!,"year, e.g. 2010"
+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
F ;fiscal year
+1 SET BGPPER=""
+2 WRITE !
+3 SET BGPVDT=""
+4 WRITE !,"Enter the Fiscal Year (FY) for the report END date. Use a 4 digit",!,"year, e.g. 2009, 2010"
+5 SET DIR(0)="D^::EP"
+6 SET DIR("A")="Enter FY"
+7 SET DIR("?")="This report is compiled for a period. Enter a valid date."
+8 DO ^DIR
+9 KILL DIC
+10 IF $DATA(DUOUT)
SET DIRUT=1
SET BGPQUIT=""
QUIT
+11 SET BGPVDT=Y
+12 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO F
+13 SET BGPPER=BGPVDT
SET BGPBD=($EXTRACT(BGPVDT,1,3)-1)_"1001"
SET BGPED=$EXTRACT(BGPVDT,1,3)_"0930"
+14 QUIT
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)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^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 ;
SUMONLY ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 SET BGPA=$EXTRACT($PIECE(^AUTTLOC(DUZ(2),0),U,10),1,2)
SET BGPA=$ORDER(^AUTTAREA("C",BGPA,0))
SET BGPA=$SELECT(BGPA:$PIECE(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")
+3 WRITE !,$$CTR("IHS 2010 Area National GPRA & PART Report Clinical Performance Summaries")
+4 WRITE !!,"This will produce ONLY the clinical performance summaries for the Area "
+5 WRITE !,"National GPRA & PART Report for the 2010 GPRA year. If you want the detailed "
+6 WRITE !,"information included in the report, including performance measure "
+7 WRITE !,"definitions and number of patients in each denominator and numerator"
+8 WRITE !,"you need to run the AGP menu option."
+9 WRITE !!,"The CRSGPRANT export files will not be created; use the AGP menu option "
+10 WRITE !,"to run the report that will create these files."
+11 WRITE !
+12 KILL DIR
SET DIR(0)="E"
SET DIR("A")="PRESS ENTER"
DO ^DIR
KILL DIR
+13 SET BGPSUMON=1
+14 GOTO TP
