COBOL Tutorial

Progress0 of 0 lessons

COBOL LOW-VALUES - Quick Reference

LOW-VALUES is a COBOL figurative constant that represents the character with the lowest value in the program's collating sequence. It is commonly used for initializing fields, performing comparisons, and establishing minimum values in data processing operations.

Overview

LOW-VALUES (and its singular form LOW-VALUE) represents the minimum character value in the collating sequence. In most systems, this corresponds to binary zeros (hexadecimal X'00'). This figurative constant is particularly useful for:

  • Initializing fields to a known minimum state
  • Detecting uninitialized or reset data
  • Ensuring items sort first in ascending order
  • Establishing baseline values for comparisons

Syntax

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
*> Using LOW-VALUES in VALUE clause 01 WS-FIELD PIC X(10) VALUE LOW-VALUES. *> Using LOW-VALUES in MOVE statement MOVE LOW-VALUES TO WS-FIELD *> Using LOW-VALUES in comparisons IF WS-FIELD = LOW-VALUES DISPLAY "Field is at minimum value" END-IF *> Using LOW-VALUES with INITIALIZE INITIALIZE WS-FIELD WITH FILLER VALUE LOW-VALUES

Basic Usage Examples

Initialization with VALUE Clause

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
IDENTIFICATION DIVISION. PROGRAM-ID. LOW-VALUES-INIT. DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-DATA-FIELDS. 05 WS-KEY-FIELD PIC X(10) VALUE LOW-VALUES. 05 WS-NAME-FIELD PIC X(30) VALUE LOW-VALUES. 05 WS-DESCRIPTION PIC X(50) VALUE LOW-VALUES. PROCEDURE DIVISION. MAIN-PARA. DISPLAY "Key field initialized to LOW-VALUES" DISPLAY "Name field initialized to LOW-VALUES" STOP RUN.

In this example, all three fields are initialized to LOW-VALUES using the VALUE clause. Each character position in these fields will contain the minimum value in the collating sequence.

Using MOVE with LOW-VALUES

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
IDENTIFICATION DIVISION. PROGRAM-ID. LOW-VALUES-MOVE. DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-BUFFER PIC X(100). 01 WS-RECORD-KEY PIC X(20). PROCEDURE DIVISION. MAIN-PARA. *> Initialize buffer to minimum values MOVE LOW-VALUES TO WS-BUFFER *> Reset key field to minimum MOVE LOW-VALUES TO WS-RECORD-KEY *> Check if key is at minimum value IF WS-RECORD-KEY = LOW-VALUES DISPLAY "Key field is at minimum value" END-IF STOP RUN.

The MOVE statement with LOW-VALUES sets each character position in the target field to the minimum collating sequence value. This is useful for resetting fields or initializing them at runtime.

Comparison Operations

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
IDENTIFICATION DIVISION. PROGRAM-ID. LOW-VALUES-COMPARE. DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-INPUT-FIELD PIC X(25). 01 WS-STATUS-FLAG PIC X. PROCEDURE DIVISION. MAIN-PARA. *> Check if field is uninitialized IF WS-INPUT-FIELD = LOW-VALUES DISPLAY "Field is uninitialized" MOVE "N" TO WS-STATUS-FLAG ELSE DISPLAY "Field contains data" MOVE "Y" TO WS-STATUS-FLAG END-IF *> Range check: ensure field is between LOW and HIGH IF WS-INPUT-FIELD > LOW-VALUES AND WS-INPUT-FIELD < HIGH-VALUES DISPLAY "Field is within valid range" END-IF STOP RUN.

LOW-VALUES is commonly used in comparisons to detect uninitialized fields or to perform range checks. Since it represents the minimum value, any field containing data will be greater than LOW-VALUES.

Practical Examples

Example 1: Initializing Record Structures

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
IDENTIFICATION DIVISION. PROGRAM-ID. INIT-RECORD-STRUCTURE. DATA DIVISION. WORKING-STORAGE SECTION. 01 CUSTOMER-RECORD. 05 CUST-ID PIC 9(5). 05 CUST-NAME PIC X(30). 05 CUST-ADDRESS PIC X(50). 05 CUST-PHONE PIC X(15). 05 CUST-STATUS PIC X. PROCEDURE DIVISION. MAIN-PARA. *> Initialize entire record to minimum values MOVE LOW-VALUES TO CUSTOMER-RECORD *> Now set specific fields MOVE 12345 TO CUST-ID MOVE "John Doe" TO CUST-NAME MOVE "A" TO CUST-STATUS *> Remaining fields (address, phone) remain at LOW-VALUES *> which can be used to detect unset fields STOP RUN.

This example shows how to initialize an entire record structure to LOW-VALUES, then populate specific fields. Fields that remain at LOW-VALUES can be detected later to identify which fields haven't been set.

Example 2: Sorting with LOW-VALUES

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
IDENTIFICATION DIVISION. PROGRAM-ID. SORT-WITH-LOW-VALUES. DATA DIVISION. WORKING-STORAGE SECTION. 01 SORT-KEY-FIELD PIC X(10). 01 RECORD-ARRAY. 05 RECORD-ITEM OCCURS 100 TIMES. 10 ITEM-KEY PIC X(10). 10 ITEM-DATA PIC X(40). PROCEDURE DIVISION. MAIN-PARA. *> Initialize sort key to ensure it sorts first MOVE LOW-VALUES TO SORT-KEY-FIELD *> Initialize all array elements PERFORM VARYING WS-INDEX FROM 1 BY 1 UNTIL WS-INDEX > 100 MOVE LOW-VALUES TO ITEM-KEY(WS-INDEX) MOVE SPACES TO ITEM-DATA(WS-INDEX) END-PERFORM *> When sorted, items with LOW-VALUES keys will appear first STOP RUN.

LOW-VALUES is useful in sorting operations because it represents the minimum value. Items initialized to LOW-VALUES will sort first in ascending order, making it useful for establishing default or placeholder records.

Example 3: Detecting Uninitialized Data

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
IDENTIFICATION DIVISION. PROGRAM-ID. DETECT-UNINIT. DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-FIELDS. 05 WS-USER-ID PIC X(8) VALUE LOW-VALUES. 05 WS-PASSWORD PIC X(20) VALUE LOW-VALUES. 05 WS-EMAIL PIC X(50) VALUE LOW-VALUES. PROCEDURE DIVISION. MAIN-PARA. *> Check if user data has been entered IF WS-USER-ID = LOW-VALUES DISPLAY "Error: User ID not entered" STOP RUN END-IF IF WS-PASSWORD = LOW-VALUES DISPLAY "Error: Password not entered" STOP RUN END-IF IF WS-EMAIL = LOW-VALUES DISPLAY "Warning: Email not provided" END-IF *> Process valid data DISPLAY "Processing user: " WS-USER-ID STOP RUN.

By initializing fields to LOW-VALUES, you can easily detect whether they have been set to actual values. This is a common pattern for input validation and data integrity checking.

Comparison with Other Figurative Constants

Figurative Constants Comparison
ConstantValueCommon Use Case
LOW-VALUESMinimum collating sequence value (typically X'00')Initialization, sorting, detecting uninitialized data
HIGH-VALUESMaximum collating sequence value (typically X'FF')Maximum initialization, sorting (appears last), range boundaries
SPACESSpace character (X'20' in ASCII, X'40' in EBCDIC)Blank text fields, padding, display formatting
ZEROSNumeric zero (0)Numeric initialization, zero-based calculations, counters

Important Considerations

Character Set Dependencies

The actual value represented by LOW-VALUES depends on the character set and collating sequence:

  • ASCII: Typically X'00' (binary zeros)
  • EBCDIC: Typically X'00' (binary zeros)
  • Custom Collating: Depends on COLLATING SEQUENCE specification

Portability

While LOW-VALUES typically represents binary zeros across most systems, be cautious when:

  • Moving code between different character sets
  • Using custom collating sequences
  • Working with international character sets

Data Type Considerations

LOW-VALUES works with alphanumeric fields (PIC X). For numeric fields:

  • Use ZEROS for numeric zero values
  • LOW-VALUES sets character positions, not numeric values
  • LOW-VALUES in a numeric field may not represent zero

Common Patterns

Pattern 1: Field Reset

cobol
1
2
*> Reset a field to minimum value MOVE LOW-VALUES TO WS-FIELD

Pattern 2: Uninitialized Check

cobol
1
2
3
4
*> Check if field has been initialized IF WS-FIELD = LOW-VALUES *> Field is uninitialized END-IF

Pattern 3: Range Validation

cobol
1
2
3
4
*> Ensure field is within valid range IF WS-FIELD > LOW-VALUES AND WS-FIELD < HIGH-VALUES *> Field contains valid data END-IF

Pattern 4: Sort Preparation

cobol
1
2
3
*> Initialize sort key to ensure first position MOVE LOW-VALUES TO SORT-KEY *> Items with LOW-VALUES will sort first

Summary

LOW-VALUES is a versatile figurative constant that represents the minimum value in the collating sequence. It's essential for:

  • Initializing fields to a known minimum state
  • Detecting uninitialized or reset data
  • Ensuring proper sorting behavior
  • Performing range validations

Remember that LOW-VALUES represents character values, not numeric zeros. Use ZEROS for numeric zero values and SPACES for blank text fields. Always consider your character set and collating sequence when using LOW-VALUES to ensure portability.

Test Your Knowledge

1. What does LOW-VALUES represent in COBOL?

  • The numeric value zero
  • The character with the lowest value in the collating sequence
  • A space character
  • The highest value in the collating sequence

2. How would you initialize a 20-character field to LOW-VALUES?

  • MOVE 0 TO WS-FIELD
  • MOVE LOW-VALUES TO WS-FIELD
  • MOVE SPACES TO WS-FIELD
  • MOVE ZEROS TO WS-FIELD

3. What is the typical hexadecimal value of LOW-VALUES?

  • X'20' (space)
  • X'00' (binary zeros)
  • X'FF' (all ones)
  • X'30' (zero character)

4. When would you use LOW-VALUES instead of SPACES?

  • When you want blank text fields
  • When you need the absolute minimum value for sorting or comparisons
  • When initializing numeric fields
  • When you want to clear a field

5. Can LOW-VALUES be used in the VALUE clause?

  • No, only in MOVE statements
  • Yes, in both VALUE clause and MOVE statements
  • Only with numeric fields
  • Only with alphanumeric fields

6. What happens when you compare a field to LOW-VALUES?

  • It checks if the field equals zero
  • It checks if the field contains the minimum collating sequence value
  • It checks if the field is blank
  • It causes a compilation error

Related Pages