Can file status always be 00 ?



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

Can file status always be 00 ?

Postby ranga_subham » Wed Apr 23, 2014 7:29 pm

Hi,

We have a DB2-IMS-COBOL program that uses COBOL File Status as shown below -

.
.
           SELECT I-CHKPT-FILE           ASSIGN TO CHKPTFL
                  FILE STATUS IS W-CHPKT-FILE-STATUS.     
.
.
000000     05  W-CHPKT-FILE-STATUS     PIC X(02)  VALUE '00'.
.
.


Surprisingly, this varibale is not checked anywhere in program. So, my question is does it always sets the FILE STATUS to 00 irrespective of its origianl status? Let us assume that program opens, reads this file once and closes it. Down below, there is another perform on this file. So, if program abends and upon restarting will this file still have FILE STATUS 00 or what?

Please help.

These users thanked the author ranga_subham for the post:
Mickeydusaor (Mon Apr 28, 2014 6:55 pm)
ranga_subham
 
Posts: 279
Joined: Fri Jul 18, 2008 7:46 pm
Has thanked: 0 time
Been thanked: 1 time

Re: Can file status always be 00 ?

Postby NicC » Wed Apr 23, 2014 8:38 pm

First, read the manual about file handling.
Second - always check the status after every file action (open, read/write/update, close)
Third: there is nothing magical in your code - an initial value is given when the program starts and any value could be inserted by the I/O routines as your program progresses: same as any other variable which will have, at the end of the program, the same value as it started with if nothing was assigned to it or trampled over its storage. Why would you expect anything different?
The problem I have is that people can explain things quickly but I can only comprehend slowly.
Regards
Nic
NicC
Global moderator
 
Posts: 3025
Joined: Sun Jul 04, 2010 12:13 am
Location: Pushing up the daisies (almost)
Has thanked: 4 times
Been thanked: 136 times

Re: Can file status always be 00 ?

Postby BillyBoyo » Wed Apr 23, 2014 8:54 pm

The FILE STATUS has been specified. It will be set by each I/O operation. For instance, if you get end-of-file on a READ, it will be set to "10". If the file is then CLOSEd, successfully, it will be set to "00" again. With no testing of the field, the only benefits are to be able to tell from a dump what the last status was, and to prevent the LE routines from saying "hey, I'm abending as there is a non-zero status and you haven't got FILE STATUS coded".
BillyBoyo
Global moderator
 
Posts: 3804
Joined: Tue Jan 25, 2011 12:02 am
Has thanked: 22 times
Been thanked: 265 times

Re: Can file status always be 00 ?

Postby ranga_subham » Fri Apr 25, 2014 6:19 pm

Thank you all.
ranga_subham
 
Posts: 279
Joined: Fri Jul 18, 2008 7:46 pm
Has thanked: 0 time
Been thanked: 1 time

Re: Can file status always be 00 ?

Postby Ed Goodman » Fri Apr 25, 2014 7:22 pm

This is a sore spot with me. Bad usage of this feature caused a major failure in our system. Someone wrote the new code to have that status code field, but never checked it, just like your situation.

The seemingly random error bounced from one developer to another over no less than six months. Every theory in the world was offered up as to why it wasn't working...IBM's new zOS version didn't work right...SMS has a flaw...Abend-AID is out of date...stuff like that.

It all came down to that stupid file status not being checked. The code was 'copied' from another program, so it looked so familiar to everyone that they assumed it was the same. BUT...the person who copied it didn't copy the error checking code 'because it was so complicated.'
Ed Goodman
 
Posts: 341
Joined: Thu Feb 24, 2011 12:05 am
Has thanked: 3 times
Been thanked: 17 times

Re: Can file status always be 00 ?

Postby Terry Heinze » Fri Apr 25, 2014 8:37 pm

When writing a new program, I like to include code like the following:
----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
       01  WS-ABEND-INFO-MSG-3.
           05                          PIC  X(16) VALUE
               'ABEND INFO ---->'.
           05                          PIC  X(13) VALUE
               'FILE STATUS: '.
           05  WS-FILE-STATUS          PIC  XX    VALUE SPACE.
               88  WS-FS-OK                       VALUE '00' '97'.
               88  WS-FS-DUP-KEY-OK               VALUE '02'.
               88  WS-FS-AT-END                   VALUE '10'.
               88  WS-FS-DUP-KEY                  VALUE '22'.
               88  WS-FS-RECORD-NOT-FOUND         VALUE '23'.
               88  WS-FS-FILE-NOT-FOUND           VALUE '35'.
               88  WS-FS-FILE-ATTRIBUTE-CONFLICT  VALUE '39'.
               88  WS-FS-90                       VALUE '90'.
               88  WS-FS-LOGIC-ERROR              VALUE '92'.
               88  WS-FS-RESOURCE-UNAVAILABLE     VALUE '93'.
               88  WS-FS-DD-MISSING               VALUE '96'.


       01  WS-FILE-NAMES-AND-STATUSES.
           05                          PIC  X(16) VALUE
               'FILE STATUSES ->'.
           05  WS-FILE001I-NAME        PIC  X(8)  VALUE 'FILE001I'.
           05  WS-FILE001I-STATUS      PIC  XX.
           05  WS-FILE002O-NAME        PIC  X(8)  VALUE 'FILE002O'.
           05  WS-FILE002O-STATUS      PIC  XX.

      /
      * .-------------------------------------------------------------.
      * |  CALLED FROM:  A10-INITIATE                                 |
      * |                B10-PROCESS                                  |
      * |  FUNCTION:  SELF-EXPLANATORY                                |
      * .-------------------------------------------------------------.
       R10-READ-FILE001I.
           MOVE 'R10-READ-FILE001I'    TO WS-PAR
           PERFORM M98-LOAD-TRACE-TABLE                THRU M98-X
           MOVE WS-FILE001I-NAME       TO WS-FILE-NAME
           READ FILE0001-FILE          INTO WS-FILE001I-RCD
           MOVE WS-FILE001I-STATUS     TO WS-FILE-STATUS
           PERFORM X90-CHECK-FILE-STATUS               THRU X90-X
           IF WS-FS-AT-END
               SET WS-END-OF-FILE001I  TO TRUE
           ELSE
               ADD 1                   TO WS-FILE001I-IN
               IF WS-DO-NOT-SKIP-CHECKPOINT
                   IF WS-FILE001I-IN NOT < WS-W-VALUE
                       PERFORM M95-DISPLAY-CHECKPOINT  THRU M95-X
                   END-IF
               END-IF
           END-IF
           .
       R10-X.
           EXIT
           .
      * .-------------------------------------------------------------.
      * |  CALLED FROM:  NUMEROUS LOCATIONS                           |
      * |  FUNCTION:  CHECK THE FILE STATUS CODE. IF OKAY OR AT END,  |
      * |               LET THE CALLER DETERMINE THE NEXT ACTION. IF  |
      * |               ANYTHING ELSE, ABEND                          |
      * .-------------------------------------------------------------.
       X90-CHECK-FILE-STATUS.
           EVALUATE TRUE
               WHEN WS-FS-OK
               WHEN WS-FS-AT-END
                   CONTINUE
               WHEN OTHER
                   PERFORM Z60-FILE-ABEND  THRU Z60-X
           END-EVALUATE
           .
       X90-X.
           EXIT
           .
.... Terry
Terry Heinze
 
Posts: 239
Joined: Wed Dec 04, 2013 11:08 pm
Location: Richfield, MN, USA
Has thanked: 12 times
Been thanked: 11 times


Return to IBM Cobol

 


  • Related topics
    Replies
    Views
    Last post