home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l360 / 3.ddi / CALENDAR.@BL / CALENDAR.CBL
Encoding:
Text File  |  1991-06-11  |  7.0 KB  |  158 lines
  1.       $SET ans85 noosvs noqual noalter nobell warning(3) noseg align(1)
  2.        WORKING-STORAGE SECTION.
  3.        01  wrk-date.
  4.            03  yymmdd-yy                   PIC 99.
  5.            03  yymmdd-mm                   PIC 99.
  6.            03  yymmdd-dd                   PIC 99.
  7.        01  date-year                       PIC 99  COMP-X.
  8.        01  date-lyear                      PIC 99  COMP-X.
  9.            88  leap-year                   VALUE 1.
  10.        01  am-pm-fld                       PIC XX.
  11.        01  hh-fld                          PIC 99.
  12.        01  month-values.
  13.            03  FILLER                      PIC X(9)  VALUE " JANUARY ".
  14.            03  FILLER                      PIC X(9)  VALUE " FEBUARY ".
  15.            03  FILLER                      PIC X(9)  VALUE "  MARCH  ".
  16.            03  FILLER                      PIC X(9)  VALUE "  APRIL  ".
  17.            03  FILLER                      PIC X(9)  VALUE "   MAY   ".
  18.            03  FILLER                      PIC X(9)  VALUE "  JUNE   ".
  19.            03  FILLER                      PIC X(9)  VALUE "  JULY   ".
  20.            03  FILLER                      PIC X(9)  VALUE " AUGUST  ".
  21.            03  FILLER                      PIC X(9)  VALUE "SEPTEMBER".
  22.            03  FILLER                      PIC X(9)  VALUE " OCTOBER ".
  23.            03  FILLER                      PIC X(9)  VALUE "NOVEMBER ".
  24.            03  FILLER                      PIC X(9)  VALUE "DECEMBER ".
  25.        01  month-value REDEFINES month-values OCCURS 12 PIC X(9).
  26.        01  no-of-days-in-month-table       PIC X(24)
  27.            VALUE "312831303130313130313031".
  28.        01  no-of-days-in-month REDEFINES
  29.            no-of-days-in-month-table
  30.            OCCURS 12                       PIC 99.
  31.        01  day-flds.
  32.            03  OCCURS 5.
  33.                05  OCCURS 7.
  34.                    07  scr-day-fld         PIC 99      COMP-X.
  35.            03  day-36                      PIC 99      COMP-X.
  36.            03  day-37                      PIC 99      COMP-X.
  37.        01  FILLER REDEFINES day-flds.
  38.            03  day-fld OCCURS 37           PIC 99      COMP-X.
  39.        01  hi-flds.
  40.            03  OCCURS 5.
  41.                05  OCCURS 7.
  42.                    07  scr-hi-fld          PIC X(80).
  43.            03  hi-36                       PIC X(80).
  44.            03  hi-37                       PIC X(80).
  45.        01  FILLER REDEFINES hi-flds.
  46.            03  hi-fld OCCURS 37           PIC X(80).
  47.                88  highlight-fld          VALUE "HIGHLIGHT".
  48.        01  day-of-year-group.
  49.            03  FILLER                      PIC XX.
  50.            03  day-of-year                 PIC 999.
  51.        01  day-of-week-fld                 PIC 99.
  52.        01  time-fld.
  53.            03  time-fld-hh                 PIC 99.
  54.            03  time-fld-mm                 PIC 99.
  55.            03  FILLER                      PIC X(4).
  56.        01  day-index                       PIC 99      COMP-X.
  57.        01  count-fld                       PIC 99      COMP-X.
  58.        01  century-fld                     PIC 99      COMP-X.
  59.        01  non-full-week-days              PIC 99      COMP-X.
  60.        01  day-of-month-day-1              PIC 99      COMP-X.
  61.        01  no-of-full-weeks-in-month       PIC 99      COMP-X.
  62.        01  current-day-scr-fld-index       PIC 99      COMP-X.
  63.       /
  64.        Screen SECTION.
  65.        01  calender-screen.
  66.            03  BLANK screen.
  67.            03  LINE 3 COL 64 PIC Z9 FROM hh-fld.
  68.            03         COL 67 PIC 99 FROM time-fld-mm.
  69.            03         COL 70 PIC XX FROM am-pm-fld.
  70.            03  LINE 5 COL 53 PIC 99 FROM century-fld.
  71.            03         COL 55 PIC 99 FROM yymmdd-yy.
  72.            03         COL 60 PIC X(9) FROM month-value(yymmdd-mm).
  73.            03         COL 72 PIC 99 FROM century-fld.
  74.            03         COL 74 PIC 99 FROM yymmdd-yy.
  75.            03  LINE 7 COL 51.
  76.            03  OCCURS 5.
  77.                05  OCCURS 7.
  78.                    07  PIC ZZ FROM scr-day-fld BLANK WHEN ZERO
  79.                            CONTROL IS scr-hi-fld.
  80.                    07  COL + 3.
  81.                05  LINE + 1 COL - 28.
  82.            03  LINE 12.
  83.            03  COL 51 PIC ZZ FROM day-fld(36) BLANK WHEN ZERO
  84.                CONTROL IS hi-fld(36).
  85.            03  COL 55 PIC ZZ FROM day-fld(37) BLANK WHEN ZERO
  86.                CONTROL IS hi-fld(37).
  87.            03  COL 74 PIC 999 FROM day-of-year.
  88.            03  LINE 3 COL 57 VALUE "Time:".
  89.            03  LINE 3 COL 66 VALUE ":".
  90.            03  LINE 6 COL 52 VALUE "S   M   T   W   T   F   S".
  91.            03  LINE 12 COL 61 VALUE "Day of Year:".
  92.       /
  93.        PROCEDURE DIVISION.
  94.        Calender-Main SECTION.
  95.            PERFORM Init-Date-Manipulation.
  96.            DISPLAY calender-screen.
  97.        Program-Exit.
  98.            EXIT PROGRAM.
  99.            STOP RUN.
  100.        Init-Date-Manipulation.
  101.            INITIALIZE day-flds hi-flds
  102.            ACCEPT wrk-date             FROM DATE
  103.            ACCEPT time-fld             FROM TIME
  104.            ACCEPT day-of-week-fld      FROM DAY-OF-WEEK
  105.            ACCEPT day-of-year-group    FROM DAY
  106.            PERFORM Find-Day-1-Of-Month
  107.            PERFORM Set-Time
  108.            PERFORM Set-Century
  109.            PERFORM Set-Day-Flds.
  110.       /
  111.        Find-Day-1-Of-Month.
  112.            DIVIDE yymmdd-dd BY 7 GIVING no-of-full-weeks-in-month
  113.                   REMAINDER non-full-week-days
  114.            IF day-of-week-fld < (non-full-week-days - 1)
  115.                ADD 7 TO day-of-week-fld
  116.            END-IF
  117.            COMPUTE day-of-month-day-1 = day-of-week-fld -
  118.                                         (non-full-week-days - 2)
  119.            IF day-of-month-day-1 > 7
  120.                SUBTRACT 7 FROM day-of-month-day-1
  121.            END-IF.
  122.        Set-Time.
  123.            IF time-fld-hh > 12
  124.                SUBTRACT 12 FROM time-fld-hh GIVING hh-fld
  125.                MOVE "PM" TO am-pm-fld
  126.            ELSE
  127.                MOVE "AM" TO am-pm-fld
  128.                MOVE time-fld-hh TO hh-fld
  129.            END-IF.
  130.        Set-Century.
  131.            IF yymmdd-yy < 88
  132.                MOVE "20" TO century-fld
  133.            ELSE
  134.                MOVE "19" TO century-fld
  135.            END-IF.
  136.        Set-Day-Flds.
  137.            MOVE ZERO TO count-fld
  138.            IF yymmdd-mm = 2
  139.                COMPUTE date-lyear = yymmdd-yy / 4
  140.                COMPUTE date-lyear = date-lyear * 4
  141.                COMPUTE date-year = date-lyear - yymmdd-yy
  142.                COMPUTE date-year = date-year / 4
  143.                IF leap-year
  144.                    ADD 1 to no-of-days-in-month(yymmdd-mm)
  145.                END-IF
  146.            END-IF
  147.            PERFORM VARYING DAY-INDEX FROM 1 BY 1 UNTIL DAY-INDEX > 37
  148.                IF day-index >= day-of-month-day-1 and
  149.                   < (day-of-month-day-1 +
  150.                     no-of-days-in-month(yymmdd-mm))
  151.                    ADD 1 TO count-fld
  152.                    MOVE count-fld TO day-fld(day-index)
  153.                ELSE
  154.                    MOVE ZERO TO day-fld(day-index)
  155.            END-PERFORM
  156.            COMPUTE yymmdd-dd = yymmdd-dd + day-of-month-day-1 - 1
  157.            SET highlight-fld(yymmdd-dd) TO TRUE.
  158.