COMPILE FUNCTION obj_Calendar(Method,Parms)
/*
	General Calendar Methods
    
	10/28/2004 JCH - Initial Coding
     
    Properties:
     
    Methods:
    
    IRFiscalYear		;* Returns 4 digit IR Fiscal year for date passed in
	IRFiscalWeek		;* Returns 1 or 2 digit IR Fiscal Week for date passed in
	FiscalWeekStartDt	;* Returns starting calendar date f
	DateAddMonths		;* Return date n months from date passed in
*/


DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, Collect.IXVals, Memory_Services
DECLARE SUBROUTINE  Set_Status, Msg, obj_Tables, RList, Send_Dyn, Memory_Services

$INSERT MSG_EQUATES
*$INSERT POPUP_EQUATES
$INSERT FISCAL_YR_EQUATES
$INSERT FISCAL_QTR_EQUATES
$INSERT LOGICAL

EQU FISCAL_ENT_NO$			TO 1
EQU FISCAL_ENT_START_DT$	TO 2
EQU FISCAL_ENT_STOP_DT$		TO 3
EQU FISCAL_ENT_ID$			TO 4	;* YYYY.Q or YYYY.MM or YYYY.WW


ErrTitle = 'Error in Stored Procedure "obj_Calendar"'
ErrorMsg = ''

IF NOT(ASSIGNED(Method))	THEN ErrorMsg = 'Unassigned parameter "Method" passed to subroutine'
IF NOT(ASSIGNED(Parms))		THEN Parms = ''

IF ErrorMsg NE '' THEN
	Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
	RETURN ''
END

Result = ''

BEGIN CASE
	CASE Method = 'CurrDTM'				; GOSUB CurrDTM
	CASE Method = 'IRFiscalYear'		; GOSUB IRFiscalYear
	CASE Method = 'IRFiscalQuarter'		; GOSUB IRFiscalQuarter
	CASE Method = 'IRFiscalMonth'		; GOSUB IRFiscalMonth
	CASE Method = 'IRFiscalWeek'		; GOSUB IRFiscalWeek
 	CASE Method = 'IRFiscalWeek2'		; GOSUB IRFiscalWeek2
	CASE Method = 'DateAddMonths'		; GOSUB DateAddMonths
	CASE MEthod = 'IRYearWeeks'			; GOSUB IRYearWeeks
	CASE Method = 'IRYearMonths'		; GOSUB IRYearMonths
	CASE 1

END CASE

IF ErrorMsg NE '' THEN
	Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
	RETURN ''
END

RETURN Result


* * * * * * *
CurrDTM:
* * * * * * *

CurrDate = OCONV(Date(),'D4/')
CurrTime = OCONV(Time(),'MTS')
CurrDTM = CurrDate:' ':CurrTime

Result = CurrDTM

RETURN


* * * * * * *
IRFiscalYear:
* * * * * * *

    DateIn		= Parms[1,@RM]			;* Always passed in OCONV'd  format
    SkipErrors	= Parms[COL2()+1,@RM]

    If Memory_Services('IsValueExpired', 'IRFiscalyear*' : DateIn, 50, True$) then
        IF NOT(ASSIGNED(DateIn)) THEN DateIn = ''
        IF DateIn = '' THEN RETURN

        thisDateIn = ICONV(DateIn,'D')

        IF thisDateIn = '' THEN
            ErrorMsg = 'Invalid Date ':QUOTE(DateIn):' passed to routine. (':Method:').'
        END

        OPEN 'FISCAL_YR' TO FiscalYrTable ELSE
            ErrMsg = 'Unable to open FISCAL_YR for read in obj_Calendar - IRFiscalYear method.'
            RETURN
        END

        FiscalYrs = Collect.IXVals('FISCAL_YR','FISCAL_YR')

        FiscalYearDates = ''
        FYCnt = COUNT(FiscalYrs,@FM) + (FiscalYrs NE '')
        FOR I = 1 TO FYCnt
            FiscalYr = FiscalYrs<I>
            READ FiscalYrRec FROM FiscalYrTable,FiscalYr else FiscalYrRec = ''
            If FiscalYrRec NE '' then
                FiscalYearDates<1,I,1> = FiscalYr
                FiscalYearDates<1,I,2> = FiscalYrRec<FISCAL_YR_START_DT$>	
            END	;* End of FiscalYr read
        NEXT I

        IF thisDateIn < FiscalYearDates<1,1,2> THEN
            Result = ''
            IF NOT(SkipErrors) THEN
                ErrorMsg = 'Date is earlier than earliest start date.'
            END
            RETURN
        END

        * * * * * * * * * * * * * * * * * * * * * * *

        IF thisDateIn > FiscalYearDates[-1,'B':@SVM] + 365 THEN
            Result = ''
            IF NOT(SkipErrors) THEN
                ErrorMsg = 'Date is later than latest start date plus one year.'
            END
            RETURN
        END

        FOR I = 1 TO COUNT(FiscalYearDates,@VM) + (FiscalYearDates NE '')
        UNTIL thisDateIn < FiscalYearDates<1,I,2>
            Result = FiscalYearDates<1,I,1>
        NEXT I
        Memory_Services('SetValue', 'IRFiscalyear*' : DateIn, Result)
    end else
        Result  = Memory_Services('GetValue', 'IRFiscalyear*' : DateIn)
    end

RETURN


* * * * * * * *
IRFiscalYear2:
* * * * * * * *

    DateIn		= Parms[1,@RM]			;* Always passed in OCONV'd  format
    SkipErrors	= Parms[COL2()+1,@RM]

    If Memory_Services('IsValueExpired', 'IRFiscalyear2*' : DateIn, 50, True$) then
        IF NOT(ASSIGNED(DateIn)) THEN DateIn = ''
        IF DateIn = '' THEN RETURN

        thisDateIn = ICONV(DateIn,'D')

        IF thisDateIn = '' THEN
            ErrorMsg = 'Invalid Date ':QUOTE(DateIn):' passed to routine. (':Method:').'
        END

        OPEN 'FISCAL_YR' TO FiscalYrTable ELSE
            ErrMsg = 'Unable to open FISCAL_YR for read in obj_Calendar - IRFiscalYear method.'
            RETURN
        END

        FiscalYrs = Collect.IXVals('FISCAL_YR','FISCAL_YR')

        FiscalYearDates = ''
        FYCnt = COUNT(FiscalYrs,@FM) + (FiscalYrs NE '')
        FOR I = 1 TO FYCnt
            FiscalYr = FiscalYrs<I>
            READ FiscalYrRec FROM FiscalYrTable,FiscalYr else FiscalYrRec = ''
            If FiscalYrRec NE '' then
                FiscalYearDates<1,I,1> = FiscalYr
                FiscalYearDates<1,I,2> = FiscalYrRec<FISCAL_YR_START_DT$>	
            END	;* End of FiscalYr read
        NEXT I

        IF thisDateIn < FiscalYearDates<1,1,2> THEN
            Result = ''
            IF NOT(SkipErrors) THEN
                ErrorMsg = 'Date is earlier than earliest start date.'
            END
            RETURN
        END

        * * * * * * * * * * * * * * * * * * * * * * *

        IF thisDateIn > FiscalYearDates[-1,'B':@SVM] + 365 THEN
            Result = ''
            IF NOT(SkipErrors) THEN
                ErrorMsg = 'Date is later than latest start date plus one year.'
            END
            RETURN
        END

        FOR I = 1 TO COUNT(FiscalYearDates,@VM) + (FiscalYearDates NE '')
        UNTIL thisDateIn < FiscalYearDates<1,I,2>
            Result = FiscalYearDates<1,I,1>
        NEXT I
        Memory_Services('SetValue', 'IRFiscalyear2*' : DateIn, Result)
    end else
        Result  = Memory_Services('GetValue', 'IRFiscalyear2*' : DateIn)
    end

RETURN



* * * * * * *
IRFiscalQuarter:
* * * * * * *

DateIn = Parms[1,@RM]		;* Always passed in OCONV'd  format

IF NOT(ASSIGNED(DateIn)) THEN DateIn = ''
IF DateIn = '' THEN RETURN

GOSUB IRFiscalYear

CurrYear = Result
Result = ''

thisDateIn = ICONV(DateIn,'D')

IF thisDateIn = '' THEN RETURN			;* Bad date passed in

FYRec = XLATE('FISCAL_YR',CurrYear,'','X')

QtrKeys = FYRec<FISCAL_YR_FISCAL_QTR_KEY$>

qCnt = COUNT(QtrKeys,@VM) + (QtrKeys NE '')


QuarterNo = ''

FOR I = 1 TO qCnt
	FQKey	= FYRec<FISCAL_YR_FISCAL_QTR_KEY$,I>
	FQRec	= XLATE('FISCAL_QTR',FQKey,'','X')
	
	QuarterStartDt	= FQRec<FISCAL_QTR_START_DT$>
	QuarterEndDt	= FQRec<FISCAL_QTR_END_DT$>
	IF thisDateIn >= QuarterStartDt AND thisDateIn <= QuarterEndDt THEN
		QuarterNo = I
	END
	
UNTIL QuarterNo NE ''	
NEXT I

Result = QuarterNo:@FM:OCONV(QuarterStartDt,'D4/'):@FM:OCONV(QuarterEndDt,'D4/'):@FM:CurrYear:'.':QuarterNo

RETURN



* * * * * * *
IRFiscalMonth:
* * * * * * *

DateIn = Parms[1,@RM]		;* Always passed in OCONV'd  format

IF NOT(ASSIGNED(DateIn)) THEN DateIn = ''
IF DateIn = '' THEN RETURN

thisDateIn = ICONV(DateIn,'D')

IF thisDateIn = '' THEN RETURN			;* Bad date passed in

GOSUB IRFiscalYear

FiscalYear = Result
Result = ''

MonthConvFlag = 1	;* Get month data in internal format

GOSUB IRYearMonths

MonthNos		= Result<1>
MonthStartDts	= Result<2>
MonthEndDts		= Result<3>

Result = ''

FOR MonthNo = 1 TO 12

	MonthStartDt	= MonthStartDts<1,MonthNo>
	MonthEndDt		= MonthEndDts<1,MonthNo>
	
	IF thisDateIn >= MonthStartDt AND thisDateIn <= MonthEndDt THEN
		Result = MonthNo:@FM:OCONV(MonthStartDt,'D4/'):@FM:OCONV(MonthEndDt,'D4/'):@FM:FiscalYear:'.':FMT(MonthNo,'R(0)#2')
		RETURN
	END
NEXT MonthNo

RETURN

/*

Delta = thisDateIn - FYStartDate
QuarterNo = INT(Delta/91) + 1
WeekNo = INT(Delta/7) + 1

IF QuarterNo = 1 THEN
	BEGIN CASE
		CASE WeekNo >= 9
			MonthNo = 3
			MonthStartDt = FYStartDate + ((9-1) * 7)
			MonthEndDt = MonthStartDt + 34
			
		CASE WeekNo >= 5
			MonthNo = 2
			MonthStartDt = FYStartDate + ((5-1) * 7)
			MonthEndDt = MonthStartDt + 27
			
		CASE WeekNo >= 1
			MonthNo = 1
			MonthStartDt = FYStartDate
			MonthEndDt = MonthStartDt + 27
			
	END CASE
END

IF QuarterNo = 2 THEN
	BEGIN CASE
		CASE WeekNo >= 22
			MonthNo = 6
			MonthStartDt = FYStartDate + ((22-1) * 7)
			MonthEndDt = MonthStartDt + 34
			
		CASE WeekNo >= 18
			MonthNo = 5
			MonthStartDt = FYStartDate + ((18-1) * 7)
			MonthEndDt = MonthStartDt + 27
			
		CASE WeekNo >= 14
			MonthNo = 4
			MonthStartDt = FYStartDate + ((14-1) * 7)
			MonthEndDt = MonthStartDt + 27
			
	END CASE
END

		
IF QuarterNo = 3 THEN
	BEGIN CASE
		CASE WeekNo >= 35
			MonthNo = 9
			MonthStartDt = FYStartDate + ((35-1) * 7)
			MonthEndDt = MonthStartDt + 34
			
		CASE WeekNo >= 31
			MonthNo = 8
			MonthStartDt = FYStartDate + ((31-1) * 7)
			MonthEndDt = MonthStartDt + 27
			
		CASE WeekNo >= 27
			MonthNo = 7
			MonthStartDt = FYStartDate + ((27-1) * 7)
			MonthEndDt = MonthStartDt + 27
			
	END CASE
END


IF QuarterNo = 4 THEN
	BEGIN CASE
		CASE WeekNo >= 48
			MonthNo = 12
			MonthStartDt = FYStartDate + ((48-1) * 7)
			MonthEndDt = MonthStartDt + 34
			
		CASE WeekNo >= 44
			MonthNo = 11
			MonthStartDt = FYStartDate + ((44-1) * 7)
			MonthEndDt = MonthStartDt + 27
			
		CASE WeekNo >= 40
			MonthNo = 10
			MonthStartDt = FYStartDate + ((40-1) * 7)
			MonthEndDt = MonthStartDt + 27
			
	END CASE
END


Result = MonthNo:@FM:OCONV(MonthStartDt,'D4/'):@FM:OCONV(MonthEndDt,'D4/'):@FM:CurrYear:'.':FMT(MonthNo,'R(0)#2')

*/



RETURN


* * * * * * *
IRFiscalWeek:
* * * * * * *

DateIn = Parms[1,@RM]		;* Always passed in OCONV'd  format

IF NOT(ASSIGNED(DateIn)) THEN DateIn = ''
IF DateIn = '' THEN RETURN

thisDateIn = ICONV(DateIn,'D')

IF thisDateIn = '' THEN RETURN			;* Bad date passed in

GOSUB IRFiscalYear

CurrYear = Result
Result = ''

FYStartDate = XLATE('FISCAL_YR',CurrYear,1,'X')

Delta = thisDateIn - FYStartDate
WeekNo = INT(Delta/7) + 1
WeekStartDt = FYStartDate + ((WeekNo - 1) * 7)
WeekEndDt	= WeekStartDt + 6

Result = WeekNo:@FM:OCONV(WeekStartDt,'D4/'):@FM:OCONV(WeekEndDt,'D4/'):@FM:CurrYear:'.':FMT(WeekNo,'R(0)#2')

RETURN


* * * * * * *
IRFiscalWeek2:
* * * * * * *

DateIn = Parms[1,@RM]		;* Always passed in OCONV'd  format

IF NOT(ASSIGNED(DateIn)) THEN DateIn = ''
IF DateIn = '' THEN RETURN

thisDateIn = ICONV(DateIn,'D')

IF thisDateIn = '' THEN RETURN			;* Bad date passed in

GOSUB IRFiscalYear

CurrYear = Result
Result = ''

FYStartDate = XLATE('FISCAL_YR',CurrYear,1,'X') - 2

Delta = thisDateIn - FYStartDate
WeekNo = INT(Delta/7) + 1
WeekStartDt = (FYStartDate) + ((WeekNo - 1) * 7)
WeekEndDt	= WeekStartDt + 6

Result = WeekNo:@FM:OCONV(WeekStartDt,'D4/'):@FM:OCONV(WeekEndDt,'D4/'):@FM:CurrYear:'.':FMT(WeekNo,'R(0)#2')

RETURN


* * * * * * * 
DateAddMonths:
* * * * * * *

DateIn = Parms[1,@RM]			;* Date passed in internal format
Months = Parms[COL2()+1,@RM]

* Called from dictionary - don't throw any errors just return

IF DateIn = '' THEN RETURN
IF Months = '' THEN RETURN


IF NOT(NUM(DateIn)) THEN RETURN			;* Bad format on date
IF NOT(NUM(Months))		THEN RETURN		;* Bad months parm

Result = DateIn + OCONV((Months*(365.25/12)),'MD0')


RETURN


* * * * * * *
IRYearWeeks:
* * * * * * *

IF NOT(Assigned(FiscalYear)) THEN
	FiscalYear = Parms[1,@RM]
END

IF NOT(ASSIGNED(NoConvFlag)) THEN
	NoConvFlag = Parms[COL2()+1,@RM]
END

IF NOT(NUM(FiscalYear)) = '' THEN RETURN	;* Bad format

IF FiscalYear = '' THEN RETURN

WeekNos = ''
MonthNos = ''
QtrNos = ''

YearRec = XLATE('FISCAL_YR',FiscalYear,'','X')

FYStartDt	= YearRec<FISCAL_YR_START_DT$>
FYWeeks		= YearRec<FISCAL_YR_WEEKS_IN_YEAR$>

FYQtrKeys = YearRec<FISCAL_YR_FISCAL_QTR_KEY$>

fqCnt = COUNT(FYQtrKeys,@VM) + ( FYQtrKeys NE '' )

QtrStartDts = XLATE('FISCAL_QTR',FYQtrKeys,FISCAL_QTR_START_DT$,'X')
QtrEndDts	= XLATE('FISCAL_QTR',FYQtrKeys,FISCAL_QTR_END_DT$,'X')

WeekStartDts	= ''
WeekEndDts		= ''

FOR WeekNo = 1 TO FYWeeks
	WeekNos<1,WeekNo> = WeekNo
	WeekStartDt = FYStartDt + ((WeekNo - 1) * 7)
	WeekEndDt = WeekStartDt + 6
	
	WeekStartDts<1,WeekNo>	= WeekStartDt
	WeekEndDts<1,WeekNo>	= WeekEndDt 
	
	BEGIN CASE
		CASE WeekNo <= 13	; Qtr = 1
		CASE WeekNo <= 26	; Qtr = 2
		CASE WeekNo <= 39	; Qtr = 3
		CASE WeekNo <= 52	; Qtr = 4
		CASE 1				; Qtr = 5
	END CASE
	
	IF WeekNo =  1 THEN	MonthNos<1,WeekNo> = 1
	IF WeekNo =  5 THEN MonthNos<1,WeekNo> = 2
	IF WeekNo =  9 THEN MonthNos<1,WeekNo> = 3
	
	IF WeekNo = 14 THEN MonthNos<1,WeekNo> = 4
	IF WeekNo = 18 THEN MonthNos<1,WeekNo> = 5
	IF WeekNo = 22 THEN MonthNos<1,WeekNo> = 6
	
	IF WeekNo = 27 THEN MonthNos<1,WeekNo> = 7
	IF WeekNo = 31 THEN MonthNos<1,WeekNo> = 8
	IF WeekNo = 35 THEN MonthNos<1,WeekNo> = 9
	
	IF WeekNo = 40 THEN MonthNos<1,WeekNo> = 10
	IF WeekNo = 44 THEN MonthNos<1,WeekNo> = 11
	
	IF fqCnt = 4 THEN
	
		IF FYWeeks = 53 THEN
			IF WeekNo = 49 THEN MonthNos<1,WeekNo> = 12		;* This makes Month 11 5 weeks long (in addition to Month 12
		END ELSE
			IF WeekNo = 48 THEN MonthNos<1,WeekNo> = 12		;* This makes Month 11 4 weeks long and Month 12 is 5 weeks
		END
	
	END
	
	IF fqCnt = 5 THEN
	
		IF WeekNo = 48 THEN MonthNos<1,WeekNo> = 12
		
		IF WeekNo = 53 THEN MonthNos<1,WeekNo> = 13
		IF WeekNo = 57 THEN MonthNos<1,WeekNo> = 14
		IF WeekNo = 61 THEN MonthNos<1,WeekNo> = 15
	
	
	END
	
	
	IF WeekStartDt = QtrStartDts<1,Qtr> THEN QtrNos<1,WeekNo> = Qtr
	
	*Send_Dyn(WeekStartDt:' ':QtrStartDts<1,Qtr>:' ':Qtr)
		
NEXT WeekNo

IF NoConvFlag ELSE
	WeekStartDts = OCONV(WeekStartDts,'D4/')
	WeekEndDts = OCONV(WeekEndDts,'D4/')
END

Result = WeekNos:@FM:WeekStartDts:@FM:WeekEndDts:@FM:MonthNos:@FM:QtrNos

RETURN




* * * * * * *
IRYearMonths:
* * * * * * * 

IF NOT(Assigned(FiscalYear)) THEN
	FiscalYear = Parms[1,@RM]
END

IF NOT(Assigned(MonthConvFlag)) THEN 
	MonthConvFlag = Parms[COL2()+1,@RM]
END

IF NOT(NUM(FiscalYear)) = '' THEN RETURN	;* Bad format

IF FiscalYear = '' THEN RETURN

MonthNos = ''
MonthStartDts = ''
MonthEndDts = ''

YearRec = XLATE('FISCAL_YR',FiscalYear,'','X')

FYStartDt	= YearRec<FISCAL_YR_START_DT$>
FYWeeks		= YearRec<FISCAL_YR_WEEKS_IN_YEAR$>

FYQtrKeys = YearRec<FISCAL_YR_FISCAL_QTR_KEY$>

QtrStartDts = XLATE('FISCAL_QTR',FYQtrKeys,FISCAL_QTR_START_DT$,'X')
QtrEndDts	= XLATE('FISCAL_QTR',FYQtrKeys,FISCAL_QTR_END_DT$,'X')

WeekStartDts	= ''
WeekEndDts		= ''

FOR WeekNo = 1 TO FYWeeks
	WeekStartDts<WeekNo> = FYStartDt + ((WeekNo - 1) * 7)
	
	BEGIN CASE
		CASE WeekNo <= 13	; Qtr = 1
		CASE WeekNo <= 27	; Qtr = 2
		CASE WeekNo <= 39	; Qtr = 3
		CASE 1				; Qtr = 4
	END CASE
	
	IF WeekNo =  1 THEN MonthStartDts<1,1> = WeekStartDts<WeekNo>
	IF WeekNo =  5 THEN MonthStartDts<1,2> = WeekStartDts<WeekNo>
	IF WeekNo =  9 THEN MonthStartDts<1,3> = WeekStartDts<WeekNo>
	IF WeekNo = 14 THEN MonthStartDts<1,4> = WeekStartDts<WeekNo>
	IF WeekNo = 18 THEN MonthStartDts<1,5> = WeekStartDts<WeekNo>
	IF WeekNo = 22 THEN MonthStartDts<1,6> = WeekStartDts<WeekNo>
	IF WeekNo = 27 THEN MonthStartDts<1,7> = WeekStartDts<WeekNo>
	IF WeekNo = 31 THEN MonthStartDts<1,8> = WeekStartDts<WeekNo>
	IF WeekNo = 35 THEN MonthStartDts<1,9> = WeekStartDts<WeekNo>
	IF WeekNo = 40 THEN MonthStartDts<1,10> = WeekStartDts<WeekNo>
	IF WeekNo = 44 THEN MonthStartDts<1,11> = WeekStartDts<WeekNo>
	
	IF FYWeeks = 53 THEN
		IF WeekNo = 49 THEN MonthStartDts<1,12> = WeekStartDts<WeekNo>
	END ELSE
		IF WeekNo = 48 THEN MonthStartDts<1,12> = WeekStartDts<WeekNo>
	END
	
NEXT WeekNo


FOR I = 1 TO 12
	MonthNos<1,I> = I
	IF I < 12 THEN
		MonthEndDts<1,I> = MonthStartDts<1,I+1> - 1
	END ELSE
		MonthEndDts<1,I> = QtrEndDts<1,4>
	END
NEXT I

IF MonthConvFlag NE 1 THEN
	MonthStartDts = OCONV(MonthStartDts,'D4/')
	MonthEndDts = OCONV(MonthEndDts,'D4/')
END

Result = MonthNos:@FM:MonthStartDts:@FM:MonthEndDts

RETURN