158 lines
7.0 KiB
COBOL
158 lines
7.0 KiB
COBOL
$SET ans85 noosvs noqual noalter nobell warning(3) noseg align(1)
|
||
WORKING-STORAGE SECTION.
|
||
01 wrk-date.
|
||
03 yymmdd-yy PIC 99.
|
||
03 yymmdd-mm PIC 99.
|
||
03 yymmdd-dd PIC 99.
|
||
01 date-year PIC 99 COMP-X.
|
||
01 date-lyear PIC 99 COMP-X.
|
||
88 leap-year VALUE 1.
|
||
01 am-pm-fld PIC XX.
|
||
01 hh-fld PIC 99.
|
||
01 month-values.
|
||
03 FILLER PIC X(9) VALUE " JANUARY ".
|
||
03 FILLER PIC X(9) VALUE " FEBUARY ".
|
||
03 FILLER PIC X(9) VALUE " MARCH ".
|
||
03 FILLER PIC X(9) VALUE " APRIL ".
|
||
03 FILLER PIC X(9) VALUE " MAY ".
|
||
03 FILLER PIC X(9) VALUE " JUNE ".
|
||
03 FILLER PIC X(9) VALUE " JULY ".
|
||
03 FILLER PIC X(9) VALUE " AUGUST ".
|
||
03 FILLER PIC X(9) VALUE "SEPTEMBER".
|
||
03 FILLER PIC X(9) VALUE " OCTOBER ".
|
||
03 FILLER PIC X(9) VALUE "NOVEMBER ".
|
||
03 FILLER PIC X(9) VALUE "DECEMBER ".
|
||
01 month-value REDEFINES month-values OCCURS 12 PIC X(9).
|
||
01 no-of-days-in-month-table PIC X(24)
|
||
VALUE "312831303130313130313031".
|
||
01 no-of-days-in-month REDEFINES
|
||
no-of-days-in-month-table
|
||
OCCURS 12 PIC 99.
|
||
01 day-flds.
|
||
03 OCCURS 5.
|
||
05 OCCURS 7.
|
||
07 scr-day-fld PIC 99 COMP-X.
|
||
03 day-36 PIC 99 COMP-X.
|
||
03 day-37 PIC 99 COMP-X.
|
||
01 FILLER REDEFINES day-flds.
|
||
03 day-fld OCCURS 37 PIC 99 COMP-X.
|
||
01 hi-flds.
|
||
03 OCCURS 5.
|
||
05 OCCURS 7.
|
||
07 scr-hi-fld PIC X(80).
|
||
03 hi-36 PIC X(80).
|
||
03 hi-37 PIC X(80).
|
||
01 FILLER REDEFINES hi-flds.
|
||
03 hi-fld OCCURS 37 PIC X(80).
|
||
88 highlight-fld VALUE "HIGHLIGHT".
|
||
01 day-of-year-group.
|
||
03 FILLER PIC XX.
|
||
03 day-of-year PIC 999.
|
||
01 day-of-week-fld PIC 99.
|
||
01 time-fld.
|
||
03 time-fld-hh PIC 99.
|
||
03 time-fld-mm PIC 99.
|
||
03 FILLER PIC X(4).
|
||
01 day-index PIC 99 COMP-X.
|
||
01 count-fld PIC 99 COMP-X.
|
||
01 century-fld PIC 99 COMP-X.
|
||
01 non-full-week-days PIC 99 COMP-X.
|
||
01 day-of-month-day-1 PIC 99 COMP-X.
|
||
01 no-of-full-weeks-in-month PIC 99 COMP-X.
|
||
01 current-day-scr-fld-index PIC 99 COMP-X.
|
||
/
|
||
Screen SECTION.
|
||
01 calender-screen.
|
||
03 BLANK screen.
|
||
03 LINE 3 COL 64 PIC Z9 FROM hh-fld.
|
||
03 COL 67 PIC 99 FROM time-fld-mm.
|
||
03 COL 70 PIC XX FROM am-pm-fld.
|
||
03 LINE 5 COL 53 PIC 99 FROM century-fld.
|
||
03 COL 55 PIC 99 FROM yymmdd-yy.
|
||
03 COL 60 PIC X(9) FROM month-value(yymmdd-mm).
|
||
03 COL 72 PIC 99 FROM century-fld.
|
||
03 COL 74 PIC 99 FROM yymmdd-yy.
|
||
03 LINE 7 COL 51.
|
||
03 OCCURS 5.
|
||
05 OCCURS 7.
|
||
07 PIC ZZ FROM scr-day-fld BLANK WHEN ZERO
|
||
CONTROL IS scr-hi-fld.
|
||
07 COL + 3.
|
||
05 LINE + 1 COL - 28.
|
||
03 LINE 12.
|
||
03 COL 51 PIC ZZ FROM day-fld(36) BLANK WHEN ZERO
|
||
CONTROL IS hi-fld(36).
|
||
03 COL 55 PIC ZZ FROM day-fld(37) BLANK WHEN ZERO
|
||
CONTROL IS hi-fld(37).
|
||
03 COL 74 PIC 999 FROM day-of-year.
|
||
03 LINE 3 COL 57 VALUE "Time:".
|
||
03 LINE 3 COL 66 VALUE ":".
|
||
03 LINE 6 COL 52 VALUE "S M T W T F S".
|
||
03 LINE 12 COL 61 VALUE "Day of Year:".
|
||
/
|
||
PROCEDURE DIVISION.
|
||
Calender-Main SECTION.
|
||
PERFORM Init-Date-Manipulation.
|
||
DISPLAY calender-screen.
|
||
Program-Exit.
|
||
EXIT PROGRAM.
|
||
STOP RUN.
|
||
Init-Date-Manipulation.
|
||
INITIALIZE day-flds hi-flds
|
||
ACCEPT wrk-date FROM DATE
|
||
ACCEPT time-fld FROM TIME
|
||
ACCEPT day-of-week-fld FROM DAY-OF-WEEK
|
||
ACCEPT day-of-year-group FROM DAY
|
||
PERFORM Find-Day-1-Of-Month
|
||
PERFORM Set-Time
|
||
PERFORM Set-Century
|
||
PERFORM Set-Day-Flds.
|
||
/
|
||
Find-Day-1-Of-Month.
|
||
DIVIDE yymmdd-dd BY 7 GIVING no-of-full-weeks-in-month
|
||
REMAINDER non-full-week-days
|
||
IF day-of-week-fld < (non-full-week-days - 1)
|
||
ADD 7 TO day-of-week-fld
|
||
END-IF
|
||
COMPUTE day-of-month-day-1 = day-of-week-fld -
|
||
(non-full-week-days - 2)
|
||
IF day-of-month-day-1 > 7
|
||
SUBTRACT 7 FROM day-of-month-day-1
|
||
END-IF.
|
||
Set-Time.
|
||
IF time-fld-hh > 12
|
||
SUBTRACT 12 FROM time-fld-hh GIVING hh-fld
|
||
MOVE "PM" TO am-pm-fld
|
||
ELSE
|
||
MOVE "AM" TO am-pm-fld
|
||
MOVE time-fld-hh TO hh-fld
|
||
END-IF.
|
||
Set-Century.
|
||
IF yymmdd-yy < 88
|
||
MOVE "20" TO century-fld
|
||
ELSE
|
||
MOVE "19" TO century-fld
|
||
END-IF.
|
||
Set-Day-Flds.
|
||
MOVE ZERO TO count-fld
|
||
IF yymmdd-mm = 2
|
||
COMPUTE date-lyear = yymmdd-yy / 4
|
||
COMPUTE date-lyear = date-lyear * 4
|
||
COMPUTE date-year = date-lyear - yymmdd-yy
|
||
COMPUTE date-year = date-year / 4
|
||
IF leap-year
|
||
ADD 1 to no-of-days-in-month(yymmdd-mm)
|
||
END-IF
|
||
END-IF
|
||
PERFORM VARYING DAY-INDEX FROM 1 BY 1 UNTIL DAY-INDEX > 37
|
||
IF day-index >= day-of-month-day-1 and
|
||
< (day-of-month-day-1 +
|
||
no-of-days-in-month(yymmdd-mm))
|
||
ADD 1 TO count-fld
|
||
MOVE count-fld TO day-fld(day-index)
|
||
ELSE
|
||
MOVE ZERO TO day-fld(day-index)
|
||
END-PERFORM
|
||
COMPUTE yymmdd-dd = yymmdd-dd + day-of-month-day-1 - 1
|
||
SET highlight-fld(yymmdd-dd) TO TRUE.
|
||
|