Find 'em, Fix 'em / Investigation and Planning /Know where you're going /Analyze source changes
![]() |
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. |
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. |
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. |
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. |
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. |
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. |
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. |
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. |
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. |
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 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. |
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. |
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. |
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. |
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. |
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. |
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. |
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. |
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. |