Compaq COBOL
Reference Manual


Previous Contents Index

6.9 END PROGRAM Header

Function

The END PROGRAM header indicates the end of the named COBOL source program. Alternatively, the end of a named COBOL source program can be indicated by the end of the program's Procedure Division.


program-name

must contain 1 to 31 characters and follow the rules for user-defined words. It must be identical to a program-name declared in a preceding PROGRAM-ID paragraph.

Syntax Rules

  1. An inside PROGRAM-ID/END PROGRAM pair must be contained within the outside pair.
  2. The END PROGRAM header must be present in every program that either contains or is contained within another program.
  3. The END PROGRAM header indicates the end of a specific COBOL source program.
  4. The END PROGRAM header starts in Area A.
  5. The only COBOL statements that can follow an END PROGRAM header are as follows:
    The last END PROGRAM header must reference the outermost containing program.
  6. If a program includes an END PROGRAM header and if it is not contained in another program, the next COBOL statement, if any, must be the Identification Division header of another program to be compiled.

Additional Reference

Section 3.1.1 paragraph in Chapter 3

Examples

  1. This separately compiled program (PROG-NAME-A) (1) contains one program (PROG-NAME-B) (2).


                        IDENTIFICATION DIVISION. 
                        PROGRAM-ID. PROG-NAME-A.  (1)
                        PROCEDURE DIVISION. 
                                 ...
     
                        IDENTIFICATION DIVISION. 
                        PROGRAM-ID. PROG-NAME-B.  (2)
                        PROCEDURE DIVISION. 
                                 ...
     
                        END PROGRAM PROG-NAME-B. 
                        END PROGRAM PROG-NAME-A. 
    

  2. This separately compiled program (PROG-NAME-A) (4) contains eight other programs (5) through (12). Also, (6) is contained within (5), and (7) is contained within (6). (9), (10), and (11) are contained within (8). (5), (8), and (12) are directly contained within (4).


                        IDENTIFICATION DIVISION. 
                        PROGRAM-ID. PROG-NAME-A.  (4)
                                 ...
     
                        IDENTIFICATION DIVISION. 
                        PROGRAM-ID. PROG-NAME-B.  (5)
                                 ...
     
                        IDENTIFICATION DIVISION. 
                        PROGRAM-ID. PROG-NAME-C.  (6)
                                 ...
     
                        IDENTIFICATION DIVISION. 
                        PROGRAM-ID. PROG-NAME-D.  (7)
                                 ...
     
                        END PROGRAM PROG-NAME-D. 
                        END PROGRAM PROG-NAME-C. 
                        END PROGRAM PROG-NAME-B. 
     
                        IDENTIFICATION DIVISION. 
                        PROGRAM-ID. PROG-NAME-F.  (8)
                                 ...
     
                        IDENTIFICATION DIVISION. 
                        PROGRAM-ID. PROG-NAME-G.  (9)
                                 ...
     
                        END PROGRAM PROG-NAME-G. 
     
                        IDENTIFICATION DIVISION. 
                        PROGRAM-ID. PROG-NAME-H.  (10)
                                 ...
     
                        END PROGRAM PROG-NAME-H. 
     
                        IDENTIFICATION DIVISION. 
                        PROGRAM-ID. PROG-NAME-I.  (11)
                                 ...
     
                        END PROGRAM PROG-NAME-I. 
                        END PROGRAM PROG-NAME-F. 
     
                        IDENTIFICATION DIVISION. 
                        PROGRAM-ID. PROG-NAME-J.  (12)
                                 ...
     
                        END PROGRAM PROG-NAME-J. 
                        END PROGRAM PROG-NAME-A. 
    


Chapter 7
Intrinsic Functions

7.1 Introduction

Data processing problems frequently require the use of values not directly accessible in the data storage associated with a program. These data values must be derived through operations on other data. Instead of having to write code to specify many common operations step by step, the programmer can use intrinsic functions. An intrinsic function is treated as a temporary elementary data item that contains a temporary data value to be derived automatically at the time of reference during execution of the program.1

The uses of the intrinsic functions can be summarized briefly in the following listing by category:
CATEGORY FUNCTIONS
Scientific/Mathematical ACOS, ASIN, ATAN, COS, FACTORIAL, LOG, LOG10, MOD, REM, SIN, SQRT, SUM, TAN
   
Relational MAX, MIN, ORD-MAX, ORD-MIN
   
String Manipulation LOWER-CASE, NUMVAL, NUMVAL-C, REVERSE, UPPER-CASE
   
Date Manipulation CURRENT-DATE, DATE-OF-INTEGER,
DATE-TO-YYYYMMDD, DAY-TO-YYYYDDD,
DAY-OF-INTEGER, INTEGER-OF-DATE,
INTEGER-OF-DAY, TEST-DATE-YYYYMMDD,
TEST-DAY-YYYYDDD, WHEN-COMPILED,
YEAR-TO-YYYY
   
Statistical/Accounting ANNUITY, MEAN, MEDIAN, MIDRANGE, PRESENT-VALUE, RANGE,
STANDARD-DEVIATION, VARIANCE
   
Other ARGCOUNT (OpenVMS only), CHAR, INTEGER, INTEGER-PART,
LENGTH, ORD, RANDOM

Later in this chapter (in Function Descriptions) you will find a comprehensive table (Table 7-1) of functions, including their types, arguments, and values returned. Following the table are complete descriptions, including formats, of the individual functions in alphabetic order.

Note

1 With an intrinsic function, the data value that it returns does not persist after the call is complete, unless the data value is moved to a user-declared field.

Intrinsic Function

Description

A call to an intrinsic function is constructed as a function-identifier made up of the word FUNCTION and a name, as well as any applicable arguments and modifiers. The name is one of those shown in Table 7-1. An argument (see the description in the argument section) is selected according to application requirements.

A function-identifier is a syntactically correct combination of character strings and separators that uniquely references the data item resulting from the evaluation of a function. Although intrinsic functions are treated as elementary data items, they cannot be receiving operands.

A function-identifier that references an alphanumeric function can generally be specified wherever a sending identifier is permitted and wherever a reference to a function is not specifically prohibited by general-format rules. (For example, the rules for the CALL statement prohibit a function from being referenced in a CALL statement as an argument.) An integer or numeric function can be used anywhere an arithmetic expression (defined in Section 6.4) can be used.


function-name

is one of the names listed in the first column of Table 7-1. A function-name must be specified as part of a function-identifier. Most function-names are not reserved words,2 and can be used in a program outside the context of a function.

argument

is an identifier, a literal, or an arithmetic expression. It complies with the specific rules governing the number, class, and category of arguments for the function. If it is an identifier, it can be subscripted, qualified, or reference-modified, and it can be a function-identifier. Functions may have between 0 and 250 arguments as specified by the definition of each function. The arguments in an argument list may be separated by a comma.3 Arguments are evaluated individually, from left to right.

Most intrinsic functions require one or more arguments. The programmer must specify arguments of the proper type and number and within the legal constraints for the function; otherwise, the result of the statement may be undefined.

reference-modifier

can be specified only for alphanumeric functions. It specifies the beginning character position to be selected in the resulting data item and optionally the length of the resulting data item. (For more information on reference modification, see Section 6.2.3.)

Functions and Subscripting

An argument of an intrinsic function that permits a variable number of arguments can be a generically subscripted table or portion of a table. Generic, or ALL, subscripting (available only for intrinsic function arguments) is the use of the word ALL to specify all elements in one or more dimensions of a table. (A table element is a data item that contains or is subordinate to an OCCURS clause; if it is an OCCURS DEPENDING ON clause, the range of values is determined by the object of the clause.) Additional arguments, if any, of the function may or may not be table names. The evaluation of an ALL subscript must result in at least one argument; otherwise the result of executing the statement is undefined.

The order of the implicit specification of each occurrence of a table element is from left to right. This process is spelled out in detail in the following paragraph:

The first (or leftmost) specification is the identifier with each subscript specified by ALL replaced by one, and the next specification is the same identifier with the rightmost subscript specified by ALL incremented by one. This process continues with the rightmost ALL subscript being incremented by one for each implicit specification until the rightmost ALL subscript has been incremented through its range of values. If there are any additional ALL subscripts, the ALL subscript immediately to the left of the rightmost ALL is incremented by one, the rightmost ALL is reset to one, and the process of varying the rightmost ALL subscript is repeated. The ALL subscript to the left of the rightmost ALL subscript is incremented by one through its range of values. For each additional ALL subscript, this process is repeated in turn until the leftmost ALL subscript has been incremented by one through its range of values. If the ALL subscript is associated with an OCCURS DEPENDING ON clause, the range of values is determined by the object of that clause.

Also see the definition of subscript in the Glossary.

The reference modifier (if any) of an argument with an ALL subscript applies to each of the implicitly specified elements of the table. See Chapter 6, Procedure Division for the general format of ALL subscripting.

When one subscript of a multidimensional table is ALL, every other subscript must be one of the following:

Another ALL subscript
A positive integer literal
The data-name of a numeric integer elementary item (optionally followed by a plus or minus sign and an integer literal)
An index-name (optionally followed by a plus or minus sign and an integer literal)

The functions that permit generic subscripting of arguments are the following:

MAX
MEAN
MEDIAN
MIDRANGE
MIN
ORD-MAX
ORD-MIN
PRESENT-VALUE
RANGE
STANDARD-DEVIATION
SUM
VARIANCE

See MAX and SUM for examples of generically subscripted arguments.

Function Descriptions

There are three types of functions, based on the type of their resultant values, as follows:

Table 7-1 lists the intrinsic functions, along with their types, their arguments, and the values they return. Complete descriptions of the functions, arranged alphabetically, follow.

Table 7-1 Intrinsic Functions
Function Number and Type
of Arguments
Function
Type
Value
Returned
ACOS 1 numeric, num Numeric Arccosine of num
ANNUITY 1 numeric, num, and 1 integer, int Numeric Ratio of annuity paid for each of int periods at interest of num to initial investment of one monetary unit
ARGCOUNT (OpenVMS only) None Integer Number of arguments passed to the COBOL program
ASIN 1 numeric, num Numeric Arcsine of num
ATAN 1 numeric, num Numeric Arctangent of num
CHAR 1 integer, int Alphanumeric Character in position int of program collating sequence
COS 1 numeric, num Numeric Cosine of num
CURRENT-DATE None Alphanumeric Current date and time
DATE-OF-INTEGER 1 integer Integer Standard date equivalent (YYYYMMDD) of integer date 5
DATE-TO-YYYYMMDD 1 or 2 integer Integer YYYYMMDD date converted from YYMMDD date
DAY-OF-INTEGER 1 integer Integer YYYYDDD date equivalent of integer date 5
DAY-TO-YYYYDDD 1 or 2 integer Integer YYYYDDD date converted from YYDDD date
FACTORIAL 1 integer, int Integer Factorial of int
INTEGER 1 numeric, num Integer The greatest integer not greater than num
INTEGER-OF-DATE 1 integer Integer Integer date 5 equivalent of standard date (YYYYMMDD)
INTEGER-OF-DAY 1 integer Integer Integer date 5 equivalent of date in YYYYDDD format
INTEGER-PART 1 numeric, num Integer Integer part of num
LENGTH 1 alphabetic or numeric or alphanumeric data item, or 1 nonnumeric literal Integer Length of argument
LOG 1 numeric, num Numeric Natural logarithm of num
LOG10 1 numeric, num Numeric Logarithm to base 10 of num
LOWER-CASE 1 alphabetic or 1 alphanumeric Alphanumeric All letters in the argument set to lowercase
MAX 1 or more alphabetic and/or alphanumeric, or 1 or more integer and/or numeric Depends on arguments 6 Value of maximum argument
MEAN 1 or more numeric Numeric Arithmetic mean of arguments
MEDIAN 1 or more numeric Numeric Median of arguments
MIDRANGE 1 or more numeric Numeric Mean of minimum and maximum arguments
MIN 1 or more alphabetic and/or alphanumeric, or 1 or more integer and/or numeric Depends on arguments 6 Value of minimum argument
MOD 2 integer, int-1 and int-2 Integer Value of int-1 modulo int-2
NUMVAL 1 alphanumeric Numeric Numeric value of simple numeric string
NUMVAL-C 1 or 2 alphanumeric Numeric Numeric value of numeric string with optional commas and currency sign
ORD 1 alphabetic or 1 alphanumeric Integer Ordinal position of the argument in collating sequence
ORD-MAX 1 or more alphabetic,
or 1 or more numeric,
or 1 or more alphanumeric
Integer Ordinal position of maximum argument
ORD-MIN 1 or more alphabetic,
or 1 or more numeric,
or 1 or more alphanumeric
Integer Ordinal position of minimum argument
PRESENT-VALUE 1 numeric, num-1; and 1 or more additional numeric, num-2 Numeric Present value of a series of future period-end amounts, num-2, at a discount rate of num-1
RANDOM 1 integer or none Numeric Pseudo-random number
RANGE 1 or more integer, or
1 or more numeric
Integer or numeric depending on arguments Value of maximum argument minus value of minimum argument
REM 2 numeric, num-1 and num-2 Numeric Remainder of num-1/ num-2
REVERSE 1 alphabetic or 1 alphanumeric Alphanumeric Reverse order of the characters of the argument
SIN 1 numeric, num Numeric Sine of num
SQRT 1 numeric, num Numeric Square root of num
STANDARD-
DEVIATION
1 or more numeric Numeric Standard deviation of arguments
SUM 1 or more integer or 1 or more numeric Integer or numeric depending on arguments Sum of arguments
TAN 1 numeric, num Numeric Tangent of num
TEST-DATE-YYYYMMDD 1 integer Integer 0,1,2, or 3, indicating whether the date is a valid date in the Gregorian calendar, and reason if invalid
TEST-DAY-YYYYDDD 1 integer Integer 0, 1, or 2, indicating whether the Julian date is a valid date in the Gregorian calendar, and reason if invalid
UPPER-CASE 1 alphabetic or 1 alphanumeric Alphanumeric All letters in the argument set to uppercase
VARIANCE 1 or more numeric Numeric Variance of argument
WHEN-COMPILED None Alphanumeric Date and time program was compiled
YEAR-TO-YYYY 1 or 2 integer Integer 4-digit year, converted from 2-digit year


5An integer date is a positive integer representing the number of days after December 31, 1600, in the Gregorian calendar.
6A function that has only alphabetic and/or alphanumeric arguments is type alphanumeric. A function that has only integer arguments is type integer. A function that has both integer and numeric arguments is type numeric.

Note

2 The exceptions are the function-names LENGTH, RANDOM, and SUM, which are reserved words. Note that FUNCTION is also a reserved word.

3 Whereas in other contexts, the comma, semicolon, and space can be used interchangeably as separators, the comma has special relevance in the argument lists of intrinsic functions. It is sometimes necessary to use commas as separators between arguments to resolve ambiguity.


Previous Next Contents Index