Michael Coughlan
Page 67
*Accepts a Zodiac House value and returns the element of the sign
*Viz – Fire Earth Air Water.
*Houses 1,5,9 = Fire; 2,6,10 = Earth; 3,7,11 = Air; 4,8,12 = Water
END METHOD "getSignElement".
Before you rewrite the Zodiac Sign Compatibility experiment program, you can test the Zodiac class you have written using the following test program:
IDENTIFICATION DIVISION.
PROGRAM-ID. UseZodiac.
AUTHOR. Michael Coughlan.
REPOSITORY.
CLASS ZodiacFactory AS "zodiac".
DATA DIVISION.
WORKING-STORAGE SECTION.
01 MyZodiac USAGE OBJECT REFERENCE ZodiacFactory.
01 Date-DDMM PIC X(4).
88 EndOfData VALUE SPACES.
01 SignCode PIC 99.
01 OpStatus1 PIC 9.
88 CuspSign VALUE 1.
01 OpStatus2 PIC 9.
88 OperationOK VALUE ZEROS.
01 SignName PIC X(11).
01 SignElement PIC X(5).
PROCEDURE DIVISION.
Begin.
INVOKE ZodiacFactory "new" RETURNING MyZodiac
DISPLAY "Enter the Date DDMM :- " WITH NO ADVANCING
ACCEPT Date-DDMM
PERFORM GetAndDisplay UNTIL EndOfdata
INVOKE MyZodiac "finalize" RETURNING MyZodiac
DISPLAY "End of Program"
STOP RUN.
GetAndDisplay.
INVOKE MyZodiac "getSignHouse" USING BY CONTENT Date-DDMM
BY REFERENCE SignCode
RETURNING OpStatus1
INVOKE MyZodiac "getSignName" USING BY CONTENT SignCode
BY REFERENCE SignName
RETURNING OpStatus2
541
Chapter 19 ■ OO-COBOL
INVOKE MyZodiac "getSignElement" USING BY CONTENT SignCode
BY REFERENCE SignElement
RETURNING OpStatus2
DISPLAY "SignCode = " SignCode
DISPLAY "Sign name is " SignName
DISPLAY "Sign Element is " SignElement
IF CuspSign
DISPLAY "The sign is a cusp"
END-IF
DISPLAY "Enter the Date DDMM :- " WITH NO ADVANCING
ACCEPT Date-DDMM.
prOGraMMING eXerCISe: aNSWer
Listing 19-3. Zodiac Compatibility Program Using the Zodiac Class
IDENTIFICATION DIVISION.
PROGRAM-ID. Listing19-3.
* Zodiac Compatibility program
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT BirthsFile ASSIGN TO "Listing19-3-MPDOB.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
CLASS-CONTROL.
ZodiacFactory IS CLASS "zodiac".
DATA DIVISION.
FILE SECTION.
FD BirthsFile.
01 BirthsRec.
88 EndOfFile VALUE HIGH-VALUES.
02 MaleDOB.
03 MaleDate PIC X(4).
03 FILLER PIC X(4).
02 FemaleDOB.
03 FemaleDate PIC X(4).
03 FILLER PIC X(4).
WORKING-STORAGE SECTION.
01 MyZodiac USAGE OBJECT REFERENCE.
01 Counts.
02 CompatiblePairs PIC 9(7) VALUE ZEROS.
02 CompatiblePrn PIC ZZZZ,ZZ9.
02 CompatiblePercent PIC ZZ9.
542
Chapter 19 ■ OO-COBOL
02 IncompatiblePairs PIC 9(7) VALUE ZEROS.
02 IncompatiblePrn PIC ZZZZ,ZZ9.
02 IncompatiblePercent PIC ZZ9.
02 ValidRecs PIC 9(8) VALUE ZEROS.
02 ValidRecsPrn PIC ZZ,ZZZ,ZZ9.
02 TotalRecs PIC 9(9) VALUE ZEROS.
02 TotalRecsPrn PIC ZZ,ZZZ,ZZ9.
01 MaleSign PIC 99.
01 FemaleSign PIC 99.
01 SumOfSigns PIC 99.
01 OpStatusM PIC 9.
88 ValidMale VALUE ZEROS.
01 OpStatusF PIC 9.
88 ValidFemale VALUE ZEROS.
PROCEDURE DIVISION.
Begin.
INVOKE ZodiacFactory "new" RETURNING MyZodiac
OPEN INPUT BirthsFile.
READ BirthsFile
AT END SET EndOfFile TO TRUE
END-READ
PERFORM ProcessBirthRecs UNTIL EndOfFile
COMPUTE ValidRecs = CompatiblePairs + IncompatiblePairs
COMPUTE CompatiblePercent ROUNDED = CompatiblePairs / ValidRecs * 100
COMPUTE InCompatiblePercent ROUNDED = InCompatiblePairs / ValidRecs * 100
PERFORM DisplayResults
CLOSE BirthsFile.
STOP RUN.
DisplayResults.
MOVE CompatiblePairs TO CompatiblePrn
MOVE IncompatiblePairs TO IncompatiblePrn
MOVE TotalRecs TO TotalRecsPrn
MOVE ValidRecs TO ValidRecsPrn
DISPLAY "Total records = " TotalRecsPrn
DISPLAY "Valid records = " ValidRecsPrn
DISPLAY "Compatible pairs = " CompatiblePrn
" which is " CompatiblePercent "% of total".
DISPLAY "Incompatible pairs = " IncompatiblePrn
" which is " InCompatiblePercent "% of total".
543
Chapter 19 ■ OO-COBOL
ProcessBirthRecs.
* Get the two sign types and add them together
* If the result is even then they are compatible
ADD 1 TO TotalRecs
INVOKE MyZodiac "getSignHouse" USING BY CONTENT MaleDate
BY REFERENCE MaleSign
RETURNING OpStatusM
INVOKE MyZodiac "getSignHouse" USING BY CONTENT FemaleDate
BY REFERENCE FemaleSign
RETURNING OpStatusF
IF ValidMale AND ValidFemale
COMPUTE SumOfSigns = MaleSign + FemaleSign
IF FUNCTION REM(SumOfSigns 2) = ZERO
ADD 1 TO CompatiblePairs
ELSE
ADD 1 TO IncompatiblePairs
END-IF
END-IF
READ BirthsFile
AT END SET EndOfFile TO TRUE
END-READ.
Listing 19-3-cls. The Zocodiac Class Program
CLASS-ID. Zodiac AS "zodiac" INHERITS FROM Base.
* AUTHOR. Michael Coughlan.
REPOSITORY.
CLASS BASE AS "base"
CLASS Zodiac AS "zodiac".
* No FACTORY in this program
OBJECT.
WORKING-STORAGE SECTION.
01 ZodiacTable.
02 ZodiacTableData.
03 FILLER PIC X(20) VALUE "Aries 103210419".
03 FILLER PIC X(20) VALUE "Taurus 204200520".
03 FILLER PIC X(20) VALUE "Gemini 305210620".
03 FILLER PIC X(20) VALUE "Cancer 406210722".
03 FILLER PIC X(20) VALUE "Leo 107230822".
03 FILLER PIC X(20) VALUE "Virgo 208230922".
03 FILLER PIC X(20) VALUE "Libra 309231022".
03 FILLER PIC X(20) VALUE "Scorpio 410231121".
03 FILLER PIC X(20) VALUE "Sagittarius111221221".
03 FILLER PIC X(20) VALUE "Capricorn 212221231".
03 FILLER PIC X(20) VALUE "Aquarius 301200218".
03 FILLER PIC X(20) VALUE "Pisces 402190320".
544
Chapter 19 ■ OO-COBOL
02 ZodiacSign REDEFINES ZodiacTableData
OCCURS 12 TIMES
INDEXED BY Zidx.
03 SignName PIC X(11).
03 SignElement PIC 9.
03 StartDate PIC X(4).
03 EndDate PIC X(4).
01 ElementTable VALUE "Fire EarthAir Water".
02 Element OCCURS 4 TIMES PIC X(5).
METHOD-ID. getSignHouse.
LOCAL-STORAGE SECTION.
01 WorkDate.
88 SignIsCusp VALUE "0120", "0121", "0219", "0220",
"0320", "0321", "0420", "0421",
"0521", "0522", "0621", "0622",
"0723", "0724", "0823", "0824",
"0923", "0924", "1023", "1024",
"1122", "1123", "1221", "1222".
02 WorkMonth PIC XX.
02 WorkDay PIC XX.
LINKAGE SECTION.
01 InDate.
02 InDay PIC XX.
02 InMonth PIC XX.
01 House PIC 99.
01 OpStatus PIC 9.
88 CuspSign VALUE 1.
88 InvalidDate VALUE 2.
PROCEDURE DIVISION USING InDate, House RETURNING OpStatus.
MOVE InDay TO WorkDay
MOVE InMonth TO WorkMonth
MOVE 0 TO OpStatus
SET Zidx TO 1
SEARCH ZodiacSign
AT END IF WorkDate >= "0101" AND <= "0119"
MOVE 11 TO House
END-IF
WHEN WorkDate >= StartDate(Zidx) AND <= EndDate(Zidx)
SET House TO Zidx
END-SEARCH
IF SignIsCusp SET CuspSign TO TRUE
END-IF
EXIT METHOD.
END METHOD getSignHouse.
545
Chapter 19 ■ OO-COBOL
METHOD-ID. getSignName.
LINKAGE SECTION.
01 House PIC 99.
88 ValidSignHouse VALUE 01 THRU 12.
01 OutSignName PIC X(11).
01 OpStatus PIC 9.
88 InvalidSignHouse VALUE 1.
88 OperationOk VALUE 0.
PROCEDURE DIVISION USING House, OutSignName RETURNING OpStatus.
IF NOT ValidSignHouse
SET InvalidSignHouse TO TRUE
ELSE
MOVE SignName(House) TO OutSignName
SET OperationOk TO TRUE
END-IF
EXIT METHOD.
END METHOD getSignName.
METHOD-ID. getSignElement.
LINKAGE SECTION.
01 House PIC 99.
88 ValidSignHouse VALUE 01 THRU 12.
01 OutSignElement PIC X(5).
01 OpStatus PIC 9.
88 InvalidSignHouse VALUE 1.
88 OperationOk VALUE 0.
PROCEDURE DIVISION USING House, OutSignElement RETURNING OpStatus.
IF NOT ValidSignHouse
SET InvalidSignHouse TO TRUE
ELSE
MOVE Element(SignElement(House)) TO OutSignElement
SET OperationOk TO TRUE
END-IF
EXIT METHOD.
END METHOD getSignElement.
END OBJECT.
END CLASS Zodiac.
546
Index
� A
�
�
Closed subroutines, 112
CLOSE statement, 139
Acme Automobile Parts Limited
COBOL, 1
file transaction, 470
application domain
maintenance, 471
characteristics, 2
redundant stock report, 471
domain-independent languages, 2
stock master file, 470
version, 3
vehicle master file, 470
bespoke application, 9
Alphanumeric literals, 37
bug-free status, 9
AND truth table, 79
characteristics
Arithmetic verbs, 60
enormous volumes, 11
GIVING phrase, 61
maintainable, 13
metalanguage, 60
many programming shops, 10
ON SIZE ERROR phrase, 62
mission-critical applications, 11
ROUNDED phrase, 62
module version log, 11
statements, 61
nonproprietary, 13
Aromamora Base Oil Sales report, 273
self-documenting programming language, 12
considerations, 274
simple language, 12
control-break program, 276
stable, 12
oil names and unit costs, 275
coding rules ( see Coding rules)
report template, 274
compiler, 34
sales file, 274
Fujitsu NetCOBOL compiler, 35
test data and results, 279
Micro Focus Visual compiler, 34
Automatic language conversion, 6
online compiler, 35
open source COBOL compiler, 35
� B
�
�
Raincode compiler, 35
conspiracy-theory, 8
Bespoke application, 9
crisis and opportunity, 7
Binary search, 303
definition, 4
Bracketing, 79
DoCalc program, 31
enterprise computing, 5
� C
�
�
greeting program, 31
hidden asset, 8
Class conditions, 75
hierarchical program structure, 21
example program, 77
divisions ( see Divisions, COBOL program)
metalanguage, 76
paragraph, 22
numeric tests, 76
sections, 21
StateName capitals, 76
sentence, 22
UserDefinedClassName, 76
statements, 23
547
■ index
COBOL ( cont. )
overlapping and multiple-value names, 86
high-level programming language, 1
rules, 84
history, 3
single name and value, 84
idiosyncrasies, 17
whole word values, 88
legacy system
design patterns
automatic language conversion, 6
sequential file reading, 91
code renovation, 7
example program, 89
commodity hardware and
group item, 92
software, 7
set to true, 90
complete rewrite, 6
SET verb examples, 90
COTS package, 6
SET verb metalanguage, 90
danger, difficulty and expense, 5
Control-break processing, 206
wrapping, 7
detection, 208
metalanguage syntax, 19
program template, 209
COMPUTE statement, 20
program writing, 208
diagram, 19
specifications required, 207
notation, 19
single control break, 207
operand suffixes, 20
three control breaks, 208
references, 14
two control breaks, 207
standards, 4
three-level control break, 209
COBOL ANS 4, 68
program implementation, 210
COBOL ANS 74 (External Subprograms), 4
test data file, 213
COBOL ANS 85 (Structured Programming
typical control break
Constructs), 4
program implementation, 215
COBOL ANS 2002 (OO Constructs), 4
specification required, 214
target application domain, 1
test data file, 217
using EVALUATE Verb, 34
Control structures
COBOL subroutines, 112
iteration ( see Iteration constructs)
Coding rules, 28
selection ( see Selection constructs)
coding sheet, 28
name construction, 29
� D
�
�
data-item names, 29
program formatting, 30
Data declaration, 37
programming style, 30
assignment operation
Common Business Oriented Language (COBOL).
alphanumeric MOVEs, 44
See COBOL
data types,
42
Compiler
MOVE combinations, 43
Fujitsu NetCOBOL compiler, 35
MOVE rules, 43
Micro Focus Visual compiler, 34
MOVE syntax, 43
online compiler, 35
MOVE verb, 42
open source COBOL compiler, 35
numeric MOVEs, 45
Raincode compiler, 35
categories
Complex conditions, 78
data item (variables), 38
bracketing, 79
elementary item, 40
cursor detection, 79
figurative constants, 39
metalanguage, 78
literals, 37
OR, AND truth tables, 79
data items
precedence rules, 79
example declarations, 42
COMPUTE statement, 20
PICTURE clauses, 40
Condition names, 83
exercise
correct use of, 88
answers, 53
Date-Validation Error Message, 93
question, 52
definition, 84
numeric MOVEs
multiple names, 85
example set 1, 45
numeric or alphabetic values, 87
example set 2, 46
548
■ index
structured data
� E
�
�
data hierarchy, 48
group item, 47
Edited pictures, 181
level number(s), 47
editing types, 184
level number relationships govern hierarchy, 50
formatting effects, 181–182
Data type enforcement, 38
immediate editing, 182
Date-Validation Error Message, 93
insertion, 185
Decimal arithmetic
fixed-insertion, 188
fixed-point, 292, 294
floating, 191
floating-point, 292–293
simple-insertion, 185
Decision tables, 94
special-insertion, 187
Direct access files, 435
picture clause, 197
COBOL file organizations
print lines, 194
relative file ( see Relative file organization)
immediate editing, 195
sequential file ( see Sequential file organization)
program implementation, 195
indexed files, 450
program implementation, 182
applied transactions, 459
string restrictions, 196
index file combination ( see Index file
suppression-and-replacement editing, 193