IBM Mainframe Forum

#! /usr/bin/rexx

/* REXX
      y         year
      d         day
      w       week

      s         date sorted   yyyymmdd
      b         date base   ( as per rexx definition 0 = monday/00010101 )

      fwky      procedure,
            returns the base date of the monday of the first week of a year
            the week containin the thursday

      iso1      procedure,
            format the iso date appropriately

*/

parse arg s k
if k = "" then k = 1

f = date("b",right(s,4,"0") || "0101", "S")
t = date("b",right(s+k,4,"0") || "0101", "S" ) - 1

do   b  = f to t
   s = date("S",b,"B")
   i = date2iso(s)
   if   s \=  iso2date(i) then do
         say "error for" b s i
         exit
   end
   if   k = 1 then ,
         say s b i
end

exit

date2iso : procedure
   parse arg s
   b = date("B", s, "S")
   y = left(s, 4 )

   /* the easy one first */
   if   b >= fwky(y+1 ) then ,
       return iso1(y+1, 1, b // 7 + 1 )

      if   b >= fwky(y ) then do
         w = b % 7 - fwky(y ) % 7 + 1
         return iso1(y, w, b // 7 + 1 )
      end

      w = b % 7 - fwky(y-1 ) % 7 + 1
      return iso1(y-1, w, b // 7 + 1 )

iso1: procedure
      parse arg y, w, d
      return right(y, 4, "0" ) || "W" || right(w, 2, "0" ) || d

iso2date:procedure
      parse arg i
      parse var i with 1 y 5 . 6 w 8 d
      b = fwky(y ) + (w - 1 )*7 + d - 1
      return date("S", b, "B")

fwky: procedure
      /* base date of the first week of the year */
      parse arg y
      w = date("b", right(y, 4, "0" ) || "01" || "01", "s" )
      d = w // 7 + 1
      if   d <= 4 then ,
       return w + 1 - d
      else ,
       return w + 1 - d + 7