Error with the IF clause



Support for OS/VS COBOL, VS COBOL II, COBOL for OS/390 & VM and Enterprise COBOL for z/OS

Error with the IF clause

Postby SS00127783 » Thu Jun 26, 2014 5:30 pm

Hi guys, please help me . Am asked to make a cobol code with using two files. If the first file is having a record containing BAID then check whether the order of the BAID is present in the second file containing only orders.

Codes i have written :

TYPE-1 -

Result - Here when run in CHGMAN, it shouws account ACTIVATED but when run through JCL, o/p file is empty

 IDENTIFICATION DIVISION.                             
        PROGRAM-ID.    FBAIDJCL.                             
        AUTHOR.        SUCHETA.                             
        INSTALLATION.  PACIFIC BELL.                         
        DATE-WRITTEN.  JUNE 19,2014.                         
        DATE-COMPILED.                                       
*************************************************************
        ENVIRONMENT DIVISION.                               
        CONFIGURATION SECTION.                               
        SOURCE-COMPUTER.    IBM-370.                         
        OBJECT-COMPUTER.    IBM-370.                         
        SPECIAL-NAMES.                                       
*************************************************************
     INPUT-OUTPUT SECTION.                                         
      FILE-CONTROL.                                                 
             SELECT INPUT-FILE ASSIGN TO IFILE.                       
             SELECT TABLE-FILE ASSIGN TO TFILE.                       
             SELECT OUTPUT-FILE ASSIGN TO OFILE.                     
**********************************************************************
       DATA DIVISION.                                                 
       FILE SECTION.                                   
               
       FD INPUT-FILE.                                                 
       01  INPUT-RECD.                                               
           05  BAID-NAME                  PIC X(04).                 
                 88   BVALUE            VALUE "BAID".                 
           05  FILLER                     PIC X(02).                 
           05  BAID-NUMBER                PIC X(12).                 
           05  FILLER                     PIC X(42).                 
           05  ORDER-NUMBER               PIC X(08).                 
           05  FILLER                     PIC X(12).           
     

     FD TABLE-FILE.                                           
     01 WS-TABLE-REC.                                             
            02  ORDERN        PIC X(8).                           
            02  FILLER        PIC X(72).                 
       
     FD OUTPUT-FILE.                                             
     01 WS-OUTPUT-REC.                                           
            02   BAID              PIC X(12).                     
            02   FILLER            PIC X(5).                     
            02   ORDERNUMBER       PIC X(8).                     
            02   FILLER            PIC X(55).                     
                                                                 
     WORKING-STORAGE SECTION.                                     
     01 WS-CFILE1-EOF-SW1          PIC X(01) VALUE 'N'.           
         88  WS-CFILE1-EOF1         VALUE 'Y'.                   
     01 WS-END-OF-FILE-SW         PIC X(01) VALUE 'N'.           
         88  WS-END-OF-FILE        VALUE 'Y'.                     
**************************************************************** 
             
    PROCEDURE DIVISION.                                           
    1000-MAIN-PARA.                                               
          PERFORM IFILE5.                                         
          PERFORM RINPTF THRU INNERF UNTIL WS-CFILE1-EOF1.       
          PERFORM CFILE.                                         
          STOP RUN.                                               
                                                                 
    2000-PROCESS-PARA.                                 
         
    IFILE5.                                                       
         OPEN INPUT INPUT-FILE.                                                                     
         OPEN OUTPUT OUTPUT-FILE.     
                           
    CFILE.                                                       
          CLOSE INPUT-FILE.                                                                         
          CLOSE OUTPUT-FILE.           
                           
    RINPTF.                           
           READ INPUT-FILE                                           
               AT END MOVE 'Y' TO WS-CFILE1-EOF-SW1.               
   
     RTFILE.                                                         
           READ TABLE-FILE                                           
               AT END MOVE 'Y' TO  WS-END-OF-FILE-SW.                 
                                                                     
      INNERF.                                                                                                             
         IF BVALUE                                                   
               OPEN INPUT TABLE-FILE                                     
          PERFORM UNTIL WS-END-OF-FILE                             
           READ TABLE-FILE AT END                                 
                        MOVE 'Y' TO WS-END-OF-FILE-SW                 
             IF ORDER-NUMBER = ORDERN                             
                      MOVE BAID-NUMBER TO BAID                           
                      MOVE ORDER-NUMBER TO ORDERNUMBER                   
          WRITE WS-OUTPUT-REC                               
                END-IF                                             
           
               END-READ                                               
                       END-PERFORM                                             
                       CLOSE TABLE-FILE                                         
        END-IF.                               




TYPE-2


This code also got Activated but no real o/p required we get.

IDENTIFICATION DIVISION.                           
     PROGRAM-ID.    FBAIDJCL.                           
     AUTHOR.        SUCHETA.                             
     INSTALLATION.  PACIFIC BELL.                       
     DATE-WRITTEN.  JUNE 19,2014.                       
    DATE-COMPILED. 06/25/14.                             
*********************************************************
     ENVIRONMENT DIVISION.                               
     CONFIGURATION SECTION.                             
     SOURCE-COMPUTER.    IBM-370.                       
     OBJECT-COMPUTER.    IBM-370.                       
     SPECIAL-NAMES.                                     
*********************************************************
    INPUT-OUTPUT SECTION.                               
    FILE-CONTROL.                                       
          SELECT INPUT-FILE ASSIGN TO IFILE.             
          SELECT TABLE-FILE ASSIGN TO TFILE.             
           SELECT OUTPUT-FILE ASSIGN TO OFILE.                 
***************************************************************

     DATA DIVISION.                                           
     FILE SECTION.                                             
     FD INPUT-FILE.                                           
     01  INPUT-RECD.                                           
         05  BAID-NAME                  PIC X(04).             
               88   BVALUE            VALUE "BAID".           
         05  FILLER                     PIC X(02).             
         05  BAID-NUMBER                PIC X(12).             
         05  FILLER                     PIC X(42).             
         05  ORDER-NUMBER               PIC X(08).             
         05  FILLER                     PIC X(12).             
     FD TABLE-FILE.                                           
     01 WS-TABLE-REC.                                         
            02  ORDERN        PIC X(8).                       
            02  FILLER        PIC X(72).                       
         01 WS-OUTPUT-REC.                                           
            02   BAID              PIC X(12).                     
            02   FILLER            PIC X(5).                     
            02   ORDERNUMBER       PIC X(8).                     
            02   FILLER            PIC X(55).         
           
     WORKING-STORAGE SECTION.                                     
     01 WS-CFILE1-EOF-SW1          PIC X(01) VALUE 'N'.           
         88  WS-CFILE1-EOF1         VALUE 'Y'.                   
     01 WS-CFILE2-EOF-SW2          PIC X(01) VALUE 'N'.           
         88  WS-CFILE2-EOF2         VALUE 'Y'.                   
     01 WS-END-OF-FILE-SW         PIC X(01) VALUE 'N'.           
         88  WS-END-OF-FILE        VALUE 'Y'.             
       
**************************************************************** 
     PROCEDURE DIVISION.                                         
     MAIN-PARA.                                                   
           PERFORM IFILE.                                         
           PERFORM RFILE.                                         
           PERFORM PROCESS-INPUT-FILE UNTIL WS-CFILE1-EOF1.       
          PERFORM CFILE.     
          STOP RUN.           

    PROCESS-PARA.             

    IFILE.                   
      OPEN INPUT INPUT-FILE.               
      OPEN INPUT TABLE-FILE.               
      OPEN OUTPUT OUTPUT-FILE.       
     
 RFILE.                                   
      READ INPUT-FILE                     
      AT END MOVE 'Y' TO WS-CFILE1-EOF-SW1.

 CFILE.                                       
      CLOSE INPUT-FILE.                       
      CLOSE TABLE-FILE.                       
      CLOSE OUTPUT-FILE.       
               
 READT.                                       
       READ TABLE-FILE                       
       AT END MOVE 'Y' TO WS-CFILE2-EOF-SW2. 

  INNERF.                         
          PERFORM READT           
            IF ORDER-NUMBER=ORDERN   
                    MOVE BAID-NUMBER TO BAID         
                    MOVE ORDER-NUMBER TO ORDERNUMBER
                    WRITE WS-OUTPUT-REC             
                  ELSE                             
                     NEXT SENTENCE.                   
                           
 PROCESS-INPUT-FILE.       
      IF BVALUE             
         PERFORM INNERF     
 END-IF.           
 PERFORM RFILE.   





TYPE - 3


   IDENTIFICATION DIVISION.                             
   PROGRAM-ID.    FBAIDJCL.                             
   AUTHOR.        SUCHETA.                             
   INSTALLATION.  PACIFIC BELL.                         
   DATE-WRITTEN.  JUNE 19,2014.                         
  DATE-COMPILED. 06/26/14.                             
********************************************************
   ENVIRONMENT DIVISION.                               
   CONFIGURATION SECTION.                               
   SOURCE-COMPUTER.    IBM-370.                         
   OBJECT-COMPUTER.    IBM-370.                         
   SPECIAL-NAMES.                                       
********************************************************
  INPUT-OUTPUT SECTION.                                 
  FILE-CONTROL.                                         
        SELECT INPUT-FILE ASSIGN TO IFILE.             
        SELECT TABLE-FILE ASSIGN TO TFILE.             
        SELECT OUTPUT-FILE ASSIGN TO OFILE.             
 **************************************************************
        DATA DIVISION.                                         
        FILE SECTION.                                         
             FD INPUT-FILE.                                         
             01  INPUT-RECD.                                       
            05  BAID-NAME                  PIC X(04).         
                  88   BVALUE            VALUE "BAID".         
            05  FILLER                     PIC X(02).         
            05  BAID-NUMBER                PIC X(12).         
            05  FILLER                     PIC X(42).         
            05  ORDER-NUMBER               PIC X(08).         
            05  FILLER                     PIC X(12).         
        FD TABLE-FILE.                                         
        01 WS-TABLE-REC.                                       
               02  ORDERN        PIC X(8).                     
               02  FILLER        PIC X(72).                   
        FD OUTPUT-FILE.                                       
             01 WS-OUTPUT-REC.                                               
              02   BAID              PIC X(12).                       
              02   FILLER            PIC X(5).                         
              02   ORDERNUMBER       PIC X(8).                         
              02   FILLER            PIC X(55).                 
     
       WORKING-STORAGE SECTION.                                       
       01 WS-CFILE1-EOF-SW1          PIC X(01) VALUE 'N'.             
           88  WS-CFILE1-EOF1         VALUE 'Y'.                       
     
       01 WS-END-OF-FILE-SW         PIC X(01) VALUE 'N'.               
           88  WS-END-OF-FILE        VALUE 'Y'.                       
******************************************************************     
       PROCEDURE DIVISION.                                             
       1000-MAIN-PARA.                                                 
             PERFORM IFILE.                                           
             PERFORM RINPTF THRU INNERF UNTIL WS-CFILE1-EOF1.         
             PERFORM CFILE.                                           
             STOP RUN.         
                               
       2000-PROCESS-PARA.       
       IFILE.                   
        OPEN INPUT INPUT-FILE.                         
        OPEN INPUT TABLE-FILE.                         
        OPEN OUTPUT OUTPUT-FILE.         
             
   CFILE.                                             
         CLOSE INPUT-FILE.                             
         CLOSE TABLE-FILE.                             
         CLOSE OUTPUT-FILE.                   
       
   RINPTF.                                             
         READ INPUT-FILE                               
             AT END MOVE 'Y' TO WS-CFILE1-EOF-SW1.     

       RTFILE.                                               
            READ TABLE-FILE                                 
                AT END MOVE 'Y' TO  WS-END-OF-FILE-SW.       
                                                             
       INNERF.                                               
             IF BVALUE                                       
               PERFORM RTFILE UNTIL WS-END-OF-FILE           
                  IF ORDER-NUMBER = ORDERN                   
                  MOVE BAID-NUMBER TO BAID                   
                  MOVE ORDER-NUMBER TO ORDERNUMBER           
                  WRITE WS-OUTPUT-REC                       
                  END-IF                                     
               END-PERFORM.                                 
      END-IF.     
PERFORM RINPTF.

Errors-P.S -

[1] THE EXPLICIT SCOPE TERMINATOR "END-PERFORM" WAS FOUND WITHOUT A MATCHING VERB. THE SCOPE TERMINATOR WAS DISCARDED.

[2] THE EXPLICIT SCOPE TERMINATOR "END-IF" WAS FOUND WITHOUT A MATCHING VERB. THE SCOPE TERMINATOR WAS DISCARDED.

Guys i tried to debug the type -3 code/ above one..but removing period '.' ...all the permutations combinations possible..its still ain't working.


Please Please Help IMPROVISE any of the types cobol code asoon as possible
SS00127783
 
Posts: 5
Joined: Thu Jun 26, 2014 4:31 pm
Has thanked: 1 time
Been thanked: 0 time

Re: Error with the IF clause

Postby Robert Sample » Thu Jun 26, 2014 6:16 pm

Please Please Help IMPROVISE any of the types cobol code asoon as possible
First, this is a volunteer forum, where people reply if / when they have time. Asking for rapid response is NOT going to get you faster responses, and may delay any responses as people decide your post is not worth the hassle.

Second, there is a CODE button for a reason -- COBOL code is much easier to understand when the spaces are preserved between Area A and Area B. Why did you not use the Code button on your program?

Third, your TYPE-1 program has a glaring logic error -- the first time you run through the read of TABLE-FILE, you hit end-of-file. The next time you reach that code, end-of-file is still set since you never re-initialized it. Hence after the first match, no further reads of TABLE-FILE will occur. I did not look at your TYPE-2 program since the logic error in TYPE-1 is so obvious and glaring.
Robert Sample
Global moderator
 
Posts: 3719
Joined: Sat Dec 19, 2009 8:32 pm
Location: Dubuque, Iowa, USA
Has thanked: 1 time
Been thanked: 279 times

Re: Error with the IF clause

Postby Aki88 » Thu Jun 26, 2014 6:25 pm

Hello,

Please use code-tags while posting code.

The error is self-explanatory; on first-look at this code-piece (without looking real-hard), from TYPE-3:

SS00127783 wrote:
 IF BVALUE                                       
               PERFORM RTFILE UNTIL WS-END-OF-FILE           
                  IF ORDER-NUMBER = ORDERN                   
                  MOVE BAID-NUMBER TO BAID                   
                  MOVE ORDER-NUMBER TO ORDERNUMBER           
                  WRITE WS-OUTPUT-REC                       
                  END-IF                                     
               END-PERFORM.                                  <--- right here is the scope-terminator
      END-IF.                                             <--- which renders this END-IF obsolete
PERFORM RINPTF.

[u]Errors-[/u]P.S - 

[1] THE EXPLICIT SCOPE TERMINATOR "END-PERFORM" WAS FOUND WITHOUT A MATCHING VERB.  THE SCOPE TERMINATOR WAS  DISCARDED.                                                       
                                                                   
[2] THE EXPLICIT SCOPE TERMINATOR "END-IF" WAS FOUND WITHOUT A MATCHING VERB.  THE SCOPE TERMINATOR WAS  DISCARDED.


Guys i tried to debug the type -3 code/ above one..but removing period '.' ...all the permutations combinations possible..its still ain't working.


There is one real good thing about a compile listing - It gives you the exact line number of the code-piece which is erroneous; it'd be good if you revisit the listing and resolve errors line-by-line.

Hth.
Aki88
 
Posts: 381
Joined: Tue Jan 28, 2014 1:52 pm
Has thanked: 33 times
Been thanked: 36 times

Re: Error with the IF clause

Postby Aki88 » Thu Jun 26, 2014 6:26 pm

errrr, my bad Robert; didn't see your post...

Thanks.
Aki88
 
Posts: 381
Joined: Tue Jan 28, 2014 1:52 pm
Has thanked: 33 times
Been thanked: 36 times

Re: Error with the IF clause

Postby SS00127783 » Thu Jun 26, 2014 7:09 pm

Hi aki,

I tried them ...could you pls help me with implementing the possible changes ... i hv tried working out with the codes and removing them.
SS00127783
 
Posts: 5
Joined: Thu Jun 26, 2014 4:31 pm
Has thanked: 1 time
Been thanked: 0 time

Re: Error with the IF clause

Postby BillyBoyo » Thu Jun 26, 2014 7:29 pm

Do you know how badly this is going to run? It is an extremely bad idea to keep opening and closing files, whilst reading the entire file for each input record.

How big is the table? Can it fit in storage (less than 128MB?)?
BillyBoyo
Global moderator
 
Posts: 3804
Joined: Tue Jan 25, 2011 12:02 am
Has thanked: 22 times
Been thanked: 265 times

Re: Error with the IF clause

Postby Robert Sample » Thu Jun 26, 2014 7:38 pm

could you pls help me with implementing the possible changes
This is a HELP forum, not a WRITE-THE-CODE-FOR-YOU forum. You need to CLEARLY post what you have done, what errors are occurring and what you have done so far to fix those errors before we can help you. As otherwise pointed out, your entire approach with this program is wrong -- you should never read a sequential record more than once in your program. Load a table in your code and use the SEARCH verb, or use a keyed file (VSAM KSDS) if the table is too large to fit in memory.
Robert Sample
Global moderator
 
Posts: 3719
Joined: Sat Dec 19, 2009 8:32 pm
Location: Dubuque, Iowa, USA
Has thanked: 1 time
Been thanked: 279 times

Re: Error with the IF clause

Postby SS00127783 » Fri Jun 27, 2014 12:59 pm

Robert Sample wrote:
could you pls help me with implementing the possible changes
This is a HELP forum, not a WRITE-THE-CODE-FOR-YOU forum. You need to CLEARLY post what you have done, what errors are occurring and what you have done so far to fix those errors before we can help you. As otherwise pointed out, your entire approach with this program is wrong -- you should never read a sequential record more than once in your program. Load a table in your code and use the SEARCH verb, or use a keyed file (VSAM KSDS) if the table is too large to fit in memory.




Hi Robert,
since am new to mainframes, am unaware of the VSAM KSDS file.
And regarding reading a file... how my logic goes is ,it is read in a loop so that i can compare each and every record in the input file with that of the order file.
SS00127783
 
Posts: 5
Joined: Thu Jun 26, 2014 4:31 pm
Has thanked: 1 time
Been thanked: 0 time

Re: Error with the IF clause

Postby BillyBoyo » Fri Jun 27, 2014 1:53 pm

We know why you are doing it, we are just telling you, as a beginner, it is a really, really, really, terrible way to do it. Really terrible.

It will work (once you've fixed it) but it be slow and waste a massive mount of resources. If you do it the "normal" way, it'll be (literally) 99% faster and use hundreds of percent fewer resources.

How many records are on the file? How long are the records?
BillyBoyo
Global moderator
 
Posts: 3804
Joined: Tue Jan 25, 2011 12:02 am
Has thanked: 22 times
Been thanked: 265 times

Re: Error with the IF clause

Postby SS00127783 » Fri Jun 27, 2014 4:37 pm

Hi billy,
There are around 85 records, its a sample i have taken...in future it may run for many more records.

what is the normal way then ? am aware of only this way of working.

INNERF.                                             
     READ INPUT-FILE                                 
        AT END MOVE 'Y' TO WS-CFILE1-EOF-SW1         
    IF BVALUE                                       
       MOVE ORDER-NUMBER TO WS-ORDER-NUMBER         
         READ TABLE-FILE                             
            AT END MOVE 'Y' TO WS-END-OF-FILE-SW     
       IF WS-ORDER-NUMBER = ORDERN                   
          MOVE BAID-NUMBER TO BAID                   
          MOVE ORDER-NUMBER TO ORDERNUMBER           
          WRITE WS-OUTPUT-REC                       
       END-IF                                       
    END-IF.                                         
    PERFORM INNERF.



here i want to know how is the -
READ INPUT-FILE                                 
        AT END MOVE 'Y' TO WS-CFILE1-EOF-SW1
interpreted ??

Because the error am getting is - in the jcl. whereas the COBOL code got activated.

A logic error occurred. Neither FILE STATUS nor a declarative was specified for file IFILE in program.
FBAIDJCL at relative location X'062A'. The status code was 46.
From compile unit FBAIDJCL at entry point FBAIDJCL at compile unit offset +0000062A at entry offset +0000062A at address 27D00B1A.


I guess there is some problem with the reading of the files...
how my logic goes is the compiler first reads the input file, next line ...since its not the en of the file , it enters the loop. Then until the inner loop gets completely executed ( where there is Read TABLE-File) ...then again it goes back to input -read-file through Perform Innerf.

Am i correct with the working of the code?
SS00127783
 
Posts: 5
Joined: Thu Jun 26, 2014 4:31 pm
Has thanked: 1 time
Been thanked: 0 time

Next

Return to IBM Cobol

 


  • Related topics
    Replies
    Views
    Last post