Example - % IF Structure

The % IF structure builds a program that tests records for any specific character and replaces some occurrences of it with any other specific character, depending on the character mode, for example, whether the character appears as a leading or trailing character, or anywhere. The variables that control the record length and what you search and replace, appear at the top of the program. Thus, you can reuse this rule for different purposes simply by changing the values of a few variables.
Restriction: This topic applies only when the AppMaster Builder AddPack has been installed, and applies only to Windows platforms.

Input source:

 % &MODE = 'TRAILING'                                      201.
 % &REC-LEN =121                                           202.
 % &TEST-CHR = 'SPACE'                                     203.
 % &REPLACE-CHR = 'ZERO'                                   204.
 IDENTIFICATION DIVISION.                                  205.
 PROGRAM-ID.                     EXAMPLE2.                 206.
*SPECIAL CONSIDERATIONS.                                   207.
* SAMPLE PROGRAM TO READ RECS WHOSE LENGTH IS DETERMINED   208.
* AT COMPILE-TIME & REPLACE SOME OCCURRENCES OF TEST-CHR   209.
* BY THE REPLACE-CHR (BOTH TO BE SET AT COMPILE-TIME).     210.
* REPLACEMENT MODE USED (LEADING, TRAILING, OR ALL)        211.
* IS SET AT COMPILE-TIME.                                  212.
                                                           213.
 ENVIRONMENT DIVISION.                                     214.
 INPUT-OUTPUT SECTION.                                     215.
 FILE-CONTROL.                                             216.
 SELECT INPUT-FILE           ASSIGN "INPUT".               217.
 SELECT OUTPUT-FILE          ASSIGN "OUTPUT".              218.
                                                           219.
 DATA DIVISION.                                            220.
 FILE SECTION.                                             221.
                                                           222.
 FD  INPUT-FILE                                            223.
     BLOCK CONTAINS 0 RECORDS                              224.
     LABEL RECORDS ARE STANDARD.                           225.
 01  INPUT-RECORD                PIC X(&REC-LEN).          226.
                                                           227.
 FD  OUTPUT-FILE                                           228.
     BLOCK CONTAINS 0 RECORDS                              229.
     LABEL RECORDS ARE STANDARD.                           230.
 01  OUTPUT-RECORD               PIC X(&REC-LEN).          231.
                                                           232.
 WORKING-STORAGE SECTION.                                  233.
                                                           234.
 01  WS-RECORD.                                            235.
   02  WS-CHR                   PIC X OCCURS &REC-LEN.     236.
                                                           237.
 01  II                          PIC S9(4) COMP-5.         238.    
                                                           239.
 PROCEDURE DIVISION.                                       240.
                                                           241.
 OPEN INPUT INPUT-FILE                                     242.
 OPEN OUTPUT OUTPUT-FILE                                   243.
                                                           244.
 REPEAT                                                    245.
     READ INPUT-FILE INTO WS-RECORD                        246.
 UNTIL AT END ON INPUT-FILE                                247.
     % IF &MODE = 'LEADING'                                248.
         REPEAT VARYING II FROM 1 BY 1                     249.
         UNTIL II > &REC-LEN                               250.
         ... OR WS-CHR (II) NOT = &TEST-CHR                251.
             WS-CHR (II) = &REPLACE-CHAR                   252.
     % ELSE-IF &MODE = 'TRAILING'                          253.
         REPEAT VARYING II FROM &REC-LEN BY -1             254.
         UNTIL II < 1                                      255.
         ... OR WS-CHR (II) NOT = &TEST-CHR                256.
             WS-CHR (II) = &REPLACE-CHAR                   257.
     % ELSE-IF &MODE = 'ALL'                               258.
         REPEAT VARYING II FROM 1 BY 1                     259.
         UNTIL II > &REC-LEN                               260.
             IF WS-CHR (II) = &TEST-CHR                    261.
                 WS-CHR (II) = &REPLACE-CHAR               262.
     % ELSE                                                263.
         DISPLAY "PARAMETER ERROR IMPROPER MODE:" &MODE    264.
                                                           265.
     WRITE OUTPUT-RECORD FROM WS-RECORD                    266.
                                                           267.
 CLOSE INPUT-FILE OUTPUT-FILE                              268.

Output source:

020500 IDENTIFICATION DIVISION.                            205.
020600 PROGRAM-ID.                     EXAMPLE2.           206.
020700*SPECIAL CONSIDERATIONS.                             207.
020800* PROGRAM TO READ RECS WHOSE LENGTH IS DETERMINED AT 208.
020900* COMPILE-TIME & REPLACE SOME OCCURRENCES OF TEST-CHR209.
021000* BY REPLACE-CHR (BOTH TO BE SET AT COMPILE-TIME).   210.
021100* REPLACEMENT MODE USED (LEADING, TRAILING OR ALL)   211.
021200* IS SET AT COMPILE-TIME.                            212.
021300                                                     213.
021400 ENVIRONMENT DIVISION.                               214.
021500 INPUT-OUTPUT SECTION.                               215.
021600 FILE-CONTROL.                                       216.
021700 SELECT INPUT-FILE           ASSIGN "INPUT".         217.
021800 SELECT OUTPUT-FILE          ASSIGN "OUTPUT".        218.
021900                                                     219.
022000 DATA DIVISION.                                      220.
022100 FILE SECTION.                                       221.
022200                                                     222.
022300 FD  INPUT-FILE                                      223.
022400     BLOCK CONTAINS 0 RECORDS                        224.
022500     LABEL RECORDS ARE STANDARD.                     225.
022600 01  INPUT-RECORD                PIC X(121).         226.
022700                                                     227.
022800 FD  OUTPUT-FILE                                     228.
022900     BLOCK CONTAINS 0 RECORDS                        229.
023000     LABEL RECORDS ARE STANDARD.                     230.
023100 01  OUTPUT-RECORD               PIC X(121).         231.
023200                                                     232.
023300 WORKING-STORAGE SECTION.                            233.
023400                                                     234.
023500 01  WS-RECORD.                                      235.
023600   02  WS-CHR                    PIC X OCCURS 121.   236.
023700                                                     237.
023800 01  II                          PIC S9(4) COMP-5.   238.
023900                                                     239.
024000 PROCEDURE DIVISION.                                 240.
024100                                                     241.
024200     OPEN INPUT INPUT-FILE                           242.
024300     OPEN OUTPUT OUTPUT-FILE                         243.
024400                                                     244.
024500     REPEAT                                          245.
024600         READ INPUT-FILE INTO WS-RECORD              246.
024700     UNTIL AT END ON INPUT-FILE                      247.
025400         REPEAT VARYING II FROM 121 BY -1            254.
025500         UNTIL II < 1                                255.
025600         ... OR WS-CHR (II) NOT = SPACE              256.
025700             WS-CHR (II) = ZERO                      257.
026600         WRITE OUTPUT-RECORD FROM WS-RECORD          266.
026700                                                     267.
026800     CLOSE INPUT-FILE OUTPUT-FILE                    268.

Discussion:

Lines 201 - 204:

  • Input - Variables are assigned values and are used in the Procedure Division to replace any trailing space with a zero.

Lines 245-247 and 266-268:

  • Input - The S-COBOL REPEAT verb establishes a loop that can be tested at the middle or end. The statement blocks subordinate to REPEAT and UNTIL form the loop and are executed repeatedly until the condition specified by the UNTIL statement is true, for example, until the end of file. At end of file, processing continues at line 268 After line 268, S-COBOL generates a STOP RUN.
  • Output - These lines are copied into the output source because they contain no Customizer syntax.

Lines 253-257:

  • Input - This statement block is executed because &MODE was assigned the value 'TRAILING' at the top of the program. REPEAT VARYING ... UNTIL ... is an extension of the S-COBOL REPEAT verb. It establishes a test and executes its subordinate statement block repeatedly until the test is true.
  • Output - Line 253 does not appear in the output because it is a Customizer statement. The other lines do appear. The variables &REC-LEN, &TEST-CHR, and &REPLACE-CHR are resolved with their values 121, SPACE, and ZERO. The loop starts at the 121st character, is decrements by 1; it executes line 257 until a trailing character appears that is not a space, or until all 121 characters are tested.

Lines 263-265:

  • Input - If &MODE is neither LEADING, TRAILING, or ALL, control falls to this % ELSE statement and displays an error message.
  • Output - Note that input line 265 is blank. It does not appear in the output because it is considered part of the statement block subordinate to % ELSE. Remember that a statement block ends with the first non-blank character at the same or less indentation than the controlling conditional statement. To get the blank line to appear in the output, end the conditional structure by inserting a line beneath line 264 and coding % END at the same indentation as % ELSE; then, leave the next line blank.