Case Study 1: Building a Reusable Date Validation Library
Background
Pinnacle Savings Bank maintains over 200 COBOL batch programs across its core banking, loan servicing, and regulatory reporting systems. Dates appear in nearly every program: transaction dates, account opening dates, maturity dates, payment due dates, and regulatory reporting dates. Over the years, each programmer implemented their own date validation and manipulation logic, resulting in inconsistent behavior, duplicated code, and recurring date-related defects.
An audit of production incidents revealed that 23% of all batch job failures over the prior 18 months were caused by date-handling errors: invalid dates passing validation, incorrect day-of-week calculations for business day processing, wrong leap year logic, and inconsistent date format conversions between YYYYMMDD, MM/DD/YYYY, and Julian (YYYYDDD) formats. The most expensive incident occurred when a loan interest calculation program accepted February 30 as a valid date, causing $147,000 in incorrect interest charges before the error was detected.
The bank's chief architect mandated the creation of a centralized date validation library implemented as a set of COBOL subprograms. Every program that handles dates must call these subprograms rather than implementing its own logic. The library must be:
- Correct: Handle all edge cases including leap years, century boundaries, and business calendar rules.
- Reusable: Callable from any COBOL program using a standardized parameter interface.
- Maintainable: When date rules change (such as new bank holidays being added), the change is made in one place and all callers automatically get the updated behavior.
- Performant: Date operations are called millions of times during batch processing; the subprograms must minimize overhead.
Library Architecture
The date library consists of four subprograms, each handling a distinct category of date operations:
| Subprogram | Purpose |
|---|---|
| DATEVAL | Date validation -- verify a date is valid |
| DATECVT | Date format conversion -- convert between formats |
| DATECALC | Date arithmetic -- add/subtract days, calculate differences |
| DATEBIZ | Business day functions -- determine if a date is a business day, find next/previous business day |
All four subprograms share a common parameter block structure and use RETURN-CODE to communicate success or failure to the caller.
Common Parameter Interface
*---------------------------------------------------------------
* DATELIB COMMON PARAMETER BLOCK
* Used by all date library subprograms
* Copy this into any program that calls the date library
*---------------------------------------------------------------
01 WS-DATE-PARAMS.
05 DP-FUNCTION-CODE PIC X(4).
* DATEVAL functions:
88 DP-VALIDATE VALUE "VALD".
88 DP-VALIDATE-RANGE VALUE "VRNG".
* DATECVT functions:
88 DP-CVT-TO-GREG VALUE "CGRG".
88 DP-CVT-TO-JULIAN VALUE "CJUL".
88 DP-CVT-TO-DISPLAY VALUE "CDSP".
88 DP-CVT-TO-DB2 VALUE "CDB2".
* DATECALC functions:
88 DP-ADD-DAYS VALUE "ADDY".
88 DP-SUB-DAYS VALUE "SUBD".
88 DP-DIFF-DAYS VALUE "DIFF".
88 DP-DAY-OF-WEEK VALUE "DOWK".
* DATEBIZ functions:
88 DP-IS-BUSINESS-DAY VALUE "IBDY".
88 DP-NEXT-BIZ-DAY VALUE "NBDY".
88 DP-PREV-BIZ-DAY VALUE "PBDY".
05 DP-INPUT-DATE-1 PIC 9(8).
05 DP-INPUT-DATE-2 PIC 9(8).
05 DP-INPUT-DAYS PIC S9(5).
05 DP-OUTPUT-DATE PIC 9(8).
05 DP-OUTPUT-DAYS PIC S9(7).
05 DP-OUTPUT-DAY-OF-WEEK PIC 9(1).
88 DP-SUNDAY VALUE 1.
88 DP-MONDAY VALUE 2.
88 DP-TUESDAY VALUE 3.
88 DP-WEDNESDAY VALUE 4.
88 DP-THURSDAY VALUE 5.
88 DP-FRIDAY VALUE 6.
88 DP-SATURDAY VALUE 7.
05 DP-OUTPUT-DISPLAY PIC X(10).
05 DP-RETURN-CODE PIC 9(2).
88 DP-SUCCESS VALUE 00.
88 DP-INVALID-DATE VALUE 01.
88 DP-INVALID-RANGE VALUE 02.
88 DP-INVALID-FUNC VALUE 03.
88 DP-CALC-ERROR VALUE 04.
88 DP-HOLIDAY VALUE 05.
88 DP-WEEKEND VALUE 06.
05 DP-ERROR-MESSAGE PIC X(50).
Subprogram 1: DATEVAL -- Date Validation
The validation subprogram is the most critical component. It verifies that a date is a valid calendar date, handling all the complexities of month lengths, leap years, and century boundaries:
IDENTIFICATION DIVISION.
PROGRAM-ID. DATEVAL.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-DATE-PARTS.
05 WS-YEAR PIC 9(4).
05 WS-MONTH PIC 9(2).
05 WS-DAY PIC 9(2).
01 WS-LEAP-YEAR-FLAG PIC X(1).
88 WS-IS-LEAP-YEAR VALUE "Y".
88 WS-NOT-LEAP-YEAR VALUE "N".
01 WS-DAYS-IN-MONTH-TABLE.
05 FILLER PIC 9(2) VALUE 31.
05 FILLER PIC 9(2) VALUE 28.
05 FILLER PIC 9(2) VALUE 31.
05 FILLER PIC 9(2) VALUE 30.
05 FILLER PIC 9(2) VALUE 31.
05 FILLER PIC 9(2) VALUE 30.
05 FILLER PIC 9(2) VALUE 31.
05 FILLER PIC 9(2) VALUE 31.
05 FILLER PIC 9(2) VALUE 30.
05 FILLER PIC 9(2) VALUE 31.
05 FILLER PIC 9(2) VALUE 30.
05 FILLER PIC 9(2) VALUE 31.
01 WS-DAYS-TABLE REDEFINES WS-DAYS-IN-MONTH-TABLE.
05 WS-DAYS-IN-MONTH PIC 9(2)
OCCURS 12 TIMES.
01 WS-MAX-DAYS PIC 9(2).
LINKAGE SECTION.
01 LS-DATE-PARAMS.
05 LS-FUNCTION-CODE PIC X(4).
05 LS-INPUT-DATE-1 PIC 9(8).
05 LS-INPUT-DATE-2 PIC 9(8).
05 LS-INPUT-DAYS PIC S9(5).
05 LS-OUTPUT-DATE PIC 9(8).
05 LS-OUTPUT-DAYS PIC S9(7).
05 LS-OUTPUT-DOW PIC 9(1).
05 LS-OUTPUT-DISPLAY PIC X(10).
05 LS-RETURN-CODE PIC 9(2).
05 LS-ERROR-MESSAGE PIC X(50).
PROCEDURE DIVISION USING LS-DATE-PARAMS.
0000-MAIN.
MOVE 00 TO LS-RETURN-CODE
MOVE SPACES TO LS-ERROR-MESSAGE
EVALUATE LS-FUNCTION-CODE
WHEN "VALD"
PERFORM 1000-VALIDATE-DATE
WHEN "VRNG"
PERFORM 2000-VALIDATE-RANGE
WHEN OTHER
MOVE 03 TO LS-RETURN-CODE
MOVE "INVALID FUNCTION CODE FOR DATEVAL"
TO LS-ERROR-MESSAGE
END-EVALUATE
GOBACK
.
1000-VALIDATE-DATE.
* Extract date components
DIVIDE LS-INPUT-DATE-1 BY 10000
GIVING WS-YEAR REMAINDER WS-MONTH
DIVIDE WS-MONTH BY 100
GIVING WS-MONTH REMAINDER WS-DAY
MOVE LS-INPUT-DATE-1(1:4) TO WS-YEAR
MOVE LS-INPUT-DATE-1(5:2) TO WS-MONTH
MOVE LS-INPUT-DATE-1(7:2) TO WS-DAY
* Check year range (1900-2099)
IF WS-YEAR < 1900 OR WS-YEAR > 2099
MOVE 01 TO LS-RETURN-CODE
MOVE "YEAR OUT OF RANGE (1900-2099)"
TO LS-ERROR-MESSAGE
GO TO 1000-EXIT
END-IF
* Check month range
IF WS-MONTH < 01 OR WS-MONTH > 12
MOVE 01 TO LS-RETURN-CODE
MOVE "MONTH OUT OF RANGE (01-12)"
TO LS-ERROR-MESSAGE
GO TO 1000-EXIT
END-IF
* Determine leap year
PERFORM 1100-CHECK-LEAP-YEAR
* Determine max days for this month
MOVE WS-DAYS-IN-MONTH(WS-MONTH)
TO WS-MAX-DAYS
IF WS-MONTH = 2 AND WS-IS-LEAP-YEAR
MOVE 29 TO WS-MAX-DAYS
END-IF
* Check day range
IF WS-DAY < 01 OR WS-DAY > WS-MAX-DAYS
MOVE 01 TO LS-RETURN-CODE
STRING "DAY OUT OF RANGE (01-"
WS-MAX-DAYS ") FOR MONTH "
WS-MONTH
DELIMITED SIZE INTO LS-ERROR-MESSAGE
GO TO 1000-EXIT
END-IF
.
1000-EXIT.
EXIT.
1100-CHECK-LEAP-YEAR.
SET WS-NOT-LEAP-YEAR TO TRUE
IF FUNCTION MOD(WS-YEAR, 4) = 0
SET WS-IS-LEAP-YEAR TO TRUE
IF FUNCTION MOD(WS-YEAR, 100) = 0
SET WS-NOT-LEAP-YEAR TO TRUE
IF FUNCTION MOD(WS-YEAR, 400) = 0
SET WS-IS-LEAP-YEAR TO TRUE
END-IF
END-IF
END-IF
.
2000-VALIDATE-RANGE.
* Validate both dates, then check that date-1 <= date-2
MOVE LS-INPUT-DATE-1 TO LS-INPUT-DATE-1
PERFORM 1000-VALIDATE-DATE
IF LS-RETURN-CODE NOT = 00
MOVE 02 TO LS-RETURN-CODE
MOVE "FIRST DATE IN RANGE IS INVALID"
TO LS-ERROR-MESSAGE
GO TO 2000-EXIT
END-IF
MOVE LS-INPUT-DATE-2 TO LS-INPUT-DATE-1
PERFORM 1000-VALIDATE-DATE
IF LS-RETURN-CODE NOT = 00
MOVE 02 TO LS-RETURN-CODE
MOVE "SECOND DATE IN RANGE IS INVALID"
TO LS-ERROR-MESSAGE
GO TO 2000-EXIT
END-IF
IF LS-INPUT-DATE-1 > LS-INPUT-DATE-2
MOVE 02 TO LS-RETURN-CODE
MOVE "START DATE IS AFTER END DATE"
TO LS-ERROR-MESSAGE
END-IF
.
2000-EXIT.
EXIT.
Subprogram 2: DATECVT -- Date Format Conversion
Financial systems store dates in multiple formats. The conversion subprogram translates between them:
IDENTIFICATION DIVISION.
PROGRAM-ID. DATECVT.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-CONV-WORK.
05 WS-YEAR PIC 9(4).
05 WS-MONTH PIC 9(2).
05 WS-DAY PIC 9(2).
05 WS-JULIAN-DAY PIC 9(3).
05 WS-INTEGER-DATE PIC 9(8).
LINKAGE SECTION.
01 LS-DATE-PARAMS.
05 LS-FUNCTION-CODE PIC X(4).
05 LS-INPUT-DATE-1 PIC 9(8).
05 LS-INPUT-DATE-2 PIC 9(8).
05 LS-INPUT-DAYS PIC S9(5).
05 LS-OUTPUT-DATE PIC 9(8).
05 LS-OUTPUT-DAYS PIC S9(7).
05 LS-OUTPUT-DOW PIC 9(1).
05 LS-OUTPUT-DISPLAY PIC X(10).
05 LS-RETURN-CODE PIC 9(2).
05 LS-ERROR-MESSAGE PIC X(50).
PROCEDURE DIVISION USING LS-DATE-PARAMS.
0000-MAIN.
MOVE 00 TO LS-RETURN-CODE
MOVE SPACES TO LS-ERROR-MESSAGE
EVALUATE LS-FUNCTION-CODE
WHEN "CGRG"
* Convert Julian (YYYYDDD) to Gregorian
PERFORM 1000-JULIAN-TO-GREGORIAN
WHEN "CJUL"
* Convert Gregorian (YYYYMMDD) to Julian
PERFORM 2000-GREGORIAN-TO-JULIAN
WHEN "CDSP"
* Convert YYYYMMDD to MM/DD/YYYY display
PERFORM 3000-TO-DISPLAY-FORMAT
WHEN "CDB2"
* Convert YYYYMMDD to DB2 format YYYY-MM-DD
PERFORM 4000-TO-DB2-FORMAT
WHEN OTHER
MOVE 03 TO LS-RETURN-CODE
MOVE "INVALID FUNCTION CODE FOR DATECVT"
TO LS-ERROR-MESSAGE
END-EVALUATE
GOBACK
.
1000-JULIAN-TO-GREGORIAN.
* Input: YYYYDDD in LS-INPUT-DATE-1 (right 7 digits)
* Output: YYYYMMDD in LS-OUTPUT-DATE
MOVE LS-INPUT-DATE-1(1:4) TO WS-YEAR
MOVE LS-INPUT-DATE-1(5:3) TO WS-JULIAN-DAY
IF WS-JULIAN-DAY < 1 OR WS-JULIAN-DAY > 366
MOVE 01 TO LS-RETURN-CODE
MOVE "JULIAN DAY OUT OF RANGE"
TO LS-ERROR-MESSAGE
GO TO 1000-EXIT
END-IF
* Use intrinsic functions for reliable conversion
COMPUTE WS-INTEGER-DATE =
FUNCTION INTEGER-OF-DAY(
WS-YEAR * 1000 + WS-JULIAN-DAY)
COMPUTE LS-OUTPUT-DATE =
FUNCTION DATE-OF-INTEGER(WS-INTEGER-DATE)
.
1000-EXIT.
EXIT.
3000-TO-DISPLAY-FORMAT.
* Convert YYYYMMDD to MM/DD/YYYY
MOVE LS-INPUT-DATE-1(5:2) TO LS-OUTPUT-DISPLAY(1:2)
MOVE "/" TO LS-OUTPUT-DISPLAY(3:1)
MOVE LS-INPUT-DATE-1(7:2) TO LS-OUTPUT-DISPLAY(4:2)
MOVE "/" TO LS-OUTPUT-DISPLAY(6:1)
MOVE LS-INPUT-DATE-1(1:4) TO LS-OUTPUT-DISPLAY(7:4)
.
4000-TO-DB2-FORMAT.
* Convert YYYYMMDD to YYYY-MM-DD
MOVE LS-INPUT-DATE-1(1:4) TO LS-OUTPUT-DISPLAY(1:4)
MOVE "-" TO LS-OUTPUT-DISPLAY(5:1)
MOVE LS-INPUT-DATE-1(5:2) TO LS-OUTPUT-DISPLAY(6:2)
MOVE "-" TO LS-OUTPUT-DISPLAY(8:1)
MOVE LS-INPUT-DATE-1(7:2) TO LS-OUTPUT-DISPLAY(9:2)
.
Subprogram 3: DATECALC -- Date Arithmetic
Date arithmetic is notoriously error-prone when implemented manually. The library uses COBOL intrinsic functions to ensure correctness:
IDENTIFICATION DIVISION.
PROGRAM-ID. DATECALC.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-CALC-WORK.
05 WS-INT-DATE-1 PIC 9(8).
05 WS-INT-DATE-2 PIC 9(8).
05 WS-RESULT-INT PIC 9(8).
LINKAGE SECTION.
01 LS-DATE-PARAMS.
05 LS-FUNCTION-CODE PIC X(4).
05 LS-INPUT-DATE-1 PIC 9(8).
05 LS-INPUT-DATE-2 PIC 9(8).
05 LS-INPUT-DAYS PIC S9(5).
05 LS-OUTPUT-DATE PIC 9(8).
05 LS-OUTPUT-DAYS PIC S9(7).
05 LS-OUTPUT-DOW PIC 9(1).
05 LS-OUTPUT-DISPLAY PIC X(10).
05 LS-RETURN-CODE PIC 9(2).
05 LS-ERROR-MESSAGE PIC X(50).
PROCEDURE DIVISION USING LS-DATE-PARAMS.
0000-MAIN.
MOVE 00 TO LS-RETURN-CODE
MOVE SPACES TO LS-ERROR-MESSAGE
EVALUATE LS-FUNCTION-CODE
WHEN "ADDY"
PERFORM 1000-ADD-DAYS
WHEN "SUBD"
PERFORM 2000-SUBTRACT-DAYS
WHEN "DIFF"
PERFORM 3000-DATE-DIFFERENCE
WHEN "DOWK"
PERFORM 4000-DAY-OF-WEEK
WHEN OTHER
MOVE 03 TO LS-RETURN-CODE
MOVE "INVALID FUNCTION CODE FOR DATECALC"
TO LS-ERROR-MESSAGE
END-EVALUATE
GOBACK
.
1000-ADD-DAYS.
* Add LS-INPUT-DAYS to LS-INPUT-DATE-1
* Result in LS-OUTPUT-DATE
COMPUTE WS-INT-DATE-1 =
FUNCTION INTEGER-OF-DATE(LS-INPUT-DATE-1)
ON SIZE ERROR
MOVE 04 TO LS-RETURN-CODE
MOVE "INVALID INPUT DATE FOR ADD"
TO LS-ERROR-MESSAGE
GO TO 1000-EXIT
END-COMPUTE
COMPUTE WS-RESULT-INT =
WS-INT-DATE-1 + LS-INPUT-DAYS
IF WS-RESULT-INT < 1
MOVE 04 TO LS-RETURN-CODE
MOVE "RESULT DATE IS BEFORE EPOCH"
TO LS-ERROR-MESSAGE
GO TO 1000-EXIT
END-IF
COMPUTE LS-OUTPUT-DATE =
FUNCTION DATE-OF-INTEGER(WS-RESULT-INT)
ON SIZE ERROR
MOVE 04 TO LS-RETURN-CODE
MOVE "RESULT DATE OUT OF RANGE"
TO LS-ERROR-MESSAGE
END-COMPUTE
.
1000-EXIT.
EXIT.
2000-SUBTRACT-DAYS.
* Subtract LS-INPUT-DAYS from LS-INPUT-DATE-1
COMPUTE WS-INT-DATE-1 =
FUNCTION INTEGER-OF-DATE(LS-INPUT-DATE-1)
ON SIZE ERROR
MOVE 04 TO LS-RETURN-CODE
MOVE "INVALID INPUT DATE FOR SUBTRACT"
TO LS-ERROR-MESSAGE
GO TO 2000-EXIT
END-COMPUTE
COMPUTE WS-RESULT-INT =
WS-INT-DATE-1 - LS-INPUT-DAYS
IF WS-RESULT-INT < 1
MOVE 04 TO LS-RETURN-CODE
MOVE "RESULT DATE IS BEFORE EPOCH"
TO LS-ERROR-MESSAGE
GO TO 2000-EXIT
END-IF
COMPUTE LS-OUTPUT-DATE =
FUNCTION DATE-OF-INTEGER(WS-RESULT-INT)
.
2000-EXIT.
EXIT.
3000-DATE-DIFFERENCE.
* Calculate days between DATE-1 and DATE-2
* Positive if DATE-2 > DATE-1
COMPUTE WS-INT-DATE-1 =
FUNCTION INTEGER-OF-DATE(LS-INPUT-DATE-1)
COMPUTE WS-INT-DATE-2 =
FUNCTION INTEGER-OF-DATE(LS-INPUT-DATE-2)
COMPUTE LS-OUTPUT-DAYS =
WS-INT-DATE-2 - WS-INT-DATE-1
.
4000-DAY-OF-WEEK.
* Determine day of week (1=Sunday ... 7=Saturday)
COMPUTE WS-INT-DATE-1 =
FUNCTION INTEGER-OF-DATE(LS-INPUT-DATE-1)
ON SIZE ERROR
MOVE 04 TO LS-RETURN-CODE
MOVE "INVALID DATE FOR DAY-OF-WEEK"
TO LS-ERROR-MESSAGE
GO TO 4000-EXIT
END-COMPUTE
* COBOL integer dates start from Monday Dec 31 1600
* MOD 7 gives: 0=Mon, 1=Tue, ... 6=Sun
* Convert to 1=Sun, 2=Mon, ... 7=Sat
COMPUTE LS-OUTPUT-DOW =
FUNCTION MOD(WS-INT-DATE-1, 7) + 1
IF LS-OUTPUT-DOW = 8
MOVE 1 TO LS-OUTPUT-DOW
END-IF
.
4000-EXIT.
EXIT.
Subprogram 4: DATEBIZ -- Business Day Functions
The business day subprogram knows about weekends and bank holidays. The holiday table is maintained as a working-storage table that is updated annually:
IDENTIFICATION DIVISION.
PROGRAM-ID. DATEBIZ.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Bank holiday table for the current year
* Updated annually by operations
01 WS-HOLIDAY-TABLE.
05 WS-HOLIDAY-COUNT PIC 9(2) VALUE 11.
05 WS-HOLIDAY-DATES.
10 FILLER PIC 9(8) VALUE 20260101.
10 FILLER PIC 9(8) VALUE 20260119.
10 FILLER PIC 9(8) VALUE 20260216.
10 FILLER PIC 9(8) VALUE 20260525.
10 FILLER PIC 9(8) VALUE 20260703.
10 FILLER PIC 9(8) VALUE 20260907.
10 FILLER PIC 9(8) VALUE 20261012.
10 FILLER PIC 9(8) VALUE 20261111.
10 FILLER PIC 9(8) VALUE 20261126.
10 FILLER PIC 9(8) VALUE 20261225.
10 FILLER PIC 9(8) VALUE 20261231.
05 WS-HOLIDAY-ENTRIES REDEFINES WS-HOLIDAY-DATES.
10 WS-HOLIDAY-DATE PIC 9(8)
OCCURS 11 TIMES.
01 WS-BIZ-WORK.
05 WS-CHECK-DATE PIC 9(8).
05 WS-DOW PIC 9(1).
05 WS-HOLIDAY-IX PIC 9(2).
05 WS-IS-HOLIDAY-FLAG PIC X(1).
88 WS-IS-HOLIDAY VALUE "Y".
88 WS-NOT-HOLIDAY VALUE "N".
LINKAGE SECTION.
01 LS-DATE-PARAMS.
05 LS-FUNCTION-CODE PIC X(4).
05 LS-INPUT-DATE-1 PIC 9(8).
05 LS-INPUT-DATE-2 PIC 9(8).
05 LS-INPUT-DAYS PIC S9(5).
05 LS-OUTPUT-DATE PIC 9(8).
05 LS-OUTPUT-DAYS PIC S9(7).
05 LS-OUTPUT-DOW PIC 9(1).
05 LS-OUTPUT-DISPLAY PIC X(10).
05 LS-RETURN-CODE PIC 9(2).
05 LS-ERROR-MESSAGE PIC X(50).
PROCEDURE DIVISION USING LS-DATE-PARAMS.
0000-MAIN.
MOVE 00 TO LS-RETURN-CODE
MOVE SPACES TO LS-ERROR-MESSAGE
EVALUATE LS-FUNCTION-CODE
WHEN "IBDY"
PERFORM 1000-IS-BUSINESS-DAY
WHEN "NBDY"
PERFORM 2000-NEXT-BUSINESS-DAY
WHEN "PBDY"
PERFORM 3000-PREV-BUSINESS-DAY
WHEN OTHER
MOVE 03 TO LS-RETURN-CODE
MOVE "INVALID FUNCTION FOR DATEBIZ"
TO LS-ERROR-MESSAGE
END-EVALUATE
GOBACK
.
1000-IS-BUSINESS-DAY.
MOVE LS-INPUT-DATE-1 TO WS-CHECK-DATE
PERFORM 5000-CHECK-WEEKEND
IF LS-RETURN-CODE NOT = 00
GO TO 1000-EXIT
END-IF
PERFORM 5100-CHECK-HOLIDAY
.
1000-EXIT.
EXIT.
2000-NEXT-BUSINESS-DAY.
* Find the next business day on or after INPUT-DATE-1
MOVE LS-INPUT-DATE-1 TO WS-CHECK-DATE
PERFORM 5200-ADVANCE-TO-BUSINESS-DAY
MOVE WS-CHECK-DATE TO LS-OUTPUT-DATE
.
3000-PREV-BUSINESS-DAY.
* Find the previous business day on or before INPUT-DATE-1
MOVE LS-INPUT-DATE-1 TO WS-CHECK-DATE
PERFORM 5300-RETREAT-TO-BUSINESS-DAY
MOVE WS-CHECK-DATE TO LS-OUTPUT-DATE
.
5000-CHECK-WEEKEND.
* Determine if WS-CHECK-DATE falls on a weekend
COMPUTE WS-DOW = FUNCTION MOD(
FUNCTION INTEGER-OF-DATE(WS-CHECK-DATE), 7)
+ 1
IF WS-DOW = 8
MOVE 1 TO WS-DOW
END-IF
* 1=Sunday, 7=Saturday
IF WS-DOW = 1 OR WS-DOW = 7
MOVE 06 TO LS-RETURN-CODE
MOVE "DATE FALLS ON A WEEKEND"
TO LS-ERROR-MESSAGE
END-IF
.
5100-CHECK-HOLIDAY.
SET WS-NOT-HOLIDAY TO TRUE
PERFORM VARYING WS-HOLIDAY-IX
FROM 1 BY 1
UNTIL WS-HOLIDAY-IX > WS-HOLIDAY-COUNT
OR WS-IS-HOLIDAY
IF WS-CHECK-DATE =
WS-HOLIDAY-DATE(WS-HOLIDAY-IX)
SET WS-IS-HOLIDAY TO TRUE
MOVE 05 TO LS-RETURN-CODE
MOVE "DATE IS A BANK HOLIDAY"
TO LS-ERROR-MESSAGE
END-IF
END-PERFORM
.
5200-ADVANCE-TO-BUSINESS-DAY.
MOVE 00 TO LS-RETURN-CODE
PERFORM 1000-IS-BUSINESS-DAY
PERFORM UNTIL LS-RETURN-CODE = 00
COMPUTE WS-CHECK-DATE =
FUNCTION DATE-OF-INTEGER(
FUNCTION INTEGER-OF-DATE(WS-CHECK-DATE)
+ 1)
MOVE 00 TO LS-RETURN-CODE
PERFORM 1000-IS-BUSINESS-DAY
END-PERFORM
.
5300-RETREAT-TO-BUSINESS-DAY.
MOVE 00 TO LS-RETURN-CODE
PERFORM 1000-IS-BUSINESS-DAY
PERFORM UNTIL LS-RETURN-CODE = 00
COMPUTE WS-CHECK-DATE =
FUNCTION DATE-OF-INTEGER(
FUNCTION INTEGER-OF-DATE(WS-CHECK-DATE)
- 1)
MOVE 00 TO LS-RETURN-CODE
PERFORM 1000-IS-BUSINESS-DAY
END-PERFORM
.
Calling the Library from a Banking Program
Here is how a loan interest calculation program calls the date library:
IDENTIFICATION DIVISION.
PROGRAM-ID. LOANINT.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-DATE-PARAMS.
COPY DATEPARM.
01 WS-LOAN-FIELDS.
05 WS-LOAN-START-DATE PIC 9(8).
05 WS-LOAN-END-DATE PIC 9(8).
05 WS-INTEREST-DAYS PIC S9(7).
PROCEDURE DIVISION.
1000-CALCULATE-INTEREST-PERIOD.
* Validate the start date
SET DP-VALIDATE TO TRUE
MOVE WS-LOAN-START-DATE TO DP-INPUT-DATE-1
CALL "DATEVAL" USING WS-DATE-PARAMS
IF NOT DP-SUCCESS
DISPLAY "INVALID START DATE: "
DP-ERROR-MESSAGE
GO TO 1000-EXIT
END-IF
* Validate the end date
MOVE WS-LOAN-END-DATE TO DP-INPUT-DATE-1
CALL "DATEVAL" USING WS-DATE-PARAMS
IF NOT DP-SUCCESS
DISPLAY "INVALID END DATE: "
DP-ERROR-MESSAGE
GO TO 1000-EXIT
END-IF
* Calculate days between dates
SET DP-DIFF-DAYS TO TRUE
MOVE WS-LOAN-START-DATE TO DP-INPUT-DATE-1
MOVE WS-LOAN-END-DATE TO DP-INPUT-DATE-2
CALL "DATECALC" USING WS-DATE-PARAMS
IF DP-SUCCESS
MOVE DP-OUTPUT-DAYS TO WS-INTEREST-DAYS
DISPLAY "INTEREST ACCRUAL PERIOD: "
WS-INTEREST-DAYS " DAYS"
ELSE
DISPLAY "DATE CALCULATION ERROR: "
DP-ERROR-MESSAGE
END-IF
* Find next business day for settlement
SET DP-NEXT-BIZ-DAY TO TRUE
MOVE WS-LOAN-END-DATE TO DP-INPUT-DATE-1
CALL "DATEBIZ" USING WS-DATE-PARAMS
IF DP-SUCCESS
DISPLAY "SETTLEMENT DATE: " DP-OUTPUT-DATE
END-IF
.
1000-EXIT.
EXIT.
JCL for Compiling and Linking the Library
//DATELIB JOB (ACCT),'DATE LIBRARY BUILD',
// CLASS=A,MSGCLASS=X,NOTIFY=&SYSUID
//*
//* COMPILE EACH SUBPROGRAM
//*
//COMPVAL EXEC PGM=IGYCRCTL,PARM='LIB,OBJECT'
//STEPLIB DD DSN=IGY.V6R4M0.SIGYCOMP,DISP=SHR
//SYSIN DD DSN=DEV.SOURCE.COBOL(DATEVAL),DISP=SHR
//SYSLIB DD DSN=DEV.COPYLIB,DISP=SHR
//SYSLIN DD DSN=&&OBJVAL,DISP=(NEW,PASS),
// SPACE=(CYL,(1,1))
//SYSPRINT DD SYSOUT=*
//SYSUT1 DD SPACE=(CYL,(1,1))
//*
//COMPCVT EXEC PGM=IGYCRCTL,PARM='LIB,OBJECT'
//STEPLIB DD DSN=IGY.V6R4M0.SIGYCOMP,DISP=SHR
//SYSIN DD DSN=DEV.SOURCE.COBOL(DATECVT),DISP=SHR
//SYSLIB DD DSN=DEV.COPYLIB,DISP=SHR
//SYSLIN DD DSN=&&OBJCVT,DISP=(NEW,PASS),
// SPACE=(CYL,(1,1))
//SYSPRINT DD SYSOUT=*
//SYSUT1 DD SPACE=(CYL,(1,1))
//*
//COMPCALC EXEC PGM=IGYCRCTL,PARM='LIB,OBJECT'
//STEPLIB DD DSN=IGY.V6R4M0.SIGYCOMP,DISP=SHR
//SYSIN DD DSN=DEV.SOURCE.COBOL(DATECALC),DISP=SHR
//SYSLIB DD DSN=DEV.COPYLIB,DISP=SHR
//SYSLIN DD DSN=&&OBJCALC,DISP=(NEW,PASS),
// SPACE=(CYL,(1,1))
//SYSPRINT DD SYSOUT=*
//SYSUT1 DD SPACE=(CYL,(1,1))
//*
//COMPBIZ EXEC PGM=IGYCRCTL,PARM='LIB,OBJECT'
//STEPLIB DD DSN=IGY.V6R4M0.SIGYCOMP,DISP=SHR
//SYSIN DD DSN=DEV.SOURCE.COBOL(DATEBIZ),DISP=SHR
//SYSLIB DD DSN=DEV.COPYLIB,DISP=SHR
//SYSLIN DD DSN=&&OBJBIZ,DISP=(NEW,PASS),
// SPACE=(CYL,(1,1))
//SYSPRINT DD SYSOUT=*
//SYSUT1 DD SPACE=(CYL,(1,1))
//*
//* LINK ALL FOUR INTO A LOAD LIBRARY
//*
//LINK EXEC PGM=IEWL,PARM='LIST,MAP,XREF'
//SYSLIN DD DSN=&&OBJVAL,DISP=(OLD,DELETE)
// DD DSN=&&OBJCVT,DISP=(OLD,DELETE)
// DD DSN=&&OBJCALC,DISP=(OLD,DELETE)
// DD DSN=&&OBJBIZ,DISP=(OLD,DELETE)
//SYSLMOD DD DSN=PROD.LOADLIB,DISP=SHR
//SYSPRINT DD SYSOUT=*
Lessons Learned
1. GOBACK vs. STOP RUN in Subprograms
Subprograms must use GOBACK, not STOP RUN. STOP RUN terminates the entire run unit (including the calling program), while GOBACK returns control to the caller. This is the most common mistake when writing COBOL subprograms.
2. The Parameter Block Pattern Enables Extensibility
By defining all parameters in a single group item (the parameter block), new functions and output fields can be added without changing the CALL statement in existing callers. The callers pass the same parameter block; they simply set a different function code and use different output fields.
3. Centralizing Date Logic Eliminates Inconsistency
After deploying the library, the bank retired 47 separate date validation routines embedded in individual programs. All 200+ programs now use the same leap year logic, the same holiday table, and the same date arithmetic. When the Federal Reserve added Juneteenth as a bank holiday, the change required updating one table in one subprogram.
4. Static vs. Dynamic CALL Matters for Performance
The loan interest program calls DATEVAL for every loan record -- potentially millions of times per batch run. Using a static CALL (with a literal program name) avoids the overhead of dynamic program loading. The DATEBIZ subprogram, called less frequently, uses a dynamic CALL since its holiday table may be updated between batch runs without relinking the callers.
Discussion Questions
-
The holiday table is hardcoded in DATEBIZ's WORKING-STORAGE. What are the disadvantages of this approach? How would you redesign the holiday table to be loaded from a file or database at program initialization?
-
Why does the parameter block use a single function code field rather than having separate CALL targets for each function (CALL "DATEVAL-VALIDATE", CALL "DATEVAL-RANGE", etc.)? What are the trade-offs of each approach?
-
The DATECALC subprogram relies on COBOL intrinsic functions (INTEGER-OF-DATE, DATE-OF-INTEGER). What would the implementation look like on a compiler that does not support these functions? How much more complex would it be?
-
If two programs call DATEBIZ concurrently in a multi-threaded CICS environment, could the WORKING-STORAGE variables cause a conflict? How does COBOL handle working storage in called programs under CICS?
-
The library currently supports dates from 1900 to 2099. What would need to change to support dates beyond 2099? Are there financial applications where dates beyond 2099 are relevant today?