HP 3000 Manuals HP 3000 Manuals
Structured Programming
Structured programming makes your program easier to design, code, read,
and maintain. It is loosely defined as programming that stresses clear
top-down design:
* A complex problem is broken into functionally cohesive modules
that perform simple tasks.
* The structure and control flow of each module reflect the
programmer's approach to the problem.
* Control flows from top to bottom (it is not transferred from one
module to the middle of another module).
The COBOL'85 features that support and encourage structured programming
are listed below, by division. These are ANSI85 features. COBOL74 does
not have them. If you use them in your program, you must invoke the HP
COBOL II/XL compiler through its ANSI85 entry point.
Division ANSI85 Structured Programming Feature
Not part of a division END PROGRAM header
IDENTIFICATION DIVISION COMMON clause
DATA DIVISION GLOBAL data items and files
PROCEDURE DIVISION CONTINUE statement
EVALUATE statement
Explicit scope terminators
NOT phrases
PERFORM statement enhancements
USE GLOBAL AFTER ERROR PROCEDURE ON
statement
This section explains the following:
* ANSI85 structured programming features, by division.
* When to use nested programs and GLOBAL data.
NOTE The SPECIAL-NAMES paragraph (in the ENVIRONMENT DIVISION) cannot
appear in nested programs. All items in the SPECIAL-NAMES
paragraph are implicitly GLOBAL.
END PROGRAM Header
The END PROGRAM header ends a COBOL source program explicitly, whereas
the absence of additional source lines ends a program implicitly. When a
single source file contains more than one COBOL program, all but the last
unnested program must end explicitly, with an END PROGRAM header.
When COBOL programs are nested, their hierarchy is described by the
sequence of PROGRAM-ID paragraph/END PROGRAM header pairs. A PROGRAM-ID
paragraph and END PROGRAM header are a pair if they specify the same
program name.
Separately compiled programs within a run unit must have unique names.
Within a single separately compiled program, nested programs must have
unique names. (Nested programs are not considered to be separately
compiled.)
NOTE The HP extension ID DIVISION is not supported for applications that
use nested or concatenated programs. Use IDENTIFICATION DIVISION
instead.
Example.
IDENTIFICATION DIVISION.
PROGRAM-ID. A.
PROCEDURE DIVISION.
BEGIN-A.
DISPLAY "A IS THE OUTERMOST PROGRAM".
CALL "B".
CALL "D".
CALL "E".
IDENTIFICATION DIVISION.
PROGRAM-ID. B.
PROCEDURE DIVISION.
BEGIN-B.
DISPLAY "B IS NESTED WITHIN A".
CALL "C".
IDENTIFICATION DIVISION.
PROGRAM-ID. C.
PROCEDURE DIVISION.
BEGIN-C.
DISPLAY "C IS NESTED WITHIN B".
END PROGRAM C.
END PROGRAM B.
IDENTIFICATION DIVISION.
PROGRAM-ID. D.
PROCEDURE DIVISION.
BEGIN-D.
DISPLAY "D IS NESTED WITHIN A".
END PROGRAM D.
END PROGRAM A.
IDENTIFICATION DIVISION.
PROGRAM-ID. E.
PROCEDURE DIVISION.
BEGIN-E.
DISPLAY "E IS A CONCATENATED PROGRAM".
In the preceding example, the PROGRAM-ID paragraph/END PROGRAM header
pairs describe this nesting hierarchy:
* Program A is the parent of programs B and D. (B and D are
siblings).
* Program A is the grandparent of program C. (C is a child of
program B.)
* Program E is a concatenated program. That is, it is in the same
source file as A, B, C, and D, but is not nested within any of
them. It is considered to be a separately compiled program. (It
does not need an END PROGRAM header, because it is the last
unnested program in the source file.)
The relationship between these programs is shown graphically below:
![[]](../../pic3k/M011950/FFN23c50.gif)
By default, a program can only call its children and separately compiled
programs. It cannot call its siblings, its grandchildren, or their
descendants. (In the preceding example, program A can call B, D, and E,
but not C.) The COMMON clause allows exceptions to this rule.
IDENTIFICATION DIVISION: COMMON Clause
The COMMON clause allows a nested program to be called by its siblings
and their descendants, as well as its parent. (By default, it can only
be called by its parent.) The COMMON clause does not allow recursion;
that is, the common program cannot be called by its descendants or
itself.
See "Call Rules" in Chapter 4 for an example of the COMMON clause.
DATA DIVISION: GLOBAL Data Items and Files
GLOBAL data items and files can be accessed from any program nested
within the program that declares it (that is, all of its descendants).
The GLOBAL clause can appear only on 01 level data items, or on an FD
level indicator. Items subordinate to a GLOBAL data item or file are
also GLOBAL. GLOBAL items cannot be declared in the LINKAGE SECTION.
Example.
01 GLOBAL-DATA IS GLOBAL.
05 ITEM1 PICTURE XX.
05 ITEM2 PICTURE 99.
When one program contains another program, the two programs can use the
same data item names (in different DATA DIVISIONs). Unless all of these
items are EXTERNAL, they refer to distinct data items. When the compiler
encounters such a name in the PROCEDURE DIVISION, it assumes that it
applies to the first data item it finds that meets the qualifications.
For example, in the following program, a GLOBAL data item, ITEM-A, is
declared and displayed in the program OUTER. The program OUTER directly
contains the program NESTED-1. When NESTED-1 displays ITEM-A, it is
referencing the ITEM-A declared in OUTER.
However, NESTED-2, a program directly contained by NESTED-1, declares
another ITEM-A. When NESTED-2 displays ITEM-A, it is referencing the most
local ITEM-A (the one it has declared itself). (If NESTED-2 contained
nested programs, it might be desirable for it to declare its own ITEM-A
to be GLOBAL, so that it would be available to its nested programs.)
The compiler first tries to resolve the reference to a data item in the
current program. If it does not find it, it searches for GLOBAL items in
the enclosing program(s).
Example.
IDENTIFICATION DIVISION.
PROGRAM-ID. OUTER.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ITEM-A IS GLOBAL PICTURE X(20) VALUE "Global item in OUTER".
PROCEDURE DIVISION.
BEGIN.
DISPLAY ITEM-A.
CALL "NESTED-1".
IDENTIFICATION DIVISION.
PROGRAM-ID. NESTED-1.
PROCEDURE DIVISION.
BEGIN.
DISPLAY ITEM-A.
CALL "NESTED-2".
IDENTIFICATION DIVISION.
PROGRAM-ID. NESTED-2.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ITEM-A PICTURE X(23) VALUE "Local item in NESTED-2".
PROCEDURE DIVISION.
BEGIN.
DISPLAY ITEM-A.
END PROGRAM NESTED-2.
END PROGRAM NESTED-1.
END PROGRAM OUTER.
The above program displays the following:
Global item in OUTER.
Global item in OUTER.
Local item in NESTED-2
A data item or file can be declared both GLOBAL and EXTERNAL, in which
case it is accessible to all the nested programs with a single
declaration and to all the separately compiled programs that declare it
EXTERNAL.
PROCEDURE DIVISION
The PROCEDURE DIVISION has the following ANSI85 structured programming
features:
* CONTINUE statement.
* EVALUATE statement.
* Explicit scope terminators.
* NOT phrases.
* PERFORM statement enhancements.
* USE GLOBAL AFTER ERROR PROCEDURE ON statement.
CONTINUE Statement.
The CONTINUE statement is a nonexecutable substitute for a conditional or
imperative statement or for the keyword EXIT in an EXIT paragraph.
Example.
IF A < B THEN
IF A < C THEN
CONTINUE
ELSE
MOVE ZERO TO A
END-IF
ADD B TO C.
SUBTRACT C FROM D.
The CONTINUE statement allows control to go to the ADD statement if A is
less than C.
EVALUATE Statement.
The EVALUATE statement is a multicondition, multibranch statement. It
evaluates sets of conditions. The first time all the conditions in a set
are true, it executes the associated group of statements. (Each
condition arises from the comparison of a subject with an object. Refer
to the HP COBOL II/XL Reference Manual for details.)
Example 1.
EVALUATE HOURS-WORKED ALSO EXEMPT
WHEN 0 ALSO ANY PERFORM NO-PAY
WHEN 1 THRU 40 ALSO ANY PERFORM REG-PAY
WHEN 41 THRU 80 ALSO "N" PERFORM OVERTIME-PAY
WHEN 41 THRU 80 ALSO "Y" PERFORM REG-PAY
WHEN OTHER PERFORM PAY-ERROR
END EVALUATE
The sets of conditions in the above EVALUATE statement are:
1. HOURS-WORKED is 0 and EXEMPT is any value.
2. HOURS-WORKED is a number from 1 through 40 and EXEMPT is any
value.
3. HOURS-WORKED is a number from 41 through 80 and EXEMPT contains
"N".
4. HOURS-WORKED is a number from 41 through 80 and EXEMPT contains
"Y".
If condition 1 is true, NO-PAY is performed. If condition 1 is false and
condition 2 is true, REG-PAY is performed. If conditions 1 and 2 are
false and condition 3 is true, OVERTIME-PAY is performed. If conditions
1, 2, and 3 are false and condition 4 is true, REG-PAY is performed. If
conditions 1, 2, 3, and 4 are false, PAY-ERROR is performed.
You can always write an EVALUATE statement that is equivalent to a nested
IF statement, but you cannot always write a nested IF statement that is
equivalent to an EVALUATE statement. This is because there is a limit to
the depth that IFs can be nested, but an EVALUATE statement can specify
any number of conditions.
Example 2.
The following example is equivalent to the example above[REV BEG] if
there is a period after END-EVALUATE. See Example 3 below.[REV END] It
uses IF-THEN-ELSE statements instead of an EVALUATE statement.
IF HOURS-WORKED = 0
PERFORM NO-PAY
ELSE IF HOURS-WORKED >= 1 AND <= 40
PERFORM REG-PAY
ELSE IF EXEMPT ='N'
IF HOURS-WORKED >= 41 AND <= 80
PERFORM OVERTIME-PAY
ELSE PERFORM PAY-ERROR
ELSE IF EXEMPT = 'Y'
IF HOURS-WORKED >= 41 AND <= 80
PERFORM REG-PAY
ELSE PERFORM PAY-ERROR
ELSE PERFORM PAY-ERROR.
[REV BEG]
Example 3.
The following example is also equivalent to the example above, but it
uses the structured form of the IF-THEN-ELSE statement with the END-IF
scope terminator:
IF HOURS-WORKED = 0
PERFORM NO-PAY
ELSE
IF HOURS-WORKED >= 1 AND <= 40
PERFORM REG-PAY
ELSE
IF EXEMPT ='N'
IF HOURS-WORKED >= 41 AND <= 80
PERFORM OVERTIME-PAY
ELSE
PERFORM PAY-ERROR
END-IF
ELSE
IF EXEMPT = 'Y'
IF HOURS-WORKED >= 41 AND <= 80
PERFORM REG-PAY
ELSE
PERFORM PAY-ERROR
END-IF
ELSE
PERFORM PAY-ERROR
END-IF
END-IF
END-IF
END-IF
[REV END]
HP COBOL II/XL evaluates the clauses in an EVALUATE statement in order.
For fastest execution, order the clauses from most frequent value to
least frequent value.
Explicit Scope Terminators.
An explicit scope terminator is a keyword, END-verb, that terminates the
scope of the last instance of the keyword verb. The explicit scope
terminators are listed in the following table:
Table 3-1. The Scope Terminators
END-ACCEPT
END-ADD
END-CALL
END-COMPUTE
END-DELETE
END-DIVIDE
END-EVALUATE
END-IF
END-MULTIPLY
END-PERFORM
END-READ
END-RETURN
END-REWRITE
END-SEARCH
END-START
END-STRING
END-SUBTRACT
END-UNSTRING
END-WRITE
Explicit scope terminators help to eliminate logic errors caused by
misplaced periods. With explicit scope terminators, periods are required
only to terminate paragraphs in the PROCEDURE DIVISION.
Example 1.
The following example shows the END-IF scope terminator. The first
END-IF terminates the scope of IF PROCESS-2-OK. The second END-IF
terminates the scope of IF PROCESS-1-OK.
IF PROCESS-1-OK THEN
IF PROCESS-2-OK THEN
MOVE 2 TO PROCESS-DATA-FLAG
ELSE
MOVE 1 TO PROCESS-DATA-FLAG
END-IF
PERFORM PROCESS-DATA
ELSE
PERFORM PROCESS-1-ERROR-CHECK
END-IF
A conditional statement used with an explicit scope terminator is called
a delimited scope statement. Unlike an ordinary conditional statement, a
delimited scope statement is legal wherever an imperative statement is
legal.
Example 2.
READ FILE-IN AT END
ADD A TO B ON SIZE ERROR
PERFORM OVERFLOW-ROUTINE
END-ADD
MOVE SPACES TO REC-IN.
The ADD statement with the ON SIZE ERROR phrase would be a conditional
statement if not for the END-ADD, which terminates its scope and makes it
a delimited scope statement. The ADD statement and the imperative
statement MOVE make up the statement group following the conditional
phrase AT END. Ordinary conditional statements are illegal in the
statement group following a conditional phrase.
NOT Phrases.
A NOT phrase specifies a set of statements to be executed if an exception
condition does not occur. The NOT phrases are listed below:
NOT AT END
NOT AT END-OF-PAGE
NOT INVALID KEY
NOT ON EXCEPTION
NOT ON INPUT ERROR
NOT ON OVERFLOW
NOT ON SIZE ERROR
Using NOT phrases can make code more readable and sometimes more
efficient.
Example.
The following are functionally equivalent:
READ IN-FILE READ IN-FILE
AT END MOVE 'YES' TO EOF. AT END MOVE 'YES' TO EOF
IF EOF <> 'YES' THEN NOT AT END ADD 1 TO IN-CNT.
ADD 1 TO IN-CNT.
The statements on the left perform two tests for every record read. The
statement on the right performs one test for every record read. In this
case, the NOT phrase makes the code more efficient as well as more
readable.
NOT phrases used with I-O verbs execute only after a successful condition
occurs. In the preceding example on the right, "ADD 1 TO IN-CNT" is not
executed if a logic error exists.
PERFORM Statement Enhancements.
The enhanced PERFORM statement can contain a list of statements rather
than only procedure names if it ends with an END-PERFORM. This form of
the PERFORM statement is called an in-line PERFORM statement.
Example 1.
The following is an in-line PERFORM statement:
PERFORM 10 TIMES
ADD A TO B
ADD 1 TO A
END-PERFORM
Example 2.
The in-line PERFORM statement can significantly reduce code
fragmentation. It eliminates the need for short paragraphs whose only
functions are to perform other paragraphs. The following two code
fragments are equivalent:
PERFORM A100-CALC-A A-CNT TIMES. PERFORM A-CNT TIMES
: ADD C TO A (SUBA)
A100-CALC-A. ADD 1 TO SUBA
ADD C TO A (SUBA). END-PERFORM.
ADD 1 TO SUBA.
:
The PERFORM on the left executes a separate paragraph in a different
location in the program. The inline PERFORM on the right is functionally
equivalent. By embedding the statements within the PERFORM, the program
is much easier to read.
The enhanced PERFORM statement can also specify whether the UNTIL
condition is to be tested before or after the statements or paragraphs
have been executed.
Example 3.
The following PERFORM statement tests EOF-FLAG and then performs
READ-LOOP if EOF-FLAG is false:
PERFORM READ-LOOP
WITH TEST BEFORE BEFORE is the default.
UNTIL EOF-FLAG
The following PERFORM statement performs READ-LOOP and then tests
EOF-FLAG. If EOF-FLAG is false, it performs READ-LOOP again:
PERFORM READ-LOOP
WITH TEST AFTER
UNTIL EOF-FLAG
Example 4.
In-line PERFORM statements can be nested. Nested in-line PERFORM
statements can make your program more readable and less fragmented.
The following shows an example without nested in-line PERFORM statements:
PERFORM PROC-NAME-1
[REV BEG]
VARYING DEPARTMENT FROM FIRST-DEPT BY 1 UNTIL LAST-DEPARTMENT
AFTER HOURS-PER-EMPLOYEE FROM FIRST-EMP BY 1 UNTIL LAST-EMPLOYEE.
[REV END]
STOP RUN.
:
PROC-NAME-1.
:
The following shows an example with nested in-line PERFORM statements:
[REV BEG]
PERFORM VARYING DEPARTMENT FROM FIRST-DEPT BY 1 UNTIL LAST-DEPARTMENT
[REV END]
{statement-group-1}
PERFORM VARYING HOURS-PER-EMPLOYEE
[REV BEG]
FROM FIRST-EMP BY 1 UNTIL LAST-EMPLOYEE
[REV END]
{statement-group-2}
END-PERFORM
{statement-group-3}
END-PERFORM
With only statement-group-2, the second example is functionally
equivalent to the first. With statement-group-1 and statement-group-3,
the second example is more powerful than the first.
USE GLOBAL AFTER ERROR PROCEDURE ON Statement.
The USE GLOBAL AFTER ERROR PROCEDURE ON statement makes the scope of a
USE procedure match the scope of the program that declares the USE
procedure. That is, the statement applies to the program that contains
it and to all programs directly or indirectly contained within that
program.
A USE GLOBAL AFTER ERROR PROCEDURE ON statement specifies either a file
open mode or the name of a GLOBAL file.
Using a File Open Mode.
An example of the first case is the following statement:
USE GLOBAL AFTER ERROR PROCEDURE ON INPUT.
If the program containing this statement, or any program contained in
that program, encounters an error while reading any file that is open for
input, the USE procedure is invoked. Thus, file error handling is
standardized in the outermost program, even if the errors occur on files
that are local to inner programs and invisible to the outermost program.
(In the example in the next section, "When to Use Nested Programs and
GLOBAL Data," only the inner programs invoke the GLOBAL USE AFTER ERROR
PROCEDURE ON INPUT statement in the outer program, because only they have
files that are open for input.)
Using a GLOBAL File.
An example of the second case is the following statement, where FILE-A is
a GLOBAL file:
USE GLOBAL AFTER ERROR PROCEDURE ON FILE-A
If a program containing this statement, or any program contained in that
program, encounters an error while accessing FILE-A in any way, the USE
procedure is invoked. Thus, the error handling for the GLOBAL file
FILE-A need only be coded once, even though errors on FILE-A may be
encountered in other (contained) programs.
If more than one USE procedure applies to a situation, the first one
found is executed. The search for this "first found" USE procedure
begins in the program where the situation arises and proceeds outward
through the enclosing programs.
NOTE An EXIT PROGRAM statement executed directly or indirectly within a
GLOBAL USE procedure has undefined results.
When to Use Nested Programs and GLOBAL Data
The structured programming features described in the previous section,
"Structured Programming," are part of ANSI85 COBOL. They allow you to
divide your application into programs whose nesting hierarchy and data
organization express and document your programming approach. This
clarifies the logical structure of your program, making it easier to
understand, debug, and maintain.
HP COBOL II/XL has always had divisions, paragraphs, sections, and the
PERFORM statement to organize code. However, the relationship between
data and code in complex COBOL programs has been obscured by the size of
the DATA DIVISION and the complexity of the code. Nested programs offer
a solution to this problem, a way to associate data with the code that
uses it. Data that is used by many programs in an application can be
declared GLOBAL in the DATA DIVISION of the outermost program. Data that
is used by one program can be declared in that program's DATA DIVISION
only.
Nested programs are also appropriate for applications where complex tasks
are composed of smaller tasks. The complex task can be initiated by the
outer program and the smaller tasks can be performed by programs nested
within it. And the smaller tasks can be broken down into relatively
simple paragraphs and sections. The nesting structure helps document the
data and logic dependencies of the program as a whole.
A good way to decide whether to break an application down into nested
programs (instead of just paragraphs or sections) is to first decide on
the clearest way to organize the data. If a task is fairly complex and
requires a set of data items and files that other sections of the program
will not need, then the task is a candidate for nested programming.
Example - A Payroll Application.
The following simplified payroll program illustrates the approach
discussed above, using nested programs, GLOBAL data items and files, and
GLOBAL USE procedures.
The nested programs break the payroll application into logical units with
distinct functionality. Note that one of the nested programs is declared
COMMON. In this simple example, it does not need to be COMMON, but in a
realistic payroll implementation, this would be appropriate (see the
comments in the program below).
The payroll program contains both local and GLOBAL files. Local files
are used when only one program needs to access their data; GLOBAL files,
when all programs do.
A GLOBAL USE procedure is declared ON INPUT. Only local files are opened
for input, so this USE procedure is only invoked by local files. Because
this USE procedure is GLOBAL, this code only needs to appear in one
place.
The comments in the program itself explain the logic and nesting
structure of the program in more detail.
***************************
*PROGRAM-ID. PAYROLL.
* Payroll declares and opens two global files CURR-PAY-REC and
* EMPLOYEE-INFO. For each record in CURR-PAY-REC it calls
* GET-CURR-GROSS and GET-CURR-DEDUCTIONS. It also updates the
* year-to-date payroll fields in EMPLOYEE-INFO.
* It declares a GLOBAL use procedure for INPUT mode, which will
* be used when local files with tax and pay scale tables
* (opened only in input mode) encounter errors.
*
* *****************************
* * PROGRAM-ID. GET-CURR-GROSS.
* * {Calculates current gross, using a local file PAY-FILE
* * which contains the pay rates.}
* * END PROGRAM GET-CURR-GROSS.
* *****************************
*
* *****************************
* * PROGRAM-ID. GET-CURR-DEDUCTIONS.
* * {Calculates current deductions, using a local file TAX-FILE.
* * For simplicity only social security tax is calculated. The
* * complex calculations of a realistic payroll program could
* * be carried out with a set of local data declarations.}
* * END PROGRAM GET-CURR-DEDUCTIONS.
* *****************************
*
* *****************************
* * PROGRAM-ID. HASHED-READ-ON-EMPLOYEE-FILE IS COMMON.
* * Passed a social security number, this routine makes a
* * relative key and executes either a read or rewrite.
* * This program is COMMON. It is callable by any program
* * nested within PAYROLL. (Only the outermost program calls
* * it here but a realistic payroll program might call it
* * to update yearly vacation, sick leave, tax status etc.)
* * END PROGRAM HASHED-READ-ON-EMPLOYEE-FILE.
* *****************************
*
* END PROGRAM PAYROLL.
*****************************
$PAGE "PAYROLL"
IDENTIFICATION DIVISION.
PROGRAM-ID. PAYROLL.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CURR-PAY-FILE ASSIGN TO "CURRPAY"
ORGANIZATION IS SEQUENTIAL.
SELECT EMPLOYEE-INFO ASSIGN TO "EMPINFO"
ORGANIZATION IS RELATIVE
ACCESS IS RANDOM
RELATIVE KEY IS EMP-INFO-KEY
FILE STATUS IS FILE-STATUS.
DATA DIVISION.
FILE SECTION.
* When the FD is GLOBAL, all subordinate records are also GLOBAL.
FD CURR-PAY-FILE IS GLOBAL.
01 CURR-PAY-REC.
05 CURR-NAME PICTURE X(20).
05 CURR-SS-NO PICTURE X(9).
05 CURR-HOURS PICTURE 999.
05 CURR-GROSS PICTURE $$$,$$$.99.
05 CURR-DEDUCTIONS PICTURE $$$,$$$.99.
FD EMPLOYEE-INFO IS GLOBAL.
01 EMPLOYEE-REC.
05 EMP-SS-NO PICTURE X(9).
05 EMP-JOB-DESCRIPTOR PICTURE 99.
05 EMP-YEARLY-GROSS PICTURE 9(6)V99
USAGE PACKED-DECIMAL.
05 EMP-YEARLY-DEDUCTIONS PICTURE 9(6)V99
USAGE PACKED-DECIMAL.
WORKING-STORAGE SECTION.
01 EMP-INFO IS GLOBAL.
05 UNIQUE-KEY PIC 999.
88 NO-UNIQUE-KEY VALUE 999.
01 EMP-INFO-KEY REDEFINES EMP-INFO IS GLOBAL PIC 9(3).
01 FILE-STATUS IS GLOBAL PIC XX.
01 FILE-NAME IS GLOBAL PIC X(10) VALUE SPACES.
PROCEDURE DIVISION.
DECLARATIVES.
GLOBAL-USE-PROC SECTION.
USE GLOBAL AFTER STANDARD ERROR PROCEDURE ON INPUT.
GLOBAL-USE.
* This will be executed when local files TAX-RATES and
* PAY-RATES encounter an error.
DISPLAY FILE-NAME, " Status is ", FILE-STATUS.
END DECLARATIVES.
PROCESS-PAYROLL SECTION.
OPEN-FILES.
OPEN I-O CURR-PAY-FILE
OPEN I-O EMPLOYEE-INFO.
READ-PAY-FILE.
READ CURR-PAY-FILE
AT END
CLOSE CURR-PAY-FILE
NOT AT END
CALL "HASHED-READ-ON-EMPLOYEE-FILE" USING CURR-SS-NO
CALL "GET-CURR-GROSS"
CALL "GET-CURR-DEDUCTIONS"
DISPLAY CURR-NAME," ", CURR-SS-NO," ", CURR-HOURS,
" ",CURR-GROSS," ", CURR-DEDUCTIONS
WRITE CURR-PAY-REC
CALL "HASHED-REWRITE-ON-EMPLOYEE-FILE" USING CURR-SS-NO
DISPLAY EMP-SS-NO," ",EMP-JOB-DESCRIPTOR," ",
EMP-YEARLY-GROSS," ",EMP-YEARLY-DEDUCTIONS
GO READ-PAY-FILE
END-READ
CLOSE EMPLOYEE-INFO
STOP RUN.
$PAGE "GET-CURR-GROSS"
$CONTROL DYNAMIC
IDENTIFICATION DIVISION.
PROGRAM-ID. GET-CURR-GROSS.
* USE EMP-JOB-DESCRIPTOR TO INDEX TABLE-OF-PAY TO GET WAGE RATE
* AND CALCULATE CURRENT GROSS SALARY.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PAY-RATES ASSIGN TO "PAYRATES"
FILE STATUS IS FILE-STATUS.
DATA DIVISION.
FILE SECTION.
* PAY-RATES is LOCAL to this program.
FD PAY-RATES.
01 TABLE-OF-PAY.
05 RATES OCCURS 99 TIMES.
10 HOURLY-PAY PICTURE 9999V99 USAGE PACKED-DECIMAL.
10 REDEF-HOURLY REDEFINES HOURLY-PAY.
15 SALARY PICTURE 9999V99 USAGE PACKED-DECIMAL.
WORKING-STORAGE SECTION.
01 RATE PICTURE 9999V99 USAGE PACKED-DECIMAL.
01 GROSS PICTURE 9(6)V99 USAGE PACKED-DECIMAL.
01 JOB-CLASS PICTURE 99.
88 NON-EXEMPT VALUE 0 THRU 50.
88 EXEMPT VALUE 51 THRU 99.
01 OVERTIME PICTURE 999.
88 WORKED-OVERTIME VALUE 41 THRU 100.
PROCEDURE DIVISION.
OPEN-LOCAL-FILE.
MOVE "PAYRATES" TO FILE-NAME.
OPEN INPUT PAY-RATES
READ PAY-RATES.
UPDATE-GROSS-PAY.
MOVE EMP-JOB-DESCRIPTOR TO JOB-CLASS
EVALUATE EXEMPT
WHEN TRUE PERFORM SALARIED-LABOR
WHEN FALSE PERFORM HOURLY-LABOR
END-EVALUATE
COMPUTE EMP-YEARLY-GROSS = EMP-YEARLY-GROSS + GROSS
MOVE GROSS TO CURR-GROSS
CLOSE-LOCAL-FILE.
CLOSE PAY-RATES.
EXIT PROGRAM.
HOURLY-LABOR.
MOVE HOURLY-PAY (EMP-JOB-DESCRIPTOR) TO RATE
MOVE CURR-HOURS TO OVERTIME
EVALUATE WORKED-OVERTIME
WHEN FALSE
COMPUTE GROSS = CURR-HOURS * RATE
WHEN TRUE
COMPUTE GROSS = 40 * RATE +
(CURR-HOURS - 40 * RATE * 1.5)
END-EVALUATE.
SALARIED-LABOR.
MOVE SALARY (EMP-JOB-DESCRIPTOR) TO GROSS.
END PROGRAM GET-CURR-GROSS.
$PAGE "GET-CURR-DEDUCTIONS"
IDENTIFICATION DIVISION.
PROGRAM-ID. GET-CURR-DEDUCTIONS.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TAX-RATES ASSIGN TO "TAXRATES"
FILE STATUS IS FILE-STATUS.
DATA DIVISION.
FILE SECTION.
* TAX-RATES is LOCAL to this program.
* For simplicity, only social security tax is calculated.
FD TAX-RATES.
01 TABLE-OF-TAXES.
05 FICA-TAX-RATE PICTURE 9999V999 USAGE PACKED-DECIMAL.
WORKING-STORAGE SECTION.
01 GROSS PICTURE 9(6)V99 USAGE PACKED-DECIMAL.
01 DEDUCTIONS PICTURE 9(6)V99 USAGE PACKED-DECIMAL.
PROCEDURE DIVISION.
OPEN-LOCAL-FILE.
MOVE "TAXRATES" TO FILE-NAME
OPEN INPUT TAX-RATES
READ TAX-RATES.
UPDATE-DEDUCTIONS.
MOVE CURR-GROSS TO GROSS
COMPUTE DEDUCTIONS = GROSS * FICA-TAX-RATE
COMPUTE EMP-YEARLY-DEDUCTIONS =
EMP-YEARLY-DEDUCTIONS + DEDUCTIONS
MOVE DEDUCTIONS TO CURR-DEDUCTIONS.
CLOSE-LOCAL-FILE.
CLOSE TAX-RATES.
END PROGRAM GET-CURR-DEDUCTIONS.
$PAGE "HASHED-ACCESS-ON-EMPLOYEE-FILE"
IDENTIFICATION DIVISION.
PROGRAM-ID. HASHED-READ-ON-EMPLOYEE-FILE IS COMMON.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 KEY-SWITCH PIC X.
88 SUCCESS VALUE "Y".
88 RESET-SWITCH VALUE "N".
LINKAGE SECTION.
01 SS-NO PICTURE X(9).
PROCEDURE DIVISION USING SS-NO.
BEGIN-HASHED-READ.
SET RESET-SWITCH TO TRUE
MOVE SS-NO(1:3) TO EMP-INFO-KEY
PERFORM UNTIL SUCCESS
READ EMPLOYEE-INFO
INVALID KEY ADD 1 TO UNIQUE-KEY
NOT INVALID KEY IF EMP-SS-NO = SS-NO THEN
SET SUCCESS TO TRUE
END-IF
END-READ
END-PERFORM
EXIT PROGRAM.
ENTRY "HASHED-REWRITE-ON-EMPLOYEE-FILE" USING SS-NO.
BEGIN-HASHED-REWRITE.
IF EMP-SS-NO
SS-NO THEN
DISPLAY "HASHING SCHEME REQUIRES READ BEFORE REWRITE"
ELSE
REWRITE EMPLOYEE-REC
INVALID KEY
DISPLAY "Employee-file Status is ", FILE-STATUS
NOT INVALID KEY
EXIT PROGRAM
END-IF.
END PROGRAM HASHED-READ-ON-EMPLOYEE-FILE.
END PROGRAM PAYROLL.