actually, the qedit doesn't matter. I have two thoroughly tested Cobol toys
which validate dates. The one you want is probably the XL-resident
subprogram DTDIF, which takes 3 parms,
01 date1 pic s9(9) comp.
01 date2 pic s9(9) comp.
01 diff pic s9(9) comp.
fill any two, get the other; invalid date gets stomped with 9999.
here's the source code:
(YODA/VMS/KTP)/lq dtdif.src
$CONTROL DYNAMIC, USLINIT 971010TP
IDENTIFICATION DIVISION.
PROGRAM-ID. DTDIF. 971006TP
*861206 KTP written. 991108TP
*971014 KTP added 'windowed' century support for 6-digit dates: 991108TP
* ************************************************** 001004TP
* * * 001004TP
* * CC assumed 19 if YY > 80, else CC assumed 20. * 001004TP
* * * 001004TP
* ************************************************** 001004TP
*991108 KTP fix bug in assumed century 2nd-date-validation per PL.991108TP
DATE-COMPILED.
REMARKS. General-usage subroutine which determines either tp910617
the difference in days between two dates tp910617
OR tp910617
the second date, given first date & number of days. tp910617
9 NOV87
PARM FORMATS (COBOL): 9 NOV87
FIRST-DATE PIC S9(09) COMP (CCYYMMDD FORMAT); TP940711
SECOND-DATE PIC S9(09) COMP (CCYYMMDD FORMAT); TP940711
DAYS-DIFF PIC S9(09) COMP. TP940711
9 NOV87
SAMPLE CALL (COBOL): 9 NOV87
CALL "DTDIF" USING FIRST-DATE SECOND-DATE DAYS-DIFF. 971006TP
9 NOV87
NOTES: 9 NOV87
If dates passed do NOT contain CENTURY, date range is 971014TP
assumed to be 1981-2080: 810101=19810101,801231=20801231.971014TP
ACTION OF PROGRAM: 9 NOV87
IF FIRST-DATE INVALID, TP940711
MOVE 999999999 TO FIRST-DATE, EXIT. TP940711
ELSE TP940712
ELAPSED = DAYS(FIRST-DATE) TP940712
END-IF TP940712
IF SECOND-DATE <> ZERO, 9 NOV87
IF SECOND-DATE INVALID, TP940712
MOVE 999999999 TO SECOND-DATE, EXIT TP940712
ELSE TP940712
ELAPSED = -ELAPSED TP940712
ELAPSED += DAYS(SECOND-DATE) TP940712
EXIT TP940712
END-IF TP940712
ELSE TP940712
SECOND-DATE = DATE(ELAPSED + DAYS-DIFF) TP940712
EXIT. TP940712
$PAGE 9 NOV87
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
*SOURCE-COMPUTER. HP3000 WITH DEBUGGING MODE. 03 MAY04
SPECIAL-NAMES. 971013TP
SW15 IS PARM1, ON STATUS IS DEBUG-ACTIVE; 971013TP
. 971013TP
DATA DIVISION.
WORKING-STORAGE SECTION.
01 CUTOFF-YEAR PIC 99 VALUE 80. 991108TP
01 YY-GT-CUTOFF-CENTURY PIC 99 VALUE 19. 991108TP
01 YY-LE-CUTOFF-CENTURY PIC 99 VALUE 20. 991108TP
991108TP
01 VALUE "312831303130313130313031". 971010TP
05 DAYS-IN-MONTH PIC 99 OCCURS 12 TIMES. 971010TP
01 VALUE "000031059090120151181212243273304334". 971010TP
05 DAYS-TIL-MONTH-NORMYR PIC 999 OCCURS 12 TIMES. 971010TP
01 VALUE "000031060091121152182213244274305335". 971010TP
05 DAYS-TIL-MONTH-LEAPYR PIC 999 OCCURS 12 TIMES. 971010TP
01 RESULT PIC S9(9) COMP. 971010TP
01 REM PIC S9(9) COMP. 971010TP
01 X PIC S9(4) COMP. 971010TP
01 FD-DAYS PIC S9(9) COMP VALUE 0. 971010TP
01 SD-DAYS PIC S9(9) COMP VALUE 0. 971010TP
01 DR-WORK PIC S9(9) COMP VALUE 0. 971010TP
01 SAVE-DAYS-DIFF PIC S9(9) COMP. 971006TP
01 F-D PIC 9(09). TP940711
01 REDEFINES F-D. TP940711
05 FILLER PIC X. TP940711
05 FD-CCYY PIC 9999. TP940711
05 REDEFINES FD-CCYY. TP940711
10 FD-CC PIC 99. TP940711
10 FD-YY PIC 99. TP940711
05 FD-MMDD. TP940711
10 FD-MM PIC 99. TP940711
10 FD-DD PIC 99. TP940711
TP940711
01 S-D PIC 9(09). TP940711
01 REDEFINES S-D. TP940711
05 FILLER PIC X. TP940711
05 SD-CCYY PIC 9999. TP940711
05 REDEFINES SD-CCYY. TP940711
10 SD-CC PIC 99. TP940711
10 SD-YY PIC 99. TP940711
05 SD-MMDD. TP940711
10 SD-MM PIC 99. TP940711
10 SD-DD PIC 99. TP940711
TP940711
LINKAGE SECTION.
01 LINK-F-D PIC S9(09) COMP. TP940711
01 LINK-S-D PIC S9(09) COMP. TP940711
01 DAYS-DIFF PIC S9(09) COMP. TP940711
991108TP
PROCEDURE DIVISION USING LINK-F-D, LINK-S-D, DAYS-DIFF. 991108TP
991108TP
*DECLARATIVES. 991108TP
*DTDEBUG SECTION. 991108TP
* USE FOR DEBUGGING ON ALL PROCEDURES. 991108TP
*DTDEBUG-PARAG. 991108TP
* DISPLAY "DTDIF:" DEBUG-LINE 991108TP
* " D1=" F-D " D2=" S-D "DIF=" DAYS-DIFF 991108TP
* "FDD=" FD-DAYS ";SDD=" SD-DAYS ";DR=" DR-WORK 991108TP
* "REM=" REM 991108TP
* 991108TP
* . 991108TP
*END DECLARATIVES. 991108TP
991108TP
DATE-ROUTINE SECTION.
DATE-RTN-START. TP940711
MOVE LINK-F-D TO F-D TP940711
MOVE LINK-S-D TO S-D TP940711
. TP940711
VALIDATE-1ST-DATE. 9 JUN86
IF FD-CC = 00 TP940711
IF FD-YY > CUTOFF-YEAR 991108TP
MOVE YY-GT-CUTOFF-CENTURY TO FD-CC 991108TP
ELSE 971014TP
MOVE YY-LE-CUTOFF-CENTURY TO FD-CC 991108TP
END-IF 971014TP
END-IF TP940711
IF F-D < 99991232 TP940711
AND FD-MM > 0 AND FD-MM < 13 TP940711
AND FD-DD > 0 TP940711
AND ( FD-DD <= DAYS-IN-MONTH (FD-MM) TP940711
OR ( FD-MMDD = "0229" TP940711
AND FD-CCYY / 4 * 4 = FD-CCYY TP940711
AND FD-CCYY / 100 * 100 <> FD-CCYY ) 971010TP
OR ( FD-MMDD = "0229" TP940711
AND FD-CCYY / 400 * 400 = FD-CCYY ) 971010TP
) TP940711
CONTINUE TP940711
ELSE TP940711
MOVE 999999999 TO F-D TP940711
GO TO DATE-ROUTINE-EXIT. TP940711
9 JUN86
FIRST-DATE-IS-OK. 9 JUN86
MOVE FD-DD TO FD-DAYS 971010TP
971013TP
IF FD-CCYY / 400 * 400 = FD-CCYY 971010TP
OR ( FD-CCYY / 4 * 4 = FD-CCYY 971010TP
AND FD-CCYY / 100 * 100 <> FD-CCYY) 971010TP
ADD DAYS-TIL-MONTH-LEAPYR ( FD-MM ) TO FD-DAYS 971010TP
ELSE 971010TP
ADD DAYS-TIL-MONTH-NORMYR ( FD-MM ) TO FD-DAYS 971010TP
END-IF 971010TP
971013TP
COMPUTE DR-WORK = FD-CCYY - 1 971013TP
DIVIDE 400 INTO DR-WORK GIVING RESULT REMAINDER REM 971010TP
COMPUTE FD-DAYS = FD-DAYS + RESULT * 146097 971010TP
MOVE REM TO DR-WORK 971013TP
DIVIDE 100 INTO DR-WORK GIVING RESULT REMAINDER REM 971010TP
COMPUTE FD-DAYS = FD-DAYS + RESULT * 36524 971010TP
MOVE REM TO DR-WORK 971013TP
DIVIDE 4 INTO DR-WORK GIVING RESULT REMAINDER REM 971010TP
COMPUTE FD-DAYS = FD-DAYS + RESULT * 1461 971010TP
COMPUTE FD-DAYS = FD-DAYS + REM * 365 971010TP
. TP940711
VALIDATE-SECOND-DATE. TP940711
IF S-D <> 0 971010TP
* *validate... 971010TP
IF SD-CC = 00 971010TP
IF SD-YY > CUTOFF-YEAR 991108TP
MOVE YY-GT-CUTOFF-CENTURY TO SD-CC 991108TP
ELSE 971014TP
MOVE YY-LE-CUTOFF-CENTURY TO SD-CC 991108TP
END-IF 971014TP
END-IF 971010TP
IF NOT ( S-D < 99991232 971010TP
AND SD-MM < 13 AND SD-MM > 0 971014TP
AND SD-DD > 0 971010TP
AND ( SD-DD <= DAYS-IN-MONTH (SD-MM) 971010TP
OR ( SD-MMDD = "0229" 971010TP
AND SD-CCYY / 4 * 4 = SD-CCYY 971010TP
AND SD-CCYY / 100 * 100 <> SD-CCYY ) 971010TP
OR ( SD-MMDD = "0229" 971010TP
AND SD-CCYY / 400 * 400 = SD-CCYY ) 971010TP
) 971010TP
) 971010TP
MOVE 999999999 TO S-D 971010TP
GO TO DATE-ROUTINE-EXIT 971010TP
ELSE 971010TP
* *2nd date's ok; find days dif... 971010TP
MOVE SD-DD TO SD-DAYS 971010TP
IF SD-CCYY / 400 * 400 = SD-CCYY 971010TP
OR ( SD-CCYY / 4 * 4 = SD-CCYY 971010TP
AND SD-CCYY / 100 * 100 <> SD-CCYY ) 971010TP
ADD DAYS-TIL-MONTH-LEAPYR ( SD-MM ) TO SD-DAYS 971010TP
ELSE 971010TP
ADD DAYS-TIL-MONTH-NORMYR ( SD-MM ) TO SD-DAYS 971010TP
END-IF 971010TP
COMPUTE DR-WORK = SD-CCYY - 1 971013TP
DIVIDE 400 INTO DR-WORK GIVING RESULT REMAINDER REM 971010TP
COMPUTE SD-DAYS = SD-DAYS + RESULT * 146097 971010TP
MOVE REM TO DR-WORK 971013TP
DIVIDE 100 INTO DR-WORK GIVING RESULT REMAINDER REM 971010TP
COMPUTE SD-DAYS = SD-DAYS + RESULT * 36524 971010TP
MOVE REM TO DR-WORK 971013TP
DIVIDE 4 INTO DR-WORK GIVING RESULT REMAINDER REM 971010TP
COMPUTE SD-DAYS = SD-DAYS + RESULT * 1461 971010TP
COMPUTE SD-DAYS = SD-DAYS + REM * 365 971010TP
COMPUTE DAYS-DIFF = SD-DAYS - FD-DAYS 971010TP
END-IF 971010TP
ELSE 971010TP
* *find 2nd date... 971010TP
COMPUTE SD-DAYS = FD-DAYS + DAYS-DIFF 971014TP
DIVIDE 146097 INTO SD-DAYS GIVING RESULT REMAINDER REM 971014TP
COMPUTE SD-CCYY = 400 * RESULT 971010TP
MOVE REM TO DR-WORK 971013TP
IF REM = 0 971013TP
MOVE 1231 TO SD-MMDD 971013TP
ELSE 971013TP
DIVIDE 36524 INTO DR-WORK GIVING RESULT REMAINDER REM 971013TP
COMPUTE SD-CCYY = SD-CCYY + 100 * RESULT 971013TP
MOVE REM TO DR-WORK 971013TP
IF REM = 0 971013TP
IF SD-CCYY / 400 * 400 = SD-CCYY 971013TP
MOVE 1230 TO SD-MMDD 971013TP
ELSE 971013TP
MOVE 1231 TO SD-MMDD 971013TP
END-IF 971013TP
ELSE 971013TP
DIVIDE 1461 INTO DR-WORK GIVING RESULT REMAINDER REM 971013TP
COMPUTE SD-CCYY = SD-CCYY + 4 * RESULT 971013TP
MOVE REM TO DR-WORK 971013TP
IF REM = 0 971013TP
MOVE 1231 TO SD-MMDD 971013TP
ELSE 971013TP
DIVIDE 365 INTO DR-WORK GIVING RESULT REMAINDER REM 971013TP
COMPUTE SD-CCYY = SD-CCYY + RESULT 971013TP
MOVE REM TO DR-WORK 971013TP
IF REM = 0 971013TP
IF SD-CCYY / 4 * 4 = SD-CCYY 971013TP
AND SD-CCYY / 100 * 100 <> SD-CCYY 971013TP
MOVE 1230 TO SD-MMDD 971013TP
ELSE 971013TP
MOVE 1231 TO SD-MMDD 971013TP
END-IF 971013TP
ELSE 971013TP
ADD 1 TO SD-CCYY 971013TP
IF SD-CCYY / 400 * 400 = SD-CCYY 971013TP
OR ( SD-CCYY / 4 * 4 = SD-CCYY 971013TP
AND SD-CCYY / 100 * 100 <> SD-CCYY) 971013TP
PERFORM VARYING X FROM 12 BY -1 971013TP
UNTIL DAYS-TIL-MONTH-LEAPYR ( X ) < DR-WORK 971013TP
CONTINUE 971013TP
END-PERFORM 971013TP
MOVE X TO SD-MM 971013TP
COMPUTE SD-DD = DR-WORK 971013TP
- DAYS-TIL-MONTH-LEAPYR ( X )971013TP
ELSE 971013TP
PERFORM VARYING X FROM 12 BY -1 971013TP
UNTIL DAYS-TIL-MONTH-NORMYR ( X ) < DR-WORK 971013TP
CONTINUE 971013TP
END-PERFORM 971013TP
MOVE X TO SD-MM 971013TP
COMPUTE SD-DD = DR-WORK 971013TP
- DAYS-TIL-MONTH-NORMYR ( X )971013TP
. 971010TP
DATE-ROUTINE-EXIT.
MOVE F-D TO LINK-F-D TP940711
MOVE S-D TO LINK-S-D TP940711
EXIT PROGRAM.
971013TP
DISP. 971013TP
DISPLAY "CCYY=" SD-CCYY ";DR-WORK=" DR-WORK ";REM=" REM 971013TP
971013TP
. 971013TP
> -----Original Message-----
> From: Olav Kappert [mailto:[log in to unmask]]
> Sent: Saturday, February 05, 2005 8:02 PM
> To: [log in to unmask]
> Subject: Cobol date procedures
>
>
> Hello:
>
> Does anyone have a cobol procedure that will verify if a
> particular date
> is indeed a valid date in the format of yyyymmdd.
>
> I tried date-to-integer and integer-to-date but what I got was an
> aborted program when entering 02/30/2005.
>
> Any ideas ?
>
> Olav.
>
> * To join/leave the list, search archives, change list settings, *
> * etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
>
* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
|
