× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



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 thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 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.