Monday 17 October 2011

RPGLE - Function to get day of the week


    RPGLE  - Function to get day of the week

*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
      * $GetDoW - Get Day of Week
      *            1=Sun, 2=Mon, etc.
      *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
     P$GetDoW          b
     D $GetDoW         pi             3a
     D  InpDate                        d   value
      *
     D DayOfWk         s             11p 0
     D AnySundayDate   s               d   datfmt(*iso)
     D                                     inz(d'1998-08-01')
     D WrkDate         s               d   datfmt(*iso)
     D DoWDesc         s              3    inz(*blanks)
      *
     C                   eval      WrkDate = InpDate
     C                   eval      DayOfWk = %diff(InpDate:AnySundayDate:*days)
     C                   div       7             DayOfWk
     C                   mvr                     DayOfWk
      *
     C                   if        DayOfWk <= 0
     C                   eval      DayOfWk = (DayOfWk + 7)
     C                   endif
      *
     C                   select
     C                   when      DayOfWk = 1
     C                   eval      DoWDesc = 'Sun'
     C                   when      DayOfWk = 2
     C                   eval      DoWDesc = 'Mon'
     C                   when      DayOfWk = 3
     C                   eval      DoWDesc = 'Tue'
     C                   when      DayOfWk = 4
     C                   eval      DoWDesc = 'Wed'
     C                   when      DayOfWk = 5
     C                   eval      DoWDesc = 'Thu'
     C                   when      DayOfWk = 6
     C                   eval      DoWDesc = 'Fri'
     C                   when      DayOfWk = 7
     C                   eval      DoWDesc = 'Sat'
     C                   endsl
      *
     C                   return    DoWDesc
      *
     P$GetDoW          E
      *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

No comments:

Post a Comment