----------------------------------------------------------------------

The 10th class session will start with an analysis of COBOL assignment 5
followed by problem-resolution methods.

----------------------------------------------------------------------
The FILE STATUS Clause -- causes the system to store a two-character
code in a data item after each I/O statement.  The status should be
tested after each I/O statement.

The following table contains some of the system status codes
----------------------------------------------------------------------
Key-1 key-2   meaning
----------------------------------------------------------------------
Successful completion:
0      0      no further information
       2      duplicate key detected
       4      wrong fixed-length record
       7      CLOSE with NO REWIND or REEL for nontape
End-of-file:
1      0      no further information
       4      relative record READ outside file boundary
Invalid key:
2      1      sequence error
       2      duplicate key
       3      no record found
       4      key outside the boundary of file
Permanent I/O error:
3      0      no further information
       4      record outside file boundary
       5      OPEN and required file not found
       7      OPEN with invalid mode
       8      OPEN of file closed with LOCK
       9      OPEN unsuccessful because of conflicting file attributes
Logic error:
4      1      OPEN of file already open
       2      CLOSE for file not open
       3      READ not executed before REWRITE
       4      REWRITE of different size record
       6      READ after EOF (end of file)
       7      READ attempted for file not open I-O or INPUT
       8      WRITE for file not opened OUTPUT, I-O, or EXTEND
       9      DELETE or REWRITE for file not opened I-O.
Specific compiler-defined conditions:
9      0      no further information
       1      VSAM password failure
       2      logic error
       3      VSAM Resources not available
       4      VSAM sequential record not available
       5      VSAM invalid or incomplete file information
       6      VSAM--no DD statement
       7      VSAM OPEN successful.  File integrity verified.
----------------------------------------------------------------------

Variable length tables

Use variable length tables when the number of items kept in the table is
not a constant but can vary between predictable limits.

OCCURS min TO max TIMES DEPENDING ON data-item describes the length of the table.

Min -- Minimum number of occurrences in the table.  Must be a numeric integer
zero or larger but less than Max.  A zero min permits a table to have zero entries.

Max -- Maximum number of occurrences in the table.  Must be greater than Min

Data-item -- numeric integer field containing a value within the Min to Max range.
This field should not be part of the table being defined or subordinate to it.
If part of a variable length record, it should be in the fixed portion of the record.
----------------------------------------------------------------------
01  INPUT-RECORD.
    05  NUMBER-OF-DEPENDENTS   PIC 99.
    05  X                      PIC 99 COMP.
    05  DEPENDENT-TABLE
        OCCURS 0 TO 20 TIMES
        INDEXED BY D
        ASCENDING KEY IS DEPENDENT-DATE-OF-BIRTH
        DEPENDING ON NUMBER-OF-DEPENDENTS.
        10 DEPENDENT-NAME       PIC X(25).
        10 DEPENDENT-DATE-OF-BIRTH      PIC 9(8).
01 FOUND-SWITCH    PIC XXX.

When NUMBER-OF-DEPENDENTS is assigned a value, the COBOL procedure verbs
of SEARCH and SEARCH ALL act as if the table were defined for that number
of occurrences.
----------------------------------------------------------------------
To add an entry to the end of a variable length table,
 

EXAMPLE:

IF NUMBER-OF-DEPENDENTS < 20
   ADD 1 TO NUMBER-OF-DEPENDENTS
   SET D TO NUMBER-OF-DEPENDENTS
   MOVE 'BABY JANE' TO DEPENDENT-NAME (D)
   MOVE 19990307 TO DEPENDENT-DATE-OF-BIRTH (D)
ELSE
   DISPLAY 'NO MORE ROOM IN THE TABLE FOR NEW DEPENDENTS'
END-IF
----------------------------------------------------------------------

Any PERFORM VARYING with variable length tables should use the data-item
that determines the number of occurrences as part of the UNTIL.

----------------------------------------------------------------------

To display all the dependents, include NUMBER-OF-DEPENDENTS as a limit on the PERFORM.
 
PERFORM VARYING D FROM 1 BY 1 UNTIL D > NUMBER-OF-DEPENDENTS
        DISPLAY DEPENDENT-NAME (D) DEPENDENT-DATE-OF-BIRTH (D)
END-PERFORM

----------------------------------------------------------------------

To do a sequential search for 'BABY JANE' using PERFORM VARYING and include NUMBER-OF-DEPENDENTS as a limit on the PERFORM.

MOVE 'NO' TO FOUND-SWITCH
PERFORM  VARYING D FROM 1 BY 1
      UNTIL D > NUMBER-OF-DEPENDENTS
      OR    FOUND-SWITCH = 'YES'
      IF DEPENDENT-NAME (D) = 'BABY JANE'
         DISPLAY 'DEPENDENT ' DEPENDENT-NAME (D)
                 ' FOUND IN TABLE'
         MOVE 'YES' TO FOUND-SWITCH
      END-IF
END-PERFORM
IF FOUND-SWITCH = 'NO'
   DISPLAY 'BABY JANE NOT FOUND'.

----------------------------------------------------------------------

The SEARCH statement works the same as for a fixed length table.

SET D TO 1
SEARCH DEPENDENT-TABLE
   AT END DISPLAY 'BABY JANE NOT FOUND'
   WHEN DEPENDENT-NAME (D) = ' BABY JANE '
       DISPLAY 'DEPENDENT ' DEPENDENT-NAME (D) ' FOUND IN TABLE'
END-SEARCH
----------------------------------------------------------------------

The SEARCH ALL statement works the same as for a fixed length table.

SEARCH ALL DEPENDENT-TABLE
   AT END DISPLAY 'BIRTH DATE NOT FOUND'
   WHEN DEPENDENT-DATE-OF-BIRTH (D) = 19990307
       DISPLAY 'DEPENDENT ' DEPENDENT-NAME (D) ' FOUND IN TABLE'
END-SEARCH

----------------------------------------------------------------------
 IDENTIFICATION DIVISION.
   PROGRAM-ID.    TABLES.
   AUTHOR.        JOHN PETLICKI.
 ENVIRONMENT DIVISION.
 DATA DIVISION.
 WORKING-STORAGE SECTION.
 01  SUB-1   PIC 99 VALUE ZERO.
 01  SUB-2   PIC 99 VALUE ZERO.
 01  SUB-3   PIC 99 VALUE ZERO.
 01  FOUND-SWITCH PIC XX VALUE SPACES.
 01  TABLE-VALUES.
     05 PIC X(27) VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '.
     05 PIC X(27) VALUE 'abcdefghijklmnopqrstuvwxyz?'.
     05 PIC X(10) VALUE '0123456789'.
 01  ONE-DIMENSION-TABLE REDEFINES TABLE-VALUES.
     05 SYMBOL-1                 OCCURS 64 TIMES PIC X.
 01  TWO-DIMENSION-TABLE REDEFINES TABLE-VALUES.
     05 DIMENSION-ONE-OF-TWO     OCCURS 8 TIMES.
        10  DIMENSION-TWO-OF-TWO OCCURS 8 TIMES.
            15 SYMBOL-2 PIC X.
 01  THREE-DIMENSION-TABLE REDEFINES TABLE-VALUES.
     05 DIMENSION-ONE-OF-THREE           OCCURS 4 TIMES.
        10  DIMENSION-TWO-OF-THREE       OCCURS 4 TIMES.
            15  DIMENSION-THREE-OF-THREE OCCURS 4 TIMES.
                20 SYMBOL-3 PIC X.

 PROCEDURE DIVISION.
     DISPLAY 'THE VALUES IN SYMBOL-1 ARE '
     PERFORM 100-DISPLAY  VARYING SUB-1 FROM 1 BY 1
                          UNTIL SUB-1 > 64.

     DISPLAY 'THE VALUES IN SYMBOL-2 ARE '
     PERFORM 200-DISPLAY
         VARYING SUB-1 FROM 1 BY 1 UNTIL SUB-1 > 8
         AFTER   SUB-2 FROM 1 BY 1 UNTIL SUB-2 > 8
 
     DISPLAY 'THE VALUES IN SYMBOL-3 ARE '
     PERFORM 300-DISPLAY
         VARYING SUB-1 FROM 1 BY 1 UNTIL SUB-1 > 4
         AFTER   SUB-2 FROM 1 BY 1 UNTIL SUB-2 > 4
         AFTER   SUB-3 FROM 1 BY 1 UNTIL SUB-3 > 4
     STOP RUN.
 
 100-DISPLAY.
     DISPLAY '(' SUB-1 '> = ' SYMBOL-1 (SUB-1).
 
 200-DISPLAY.
     DISPLAY '<' SUB-1 ' ' SUB-2 '> = '
             SYMBOL-2 (SUB-1 SUB-2).
 
 300-DISPLAY.
     DISPLAY '<' SUB-1 ' ' SUB-2 ' ' SUB-3 '> = '
             SYMBOL-3 (SUB-1 SUB-2 SUB-3).
----------------------------------------------------------------------

Two dimensional tables are created by having two OCCURS clauses describe entries.
 

--------------------------------------------------------------------

01  TWO-DIMENSION-TABLE REDEFINES TABLE-VALUES.
     05 DIMENSION-ONE-OF-TWO     OCCURS 8 TIMES.
        10  DIMENSION-TWO-OF-TWO OCCURS 8 TIMES.
            15 SYMBOL-2 PIC X.
 

        (1 1) (1 2) . . . (1 8) (2 1) (2 2) (2 3) . . . (2 8) (3 1) etc
 

        What is the value of  SYMBOL-2 (1 8)?
 
                              SYMBOL-2 (2 1)?

--------------------------------------------------------------------
Indexes can be defined for any OCCURS level.

01   TWO-DIMENSION-TABLE REDEFINES TABLE-VALUES.
     05 DIMENSION-ONE-OF-TWO
        OCCURS 8 TIMES
        INDEXED BY T1.
        10 DIMENSION-TWO-OF-TWO
           OCCURS 8 TIMES
           INDEXED BY T2.
           15 SYMBOL-2 PIC X.
--------------------------------------------------------------------
 
PERFORM VARYING with AFTER option
 

EXAMPLE.
MOVE 'NO' TO FOUND-SWITCH
PERFORM 400-SEARCH
    VARYING SUB-1 FROM 1 BY 1
    UNTIL   SUB-1 > 8 OR FOUND-SWITCH = 'YES'
    AFTER   SUB-2 FROM 1 BY 1
    UNTIL SUB-2 > 8 OR FOUND-SWITCH = 'YES'
IF  FOUND-SWITCH = 'YES'
    DISPLAY 'character at SYMBOL-2 ('
    SUB-1 ' ' SUB-2 ')'
ELSE
    DISPLAY 'character not found'
END-IF
400-SEARCH.
    IF SYMBOL (SUB-1 SUB-2) = 'e'
       MOVE 'YES' TO FOUND-SWITCH.

 What is the value of SUB-1 and SUB-2?

--------------------------------------------------------------------

SEARCH Verb and two dimensional tables.
 

To search for 'e' using the search verb,

MOVE 'NO' TO FOUND-SWITCH
PERFORM VARYING T1 FROM 1 BY 1
        UNTIL   T1 > 8 OR FOUND-SWITCH = 'YES'
        SET T2 TO 1
        SEARCH DIMENSION-TWO-OF-TWO  ? LAST OCCURS CLAUSE
        WHEN SYMBOL-2 (T1 T2) = 'e'
             MOVE 'YES' TO FOUND-SWITCH
        END-SEARCH
END-PERFORM
IF  FOUND-SWITCH = 'YES'
    DISPLAY 'character at SYMBOL-2 ('
             SUB-1 ' ' SUB-2 ')'
ELSE
    DISPLAY 'character not found'
END-IF

--------------------------------------------------------------------

Three dimensional tables
 

--------------------------------------------------------------------

01  THREE-DIMENSION-TABLE REDEFINES TABLE-VALUES.
     05 DIMENSION-ONE-OF-THREE           OCCURS 4 TIMES.
        10  DIMENSION-TWO-OF-THREE       OCCURS 4 TIMES.
            15  DIMENSION-THREE-OF-THREE OCCURS 4 TIMES.
                20 SYMBOL-3 PIC X.
 

        (1 1 1) (1 1 2) (1 1 3) (1 1 4) (1 2 1) . . . (1 2 4) (1 3 1) etc

        What is the value of    SYMBOL-3 (1 1 4)?

                                SYMBOL-3 (1 2 1)?

--------------------------------------------------------------------