Re: Day of the Week

Mark,

I like your solution.  Although I might have used an overlay table versus 
a compile time table.

If you don't have SQL, (which is a gimmie product with the new Enterprise 
Edition package), then you might like these three subprocedures which we 
keep in a service program:

      /eject
     P     DayOfWeek   B                   EXPORT
      ***** DayOfWeek - Calculates day of week (Monday = 1, Tuesday = 2, 
etc.)
      *               - for any date.
      *               - Input:  WorkDate (Date field in *USA format)
      *               - Result: WorkDay  (Single digit numeric)
     D                 PI             1S 0
     D WorkDate                        D   CONST
     D AnySunday       S               D   INZ(D'04/02/1995')
     D WorkNum         S              7  0
     D WorkDay         S              1S 0


     C     WorkDate      SubDur    AnySunday     WorkNum:*D

     C     WorkNum       Div       7             WorkNum
     C                   MvR                     WorkDay

     C                   If        WorkDay < 1
     C                   Return    WorkDay + 7
     C                   Else
     C                   Return    WorkDay
     C                   EndIf

     P     DayOfWeek   E


      /eject
     P     DayNameL    B                   EXPORT
     D DayNameL        PI             9A
     D  WorkDate                       D   CONST

     D                 DS
     D DayData                       42    Inz('Mon   Tues  Wednes+
     D                                          Thurs Fri   Satur Sun   ')
     D DayArray                       6    Overlay(DayData) Dim(7)

     C                   Return    %TrimR(DayArray(DayOfWeek(WorkDate))) +
     C                             'day'

     P     DayNameL    E


      /eject
     P     DayNameS    B                   EXPORT
     D DayNameS        PI             3A
     D  WorkDate                       D   CONST

     D                 DS
     D DayData                       21    Inz('MonTueWedThuFriSatSun')
     D DayArray                       3    Overlay(DayData) Dim(7)

     C                   Return    %TrimR(DayArray(DayOfWeek(WorkDate)))

     P     DayNameS    E

We keep the following in a standard /copy module:
     D DayOfWeek       PR             1S 0
     D  AnyDate                        D   CONST DATFMT(*USA)

     D DayNameL        PR             9A
     D  AnyDate                        D   CONST DATFMT(*USA)

     D DayNameS        PR             3A
     D  AnyDate                        D   CONST DATFMT(*USA)

 

Rob Berendt
-- 
"They that can give up essential liberty to obtain a little temporary 
safety deserve neither liberty nor safety." 
Benjamin Franklin 




MWalter@xxxxxxxxxxxxxxx
Sent by: rpg400-l-bounces@xxxxxxxxxxxx
02/25/2003 08:13 AM
Please respond to RPG programming on the AS400 / iSeries
 
        To:     RPG programming on the AS400 / iSeries 
<rpg400-l@xxxxxxxxxxxx>
        cc: 
        Fax to: 
        Subject:        Re: Day of the Week



This is the procedure we use:

     Hdatedit(*ymd) nomain
     DgetDOW           PR             9
     D date                           8  0 const
     Darray            S              9    dim(7) ctdata perrcd(1)


     PgetDOW           B                   export
     DgetDOW           PI             9
     D dateIn                         8  0 const

     Didx              S              5i 0
     Ddow              S                   like(getDOW)
     Ddate             S               D   datfmt(*ISO)

     C     *iso          MOVE      dateIn        date

     C/exec sql set :idx = dayofweek(:date)
     C/end-exec

     C                   EVAL      dow = array(idx)
     C                   RETURN    dow
     P                 E

**
Sunday
Monday
Tuesday
Wednesday
Thursday
Friday
Saturday


Thanks,

Mark


Mark Walter
Sr. Programmer/Analyst
Hanover Wire Cloth a div of CCX, Inc.
mwalter@xxxxxxxxxxxxxxx
http://www.hanoverwire.com
717.637.3795 Ext.3040
/"\
\ /
 X
/ \


_______________________________________________
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.