calendar: procedure (year) options (main);
   declare year character (4) varying;
   declare (a, b, c) (0:5,0:6) character (3);
   declare name_month(12) static character (9) varying initial (
      'JANUARY', 'FEBRUARY', 'MARCH',     'APRIL',   'MAY',      'JUNE',
      'JULY',    'AUGUST',   'SEPTEMBER', 'OCTOBER', 'NOVEMBER', 'DECEMBER');
   declare i fixed;
   declare (mm, mmp1, mmp2) pic '99';

   put edit (center('CALENDAR FOR ' || YEAR, 67)) (a);
   put skip (2);

   do mm = 1 to 12 by 3;
      mmp1 = mm + 1; mmp2 = mm + 2;
      call prepare_month('01' || mm   || YEAR, a);
      call prepare_month('01' || mmp1 || YEAR, b);
      call prepare_month('01' || mmp2 || YEAR, c);

      put skip edit (center(name_month(mm),   23),
                     center(name_month(mmp1), 23),
                     center(name_month(mmp2), 23) ) (a);
      put skip edit ((3)'  M  T  W  T  F  S  S  ') (a);
      do i = 0 to 5;
         put skip edit (a(i,*), b(i,*), c(i,*)) (7 a, x(2));
      end;
   end;

prepare_month: procedure (start, month);
   declare month(0:5,0:6) character (3);
   declare start character (8);
   declare i pic 'ZZ9';
   declare offset fixed;
   declare (j, day) fixed binary (31);
   declare (this_month, next_month, k) fixed binary;

   day = days(start, 'DDMMYYYY');
   offset = weekday(day) - 1;
   if offset  = 0 then offset = 7;
   month = '';
   do j = day by 1;
      this_month = substr(daystodate(j,   'DDMMYYYY'), 3, 2);
      next_month = substr(daystodate(j+1, 'DDMMYYYY'), 3, 2);
      if this_month^= next_month then leave;
   end;
   i = 1;
   do k = offset-1 to offset+j-day-1;
      month(k/7, mod(k,7)) = i; i = i + 1;
   end;
end prepare_month;

end calendar;