BGP8UTL3 ; IHS/CMI/LAB - UTILITIES ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
ONN4 ;EP
K BGPEXCT
S Y=$$OPEN^%ZISH(BGPUF,BGPFONN4,"W")
I Y=1 W:'$D(ZTQUEUED) !!,"Cannot open host file." Q
U IO
S BGPP=0,BGPY=$O(^BGPCTRL("B","2018",0)),BGPX="",BGPEC=$P(^BGPCTRL(BGPY,0),U,25)
F S BGPP=$O(^BGPCTRL(BGPY,86,BGPP)) Q:BGPP'=+BGPP D
.S BGPPP1=$P(^BGPCTRL(BGPY,86,BGPP,0),U,1)
.S BGPZ=$P(^BGPCTRL(BGPY,86,BGPP,0),U,2)
.S $P(BGPX,U,BGPPP1)=BGPZ
W BGPX,!
K BGPX
S BGPX="" S P=11 F S $P(BGPX,U,P)="Current",P=P+9 Q:P>(BGPEC-8)
S P=14 F S $P(BGPX,U,P)="Previous",P=P+9 Q:P>(BGPEC-5)
S P=17 F S $P(BGPX,U,P)="Baseline",P=P+9 Q:P>(BGPEC+1)
W BGPX,!
K BGPX
D SETHDR^BGP8UTL
S P=11 F S $P(BGPX,U,P)="Num",P=P+3 Q:P>(BGPEC-2)
S P=12 F S $P(BGPX,U,P)="Den",P=P+3 Q:P>(BGPEC-1)
S P=13 F S $P(BGPX,U,P)="%",P=P+3 Q:P>BGPEC
W BGPX,!
S BGPX=0 F S BGPX=$O(BGPONN4(BGPX)) Q:BGPX'=+BGPX W BGPONN4(BGPX),!
K BGPONN4
D ^%ZISC
Q
ONN5 ;
K BGPEXCT
S Y=$$OPEN^%ZISH(BGPUF,BGPFONN5,"W")
I Y=1 W:'$D(ZTQUEUED) !!,"Cannot open host file." Q
U IO
S BGPP=0,BGPY=$O(^BGPCTRL("B","2018",0)),BGPX="",BGPEC=$P(^BGPCTRL(BGPY,0),U,26)
F S BGPP=$O(^BGPCTRL(BGPY,87,BGPP)) Q:BGPP'=+BGPP D
.S BGPPP1=$P(^BGPCTRL(BGPY,87,BGPP,0),U,1)
.S BGPZ=$P(^BGPCTRL(BGPY,87,BGPP,0),U,2)
.S $P(BGPX,U,BGPPP1)=BGPZ
W BGPX,!
K BGPX
S BGPX="" S P=11 F S $P(BGPX,U,P)="Current",P=P+9 Q:P>(BGPEC-8)
S P=14 F S $P(BGPX,U,P)="Previous",P=P+9 Q:P>(BGPEC-5)
S P=17 F S $P(BGPX,U,P)="Baseline",P=P+9 Q:P>(BGPEC+1)
W BGPX,!
K BGPX
D SETHDR^BGP8UTL
S P=11 F S $P(BGPX,U,P)="Num",P=P+3 Q:P>(BGPEC-2)
S P=12 F S $P(BGPX,U,P)="Den",P=P+3 Q:P>(BGPEC-1)
S P=13 F S $P(BGPX,U,P)="%",P=P+3 Q:P>BGPEC
W BGPX,!
S BGPX=0 F S BGPX=$O(BGPONN5(BGPX)) Q:BGPX'=+BGPX W BGPONN5(BGPX),!
K BGPONN5
ONNC D ^%ZISC ;close host file
Q
AGEDATE(BIAGRG,BISVDT,BIBEGDT,BIENDDT,BIERR) ;EP
;---> Given an Age Range in months or years and a Survey Date,
;---> return the beginning and ending dates in Fileman format.
;---> Use to search patients by DOB.
;---> Parameters:
; 1 - BIAGRG (req) Age Range^Mth/Yr (e.g.,50-64^1)
; (See description at linelable AGERNG above.)
; 2 - BISVDT (req) Survey/Forecast Date (date from which to
; calculate age).
; 3 - BIBEGDT (ret) Beginning Date.
; 4 - BIENDDT (ret) Ending Date.
; 5 - BIERR (ret) Error.
;
;---> Set begin and end dates for search through PATIENT File.
I "ALL"[$G(BIAGRG) S BIBEGDT=0,BIENDDT=9999999 Q
I '$G(BISVDT) S BISVDT=$G(DT)
;I '$G(BISVDT) S BIBEGDT=0,BIENDDT=9999999 Q
;S:BISVDT>DT BISVDT=DT
;
;---> If X=one age only, set it in the form X-X and quit.
;---> If Age Range is passed in years, convert to months.
D
.N Y S Y=$P(BIAGRG,U)
.;---> If Y=one age only, set it in the form Y-Y.
.I Y?1N.N S Y=Y_"-"_Y
.I '$P(BIAGRG,U,2) S BIAGRG=Y Q
.S BIAGRG=(12*$P(Y,"-"))_"-"_(12*$P(Y,"-",2)+11)
;
N BIAGRG1,BIAGRG2
S BIAGRG1=+$P(BIAGRG,"-",1),BIAGRG2=+$P(BIAGRG,"-",2)
;I (BIAGRG1'?1N.N)!(BIAGRG2'?1N.N) D ERRCD^BIUTL2(676,.BIERR) Q
;
;D PASTMTH(BISVDT,($P(BIAGRG,"-",2)+1),.BIBEGDT)
D PASTMTH(BISVDT,(BIAGRG2+1),.BIBEGDT)
;
;---> Now, set Beginning Day to be one day AFTER the patient would
;---> be too old and out of the selected Age Range.
;---> In other words, come forward one day to include only patients
;---> whose age is ONE DAY LESS THAN a month (or year) after the
;---> maximum limit of the selected Age Range.
;---> For example, Age Range=24-36 includes patients whose age
;---> is between [24months] and [37months-1day].
N X,X1,X2 S X1=BIBEGDT,X2=1 D C^%DTC S BIBEGDT=X
;
;D PASTMTH(BISVDT,$P(BIAGRG,"-",1),.BIENDDT)
D PASTMTH(BISVDT,BIAGRG1,.BIENDDT)
Q
;
;
;----------
PASTMTH(BIDTI,BIMTHS,BIDTO,BIYR) ;EP
;---> Return the date BIMTHS months/years prior the input date.
;---> Parameters:
; 1 - BIDTI (req) Date in.
; 2 - BIMTHS (req) Number of months in the past to calculate.
; 3 - BIDTO (ret) Date out (BIMTHS prior to BIDTI).
; 4 - BIYR (opt) If BIYR=1, input is in years; multiply BIMTHSx12.
;
Q:'$G(BIDTI)
I '$G(BIMTHS) S BIDTO=BIDTI Q
I $G(BIYR)=1 S BIMTHS=(BIMTHS*12)
N YYY,MM,DD
S YYY=$E(BIDTI,1,3),MM=+$E(BIDTI,4,5),DD=+$E(BIDTI,6,7)
D
.I MM>BIMTHS S MM=MM-BIMTHS Q
.N I,Q S Q=0
.F I=12:12 D Q:Q
..I BIMTHS-MM<I S MM=I-(BIMTHS-MM),YYY=YYY-(I/12),Q=1
;
S:MM<10 MM="0"_MM
S:DD<10 DD="0"_DD
S BIDTO=YYY_MM_DD
Q
;
TESTDR ;
TP ;
W !!,"for testing purposes only, please enter DATE RANGE AND YEAR",!
S (BGPBD,BGPED,BGPTP)=""
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) Q
S BGPQTR=Y
I BGPQTR=5 D ENDDATE^BGP8DGPU
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 D=$$FMADD^XLFDT(BGPPER,1) S BGPBD=($E(BGPPER,1,3)-1)_$E(D,4,7),BGPED=BGPPER,BGPPER=$E(BGPED,1,3)_"0000"
I BGPQTR=5 D
.S D=$$FMADD^XLFDT(BGPPER,1)
.I $E(BGPPER,4,7)'=1231 S BGPBD=($E(BGPPER,1,3)-1)_$E(D,4,7),BGPED=BGPPER,BGPPER=$E(BGPED,1,3)_"0000"
.I $E(BGPPER,4,7)=1231 S BGPBD=$E(BGPPER,1,3)_$E(D,4,7),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. 2010"
S DIR(0)="D^::EP"
S DIR("A")="Enter Year (e.g. 2010)"
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^BGP8DL I Y K BGPBBD,BGPBED,BGPPBD,BGPPED G BY
Q
F ;calendar year
S (BGPPER,BGPVDT)=""
W !!,"Enter the Calendar Year for the report END date. Use a 4 digit",!,"year, e.g. 2018"
S DIR(0)="D^::EP"
S DIR("A")="Enter 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 BGPPER=BGPVDT
Q
BGP8UTL3 ; IHS/CMI/LAB - UTILITIES ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
ONN4 ;EP
+1 KILL BGPEXCT
+2 SET Y=$$OPEN^%ZISH(BGPUF,BGPFONN4,"W")
+3 IF Y=1
IF '$DATA(ZTQUEUED)
WRITE !!,"Cannot open host file."
QUIT
+4 USE IO
+5 SET BGPP=0
SET BGPY=$ORDER(^BGPCTRL("B","2018",0))
SET BGPX=""
SET BGPEC=$PIECE(^BGPCTRL(BGPY,0),U,25)
+6 FOR
SET BGPP=$ORDER(^BGPCTRL(BGPY,86,BGPP))
IF BGPP'=+BGPP
QUIT
Begin DoDot:1
+7 SET BGPPP1=$PIECE(^BGPCTRL(BGPY,86,BGPP,0),U,1)
+8 SET BGPZ=$PIECE(^BGPCTRL(BGPY,86,BGPP,0),U,2)
+9 SET $PIECE(BGPX,U,BGPPP1)=BGPZ
End DoDot:1
+10 WRITE BGPX,!
+11 KILL BGPX
+12 SET BGPX=""
SET P=11
FOR
SET $PIECE(BGPX,U,P)="Current"
SET P=P+9
IF P>(BGPEC-8)
QUIT
+13 SET P=14
FOR
SET $PIECE(BGPX,U,P)="Previous"
SET P=P+9
IF P>(BGPEC-5)
QUIT
+14 SET P=17
FOR
SET $PIECE(BGPX,U,P)="Baseline"
SET P=P+9
IF P>(BGPEC+1)
QUIT
+15 WRITE BGPX,!
+16 KILL BGPX
+17 DO SETHDR^BGP8UTL
+18 SET P=11
FOR
SET $PIECE(BGPX,U,P)="Num"
SET P=P+3
IF P>(BGPEC-2)
QUIT
+19 SET P=12
FOR
SET $PIECE(BGPX,U,P)="Den"
SET P=P+3
IF P>(BGPEC-1)
QUIT
+20 SET P=13
FOR
SET $PIECE(BGPX,U,P)="%"
SET P=P+3
IF P>BGPEC
QUIT
+21 WRITE BGPX,!
+22 SET BGPX=0
FOR
SET BGPX=$ORDER(BGPONN4(BGPX))
IF BGPX'=+BGPX
QUIT
WRITE BGPONN4(BGPX),!
+23 KILL BGPONN4
+24 DO ^%ZISC
+25 QUIT
ONN5 ;
+1 KILL BGPEXCT
+2 SET Y=$$OPEN^%ZISH(BGPUF,BGPFONN5,"W")
+3 IF Y=1
IF '$DATA(ZTQUEUED)
WRITE !!,"Cannot open host file."
QUIT
+4 USE IO
+5 SET BGPP=0
SET BGPY=$ORDER(^BGPCTRL("B","2018",0))
SET BGPX=""
SET BGPEC=$PIECE(^BGPCTRL(BGPY,0),U,26)
+6 FOR
SET BGPP=$ORDER(^BGPCTRL(BGPY,87,BGPP))
IF BGPP'=+BGPP
QUIT
Begin DoDot:1
+7 SET BGPPP1=$PIECE(^BGPCTRL(BGPY,87,BGPP,0),U,1)
+8 SET BGPZ=$PIECE(^BGPCTRL(BGPY,87,BGPP,0),U,2)
+9 SET $PIECE(BGPX,U,BGPPP1)=BGPZ
End DoDot:1
+10 WRITE BGPX,!
+11 KILL BGPX
+12 SET BGPX=""
SET P=11
FOR
SET $PIECE(BGPX,U,P)="Current"
SET P=P+9
IF P>(BGPEC-8)
QUIT
+13 SET P=14
FOR
SET $PIECE(BGPX,U,P)="Previous"
SET P=P+9
IF P>(BGPEC-5)
QUIT
+14 SET P=17
FOR
SET $PIECE(BGPX,U,P)="Baseline"
SET P=P+9
IF P>(BGPEC+1)
QUIT
+15 WRITE BGPX,!
+16 KILL BGPX
+17 DO SETHDR^BGP8UTL
+18 SET P=11
FOR
SET $PIECE(BGPX,U,P)="Num"
SET P=P+3
IF P>(BGPEC-2)
QUIT
+19 SET P=12
FOR
SET $PIECE(BGPX,U,P)="Den"
SET P=P+3
IF P>(BGPEC-1)
QUIT
+20 SET P=13
FOR
SET $PIECE(BGPX,U,P)="%"
SET P=P+3
IF P>BGPEC
QUIT
+21 WRITE BGPX,!
+22 SET BGPX=0
FOR
SET BGPX=$ORDER(BGPONN5(BGPX))
IF BGPX'=+BGPX
QUIT
WRITE BGPONN5(BGPX),!
+23 KILL BGPONN5
ONNC ;close host file
DO ^%ZISC
+1 QUIT
AGEDATE(BIAGRG,BISVDT,BIBEGDT,BIENDDT,BIERR) ;EP
+1 ;---> Given an Age Range in months or years and a Survey Date,
+2 ;---> return the beginning and ending dates in Fileman format.
+3 ;---> Use to search patients by DOB.
+4 ;---> Parameters:
+5 ; 1 - BIAGRG (req) Age Range^Mth/Yr (e.g.,50-64^1)
+6 ; (See description at linelable AGERNG above.)
+7 ; 2 - BISVDT (req) Survey/Forecast Date (date from which to
+8 ; calculate age).
+9 ; 3 - BIBEGDT (ret) Beginning Date.
+10 ; 4 - BIENDDT (ret) Ending Date.
+11 ; 5 - BIERR (ret) Error.
+12 ;
+13 ;---> Set begin and end dates for search through PATIENT File.
+14 IF "ALL"[$GET(BIAGRG)
SET BIBEGDT=0
SET BIENDDT=9999999
QUIT
+15 IF '$GET(BISVDT)
SET BISVDT=$GET(DT)
+16 ;I '$G(BISVDT) S BIBEGDT=0,BIENDDT=9999999 Q
+17 ;S:BISVDT>DT BISVDT=DT
+18 ;
+19 ;---> If X=one age only, set it in the form X-X and quit.
+20 ;---> If Age Range is passed in years, convert to months.
+21 Begin DoDot:1
+22 NEW Y
SET Y=$PIECE(BIAGRG,U)
+23 ;---> If Y=one age only, set it in the form Y-Y.
+24 IF Y?1N.N
SET Y=Y_"-"_Y
+25 IF '$PIECE(BIAGRG,U,2)
SET BIAGRG=Y
QUIT
+26 SET BIAGRG=(12*$PIECE(Y,"-"))_"-"_(12*$PIECE(Y,"-",2)+11)
End DoDot:1
+27 ;
+28 NEW BIAGRG1,BIAGRG2
+29 SET BIAGRG1=+$PIECE(BIAGRG,"-",1)
SET BIAGRG2=+$PIECE(BIAGRG,"-",2)
+30 ;I (BIAGRG1'?1N.N)!(BIAGRG2'?1N.N) D ERRCD^BIUTL2(676,.BIERR) Q
+31 ;
+32 ;D PASTMTH(BISVDT,($P(BIAGRG,"-",2)+1),.BIBEGDT)
+33 DO PASTMTH(BISVDT,(BIAGRG2+1),.BIBEGDT)
+34 ;
+35 ;---> Now, set Beginning Day to be one day AFTER the patient would
+36 ;---> be too old and out of the selected Age Range.
+37 ;---> In other words, come forward one day to include only patients
+38 ;---> whose age is ONE DAY LESS THAN a month (or year) after the
+39 ;---> maximum limit of the selected Age Range.
+40 ;---> For example, Age Range=24-36 includes patients whose age
+41 ;---> is between [24months] and [37months-1day].
+42 NEW X,X1,X2
SET X1=BIBEGDT
SET X2=1
DO C^%DTC
SET BIBEGDT=X
+43 ;
+44 ;D PASTMTH(BISVDT,$P(BIAGRG,"-",1),.BIENDDT)
+45 DO PASTMTH(BISVDT,BIAGRG1,.BIENDDT)
+46 QUIT
+47 ;
+48 ;
+49 ;----------
PASTMTH(BIDTI,BIMTHS,BIDTO,BIYR) ;EP
+1 ;---> Return the date BIMTHS months/years prior the input date.
+2 ;---> Parameters:
+3 ; 1 - BIDTI (req) Date in.
+4 ; 2 - BIMTHS (req) Number of months in the past to calculate.
+5 ; 3 - BIDTO (ret) Date out (BIMTHS prior to BIDTI).
+6 ; 4 - BIYR (opt) If BIYR=1, input is in years; multiply BIMTHSx12.
+7 ;
+8 IF '$GET(BIDTI)
QUIT
+9 IF '$GET(BIMTHS)
SET BIDTO=BIDTI
QUIT
+10 IF $GET(BIYR)=1
SET BIMTHS=(BIMTHS*12)
+11 NEW YYY,MM,DD
+12 SET YYY=$EXTRACT(BIDTI,1,3)
SET MM=+$EXTRACT(BIDTI,4,5)
SET DD=+$EXTRACT(BIDTI,6,7)
+13 Begin DoDot:1
+14 IF MM>BIMTHS
SET MM=MM-BIMTHS
QUIT
+15 NEW I,Q
SET Q=0
+16 FOR I=12:12
Begin DoDot:2
+17 IF BIMTHS-MM<I
SET MM=I-(BIMTHS-MM)
SET YYY=YYY-(I/12)
SET Q=1
End DoDot:2
IF Q
QUIT
End DoDot:1
+18 ;
+19 IF MM<10
SET MM="0"_MM
+20 IF DD<10
SET DD="0"_DD
+21 SET BIDTO=YYY_MM_DD
+22 QUIT
+23 ;
TESTDR ;
TP ;
+1 WRITE !!,"for testing purposes only, please enter DATE RANGE AND YEAR",!
+2 SET (BGPBD,BGPED,BGPTP)=""
+3 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
+4 IF $DATA(DIRUT)
QUIT
+5 SET BGPQTR=Y
+6 IF BGPQTR=5
DO ENDDATE^BGP8DGPU
+7 IF BGPQTR'=5
DO F
+8 IF BGPPER=""
WRITE !,"Year not entered.",!
GOTO TP
+9 IF BGPQTR=1
SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"
SET BGPED=$EXTRACT(BGPPER,1,3)_"1231"
+10 IF BGPQTR=2
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0401"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0331"
+11 IF BGPQTR=3
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0701"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0630"
+12 IF BGPQTR=4
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"1001"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0930"
+13 ;I BGPQTR=5 S D=$$FMADD^XLFDT(BGPPER,1) S BGPBD=($E(BGPPER,1,3)-1)_$E(D,4,7),BGPED=BGPPER,BGPPER=$E(BGPED,1,3)_"0000"
+14 IF BGPQTR=5
Begin DoDot:1
+15 SET D=$$FMADD^XLFDT(BGPPER,1)
+16 IF $EXTRACT(BGPPER,4,7)'=1231
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_$EXTRACT(D,4,7)
SET BGPED=BGPPER
SET BGPPER=$EXTRACT(BGPED,1,3)_"0000"
+17 IF $EXTRACT(BGPPER,4,7)=1231
SET BGPBD=$EXTRACT(BGPPER,1,3)_$EXTRACT(D,4,7)
SET BGPED=BGPPER
SET BGPPER=$EXTRACT(BGPED,1,3)_"0000"
End DoDot:1
+18 IF BGPED>DT
Begin DoDot:1
+19 WRITE !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."
+20 WRITE !,"The end date of this report is in the future; your data will not be",!,"complete.",!
+21 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
+22 IF $DATA(DIRUT)
SET BGPDO=1
QUIT
+23 IF Y
SET BGPDO=1
QUIT
+24 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. 2010"
+3 SET DIR(0)="D^::EP"
+4 SET DIR("A")="Enter Year (e.g. 2010)"
+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 ;W !!,"The date ranges for this report are:"
+17 ;W !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
+18 ;W !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
+19 ;W !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
+20 IF BGPPBD=BGPBBD
IF BGPPED=BGPBED
KILL Y
DO CHKY^BGP8DL
IF Y
KILL BGPBBD,BGPBED,BGPPBD,BGPPED
GOTO BY
+21 QUIT
F ;calendar year
+1 SET (BGPPER,BGPVDT)=""
+2 WRITE !!,"Enter the Calendar Year for the report END date. Use a 4 digit",!,"year, e.g. 2018"
+3 SET DIR(0)="D^::EP"
+4 SET DIR("A")="Enter 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 BGPPER=BGPVDT
+12 QUIT
