Level Numbers
Level numbers specify the hierarchy or level of data items or variables. They play the most important role in declaring the variables in the application programs.
Syntax -
level-number {variable|FILLER} ...
- level-number -
- Level number is a one or two-digit numeric value. Valid level numbers are - 01, 02, ...49, 66, 77 and 88.
- Level numbers 01 or 77 should begin in Area A.
- A level-numbers 02 through 49, 66 and 88 can begin in either Area A or Area B.
- variable - Identifies the variable used in the program.
- FILLER - FILLER is a keyword and is optional. We can use it where the buffer length is needed in the declaration. We can't able to refer FILLER in the program.
Level Number Types -
Level numbers are of two types based on their usage purpose -
- General purpose level numbers (01 to 49)
- Special purpose level numbers (66, 77 and 88)
General purpose level numbers (01 to 49) -
- General purpose level numbers declare regular variables that simply process the data.
- The level number hierarchy starts from 01 through 49.
- The hierarchy of level numbers should be in ascending order. i.e., 01 is the highest level number, and 49 is the lowest level number.
Example -
Scenario - Declaring employee record.
----+----1----+----2----+----3----+----4----+----5----+
01 EMPLOYEE-RECORD.
05 EMP-ID PIC 9(5).
05 EMP-NAME.
10 FIRST-NAME PIC X(15).
10 MIDDLE-NAME PIC X(10).
10 LAST-NAME PIC X(20).
Explaining Example -
In the above example:
- EMPLOYEE-RECORD, and EMP-NAME are group variables, and FIRST-NAME, MIDDLE-NAME, LAST-NAME are the elementary variables.
- EMP-NAME is a group variable with three elementary variables: FIRST-NAME (15 bytes), MIDDLE-NAME(10 bytes), and LAST-NAME(20 bytes). So, the total length of the EMP-NAME is 45 bytes.
- Lastly, EMPLOYEE-RECORD has two variables: EMP-ID(5 characters), EMP-NAME(45 bytes). So, the total EMPLOYEE-RECORD size is 50 bytes.
Special purpose level numbers (66, 77 and 88) -
These level numbers are used for special purposes like renaming a variable and declaring individual variables and conditional names. Those are -
- 66 level number
- 77 level number
- 88 level number
Level number 66 is used to create another logical group by regrouping the elementary variables of a group. The RENAMES keyword is used along with the 66-level number to rename the group.
Syntax -
----+----1----+----2----+----3----+----4----+----5----+
01 WS-VAR-GRP1.
05 WS-VAR-A PIC ...
05 WS-VAR-B PIC ...
.
.
05 WS-VAR-N PIC ...
05 WS-VAR-O PIC ...
.
.
05 WS-VAR-Z PIC ...
* Renaming entire group
66 WS-VAR-GRP2 RENAMES WS-VAR-A THRU WS-VAR-N.
* Renaming some elementary variables
66 WS-VAR-GRP3 RENAMES WS-VAR-GRP1.
In the above syntax,
- WS-VAR-GRP1 - Specifies source group.
- WS-VAR-A THRU WS-VAR-N - Specifies starting and ending elementary variables that will be part of the new group.
- WS-VAR-GRP2, WS-VAR-GRP3 - Specifies target groups.
Rules to Remember -
- Renaming elementary variables should be in sequential order.
- 66 level number shouldn't have a PIC or PICTURE clause.
- The RENAMES clause should follow the target variable in the declaration.
- Level-01, level-77, level-88, or other level-66 entries can't be renamed.
- Elementary variables that are declared with the OCCURS clause should not be renamed.
Example -
Scenario - Create a employee record with EMP-ID and EMP-NAME alone.
----+----1----+----2----+----3----+----4----+----5----+
01 EMPLOYEE-RECORD.
05 EMP-ID PIC 9(5).
05 EMP-NAME.
10 FIRST-NAME PIC X(15).
10 MIDDLE-NAME PIC X(10).
10 LAST-NAME PIC X(20).
05 DATE-OF-BIRTH.
10 DOB-YEAR PIC 9(4).
10 DOB-MONTH PIC 9(2).
10 DOB-DAY PIC 9(2).
66 EMPLOYEE-REC01 RENAMES EMP-ID THRU EMP-NAME.
In the above example, EMPLOYEE-REC01 contains only EMP-ID and EMPLOYEE-NAME from the EMPLOYEE-RECORD.
- In some scenarios, the variables are neither allowed to be converted to group variables nor elementary variables, such as constants. They have no immediate relationship to any other variables. Those variables are called Individual variables.
- Level number 77 is used to declare the individual variables.
Example -
Scenario - Create a employee record with EMP-ID and EMP-NAME alone.
----+----1----+----2----+----3----+----4----+----5----+
77 WS-PI PIC 9V9(2) VALUE 3.14.
In the above example, WS-PI contains the value 3.14, and it is not allowed to alter its declaration.
- The 88-level number defines a name for a value or a set of values under the variable.
- The 88-level number provides a descriptive name for a condition.
- The name associated with 88 level numbers is called as Condition Name, and the variable with 88 level numbers attached to it is called as Conditional Variable.
Condition names declartion syntax below -
01 conditional-variable PIC variable-declaration.
88 condition-name VALUE condition-value.
Different Formats -
Condition name has the advantage of being used in three different formats, which are very useful in validating the data.
Format1 - Single Value
The condition name is declared with only one value to validate. Syntax -
88 Condition-Name VALUE single-value.
For example - MALE & FEMALE condition names having a single value.
01 WS-GENDER PIC X(01).
88 WS-MALE VALUE 'M'.
88 WS-FEMALE VALUE 'F'.
With the above definition, we can write -
IF WS-MALE ...
Instead of -
IF WS-GENDER EQUAL "M" ...
Format2 - Multiple values
The condition name is declared with more than one value to validate. i.e., In a single condition, it can validate with more than one value. Syntax -
88 Condition-Name VALUE value1 value2...valueN.
For example - VALID-GENDER condition name has multiple values.
01 WS-GENDER PIC X(01).
88 WS-VALID-GENDER VALUE "M" "F".
88 WS-MALE VALUE "M".
88 WS-FEMALE VALUE "F".
With the above definition, we can write -
IF WS-VALID-GENDER ...
Instead of -
IF WS-GENDER EQUAL 'M'
OR WS-GENDER EQUAL 'Y' ...
Format3 - Range of values
The condition name is declared with a range of values to validate. i.e., in a single condition, it validates the value between starting and ending of a range. Syntax -
88 Condition-Name VALUE value1 THRU literalN.
For example - FIRST-CLASS, SECOND-CALSS, THIRD-CLASS & FAIL condition name has a range of values.
01 WS-MARKS PIC 9(03).
88 WS-FIRST-CLASS VALUE 60 THROUGH 100.
88 WS-SECOND-CLASS VALUE 50 THROUGH 59.
88 WS-THIRD-CLASS VALUE 35 THROUGH 49.
88 WS-FAIL VALUE 00 THROUGH 34.
With the above definition, we can write -
IF WS-FIRST-CLASS ...
Instead of -
IF WS-MARKS >= 60
AND WS-MARKS <= 100...
