88 Level Number


In some scenarios, the variable might need to be compared with multiple values to control the program flow. Comparison occurs using multiple relational operators makes the conditions more complex. These complex conditions might not produce accurate results if we are not using relational operators according to their priority.

88 level number or Condition name concept introduced to avoid the above issue in COBOL.

What is 88 Level number?


The 88-level number defines a condition name for a specific value or a set of values under the variable. The 88-level number can't declare a variable, but it is used to provide a descriptive name for a condition. The name associated with 88 level numbers is called as Condition Name, and the variable with 88 level names attached to it is called as Conditional Variable.

For Example -

 01 WS-GENDER          PIC X(01) OCCURS 10 TIMES.
    88 WS-MALE           VALUE "M".
    88 WS-FEMALE         VALUE "F".

In the above example, WS-GENDER is the conditional variable, and WS-MALE and WS-FEMALE are the condition names.

Notes -

  • Condition name is always associated with a variable.
  • The condition name should be subscripted or indexed if the conditional variable uses subscripts or indexes.
  • The condition name doesn't occupy any storage.
  • Condition names can be coded in either Area-A or Area-B.

Rules -

  • No PICTURE clause is associated with 88-level numbers.
  • 88 level number is always associated with level number 01-49.
  • The VALUE clause is mandatory for the condition name.
  • The keywords THROUGH and THRU are equivalent.
  • Condition names can be coded both at the group and elementary levels.

How can the condition variables be initialized?


Condition variables are initialized in two ways -

  • During the declaration.
  • Using SET statement.

During the declaration -

Condition variables are initialized by coding the VALUE clause during the declaration. For example - The below declaration initializes the WS-GENDER with 'M', which sets the MALE condition name to true.

 01 WS-GENDER       PIC X(01) VALUE 'M'.
   88 MALE         VALUE 'M'.
   88 FEMALE       VALUE 'F'.

Using SET statement -

The condition variables are initialized using the SET statement during the program execution. For example - The below declaration sets the WS-GENDER value to 'M'.

SET MALE    TO TRUE.
Note! SET statement sets the condition name and indirectly assigns the value to the conditional variable. So, it is always good to double-check before using the SET statement.

How do we validate the condition name?


IF and EVALUATE statements use condition names to validate conditions using condition names that produce TRUE or FALSE. Based on the result, the program flow gets decided.

For example - If the WS-GENDER value is 'M', it executes statement-set1 —otherwise, statement-set2.

01 WS-GENDER       PIC X(01).
   88 MALE         VALUE 'M'.
   88 FEMALE       VALUE 'F'.
...
IF MALE
	statement-set1
ELSE
	statement-set2
END-IF.

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 in this format. Syntax -

 88 Condition-Name VALUE single-value.

For example - MALE & FEMALE condition names having a single value.

 01 WS-GENDER       PIC X(01).
   88 MALE         VALUE 'M'.
   88 FEMALE       VALUE 'F'.

With the above definition, we can write -

 IF MALE ...

Instead of -

 IF WS-GENDER EQUAL 'M' ...

Format2 - Multiple values


In this format, 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 VALID-GENDER    VALUE 'M' 'F'.
   88 MALE            VALUE 'M'.
   88 FEMALE          VALUE 'F'.

With the above definition, we can write -

 IF VALID-GENDER ...

Instead of -

 IF WS-GENDER EQUAL 'M' 
 OR WS-GENDER EQUAL 'Y' ...

Format3 - Range of values


In this format, the condition name is declared with a range of values to validate. i.e., In a single condition, it can validate with a range of values starting from one value to another in a sequence. 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 FIRST-CLASS     VALUE 60 THROUGH 100.
   88 SECOND-CLASS    VALUE 50 THROUGH 59.
   88 THIRD-CLASS     VALUE 35 THROUGH 49.
   88 FAIL            VALUE 00 THROUGH 34.

With the above definition, we can write -

 IF FIRST-CLASS ...

Instead of -

 IF  WS-MARKS <= 100
 AND WS-MARKS >= 60 ...

Practical Example -


Scenario - Condition names declaration (all formats) using 88 level number and their usage for validation in PROCEDURE DIVISION.

Code -

----+----1----+----2----+----3----+----4----+----5----+
       IDENTIFICATION DIVISION. 
       PROGRAM-ID. LEVEL88. 
       AUTHOR. MTH. 

       DATA DIVISION.  
       WORKING-STORAGE SECTION.

       01 WS-ALPHABET       PIC X(01).
	  * Condition names with single values
          88 ALPHABET-A     VALUE "A". 
          88 ALPHABET-S     VALUE "S".
      * Condition names with multiple values
          88 VALID-ALPHABET VALUE "A" THROUGH "Z". 
          88 VOWELS         VALUE "A" "E" "I" "O" "U".
      * Condition names with range of values		  
          88 CONSONANTS     VALUE "B" THRU "D" 
                                  "F" THRU "H"
                                  "J" THRU "N"
                                  "P" THRU "T"
                                  "V" THRU "Z". 

       PROCEDURE DIVISION. 

           SET ALPHABET-A    TO TRUE.
           IF  VOWELS
               DISPLAY "ALPHABET IS VOWEL"
           END-IF.

           SET ALPHABET-S    TO TRUE. 
           IF  CONSONANTS
               DISPLAY  "ALPHABET IS CONSONENTS" 
           END-IF. 

           STOP RUN.

Output -

ALPHABET IS VOWEL
ALPHABET IS CONSONENTS

Explaining Example -

In the above example:

  • WS-ALPHABET is declared as a single-byte alphanumeric variable. It has five condition names.
  • ALPHABET-A and ALPHABET-S are single-value condition names. VOWELS is a multiple-value condition name. VALID-ALPHABET CONSONANTS is a condition name with a set of values.