Summary -
In this topic, we described about the below sections -
In some scenarios, data item required to compare with a value by using a relational operator to control the program flow. Using more than one relational operator makes the condition complex. The complex relational condition or wrong usage of relational operators doesn't produce the accurate results.
So, COBOL supports condition names concept to avoid the above issue.
Condition name is a name with a value or set of values used only for comparison. Condition name declared with 88 level number.
Syntax -

Condition name associates with a conditional variable.
For example -
01 WS-GENDER PIC X(01). 88 WS-MALE VALUE "M". 88 WS-FEMALE VALUE "F".
If the conditional variable requires subscripts or indexes, the associated condition-name must be subscripted or indexed.
For example -
01 WS-GENDER PIC X(01) OCCURS 10 TIMES. 88 WS-MALE VALUE "M". 88 WS-FEMALE VALUE "F". . . . IF WS-MALE (5) ... END-IF.
Condition name doesn't occupy any storage. Condition name can code in either in Area-A or Area-B.
For example -
----+----1----+----2----+----3----+----4----+----5----+----6----+----7-- 01 WS-GENDER PIC X(01). 88 WS-MALE VALUE "M". 88 WS-FEMALE VALUE "F". 01 WS-GENDER PIC X(01). 88 WS-MALE VALUE "M". 88 WS-FEMALE VALUE "F".
Rules -
- No PICTURE clause is associated with 88 level number.
For example - 88 WS-MALE VALUE "M". - 88 level number always associated with level number 01-49.
For example -01 WS-GENDER PIC X(01). 88 WS-MALE VALUE "M". 88 WS-FEMALE VALUE "F".
- Used with conditional keywords like IF and EVALUATE to validate.
For example -IF WS-MALE ... END-IF.
- The VALUE clause is required in a condition-name entry.
For example - 88 WS-MALE VALUE "M". - The keywords THROUGH and THRU are equivalent.
For example -01 WS-AGE-LIMIT PIC X(01). 88 WS-MINOR VALUE 1 THROUGH 18. 88 WS-MAJOR VALUE 18 THROUGH 100.
- Condition-names can be specified both at the group level and at subordinate levels.
For example -01 WS-AGE-LIMIT PIC X(01). 88 WS-MINOR VALUE 1 THROUGH 18. 88 WS-MAJOR VALUE 18 THROUGH 100.
- A space, a separator comma, or a separator semicolon must separate successive operands.
For example -01 WS-ALPHABETS PIC X(01). 88 WS-VOWELS VALUE "A" "E" "I" "O" "U". 88 WS-CONSONANTS VALUE "B" THRU "D" "F" THRU "H" "J" THRU "N" "P" THRU "T" "V" THRU "Z".
Different Formats -
Condition name has advantage of using in three different formats which are very useful in validating the data.
Format1 - Single value
Syntax -
88 Condition-Name VALUE literal/Figurative-Constants.
In this format, Condition name have only one value assigned to validate.
For example - MALE & FEMALE condition variables represent the single value constants.
01 WS-GENDER PIC X(01). 88 MALE VALUE 'M'. 88 FEMALE VALUE 'F'.
Format2 - Multiple values
Syntax -
88 Condition-Name VALUE literal-1 literal-2...literal-n.
In this format, Condition names have more than one value assigned to validate. i.e. In a single condition, it can be used to validate more than one value.
For example - VALID-GENDER conditional variables represent the multiple value constants.
01 WS-GENDER PIC X(01). 88 VALID-GENDER VALUE 'M' 'F'. 88 MALE VALUE 'M'. 88 FEMALE VALUE 'F'.
Format3 - Set of values
Syntax -
88 Condition-Name VALUE literal-1 THROUGH/THRU literal-n.
In this format, Condition names have set of values assigned to validate. i.e. In a single condition, it can validate a set of values range started from one value to another in a sequence.
For example - FIRST-CLASS, SECOND-CALSS, THIRD-CLASS & FAIL conditional variables represents THRU/THROUGH value constants.
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.
How the condition name can be initialized?
Condition name can be initialized in two ways -
- Static initialization.
- Dynamic initialization.
Static initialization -
By directly specifying the VALUE clause during the declaration.For example - Below declaration creates to condition names MALE and FEMALE.
01 WS-GENDER PIC X(01). 88 MALE VALUE 'M'. 88 FEMALE VALUE 'F'.
Dynamic initialization -
Using SET statement.Syntax -
SET condition-name TO TRUE.
For example - Below declaration sets the WS-GENDER value to 'M'.
SET MALE TO TRUE.
How initializing condition name effects conditional variable value?
The static initialization of condition name has no effect on conditional variable value. It is just a condition name declaration with its value(s).
For example - Below declaration doesn't change the value of WS-GENDER and the value is some junk value.
01 WS-GENDER PIC X(01). 88 MALE VALUE 'M'. 88 FEMALE VALUE 'F'.
The dynamic initialization of condition name changes the value of the conditional variable. So, it is always good to double check before using SET statement for initializing condition name.
For example - Below statement sets the WS-GENDER value to 'M'.
SET MALE TO TRUE.
How to validate condition name?
Condition name used with conditional keywords like IF and EVALUATE to validate. Conditional keywords with condition name results a boolean value TRUE or FALSE. Based on the TRUE or FALSE, the program flow gets decided.
For example - Below code executes statement-1 when the WS-GENDER value is 'M'. Otherwise, executes statement-2.
IF MALE statement-1 ELSE statement-2 END-IF.
Practical Example -
Scenario - Below example describes how the condition names used in COBOL programming.
Code -

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
***************************** Top of Data ******************************
IDENTIFICATION DIVISION.
PROGRAM-ID. LEVEL88.
AUTHOR. MTH.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-ALPHABET PIC X(01).
88 ALPHABET-A VALUE "A".
88 ALPHABET-S VALUE "S".
88 VALID-ALPHABET VALUE "A" THROUGH "Z".
88 VOWELS VALUE "A" "E" "I" "O" "U".
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.
**************************** Bottom of Data ****************************
Output -

Explaining Example -
In the above example, WS-ALPHABET declared as a single byte alphanumeric variable. It has 5 condition variables.
ALPHABET-A, ALPHABET-S are single value condition variables. VOWELS is multiple value condition variable. VALID-ALPHABET, CONSONANTS is a condition variable with set of values.