IDENTIFICATION DIVISION. PROGRAM-ID. CDATEC. DATA DIVISION. WORKING-STORAGE SECTION. 01 YR PIC 9999. ...
PROGRAM-ID. CDATEC.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 YR PIC 9999.
01 YR1 PIC 9999.
01 YR2 PIC 9999.
01 MON PIC 99.
01 MON1 PIC 99.
01 MON2 PIC 99.
01 D1 PIC 99.
01 D2 PIC 99.
01 QU1 PIC 99.
01 REM1 PIC 99.
01 REM2 PIC 99.
01 REM3 PIC 99.
01 T PIC 99999999.
01 T1 PIC 99999999.
01 T2 PIC 99999999.
PROCEDURE DIVISION.
MAINP.
ACCEPT YR1.
ACCEPT YR2.
ACCEPT MON1.
00200000
ACCEPT MON2.
00210000
ACCEPT D1.
00220000
ACCEPT D2.
00230000
00240001
PERFORM LP-PARA VARYING YR FROM 1900 BY 1 UNTIL YR = YR1.
00270000
PERFORM MN-PARA VARYING MON FROM 1 BY 1 UNTIL MON = MON1.
00280000
00281001
MOVE T TO T1.
00290000
COMPUTE T1 = T1 + D1.
00290100
MOVE 0 TO T.
00291000
00292001
PERFORM LP-PARA VARYING YR FROM 1900 BY 1 UNTIL YR = YR2.
00330000
PERFORM MN-PARA VARYING MON FROM 1 BY 1 UNTIL MON = MON2.
00340000
00341001
MOVE T TO T2.
00350000
COMPUTE T2 = T2 + D2.
00350100
COMPUTE T = T2 - T1.
00351000
00352001
DISPLAY "THE DIFFERENCE BETWEEN DATES: ".
00360000
DISPLAY D1 "/" MON1 "/" YR1 " & " D2 "/" MON2 "/" YR2 " IS
".00361000
DISPLAY T.
00362000
STOP RUN.
00370000
00371001
LP-PARA.
00380000
DIVIDE YR BY 400 GIVING QU1 REMAINDER REM1.
00381000
DIVIDE YR BY 100 GIVING QU1 REMAINDER REM2.
00382000
DIVIDE YR BY 4 GIVING QU1 REMAINDER REM3.
00383000
IF REM1 = 0 OR ( REM2 IS NOT = 0 AND REM3 = 0 ) THEN
00390000
COMPUTE T = T + 366
00400000
ELSE
00410000
COMPUTE T = T + 365
00420000
END-IF.
00430000
00431001
MN-PARA.
00440000
DIVIDE YR BY 400 GIVING QU1 REMAINDER REM1.
00441000
DIVIDE YR BY 100 GIVING QU1 REMAINDER REM2.
00442000
DIVIDE YR BY 4 GIVING QU1 REMAINDER REM3.
00443000
IF MON = 1 OR MON = 3 OR MON = 5 OR MON = 7 OR MON = 8
00450000
OR MON = 10 OR MON = 12 THEN
00460000
COMPUTE T = T + 31
00470000
ELSE IF MON = 4 OR MON = 6 OR MON = 9 OR MON = 11 THEN
00480000
COMPUTE T = T + 30
00490000
ELSE IF REM1 = 0 OR ( REM2 IS NOT = 0 AND REM3 = 0 ) THEN
00500000
COMPUTE T = T + 29
00510000
ELSE
00520000
COMPUTE T = T + 28
00530000
END-IF.
00540000
No comments
Post a Comment