open-insight/LSL2/STPROC/OBJ_CALENDAR.txt
Infineon\StieberD 7762b129af pre cutover push
2024-09-04 20:33:41 -07:00

667 lines
16 KiB
Plaintext

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