Library View Topics Framed Contents Revised Topics Previous Topic Next Topic Search Search ResultsPrevious Topic MatchNext Topic Match Notes List Notes Print Download No PDF Handheld DisconnectedHandheld ConnectedHelp

6.1.8.1 CORRESPONDING Phrase



The CORRESPONDING phrase (CORR) allows ADD, SUBTRACT, and MOVE operations to be performed on elementary data items of the same name if the group items to which they belong are specified.

Both identifiers following the key word CORRESPONDING must name group items. In this discussion, these identifiers are referred to as identifier-1 and identifier-2.

A pair of data items (subordinate items), one from identifier-1 and one from identifier-2, correspond if the following conditions are true:

For example, if two data hierarchies are defined as follows:


     05  ITEM-1 OCCURS 6.
       10  ITEM-A PIC S9(3).
       10  ITEM-B PIC +99.9.
       10  ITEM-C PIC X(4).
       10  ITEM-D REDEFINES ITEM-C PIC 9(4).
       10  ITEM-E USAGE COMP-1.
       10  ITEM-F USAGE INDEX.
     05  ITEM-2.
       10  ITEM-A PIC 99.
       10  ITEM-B PIC +9V9.
       10  ITEM-C PIC A(4).
       10  ITEM-D PIC 9(4).
       10  ITEM-E PIC 9(9) USAGE COMP.
       10  ITEM-F USAGE INDEX.

Then, if ADD CORR ITEM-2 TO ITEM-1(X) is specified, ITEM-A and ITEM-A(X), ITEM-B and ITEM-B(X), and ITEM-E and ITEM-E(X) are considered to be corresponding and are added together. ITEM-C and ITEM-C(X) are not included because they are not numeric. ITEM-D and ITEM-D(X) are not included because ITEM-D(X) includes a REDEFINES clause in its data description. ITEM-F and ITEM-F(X) are not included because they are defined as USAGE IS INDEX. Note that ITEM-1 is valid as either identifier-1 or identifier-2.

If any of the individual operations in the ADD CORRESPONDING statement produces a size error condition, imperative-statement-1 in the ON SIZE ERROR phrase is not executed until all of the individual additions are completed.

Previous Topic Next Topic © Copyright IBM Corp. 1991, 1998

IBM Library Server Copyright 1989, 2005 IBM Corporation. All rights reserved.





Return to library:   z/OS | z/OS.e | TPF | z/VSE | z/VM | IBM Hardware | IBM System z Redbooks
Glossary:   IBM terminology
Publications:   How to order publications
Readers:   Download IBM Library Reader | Download IBM Softcopy Reader | Download Adobe® Acrobat® Reader®
Library management:   Download IBM Softcopy Librarian
Contacts:   Contact z/OS


Adobe, the Adobe logo, Acrobat, the Acrobat logo, and Acrobat Reader are registered trademarks of Adobe Systems incorporated.