Example 16-4. Program Outline Showing the Use of the IS GLOBAL Clause
IDENTIFICATION DIVISION.
PROGRAM-ID. CarPurchasesReport.
: : : : : : :
01 StateTable IS GLOBAL.
02 State OCCURS 50 TIMES.
03 TotalCarPurchases PIC 9(9)V99.
: : : : : : :
PROCEDURE DIVISION.
: : : : : :
CALL AddToStateTotal USING BY CONTENT StateNo, ValueOfCarPurchase
: : : : : :
CALL PrintTotalCarPurchases
STOP RUN.
IDENTIFICATION DIVISION.
PROGRAM-ID. AddToStateTotal.
: : : : : : :
END-PROGRAM AddToStateTotal.
IDENTIFICATION DIVISION.
PROGRAM-ID. PrintTotalCarPurchases.
: : : : : : :
END PROGRAM PrintTotalCarPurchases.
END PROGRAM CarPurchasesReport.
The IS COMMON PROGRAM Clause
I mentioned earlier that a contained subprogram can only be called by its immediate parent (container) program or by a subprogram at the same level. I noted that even then, a contained subprogram can call a subprogram at the same level only if the subprogram to be called uses the IS COMMON PROGRAM clause in its PROGRAM-ID. You already saw the metalanguage for the IS COMMON PROGRAM clause in Figure 16-5, but it is repeated here for convenience: IS [ COMMON ] [ INITIAL ] PROGRAM.
407
Chapter 16 ■ Creating Large SyStemS
When IS COMMON PROGRAM is attached to the PROGRAM-ID clause of a contained subprogram, that subprogram
may be invoked by any subprograms at the same level (siblings) but only by them. As you can see from the
metalanguage, both the COMMON and INITIAL clauses may be used in combination. The words IS and PROGRAM are noise words that may be omitted. The IS COMMON PROGRAM clause can be used only in nested programs.
Example Programs and Their Subprograms
Listing 16-2, Listing 16-3, and Listing 16-4 are programs that consist of simple examples to demonstrate some of the issues discussed so far. Listing 16-5 is a more practical example that implements a game to test your knowledge of the American states. Listing 16-6 is a demonstrator for the external subprogram used by Listing 16-5.
External Subprogram
Listing 16-2 is an example program that calls an external subprogram to validate Student IDs. It is followed by the external subprogram Listing 16-2sub, which applies check-digit validation to any seven-digit number supplied to it.
Listing 16-2. Creating and Calling an External Subprogram
IDENTIFICATION DIVISION.
PROGRAM-ID. Listing16-2.
AUTHOR. Michael Coughlan.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 StudentId PIC 9(7).
01 ValidationResult PIC 9.
88 ValidStudentId VALUE ZERO.
88 InvalidStudentId VALUE 1.
PROCEDURE DIVISION.
Begin.
PERFORM 3 TIMES
DISPLAY "Enter a Student Id : " WITH NO ADVANCING
ACCEPT StudentId
CALL "ValidateCheckDigit" USING BY CONTENT StudentID
BY REFERENCE ValidationResult
IF ValidStudentId
DISPLAY "The Student id - " StudentId " - is valid"
ELSE
DISPLAY "The Student id - " StudentId " - is not valid"
END-IF
DISPLAY SPACES
END-PERFORM
STOP RUN.
Listing 16-2sub. The ValidateCheckDigit External Subprogram
IDENTIFICATION DIVISION.
PROGRAM-ID. ValidateCheckDigit IS INITIAL.
DATA DIVISION.
WORKING-STORAGE SECTION.
408
Chapter 16 ■ Creating Large SyStemS
01 SumOfNums PIC 9(5).
01 Quotient PIC 9(5).
01 CalcResult PIC 99.
LINKAGE SECTION.
01 NumToValidate.
02 D1 PIC 9.
02 D2 PIC 9.
02 D3 PIC 9.
02 D4 PIC 9.
02 D5 PIC 9.
02 D6 PIC 9.
02 D7 PIC 9.
01 Result PIC 9.
88 InvalidCheckDigit VALUE 1.
88 ValidCheckDigit VALUE 0.
PROCEDURE DIVISION USING NumToValidate, Result.
*> Returns a Result of 1 (invalid check digit) or 0 (valid check digit)
Begin.
COMPUTE SumOfNums = (D1 * 7) + (D2 * 6) + (D3 * 5) + (D4 * 4) +
(D5 * 3) + (D6 * 2) + (D7).
DIVIDE SumOfNums BY 11 GIVING Quotient REMAINDER CalcResult
IF CalcResult EQUAL TO ZERO
SET ValidCheckDigit TO TRUE
ELSE
SET InvalidCheckDigit TO TRUE
END-IF
EXIT PROGRAM.
Parameter Passing and Data Visibility
Listing 16-3 is an abstract example that demonstrates how to create contained subprograms. It shows the various kinds of parameters and parameter-passing mechanisms you can use and demonstrates the visibility of any data item declared with the IS GLOBAL clause.
Listing 16-3. Contained Subprograms and Parameter Passing and Data Visibility
IDENTIFICATION DIVISION.
PROGRAM-ID. Listing16-3.
AUTHOR. Michael Coughlan.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 DaysOfTheWeek VALUE "MonTueWedThuFriSatSun" IS GLOBAL.
02 DayName PIC XXX OCCURS 7 TIMES.
01 Parameters.
02 Number1 PIC 9(3) VALUE 456.
02 Number2 PIC 9(3) VALUE 321.
02 FirstString PIC X(20) VALUE "First parameter = ".
409
Chapter 16 ■ Creating Large SyStemS
02 SecondString PIC X(20) VALUE "Second parameter = ".
02 Result PIC 9(6) USAGE IS COMP.
02 DiscountTable VALUE "12430713862362".
03 Discount PIC 99 OCCURS 7 TIMES.
01 PrnResult PIC ZZZ,ZZ9.
PROCEDURE DIVISION.
DemoParameterPassing.
DISPLAY "FirstString value is - " FirstString
DISPLAY "SecondString value is - " SecondString
CALL "MultiplyNums"
USING BY CONTENT Number1, Number2, FirstString,
BY REFERENCE SecondString, Result
BY CONTENT DiscountTable
DISPLAY SPACES
DISPLAY "FirstString value is - " FirstString
DISPLAY "SecondString value is - " SecondString
MOVE Result TO PrnResult
DISPLAY "COMP value is " PrnResult
STOP RUN.
IDENTIFICATION DIVISION.
PROGRAM-ID. MultiplyNums.
AUTHOR. Michael Coughlan.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 idx PIC 9.
LINKAGE SECTION.
01 Param1 PIC 9(3).
01 Param2 PIC 9(3).
01 Answer PIC 9(6) USAGE IS COMP.
01 StrA PIC X(20).
01 StrB PIC X(20).
01 TableIn.
02 TNum PIC 99 OCCURS 7 TIMES.
PROCEDURE DIVISION USING Param1, Param2, StrA,
StrB, Answer, TableIn.
Begin.
DISPLAY SPACES
DISPLAY ">>> In the MultiplyNums subprogram"
DISPLAY StrA Param1
DISPLAY StrB Param2
MULTIPLY Param1 BY Param2 GIVING Answer.
410
Chapter 16 ■ Creating Large SyStemS
*> Displays table values. One passed as a parameter and the other global
DISPLAY SPACES
PERFORM VARYING idx FROM 1 BY 1 UNTIL idx > 7
DISPLAY DayName(idx) " discount is " Tnum(idx) "%"
END-PERFORM
*> Transfer control to a subprogram contained within MultiplyNums
CALL "InnerSubProg"
*> Demonstrates the difference between BY CONTENT and BY REFERENCE.
MOVE "VALUE OVERWRITTEN" TO StrA
MOVE "VALUE OVERWRITTEN" TO StrB
DISPLAY SPACES
DISPLAY "<<<< Leaving MultiplyNums"
EXIT PROGRAM.
IDENTIFICATION DIVISION.
PROGRAM-ID. InnerSubProg.
AUTHOR. Michael Coughlan.
PROCEDURE DIVISION.
Begin.
*> Demonstrates that the GLOBAL data item is even visible here
DISPLAY SPACES
DISPLAY ">>>> In InnerSubProg"
DISPLAY "Days of the week = " DaysOfTheWeek
DISPLAY "<<<< Leaving InnerSubProg"
EXIT PROGRAM.
END PROGRAM InnerSubProg.
END PROGRAM MultiplyNums.
END PROGRAM LISTING16-3.
The first displayed items show the current value of the two strings in the main program. There is a purpose to this. One string is passed BY REFERENCE and the other BY CONTENT. When these strings are displayed after the CALL has executed, the one passed BY REFERENCE has been corrupted. The lesson should be obvious.
In addition to normal numeric items, one of the parameters is a USAGE IS COMP data item. It holds the result of multiplying the two numbers Param1 and Param2. One thing I must stress here is that the description of numeric items in the main program must be the same as the description in the LINKAGE SECTION. If you describe an item as signed in the subprogram, it must be signed in the main program. If it is a USAGE IS COMP item in the subprogram, it must be the same in the main program. Be aware that the complier provides you with absolutely no protection in this regard.
It is up to you to make sure the data types and sizes correspond. Working with COBOL subprograms is akin to driving down a twisty mountain road with no protection barrier—one mistake, and you plunge into the abyss.
The percentage displays are used to show that an array can be passed as a parameter. But in this example I also take the opportunity to show that the DaysOfTheWeek table, which is declared as GLOBAL in the outer scope
(main program), is also visible inside the contained subprogram.
Just to emphasize the visibility of GLOBAL data items, the subprogram InnerSubProg is nested within the
subprogram MultiplyNums. Even in InnerSubProg, the DaysOfTheWeek table is visible.
411
Chapter 16 ■ Creating Large SyStemS
Using IS COMMON PROGRAM
Listing 16-4 shows that the program to be called can be assigned at runtime. In this example, instead of using a literal value as the target of the CALL, a data item containing the name of the subprogram to be called is used. The name of the subprogram is supplied by the user. Because the user is supplying the name of the program, there is a possibility that they will get the name wrong; the ON EXCEPTION clause is used to make sure the named program exists.
Listing 16-4. Creating and Using a COMMON Subprogram
IDENTIFICATION DIVISION.
PROGRAM-ID. Listing16-4.
AUTHOR. Michael Coughlan.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 Operation PIC XXX.
01 NumericValue PIC 999.
88 EndOfData VALUE ZEROS.
01 FILLER PIC 9.
88 ValidSubprogName VALUE ZERO.
88 InvalidSubprogName VALUE 1.
PROCEDURE DIVISION.
Begin.
PERFORM 3 TIMES
SET ValidSubprogName TO TRUE
DISPLAY SPACES
DISPLAY "Ente r the required operation (Dec or Inc) : " WITH NO ADVANCING
ACCEPT Operation
DISPLAY "Enter a three digit value : " WITH NO ADVANCING
ACCEPT NumericValue
PERFORM UNTIL EndofData OR InvalidSubprogName
CALL Operation USING BY CONTENT NumericValue
ON EXCEPTION DISPLAY Operation " is not a valid operation"
SET InvalidSubprogName TO TRUE
NOT ON EXCEPTION SET ValidSubprogName TO TRUE
DISPLAY "Enter a three digit value : "
WITH NO ADVANCING
ACCEPT NumericValue
END-CALL
END-PERFORM
CANCEL Operation
END-PERFORM
STOP RUN.
IDENTIFICATION DIVISION.
PROGRAM-ID. Inc.
AUTHOR. Michael Coughlan.
412
Chapter 16 ■ Creating Large SyStemS
DATA DIVISION.
WORKING-STORAGE SECTION.
01 RunningTotal PIC S9(5) VALUE ZEROS.
LINKAGE SECTION.
01 ValueIn PIC 9(3).
PROCEDURE DIVISION USING ValueIn.
Begin.
ADD ValueIn TO RunningTotal
CALL "DisplayTotal" USING BY CONTENT RunningTotal
EXIT PROGRAM.
END PROGRAM Inc.
IDENTIFICATION DIVISION.
PROGRAM-ID. Dec.
AUTHOR. Michael Coughlan.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 RunningTotal PIC S9(5) VALUE ZEROS.
LINKAGE SECTION.
01 ValueIn PIC 9(3).
PROCEDURE DIVISION USING ValueIn.
Begin.
SUBTRACT ValueIn FROM RunningTotal
CALL "DisplayTotal" USING BY CONTENT RunningTotal
EXIT PROGRAM.
END PROGRAM Dec.
IDENTIFICATION DIVISION.
PROGRAM-ID. DisplayTotal IS COMMON INITIAL PROGRAM.
AUTHOR. Michael Coughlan.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 PrnValue PIC +++,++9.
LINKAGE SECTION.
01 ValueIn PIC S9(5).
PROCEDURE DIVISION USING ValueIn.
Begin.
MOVE ValueIn TO PrnValue
DISPLAY "The current value is " PrnValue
EXIT PROGRAM.
END PROGRAM DisplayTotal.
END PROGRAM LISTING16-4.
413
Chapter 16 ■ Creating Large SyStemS
In this example, both Inc and Dec display RunningTotal via a CALL to their sibling program DisplayTotal, which has the IS COMMON PROGRAM clause.
A Practical Example
In Chapter 13, I introduced a table that held the codes, names, and capitals of all the states in America. You might have thought at the time that that information could prove useful in a number of programs. In the next example I take that table, expand it to include the population of each state and from it create an external subprogram called GetStateInfo. Listing 16-5 and Listing 16-6 both use GetStateInfo, but in different ways. Listing 16-5 is a game that uses GetStateInfo to test your knowledge of the American states. Listing 16-6 simply returns the other information about a state when you give it one piece of information, such as the state name.
GetStateInfo External Subprogram
Before examining Listing 16-5 and Listing 16-6, let’s look at the external subprogram that both of these programs call (see Listing 16-5sub).
Listing 16-5sub. External Subprogram to Supply Information About the States
IDENTIFICATION DIVISION.
PROGRAM-ID. GetStateInfo IS INITIAL.
AUTHOR. Michael Coughlan.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 StatesTable.
02 StateValues.
03 FILLER PIC X(38) VALUE "ALAlabama Montgomery 04822023".
03 FILLER PIC X(38) VALUE "AKAlaska Juneau 00731449".
03 FILLER PIC X(38) VALUE "AZArizona Phoenix 06553255".
03 FILLER PIC X(38) VALUE "ARArkansas Little Rock 02949131".
03 FILLER PIC X(38) VALUE "CACalifornia Sacramento 38041430".
03 FILLER PIC X(38) VALUE "COColorado Denver 05187582".
03 FILLER PIC X(38) VALUE "CTConnecticut Hartford 03590347".
03 FILLER PIC X(38) VALUE "DEDelaware Dover 00917092
".
03 FILLER PIC X(38) VALUE "FLFlorida Tallahassee 19317568".
03 FILLER PIC X(38) VALUE "GAGeorgia Atlanta 09919945".
03 FILLER PIC X(38) VALUE "HIHawaii Honolulu 01392313".
03 FILLER PIC X(38) VALUE "IDIdaho Boise 01595728".
03 FILLER PIC X(38) VALUE "ILIllinois Springfield 12875255".
03 FILLER PIC X(38) VALUE "INIndiana Indianapolis 06537334".
03 FILLER PIC X(38) VALUE "IAIowa Des Moines 03074186".
03 FILLER PIC X(38) VALUE "KSKansas Topeka 02885905".
03 FILLER PIC X(38) VALUE "KYKentucky Frankfort 04380415".
03 FILLER PIC X(38) VALUE "LALouisiana Baton Rouge 04601893".
03 FILLER PIC X(38) VALUE "MEMaine Augusta 01329192".
03 FILLER PIC X(38) VALUE "MDMaryland Annapolis 05884563".
03 FILLER PIC X(38) VALUE "MAMassachusetts Boston 06646144".
03 FILLER PIC X(38) VALUE "MIMichigan Lansing 09883360".
03 FILLER PIC X(38) VALUE "MNMinnesota Saint Paul 05379139".
03 FILLER PIC X(38) VALUE "MSMississippi Jackson 02984926".
03 FILLER PIC X(38) VALUE "MOMissouri Jefferson City06021988".
414
Chapter 16 ■ Creating Large SyStemS
03 FILLER PIC X(38) VALUE "MTMontana Helena 01005141".
03 FILLER PIC X(38) VALUE "NENebraska Lincoln 01855525".
03 FILLER PIC X(38) VALUE "NVNevada Carson City 02758931".
03 FILLER PIC X(38) VALUE "NHNew Hampshire Concord 01320718".
03 FILLER PIC X(38) VALUE "NJNew Jersey Trenton 08864590".
03 FILLER PIC X(38) VALUE "NMNew Mexico Santa Fe 02085538".
03 FILLER PIC X(38) VALUE "NYNew York Albany 19570261".
03 FILLER PIC X(38) VALUE "NCNorth CarolinaRaleigh 09752073".
03 FILLER PIC X(38) VALUE "NDNorth Dakota Bismarck 00699628".
03 FILLER PIC X(38) VALUE "OHOhio Columbus 11544225".
03 FILLER PIC X(38) VALUE "OKOklahoma Oklahoma City 03814820".
03 FILLER PIC X(38) VALUE "OROregon Salem 03899353".
03 FILLER PIC X(38) VALUE "PAPennsylvania Harrisburg 12763536".
03 FILLER PIC X(38) VALUE "RIRhode Island Providence 01050292".
03 FILLER PIC X(38) VALUE "SCSouth CarolinaColumbia 04723723".
Michael Coughlan Page 50
