IDENTIFICATION DIVISION. PROGRAM-ID. SAMPLE. ************************************************** * VALIDATES TRANSACTION FILE AND PRINTS ERRORS * ************************************************** ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT TRANS-FILE-IN ASSIGN TO 'INVALID1'. SELECT ERROR-LIST-OUT ASSIGN TO PRINTER. * DATA DIVISION. FILE SECTION. FD TRANS-FILE-IN LABEL RECORDS ARE STANDARD. 01 TRANS-REC-IN. 05 SS-NO-IN PIC 9(9). 05 NAME-IN PIC X(20). 05 EMPL-ADDR-IN PIC X(20). 05 TRANS-CODE-IN PIC 9. 88 VALID-CODE-IN VALUE 1 THRU 9. 05 ANNUAL-SALARY-IN PIC 9(5). 88 ACCEPTABLE-SALARY-RANGE-IN VALUE 15000 THRU 87000. 05 MARITAL-STATUS-IN PIC X. 88 MARRIED VALUE 'M'. 88 SINGLE VALUE 'S'. 88 DIVORCED VALUE 'D'. 88 WIDOWED VALUE 'W'. 05 LEVEL-IN PIC 9. 88 ACCEPTABLE-LEVEL-IN VALUE 1 THRU 6. 05 DEPT-IN PIC 99. 05 PIC X(41). FD ERROR-LIST-OUT LABEL RECORDS OMITTED. 01 ERROR-REC-OUT PIC X(132). WORKING-STORAGE SECTION. 01 WS-AREAS. 05 ARE-THERE-MORE-RECORDS PIC X(3) VALUE 'YES'. 88 NO-MORE-RECORDS VALUE 'NO '. 05 WS-LINE-CT PIC 99 VALUE ZEROS. *** date fields must be 8 characters to include a 4-digit year * *** in order to be Y2K compliant 05 WS-DATE PIC X(21). 05 WS-DATE-X REDEFINES WS-DATE. 10 WS-YR PIC 9999. 10 WS-MO PIC 99. 10 WS-DA PIC 99. 10 WS-TIME PIC X(13). 05 WS-ERROR-CT PIC 9 VALUE ZERO. 05 WS-PAGE-CT PIC 99 VALUE ZEROS. 01 HL-HEADING-1. 05 PIC X(19) VALUE SPACES. 05 PIC X(35) VALUE 'LISTING OF TRANSACTION ERRORS'. 05 PIC X(5) VALUE 'PAGE '. 05 HL-PAGE-NO PIC Z9. 05 PIC X(10) VALUE SPACES. 05 HL-DATE. 10 HL-MO PIC 99. 10 PIC X VALUE '/'. 10 HL-DA PIC 99. 10 PIC X VALUE '/'. 10 HL-YR PIC 9999. 05 PIC X(51) VALUE SPACES. 01 HL-HEADER-2. 05 PIC X(9) VALUE SPACES. 05 PIC X(30) VALUE 'NAME'. 05 PIC X(35) VALUE 'ERROR MESSAGE'. 05 PIC X(58) VALUE 'VALUE IN ERROR FIELD'. 01 DL-DETAIL-LINE. 05 PIC X(9) VALUE SPACES. 05 DL-NAME PIC X(20). 05 PIC X(10) VALUE SPACES. 05 DL-ERROR-MESSAGE PIC X(25). 05 PIC X(10) VALUE SPACES. 05 DL-FIELD-IN-ERROR PIC X(20). 05 PIC X(38) VALUE SPACES. * PROCEDURE DIVISION. ***************************************** * CONTROLS DIRECTION OF PROGRAM LOGIC * * AND READS THE FIRST RECORD. * ***************************************** 100-MAIN-MODULE. PERFORM 500-INITIALIZATION-RTN PERFORM 400-HEADING-RTN PERFORM UNTIL NO-MORE-RECORDS READ TRANS-FILE-IN AT END MOVE 'NO ' TO ARE-THERE-MORE-RECORDS NOT AT END PERFORM 200-ERROR-CHECK END-READ END-PERFORM PERFORM 600-END-OF-JOB-RTN STOP RUN. ***************************************************************** * PERFORMED FROM 100-MAIN-MODULE; TESTS INPUT DATA FOR ERRORS * ***************************************************************** 200-ERROR-CHECK. MOVE NAME-IN TO DL-NAME IF SS-NO-IN NOT NUMERIC MOVE SS-NO-IN TO DL-FIELD-IN-ERROR MOVE 'SS NO IS INVALID' TO DL-ERROR-MESSAGE PERFORM 300-ERROR-RTN END-IF IF NAME-IN = SPACES MOVE NAME-IN TO DL-FIELD-IN-ERROR MOVE 'NAME IS INVALID' TO DL-ERROR-MESSAGE PERFORM 300-ERROR-RTN END-IF IF EMPL-ADDR-IN = SPACES MOVE EMPL-ADDR-IN TO DL-FIELD-IN-ERROR MOVE 'ADDRESS IS INVALID' TO DL-ERROR-MESSAGE PERFORM 300-ERROR-RTN END-IF IF NOT VALID-CODE-IN MOVE TRANS-CODE-IN TO DL-FIELD-IN-ERROR MOVE 'TRANS CODE IS INVALID' TO DL-ERROR-MESSAGE PERFORM 300-ERROR-RTN END-IF IF NOT ACCEPTABLE-SALARY-RANGE-IN MOVE ANNUAL-SALARY-IN TO DL-FIELD-IN-ERROR MOVE 'SALARY IS INVALID' TO DL-ERROR-MESSAGE PERFORM 300-ERROR-RTN END-IF IF NOT MARRIED AND NOT SINGLE AND NOT DIVORCED AND NOT WIDOWED MOVE MARITAL-STATUS-IN TO DL-FIELD-IN-ERROR MOVE 'MARITAL STATUS IS INVALID' TO DL-ERROR-MESSAGE PERFORM 300-ERROR-RTN END-IF IF NOT ACCEPTABLE-LEVEL-IN MOVE LEVEL-IN TO DL-FIELD-IN-ERROR MOVE 'LEVEL IS INVALID' TO DL-ERROR-MESSAGE PERFORM 300-ERROR-RTN END-IF IF DEPT-IN NOT = 10 AND NOT = 20 AND NOT = 25 MOVE DEPT-IN TO DL-FIELD-IN-ERROR MOVE 'DEPT IS INVALID' TO DL-ERROR-MESSAGE PERFORM 300-ERROR-RTN END-IF IF WS-LINE-CT > 25 PERFORM 400-HEADING-RTN END-IF IF WS-ERROR-CT = ZERO MOVE WS-ERROR-CT TO DL-FIELD-IN-ERROR MOVE 'A-OK' TO DL-ERROR-MESSAGE WRITE ERROR-REC-OUT FROM DL-DETAIL-LINE AFTER ADVANCING 2 LINES ADD 1 TO WS-LINE-CT ELSE MOVE ZEROS TO WS-ERROR-CT END-IF. *************************************************************** * PERFORMED FROM 200-ERROR-CHECK, PRINTS THE ERROR MESSAGES * * WHEN ERRORS OCCUR. * *************************************************************** 300-ERROR-RTN. IF WS-LINE-CT > 25 PERFORM 400-HEADING-RTN END-IF WRITE ERROR-REC-OUT FROM DL-DETAIL-LINE AFTER ADVANCING 2 LINES ADD 1 TO WS-LINE-CT ADD 1 TO WS-ERROR-CT. ****************************************************************** * PERFORMED FROM 100-MAIN-MODULE, 200-ERROR-CHECK, 300-ERROR-RTN* * PRINTS OUT HEADINGS AFTER NEW PAGE, ZEROS OUT LINE CTR. * ****************************************************************** 400-HEADING-RTN. ADD 1 TO WS-PAGE-CT MOVE WS-PAGE-CT TO HL-PAGE-NO WRITE ERROR-REC-OUT FROM HL-HEADING-1 AFTER ADVANCING PAGE WRITE ERROR-REC-OUT FROM HL-HEADER-2 AFTER ADVANCING 1 LINES MOVE ZEROS TO WS-LINE-CT. ****************************************************** * PERFORMED FROM 100-MAIN-MODULE. OPENS THE FILES, * * READS IN THE CURRENT DATE * ****************************************************** 500-INITIALIZATION-RTN. OPEN INPUT TRANS-FILE-IN OUTPUT ERROR-LIST-OUT ************************************************************ **TO MAKE THIS PROGRAM Y2K COMPLIANT YOU CAN: ** **A) HAVE THE USER INPUT A DATE WITH A 4-DIGIT YEAR ** WHICH YOU THEN STORE IN A 4-DIGIT YEAR FIELD. ** **B) USE THE CURRENT-DATE FUNCTION ** MOVE FUNCTION CURRENT-DATE TO DATE-AND-TIME ** WHICH IS A 21-POSITION FIELD AS FOLLOWS: ** 01 DATE-AND-TIME. ** 05 FOUR-DIGIT-YEAR PIC 9999. ** 05 T-MONTH PIC 99. ** 05 T-DAY PIC 99. ** 05 T-TIME PIC X(13). ** SEE PAGE 266 OF THE TEXT. NOTE THAT THIS ** PROCEDURE IS ONLY AVAILABLE WITH COMPILERS ** LIKE MICROFOCUS THAT ACCEPT INTRINSIC FUNCTIONS. ** **C) IF YOU KNOW THAT THE DATE HAS A YEAR < 2000 ** MOVE 19 TO THE LEFTMOST TWO DIGITS OF A ** FOUR-DIGIT YEAR. THAT IS, DEFINE FOUR-DIGIT-YEAR ** AS A GROUP ITEM SUBDIVIDED INTO TWO ELEMENTARY ** ITEMS AND MOVE 19 TO THE HIGH-ORDER OR LEFTMOST ** DIGITS. IF YOU KNOW THAT THE DATE HAS A YEAR >= ** 1999 MOVE 20 (FOR THE NEXT MILLENIUM) TO THE ** HIGH-ORDER OR LEFTMOST TWO-DIGITS. ** ALTERNATIVELY, YOU CAN DEFINE ALL TWO-DIGIT ** YEARS > 25 AS BEING TWENTIETH CENTURY DATES ** AND ALL TWO-DIGIT YEARS <= 25 AS BEING TWENTY- ** FIRST CENTURY YEARS, WHERE 25 IS AN ARBITRARY ** CUT-OFF POINT. FOR EXAMPLE: ** IF YEAR <= 25 ** MOVE 20 TO CENTURY-YEAR OF FOUR-DIGIT-YEAR ** ELSE ** MOVE 19 TO CENTURY-YEAR OF FOUR-DIGIT-YEAR ** END-IF ** MOVE YEAR TO TWO-DIGIT-YEAR. ** ** WHERE THE FOUR-DIGIT YEAR IS DEFINED AS: ** 05 FOUR-DIGIT-YEAR. ** 10 CENTURY-YEAR PIC 99. ** 10 TWO-DIGIT-YEAR PIC 99. ********************************************************* * ACCEPT WS-DATE FROM DATE -NON Y2K COMPLIANT MOVE FUNCTION CURRENT-DATE TO WS-DATE MOVE WS-MO TO HL-MO MOVE WS-DA TO HL-DA MOVE WS-YR TO HL-YR. ************************************************** * PERFORMED FROM 100-MAIN-MODULE, CLOSES FILES * * AND RETURNS CONTROL TO OPERATING SYSTEM * ************************************************** 600-END-OF-JOB-RTN. CLOSE TRANS-FILE-IN ERROR-LIST-OUT.