Find 'em, Fix 'em / Investigation and Planning /Know where you're going /Analyze source changes

Analyze, Find, and Fix

The ACCEPT statement

 01 WS-DATE PIC 99.
    05 WS-YY PIC 99.
    05 WS-MM PIC 99.
    05 WS-DD PIC 99.
 01 EMPLOYEE-RECORD.
    05 EMPLOYEE-ID PIC 9(9).
    05 EMPLOYEE-BD.
       10 EMP-BD-YY PIC 99.
       10 EMP-BD-MM PIC 99.
       10 EMP-DB-DD PIC 99.

ACCEPT WS-DATE FROM DATE.
COMPUTE EMP-AGE = WS-YY -
                EMP-BD-YY.
You picked up on the "YY" names, right? An obvious naming convention to look for. Did you remember that older compilers return a 2-digit date with the ACCEPT statement? You could use a window technique with the older compiler or use Language Environment callable services or a common date routine (replacing the ACCEPT statement with something like
MOVE FUNCTION CURRENT-DATE(1:8) TO WS-DATE
(after changing WS-YY to PIC 9999, of course)

What about the result of the COMPUTE statement? With four-digit years, EMP-AGE needs to be PIC 9999.

Hard-coded century

01 SERVICE-DATE.
   05 CC              PIC 99.
   05 YY              PIC 99.
   05 MM              PIC 99.
   05 DD              PIC 99.
01 SERVICE-RECORD.
   05 SERVICE-MM      PIC 99.
   05 SERVICE-DD      PIC 99.
   05 SERVICE-YY      PIC 99.
   05 SERVICE-DETAILS PIC X(255).

MOVE SERVICE-YY TO YY.
MOVE SERVICE-MM TO MM.
MOVE SERVICE-DD TO DD
MOVE 19 TO CC.
You might have thought that this was ready at first seeing that CC field for the century. Don't overlook the "19."

You will have to implement some way to represent the correct century.

Year literals

IF CUR-YR <= 77
   MOVE 4 TO DC
ELSE
   MOVE 5 TO DC
END-IF.
If you do name searches only, you will miss some changes. In this sample, is "77" a year? Most likely, but you will have to verify that it isn't a special value. If it is a year, you need to change the literal to "1977."

Notice that this makes DC a date-affected element. Since it does not contain a date itself, it may not need to be changed.

Double-duty values

77 WS-CONTACT-YEAR      PIC 99.
READ CONTACT-FILE
   AT END MOVE 99 TO
       WS-CONTACT-YEAR.
Despite its name, WS-CONTACT-YEAR is not just a date field: it is doing double-duty as an end-of-file switch, which passes end-of-file status to another part of the program.

The switch value, however, conflicts with a valid year value.

Date forms

77 EFFECTIVE-DATE    PIC 99999.

COMPUTE EFF-DATE =
   99999 - EFFECTIVE-DATE.	
A date is being converted from Julian to 9's complement Julian. Expand the numeric literal if you keep the date remains in 9's complement form.

Julian reserved values

01 DOB.
   05 DOB-YY      PIC 99.
   05 DOB-DDD     PIC 999.

IF DOB-DDD > 386 OR DOB-DDD = 0
   MOVE 'A' TO RET-CODE
   MOVE 'B'
     TO OCCUR-DATE-ERROR (SUB)
   GO TO 500-VALID-OCCURS-EXIT
END-IF
The Julian day-of-year contains reserved values - values in the range 367-386 are not treated as an error.

You would need to investigate further to confirm this and seek a way to move those reserved values to another variable, so that standard date routines can be used.

Incomplete century values

77 POLICY-YYYY     PIC 9999.
01 POLICY.
   05 POLICY-DD    PIC 99.
   05 POLICY-MM    PIC 99.
   05 POLICY-YY    PIC 99.
   05 POLICY-CC    PIC 99.
   05 POLICY-CI    PIC 9.

IF POLICY-CI = 1 THEN
   POLICY-YYYY = 1700 +
                  POLICY-YY
ELSEIF POLICY-CI = 2 THEN
   POLICY-YYYY = 1800 +
                  POLICY-YY
ELSEIF POLICY-CI = 3 THEN
   POLICY-YYYY = 1900 +
                  POLICY-YY
ELSE PERFORM POLICY-CI ERROR
END-IF
Well, we are on the right track here, using a century indicator and expanding into a 4-digit year.

If you keep the century indicator approach, extend the expansion to 2000.

If you replace the century indicator with a 4-digit year, convert the associated. files.

Wrong leap year

MOVE C-MM TO W-MM MM.
MOVE C-DD TO W-DY DY.
NIVE C-YY TO W-YR YR.

DIVIDE C-YY BY 4 GIVING WORK1-WS
   REMAINDER REMN-WS
IF REMN-WS = 0
   MOVE 29 TO DOM-WS (2)
END-IF
IF C-MM = 1
   COMPUTE INT-STARTA =
           123100 + (C-YY - 1)
ELSE
   COMPUTE A = C-MM - 1
   COMPUTE INT-STARTA =
           A * 10000 +
           DOM-WS (A) * 100 +
           C-YY
END-IF
This computation of leap year will fail every 100 years.

It calculates the last day of the prior month and converts the date format inline.

Replace such hand-coded logic with standard date routines.

Forgot about leap year

COMPUTE D9-CUR-DT = XDYR *
                 1000 + YDDA
EVALUATE XDMO
 WHEN  1 ADD 000 TO D9-CURR-DT
 WHEN  2 ADD 031 TO D9-CURR-DT
 WHEN  3 ADD 059 TO D9-CURR-DT
 WHEN  4 ADD 090 TO D9-CURR-DT
 WHEN  5 ADD 120 TO D9-CURR-DT
 WHEN  6 ADD 151 TO D9-CURR-DT
 WHEN  7 ADD 181 TO D9-CURR-DT
 WHEN  8 ADD 212 TO D9-CURR-DT
 WHEN  9 ADD 243 TO D9-CURR-DT
 WHEN 10 ADD 273 TO D9-CURR-DT
 WHEN 11 ADD 304 TO D9-CURR-DT
 WHEN 12 ADD 334 TO D9-CURR-DT
END-EVALUATE
MOVE D9-CURR-DT TO D9-BATCH
This logic is computing the number of days in the current year.

But it does not account for leap years when adding the number of days for months 3 through 12 and will be off by 1 in leap years.

You should consider replacing such logic with standard date routines.

Not ready standard date routine

01 CUR-DT-X-WS.
   05 CUR-DT-MMDDYY PIC XXXXX.
   05 CUR-MO-X-WS   PIC 99.
   05 CUR-DA-X-WS   PIC 99.
   05 CUR-YR-X-WS   PIC 99.
   05 XDATE-RC      PIC S9(4).
01 CUR-DATE-9-WS  PIC 999999.

CALL 'XDATE' USING CUR-DT-X-WS.

COMPUTE CUR-DATE-9-WS =
     CUR-MO-X-WS * 10000
   + CUR-DA-X-WS * 100
   + CUR-YR-X-WS.
Here a standard date routine (XDATE) is being called, but it is not year 2000 ready (it is returning a year of only 2 digits). And the return code is not being checked.

Replace the date routine with a year 2000 ready routine. And check the return code.

You will have to upgrade the year arguments to these routines, of course.

Sort keys

SORT SORT-FILE
  ASCENDING  KEY SORT-SSN-SID
  DESCENDING KEY SORT-TY
  ASCENDING  KEY SORT-TRC
                       SORT-DTE
  INPUT PROCEDURE INPUT-SECTION
  GIVING JSACC-FILE.
One of the sort keys in this fragment is probably a date.

If your year 2000 solution for this date is windowing or compression, implement a correct sort order with input/output procedures for internal sorts, a user exit for external sorts, or a sort utility with date windowing or encoding capability, such as DFSORT.

Using dates in non-date calculations

COMPUTE-SECURITY.
 MOVE TORWRLX TO WS-JUL-DATE.
 MOVE 'ZITEBYDT' TO WS-PGMDATE.
 CALL 'ICSCUTLY'
   USING ICSTWADS WS-PGMDATE
         WS-JUL-DATE WS-CUR-DT.
 COMPUTE WS-PASS-VALUE =
     WS-CUR-YY
   + (((WS-CUR-DD ** 8) * 5)
     + WS-CUR-MM).
 COMPUTE WS-PASS-EVEN =
   (WS-PASS-VALUE / 2).
 IF WS-PASS-REMAINER GREATER
   THAN ZEROES
     COMPUTE WS-SECURITY-CODE =
         (WS-PASS-VALUE + 7)
 END-IF.
EXIT.
This program creates a security code based on the value of a date.

It is an example of a date used for non-date calculations.

Verify changes to the date field to ensure that security is not compromised.

Redefined records

01 CUST-MASTER.
   05 CUST-ID        PIC X(10).
   05 CUST-ACTIVE-DTE.
      10 CUST-YY     PIC 99.
      10 CUST-DDD    PIC 999.
   05 CUST-NAME      PIC X(32).
   05 CUST-ADDR      PIC X(80).
   05 FILLER         PIC X(66).
01 CUST-CODES REDEFINES
                 CUST-MASTER.
   05 FILLER         PIC X(124).
   05 CUST-CODE      PIC 999
                OCCURS 20 TIMES.

PERFORM VARING CODE-PTR
              FROM 1 TO 20
  MOVE CUST-CODE(CODE-PTR) TO
       REPORT-CODE(CODE-PTR)
END-PERFORM.
Redefined records that contain dates require changing the redefinition if you use date expansion.

In this code fragment, the CUST-MASTER record contains a date, and the record is redefined.

To make things worse, the redefinition is wrong! The byte-offset problem (first CUST-CODE overlays the end of CUST-ADDR) is a latent defect on its own. Don't get distracted with fixing code that is not related to the year 2000 work; make it part of your regular maintenance.

Inconsistent record definitions

PROGRAM-ID. ADC537.
01 PAY-MASTER.
   05 EMP-ID    PIC X(10).
   05 PAY-DTE.
      10 PAY-YY  PIC 99.
      10 PAY-DDD PIC 999.
   05 FILLER
MOVE WS-YY TO PAY-YY.
MOVE WS-DDD TO PAY-DDD.
WRITE PAY-MASTER.
PROGRAM-ID.  BYC295
01 PAYROLL-MASTER
   05 EMPLOYEE-ID PIC X(10).
   05 PAY-DATE    PIC 99999.
   05 FILLER      PIC X(120).

MOVE WS-DATE TO PAY-DATE.
WRITE PAYROLL-MASTER.
Both these programs seem to be writing 2-digit years to the same file. But each programs has its own, hard-coded, record definition. Put record definitions into a copybook during your year 2000 work to ensure consistency.

Dates in record keys

FILE-CONTROL
  SELECT CUST-FILE
            ASSIGN TO MR-FILE.
    ORGANIZATION IS INDEXED
    RECORD KEY IS KEY2-MR. . .

MOVE INQKEY-E TO KEY1-MR
COMPUTE X = 100 - CUST-YY
MOVE X TO KEY2-MR
Here is a date included in the record key to a file

The year is being converted to 10's complement form before being used as a key.

Changes to the date field will require reloading the file.

Interfaces

PROGRAM -ID.  CRN252.

77 SUBR-NAME      PIC X(8).
LINKAGE SECTION.
77 REC-DTE        PIC 9(6).
77 REC-QTY        PIC S9999.
77 DUE-DTE        PIC 9(6).
77 OD-DAYS        PIC S999.

PROCEDURE DIVISION.

MOVE 'CRM638' TO SUBR-NAME.
CALL SUBR-NAME USING DUE-DTE
                     REC-DTE
                     REC-QTY
                     OD-DAYS.
PROGRAM-ID.  CRM638.

LINKAGE SECTION.
77 QUANTITY-RECVD        PIC S9999.
77 DATE-RECEIVED         PIC 9(6).
77 DATE-DUE              PIC 9(6)
77 DAYS-OVERDUE          PIC S999.

PROCEDURE DIVISION
   USING DATE-DUE
         DATE-RECEIVED
         QUANTITY-RECVD
         DAYS-OVERDUE.

PERFORM COMPUTE-DAYS-OVERDUE.
The interface between these programs id a dynamic call, with the program on the left invoking the one on the right. Some of the parameters are dates with 2-digit years. When you find the date impacts of one program, realize that the invoked program also is impacted.

Not using SQL DATE type

DATA DIVISION.
77 START-DATE              PIC X(6).
EXEC SQL DECLARE XR7.PATIENT TABLE (
  PATIENT_ID    INTEGER   NOT NULL,
  PATIENT_NAME  CHARACTER(30) NOT NULL
 END-EXEC.
EXEC SQL DECLARE XR7.STAY TABLE (
  PATIENT_ID INTEGER    NOT NULL
  ADMISSION_DATE CHARACTER(6) NOT NULL
  DISCHARGE_DATE CHARACTER(6) NOT NULL
  TREATMENT_CODE CHARACTER(8) NOT NULL
END SQL.
EXEC SQL DECLARE C1 CURSOR FOR
  SELECT P.PATIENT_NAME
         S.ADMISSION_DATE
         S.DISCHARGE_DATE
  FROM XR7.PATIENT P XR7.STAY S
  WHERE P.PATIENT_ID = S.PATEIENT.ID AND
    S.ADMISSIONS_DATE >= :START_DATE
  ORDER BY 1, 2, 3
  FOR FETCH ONLY
END-EXEC.
PROCEDURE DIVISION.
MAINLINE.
  MOVE '960101' TO START-DATE
  EXEC SQL OPEN C1 END-EXEC
  PERFORM MAIN-LOOP
    UNTIL SQLCODE NOT = ZERO
  EXEC SQL CLOSE C1 END-EXEC
  GOBACK.
MAIN-LOOP.
  MOVE SPACES TO STAY-DATA
  EXEC SQL
    FETCH C1 INTO :STAY-DATA
  END-EXEC
  PERFORM COMPUTE-LENGTH-OF-STAY
  PERFORM PRINT-PATIENT-DATA.
Wondering why you didn't use use the DATE type? Well, you didn't, and now you have to change this code by getting those dates out of character format and into DATE format. And--don't forget about the impact to the database itself , unless you are able to choose a windowing approach.

Truncation of century

01 TODAYS-DATE.
   05 TODAY-YEAR      PIC 9999.
   05 TODAY-MONTH     PIC 99.
   05 TODAY-DAY       PIC 99.
01 STUDENT-RECORD.
   05 STUDENT-ID      PIC 9(9).
   05 STUDENT-ADMISSION-DATE.
      10 STU-ADM-MONTH  PIC 99.
      10 STU-ADM-DAY    PIC 99.
      10 STU-ADM-CNETURY PIC 99.
      10 STU-ADM-YEAR   PIC 99.

ACCEPT TODAYS-DATE FROM DATE.
MOVE TODAY-MONTH TO
                STU-ADM-MONTH.
MOVE TODAY-DAY TO STU-ADM-DAY.
MOVE TODAY-YEAR TO STU-ADM-YEAR.
WRITE STUDENT-MASTER FROM
             STUDENT-RECORD.
If you look only at the data declarations for this fragment, you will not see the problem. The declarations are year 2000 ready but the century bytes returned into TODAY-YEAR are lost by truncation during processing.

You might miss this type of problem without manual code inspection, automated data flow analysis, or automated data value analysis.

Truncation during computation

01 TODAYS-DATE.
   05 TODAY-YEAR      PIC 9999.
   05 TODAY-MONTH     PIC 99.
   05 TODAY-DAY       PIC 99.
   05 FILLER          PIC X(13).
01 ASSET-RECORD.
   05 ASSET-ID        PIC 9(9).
   05 ASSET-DATE.
      10 ASSET-YEAR   PIC 9999.
      10 ASSET-MONTH  PIC 99.
      10 ASSET-DAY    PIC 99.
   05 FILLER          PIC X(842).
01 ASSET-AGE          PIC 99.
MOVE FUNCTION CURRENT-DATE TO
              TODAYS-DATE.
ASSET-AGE = (FUNCTION
   INTEGER-OF-DATE(TODAYS-DATE)
  - FUNCTION INTEGER-OF-DATE(
                ASSET-DATE))
   / 365.
This is another one that you might not see right away. The date declarations and the date functions are all year 2000 ready.

But the ASSET-AGE field was not expanded to accommodate a full range and will truncate any age of 99 years.

You can see how the date impact needs to be traced through the logic of impacted programs.