BGP3DG ; IHS/CMI/LAB - IHS GPRA - report for area export ;
;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
;
;
W:$D(IOF) @IOF
W !!,$$CTR("IHS FY03 GPRA Indicator Report for Export to Area",80)
INTRO ;
D XIT
W !!,"This will produce a GPRA Indicator Report for one or more indicators for a year",!,"period ending on a date you specify. You will be asked to provide: 1) the",!,"baseline year to"
W " compare data to, and 2) the Community taxonomy to determine",!,"which patients will be included.",!
W !,"This option will produce a report in export format for the Area Office to use",!,"in Area aggregated data. Depending on site-specific configuration, the",!
W "export file will either be automatically transmitted directly to the Area or ",!,"the site will have to send the file manually.",!
D TAXCHK^BGP3TXCH
TP ;get time period
D XIT
S BGPRTYPE=1
S (BGPBD,BGPED,BGPTP)=""
S DIR(0)="S^Q:FY Quarter End (Q1 December 31, Q2 March 31, Q3 June 30);F:Fiscal Year End (September 30)",DIR("A")="Run Report for which time period",DIR("B")="Q" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
S BGPTP=Y
D @BGPTP
I $D(BGPQUIT) G TP
BY ;get baseline year
W !!,"The baseline year is FY 2000.",!
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. 2003)"
;D ^DIR KILL DIR
;K DIC
;I $D(DUOUT) S DIRUT=1 G TP
S BGPVDT=3000000
;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,"Reporting 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
COMM ;
W !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report. You should have created this taxonomy using QMAN",!,"or the Taxonomy Setup option.",!
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: " D ^DIC
I Y=-1 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
HOME ;
S BGPHOME=$P($G(^BGPSITE(DUZ(2),0)),U,2)
I BGPHOME="" W !!,"Home Location not found in Site File!!",!,"PHN Visits counts to Home will be calculated using clinic 11 only!!" H 2 G GI
W !,"Your HOME location is defined as: ",$P(^DIC(4,BGPHOME,0),U)," asufac: ",$P(^AUTTLOC(BGPHOME,0),U,10)
GI ;gather all gpra indicators
S X=0 F S X=$O(^BGPINDC("AGPRA",X)) Q:X'=+X S Y=0 F S Y=$O(^BGPINDC("AGPRA",X,Y)) Q:Y'=+Y S BGPIND($P(^BGPINDC(Y,0),U,1))=""
S BGPINDT="G"
SUM ;display summary of this report
W:$D(IOF) @IOF
W !,$$CTR("SUMMARY OF GPRA REPORT TO BE GENERATED")
W !!,"The date ranges for this report are:"
W !?5,"Reporting 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 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."
W !!,"These GPRA indicators will be calculated: " S X=0 F S X=$O(BGPIND(X)) Q:X'=+X I $P($T(@X),";;",2)]"" W $P($T(@X),";;",2)," ; "
D PT^BGP3DSL
I BGPROT="" G COMM
ZIS ;call to XBDBQUE
D REPORT^BGP3UTL
I $G(BGPQUIT) D XIT Q
I BGPRPT="" D XIT Q
W !!,"A file will be created called BG03",$P(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT," and will reside",!,"in the export/public directory.",!
W !,"Depending on your site configuration, this file may need to be manually",!,"sent to your Area Office.",!
;
K IOP,%ZIS W !! S %ZIS=$S(BGPDELT'="S":"PQM",1:"PM") D ^%ZIS
I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDC(" D ^DIK K DIK D XIT Q
I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDP(" D ^DIK K DIK D XIT Q
I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDB(" D ^DIK K DIK D XIT Q
I $D(IO("Q")) G TSKMN
DRIVER ;
D ^BGP3D1
U IO
D ^BGP3DP
D ^%ZISC
D GS^BGP3UTL
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^BGP3DG",ZTDTH="",ZTDESC="GPRA 03 REPORT" D ^%ZTLOAD D XIT Q
Q
;
OLD ;
S XBRP="PRINT^BGPDP",XBRC="PROC^BGPD1",XBRX="XIT^BGPD",XBNS="BGP"
D ^XBDBQUE
D XIT
Q
;
XIT ;
D ^%ZISC
D EN^XBVK("BGP")
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
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)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIR,DIRUTUT,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")
;----------
;
D ;get date range.
K DIR,DIRUT W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date for this Report"
D ^DIR KILL DIR I Y<1 S BGPQUIT="" Q
S BGPBD=Y
K DIR,DIRUT S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Date for this Report Date"
D ^DIR KILL DIR I Y<1 S BGPQUIT="" Q
S BGPED=Y
;
I BGPED<BGPBD D G D
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
;
Q
Q ;which quarter
D F
I $G(BGPPER)="" W !,"No FY entered" S BGPQUIT="" Q
S DIR("?",1)="Select the end date for your report:",DIR("?",2)=" 1 December 31",DIR("?",3)=" 2 March 31",DIR("?")=" 3 June 30"
S DIR(0)="N^1:3:0",DIR("A")="Which FY Quarter End Date" KILL DA D ^DIR KILL DIR
I $D(DIRUT)!(Y="") S BGPQUIT="" Q
W !!,"Your report will use the last day of the quarter you selected as the End Date",!,"of the Report. Depending on the indicator, the report will calculate based",!,"on data from at least the year prior"
W " to the Report End Date, not just on the",!,"quarter selected.",!
S BGPQTR=Y
I Y=1 S BGPBD=($E(BGPPER,1,3)-1)_"0101",BGPED=($E(BGPPER,1,3)-1)_"1231" Q
I Y=2 S BGPBD=($E(BGPPER,1,3)-1)_"0401",BGPED=$E(BGPPER,1,3)_"0331" Q
I Y=3 S BGPBD=($E(BGPPER,1,3)-1)_"0701",BGPED=$E(BGPPER,1,3)_"0630" Q
I Y=4 S BGPBD=($E(BGPPER,1,3)-1)_"1001",BGPED=$E(BGPPER,1,3)_"0930" Q
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
A ;area dir year
W !
S BGPVDT=""
W !,"Enter the appropriate AREA REPORTING YEAR. Use a 4 digit year, e.g. 2002"
S DIR(0)="D^::EP"
S DIR("A")="Enter AREA REPORTING YEAR (e.g. 1999)"
S DIR("?")="This report is compiled for a period. Enter a valid date."
D ^DIR KILL 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 A
S BGPPER=BGPVDT,BGPBD=($E(BGPVDT,1,3)-1)_"0701",BGPED=$E(BGPVDT,1,3)_"0630"
Q
F ;fiscal year
S BGPPER=""
W !
S BGPVDT=""
W !,"Enter the Fiscal Year (FY). Use a 4 digit year, e.g. 2002, 2003"
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 KILL 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
BGP3DG ; IHS/CMI/LAB - IHS GPRA - report for area export ;
+1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 WRITE !!,$$CTR("IHS FY03 GPRA Indicator Report for Export to Area",80)
INTRO ;
+1 DO XIT
+2 WRITE !!,"This will produce a GPRA Indicator Report for one or more indicators for a year",!,"period ending on a date you specify. You will be asked to provide: 1) the",!,"baseline year to"
+3 WRITE " compare data to, and 2) the Community taxonomy to determine",!,"which patients will be included.",!
+4 WRITE !,"This option will produce a report in export format for the Area Office to use",!,"in Area aggregated data. Depending on site-specific configuration, the",!
+5 WRITE "export file will either be automatically transmitted directly to the Area or ",!,"the site will have to send the file manually.",!
+6 DO TAXCHK^BGP3TXCH
TP ;get time period
+1 DO XIT
+2 SET BGPRTYPE=1
+3 SET (BGPBD,BGPED,BGPTP)=""
+4 SET DIR(0)="S^Q:FY Quarter End (Q1 December 31, Q2 March 31, Q3 June 30);F:Fiscal Year End (September 30)"
SET DIR("A")="Run Report for which time period"
SET DIR("B")="Q"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
DO XIT
QUIT
+6 SET BGPTP=Y
+7 DO @BGPTP
+8 IF $DATA(BGPQUIT)
GOTO TP
BY ;get baseline year
+1 WRITE !!,"The baseline year is FY 2000.",!
+2 SET BGPVDT=""
+3 ;W !,"Enter the Baseline Year to compare data to.",!,"Use a 4 digit year, e.g. 1999, 2000"
+4 ;S DIR(0)="D^::EP"
+5 ;S DIR("A")="Enter Year (e.g. 2003)"
+6 ;D ^DIR KILL DIR
+7 ;K DIC
+8 ;I $D(DUOUT) S DIRUT=1 G TP
+9 SET BGPVDT=3000000
+10 ;I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G BY
+11 SET X=$EXTRACT(BGPPER,1,3)-$EXTRACT(BGPVDT,1,3)
+12 SET X=X_"0000"
+13 SET BGPBBD=BGPBD-X
SET BGPBBD=$EXTRACT(BGPBBD,1,3)_$EXTRACT(BGPBD,4,7)
+14 SET BGPBED=BGPED-X
SET BGPBED=$EXTRACT(BGPBED,1,3)_$EXTRACT(BGPED,4,7)
+15 SET BGPPBD=($EXTRACT(BGPBD,1,3)-1)_$EXTRACT(BGPBD,4,7)
+16 SET BGPPED=($EXTRACT(BGPED,1,3)-1)_$EXTRACT(BGPED,4,7)
+17 WRITE !!,"The date ranges for this report are:"
+18 WRITE !?5,"Reporting Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
+19 WRITE !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
+20 WRITE !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
+21 IF BGPPBD=BGPBBD
IF BGPPED=BGPBED
KILL Y
DO CHKY
IF Y
KILL BGPBBD,BGPBED,BGPPBD,BGPPED
GOTO BY
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",!,"or the Taxonomy Setup option.",!
+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: "
DO ^DIC
+6 IF Y=-1
QUIT
+7 SET BGPTAXI=+Y
COM1 SET X=0
+1 FOR
SET X=$ORDER(^ATXAX(BGPTAXI,21,X))
IF 'X
QUIT
Begin DoDot:1
+2 SET BGPTAX($PIECE(^ATXAX(BGPTAXI,21,X,0),U))=""
+3 QUIT
End DoDot:1
+4 IF '$DATA(BGPTAX)
WRITE !!,"There are no communities in that taxonomy."
GOTO COMM
HOME ;
+1 SET BGPHOME=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,2)
+2 IF BGPHOME=""
WRITE !!,"Home Location not found in Site File!!",!,"PHN Visits counts to Home will be calculated using clinic 11 only!!"
HANG 2
GOTO GI
+3 WRITE !,"Your HOME location is defined as: ",$PIECE(^DIC(4,BGPHOME,0),U)," asufac: ",$PIECE(^AUTTLOC(BGPHOME,0),U,10)
GI ;gather all gpra indicators
+1 SET X=0
FOR
SET X=$ORDER(^BGPINDC("AGPRA",X))
IF X'=+X
QUIT
SET Y=0
FOR
SET Y=$ORDER(^BGPINDC("AGPRA",X,Y))
IF Y'=+Y
QUIT
SET BGPIND($PIECE(^BGPINDC(Y,0),U,1))=""
+2 SET BGPINDT="G"
SUM ;display summary of this report
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR("SUMMARY OF GPRA REPORT TO BE GENERATED")
+3 WRITE !!,"The date ranges for this report are:"
+4 WRITE !?5,"Reporting Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
+5 WRITE !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
+6 WRITE !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
+7 WRITE !!,"The COMMUNITY Taxonomy to be used is: ",$PIECE(^ATXAX(BGPTAXI,0),U)
+8 IF BGPHOME
WRITE !,"The HOME location is: ",$PIECE(^DIC(4,BGPHOME,0),U)," ",$PIECE(^AUTTLOC(BGPHOME,0),U,10)
+9 IF 'BGPHOME
WRITE !,"No HOME Location selected."
+10 WRITE !!,"These GPRA indicators will be calculated: "
SET X=0
FOR
SET X=$ORDER(BGPIND(X))
IF X'=+X
QUIT
IF $PIECE($TEXT(@X),";;",2)]""
WRITE $PIECE($TEXT(@X),";;",2)," ; "
+11 DO PT^BGP3DSL
+12 IF BGPROT=""
GOTO COMM
ZIS ;call to XBDBQUE
+1 DO REPORT^BGP3UTL
+2 IF $GET(BGPQUIT)
DO XIT
QUIT
+3 IF BGPRPT=""
DO XIT
QUIT
+4 WRITE !!,"A file will be created called BG03",$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT," and will reside",!,"in the export/public directory.",!
+5 WRITE !,"Depending on your site configuration, this file may need to be manually",!,"sent to your Area Office.",!
+6 ;
+7 KILL IOP,%ZIS
WRITE !!
SET %ZIS=$SELECT(BGPDELT'="S":"PQM",1:"PM")
DO ^%ZIS
+8 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDC("
DO ^DIK
KILL DIK
DO XIT
QUIT
+9 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDP("
DO ^DIK
KILL DIK
DO XIT
QUIT
+10 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDB("
DO ^DIK
KILL DIK
DO XIT
QUIT
+11 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 DO ^BGP3D1
+2 USE IO
+3 DO ^BGP3DP
+4 DO ^%ZISC
+5 DO GS^BGP3UTL
+6 DO XIT
+7 QUIT
+8 ;
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^BGP3DG"
SET ZTDTH=""
SET ZTDESC="GPRA 03 REPORT"
DO ^%ZTLOAD
DO XIT
QUIT
+6 QUIT
+7 ;
OLD ;
+1 SET XBRP="PRINT^BGPDP"
SET XBRC="PROC^BGPD1"
SET XBRX="XIT^BGPD"
SET XBNS="BGP"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
+5 ;
XIT ;
+1 DO ^%ZISC
+2 DO EN^XBVK("BGP")
+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 DO KILL^AUPNPAT
+10 DO ^XBFMK
+11 QUIT
+12 ;
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 DIR,DIRUTUT,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 ;
D ;get date range.
+1 KILL DIR,DIRUT
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Date for this Report"
+2 DO ^DIR
KILL DIR
IF Y<1
SET BGPQUIT=""
QUIT
+3 SET BGPBD=Y
+4 KILL DIR,DIRUT
SET DIR(0)="DO^:DT:EXP"
SET DIR("A")="Enter Ending Date for this Report Date"
+5 DO ^DIR
KILL DIR
IF Y<1
SET BGPQUIT=""
QUIT
+6 SET BGPED=Y
+7 ;
+8 IF BGPED<BGPBD
Begin DoDot:1
+9 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO D
+10 ;
+11 QUIT
Q ;which quarter
+1 DO F
+2 IF $GET(BGPPER)=""
WRITE !,"No FY entered"
SET BGPQUIT=""
QUIT
+3 SET DIR("?",1)="Select the end date for your report:"
SET DIR("?",2)=" 1 December 31"
SET DIR("?",3)=" 2 March 31"
SET DIR("?")=" 3 June 30"
+4 SET DIR(0)="N^1:3:0"
SET DIR("A")="Which FY Quarter End Date"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)!(Y="")
SET BGPQUIT=""
QUIT
+6 WRITE !!,"Your report will use the last day of the quarter you selected as the End Date",!,"of the Report. Depending on the indicator, the report will calculate based",!,"on data from at least the year prior"
+7 WRITE " to the Report End Date, not just on the",!,"quarter selected.",!
+8 SET BGPQTR=Y
+9 IF Y=1
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0101"
SET BGPED=($EXTRACT(BGPPER,1,3)-1)_"1231"
QUIT
+10 IF Y=2
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0401"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0331"
QUIT
+11 IF Y=3
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0701"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0630"
QUIT
+12 IF Y=4
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"1001"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0930"
QUIT
+13 QUIT
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
A ;area dir year
+1 WRITE !
+2 SET BGPVDT=""
+3 WRITE !,"Enter the appropriate AREA REPORTING YEAR. Use a 4 digit year, e.g. 2002"
+4 SET DIR(0)="D^::EP"
+5 SET DIR("A")="Enter AREA REPORTING YEAR (e.g. 1999)"
+6 SET DIR("?")="This report is compiled for a period. Enter a valid date."
+7 DO ^DIR
KILL DIR
+8 KILL DIC
+9 IF $DATA(DUOUT)
SET DIRUT=1
SET BGPQUIT=""
QUIT
+10 SET BGPVDT=Y
+11 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO A
+12 SET BGPPER=BGPVDT
SET BGPBD=($EXTRACT(BGPVDT,1,3)-1)_"0701"
SET BGPED=$EXTRACT(BGPVDT,1,3)_"0630"
+13 QUIT
F ;fiscal year
+1 SET BGPPER=""
+2 WRITE !
+3 SET BGPVDT=""
+4 WRITE !,"Enter the Fiscal Year (FY). Use a 4 digit year, e.g. 2002, 2003"
+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
KILL 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
