BGP3DA ; 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 Annual Area Clinical Performance Indicator Report for Export to Area",80)
INTRO ;
D XIT
W !!,"This will produce an Annual Area Clinical Performance Indicator Report for one",!,"or more indicators for a year period ending on a date you specify."
W !,"You will be asked to provide 1) the baseline year to 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.",!
W !,"This option will also produce an output file for export to the EISS system.",!
D TAXCHK^BGP3TXCH
TP ;get time period
D XIT
S BGPRTYPE=2
S (BGPBD,BGPED,BGPTP)=""
S DIR(0)="S^Q:Area Dir's Quarter End (Q1 Sept 30, Q2 Dec 31, Q3 Mar 31);A:Area Director's Reporting Year End (June 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 defined as 2000."
;W !
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 ;set standard by Terry
;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 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
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 area indicators
S X=0 F S X=$O(^BGPINDC("AREA",X)) Q:X'=+X S Y=0 F S Y=$O(^BGPINDC("AREA",X,Y)) Q:Y'=+Y S BGPIND($P(^BGPINDC(Y,0),U,1))=""
S BGPINDT="A"
SUM ;display summary of this report
W:$D(IOF) @IOF
W !,$$CTR("SUMMARY OF AREA DIRECTOR'S CLINICAL PERFORMANCE 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 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 EISSGS^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^BGP3DA",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 A
I BGPPER="" W !,"No YEAR entered" S BGPQUIT="" Q
S DIR("?",1)="Select the end date for your report:",DIR("?",2)=" 1 September 30",DIR("?",3)=" 2 December 31",DIR("?")=" 3 March 31"
S DIR(0)="N^1:3:0",DIR("A")="Which Area Director's 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)-2)_"1001",BGPED=($E(BGPPER,1,3)-1)_"0930" Q
I Y=2 S BGPBD=($E(BGPPER,1,3)-1)_"0101",BGPED=($E(BGPPER,1,3)-1)_"1231" Q
I Y=3 S BGPBD=($E(BGPPER,1,3)-1)_"0401",BGPED=$E(BGPPER,1,3)_"0331" Q
I Y=4 S BGPBD=$E(BGPPER,1,3)_"0401",BGPED=$E(BGPPER,1,3)_"0630" Q
Q
F ;fiscal year
S BGPPER=""
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
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
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
S BGPPER=""
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
BGP3DA ; 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 Annual Area Clinical Performance Indicator Report for Export to Area",80)
INTRO ;
+1 DO XIT
+2 WRITE !!,"This will produce an Annual Area Clinical Performance Indicator Report for one",!,"or more indicators for a year period ending on a date you specify."
+3 WRITE !,"You will be asked to provide 1) the baseline year to 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 WRITE !,"This option will also produce an output file for export to the EISS system.",!
+7 DO TAXCHK^BGP3TXCH
TP ;get time period
+1 DO XIT
+2 SET BGPRTYPE=2
+3 SET (BGPBD,BGPED,BGPTP)=""
+4 SET DIR(0)="S^Q:Area Dir's Quarter End (Q1 Sept 30, Q2 Dec 31, Q3 Mar 31);A:Area Director's Reporting Year End (June 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 defined as 2000."
+2 ;W !
+3 SET BGPVDT=""
+4 ;W !,"Enter the Baseline Year to compare data to.",!,"Use a 4 digit year, e.g. 1999, 2000"
+5 ;S DIR(0)="D^::EP"
+6 ;S DIR("A")="Enter Year (e.g. 2003)"
+7 ;D ^DIR KILL DIR
+8 ;K DIC
+9 ;I $D(DUOUT) S DIRUT=1 G TP
+10 ;set standard by Terry
SET BGPVDT=3000000
+11 ;I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G BY
+12 SET X=$EXTRACT(BGPPER,1,3)-$EXTRACT(BGPVDT,1,3)
+13 SET X=X_"0000"
+14 SET BGPBBD=BGPBD-X
SET BGPBBD=$EXTRACT(BGPBBD,1,3)_$EXTRACT(BGPBD,4,7)
+15 SET BGPBED=BGPED-X
SET BGPBED=$EXTRACT(BGPBED,1,3)_$EXTRACT(BGPED,4,7)
+16 SET BGPPBD=($EXTRACT(BGPBD,1,3)-1)_$EXTRACT(BGPBD,4,7)
+17 SET BGPPED=($EXTRACT(BGPED,1,3)-1)_$EXTRACT(BGPED,4,7)
+18 WRITE !!,"The date ranges for this report are:"
+19 WRITE !?5,"Reporting Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
+20 WRITE !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
+21 WRITE !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
+22 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
DO XIT
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 area indicators
+1 SET X=0
FOR
SET X=$ORDER(^BGPINDC("AREA",X))
IF X'=+X
QUIT
SET Y=0
FOR
SET Y=$ORDER(^BGPINDC("AREA",X,Y))
IF Y'=+Y
QUIT
SET BGPIND($PIECE(^BGPINDC(Y,0),U,1))=""
+2 SET BGPINDT="A"
SUM ;display summary of this report
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR("SUMMARY OF AREA DIRECTOR'S CLINICAL PERFORMANCE 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 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 ;D EISSGS^BGP3UTL
+7 DO XIT
+8 QUIT
+9 ;
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^BGP3DA"
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 A
+2 IF BGPPER=""
WRITE !,"No YEAR entered"
SET BGPQUIT=""
QUIT
+3 SET DIR("?",1)="Select the end date for your report:"
SET DIR("?",2)=" 1 September 30"
SET DIR("?",3)=" 2 December 31"
SET DIR("?")=" 3 March 31"
+4 SET DIR(0)="N^1:3:0"
SET DIR("A")="Which Area Director's 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)-2)_"1001"
SET BGPED=($EXTRACT(BGPPER,1,3)-1)_"0930"
QUIT
+10 IF Y=2
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0101"
SET BGPED=($EXTRACT(BGPPER,1,3)-1)_"1231"
QUIT
+11 IF Y=3
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0401"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0331"
QUIT
+12 IF Y=4
SET BGPBD=$EXTRACT(BGPPER,1,3)_"0401"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0630"
QUIT
+13 QUIT
F ;fiscal year
+1 SET BGPPER=""
+2 SET BGPVDT=""
+3 WRITE !!,"Enter the Fiscal Year (FY). Use a 4 digit year, e.g. 2002, 2003"
+4 SET DIR(0)="D^::EP"
+5 SET DIR("A")="Enter FY"
+6 SET DIR("?")="This report is compiled for a period. Enter a valid date."
+7 DO ^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 F
+12 SET BGPPER=BGPVDT
SET BGPBD=($EXTRACT(BGPVDT,1,3)-1)_"1001"
SET BGPED=$EXTRACT(BGPVDT,1,3)_"0930"
+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 SET BGPPER=""
+2 WRITE !
+3 SET BGPVDT=""
+4 WRITE !,"Enter the appropriate AREA REPORTING YEAR. Use a 4 digit year, e.g. 2002"
+5 SET DIR(0)="D^::EP"
+6 SET DIR("A")="Enter AREA REPORTING YEAR (e.g. 1999)"
+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 A
+13 SET BGPPER=BGPVDT
SET BGPBD=($EXTRACT(BGPVDT,1,3)-1)_"0701"
SET BGPED=$EXTRACT(BGPVDT,1,3)_"0630"
+14 QUIT
