%* HERE IS THE RULE $DAYDEF 501.
502.
% DEFINE $DAYDEF( &DAY) 506.
% &PREFIX = &SUBSTR( &DAY, 1, 24) 507.
% &CHR = &SUBSTR( &PREFIX, 24) 508.
% IF &CHR = '-' 509.
% &PREFIX = &SUBSTR( &PREFIX, 1, 23) 510.
% &SUFFIX = '-ENTRY' 511.
% &DAYCTR = &DAYCTR + 1 512.
02 &PREFIX&SUFFIX. 513.
03 FILLER &40+PIC S9(2) COMP SYNC VALUE +&LENGTH( &DAY).
% IF &LENGTH( &DAY) <= 16 515.
03 FILLER &40+PIC X(30) VALUE &QT&DAY&QT. 516.
% ELSE 517.
03 FILLER &40+PIC X(30) VALUE 518.
&40+&QT&DAY&QT. 519.
% END 520.
521.
All Lines:
The $DAYDEF rule uses the structures &SUBSTR and &LENGTH to build a data structure for a table. For each table entry, $DAYDE builds an 02-level data name and provides the values for the two 03-level entries VALUE clauses that follow it. The 02-level data name construct is &PREFIX&SUFFIX.
The value of &PREFIX is supplied by the formal argument &DAY, which receives its value from a rule call to $DAYDEF. For example, the first rule call in the program gives the value SUNDAY to &DAY. The structure &SUBSTR checks this value and allows acceptance of up to 24 characters; values longer than 24 characters are truncated. On the next line, &SUBSTR checks to see whether the 24th character (if there is one) is a hyphen. If it is a hyphen, it uses only 23 characters; this prevents a double hyphen, which would be undesirable; for example, you don't want a hyphen from the name followed by the hyphen of the suffix -ENTRY. SUNDAY is only 6 characters long, so the entire value is accepted for &PREFIX. Thus, the value of &PREFIX&SUFFIX for the first call is SUNDAY-ENTRY.
Now, $DAYDEF provides the VALUE clause values for the two 03-level data elements of SUNDAY-ENTRY. In the first 03 element, VALUE +&LENGTH( &DAY) becomes VALUE +6 because the value of &DAY, which is SUNDAY, is 6 characters long. The plus symbol is recognized as the COBOL plus symbol because there is a space before it. In contrast, the plus symbol in &40+PIC is recognized as a Customizer column indicator, which in this case means to put the PIC clause in column 41.
Line 515 checks to see whether the &DAY values fit on one line; for example, if they are 16 characters maximum. If it fits, its format is like line 516; remember that the line shifts under the % IF statement during processing. If it cannot fit, its format is the 2-line format on lines 518-519.
The value of &SUFFIX for each rule call is the literal string -ENTRY.
% &DAYCTR = 0 522.
% &QT = "'" 523.
524.
% SET BLANK 525.
IDENTIFICATION DIVISION. 526.
PROGRAM-ID. EXAMPLE&INDEX( 'ABCDEFG', 'EF'). 527.
DATE-COMPILED. &COMPILETIME. 528.
*SPECIAL CONSIDERATIONS. 529.
* A PIECE OF A SAMPLE PROGRAM TO DEMONSTRATE SOME 530.
* OF THE SOURCE CODE GENERATOR STRUCTURES. 531.
532.
-- 533.
-- 534.
535.
WORKING-STORAGE SECTION. 536.
537.
01 DAY-TABLE. 538.
$DAYDEF( 'SUNDAY') 539.
$DAYDEF( 'MONDAY') 540.
$DAYDEF( 'TUESDAY') 541.
$DAYDEF( 'WEDNESDAY') 542.
$DAYDEF( 'THURSDAY') 543.
$DAYDEF( 'FRIDAY') 544.
$DAYDEF( 'A-LARGE-SYMBOL-TO-CHECK-DAYDEF') 545.
01 DAY-TABLE-REDEF REDEFINES DAY-TABLE. 546.
02 DAY-ENTRY OCCURS &DAYCTR. 547.
03 DAY-LEN PIC S9(2) COMP SYNC. 548.
03 DAY-BOL PIC X(30). 549.
550.
PROCEDURE DIVISION. 551.
552.
-- 553.
-- 554.
Lines 527-528:
&INDEX returns a number identifying the character position of the first occurrence of EF within ABCDEFG. The number is 5; thus, EXAMPLE&INDEX 'ABCDEFG', 'EF') becomes EXAMPLE5.
&COMPILETIME returns the current date and time each time the program compiles.
Lines 539-545:
These are seven rule calls to $DAYDEF, each providing a value for the &DAY argument in $DAYDEF.
Line 547:
The OCCURS clause value is initialized to 0 at the top of the program, and is used in $DAYDEF.
052300 IDENTIFICATION DIVISION. 526. 052400 PROGRAM-ID. EXAMPLE5. 527. 052500 DATE-COMPILED. 22 OCT 79 14.24.00. 528. 052600*SPECIAL CONSIDERATIONS. 529. 052700* A PIECE OF A SAMPLE PROG TO DEMONSTRATE SOME OF 530. 052800* THE SOURCE CODE GENERATOR STRUCTURES. 531. 052900 532. 053000 -- 533. 053100 -- 534. 053200 535. 053300 WORKING-STORAGE SECTION. 536. 053400 537. 053500 01 DAY-TABLE. 538. 053600 02 SUNDAY-ENTRY. 539. 053602 03 FILLER PIC S9(2) COMP SYNC VALUE +6 539. 053604 03 FILLER PIC X(30) VALUE 'SUNDAY'. 539. 053700 02 MONDAY-ENTRY. 540. 053702 03 FILLER PIC S9(2) COMP SYNC VALUE +6. 540. 053704 03 FILLER PIC X(30) VALUE 'MONDAY'. 540. 053800 02 TUESDAY-ENTRY. 541. 053802 03 FILLER PIC S9(2) COMP SYNC VALUE +7. 541. 053804 03 FILLER PIC X(30) VALUE 'TUESDAY'. 541. 053900 02 WEDNESDAY-ENTRY 542. 053902 03 FILLER PIC S9(2) COMP SYNC VALUE +9. 542. 053904 03 FILLER PIC X(30) VALUE 'WEDNESDAY'. 542. 054000 02 THURSDAY-ENTRY. 543. 054002 03 FILLER PIC S9(2) COMP SYNC VALUE +8. 543. 054004 03 FILLER PIC X(30) VALUE 'THURSDAY'. 543. 054100 02 FRIDAY-ENTRY. 544. 054102 03 FILLER PIC S9(2) COMP SYNC VALUE +6. 544. 054104 03 FILLER PIC X(30) VALUE 'FRIDAY'. 544. 054200 02 A-LARGE-SYMBOL-TO-CHECK-ENTRY. 545. 054202 03 FILLER PIC S9(2) COMP SYNC VALUE +30.545. 054204 03 FILLER PIC X(30) VALUE 545. 054206 'A-LARGE-SYMBOL-TO-CHECK-DAYDEF'.545. 054300 01 DAY-TABLE-REDEF REDEFINES DAY-TABLE. 546. 054400 02 DAY-ENTRY OCCURS 7. 547. 054500 03 DAY-LEN PIC S9(2) COMP SYNC. 548. 054600 03 DAY-BOL PIC X(30). 549. 054700 550. 054800 PROCEDURE DIVISION. 551. 054900 552. 055000 -- 553. 055100 -- 554.