BGP3DARO ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM 01 Jul 2010 11:43 AM ;
;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
;
;
W:$D(IOF) @IOF
D EXIT
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 Other National Measures Report",80)
CHOICE ;
W !!!,"Please select the type of report would you like to run:"
W !!?8,"H Hard-coded Report: Report with all parameters set to the"
W !?11,"same as the National GPRA Report (report period of "
W !?11,"July 1, 2012 - June 30, 2013, baseline period of July 1, 1999"
W !?11,"- June 30, 2000, and AI/AN patients only)"
W !!?8,"U User-defined Report: You select the report and baseline"
W !?11,"periods and beneficiary population"
W !
S DIR(0)="F^1:1",DIR("A")="Select a Report Option"
S DIR("B")="H",DIR("?")="Enter an H for Hard-coded or a U for User-defined"
D ^DIR
I $D(DIRUT) D EXIT Q
KILL DIR
S Y=$$UP^XLFSTR(Y)
I Y'="H",Y'="U" W !!,"Please enter an H for Hard-coded or a U for User-defined." G CHOICE
S BGPRTC=Y
INTRO ;
I BGPRTC="U" D
.W !!,"This will produce an Other National Measures Report for a year period"
.W !,"you specify. You will be asked to provide: 1) the reporting period,"
.W !,"2) the baseline period to compare data to, and 3) the beneficiary/"
.W !,"classification of the patients."
.W !
;
S BGPAREAA=1
S (BGPBD,BGPED,BGPTP)=""
S BGPRTYPE=7,BGPYRPTH=""
H I BGPRTC="H" D G ASU
.S X=$O(^BGPCTRL("B",2013,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 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)
.S BGPBEN=1,BGPBENF(0)="Indian/Alaskan Native (Classification 01)" W !!,"Beneficiary Population is set to American Indian/Alaskan Native Only."
TP ;
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) D EXIT Q
S BGPQTR=Y
I BGPQTR=5 D ENDDATE
I BGPQTR'=5 D F
I BGPPER="" W !,"Year not entered.",! G TP
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 S BGPBD=$$FMADD^XLFDT(BGPPER,-364),BGPED=BGPPER,BGPPER=$E(BGPED,1,3)_"0000"
I BGPED>DT D G:BGPDO=1 TP
.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. 1999, 2000"
S DIR(0)="D^::EP"
S DIR("A")="Enter Year (e.g. 2000)"
D ^DIR KILL DIR
I $D(DIRUT) G TP
I $D(DUOUT) S DIRUT=1 G TP
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
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 BY
S BGPBEN=Y,BGPBENF=Y(0)
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^BGP3ASL
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.",!!
ZIS ;call to XBDBQUE
EISSEX ;
S BGPEXCEL=1
S BGPUF=$$GETDIR^BGP3UTL2()
;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/"
S BGPEXCEL=1 D
.S BGPNOW=$$NOW^XLFDT() S BGPNOW=$P(BGPNOW,".")_"."_$$RZERO^BGP3UTL($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 BGPFONN1="CRSONMNT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_2013063000000000_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
.S BGPFONN2="CRSONMNT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_2013063000000000_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
.S BGPFONN3="CRSONMNT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_2013063000000000_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
.S BGPFONN4="CRSONMNT4"_$P(^AUTTLOC(DUZ(2),0),U,10)_2013063000000000_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
.S BGPFONN5="CRSONMNT5"_$P(^AUTTLOC(DUZ(2),0),U,10)_2013063000000000_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
.Q
S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
I BGPEXCEL D
.W !!,"A file will be created called ",BGPFONN1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFONN2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFONN3,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFONN4,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFONN5,!,"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(^BGPINDH("ON",1,X)) Q:X'=+X S BGPIND(X)=""
S BGPINDH="G"
D PT^BGP3DSL
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^BGP3PARQ
I BGPRPTT="A" D ONN1^BGP3UTL
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^BGP3DARO",ZTDTH="",ZTDESC="GPRA REPORT" D ^%ZTLOAD D HOME^%ZIS D EXIT Q
Q
;
NODEV ;
S XBRP="",XBRC="NODEV1^BGP3DARO",XBRX="EXIT^BGP3DARO",XBNS="BGP"
D ^XBDBQUE
Q
;
NODEV1 ;
D PRINT^BGP3PARQ
I BGPRPTT="A" D ONN1^BGP3UTL
D ^%ZISC
D EXIT
Q
EXIT ;
D ^%ZISC
D EN^XBVK("BGP") I $D(ZTQUEUED) S ZTREQ="@"
D KILL^AUPNPAT
D ^XBFMK
Q
;
B ;fiscal year
S (BGPBPER,BGPVDT)=""
W !!,"Enter the BASELINE year for the report. Use a 4 digit ",!,"year, e.g. 2005"
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. 2002, 2005"
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")
;----------
;
ENDDATE ;
W !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2013)"
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/2010 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
;
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
BGP3DARO ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM 01 Jul 2010 11:43 AM ;
+1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 DO EXIT
+6 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")
+7 WRITE !!,$$CTR(BGPA_" Area Aggregate Other National Measures Report",80)
CHOICE ;
+1 WRITE !!!,"Please select the type of report would you like to run:"
+2 WRITE !!?8,"H Hard-coded Report: Report with all parameters set to the"
+3 WRITE !?11,"same as the National GPRA Report (report period of "
+4 WRITE !?11,"July 1, 2012 - June 30, 2013, baseline period of July 1, 1999"
+5 WRITE !?11,"- June 30, 2000, and AI/AN patients only)"
+6 WRITE !!?8,"U User-defined Report: You select the report and baseline"
+7 WRITE !?11,"periods and beneficiary population"
+8 WRITE !
+9 SET DIR(0)="F^1:1"
SET DIR("A")="Select a Report Option"
+10 SET DIR("B")="H"
SET DIR("?")="Enter an H for Hard-coded or a U for User-defined"
+11 DO ^DIR
+12 IF $DATA(DIRUT)
DO EXIT
QUIT
+13 KILL DIR
+14 SET Y=$$UP^XLFSTR(Y)
+15 IF Y'="H"
IF Y'="U"
WRITE !!,"Please enter an H for Hard-coded or a U for User-defined."
GOTO CHOICE
+16 SET BGPRTC=Y
INTRO ;
+1 IF BGPRTC="U"
Begin DoDot:1
+2 WRITE !!,"This will produce an Other National Measures Report for a year period"
+3 WRITE !,"you specify. You will be asked to provide: 1) the reporting period,"
+4 WRITE !,"2) the baseline period to compare data to, and 3) the beneficiary/"
+5 WRITE !,"classification of the patients."
+6 WRITE !
End DoDot:1
+7 ;
+8 SET BGPAREAA=1
+9 SET (BGPBD,BGPED,BGPTP)=""
+10 SET BGPRTYPE=7
SET BGPYRPTH=""
H IF BGPRTC="H"
Begin DoDot:1
+1 SET X=$ORDER(^BGPCTRL("B",2013,0))
+2 SET Y=^BGPCTRL(X,0)
+3 SET BGPBD=$PIECE(Y,U,8)
SET BGPED=$PIECE(Y,U,9)
+4 SET BGPPBD=$PIECE(Y,U,10)
SET BGPPED=$PIECE(Y,U,11)
+5 SET BGPBBD=$PIECE(Y,U,12)
SET BGPBED=$PIECE(Y,U,13)
+6 SET BGPPER=$PIECE(Y,U,14)
SET BGPQTR=3
+7 ;BEGIN TEST STUFF
+8 ;comment out when testing in TEHR
GOTO NT
+9 WRITE !!,"for testing purposes only, please enter a report year",!
+10 DO F
+11 IF BGPPER=""
WRITE !!,"no year entered..bye"
DO EXIT
QUIT
+12 SET BGPQTR=3
+13 SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"
SET BGPED=$EXTRACT(BGPPER,1,3)_"1231"
+14 SET BGPPBD=($EXTRACT(BGPPER,1,3)-1)_"0101"
SET BGPPED=($EXTRACT(BGPPER,1,3)-1)_"1231"
+15 WRITE !!,"for testing purposes only, please enter a BASELINE year",!
+16 DO B
+17 IF BGPBPER=""
WRITE !!,"no year entered..bye"
DO EXIT
QUIT
+18 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)
+5 SET BGPBEN=1
SET BGPBENF(0)="Indian/Alaskan Native (Classification 01)"
WRITE !!,"Beneficiary Population is set to American Indian/Alaskan Native Only."
End DoDot:1
GOTO ASU
TP ;
+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)
DO EXIT
QUIT
+3 SET BGPQTR=Y
+4 IF BGPQTR=5
DO ENDDATE
+5 IF BGPQTR'=5
DO F
+6 IF BGPPER=""
WRITE !,"Year not entered.",!
GOTO TP
+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
SET BGPBD=$$FMADD^XLFDT(BGPPER,-364)
SET BGPED=BGPPER
SET BGPPER=$EXTRACT(BGPED,1,3)_"0000"
+12 IF BGPED>DT
Begin DoDot:1
+13 WRITE !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."
+14 WRITE !,"The end date of this report is in the future; your data will not be",!,"complete.",!
+15 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
+16 IF $DATA(DIRUT)
SET BGPDO=1
QUIT
+17 IF Y
SET BGPDO=1
QUIT
+18 QUIT
End DoDot:1
IF BGPDO=1
GOTO TP
BY ;get baseline year
+1 SET BGPVDT=""
+2 WRITE !!,"Enter the Baseline Year to compare data to.",!,"Use a 4 digit year, e.g. 1999, 2000"
+3 SET DIR(0)="D^::EP"
+4 SET DIR("A")="Enter Year (e.g. 2000)"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
GOTO TP
+7 IF $DATA(DUOUT)
SET DIRUT=1
GOTO TP
+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
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 BY
+5 SET BGPBEN=Y
SET BGPBENF=Y(0)
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^BGP3ASL
+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.",!!
ZIS ;call to XBDBQUE
EISSEX ;
+1 SET BGPEXCEL=1
+2 SET BGPUF=$$GETDIR^BGP3UTL2()
+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 SET BGPEXCEL=1
Begin DoDot:1
+6 SET BGPNOW=$$NOW^XLFDT()
SET BGPNOW=$PIECE(BGPNOW,".")_"."_$$RZERO^BGP3UTL($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 BGPFONN1="CRSONMNT1"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2013063000000000_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
+10 SET BGPFONN2="CRSONMNT2"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2013063000000000_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
+11 SET BGPFONN3="CRSONMNT3"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2013063000000000_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
+12 SET BGPFONN4="CRSONMNT4"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2013063000000000_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
+13 SET BGPFONN5="CRSONMNT5"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2013063000000000_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
+14 QUIT
End DoDot:1
+15 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
+16 IF BGPEXCEL
Begin DoDot:1
+17 WRITE !!,"A file will be created called ",BGPFONN1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+18 WRITE !!,"A file will be created called ",BGPFONN2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+19 WRITE !!,"A file will be created called ",BGPFONN3,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+20 WRITE !!,"A file will be created called ",BGPFONN4,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+21 WRITE !!,"A file will be created called ",BGPFONN5,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
End DoDot:1
+22 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
+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(^BGPINDH("ON",1,X))
IF X'=+X
QUIT
SET BGPIND(X)=""
+2 SET BGPINDH="G"
+3 DO PT^BGP3DSL
+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^BGP3PARQ
+3 IF BGPRPTT="A"
DO ONN1^BGP3UTL
+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^BGP3DARO"
SET ZTDTH=""
SET ZTDESC="GPRA REPORT"
DO ^%ZTLOAD
DO HOME^%ZIS
DO EXIT
QUIT
+6 QUIT
+7 ;
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^BGP3DARO"
SET XBRX="EXIT^BGP3DARO"
SET XBNS="BGP"
+2 DO ^XBDBQUE
+3 QUIT
+4 ;
NODEV1 ;
+1 DO PRINT^BGP3PARQ
+2 IF BGPRPTT="A"
DO ONN1^BGP3UTL
+3 DO ^%ZISC
+4 DO EXIT
+5 QUIT
EXIT ;
+1 DO ^%ZISC
+2 DO EN^XBVK("BGP")
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 DO KILL^AUPNPAT
+4 DO ^XBFMK
+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. 2005"
+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. 2002, 2005"
+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 ;
ENDDATE ;
+1 WRITE !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2013)"
+2 WRITE !,"will assume a year in the past, if you want to put in a future date,"
+3 WRITE !,"remember to enter the full 4 digit year. For example, if today is"
+4 WRITE !,"January 4, 2010 and you type in 6/30/05 the system will assume the year"
+5 WRITE !,"as 1905 since that is a date in the past. You must type 6/30/2010 if you"
+6 WRITE !,"want a date in the future."
+7 SET (BGPPER,BGPVDT)=""
+8 WRITE !
KILL DIR,X,Y
SET DIR(0)="D^::EP"
SET DIR("A")="Enter End Date for the Report: (e.g. 11/30/2005)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+9 IF $DATA(DIRUT)
QUIT
+10 SET (BGPPER,BGPVDT)=Y
+11 QUIT
+12 ;
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
