Compaq COBOL
Reference Manual


Previous Contents Index

Additional References

Examples Using Format 1

The examples that follow copy library text from two library files:

In the following examples, the original source program text is shown in lowercase text. The text that is copied is shown in uppercase. (The messages in these examples are in OpenVMS Alpha format.)

Example 8-1 shows the results of a COPY statement with no REPLACING phrase. The compiler copies the library text without change. In this example, syntax errors result from invalid library text.

Example 8-1 COPY with No REPLACING Phrase

            1 identification division. 
            2 program-id. cust01. 
            3 data division. 
            4 working-storage section. 
            5 copy custfile. 
L           6 01  CUSTOMER-REC. 
L           7     03  CUST-REC-KEY        PIC X(03) VALUE "KEY". 
L           8     03  CUST-NAME   PIC X(25). 
L           9     03  CUST-ADDRESS. 
L          10         05  CUST-CUST-STREET        PIC X(20). 
L          11         05  CUST-CITY       PIC X(20). 
L          12         05  CUST-STATE      PIC XX. 
L          13         05  CUST-ZIP        PIC 9(5). 
L          14 * THE COMPILER IGNORES COMMENT LINES AND BLANK LINES 
L          15 
L          16 * FOR MATCHING PURPOSES 
L          17     03  CUST-ORDERS OCCURS XYZ TIMES. 
                                         1        2 
%COBOL-F-SYN5  121, (1) Invalid OCCURS clause 
%COBOL-W-RESTART  297, (2) Processing of source program resumes at this point 
L          18         05  CUST-ORDER      PIC 9(6). 
L          19         05  CUST-ORDER-DATE PIC 9(6). 
L          20         05  CUST-ORDER-AMT  PIC 9(R)V99. 
                                              1 
%COBOL-F-ERROR  178, (1) Invalid repetition factor 
 

Example 8-2 shows the results of replacing a word ("xyz") by a literal (6).

Example 8-2 Replacing a Word with a Literal

           22 copy custfile replacing xyz by 6. 
L          23 01  CUSTOMER-REC. 
L          24     03  CUST-REC-KEY        PIC X(03) VALUE "KEY". 
L          25     03  CUST-NAME   PIC X(25). 
L          26     03  CUST-ADDRESS. 
L          27         05  CUST-CUST-STREET        PIC X(20). 
L          28         05  CUST-CITY       PIC X(20). 
L          29         05  CUST-STATE      PIC XX. 
L          30         05  CUST-ZIP        PIC 9(5). 
L          31 * THE COMPILER IGNORES COMMENT LINES AND BLANK LINES 
L          32 
L          33 * FOR MATCHING PURPOSES 
LR         34     03  CUST-ORDERS OCCURS 6   TIMES. 
L          35         05  CUST-ORDER      PIC 9(6). 
L          36         05  CUST-ORDER-DATE PIC 9(6). 
L          37         05  CUST-ORDER-AMT  PIC 9(R)V99. 
                                              1 
%COBOL-F-PICREPEAT  178, (1) Invalid repetition factor 
 

Example 8-3 shows the results of replacing a word ("xyz") by a literal (6), and pseudo-text by pseudo-text. The compiler recognizes R as a text-word because parentheses enclose it. The other R characters are not text-words; they are part of other text-words.

Example 8-3 Replacing a Word by a Literal and Pseudo-Text by Pseudo-Text

           39 copy custfile replacing xyz by 6, ==r== by ==4==. 
L          40 01  CUSTOMER-REC. 
L          41     03  CUST-REC-KEY        PIC X(03) VALUE "KEY". 
L          42     03  CUST-NAME   PIC X(25). 
L          43     03  CUST-ADDRESS. 
L          44         05  CUST-CUST-STREET        PIC X(20). 
L          45         05  CUST-CITY       PIC X(20). 
L          46         05  CUST-STATE      PIC XX. 
L          47         05  CUST-ZIP        PIC 9(5). 
L          48 * THE COMPILER IGNORES COMMENT LINES AND BLANK LINES 
L          49 
L          50 * FOR MATCHING PURPOSES 
LR         51     03  CUST-ORDERS OCCURS 6   TIMES. 
L          52         05  CUST-ORDER      PIC 9(6). 
L          53         05  CUST-ORDER-DATE PIC 9(6). 
LR         54         05  CUST-ORDER-AMT  PIC 9(4)V99. 
 

Example 8-4 shows the results of matching a nonnumeric literal. The opening and closing quotation marks are part of the text-word.

Example 8-4 Matching a Nonnumeric Literal

           129 copy custfile replacing xyz by 6, ==r== by ==4== 
           130    "KEY" by "abc". 
L          131 01  CUSTOMER-REC. 
LR         132     03  CUST-REC-KEY        PIC X(03) VALUE "abc" . 
L          133     03  CUST-NAME   PIC X(25). 
L          134     03  CUST-ADDRESS. 
L          135         05  CUST-CUST-STREET        PIC X(20). 
L          136         05  CUST-CITY       PIC X(20). 
L          137         05  CUST-STATE      PIC XX. 
L          138         05  CUST-ZIP        PIC 9(5). 
L          139 * THE COMPILER IGNORES COMMENT LINES AND BLANK LINES 
L          140 
L          141 * FOR MATCHING PURPOSES 
LR         142     03  CUST-ORDERS OCCURS 6   TIMES. 
L          143         05  CUST-ORDER      PIC 9(6). 
L          144         05  CUST-ORDER-DATE PIC 9(6). 
LR         145         05  CUST-ORDER-AMT  PIC 9(4)V99. 
 

Example 8-5 shows the results of a multiple-line pseudo-text replacement item. The replacement item starts after the pseudo-text delimiter on line 167 and ends before the delimiter on line 169. The continuation area on the new line (172) contains the same characters as line 168 in the pseudo-text replacement item. This example is not a recommended use of the COPY statement. It only shows the mechanics of the statement.

Example 8-5 Multiple-Line Pseudo-Text Replacement Item

         166  copy custfile replacing xyz by 6, ==r== by ==4== 
         167      "KEY" by =="abc". 
         168 * cust-number is a new field 
         169      03  cust-number pic 9(8)==. 
L        170  01  CUSTOMER-REC. 
LR       171      03  CUST-REC-KEY        PIC X(03) VALUE "abc". 
LR       172 * cust-number is a new field 
LR       173      03  cust-number pic 9(8). 
L        174      03  CUST-NAME   PIC X(25). 
L        175      03  CUST-ADDRESS. 
L        176          05  CUST-CUST-STREET        PIC X(20). 
L        177          05  CUST-CITY       PIC X(20). 
L        178          05  CUST-STATE      PIC XX. 
L        179          05  CUST-ZIP        PIC 9(5). 
L        180 * THE COMPILER IGNORES COMMENT LINES AND BLANK LINES 
L        181 
L        182 * FOR MATCHING PURPOSES 
LR       183      03  CUST-ORDERS OCCURS 6   TIMES. 
L        184          05  CUST-ORDER      PIC 9(6). 
L        185          05  CUST-ORDER-DATE PIC 9(6). 
LR       186          05  CUST-ORDER-AMT  PIC 9(4)V99. 
 

Example 8-6 shows the results of matching pseudo-text that includes separators.

The replacement phrase in line 210 fails to match the library text in line 212. The text-matching argument contains one text-word: the 13 characters beginning with c and ending with a period (.). The period is not a separator period, because it is not followed by a space. This argument fails to match the two text-words on line 212. The two text-words are: (1) CUSTOMER-REC and (2) the separator period.

The replacement phrase in line 211 replaces library text on line 215. The text-matching argument contains the same two text-words that are in the library text: (1) CUST-ADDRESS and (2) the separator period.

Example 8-6 Matching Pseudo-Text That Includes Separators

           209 copy custfile replacing xyz by 6, ==r== by ==4== 
           210    ==customer-rec.== by ==record-a.== 
           211    ==cust-address. == by ==customer-address.==. 
L          212 01  CUSTOMER-REC. 
L          213     03  CUST-REC-KEY        PIC X(03) VALUE "KEY". 
L          214     03  CUST-NAME   PIC X(25). 
LR         215     03  customer-address. 
L          216         05  CUST-CUST-STREET        PIC X(20). 
L          217         05  CUST-CITY       PIC X(20). 
L          218         05  CUST-STATE      PIC XX. 
L          219         05  CUST-ZIP        PIC 9(5). 
L          220 * THE COMPILER IGNORES COMMENT LINES AND BLANK LINES 
L          221 
L          222 * FOR MATCHING PURPOSES 
LR         223     03  CUST-ORDERS OCCURS 6   TIMES. 
L          224         05  CUST-ORDER      PIC 9(6). 
L          225         05  CUST-ORDER-DATE PIC 9(6). 
LR         226         05  CUST-ORDER-AMT  PIC 9(4)V99. 
           227 
 

Examples Using Format 2 (OpenVMS)

Figure 8-1 represents a hierarchical repository structure for Examples 8-7, 8-8, and 8-9. It contains one repository directory and two repository objects.

Figure 8-1 Hierarchical Repository Structure (OpenVMS)


In Figure 8-1, the repository is named SALES (USA and GERMANY are not used). ANCHOR is the starting directory for the full repository pathname. Repository directories are analogous to OpenVMS Alpha subdirectories. They catalog other repository directories or repository objects, and they are labeled by the paths through the hierarchy that lead to them.

The repository objects are named PAYROLL and INVENTORY. These objects are the named record descriptions stored in Oracle CDD/Repository, and they form the end-points of the repository hierarchy branches. The examples that follow copy these record descriptions.

The full repository pathname provides a unique designation for every directory and object in Oracle CDD/Repository hierarchy. It traces the paths from ANCHOR to the directory or object.

For information on how to create and maintain a hierarchical structure in Oracle CDD/Repository, refer to the Oracle CDD/Repository documentation set.

Note

Not all Oracle CDD/Repository data types are valid Compaq COBOL data types. See the Technical Notes.

Example 8-7 shows how to use a command file to create the repository directories and objects shown in Figure 8-1 using CDO.

Example 8-7 Command File That Creates Oracle CDD/Repository Directories and Objects in Figure 8-1 (OpenVMS)

define field name 
    datatype is text 
    size 30. 
define field address 
    datatype is text 
    size is 40. 
define field salesman_id 
    datatypes is text 
    size is 5. 
define record salesman. 
    name. 
    address. 
    salesman_id. 
end record. 
define field ytd_sales 
    datatype is right overpunched numeric 
    size is 11 digits 
    scale -2. 
define field ytd_commission 
    datatype is right overpunched numeric 
    size is 11 digits 
    scale -2. 
define field curr_month_sales 
    datatype is right overpunched numeric 
    size is 11 digits 
    scale -2. 
define field curr_month_commission 
    datatype is right overpunched numeric 
    size is 11 digits 
    scale -2. 
define field curr_week_sales 
    datatype is right overpunched numeric 
    size is 11 digits 
    scale -2. 
define field curr_week_commission 
    datatype is right overpunched numeric 
    size is 11 digits 
    scale -2. 
define record payroll_record. 
    salesman. 
    ytd_sales. 
    ytd_commission. 
    curr_month_sales. 
    curr_month_commission. 
    curr_week_sales. 
    curr_week_commission. 
end record. 
define field part_number 
    datatype is right overpunched numeric 
    size is 6 digits. 
define field quantity_on_hand 
    datatype is right overpunched numeric 
    size is 9 digits. 
define field quantity_on_order 
    datatype is right overpunched numeric 
    size is 9 digits. 
define field retail_price 
    datatype is right overpunched numeric 
    size is 8 digits 
    scale -2. 
define field wholesale_price 
    datatype is right overpunched numeric 
    size is 8 digits 
    scale -2. 
define field supplier 
    datatype is text 
    size is 5 characters. 
define record inventory_record. 
    part_number. 
    quantity_on_hand. 
    quantity_on_order. 
    retail_price. 
    wholesale_price. 
    supplier. 
end record. 

Example 8-8 shows the results of copying the repository object PAYROLL in Figure 8-1. The program defines the logical name payroll to be equivalent to the full Oracle CDD/Repository pathname DEVICE:[DIRECTORY.ANCHOR]. Line 27 of the program shows the DCL command used to define the logical name and line 30 contains the COPY FROM DICTIONARY statement.

On OpenVMS Alpha systems, the COPY statement produces lines 31 to 44 in your program listing if you include the /COPY_LIST compiler option. Line 32 is the resulting full Oracle CDD/Repository pathname used by the compiler. Lines 31 and 33 are separator comment lines. Lines 34 to 44 are the COBOL compiler-translated record description entries taken from the PAYROLL repository object in Oracle CDD/Repository.

Example 8-8 Using a Logical Name in a COPY Statement (OpenVMS)

              1 IDENTIFICATION DIVISION. 
              2 PROGRAM-ID.  TEST-CDD. 
              3 * 
              4 *   Copy from CDD/Repository 
              5 *   FILE SECTION 
              6 *           Records:    PERSONNEL 
              7 *                       INVENTORY 
              8 *                       PAYROLL 
              9 * 
             10 *   WORKING-STORAGE SECTION 
             11 *           Records:    SYDNEY 
             12 *                       MAPLE 
             13 *                       FRENCH 
             14 * 
             15 ENVIRONMENT DIVISION. 
             16 INPUT-OUTPUT SECTION. 
             17 FILE-CONTROL. 
             18     SELECT SALES-CDD-FILE 
             19     ASSIGN TO "CDD.TMP". 
             20 DATA DIVISION. 
             21 FILE SECTION. 
             22 FD SALES-CDD-FILE. 
             23 * 
             24 *   To create a logical name entry for the repository object 
             25 *   PAYROLL, use this command: 
             26 * 
             27 *   $ DEFINE PAYROLL_RECORD "DEVICE:[DIRECTORY.ANCHOR]SALES.PAYROLL" 
             28 * 
             29 * 
             30     COPY PAYROLL FROM DICTIONARY. 
L            31 * 
L            32 * _DEVICE:[DIRECTORY.ANCHOR]PAYROLL_RECORD 
L            33 * 
L            34 01  PAYROLL_RECORD. 
L            35     02  SALESMAN. 
L            36         03  NAME            PIC X(30). 
L            37         03  ADDRESS         PIC X(40). 
L            38         03  SALESMAN_ID     PIC X(5). 
L            39     02  YTD_SALES           PIC S9(9)V9(2) SIGN TRAILING. 
L            40     02  YTD_COMMISSION      PIC S9(9)V9(2) SIGN TRAILING. 
L            41     02  CURR_MONTH_SALES    PIC S9(9)V9(2) SIGN TRAILING. 
L            42     02  CURR_MONTH_COMMISSION PIC S9(9)V9(2) SIGN TRAILING. 
L            43     02  CURR_WEEK_SALES     PIC S9(9)V9(2) SIGN TRAILING. 
L            44     02  CURR_WEEK_COMMISSION PIC S9(9)V9(2) SIGN TRAILING. 
             45 
             46     COPY "DEVICE:[DIRECTORY.ANCHOR]INVENTORY_RECORD" FROM DICTIONARY. 
L            47 * 
L            48 * _DEVICE:[DIRECTORY.ANCHOR]INVENTORY_RECORD 
L            49 * 
L            50 01  INVENTORY_RECORD. 
L            51     02  PART_NUMBER         PIC S9(6) SIGN TRAILING. 
L            52     02  QUANTITY_ON_HAND    PIC S9(9) SIGN TRAILING. 
L            53     02  QUANTITY_ON_ORDER   PIC S9(9) SIGN TRAILING. 
L            54     02  RETAIL_PRICE        PIC S9(6)V9(2) SIGN TRAILING. 
L            55     02  WHOLESALE_PRICE     PIC S9(6)V9(2) SIGN TRAILING. 
L            56     02  SUPPLIER            PIC X(5). 
             57 
             58 
        ...      

Example 8-9 shows the results of copying a repository object INVENTORY by specifying its full Oracle CDD/Repository pathname.

In Example 8-9, line 44 contains the COPY FROM DICTIONARY statement. On OpenVMS Alpha systems, this COPY statement produces lines 45 to 54 in your program listing if you include the /COPY_LIST compiler option. Line 46 is the resulting full Oracle CDD/Repository pathname used by the compiler. Lines 45 and 47 are separator comment lines. Lines 48 to 54 are the compiler-translated record description entries taken from the inventory repository object in Oracle CDD/Repository.

Example 8-9 Using a Full Pathname in a COPY Statement (OpenVMS)

       44      COPY "DEVICE:[DIRECTORY.ANCHOR]SALES.INVENTORY" FROM DICTIONARY. 
L      45 * 
L      46 * DEVICE:[DIRECTORY.ANCHOR]SALES.INVENTORY 
L      47 * 
L      48 01  INVENTORY_RECORD. 
L      49      02  PART_NUMBER               PIC 9(6). 
L      50      02  QUANTITY_ON_HAND          PIC S9(9) SIGN TRAILING. 
L      51      02  QUANTITY_ON_ORDER         PIC S9(9) SIGN TRAILING. 
L      52      02  RETAIL_PRICE              PIC S9(6)V9(2) SIGN TRAILING. 
L      53      02  WHOLESALE_PRICE           PIC S9(6)V9(2) SIGN TRAILING. 
L      54      02  SUPPLIER                  PIC X(5). 

Figure 8-2 shows a nonhierarchical repository structure. In this example, fields NAME and ADDRESS are used by both the EMPLOYEE-RECORD and the CUSTOMER-RECORD. As such, they are defined in a separate directory (COMMON_FIELD_DEFINITIONS). The fields PART and PART_NUMBER are used exclusively by the INVENTORY_RECORD. As such, they are defined in the INVENTORY directory. This functionality is only available in CDO formatted repositories.

Figure 8-2 Nonhierarchical Repository Structure (OpenVMS)


Example 8-10 shows how to use a CDO command file to create the directories and objects shown in Figure 8-2 using CDO. The CDO file is executed from within CDO using the following command:


$ REPOSITORY 
CDO>@FILENAME.CDO 

Example 8-10 Command File That Creates Oracle CDD/Repository Directories and Objects in Figure 8-2 (OpenVMS)

DEFINE DICTIONARY DEVICE:[DIRECTORY.ANCHOR]. 
SET DEFAULT DEVICE:[DIRECTORY.ANCHOR] 
DEFINE DIRECTORY EMPLOYEE. 
DEFINE DIRECTORY CUSTOMER. 
DEFINE DIRECTORY INVENTORY. 
DEFINE DIRECTORY COMMON_FIELD_DEFINITIONS. 
SET DEFAULT DEVICE:[DIRECTORY.ANCHOR]COMMON_FIELD_DEFINITIONS 
DEFINE FIELD NAME DATATYPE IS TEXT SIZE IS 25 CHARACTERS. 
DEFINE FIELD ADDRESS DATATYPE IS TEXT SIZE IS 47 CHARACTERS. 
SET DEFAULT DEVICE:[DIRECTORY.ANCHOR]EMPLOYEE 
DEFINE FIELD DATE_OF_HIRE DATATYPE IS UNSIGNED NUMERIC SIZE IS 8 DIGITS. 
DEFINE FIELD SEX DATATYPE IS TEXT SIZE IS 1 CHARACTER. 
DEFINE FIELD DEPENDENTS DATATYPE IS UNSIGNED NUMERIC SIZE IS 2 DIGITS. 
DEFINE RECORD EMPLOYEE_RECORD. 
[DIRECTORY.ANCHOR]COMMON_FIELD_DEFINITIONS.NAME. 
[DIRECTORY.ANCHOR]COMMON_FIELD_DEFINITIONS.ADDRESS. 
DATE_OF_HIRE. 
SEX. 
DEPENDENTS. 
END RECORD. 
SET DEFAULT DEVICE:[DIRECTORY.ANCHOR]CUSTOMER 
DEFINE FIELD BUSINESS_TYPE DATATYPE IS TEXT SIZE IS 25 CHARACTERS. 
DEFINE FIELD CONTACT_PERSON DATATYPE IS TEXT SIZE IS 25 CHARACTERS. 
DEFINE RECORD CUSTOMER_RECORD. 
[DIRECTORY.ANCHOR]COMMON_FIELD_DEFINITIONS.NAME. 
[DIRECTORY.ANCHOR]COMMON_FIELD_DEFINITIONS.ADDRESS. 
BUSINESS_TYPE. 
CONTACT_PERSON. 
END RECORD. 
SET DEFAULT DEVICE:[DIRECTORY.ANCHOR]INVENTORY 
DEFINE FIELD PART DATATYPE IS TEXT SIZE IS 25 CHARACTERS. 
DEFINE FIELD PART_NUMBER DATATYPE IS TEXT SIZE IS 10 CHARACTERS. 
DEFINE RECORD INVENTORY_RECORD. 
PART. 
PART_NUMBER. 
END RECORD.                                              <>
 

8.1.2 REPLACE

Function

The REPLACE statement is used to replace source program text.


pseudo-text-1

is a text-matching argument that the compiler compares against text-words in the source text.

pseudo-text-2

is a replacement item that the compiler inserts into the source program.

Syntax Rules

  1. A REPLACE statement can be inserted anywhere that a character-string can be used. This statement must be preceded by a separator period unless it is the first statement in a separately compiled program.
  2. A REPLACE statement must be terminated by the separator period.
  3. pseudo-text-1 must contain at least one text-word.
  4. pseudo-text-2 can contain zero, one, or more text-words.
  5. Character-strings within pseudo-text-1 and pseudo-text-2 can be continued.
  6. pseudo-text-1 must not consist entirely of a separator comma or a separator semicolon.
  7. The word REPLACE is considered part of a comment-entry if it appears in the comment-entry or in the place where a comment-entry can appear.

General Rules

Format 1

  1. Each matched occurrence of pseudo-text-1 in the source program is replaced by the corresponding pseudo-text-2.

Format 2

  1. Any text replacement currently in effect is discontinued.

Both Formats

  1. A REPLACE statement remains in effect until the next occurrence of a REPLACE statement or until the end of a separately compiled program has been reached.
  2. Any occurrence of a REPLACE statement in a source program is processed after all COPY statements in the source program have been processed.
  3. pseudo-text-2 must not contain a REPLACE statement.
  4. The comparison operation starts with the leftmost source text word and the first text-matching argument. The compiler compares the entire text-matching argument to an equivalent number of consecutive source text-words.
  5. A text-matching argument matches the source text only if the ordered sequence of text-words that forms the text-matching argument is equal, character for character, to the ordered sequence of source text-words.
    In the matching operation, the compiler treats each occurrence or combination of the following items in source text as a single space:
  6. If no match occurs, the compiler repeats the comparison operation with each successive text-matching argument until a match is found or there are no more text-matching arguments.
  7. If no match occurs after the compiler has compared all of the text-matching arguments, the next successive source text-word becomes the leftmost text-word, and the comparison resumes with the first occurrence of pseudo-text-1.
  8. If a match occurs between a text-matching argument and the source program text, the compiler inserts the replacement text into the source program. The source text-word immediately following the rightmost replaced text-word becomes the leftmost text-word for the next cycle. The comparison cycle resumes with the first occurrence of pseudo-text-1.
  9. The comparison cycles continue until the rightmost text-word in the source text that is within the scope of the REPLACE statement has been either:
  10. The rules for Reference Format determine the sequence of text-words in the source text and the text-matching arguments.
  11. The compiler ignores comment lines and blank lines in the source program and in pseudo-text-1 for matching.
  12. When the compiler inserts pseudo-text-2 in the source program, it inserts comment lines and blank lines in pseudo-text-2 without modification.
  13. Debugging lines are permitted in pseudo-text-1 and pseudo-text-2. The compiler treats the comparison of debugging lines as if the conditional compilation character does not appear in the indicator area.
  14. The compiler cannot determine the syntactic correctness of source text or the source program until all COPY and REPLACE statements have been processed.
  15. Text words that are inserted as a result of a processed REPLACE statement are placed in the source program according to the rules for Reference Format.
  16. When the compiler inserts text words of pseudo-text-2 into the source program, additional spaces may be introduced between text words where spaces already exist (including the assumed space between source lines).
  17. If additional lines are added to the source program as a result of a REPLACE operation, the indicator area of the added lines contains the same character as the line on which the text being replaced begins (unless that line contains a hyphen, in which case the introduced line contains a space).
    If a literal within pseudo-text-2 cannot be contained on a single line without a continuation to another line in the resultant program and the literal is not being placed on a debugging line, additional continuation lines are introduced that contain the remainder of the literal. If replacement requires the continued literal to be continued on a debugging line, the program is in error.

Additional Reference

See Section 1.3, Source Reference Format.

Examples

In the following examples, uppercase words represent text-words that have been replaced.

  1. REPLACE statement with multiple replacement items:


             8 working-storage section.         
             9 replace ==alpha== by ==NUM-1==  
            10         ==num== by ==ALPHA-1==. 
     R      11 01  NUM-1  pic 9(10).           
     R      12 01  ALPHA-1                     
            13            pic x(10).           
            14 procedure division.             
    

  2. Multiple REPLACE statements:
    A given occurrence of the REPLACE statement is in effect from the point at which it is specified until the next occurrence of the REPLACE statement. The new REPLACE statement supersedes the text-matching established by the previous REPLACE statement.


             7 working-storage section. 
             8 01  total           pic 9(4)v99. 
             9 replace ==class== by ==CLASS1== 
            10         ==total== by ==ORDER-AMT==. 
            11 01  customer-rec. 
     R      12     03  CLASS1      pic x(02). 
            13     03  name        pic x(25). 
            14     03  address. 
            15         05  street  pic x(20). 
            16         05  city    pic x(20). 
            17         05  state   pic xx. 
            18         05  zip     pic 9(5). 
            19     03  orders occurs 6 times. 
            20         05  order-numb  pic 9(6). 
            21         05  order-date  pic 9(6). 
     R      22         05  ORDER-AMT   pic 9(4)v99. 
            23 procedure division. 
            24 replace ==class== by ==CLASS1==. 
            25 p0.  add order-amt of orders(3) to total. 
    

    In the previous example, the word total on line 25 is not replaced because the REPLACE statement on line 24 reestablished the text-matching arguments.


    Previous Next Contents Index