226 lines
8.6 KiB
COBOL
226 lines
8.6 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. CALEND.
|
|
ENVIRONMENT DIVISION.
|
|
INPUT-OUTPUT SECTION.
|
|
DATA DIVISION.
|
|
|
|
WORKING-STORAGE SECTION.
|
|
01 WS-DAY-NAMES-DEF.
|
|
03 FILLER PIC X(09) VALUE 'SUNDAY '.
|
|
03 FILLER PIC X(09) VALUE 'MONDAY '.
|
|
03 FILLER PIC X(09) VALUE 'TUESDAY '.
|
|
03 FILLER PIC X(09) VALUE 'WEDNESDAY'.
|
|
03 FILLER PIC X(09) VALUE 'THURSDAY '.
|
|
03 FILLER PIC X(09) VALUE 'FRIDAY '.
|
|
03 FILLER PIC X(09) VALUE 'SATURDAY '.
|
|
01 FILLER REDEFINES WS-DAY-NAMES-DEF.
|
|
03 WS-DAY-NAME PIC X(09) OCCURS 07 TIMES.
|
|
|
|
01 WS-MTH-INFO-DEF.
|
|
03 FILLER PIC X(11) VALUE 'JANUARY 31'.
|
|
03 FILLER PIC X(11) VALUE 'FEBRUARY 28'.
|
|
03 FILLER PIC X(11) VALUE 'MARCH 31'.
|
|
03 FILLER PIC X(11) VALUE 'APRIL 30'.
|
|
03 FILLER PIC X(11) VALUE 'MAY 31'.
|
|
03 FILLER PIC X(11) VALUE 'JUNE 30'.
|
|
03 FILLER PIC X(11) VALUE 'JULY 31'.
|
|
03 FILLER PIC X(11) VALUE 'AUGUST 31'.
|
|
03 FILLER PIC X(11) VALUE 'SEPTEMBER30'.
|
|
03 FILLER PIC X(11) VALUE 'OCTOBER 31'.
|
|
03 FILLER PIC X(11) VALUE 'NOVEMBER 30'.
|
|
03 FILLER PIC X(11) VALUE 'DECEMBER 31'.
|
|
01 FILLER REDEFINES WS-MTH-INFO-DEF.
|
|
03 WS-MTH-INFO-TABLE OCCURS 12 TIMES.
|
|
05 WS-MTH-INFO-NAME PIC X(09).
|
|
05 WS-MTH-INFO-DAYS PIC 9(02).
|
|
|
|
01 WS-MTH-AREA.
|
|
03 WS-MTH-DD PIC S99.
|
|
03 WS-DAY1 PIC 9.
|
|
03 WS-DAYS PIC 99.
|
|
03 WS-DD PIC 9.
|
|
03 WS-WK PIC 9.
|
|
03 WS-MM PIC 99.
|
|
03 WS-QQ PIC 99.
|
|
|
|
03 WS-MTH-MONTH OCCURS 12 TIMES.
|
|
05 WS-MTH-WEEK OCCURS 6 TIMES.
|
|
07 WS-DAY-FLD OCCURS 7 TIMES.
|
|
09 WS-DAY PIC ZZ.
|
|
01 INPDATE-RECORD.
|
|
05 INPD-YEAR PIC 9(04).
|
|
05 FILLER PIC X(01).
|
|
05 INPD-MONTH PIC 9(02).
|
|
05 FILLER PIC X(01).
|
|
05 INPD-DAY PIC 9(02).
|
|
01 WMS-DOW PIC 9(01).
|
|
01 WS-PRT PIC X(132).
|
|
01 WS-COL PIC 9(03) VALUE 0.
|
|
01 WS-PP PIC 9(03) VALUE 0.
|
|
01 WS-CFGN.
|
|
03 FILLER PIC 9(03) VALUE 80.
|
|
03 FILLER PIC 9(02) VALUE 5.
|
|
03 FILLER PIC 9(01) VALUE 1.
|
|
03 FILLER PIC 9(02) VALUE 5.
|
|
03 FILLER PIC 9(01) VALUE 2.
|
|
01 WS-CFGW.
|
|
03 FILLER PIC 9(03) VALUE 120.
|
|
03 FILLER PIC 9(02) VALUE 10.
|
|
03 FILLER PIC 9(01) VALUE 2.
|
|
03 FILLER PIC 9(02) VALUE 10.
|
|
03 FILLER PIC 9(01) VALUE 3.
|
|
01 WS-CFG.
|
|
03 WS-LS PIC 9(03) VALUE 120.
|
|
03 WS-LMAR PIC 9(02) VALUE 10.
|
|
03 WS-SPBD PIC 9(01) VALUE 2.
|
|
03 WS-SPBC PIC 9(02) VALUE 10.
|
|
03 WS-DNMW PIC 9(01) VALUE 3.
|
|
PROCEDURE DIVISION.
|
|
MOVE '1969-01-01' TO INPDATE-RECORD
|
|
MOVE WS-CFGN TO WS-CFG
|
|
IF (FUNCTION MOD ( INPD-YEAR , 400 ) = 0
|
|
OR (FUNCTION MOD ( INPD-YEAR , 4 ) = 0
|
|
AND
|
|
FUNCTION MOD ( INPD-YEAR , 100 ) NOT = 0))
|
|
MOVE 29 TO WS-MTH-INFO-DAYS (02)
|
|
ELSE
|
|
MOVE 28 TO WS-MTH-INFO-DAYS (02)
|
|
END-IF
|
|
|
|
PERFORM VARYING WS-MM FROM 1 BY +1
|
|
UNTIL WS-MM > 12
|
|
MOVE WS-MM TO INPD-MONTH
|
|
CALL 'DATE2DOW' USING INPDATE-RECORD, WMS-DOW
|
|
COMPUTE WS-MTH-DD = 1 - WMS-DOW
|
|
COMPUTE WS-DAYS = WS-MTH-INFO-DAYS (INPD-MONTH)
|
|
PERFORM VARYING WS-WK FROM 1 BY +1
|
|
UNTIL WS-WK > 6
|
|
PERFORM VARYING WS-DD FROM 1 BY +1
|
|
UNTIL WS-DD > 7
|
|
COMPUTE WS-MTH-DD = WS-MTH-DD + 1
|
|
IF (WS-MTH-DD < 1)
|
|
OR (WS-MTH-DD > WS-DAYS)
|
|
MOVE 0 TO WS-DAY (WS-MM, WS-WK, WS-DD)
|
|
ELSE
|
|
MOVE WS-MTH-DD TO WS-DAY (WS-MM, WS-WK, WS-DD)
|
|
END-IF
|
|
END-PERFORM
|
|
END-PERFORM
|
|
END-PERFORM
|
|
|
|
COMPUTE WS-MM = 0
|
|
PERFORM VARYING WS-QQ FROM 1 BY +1
|
|
UNTIL WS-QQ > 4
|
|
|
|
INITIALIZE WS-PRT
|
|
COMPUTE WS-PP = 1
|
|
PERFORM VARYING WS-COL FROM 1 BY +1
|
|
UNTIL WS-COL > 3
|
|
COMPUTE WS-MM = 3 * (WS-QQ - 1) + WS-COL
|
|
|
|
IF WS-COL = 1
|
|
COMPUTE WS-PP = WS-PP + WS-LMAR + 2 - WS-DNMW
|
|
ELSE
|
|
COMPUTE WS-PP = WS-PP + WS-SPBC + 2 - WS-DNMW
|
|
END-IF
|
|
MOVE WS-MTH-INFO-NAME (WS-MM)
|
|
TO WS-PRT(WS-PP:9)
|
|
COMPUTE WS-PP
|
|
= WS-PP + ( 2 * 7 + WS-SPBD * 6 + WS-SPBD - 1)
|
|
- 4
|
|
MOVE INPD-YEAR TO WS-PRT (WS-PP:4)
|
|
COMPUTE WS-PP = WS-PP + 4
|
|
END-PERFORM
|
|
DISPLAY WS-PRT (1:WS-LS)
|
|
|
|
INITIALIZE WS-PRT
|
|
COMPUTE WS-PP = 1
|
|
PERFORM VARYING WS-COL FROM 1 BY +1
|
|
UNTIL WS-COL > 3
|
|
COMPUTE WS-MM = 3 * (WS-QQ - 1) + WS-COL
|
|
|
|
IF WS-COL = 1
|
|
COMPUTE WS-PP = WS-PP + WS-LMAR + 2 - WS-DNMW
|
|
ELSE
|
|
COMPUTE WS-PP = WS-PP + WS-SPBC + 2 - WS-DNMW
|
|
END-IF
|
|
PERFORM VARYING WS-DD FROM 1 BY +1
|
|
UNTIL WS-DD > 7
|
|
IF WS-DD > 1
|
|
COMPUTE WS-PP = WS-PP + WS-SPBD + 2 - WS-DNMW
|
|
END-IF
|
|
MOVE WS-DAY-NAME (WS-DD) (1:WS-DNMW)
|
|
TO WS-PRT (WS-PP:WS-DNMW)
|
|
COMPUTE WS-PP = WS-PP + WS-DNMW
|
|
END-PERFORM
|
|
END-PERFORM
|
|
DISPLAY WS-PRT (1:WS-LS)
|
|
|
|
PERFORM VARYING WS-WK FROM 1 BY +1
|
|
UNTIL WS-WK > 6
|
|
INITIALIZE WS-PRT
|
|
COMPUTE WS-PP = 1
|
|
PERFORM VARYING WS-COL FROM 1 BY +1
|
|
UNTIL WS-COL > 3
|
|
COMPUTE WS-MM = 3 * (WS-QQ - 1) + WS-COL
|
|
|
|
IF WS-COL = 1
|
|
COMPUTE WS-PP = WS-PP + WS-LMAR
|
|
ELSE
|
|
COMPUTE WS-PP = WS-PP + WS-SPBC
|
|
END-IF
|
|
PERFORM VARYING WS-DD FROM 1 BY +1
|
|
UNTIL WS-DD > 7
|
|
IF WS-DD > 1
|
|
COMPUTE WS-PP = WS-PP + WS-SPBD
|
|
END-IF
|
|
MOVE WS-DAY (WS-MM, WS-WK, WS-DD)
|
|
TO WS-PRT (WS-PP:2)
|
|
COMPUTE WS-PP = WS-PP + 2
|
|
END-PERFORM
|
|
END-PERFORM
|
|
DISPLAY WS-PRT (1:WS-LS)
|
|
END-PERFORM
|
|
DISPLAY ' '
|
|
END-PERFORM
|
|
GOBACK
|
|
.
|
|
END PROGRAM CALEND.
|
|
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. DATE2DOW.
|
|
ENVIRONMENT DIVISION.
|
|
DATA DIVISION.
|
|
WORKING-STORAGE SECTION.
|
|
01 WMS-WORK-AREA.
|
|
03 WMS-YEAR PIC 9(04).
|
|
03 WMS-MONTH PIC 9(02).
|
|
03 WMS-CSYS PIC 9(01) VALUE 1.
|
|
03 WMS-SUM pic 9(04).
|
|
LINKAGE SECTION.
|
|
01 INPDATE-RECORD.
|
|
05 INPD-YEAR PIC 9(04).
|
|
05 FILLER PIC X(01).
|
|
05 INPD-MONTH PIC 9(02).
|
|
05 FILLER PIC X(01).
|
|
05 INPD-DAY PIC 9(02).
|
|
01 WMS-DOW PIC 9(01).
|
|
PROCEDURE DIVISION USING INPDATE-RECORD, WMS-DOW.
|
|
1010-CONVERT-DATE-TO-DOW.
|
|
IF INPD-MONTH < 3
|
|
COMPUTE WMS-MONTH = INPD-MONTH + 12
|
|
COMPUTE WMS-YEAR = INPD-YEAR - 1
|
|
ELSE
|
|
COMPUTE WMS-MONTH = INPD-MONTH
|
|
COMPUTE WMS-YEAR = INPD-YEAR
|
|
END-IF
|
|
COMPUTE WMS-SUM =
|
|
( INPD-DAY + 2 * WMS-MONTH + WMS-YEAR
|
|
+ FUNCTION INTEGER (6 * (WMS-MONTH + 1) / 10)
|
|
+ FUNCTION INTEGER ( WMS-YEAR / 4 )
|
|
- FUNCTION INTEGER ( WMS-YEAR / 100 )
|
|
+ FUNCTION INTEGER ( WMS-YEAR / 400 )
|
|
+ WMS-CSYS )
|
|
COMPUTE WMS-DOW = FUNCTION MOD (WMS-SUM, 7) + 1
|
|
GOBACK
|
|
.
|
|
END PROGRAM DATE2DOW.
|