Condition names


A condition name is a way to give a meaningful name to a specific value or a range of values of a variable. This feature makes the code more readable by allowing programmers to use descriptive names in place of conditional expressions rather than always comparing them against specific values.

Condition name declared with 88 level number and can be used with IF and EVALUATE.

Syntax -

88 condition-name    VALUE value1 [THRU value2].
Note! All statements coded in [ ] are optional.

Where:

  • condition-name is the descriptive name of the condition.

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 name can code in either in 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.
  • Condition names can be coded with group or elementary levels.

How can the condition variables be initialized?


We can initialize the condition variables 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 -

We can initialize condition variables using SET statements 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 - The below code executes statement-set1 when the WS-GENDER value is 'M'. Otherwise, run 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. Syntax -

 88 Condition-Name VALUE single-value.

For example - MALE & FEMALE condition names have 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


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 the 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


Condition name is declared with a range of values to validate. i.e., In a single condition, it can validate with range of values started 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 -

Condition names Output

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.