Working with Dates

10 Jul

COBOL allows you to accept a number of data items from the operating system, including current date.

ACCEPT WS-YYMMDD FROM DATE.
This statement will return a six-digit date in the format of YYMMDD. The variable  WS-YYMMDD must be defined in WORKING-STORAGE.

ACCEPT WS-CCYYMMDD FROM CENTURY-DATE.
This statement will return an eight-digit date in the format of CCYYMMDD. The variable WS-CCYYMMDD must be defined in WORKING-STORAGE.

COBOL provides some handy functions, and some of the most widely used are the date functions.   Let say, for example, that you’re processing an invoice, and you need to determine the due date, which is always 30 days from the current date.  You could use the following logic:

The COBOL function INTEGER-OF-DATE converts a Gregorian date to an integer.  Conversely, the function DATE-OF-INTEGER converts an integer to a Gregorian date.

Functions are handy tools, and are exceedingly easier than the methods we previously used that required copious amounts of code to convert a Gregorian date to a Julian date and vice versa.   You’ll do yourself a huge favor if you learn the COBOL functions!

2 Replies to “Working with Dates

  1. I have 2 sub-routines to handle dates and date validation these are days1900.cbl and 1900days.cob.
    Days9900 is supplied with a 6 or 8 digit date and returns a 6 digit date + a 8 digit date + No Of date since 1900 (as per spreadsheet dates)
    1900days is supplied with the No Of dates since 1900 and returns 6 digit date + 8 digit date and the Julian date
    to go back or forward a number of days just add or subtract the number from the Days Since 1900 and pass the result thru 1900days, that would return the corresponding date.
    Any invalid dates returns zero for date validation.
    This was my millennium fix so the system only holds dates since 1900.
    Isn’t difficult when you get your head round it 🙂
    Code:
    Days1900.cbl
    * $Header: days1900.cbl 1.5 11/06/03 13:33:02 it01ijg$
    * $Log: $
    * days1900.cbl 1.5 11/06/03 13:33:02 it01ijg
    *
    * days1900.cbl 1.4 10/11/16 09:00:04 it01jb2
    *
    * days1900.cbl 1.3 05/08/18 19:44:49 it01ijg
    *
    * days1900.cbl 1.2 04/08/24 14:13:35 it01ijg
    * Allow input of day only or day and month
    * days1900.cbl 1.1 99/08/05 21:17:03 it02bpp
    * First Putaway for SMS.
    *
    * $Revision: 1.5$
    *
    identification division.
    **************************************************************
    * Called routine to calculate the number of days since the *
    * year 1900 *
    * Amended to return the oposite date format than supplied *
    * ie. Supply ddmmyy return date = ddmmccyy *
    * ddmmccyy return date = ddmmyy *
    **************************************************************
    program-id. days1900.
    data division.
    working-storage section.
    01 work-fields.
    05 i1 pic 9(6) comp-6.
    05 work2 pic 9(6)v99.
    05 redefines work2.
    15 ws-w1 pic 9(6).
    15 ws-rem pic 99.
    88 leap-year value 0.

    05 work0 pic 9(6) comp-6.
    05 ws-year pic 9(3) comp-6.

    05 ws-date pic 9(6).
    05 redefines ws-date.
    15 ws-dd pic 99.
    15 ws-mm pic 99.
    15 ws-yy pic 99.

    05 ws-link-date pic 9(8).
    05 redefines ws-link-date.
    15 ws-l-1 pic 9(4).
    15 ws-l-2 pic 9(4).

    05 ws-date-ddmmccyy pic 9(8).
    05 redefines ws-date-ddmmccyy.
    15 ws-dd1 pic 99.
    15 ws-mm1 pic 99.
    15 ws-cc pic 99.
    15 ws-yy1 pic 99.
    05 ws-sys-date pic 9(6).
    05 redefines ws-sys-date.
    15 ws-sys-yy pic 99.
    15 ws-sys-mm pic 99.
    15 ws-sys-dd pic 99.

    01 preset-literals.
    05 ws-days-mth pic x(24) value
    “312831303130313130313031”.
    05 ws-no-days redefines ws-days-mth pic 99 occurs 12.

    linkage section.
    01 link-days-1900.
    05 link-date pic 9(8) comp-6.
    05 link-date-return pic 9(8) comp-6.
    05 link-reply pic 9(6) comp-6.

    procedure division using link-days-1900.
    begin.
    if link-date < 10000
    perform check-date
    end-if.
    if link-date 1900
    and ws-l-2 31
    move ws-yy to i1
    move ws-dd to ws-yy
    move i1 to ws-dd
    end-if.

    if (ws-mm 12)
    or (ws-dd 31)
    move zero to link-reply
    else
    if ((ws-yy < 28 and link-reply not = 99)
    or (ws-yy < 70 and link-reply = 99))
    if link-date ws-no-days(ws-mm)
    move zero to link-reply
    else
    add ws-dd to work0
    perform varying i1 from 1 by 1 until i1 = ws-mm
    or work0 = zero
    add ws-no-days(i1) to work0
    end-perform
    move work0 to link-reply

    if ws-date-ddmmccyy = zero
    move ws-dd to ws-dd1
    move ws-mm to ws-mm1
    move ws-yy to ws-yy1
    if ws-year < 100
    move 19 to ws-cc
    else
    move 20 to ws-cc
    end-if
    move ws-date-ddmmccyy to link-date-return
    else
    move ws-date to link-date-return
    end-if

    end-if
    end-if.
    if link-reply = zero
    move zero to link-date-return
    end-if.

    end-para.
    check-date.
    accept ws-sys-date from date.
    move link-date to work0.
    if work0 < 100
    compute work0 = work0 * 100 + ws-sys-mm
    end-if.
    if work0 12
    or work0 < 1
    subtract ws-no-days(i1) from work0
    end-perform
    subtract 1 from i1
    add ws-no-days(i1) to work0
    move ws-year to ws-yy
    move i1 to ws-mm
    move work0 to ws-dd
    end-if
    move ws-date to link-date
    move ws-dd to ws-dd1
    move ws-mm to ws-mm1
    move ws-yy to ws-yy1
    move ws-dd to ws-dd1
    if link-reply < 36526
    move 19 to ws-cc
    else
    move 20 to ws-cc
    end-if
    move ws-date-ddmmccyy to link-date-return
    move ws-julian-date to link-reply
    else
    move zero to link-date,
    link-date-return
    end-if.
    end-para.
    exit program.

Leave a Reply

Your email address will not be published. Required fields are marked *