h NoMain
h DatFmt(*iso)
h Optimize(*basic)
I* ------------------------------------------------------------------ *
I*APrototype Definitions I*
I* ------------------------------------------------------------------ *
*d/copy HASTONM/QCPYSRC,DATEPROTO
* *** Begin Copy ***
d WeekDay pr n
d InputDate d Const
d DayOfWeek pr 1s 0
d InputDate d Const
d DayName pr 32a Varying
d InputDate d Const
d MonthName pr 32a Varying
d InputDate d Const
d CompleteDate pr 50a
d InputDate d Const
d CheckDates pr n
d DateSix 6 0 Const
d DateEight 8 0 Const
d EndOfMonth pr d
d InputDate d Const
d Month3Upper pr 3a
d InputDate d Const
d Day3Upper pr 3a
d InputDate d Const
d DayOfYear pr 3 0
d InputDate d Const
* *** End Copy ***
I* ------------------------------------------------------------------ *
I*AGlobal Constants and Variables I*
I* ------------------------------------------------------------------ *
d Lower c Const('abcdefghijklmnopqrstuvwxyz')
d Upper c Const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
/eject
I* ------------------------------------------------------------------ *
I*AProcedure - DayOfWeek I*
I*ADescription - Receive an *ISO date field and return the numeric I*
I*A value for that day of week (ie. Sun = 1, Mon = 2...)I*
I*AInput - Input date (*ISO format) I*
I*AOutput - Numeric day of week (1-7) I*
I* ------------------------------------------------------------------ *
p DayOfWeek b Export
d DayOfWeek pi 1s 0
d InputDate d Const
d DayOfWeek s 11s 0
c InputDate subdur d'1998-08-01' DayofWeek:*D
c div 7 DayofWeek
c mvr DayOfWeek
c if DayOfWeek > 0
c return DayOfWeek
c else
c return DayOfWeek + 7
c endif
p DayOfWeek e
/eject
I* ------------------------------------------------------------------ *
I*AProcedure - DayName I*
I*ADescription - Receive an *ISO date field and return the name of I*
I*A the day in mixed case. I*
I*AUses - DayOfWeek I*
I*AInput - Input Date (*ISO date) I*
I*AOutput - Named day of the week I*
I* ------------------------------------------------------------------ *
p DayName b Export
d DayName pi 32a Varying
d InputDate d Const
d ds
d Days 70a Inz('Sunday +
d Monday +
d Tuesday +
d Wednesday +
d Thursday +
d Friday +
d Saturday ')
d Day 10a Dim(7) Overlay(Days)
c return %trim(Day(DayOfWeek(InputDate)))
p DayName e
/eject
I* ------------------------------------------------------------------ *
I*AProcedure - MonthName I*
I*ADescription - Receive an *ISO date field and return the name of I*
I*A its month in mixed case. I*
I*AInput - Input Date (*ISO date) I*
I*AOutput - Name of the month I*
I* ------------------------------------------------------------------ *
p MonthName b Export
d MonthName pi 32a Varying
d InputDate d Const
d Month# s 2 0
d ds
d Months 120a Inz('January +
d February +
d March +
d April +
d May +
d June +
d July +
d August +
d September +
d October +
d November +
d December ')
d Month 10a Dim(12) Overlay(Months)
c extrct InputDate :*M Month#
c return %trim(Month(Month#))
p MonthName e
/eject
I* ------------------------------------------------------------------ *
I*AProcedure - CompleteDate I*
I*ADescription - Receive an *ISO date field and return a full date I*
I*A string. I*
I*AUses - DayName I*
I*A MonthName I*
I*AInput - InputDate (Date field in *ISO format) I*
I*AOutput - Date string (50 characters) I*
I*A (ie. January 1st, 2000) I*
I* ------------------------------------------------------------------ *
p CompleteDate b Export
d CompleteDate pi 50a
d InputDate d Const
d*DayStart s 1s 0
d Suffix s 2a
d TheDay s 2s 0
d TheMonth s 2s 0
d TheYear s 4s 0
c extrct InputDate:*Y TheYear
c extrct InputDate:*M TheMonth
c extrct InputDate:*D TheDay
c* if TheDay < 10
c* eval DayStart = 2
c* else
c* eval DayStart = 1
c* endif
c select
c when ((TheDay > 3) and (TheDay < 21))
c or ((TheDay > 23) and (TheDay < 31))
c eval Suffix = 'th'
c when (TheDay = 1) or (TheDay = 21) or
c (TheDay = 31)
c eval Suffix = 'st'
c when (TheDay = 2) or (TheDay = 22)
c eval Suffix = 'nd'
c when (TheDay = 3) or (TheDay = 23)
c eval Suffix = 'rd'
c endsl
c* return DayName(InputDate) + ' ' +
c return MonthName(InputDate) + ' ' +
c %editc(TheDay : '4') + Suffix + ', ' +
c %editc(TheYear : '4')
p CompleteDate e
/eject
I* ------------------------------------------------------------------ *
I*AProcedure - CheckDates I*
I*ADescription - Compare a six digit and eight digit date I*
I*AInput - DateSix (6,0) and DateEight(8,0) both YMD format I*
I*AOutput - Indicator (*ON if dates match, *OFF otherwise) I*
I* ------------------------------------------------------------------ *
p CheckDates b Export
d CheckDates pi n
d DateSix 6 0 Const
d DateEight 8 0 Const
d ISOdate s d Inz(D'1940-01-01')
d YMDdate s d DatFmt(*YMD)
c *YMD test(e d) DateSix
c if %error
c return *off
c else
c *YMD move DateSix YMDdate
c endif
c *ISO test(e d) DateEight
c if %error
c return *off
c else
c *ISO move DateEight ISOdate
c endif
c return ISOdate = YMDdate
p CheckDates e
/eject
I* ------------------------------------------------------------------ *
I*AProcedure - WeekDay I*
I*ADescription - Receive and eight digit date and return an indicatorI*
I*A (*on = WeekDay / *off = Weekend) I*
I*AUses - DayOfWeek I*
I*AInput - InputDate(8,0) in CCYYMMDD format I*
I*AOutput - Indicator I*
I* ------------------------------------------------------------------ *
p WeekDay b Export
d WeekDay pi n
d InputDate d Const
c if (DayOfWeek(InputDate) = 1) or
c (DayOfWeek(InputDate) = 7)
c return *off
c else
c return *on
c endif
p WeekDay e
/eject
I* ------------------------------------------------------------------ *
I*AProcedure - EndOfMonth I*
I*ADescription - Receive a date and return the last day of the month I*
I*AInput - InputDate(8,0) in CCYYMMDD format I*
I*AOutput - Date set to last day of month I*
I* ------------------------------------------------------------------ *
p EndOfMonth b Export
d EndOfMonth pi d
d InputDate d Const
d NextMth s d
d nDay s 5i 0
d EndDate s d
c InputDate adddur 1:*Months NextMth
c extrct NextMth:*Days nDay
c NextMth subdur nDay:*Days EndDate
c return EndDate
p EndOfMonth e
/eject
I* ------------------------------------------------------------------ *
I*AProcedure - Month3Upper I*
I*ADescription - Receive an *ISO date field and return the upper caseI*
I*A abbreviation of the month. I*
I*AInput - InputDate(8,0) in CCYYMMDD format I*
I*AOutput - Abbreviated name of month (ie. JAN, FEB...) I*
I* ------------------------------------------------------------------ *
p Month3Upper b Export
d Month3Upper pi 3a
d InputDate d Const
d Mixed s 3a
d UpperCase s 3a
c eval Mixed = MonthName(InputDate)
c Lower:Upper xlate Mixed UpperCase
c return UpperCase
p Month3Upper e
/eject
I* ------------------------------------------------------------------ *
I*AProcedure - Day3Upper I*
I*ADescription - Receive an *ISO date field and return the upper caseI*
I*A abbreviation of the month. I*
I*AInput - InputDate(8,0) in CCYYMMDD format I*
I*AOutput - Abbreviated name of month (ie. JAN, FEB...) I*
I* ------------------------------------------------------------------ *
p Day3Upper b Export
d Day3Upper pi 3a
d InputDate d Const
d Mixed s 3a
d UpperCase s 3a
c eval Mixed = DayName(InputDate)
c Lower:Upper xlate Mixed UpperCase
c return UpperCase
p Day3Upper e
/eject
I* ------------------------------------------------------------------ *
I*AProcedure - DayOfYear I*
I*ADescription - Receive an *ISO date field and return the number I*
I*A of the day in the year. I*
I*AInput - *ISO date field I*
I*AOutput - Number 1 - 366 I*
I* ------------------------------------------------------------------ *
p DayOfYear b Export
d DayOfYear pi 3 0
d InputDate d Const
d DayNumber s 3 0
d Year s 4 0
d ds
d December31st d inz(d'2000-12-31')
d YearField 1 4
c extrct InputDate:*Y Year
c move Year YearField
c subdur 1:*y December31st
c InputDate subdur December31st DayNumber : *d
c return DayNumber
p DayOfYear e
|