|
This is a multi-part message in MIME format. -- If you search you should find oodles of DayOfWeek code...I've attached some also. -----Original Message----- From: Weeks, Glenn [mailto:GWeeks@Sallybeauty.com] Sent: Tuesday, December 10, 2002 5:27 PM To: 'rpg400-l@midrange.com' Subject: Day of the week If I know the date, 20021215 for instance, is there an easy way to determine the day of the week, (Monday, Tuesday, etc..). I cannot find an example of this in any of the documentation that we have or any online documentaion. Any help would be appreciated. Thanks,. Glen Weeks Ex. 7771 -- Content-Description: date_procedures.txt /title DATEPROCS - Standard date API functions ********************************************************************** * * * Compile Notes: These procedures are part of a *SRVPGM. * * If modifications are done to this module in the * * future, it will have to be first compiled as a * * *MODULE and then either created or updated. * * * * Use OPT 15 to create the module which gives you this command: * * * * CRTRPGMOD OBJ(LIB/DATEPROCS) * * SRCFILE(LIB/FILE) * * SRCMBR(DATEPROCS) * * OBJTYPE(*MODULE) * * DBGVIEW(*SOURCE) * * * * Then update the service program: * * * * UPDSRVPGM SRVPGM(LIB/DATEPROCS) * * MODULE(LIB/DATEPROCS) * * EXPORT(*ALL) * * * ********************************************************************** * Description.. Standard date API functions * * Program Name. DATEPROCS * * * * Performs many common functions to work with dates and date * * strings within an RPGIV program. * ********************************************************************** h noMain h datFmt( *iso ) h optimize( *full ) ********************************************************************** *Prototype Definitions * ********************************************************************** d/copy jplpgm/acscpy,dateproto ********************************************************************** *Global constants and Variables * ********************************************************************** d lo c const('abcdefghijklmnopqrstuvwxyz') d up c const('ABCDEFGHIJKLMNOPQRSTUVWXYZ') d today s d inz( *job ) /eject ********************************************************************** *Procedure - #dayOfWeek * *Description - Receive an *ISO date field and return the numeric * * value for that day of week (ie. Sun = 1, Mon = 2...)* *Input - Input date (*ISO format) * *Output - Numeric day of week (1-7) * ********************************************************************** 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 ********************************************************************** *Procedure - #dayName * *Description - Receive an *ISO date field and return the name of * * the day in mixed case. * *Uses - #dayOfWeek * *Input - Input date (*ISO date) * *Output - Named day of the week * ********************************************************************** 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 ********************************************************************** *Procedure - #monthName * *Description - Receive an *ISO date field and return the name of * * its month in mixed case. * *Input - Input date (*ISO date) * *Output - Name of the month * ********************************************************************** 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 ********************************************************************** *Procedure - #completeDate * *Description - Receive an *ISO date field and return a full date * * string. * *Uses - #dayName * * #monthName * *Input - inputDate (date field in *ISO format) * *Output - date string (50 characters) * * (ie. January 1st, 2000) * ********************************************************************** p #completeDate b export d #completeDate pi 50a d inputDate d const 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 select c when ((theDay > 3) and (theDay < 21)) or c ((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 #monthName( inputDate ) + ' ' + c*** no suffix *** %editc(theDay : '4') + suffix + ', ' + c %editc(theDay : '4') + ', ' + c %editc(theYear : '4') p #completeDate e /eject ********************************************************************** *Procedure - #checkDates * *Description - Compare a six digit and eight digit date * *Input - dateSix (6,0) and dateEight(8,0) both YMD format * *Output - Indicator (*ON if dates match, *OFF otherwise) * ********************************************************************** 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 ********************************************************************** *Procedure - #weekDay * *Description - Receive and eight digit date and return an indicator* * (*on = weekDay / *off = Weekend) * *Uses - #dayOfWeek * *Input - *ISO date field * *Output - Indicator * ********************************************************************** 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 ********************************************************************** *Procedure - #endOfMonth * *Description - Receive a date and return the last day of the month * *Input - *ISO date field * *Output - date set to last day of month * ********************************************************************** 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 ********************************************************************** *Procedure - #month3Upper * *Description - Receive an *ISO date field and return the up case* * abbreviation of the month. * *Input - *ISO date field * *Output - Abbreviated name of month (ie. JAN, FEB...) * ********************************************************************** p #month3Upper b export d #month3Upper pi 3a d inputDate d const /free return %xlate( lo : up : #monthName( inputDate ) ); /end-free p #month3Upper e /eject ********************************************************************** *Procedure - #day3Upper * *Description - Receive an *ISO date field and return the up case* * abbreviation of the month. * *Input - *ISO date field * *Output - Abbreviated name of month (ie. JAN, FEB...) * ********************************************************************** p #day3Upper b export d #day3Upper pi 3a d inputDate d const /free return %xlate( lo : up : #dayName( inputDate ) ); /end-free p #day3Upper e /eject ********************************************************************** *Procedure - #dayOfYear * *Description - Receive an *ISO date field and return the number * * of the day in the year. * *Input - *ISO date field * *Output - Number 1 - 366 * ********************************************************************** 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 /eject ********************************************************************** *Procedure - #weekOfYear * *Description - Receive an *ISO date field and return the number * * of the week of the year. * *Input - *ISO date field * *Output - Number 1 - 52. * ********************************************************************** p #weekOfYear b export d #weekOfYear pi 2 0 d inputDate d const /free return %div( #dayOfYear( inputDate ) : 7 ) + 1; /end-free p #weekOfYear e /eject ********************************************************************** *Procedure - #getPrvWkStart * *Description - Receive an *ISO date field and return the *ISO date * * field containing the start date of the previous week* *Uses proc - #getPrvWkEnd * *Input - *ISO date field * *Output - *ISO date field * ********************************************************************** p #getPrvWkStart b export d #getPrvWkStart pi d d inputDate d const c return #getPrvWkEnd( inputDate ) - %days( 6 ) p #getPrvWkStart e /eject ********************************************************************** *Procedure - #getPrvWkEnd * *Description - Receive an *ISO date field and return the *ISO date * * field containing the end date of the previous week * *Uses proc - #dayOfWeek * *Input - *ISO date field * *Output - *ISO date field * ********************************************************************** p #getPrvWkEnd b export d #getPrvWkEnd pi d d inputDate d const d i s 1s 0 d saturday s 1s 0 inz(7) d workdate s d /free workdate = inputDate; for i = 1 to 7; workdate = workdate - %days( 1 ); if #dayOfWeek( workdate ) = saturday; return workdate; endif; endfor; /end-free p #getPrvWkEnd e /eject ********************************************************************** *Procedure - #getWkEndDate * *Description - Receive an *ISO date field and return the *ISO date * * field containing the end date for that week. * *Uses proc - #dayOfWeek * *Input - *ISO date field * *Output - *ISO date field * ********************************************************************** p #getWkEndDate b export d #getWkEndDate pi d d inputDate d const d i s 1s 0 d saturday s 1s 0 inz(7) d workdate s d /free workdate = inputDate; for i = 1 to 7; if #dayOfWeek( workdate ) = saturday; return workdate; else; workdate = workdate + %days( 1 ); endif; endfor; /end-free p #getWkEndDate e /eject ********************************************************************** *Procedure - #getWkStrDate * *Description - Receive an *ISO date field and return the *ISO date * * field containing the end date for the current week. * *Uses proc - #dayOfWeek * *Input - *ISO date field * *Output - *ISO date field * ********************************************************************** p #getWkStrDate b export d #getWkStrDate pi d d inputDate d const d i s 1s 0 d sunday s 1s 0 inz(1) d workdate s d /free workdate = inputDate; for i = 1 to 7; if #dayOfWeek( workdate ) = sunday; return workdate; else; workdate = workdate - %days( 1 ); endif; endfor; /end-free p #getWkStrDate e -- Content-Description: date_prototypes.txt * ------------------------------------------------------------------ * * Prototype Definitions * * ------------------------------------------------------------------ * 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 d #weekOfYear pr 2 0 d inputDate d const d #getPrvWkStart pr d d inputDate d const d #getPrvWkEnd pr d d inputDate d const d #getWkEndDate pr d d inputDate d const d #getWkStrDate pr d d inputDate d const
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
midrange.com
