The MAX function returns the content of the argument that contains the maximum value.
The type of this function depends upon the argument types as follows:
Argument type | Function type |
alphabetic | alphanumeric |
Format
FUNCTION
MAX
({argument-1}...)
Arguments
If more than one argument is specified, all arguments must be of the same class.
The individual arguments must not be specified in the ANY LENGTH clause.
Returned values
The returned value is the content of the argument having the greatest value. The comparisons used to determine the greatest value are made according to the rules for simple conditions.
If more than one argument has the same greatest value, the content of the argument returned is the leftmost argument having that value.
If the type of the function is alphanumeric or national, the size of the returned value is the same as the size of the selected argument.
The error default value is 0.
See also: MIN, ORD-MAX, ORD-MIN, RANGE, MEAN, MEDIAN, MIDRANGE, SUM
Example 9-24
... DATA DIVISION. WORKING-STORAGE SECTION. 01 RES PIC 9(3). 01 RES1 PIC X(4). PROCEDURE DIVISION. P1 SECTION. MAIN. COMPUTE RES = FUNCTION MAX (12 32 5 8 17 9). MOVE FUNCTION MAX ("HUGO" "EGON" "THEO" "OTTO") TO RES1. DISPLAY "Argument with greatest value: " RES UPON T. DISPLAY "Argument with greatest value: " RES1 UPON T. STOP RUN.
Result: Argument with greatest value RES: 032
Argument with greatest value RES1: THEO