Search code examples
cobolmainframejclgnucobolcobol85

How do I rectify this logical error in printing output in the SYSOUT spool from COBOL program?


This is the cobol code

     *-----------------------
       IDENTIFICATION DIVISION.
      *-----------------------
       PROGRAM-ID.    TOPACCTS
       AUTHOR.        Otto B. Boolean.
      *--------------------
       ENVIRONMENT DIVISION.
      *--------------------
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT PRINT-LINE ASSIGN TO PRTLINE.
           SELECT CUST-RECS   ASSIGN TO CUSTRECS.
      *-------------
       DATA DIVISION.
      *-------------
       FILE SECTION.
       FD  PRINT-LINE RECORDING MODE F.
       01  PRINT-REC.
           05  FILLER         PIC X(02) VALUE SPACES.
           05  LAST-NAME-O    PIC X(25).
           05  FILLER         PIC X(02) VALUE SPACES.
           05  ACCT-BALANCE-O PIC X(18).
           05  FILLER         PIC X(33) VALUE SPACES.
      *
       FD  CUST-RECS RECORDING MODE F.
       01  CUSTOMER-REC.
           05  LAST-NAME          PIC X(25).
           05  FILLER             PIC X(10) VALUE SPACES.
           05  FIRST-NAME         PIC X(15).
           05  FILLER             PIC X(10) VALUE SPACES.
           05  ACCT-BALANCE       PIC X(18).
           05  FILLER             PIC X(02) VALUE SPACES.


      *
       WORKING-STORAGE SECTION.
       01  Filler.
           05 LASTREC          PIC X VALUE SPACE.
           05 TOTL             PIC 9(2) VALUE ZEROS.
           05 SUB1             PIC 9(2) VALUE 01.
           05 S                PIC X(12) VALUE "8,500,000.00".

      *
         01 OVERLIMIT.
           03 FILLER OCCURS 20 TIMES.
               05  OL-ACCT-NO            PIC X(8).
               05  OL-ACCT-LIMIT         PIC S9(7)V99 COMP-3.
               05  OL-ACCT-BALANCE       PIC S9(7)V99 COMP-3.
               05  OL-LASTNAME           PIC X(20).
               05  OL-FIRSTNAME          PIC X(15).
      *
       01  HEADER-1.
           05  FILLER         PIC X(20) 
                     VALUE 'Financial Report for'.
           05  FILLER         PIC X(01) VALUE SPACES.
           05  FILLER         PIC X(14) 
                     VALUE "Account holder".
           05  FILLER         PIC X(45) VALUE SPACES.
      *
       01  HEADER-2.
           05  FILLER         PIC X(05) VALUE 'Year '.
           05  HDR-YR         PIC 9(04).
           05  FILLER         PIC X(02) VALUE SPACES.
           05  FILLER         PIC X(06) VALUE 'Month '.
           05  HDR-MO         PIC X(02).
           05  FILLER         PIC X(02) VALUE SPACES.
           05  FILLER         PIC X(04) VALUE 'Day '.
           05  HDR-DAY        PIC X(02).
           05  FILLER         PIC X(56) VALUE SPACES.
      *
       01  HEADER-3.
           05  FILLER         PIC X(08) VALUE 'No.'. 
           05  FILLER         PIC X(02) VALUE SPACES.
           05  FILLER         PIC X(10) VALUE 'Cust Name '.
           05  FILLER         PIC X(15) VALUE SPACES.
           05  FILLER         PIC X(08) VALUE 'Balance '.
           05  FILLER         PIC X(40) VALUE SPACES.
      *
       01  HEADER-4.
           05  FILLER         PIC X(08) VALUE '--------'.
           05  FILLER         PIC X(02) VALUE SPACES.
           05  FILLER         PIC X(10) VALUE '----------'.
           05  FILLER         PIC X(15) VALUE SPACES.
           05  FILLER         PIC X(10) VALUE '----------'.
           05  FILLER         PIC X(02) VALUE SPACES.
           05  FILLER         PIC X(13) VALUE '-------------'.
           05  FILLER         PIC X(40) VALUE SPACES.
      *
       01 WS-CURRENT-DATE-DATA.
           05  WS-CURRENT-DATE.
               10  WS-CURRENT-YEAR         PIC 9(04).
               10  WS-CURRENT-MONTH        PIC 9(02).
               10  WS-CURRENT-DAY          PIC 9(02).
           05  WS-CURRENT-TIME.
               10  WS-CURRENT-HOURS        PIC 9(02).
               10  WS-CURRENT-MINUTE       PIC 9(02).
               10  WS-CURRENT-SECOND       PIC 9(02).
               10  WS-CURRENT-MILLISECONDS PIC 9(02).
      *
      *------------------
       PROCEDURE DIVISION.
      *------------------
       OPEN-FILES.
           OPEN INPUT  CUST-RECS.
           OPEN OUTPUT PRINT-LINE.
           DISPLAY HEADER-1.
           PERFORM WRITE-HEADERS.
           DISPLAY 'PREPARED ON ' HDR-DAY '.' HDR-MO '.' HDR-YR.
           DISPLAY '# OF RECORDS: ' TOTL.
           DISPLAY '==========================================='.
           PERFORM READ-NEXT-RECORD.
           
           
      *
       WRITE-HEADERS.
           MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE-DATA.
           MOVE WS-CURRENT-YEAR  TO HDR-YR.
           MOVE WS-CURRENT-MONTH TO HDR-MO.
           MOVE WS-CURRENT-DAY   TO HDR-DAY.
           MOVE SPACES TO PRINT-REC.
           WRITE PRINT-REC AFTER ADVANCING 1 LINES.
           MOVE SPACES TO PRINT-REC.
      *
      *
       READ-NEXT-RECORD.
           PERFORM READ-RECORD
            PERFORM UNTIL LASTREC = 'Y'
            PERFORM THE-RICH
            PERFORM WRITE-RECORD
            PERFORM READ-RECORD
            END-PERFORM.
           EXIT.
      *

      *
       READ-RECORD.
           READ CUST-RECS          
           AT END MOVE 'Y' TO LASTREC
           END-READ.
           EXIT.
      *
       THE-RICH.
           IF FUNCTION NUMVAL-C(S) < FUNCTION NUMVAL-C(ACCT-BALANCE)
            THEN
               DISPLAY LAST-NAME  ACCT-BALANCE
               MOVE ACCT-BALANCE TO ACCT-BALANCE-O
               MOVE LAST-NAME TO LAST-NAME-O
               ADD 1 TO SUB1
               MOVE SUB1 TO TOTL
            END-IF.
           EXIT.
 
      *
       WRITE-RECORD.
           MOVE ACCT-BALANCE TO  ACCT-BALANCE-O.
           MOVE LAST-NAME    TO  LAST-NAME-O.
      *    MOVE FIRST-NAME   TO  FIRST-NAME-O.
           WRITE PRINT-REC.
           EXIT.
      *

this is the SYSOUT output

 Financial Report for Account holder
 PREPARED ON 24.09.2020
 no OF RECORDS: 00
 ===========================================
 Maggie     Bignell        8,670,838.00
 Saw        Eckart         8,668,500.00
 Dede       Quickenden     8,667,260.00
 Allison    Oxshott        8,593,183.00
 Ambrose    Inch           8,557,403.00
 Leann      Lob            8,656,689.00
 Nevile     Roswarn        8,579,721.00
 Hedda      Littrell       8,598,965.00
 KonstantineMerner         8,557,306.00
 Heddie     Atwel          8,674,813.00
 Torie      Gimenez        8,662,345.00
 Lorraine   Van Hault      8,500,390.00
 Javier     Coltan         8,534,879.00
 Kissee     Kidston        8,650,707.00
 Benedikta  Spitell        8,589,633.00
 Niles      Garnson        8,649,886.00
 Alair      Sturrock       8,576,908.00
 Tandy      Pilgram        8,626,022.00
 Elfrida    Bamlet         8,540,474.00

 IGZ0020S A logic error occurred.  Neither FILE STATUS nor a declarative was specified for file CUSTRECS in program
          TOPACCTS at relative location X'414'.  The status code was 46.
          From compile unit TOPACCTS at entry point TOPACCTS at compile unit offset +00000414 at entry offset +00000414
          at address 1B800414.

Solution

  • If you're using a mainframe COBOL compiler, you go to the documentation and select your version. Then you do a search for "file status key" and review what file status 46 means.

    A sequential READ statement was attempted on a file open in the input or I-O mode and no valid next record had been established because:

    • The preceding READ statement was unsuccessful but did not cause an at-end condition.
    • The preceding READ statement caused an at-end condition.

    Note that in your OPEN-FILES paragraph you PERFORM READ-NEXT-RECORD and then fall through into the rest of your code after already having reached end of file.

    You probably want a STOP RUN or GOBACK at the end of your first paragraph.

    Edit regarding printing record count: There really isn't a good way to have the record count appear at the top of the report because you don't know the record count until you've read the entire input file but you're printing the report lines as you go. Most of the time control totals like record counts are DISPLAYed (which by default goes to the SYSOUT DD) and the report(s) go to a different DD defined in FILE-CONTROL (via a WRITE, just like what you're doing).

    Second edit regarding printing record count: As @GilbertLeBlanc points out you can store your output lines in a table until you've read all record in the input file. You do have to have enough space in the table to handle all the output records, and there are a number of different ways to do that.

    • Your table could be statically defined with a large enough OCCURS clause to handle what you've been told is a reasonable number of records. This used to be very common, and there would be code to check if the reasonable number had been exceeded and abend if it was.
    • Your table could be variably occurring with the UNBOUNDED phrase, subject to its limitations, and storage managed with the ALLOCATE statement and FREE statement.
    • You could roll your own allocation and reallocation with LE Callable Services CEEGTST, CEEFRST, and CEECZST.

    Gilbert also points out you can read the file twice, once to get the record count, then close and reopen to do your normal processing. This will work so long as you're not doing something tricky with your JCL like...

    //TOPACCTS EXEC PGM=TOPACCTS
    //SYSOUT   DD  SYSOUT=*
    //CUSTRECS DD  DISP=SHR,DSN=MY.INPUT.FILE01
    //CUSTRECS DD  DISP=SHR,DSN=MY.INPUT.FILE02
    //CUSTRECS DD  DISP=SHR,DSN=MY.INPUT.FILE03
    //PRTLINE  DD  SYSOUT=*
    //PRTLINE  DD  SYSOUT=*
    //PRTLINE  DD  SYSOUT=*
    

    ...where each time you close and open CUST-RECS and PRINT-LINE you get the next DD. But that's a more advanced JCL topic and one you may not run into very often in practice.