(SUBRG, SIZE, FOFL):
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;