Wednesday, February 17, 2010

13. Table Handling

Use of OCCURS clause
An OCCURS clause is used in COBOL to indicate the repeated occurrence of fields with the same format.
Defining a series of totals in WORKING-STORAGE to which amounts are added; after all data is accumulated, the total can be printed.
Defining a table in WORKING-STORAGE to be accessed by each input record. For example, using the contents of some input field to “look up” the required data in the table.

Eg 13.1:
01 TEMP-REC.
05 TEMPERATURE OCCURS 24 TIMES PIC S9(3).

Subscript
A subscript is used in the PROCEDURE DIVISION to indicate which specific item within the array we wish to access.
The subscript is used along with the identifier that is defined with an OCCURS, to refer to an item within an array.

Eg 13.2:
MOVE TEMPERATURE (2) TO TEMP-OUT.

Rules for OCCURS and subscripts
There must be at least one space between the identifier and the left parenthesis that precedes the subscript. Similarly, the subscript must be enclosed in parentheses with no spaces within the parentheses.
A subscript may be a numeric literal or a data-name with a numeric PICTURE clause.
An OCCURS clause may be used on levels 02-49 only, because 01 level is used for defining records not fields.
COBOL 74 permits only upto three levels of OCCURS clauses

Using OCCURS with VALUE and REDEFINES clauses
Sometimes we want to initialize elements in a table or an array with specific values.
With COBOL 74, we cannot use a VALUE clause with an entry defined by an OCCURS clause. Instead we can define the field with one value and then redefine that storage area into separate array elements. As a result, each array element will have a different value.



Eg 13.3:
01 MONTH-NAMES.
05 STRING-1 PIC X(36) VALUE
‘JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC’.
05 MONTH REDEFINES STRING-1 OCCURS 12 TIMES PIC XXX.

The SEARCH statement
The best method for searching a table is with the use of a SEARCH statement. The identifier used with the SEARCH verb is the table entry name specified on the OCCURS level, not on the 01 level. The WHEN clause indicates what action is to be taken when the condition specified is actually met. Additional comparisons between search and table arguments can be made using other WHEN clauses. The AT END clause specifies what should be done if the table has been completely searched and no match is found.
To use a SEARCH statement, two additional entries are required : the INDEXED BY clause along with OCCURS, and the SET statement in the PROCEDURE DIVISION.
Table entries must be specified with an index rather than a subscript. An index is similar to a subscript, but it is defined along with the table entries as part of the OCCURS description.

Eg 13.4:
01 SALES-TAX-TABLE,
05 TABLE-ENTRIES OCCURS 1000 TIMES INDEXED BY X1.
10 WS-ZIPCODE PIC 9(5).
10 WS-TAX-RATE PIC V999.

However, unlike a subscript, an index is not defined separately in WORKING-STORAGE. The compiler automatically provides an appropriate PICTURE clause. An index is processed more efficiently than a subscript, because the index contains the displacement from the start of the table.
A SEARCH statement does not automatically initialize the index at 1 because sometimes we may want to begin searching a table at some point other than the beginning. Initializing an index at 1 must be performed by a SET statement prior to the SEARCH.

Eg 13.5:
SET X1 TO 1.
SEARCH TABLE-ENTRIES
AT END MOVE 0 TO WS-SALES-TAX
WHEN ZIP-IN = WS-ZIPCODE (X1)
COMPUTE ........

An index can be used to reference an element only in the table or array for which it was defined.
With 2 WHEN clauses, the computer begins by performing the first comparison. Only if the condition in the first WHEN is not met does it test the second WHEN.
To search for multiple matches in a table, it is better to use a PERFORM rather than a SEARCH statement for processing the entire table.
If you have parallel table with CUST-NO-TABLE storing 25 customer numbers and CUST-ARRAY storing the corresponding BAL-DUE for each. In such a case the SEARCH... VARYING can be used.

Eg 13.6:
SET X1, X2 TO 1.
SEARCH EACH-CUST-NO VARYING X2
AT END PERFORM 300-ERR-RTN
WHEN CUST-NO-IN = EACH-CUST-NO (X1)
ADD AMT-IN TO BAL-DUE (X2).

Binary search
When table entries are arranged in sequence by some field, such as T-CUSTOMER-NO, the most efficient type of look-up is a binary search. The SEARCH ALL verb is used to perform a binary search. A SET statement is not necessary with the SEARCH ALL, since the computer sets the index to the appropriate point initially when each binary search begins.

Limitations of the SEARCH ALL
The condition following the word WHEN can test only for equality.
If the condition following the word WHEN is a compound conditional :
Each part of the conditional can only consist of a relational test that involves an equal condition.
The only compound condition permitted is with ANDs, not Ors.
Only one WHEN clause can be used with a SEARCH ALL.
The VARYING option may not be used with the SEARCH ALL.
The OCCURS item and its index, which define the table argument, must appear to the left of the equal sign.

Eg 13.7:
WHEN S-AMT (X1) = AMT1 .....

To use the SEARCH ALL statement, we must indicate which table entry will serve as the
field. The identifier used in the ASCENDING KEY clause must be an entry within the table and it must appear before the INDEXED BY clause.

Eg 13.8:
01 TABLE-1.
05 DISCOUNT-TABLE OCCURS 50 TIMES
ASCENDING KEY T-CUSTOMER-NO
INDEXED BY X1.
10 T-CUSTOMER-NO PIC 9(4).
10 T-DISCOUNT-PCT PIC V999.

Eg 13.9:
01 INVENTORY-TABLE.
05 WAREHOUSE OCCURS 50 TIMES INDEXED BY X1.
10 ITEM-X OCCURS 100 TIMES INDEXED BY X2.
15 PART-NO PIC 9(4).
15 UNIT-PRICE PIC 999V99.

The identifier used with the SEARCH refers to the lowest-level OCCURS entry.
e.g. SEARCH ITEM-X.
Note that SEARCH ITEM-X increments the lowest-level index only. Hence if X1 is set to 1 initially, the SEARCH will perform a look-up on items in warehouse 1 only, that is (1,1) to (1,100).
To search all warehouses, the major index X1 must be incremented.

Back to COBOL Index

No comments: