SEPA
United States
Environmental Protection
Agency
Municipal Environmental Research
Laboratory
Cincinnati OH 45268
EPA-600/2-80-012b
July 1980
Research and Development
Development and
Application of a
Water Supply Cost
Analysis System
Volume II
-------
RESEARCH REPORTING SERIES
Research reports of the Office of Research and Development, U.S Environmental
Protection Agency, have been grouped into nine series These nine broad cate-
gories were established to facilitate further development and application of en-
vironmental technology Elimination of traditional grouping was consciously
planned to foster technology transfer and a maximum interface in related fields.
The nine series are
1 Environmental Health Effects Research
2 Environmental Protection Technology
3 Ecological Research
4 Environmental Monitoring
5, Socioeconomic Environmental Studies
6. Scientific and Technical Assessment Reports (STAR)
7 Interagency Energy-Environment Research and Development
8. "Special" Reports
9 Miscellaneous Reports
This report has been assigned to the ENVIRONMENTAL PROTECTION TECH-
NOLOGY series. This series describes research performed to develop and dem-
onstrate instrumentation, equipment, and methodology to repair or prevent en-
vironmental degradation from point and non-point sources of pollution. This work
provides the new or improved technology required for the controf and treatment
of pollution sources to meet environmental quality standards.
This document is available to the public through the National Technical Informa-
tion Service, Springfield, Virginia 22161.
-------
EPA-600/2-80-012b
July 1980
DEVELOPMENT AND APPLICATION OF A
WATER SUPPLY COST ANALYSIS SYSTEM
Volume II
by
James I. Gillean
Rex D. Osborn
William L. Britton, Jr.
ACT Systems, Inc.
Winter Park, Florida 32789
Robert M. Clark
Municipal Environmental Research Laboratory
Cincinnati, Ohio 45268
Contract No. 68-03-2506
Project Officer
Robert M. Clark
Drinking Water Research Division
Municipal Environmental Research Laboratory
Cincinnati, Ohio 45268
MUNICIPAL ENVIRONMENTAL RESEARCH LABORATORY
OFFICE OF RESEARCH AND DEVELOPMENT
U.S. ENVIRONMENTAL PROTECTION AGENCY
CINCINNATI, OHIO 45268
-------
DISCLAIMER
This report has been reviewed by the Municipal Environmental Research
Laboratory, U.S. Environmental Protection Agency, and approved for
publication. Approval does not signify that the contents necessarily
reflect the views and policies of the U.S. Environmental Protection Agency;
nor does mention of trade names or commercial products constitute
endorsement or recommendation for use.
ii
-------
FOREWORD
The Environmental Protection Agency was created because the public and
the federal government were increasingly concerned about the dangers of
pollution on the health and welfare of the American people. Noxious air,
foul water, and spoiled land are tragic testimonies to the deterioration of
our natural environment. The complexity of that environment and the inter-
play among its components require a concentrated and integrated attack on
the problem.
Research and development is that first step in problem solution, and
involves defining the problem, measuring its impact, and searching for
solutions. The Municipal Environmental Research Laboratory develops new
and improved technology and systems: 1) to prevent, treat, and manage
wastewater, solid and hazardous waste, and pollutant discharges from
municipal and community sources; 2) to preserve and treat public drinking
water supplies; and 3) to minimize the adverse economic, social, health,
and aesthetic effects of pollution. This publication is a product of that
research and is a most vital communications link between the researcher and
the user community.
The Safe Drinking Water Act of 1974 establishes primary health-
related standards and secondary aesthetic-related but nonenforceable
guidelines for drinking water supplies. These standards will bring about a
fundamental examination of the way water is handled before it is delivered
to the consumer. Many of these changes will have an economic impact on the
affected water utilities. This report describes a cost analysis system
that was developed to analyze a water utility's operating and maintenance
cost data. The cost analysis system provides the manager and other
interested parties with an insight into a water utility's performance, and
defines, by unique cost centers, those areas where costs can be monitored.
Volume I of this report outlines the background, development, and
application of the cost analysis system. Volume II provides the computer
program documentation developed to operate the system.
Francis T. Mayo
Director
Municipal Environmental Research Laboratory
iii
-------
ABSTRACT
The Environmental Protection Agency is concerned with the Safe
Drinking Water Act's economic impact on the water supply industry.
The Environmental Protection Agency initiated an ongoing program to gather
and examine cost data from utilities across the country on which to
establish a data base for water supply cost.
Experience has shown that although most utilities maintain an
accounting system, the data provided by the systems are maintained in
different formats and are therefore incompatible among utilities. Few
systems provide continuous and adequate cost information directly.
As a result of this effort, the Environmental Protection Agency and
many utility managers agree that there is a need for a cost analysis
system having features especially applicable to the water supply industry.
Based on the perceived need and because of the Act's emphasis on
economics, the Drinking Water Research Division initiated a research
program to develop standardized techniques for analyzing costs within a
utility accounting framework. This program is described in a two-volume
report. Volume I describes the development and functions of this system
and its application to Kenton County, Kentucky, Water District No. 1.
Volume II contains the programming documentation and operating
instructions for the cost analysis system.
This report is submitted by ACT Systems, Inc., in partial fulfillment
of Contract No. 68-03-2506, Section II, under the sponsorship of the U.S.
Environmental Protection Agency.
iv
-------
CONTENTS
Foreword ill
Abstract iv
Figures v
Acknowledgments vi
1. Introduction 1
2. Cost Analysis System Computer Operations 3
System Flow Diagrams 3
Computer Program Directory 3
System Operating Instructions 8
Routine Operating Sequence 41
3. Data Format 43
Keypunching Source Data 43
System File Layout 66
4. Program Flow Diagrams ..... 77
5. Program Listing 124
FIGURES
Number Page
1 Cost analysis system flow diagram 4
2 Cost data flow through the cost analysis system 7
-------
ACKNOWLEDGMENTS
The staff of Kenton County, Kentucky, Water District No. 1
participated in the development and implementation of the cost analysis
system described in this report. The cooperation and active support of
Mr. Victor C. Fender, General Manager, and Mr. Malvern Connett, Office
Manager, are gratefully acknowledged.
vi
-------
SECTION 1
INTRODUCTION
Volume I describes the water supply cost analysis system in detail
from concept to final report generation. Volume II explains the computer
operations and is intended to be used along with Volume I.
From its inception, the water supply cost analysis system was
designed to have broad applications to the water supply industry while
maintaining the capability of performing detailed checks of the input data
and handling that data to meet the specific needs of a utility. This adds
up to the requirement that the cost analysis system be both general and
specific at the same time. In addition, it was recognized that the
program must have the built-in capability to interface with many different
utilities each with a different operating configuration and financial
system.
Based on experience in examining the financial records of over 50
water utilities, it was also recognized that most utilities do not
identify cost to the level required by the cost analysis system, and it is
difficult to attempt a rapid change in the total accounting system of a
utility during the implementation of a cost analysis module. Therefore,
it was necessary to design, within the cost analysis system, flexible
inputs and the capability of allocating costs when they are not
specifically identified.
To accomplish the objectives of the cost analysis system, all cost
input information must come from the utility's financial documentation.
Since this information will vary from utility to utility, a concept was
established for developing interface programs unique to each utility.
These interface programs will accept the information in a specific utility
format and convert it to a standardized format. However, the cost
analysis system program cannot be entirely standard because each utility
maintains a different chart of accounts and cost centers. For this
reason, it is necessary to adjust the standard program to contain the
chart of accounts and the cost centers on a utility-by-utility basis.
Once this is accomplished, the program will handle all utilities in a
standard mode while producing reports compatible with each utility's
particular needs.
As described in Volume I, from a formatting standpoint, the principal
variation between reports of different utilities will be in the Level IV
and II reports which will reflect specific utility cost centers and chart
of accounts. Level I and III reports will appear exactly the same in
-------
format but will be produced with each utility's individual data.
The following sections of this report provide the details of the cost
analysis operating system.
-------
SECTION 2
COST ANALYSIS SYSTEM COMPUTER OPERATIONS
SYSTEM FLOW DIAGRAMS
Figure 1 (a,b,c) represents the overall routine monthly operating flow
diagram of the cost analysis system. In general, the cost analysis system
takes the source input data, verifies it, allocates or assigns it to the
proper cost centers, and produces the reports. There are actually fourteen
separate modules of programs performing the necessary functions of the
analysis and six modules performing the interface functions. The inter-
face programs receive the input data in various formats, edit the data for
validity, and condition the data for entry into the cost analysis system.
It is from these interface programs that reports are generated to link the
automated cost analysis system with the Kenton County Water District's
financial reporting system. The interface edit programs perform such
functions as verifying the validity of each account number to assure that it
is appropriate, monitoring each cost for correct designation to a cost
center, and allocating costs not assigned to proper cost centers. These
cost elements are stored in a large matrix from which each element is
withdrawn and utilized in the various reports. Figure 2 shows the types of
information input to the system, the flow, and application of that
information within the system. In addition, the figure includes a brief
description of the types of reports generated.
COMPUTER PROGRAM DIRECTORY
The purpose of this directory is to record the location of each program
within the Operating Instructions, Flow Diagrams, and Program Listings
Sections of this report so that each program may be analyzed individually in
its entirety.
The programs listed are in the order used to create the system and are
not necessarily in their routine operating order. That order is recorded in
the Routine Operating Sequence part of Section 2.
-------
<^2
INITI/
'AYROU
FILE
1
1
I
u.
—•^
>
\L
C
— -^
•~>
\L
CE
\CT
^
~>
KL
>
a.
;
>
LL
F-^
— *1
*~
--
1
!
j '
1
c
R
BUMS
HUM
I
i
UPPLE
ACCOUM
' REP
1
JST AC
'.PORT
DATA
iER WT
EDIT
-, t-^
1
-
ENTAL
TING
RTS
JOUNTI
PROGRA
3Y ACCJ
HUN E/
FILE
Jt
1
1
i
1
1
1
G
t
HJNT
CH
-
1
UPPLET
ACCOUN
REI
|
ENTAL
TING
URT
- - --
-
---
—
PAAC
MERGES EDIT
--FILES AND SUMS--
DATA BY
ACCOUNT NUMBER
1
1
1
1
I
T
^- —
—
j
j -
1
-
D
—
_ .
... _.
- --
Figure l(a). Cost analysis system routing operation flow diagram.
-------
INDIRECT
CHARGES
UNr
RFSOLVED
COST1ALLOCATION
PART;3
"WBASCAPV- --
1
Figure l(b)
-------
Figure l(c)
-------
DESCRIPTION Of MONTHLY
lUIST DATA SOURCES
oescumoN OF COST
T»ATA BANK WITHIN
Cost Analysis Svstem
DESCRIPTION OF REPORTS GENERATED BY Cost Analysis System
TOtAL COSTS
INCUKKril FOR PERIOD
SOUiTFS
OF COST DATA
\~{ I'AVHULI. I IKE CAMI>S
PAYROLL COSTS
RHJIMSiriON MOM
STOCK FORMS
PAYMTITT
AUTHORIZATION FORM
COST OF MATERIALS USED
FROM STOCK
DEPRECIATION
PURCHASES (•ROM OUTS IDC
SOURCES NOT TO STOCK
1MTCRFST PAID OR
INCURRED
M RVICF. CUNTHACT
FORM
MlbC. TRANSACTIONS
OK AnJUSTMENT FORM
n;
m
ABJUSTHKNTS OR
COKHECT1ONS OF EMRORS
COSTS TO BE
CAPITAI IZFD
TOTAL COSTS
TO U DISTI1BUTED
AID REPORTED
L
n
COSTS COVERED BY OTHt.R
REVENUE THAN BILLINGS
TO WATER CUSTOMERS
COSTS KEPORTFn BY COST CENTERS
LEVEL IV:
DETAIL BY NAHUC ACCOUNT
LEVEL 111-
SI'MMARt BY i,TD COST CATEGORY
LEVEL 1:
SUMMARY BY TOTAL COST AND UNIT
COST
COSTS REPORTED BY THE COST OF
REVENUE PRODUCING WATER
WATER SUPPLY DATA ANALYSIS REPORT
FUNCTIONAL COSTS AJID TOTAL
COST BY PRESSUKE ZONE
EXPRESSED AS A TOTAL AND AS A
UNIT COST PER MC REVENUE PRO-
DUCING WATER
COSTS REPORTED BY PERFORMANCE
TO SOME STANIMHLJ
LEVEL 11 :
ACTUAL TO BUDC.ET BY NARUC
ACCOUNT;
All UAL Til PRIOK YEAR BY STAN-
DARD COST UAIEUOKY;
LEVtL 1:
UNIT COSTS COMI'AKED TO PRIOR
MONTH AND PR ION YFAK,
UNIT COSTS BY FUNCTION COM-
PARED TO TOTAL UNIT COST;
SUMMARY TOTALS OF OIIIKH HI-
PORTb;
SUMMARY TOTALS OF COSTS BY
FUNCTION, BY MONTH, ANU UY
YEAR "*
Figure 2. Cost data flow through the cost analysis system.
-------
PROGRAM
SECTION 2
OPERATING
INSTRUCTIONS
Page No
SECTION 4
FLOW DIAGRAMS
Page No.
SECTION 5
PROGRAM LISTINGS
Page No.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
WUASBCCT
WUASBSAT
WUASBFAT
WUASBCRF
WUASBCMF
WUASBDPT
WUASBCDP
WUASSCER
WUASMTER
WUASPAER
WUASRSER
WUASPRER
WUASCARP
WUASPAAC
WUASCAP1
WUASCAP2
WUASCAP3
WUASUZFI
WUASCUPD
WUASPLV4
WUASPLV3
WUASPLV2
WUASPLV1
WUASPWAR
WUASBUCM
WUASUCAD
9
10
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
29
30
32
33
34
36
37
38
78
79
80
82
83
85
86
88
90
92
94
96
98
99
101
103
104
106
108
109
114
115
116
119
120
121
125
130
134
140
148
157
161
167
174
182
191
200
209
214
219
227
231
242
245
249
284
292
311
318
331
337
SYSTEM OPERATING INSTRUCTIONS
The purpose of this part of the report is to provide a general
description of each program and give specific keypunching and system
operating instructions. All routine listings should normally be printed
on one-part paper; however, the number of report copies should be deter-
mined by the utility's requirements.
Operating instructions for each program begin with an objective or
definition, and then the instructions are broken down into keypunching
and operation instructions.
By following these instructions, the cost analysis system can be
operated successfully. If a variation in procedure is encountered, contact
the System Programmer.
-------
"WUASBCCT"
OBJECTIVE: THIS PROGRAM CREATES A FILE THAT CONTAINS ALL THE VALID
COST CENTERS AND THEIR DESCRIPTIONS USED IN THE COST
ANALYSIS SYSTEM.
(A) KEY PUNCH:
OPERATING INSTRUCTIONS
THE FOLLOWING INPUT DATA ARE REQUIRED: (see section 3)
(1). ONE DATE-TITLE CARD.
(2). DATA USED TO BUILD THE COST CENTER TABLE FILE.
(B) OPERATION:
PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE THE DATE-TITLE CARD FOLLOWED BY THE COST
CENTERS DATA BEHIND THE "//SYSIN DD *" CARD IN THE
"WUASBCCT" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER LISTING THE DATA
FILE.
(4). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
-------
"WUASBSAT"
OBJECTIVE: THIS PROGRAM IS USED TO CREATE SPECIAL TABLE FILES THAT ARE
USED THROUGHOUT THE COST ANALYSIS SYSTEM TO VERIFY OR
REFERENCE CERTAIN DATA. CURRENTLY, THERE ARE THREE FILES
THAT ARE CREATED BY THIS PROGRAM.
(1). BSAT.CCC COST CENTER CONVERSION:
USED TO CONVERT TWO-DIGIT COST CENTERS TO
FOUR-DIGIT COST CENTERS.
(2). BSAT.CCT COST CATEGORY TABLE:
USED TO VERIFY THE EXISTENCE OF A VALID
COST CATEGORY AND THE NAME OF THE
CATEGORY.
(3). BSAT.FAT FUND TITLE TABLE:
USED TO VERIFY AND PROVIDE VALID
FUND TITLES REQUIRED IN THE (CMF)
BUILDING PROGRAM WUASBCMF.
(A) KEY PUNCH:
OPERATING INSTRUCTIONS
THE FOLLOWING INPUT DATA ARE REQUIRED: (see section 3)
(1). ONE DATE-TITLE CARD.
(2). DATA USED TO BUILD THE SPECIFIC FILE.
10
-------
"WUASBSAT" (continued)
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE THE DATE-TITLE CARD FOLLOWED BY THE
SPECIFIC FILE DATA BEHIND THE "//SYSIN DD *" CARD
IN THE "WUASBSAT" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER LISTING THE FILE.
(4). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
11
-------
"WUASBFAT"
OBJECTIVE: THIS PROGRAM CREATES A FILE THAT IS USED IN BUILDING THE COST
MATRIX FILE AND THE CROSS REFERENCE FILE. IN ADDITION, IT IS
USED TO VERIFY THE EXISTENCE OF VALID ACCOUNT NUMBERS IN THE
ANALYSIS SYSTEM. THIS FILE CONTAINS THE ACCOUNT NAME IN TWO
(2) 20-CHARACTER FIELDS.
(A) KEY PUNCH:
OPERATING INSTRUCTIONS
THE FOLLOWING INPUT DATA ARE REQUIRED: (see section 3)
(1). ONE DATE-TITLE CARD.
(2). DATA USED TO BUILD THE FINANCIAL ACCOUNT TABLE
FILE.
(B) OPERATION:
PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE THE DATE-TITLE CARD FOLLOWED BY THE FINANCIAL
DATA BEHIND THE "//SYSIN DD *" CARD IN THE "WUASBFAT"
JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER LISTING THE FINANCIAL
ACCOUNT TABLE FILE.
(4). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
12
-------
"WUASBCRF"
OBJECTIVE: THIS PROGRAM CREATES A FILE THAT IS USED TO ALLOCATE
COSTS TO COST CENTERS. IN ADDITION, THIS FILE IS USED BY
THE "WUASBCMF" PROGRAM TO CREATE THE COST MATRIX FILE.
(A) KEY PUNCH:
OPERATING INSTRUCTIONS
THE FOLLOWING INPUT DATA ARE REQUIRED: (see section 3)
(1). ONE DATE-TITLE CARD.
(2). CROSS REFERENCE DATA NEEDED TO CREATE THE CROSS
REFERENCE FILE (CRF).
(B) OPERATION:
PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE THE DATE-TITLE CARD FOLLOWED BY THE CRF DATA
BEHIND THE "//SYSIN DD *" CARD IN THE "WUASBCRF"
JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER LISTING THE CROSS
REFERENCE FILE.
(4). THIS PROGRAM CAN BE RUN AS MANY TIMES AS REQUIRED BUT
SHOULD ONLY HAVE TO BE RERUN WHEN NEW ACCOUNT NUMBERS
AND/OR NEW COST CENTERS ARE ADDED TO THE COST
ANALYSIS SYSTEM.
13
-------
"WUASBCMF"
OBJECTIVE: THIS PROGRAM CREATES THE COST MATRIX FILE. GENERALLY, THIS
PROGRAM SHOULD BE USED ONLY ONCE TO INITIATE THE FILE.
HOWEVER, IF THE FILE IS DELETED, THE ORIGINAL FILE CAN BE RE-
CREATED AND UPDATED FROM THE MOST CURRENT BACKUP TAPE USING
PROGRAM "WUASUCAD".
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see section 3)
(1). DATE-TITLE CARD.
(2). REQUIRES NO DATA CARD INPUT.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). NOTE: MAKE SURE THE PROGRAM "WUASBCRF" IS
SUCCESSFULLY COMPLETED PRIOR TO RUNNING THIS JOB
BECAUSE THE FILE BUILT IN THAT PROGRAM IS USED TO
CREATE THIS FILE.
(2). PLACE THE DATE-TITLE CARD BEHIND THE "//SYSIN DD *"
CARD IN THE "WUASBCMF" JCL DECK.
(3). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(4). OUTPUT WILL BE ON ONE-PART PAPER.
(5). LISTING WILL SHOW WHAT THE FILE CONTAINS.
(6). THIS PROGRAM CAN BE RUN AS MANY TIMES AS REQUIRED.
14
-------
"WUASBDPT"
OBJECTIVE: THIS PROGRAM IS USED TO CREATE A TABLE FILE OF THE YEARLY
DEPRECIATION AMOUNTS ASSIGNED TO VARIOUS COST CENTERS. THE
TABLE FILE WILL THEN BE USED IN THE PROGRAM "WUASBCDP" WHICH
CONVERTS THE YEARLY DEPRECIATION AMOUNTS INTO A CURRENT
DEPRECIATION AMOUNT.
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). DATA FOR BUILDING THE DEPRECIATION TABLE.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE THE DATE-TITLE CARD FOLLOWED BY THE
DEPRECIATION AMOUNTS BEHIND THE "//SYSIN DD *" CARD
IN THE "WUASBDPT" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER LISTING THE
THE DEPRECIATION AMOUNTS.
(4). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED
BUT IS USUALLY RUN ONCE OR UNTIL A COST CENTER
DEPRECIATION VALUE CHANGES.
15
-------
"WUASBCDP"
OBJECTIVE: THE PURPOSE OF THIS PROGRAM IS TO READ THE FILE WHICH
CONTAINS THE YEARLY DEPRECIATION COSTS BY COST CENTERS
THEN CALCULATE THE CURRENT PERIOD DEPRECIATION VALUES
(MONTHLY, QUARTERLY, ETC.).
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE SPECIAL DATE-TITLE CARD.
(2). REQUIRES NO DATA CARD INPUT.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE DATE-TITLE CARD BEHIND THE "//SYSIN DD *"
CARD IN THE "WUASBCDP" JCL DECK.
(2). PUT DECK IN CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER.
(4). THIS PROGRAM MAY BE RUN AS MANY TIMES AS
REQUIRED.
16
-------
"WUASSCER"
OBJECTIVE: THE PURPOSE OF THIS PROGRAM IS TO READ AND EDIT THE
SERVICE CONTRACT SOURCE DATA CARDS. THIS PROGRAM BUILDS
A DATA FILE USED IN THE COST ANALYSIS SYSTEM.
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). DATA FROM SERVICE CONTRACT SOURCE DOCUMENTS SHOULD
BE PUNCHED AND VERIFIED.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE DATE-TITLE CARD FOLLOWED BY THE SERVICE
CONTRACT DATA BEHIND THE "//SYSIN DD *" CARD IN THE
"WUASSCER" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER.
(4). UNDER THE COMMENT COLUMN OF THE LISTING, DESCRIPTIVE
COMMENTS WILL BE PRINTED CONCERNING ERROR(S) FOUND IN
THE DATA.
(5). IF ANY ERRORS WERE DETECTED, CORRECT THEM AND GO BACK
TO (1).
(6). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
17
-------
"WUASMTER"
OBJECTIVE: THE PURPOSE OF THIS PROGRAM IS TO READ AND EDIT THE
MISCELLANEOUS TRANSACTIONS SOURCE DATA CARDS. THIS
PROGRAM BUILDS A DATA FILE USED IN THE COST ANALYSIS
SYSTEM.
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). DATA FROM MISCELLANEOUS TRANSACTIONS SOURCE DOCUMENTS
SHOULD BE PUNCHED AND VERIFIED.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE DATE-TITLE CARD FOLLOWED BY THE MISCELLANEOUS
TRANSACTIONS DATA BEHIND THE "//SYSIN DD *" CARD IN
THE "WUASMTER" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER.
(4). UNDER THE COMMENT COLUMN OF THE LISTING, DESCRIPTIVE
COMMENTS WILL BE PRINTED CONCERNING ERROR(S) FOUND IN
THE DATA.
(5). IF ANY ERRORS WERE DETECTED, CORRECT THEM AND GO BACK
TO (1).
(6). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
18
-------
"WUASPAER"
OBJECTIVE: THE PURPOSE OF THIS PROGRAM IS TO READ AND EDIT THE PAYMENT
AUTHORIZATIONS SOURCE DATA CARDS. THIS PROGRAM BUILDS A
DATA FILE USED IN THE COST ANALYSIS SYSTEM.
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). DATA FROM PAYMENT AUTHORIZATION SOURCE DOCUMENTS
SHOULD BE PUNCHED AND VERIFIED.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE DATE-TITLE CARD FOLLOWED BY THE PAYMENT
AUTHORIZATION DATA BEHIND THE "//SYSIN DD *" CARD IN
THE "WUASPAER" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER.
(4). UNDER THE COMMENT COLUMN OF THE LISTING, DESCRIPTIVE
COMMENTS WILL BE PRINTED CONCERNING ERROR(S) FOUND IN
THE DATA.
(5). IF ANY ERROR(S) WERE DETECTED, CORRECT THEM AND GO BACK
TO (1).
(6). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
19
-------
"WUASRSER"
OBJECTIVE: THE PURPOSE OF THIS PROGRAM IS TO READ AND EDIT THE
REQUISITION FROM STOCK SOURCE DATA CARDS. THIS PROGRAM
BUILDS A DATA FILE USED IN THE COST ANALYSIS SYSTEM.
(A) KEY PUNCH:
OPERATING INSTRUCTIONS
THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). DATA FROM STOCK REQUISITION SOURCE DOCUMENTS
SHOULD BE PUNCHED AND VERIFIED.
(B) OPERATION:
PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE DATE-TITLE CARD FOLLOWED BY THE REQUISITION
FROM STOCK DATA BEHIND THE "//SYSIN DD *" CARD IN
THE "WUASPRSER" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER.
(4). UNDER THE COMMENT COLUMN OF THE LISTING, DESCRIPTIVE
COMMENTS WILL BE PRINTED CONCERNING ERROR(S) FOUND
IN THE DATA.
(5). IF ANY ERROR(S) WERE DETECTED, CORRECT THEM AND GO
BACK TO (1).
(6). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
20
-------
"WUASPRER"
OBJECTIVE: THE PURPOSE OF THIS PROGRAM IS TO READ AND EDIT THE PAYROLL
SOURCE DATA CARDS. THIS PROGRAM BUILDS A DATA FILE USED
IN THE COST ANALYSIS SYSTEM.
(A) KEY PUNCH:
OPERATING INSTRUCTIONS
THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). DATA FROM PAYROLL SOURCE DOCUMENTS SHOULD BE
PUNCHED AND VERIFIED.
(B) OPERATION:
PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE DATE-TITLE CARD FOLLOWED BY THE PAYROLL DATA
BEHIND THE "//SYSIN DD *" CARD IN THE "WUASPRER"
JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER.
(4). UNDER THE COMMENT COLUMN OF THE LISTING, DESCRIPTIVE
COMMENTS WILL BE PRINTED CONCERNING ERROR(S) FOUND
IN THE DATA.
(5). IF ANY ERROR(S) WERE DETECTED, CORRECT THEM AND GO
BACK TO (1).
(6). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
21
-------
"WUASCARP"
OBJECTIVE: THE PURPOSE OF THIS PROGRAM IS TO READ THE FILES CREATED
BY THE INITIAL EDIT PROGRAMS AND THEN LIST THE COST BY
ACCOUNT NUMBER WITHIN TYPE OF DATA (PAYROLL, SERVICE
CONTRACT, ETC.).
OPERATING INSTRUCTIONS
(A) KEY PUNCH: REQUIRE NO DATE-TITLE OR DATA CARD INPUT.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PUT THE "WUASCARP" JCL DECK IN THE CARD READER
AND READ THE DECK.
(2). OUTPUT SHOULD BE ON MULTI-PART PAPER DEPENDING
ON THE NUMBER OF REQUIRED COPIES.
(3). UNDER THE COMMENT COLUMN OF THE LISTING,
DESCRIPTIVE COMMENTS WILL BE PRINTED INDICATING
ERROR(S) FOUND IN THE DATA.
(4). IF ERRORS ARE DETECTED, THE CORRECTIONS MUST BE
MADE TO THE INITIAL INPUT DATA. THE APPROPRIATE
EDIT PROGRAM MUST THEN BE RERUN.
(5). THIS PROGRAM MAY BE RUN AS MANY TIMES AS
REQUIRED.
22
-------
"WUASPAAC"
OBJECTIVE: THE PURPOSE OF THIS PROGRAM IS TO SUM, WITHIN ACCOUNT
NUMBER ORDER, THE INPUT DATA FILES CREATED BY THE INITIAL
EDIT PROGRAMS.
(A) KEY PUNCH:
OPERATING INSTRUCTIONS
THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). REQUIRES NO DATA CARD INPUT.
(B) OPERATION:
PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE DATE-TITLE CARD BEHIND THE "//SYSIN DD *" CARD
IN THE "WUASPAAC" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT CAN BE ON MULTI-PART PAPER.
(4). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
23
-------
"WUASCAP1"
OBJECTIVE: THE PURPOSE OF THIS PROGRAM IS TO READ THE FILES CREATED BY
THE INITIAL EDIT PROGRAMS AND MERGE THESE FILES INTO TWO
FILES; ONE FILE CONTAINING RECORDS OF DIRECT COST CENTERS
AND CHARGES, AND THE OTHER FILE CONTAINING THE INDIRECT
CHARGES.
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). REQUIRES NO DATE-TITLE CARD INPUT.
(2). ONE UTILITY DESCRIPTION CARD. (UTILITY NAME OR NUMBER.)
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE UTILITY DESCRIPTION CARD BEHIND THE "//SYSIN
DD *" CARD IN THE "WUASCAP1" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER.
(4). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
24
-------
"WUASCAP2"
OBJECTIVE: THE PURPOSE OF THIS PROGRAM IS TO READ THE DIRECT CHARGES
FILE (RESOLVED COSTS) CREATED BY THE "WUASCAP1" PROGRAM,
SUM WITHIN COST CENTERS, AND CREATE A FILE THAT CONTAINS
THE TOTAL AMOUNT CHARGED TO THE COST CENTERS.
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). REQUIRES NO DATA CARD INPUT.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE DATE-TITLE CARD FOLLOWING THE "//SYSIN DD *"
CARD IN THE "WUASCAP2" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER.
(4). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
25
-------
"WUASCAP3"
OBJECTIVE: THE PURPOSE OF THIS PROGRAM IS TO READ THE FILE CREATED BY
THE "WUASCAP2" PROGRAM AND, USING A PREDETERMINED ALLOCA-
TION METHOD, DETERMINE THE PERCENTAGES ASSOCIATED WITH EACH
COST CENTER. WHEN THE RATIO OF DIRECT CHARGES TO TOTAL
CHARGES IS DETERMINED, THE NON-DIRECT COST CREATED IN THE
"WUASCAP1" PROGRAM ARE ALLOCATED TO COST CENTERS. THE NEW
RECORDS ARE THEN ADDED TO THE RESOLVED COST CENTERS FILE
CREATED IN "WUASCAP1".
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). REQUIRES NO DATA CARD INPUT.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE DATE-TITLE CARD FOLLOWING THE "//SYSIN DD *"
CARD IN THE "WUASCAP2" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER.
(4). THIS PROGRAM MAY NOT BE RERUN. IF PROGRAM IS NOT
COMPLETED, YOU MUST START OVER AGAIN AT THE
"WUASCAP1" LEVEL.
DO NOT RERUN THIS PROGRAM.
26
-------
"WUASUZFI"
OBJECTIVE: THE PURPOSE OF THIS PROGRAM IS TO ADJUST OR ELIMINATE COST BY
ACCOUNT NUMBER IN CERTAIN DATA FIELDS THROUGHOUT THE COST MAT-
RIX FILE (CMF). THIS PROGRAM MOVES THE CURRENT PERIOD'S COST
TO THE PREVIOUS PERIOD'S COST FIELDS AND THEN ZEROS THE CUR-
RENT PERIOD'S COST FIELD. THE PROGRAM CAN ALSO MAKE OTHER
CHANGES TO THE (CMF) BY USING ONE OF THE FOLLOWING OPTION
CARDS:
(1) BY INCLUDING A "PHYSICAL" OPTION CARD, IN ADDITION TO
ACCOMPLISHING THE ABOVE ADJUSTMENT, THE CURRENT YEAR-
TO-DATE COST WILL BE MOVED TO THE PREVIOUS YEAR-TO-DATE
COST FIELDS AND THEN THE CURRENT YEAR-TO-DATE COST FIELDS
ARE ZEROED.
(2) BY INCLUDING A "ZERO" OPTION CARD, ALL THE COST DATA
FIELDS WILL BE ZEROED. (SHOULD BE USED NORMALLY FOR
INITIAL SYSTEM TESTING PERIOD).
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED. (see Section 3)
(1) NO DATE-TITLE CARD IS NEEDED.
(2) FOR "PHYSICAL" OPTION—PUNCH THE WORD "PHYSICAL" IN
THE FIRST SEVEN POSITIONS OF THE DATA CARD.
(3) FOR "ZERO" OPTION—PUNCH THE WORD "ZERO" IN THE
FIRST FOUR POSITIONS OF THE DATA CARD.
27
-------
"WUASUZFI" (continued)
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
NOTE; USE CARE WHEN RUNNING THIS JOB, AS FILE COULD BE
ERASED IN ERROR. THIS JOB MUST BE RUN PRIOR TO RUNNING
THE PROGRAM "WUASCUPD" WHICH IS THE UPDATE UTILITY
PROGRAM.
(1). IF USING AN OPTION CARD, PLACE THE OPTION CARD
AFTER THE "//SYSIN DD *" CARD IN THE "WUZSUZFI" JCL
DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON ONE-PART PAPER. ONLY A MESSAGE
WILL BE PRINTED STATING WHAT TYPE OF OPTION WAS USED
AND IF IT WAS COMPLETED.
(4). DO NOT RERUN THIS JOB...IF JOB SHOULD NOT BE
COMPLETED OR THE WRONG OPTION WAS USED, THE FILE
WILL HAVE TO BE REBUILT.
28
-------
"WUASCUPD"
OBJECTIVE: THE PURPOSE OF THIS PROGRAM IS TO UPDATE THE COST MATRIX
FILE (CMF) WITH CURRENT VALUES USING THE DIRECT CHARGES FILE
CREATED BY THE "WUASCAP3" PROGRAM.
OPERATING INSTRUCTIONS
(A) KEY PUNCH: REQUIRES NO DATE-TITLE OR DATA CARD(S) INPUT.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
NOTE; MAKE SURE PROGRAM "WUASUZFI" WAS EXECUTED PRIOR TO
BEGINNING THIS JOB.
(1). PLACE THE "WUASCUPD" JCL DECK IN THE CARD READER AND
READ THE DECK.
(2). OUTPUT CONSISTING OF A MESSAGE INFORMING THE OPERATOR
THAT THE COST MATRIX FILE HAD BEEN UPDATED WILL BE ON
ONE-PART PAPER.
(3). DO NOT RERUN THIS JOB. IF JOB ABORTS, CONTACT PRO-
GRAMMER OR DATA BASE MANAGER BEFORE ATTEMPTING FURTHER
ACTION.
29
-------
"WUASPLV4"
OBJECTIVE: THIS LEVEL 4 REPORT PROGRAM IS BROKEN DOWN INTO THE FOLLOWING
FOUR SEPARATE PROGRAMS: "WUASLV41", "WUASLV42", "WUASLV43",
AND "WUASLV44". THE PROGRAM READS THE COST MATRIX FILE AND
PRODUCES A LISTING OF THE COSTS BY ACCOUNT NUMBERS WITHIN COST
CENTERS.
THE "WUASLV41" PROGRAM LISTS ALL COSTS PERTAINING TO THE
ACQUISITION FUNCTION.
THE "WUASLV42" PROGRAM LISTS ALL COSTS PERTAINING TO THE
TREATMENT FUNCTION.
THE "WUASLV43" PROGRAM LISTS ALL COSTS PERTAINING TO THE
DELIVERY FUNCTION.
THE "WUASLV44" PROGRAM LISTS ALL COSTS PERTAINING TO THE
SUPPORT SERVICE FUNCTION.
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD IS NEEDED FOR EACH PROGRAM.
(2). REQUIRES NO DATA CARD INPUT.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE DATE-TITLE CARDS IN THE "WUASLV41",
"WUASLV42", "WUASLV43", AND "WUASLV44" JCL DECKS.
30
-------
"WUASPLV4" (continued)
(2). PUT THE DECKS IN THE CARD READER AND READ THE DECKS.
(3). OUTPUT WILL BE ON MULTI-PART PAPER DEPENDING UPON
THE NUMBER OF REQUIRED COPIES.
(4). THESE PROGRAMS MAY BE RUN AS MANY TIMES AS REQUIRED.
31
-------
"WUASPLV3"
OBJECTIVE: THIS LEVEL 3 REPORT PROGRAM READS THE COST MATRIX FILE, THEN
SUMS THE CURRENT COSTS AND YTD COST BY COST CATEGORIES WITHIN
FUNCTIONS OF ACQUISITION, TREATMENT, DELIVERY, SUPPORT SERVICES,
TAXES, AND INTEREST.
(A) KEY PUNCH:
OPERATING INSTRUCTIONS
THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). REQUIRES NO DATA CARD INPUT.
(B) OPERATION:
PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE DATE-TITLE CARD BEHIND THE "//SYSIN DD *" CARD
IN THE "WUASPLV3" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON MULTI-PART PAPER DEPENDING UPON THE
NUMBER OF COPIES REQUIRED.
(4). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
32
-------
"WUASPLV2"
OBJECTIVE: THIS LEVEL 2 REPORT PROGRAM READS THE COST MATRIX FILE AND
PRODUCES A TWO-PART LISTING. THE FIRST PART IS A COST
COMPARISON OF THE ACTUAL COSTS TO THE BUDGET BY ACCOUNT
NUMBERS. THE SECOND PART IS A COST COMPARISON OF ACTUAL
COSTS TO THE PREVIOUS YEAR'S COST.
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). REQUIRES NO DATA CARD INPUT.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE DATE-TITLE CARD BEHIND THE "//SYSIN DD *" CARD
IN THE "WUASPLV2" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON MULTI-PART PAPER DEPENDING UPON THE
NUMBER OF COPIES REQUIRED.
(4). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
33
-------
"WUASPLV1"
OBJECTIVE: THIS LEVEL 1 REPORT PROGRAM READS THE COST MATRIX FILE, THEN
SUMS THE CURRENT COSTS AND YTD COSTS BY COST CATEGORIES WITHIN
FUNCTIONS OF ACQUISITION, TREATMENT, DELIVERY, SUPPORT SERVICES,
TAXES AND INTEREST. THIS PROGRAM USES THESE VALUES TO PRODUCE
A LIST OF THE COSTS IN TERMS OF WATER PRODUCTION UNITS.
(USUALLY THE UNIT IS IN MILLIONS OF GALLONS.)
OPERATING INSTRUCTIONS:
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). ONE DATA CARD CONTAINING THE AMOUNT OF WATER USED
FOR THE PREVIOUS MONTH IS NEEDED.
(3). ONE DATA CARD CONTAINING THE AMOUNT OF WATER USED
FOR THE CURRENT MONTH IS NEEDED.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
NOTE; THIS PROGRAM CANNOT BE RUN UNTIL LEVEL 2 REPORT HAS
BEEN SUCCESSFULLY COMPLETED SINCE PART OF THE DATA
FOR THIS PROGRAM IS TAKEN FROM LEVEL 2 (DATA TAKEN
FROM LEVEL 2 = ACTUAL TO BUDGET PERCENT).
(1). PLACE THE DATE-TITLE CARD FOLLOWED BY THE PREVIOUS
MONTH WATER CARD AND THE CURRENT MONTH WATER CARD
BEHIND THE "//SYSIN DD *" CARD IN THE "WUASPLV1" JCL
DECK.
34
-------
"WUASPLV1" (continued)
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUTPUT WILL BE ON MULTI-PART PAPER DEPENDING UPON THE
NUMBER OF COPIES REQUIRED.
(4). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
35
-------
"WUASPWAR"
OBJECTIVE: THIS WATER SUPPLY DATA ANALYSIS PROGRAM READS THE COST MATRIX
FILE, ANALYZES THE COST ASSOCIATED WITH WATER PRODUCTION
WITHIN VARIOUS ZONES IN THE WATER UTILITY SYSTEM, AND THEN
PRINTS A REPORT.
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). ONE CURRENT ZONE-USAGE DATA CARD.
(3). ONE YTD ZONE-USAGE DATA CARD.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE DATE-TITLE CARD FOLLOWED BY THE CURRENT AND
YTD DATA CARDS BEHIND THE "//SYSIN DD *" CARD IN
THE "WUASPCAR" JCL DECK.
(2). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(3). OUPUT WILL BE PRINTED ON MULTI-PART PAPER DEPENDING
UPON THE NUMBER OF REQUIRED COPIES.
(4). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
36
-------
"WUASBUCM"
OBJECTIVE: THIS PROGRAM IS USED TO LIST AND/OR BACK UP THE COST MATRIX
FILE (CMF) ONTO A TAPE FILE. THE PROGRAM WILL NORMALLY PRODUCE
A LISTING OF THE DATA ON THE CMF, HOWEVER, BY INSERTING AN
OPTION CARD THE FILE WILL BE ALSO BACKED UP ON TAPE.
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). ONE OPTION CARD CONTAINING THE WORD "BACK-UP" IN THE
FIRST SEVEN POSITIONS OF THE CARD IF ACTUAL BACK-UP
IS TO TAKE PLACE. OTHERWISE, NO OPTION CARD REQUIRED.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
(1). PLACE THE DATE-TITLE CARD FOLLOWING THE "//SYSIN DD *'
CARD IN THE "WUASBUCM" JCL DECK.
(2). OPTION; IF COST MATRIX FILE IS TO BE BACKED UP ON
TAPE THEN PLACE THE OPTION CARD AFTER THE DATE-TITLE
CARD.
(3). PUT THE DECK IN THE CARD READER AND READ THE DECK.
(4). OUTPUT WILL BE ON ONE-PART PAPER.
(5). THIS PROGRAM MAY BE RUN AS MANY TIMES AS REQUIRED.
37
-------
"WUASUCAD"
OBJECTIVE: THIS PROGRAM IS USED FOR MAKING CHANGES, ADDITIONS, AND/OR
DELETIONS TO RECORDS IN THE COST MATRIX FILE (CMF). IN
ADDITION, THE (CMF) MAY BE RE-CREATED FROM A (CMF) BACKUP TAPE.
OPERATING INSTRUCTIONS
(A) KEY PUNCH: THE FOLLOWING INPUT DATA ARE REQUIRED: (see Section 3)
(1). ONE DATE-TITLE CARD.
(2). ONE OPTION CARD WITH THE WORD '****UPDATE' IN THE
FIRST 10 POSITIONS OF THE CARD.
(3). DATA FOR MAKING CHANGES, ADDITIONS, AND/OR DELETIONS.
DATA RECORDS (CARDS) MUST BE IN THE EXACT IMAGE OF THE
COST MATRIX FILE RECORDS.
(B) OPERATION: PROGRAM OPERATION/INFORMATION IS AS FOLLOWS:
NOTE: BY LEAVING OUT THE '****UPDATE' CARD, THE FILE WILL
NOT BE PHYSICALLY CHANGED. ONLY A SIMULATION OF UPDATING
WILL TAKE PLACE. THIS WILL ALLOW FOR A TEST RUN ON LARGE
AMOUNTS OF DATA TO REVIEW CHANGES.
THERE ARE TWO (2) DIFFERENT OPERATING PROCEDURES
AVAILABLE TO BE USED IN THIS PROGRAM, AS DESCRIBED BELOW.
(1) CHANGING, ADDING, DELETING PROCEDURE.
IN ORDER TO CHANGE A RECORD, THE ACCOUNT NUMBER, COST CENTER,
38
-------
"WUASUCAD" (continued)
AND COST CATEGORY FIELDS MUST BE IDENTICAL TO THOSE OF THE
RECORD BEING CHANGED. IF THESE KEY FIELDS ARE INVALID OR
CANNOT BE LOCATED WITHIN THE COST MATRIX FILE, THE CHANGE
WILL BE CONSIDERED A NEW RECORD AND WILL BE ADDED TO THE
EXISTING FILE. EACH AMOUNT FIELD MUST CONTAIN A VALUE,
OTHERWISE, IF LEFT BLANK, THE FIELD WILL BE ZEROED.
IN ORDER TO ADD A NEW RECORD, THE ACCOUNT NUMBER, COST
CENTER, AND COST CATEGORY FIELDS MUST BE COMPLETED. THE
AMOUNT FIELDS SHOULD CONTAIN WHATEVER VALUES ARE REQUIRED.
IN ADDITION, THE NEW RECORD MUST INCLUDE A UNIQUE MATCH CODE
IN ORDER TO POSITION THE INFORMATION WITHIN THE OUTPUT
REPORTS.
IN ORDER TO DELETE AN EXISTING RECORD, THE ACCOUNT NUMBER,
COST CENTER, AND COST CATEGORY FIELDS MUST BE IDENTICAL TO
THOSE OF THE RECORD BEING DELETED. ALL OTHER FIELDS MUST
BE BLANK.
TO OPERATE THE CHANGE, ADD, OR DELETE PROGRAM:
(a) PLACE THE DATE-TITLE AND THEN THE OPTION CARD, IF USED,
FOLLOWED BY THE DATA CARDS BEHIND THE "//SYSIN DD *" CARD
IN THE "WUASUCAD" JCL DECK.
(b) PUT THE DECK IN THE CARD READER AND READ THE DECK.
39
-------
"WUASUCAD" (continued)
(c) OUTPUT WILL BE ON ONE-PART PAPER LISTING ALL CHANGES, ADDS, OR
DELETES. A COMMENT WILL STATE WHAT ACTION WAS TAKEN FOR EACH
RECORD (i.e. RECORD CHANGED, ADDED, OR DELETED). IN ADDITION
AT THE END OF THE LISTING, A COUNT OF ALL CHANGES WILL BE BE
PRINTED.
(d) THIS JOB CAN BE RERUN, BUT USE CARE AS THE COST MATRIX FILE
CAN BE DRASTICALLY CHANGED.
(2) THE PROCEDURE FOR RECREATING THE (CMF) FROM (CMF) BACKUP TAPE.
NO DATA CARDS ARE USED IN THIS PROGRAM—ONLY THE DATE-TITLE, OPTION
CARD, AND THE (CMF) BACKUP FILE. TO OPERATE THE RECREATING PROGRAM:
(a). PLACE THE DATE-TITLE CARD FOLLOWED BY THE OPTION CARD BEHIND THE
"//SYSIN DD *" CARD IN THE "WUASUCAD" JCL DECK.
(b) PUT THE DECK IN THE CARD READER AND READ THE DECK.
(c) OUTPUT WILL BE ON ONE-PART PAPER, LISTING ALL THE RECORDS THAT
WERE RECREATED.
(d) THIS JOB CAN BE RERUN IF REQUIRED.
40
-------
ROUTINE OPERATING SEQUENCE
The following routine operating sequence should normally be followed
unless otherwise stated in the special operating instructions. In
operating the cost analysis system, it is important to note that each
program instruction must be understood and that certain procedures be
completed prior to performing the subsequent operational functions.
(A) Initial Edits - WUASPRER (Payroll), WUASRSER (Requisition from
Stock), WUASPAER (Payment Authorization), WUASSCER (Service
Contract), WUASMTER (Miscellaneous Transactions), and WUASBCDP
(Depreciation).
Special Instructions:
(1) The WUASBCDP (Depreciation) program needs to be run only
once until the depreciation values change.
(2) All other edit programs must be run even if current data is
not supplied.
(3) The edit programs may be run in any order.
(B) Cost Allocation - WUASCAP1 (1st Allocation Program), WUASCAP2
(2nd Allocation Program); and WUASCAP3 (3rd Allocation Program).
(C) Updating Cost Matrix File - WUASUZFI (Zero File) and WUASCUPD
(Update File).
Special Instructions:
(1) Each program must be run in the order listed.
(2) Do not re-run these programs without consulting with
Systems Programmer.
(D) Print Output Reports - WUASLV41, WUASLV42, WUASLV43, WUASLV44
(Level 4 Reports); WUASPLV3 (Level 3 Report); WUASPLV2 (Level 2
Report); WUASPLV1 (Level 1 Report); and WUASPWAR (Water Supply
Data Analysis Report).
Special Instructions;
(1) Programs may be run in any order, except WUASPLV1; because
this program needs data from WUASPLV2.
(2) Programs may be run as many times as required.
(E) Back-Up Cost Matrix File - WUASBUCM (Back-Up file).
41
-------
Special Instructions:
(1) Program may be run as many times as required.
(2) To produce a current listing of the Cost Matrix File only,
run program WUASBUCM without "Back-Up" option card.
(3) To back-up the Cost Matrix File and then produce a listing
run program WUASBUCM, with "Back-Up" option card.
42
-------
SECTION 3
DATA FORMAT
KEYPUNCHING SOURCE DATA
The keypunch format is provided to describe the card image layout of
all input data. This keypunch format should be used by the keypunch
operator in setting-up drum cards and keypunching the data onto an
80-column card. Any variation in these formats should be discussed with
the Systems Programmer.
43
-------
PUNCHING
NAME WUASBCCT
PROGRAM CARD NO.
TYPE OF CARDS 80 COLUMN
FIELD
1 NO,
1
2
3
FIELD NAME
COST CENTER
BLANK
CC NAME 1
iSLANK
CC NAME 2
BLANK
COLUMNS
FROM
1
s
6
19
20
33
THRU
4
q
1 8
19
32
80
OR VERIFICATION
SOURCE DOCUME
SOURCE
NO, OF
COLUMNS
4
1
13
1
13
48
INSTRUCTIONS
SHFFT NO. 1 OF 1
SJJ BUILD COST CENTER TABLE
DFPT. JOB NO.
TYPE
N
X
X
X
A
X
X
CO
n
—)
LJ
T,.T
REMARKS AND INSTRUCTIONS
DESCRIPTION OF COST CF.NTF.R
DESCRIPTION DTT rngT r'ENTEP
-------
PUN(
NAME WUASBSAT (".CCC"f ".CCT", '
PROGRAM CARD NO,
TYPE OF CARDS 80 COLUMN
FIELD
NO.
1
2
FIELD NAME
SPECIAL AOCT. NO
BLANK
SPECIAL ACCT. NA
RT.ANK
:HING OR VERIF
'.FAT")
SOURC
SOURC
COLUMNS
FROM
1
3
IE 4
24
THRU
2
23
80
NO. OF
COLUMNS
?
1
20
57
I CAT I ON
E DOCUME
E
INSTRUCTIONS
SHEET NO. 1 OF 1
NT BUILDING SPECIAL ACCT. TABLES
DFPT. JOB NO,
TYPE
N
.. X
X
A
x
X
CO
-)
T,.T
o;
LLJ
>
REMARKS AND INSTRUCTIONS
-------
PUNCHING OR VERIFICATION
NAME WUASBFAT
PROGRAM CARD NO.
TYPE OF CARDS 80 COLUMN
FIELD
NO,
1
2
3
4
5
6
FIELD NAME
ACCOUNT NO.
BLANK
ACCOUNT NAME 1
BLANK
ACCOUNT NAME 2
BLANK
FUND TITLE NO.
BLANK
GENERAL ACCT. NO
BLANK
ACCT. NO. INTERNA
BLANK
SOURCE DOCUME
SOURCE CARD
COLUMNS
FROM
1
11
12
32
33
53
54
56
57
59
, 60
64
THRU
in
11
31
32
52
53
55
56
58
59
63
80
NO. OF
COLUMNS
in
1
20
1
20
1
2
1
2
1
4
17
INSTRUCTIONS
SHFET NO. L OF i
NT FINANCIAL. ACCT. TART.F. INPUT SWTTF.T
DFPT. JOB NO,
TYPE
N
x
X
X
X
X
X
A
X
X
X
x.
X
X
CO
=^
TiJ
TiJ
Ti,T
on
UJ
>
REMARKS AND INSTRUCTIONS
ACCOUNT NO. DF^r.RTPTTnN 1
ACCOUNT NO. TIRCIPRTPTTDM ?
FIJND TTTT.F. NO (i - in)
GENERAL ACCOUNT NO. (H ~ 99)
INTERNAL AflflT. NO
-------
PUNCHING OR VERIFICATION INSTRUCTIONS
NAME WUASBCRF
PROGRAM CARD NO, 1
TYPE OF CARDS sn rm.iiMM
FIELD
NO,
1
-2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
FIELD NAME
CARD NUMBER
BLANK
ACCOUNT NUMBER
^ALLOCATION CODE
BLANK
COST CAT (NOH LAB
COST CAT (LABOR)
BLANK
COST CKETER
MATCH CODE
COST CENTER
MATCH CODE
COST CENTER
MATCH CODE
COST CENTER
MATCH CODE
COST CENTER
MATCH CODE
COST CENTER
MATCH CODE
COST CENTER
MATCH CODE
BLANK
COLUMNS
FROM
1
2
3
13
14
)R) 15
17
19
21
25
29
33
37
41
45
49
53
57
61
65
69
73
77
THRU
1
2
12
13
14
16
18
20
24
28
32
36
40
46
48
52
56
60
64
68
72
76
80
SOURC
SOURC
NO. OF
COLUMNS
1
1
10
1
1
2
2
2
4
4
4
4
4
4
4
4
4
4
4
4
4
4
4
E DOCUME
£ FIRST C
SHEET NO, l OF 2
SIT CROSS REFERENCE FILE INPUT SHEET
ARD DEPT. JOB NO,
TYPE
N
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
A
X
X
CO
—
LJ
cc.
ID
>
REMARKS AND INSTRUCTIONS
MUST BE A '!'
-p-
-------
PUNCHING OR VERIFICATION INSTRUCTIONS
NAME
WUASBCRF
SHEET NO.
OF
PROGRAM CARD NO. 2
TYPE OF CARDS 80 COLUMN
FIELD
NO,
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
FIELD NAME
CARD NUMBER
BLANK
ACCOUNT NUMBER
COST CENTER
MATCH CODE
COST CENTER
MATCH CODE
COST CENTER
MATCH CODE
COST CENTER
MATCH CODE
COST CENTER
MATCH CODE
COST CENTER
MATCH CODE
COST CENTER
MATCH CODE
COST CENTER
MATCH CODE
BLANk
COLUMNS
FROM
1
2
3
13
17
21
25
29
33
37
41
45
49
53
57
61
65
69
73
77
THRU
L
2
12
16
20
24
28
32
36
40
44
48
52
56
60
64
68
SOURC
SOURC
NO, OF
COLUMNS
1
1
10
4
4
4
4
4
4
4
4
4
4
4
4
4
4
72 4
76
80
4
L
E DOCUME
E ADDITIC
^T CROSS REFERENCE FILE INPUT SHEET
NAL CARDSDFPT. JOB NO,
TYPE
N
x
X
X
X
X
X
X
X
X
X
X
X
X •
X
X
X
X
X
A
X
CO
—
LJ
a:
LU
>
REMARKS AND INSTRUCTIONS
VTTWRR '9' ' T ' np '/.'
* *
-P-
00
-------
PUNCHING
NAME WUASBDPT
PROGRAM CARD NO.
TYPE OF CARDS 80 COLUMN
FIELD
NO.
1
2
3
FIELD NAME
COST CENTER
BLANK
AMOUNT
BLANK
UTILITY CODE
BLANK
COLUMNS
FROM
1
5
6
16
17
18
THRU
L
5
15
16
17
80
OR VERIF
SOURC
SOURC
NO, OF
COLUMNS
4
1
10
1
1
63
I CAT I ON
E DOCUME
E
INSTRUCTIONS
SHEET NO, 1 OF 1
NT BUILD DEPRECIATION TABLE
DEPT. JOB NO.
TYPE
N
X
X
A
X
CO
-)
RJ
oc
LLJ
>
REMARKS AND INSTRUCTIONS
MUST BE 4-DIGIT NUMBER
YEARLY DEP. AMOUNT PIC 9(8)V99
BLANK = KENTON, "C" - COVINGTON
-------
NAME
WUASSCER
PUNCHING OR VERIFICATION INSTRUCTIONS
SHEET NO. 1 OF L
PROGRAM CARD NO,
TYPE OF CARDS 80 COLUMN
FIELD
NO,
1
2
3
4
5
6
7
8
9
10
11
1
VVOTM^^BMM
FIELD NAME
SOURCE CODE
BLANK
UTILITY CODE
BLANK
CONTRACT NO.
MATERIAL COST
LABOR COST
TRACTOR COST
COMPRESSOR COST
TRUCK (S) COST
OTHER COST
OVERHEAD COST
BALANCE
BLANK
COLUMNS
FROM
1
2
3
4
5
9
17
25
33
41
49
57
65
73
THRU
1
2
3
4
8
16
24
32
40
48
56
64
72
an
SOURC
NO. OF
COLUMNS
1
1 1
J__ 1
1
4
8
8
8
8
8
8
8
h 8
fi
IE DEPT. JOB NO,
TYPE
N
X
X
X
X
X
X
X
X
X
r X
A
X
C/3
^
RJ
RJ
RJ
RJ
RJ
RJ
RJ
RJ
RJ
OC
LU
>
REMARKS AND INSTRUCTIONS
MUST BE A '3'
BLANK=KENTON, "C"=COVINGTON
PIC 9(8)V99
PIC 9(8)V99
PIC 9(8)V99
PIC 9(8)V99
PIC 9(8)V99
PIC 9(8)V99
PIC 9(8)V99
PIC 9(8)V99
Ln
O
-------
PUNCHING OR VERIFICATION
NAME WUASMTER
PROGRAM CARD NO,
TYPE OF CARDS 80 COLUMN
FIELD
NO,
1
2
3
4
5
FIELD NAME
SOURCE CODE
BLANK
ENTRY NO.
BLANK
ACCOUNT NO.
BLANK
COST CENTER
BLANK
AMOUNT
BLANK
COLUMNS
FROM
1
2
3
6
7
17
18
22
23
33
THRU
1
2
5
6
16
17
21
22
32
80
SOURC
SOURC
NO, OF
COLUMNS
1
1
3
1
10
1
4
1
10
48
INSTRUCTIONS
SHEET NO, 1 OF 1
E DOCUMENT MISCELLANEOUS TRANSACTIONS
E
DEPT. JOB NO.
TYPE
N
X
X
X
X
X
A
X
CO
—
RJ
L.T
RJ
RJ
cn
LU
>
REMARKS AND INSTRUCTIONS
MUST BE A 'S'
PIC gm
PIC XflO")
PIC 9(4}
PIC 9C81V99
-------
Ul
ho
PUNCHING
NAME WUASPAER
PROGRAM CARD NO.
OR VERIFICATION INSTRUCTIONS
SHFET NO. 1 OF 1
SOURCE DOCUMENT PAYMENT AUTHORIZATIONS
TYPE OF CARDS 80 COLUMN
FIELD
NO,
1
2
3
4
5
6
FIELD NAME
SOURCE CODE
BLANK
AUTHORIZATION NO
BLANK
ACCOUNT NO.
BLANK
COST CENTER
BLANK
AMOUNT
BLANK
TOTAL
BLANK
COLUMNS
FROM
1
2
3
13
14
24
25
29
30
40
41
51
THRU
1
2
12
13
23
24
28
29
39
40
50
80
SOURC
NO. OF
COLUMNS
1
1
10
1
10
1
4
1
10
1
10
30
E
DEPT. JOB NO,
TYPE
N
X
X
X
X
X
X
A
X
to
RJ
LJ
RJ
RJ
RJ
a
LU
>
REMARKS AND INSTRUCTIONS
MUST BE A '4'
PIC 9(10)
PIC X(10)
PIC 9(4)
PIC 9(8)V99
PIC 9(8)V99
-------
PUNCHING
NAME WUASRSER
PROGRAM CARD NO,
TYPE OF CARDS 80 COLUMN
FIELD
NO,
1
2
3
4
5
6
FIELD NAME
SOURCE CODE
BLANK
REQUISITION NO.
BLANK
ACCOUNT NUMBER
BLANK
COST CENTER
BLANK
AMOUNT
BLANK
TOTAL
BLANK
COLUMNS
FROM
1
2
3
13
14
24
25
29
30
40
41
51
THRU
1
2
12
13
23
24
28
29
39
40
50
80
OR VERIF
SOURC
SOURC
NO. OF
COLUMNS
1
1
10
1
10
1
4
1
10
1
10
30
'I CAT I ON
.E DOCUME
E
INSTRUCTIONS
SHEET NO, 1 OF 1
NT REQUISITION FROM STOCK
DFPT. JOB NO.
TYPE
N
X
X
X
X
X
X
A
X
c/>
RJ
LJ
RJ
RJ
RJ
cr
LU
>
-
REMARKS AND INSTRUCTIONS
MUST BE A '2'
PIC 9(10)
PIC X(10)
PIC 9(4)
PIC 9(8)V99
PIC 9(8)V99
-------
PUNCHING
NAME WUASPRER
PROGRAM CARD NO.
OR VERIFICATION INSTRUCTIONS
SHEET NO. 1 OF 1
SOURCE DOCUMENT PAYROLL
TYPE OF CARDS 80 COLUMN
FIELD
NO,
1
2
3
4
5
6
7
FIELD NAME
SOURCE CODE
| BLANK
EMPLOYEE NUMBER
BLANK
DATE
BLANK
ACCOUNT NO.
BLANK
COST CENTER
BLANK
TOTAL PAY
BLANK
GROSS PAY
BLANK
COLUMNS
FROM
1
2
3
12
13
19
20
30
31
35
36
46
47
57
THRU
1
2
11
12
18
19
29
30
34
35
45
46
56
80
SOURC
NO. OF
COLUMNS
1
1
9
1
6
1
10
1
4
1
10
1
10
24
E
DEPT. JOB NO,
TYPE
N
X
X
X
X
X
X
X
A
X
CO
LJ
RJ
RJ
RJ
o:
LU
>
REMARKS AND INSTRUCTIONS
MUST BE A '!'
SOCIAL SECURITY NUMBER
DDMMYY
PIC X(IO)
PIC 9(4)
PIC 9(8)V99
PIC 9(8)V99
-------
PUNCHING
NAME WUASCAP1
PROGRAM CARD NO,
TYPE OF CARDS 80 COLUMN
FIELD
NO.
1
FIELD NAME
UTILITY CODE
BLANK
COLUMNS
FROM
1
2
THRU
1
80
OR VERIF
SOURC
SOURC
NO, OF
COLUMNS
1
79
I CAT I ON
E DOCUME
E
INSTRUCTIONS
SHEET NO, 1 OF 1
NT UTILITY DATA CARD FOR COST ALCT^. PT 1
DEPT. JOB NO,
TYPE
N
A
X
CO
—
tr
LU
>
REMARKS AND INSTRUCTIONS
OPTION = BLANK - KENTON
or
"C" = COVINGTON
-------
OPTION CARD
PUNCHING OR VERIFICATION
NAME WUASUZFT
PROGRAM CARD NO.
TYPE OF CARDS 80 COLUMN
FIELD
NO,
1
FIELD NAME
OPTION
BLANK
INSTRUCTIONS
SHFFT NO. 1 OF 1
SOURCE DOCUMENT
SOURCE
COLUMNS
FROM
1
7
THRU
6
80
NO. OF
COLUMNS
§
74
OPTION FOR ZEROING CM FILE
DFPT. JOB NO.
TYPE
N
A
X
y>
^
L.
ce
LU
^
REMARKS AND INSTRUCTIONS
OPTIONS = 'FTSCAT,"
= 'ZERO"
-------
PUNCHING OR VERIFICATION
NAME WUASPLV1
PROGRAM CARD NO, 1
TYPE OF CARDS 80 COLUMN
FIELD
NO.
1
2
3
4
5
1
I
FIELD NAME
CURRENT RPW
CURRENT TRTD WTR
YTD RPW
PREV YR -RPW
ACTUAL TO BUDGET
BLANK
SOURC
SOURC
COLUMNS
FROM
1
11
21
31
41
46
THRU
10
20
30
40
45
80
NO, OF
COLUMNS
10
10
10
10
5
35
E DOCUME!
E CARD
INSTRUCTIONS
SHFFT NO. L OF 1
YT WATER FLOW SHFFT
DEPT. JOB NO,
TYPE
N
X
X
X
x
X
A
V)
R.T
RJ
R.T
P T
RJ
a:
LLJ
>
REMARKS AND INSTRUCTIONS
PIC 9f7^VqQQ
PTC QHWQQQ
PTC qmVQQP
PTC QHWQQQ
PIC gnwqq *
* TAXEN FROM LV II ACTUAL TO BUDGET PERCENTAGE
-------
Ul
00
PUNCHING OR VERIFICATION
NAME WUASPWAR
PROGRAM CARD NO, 1
TYPE OF CARDS 80 COLLUMN
FIELD
NO,
1
2
3
4
5
6
7
8
9
10
11
12
FIELD NAME
UTILITY NAME
SYSTEM
SERIES
PARALLEL
SERIES-PARALLEL
WATER SOLD
MILLION GALLONS
MILLION GALLONS
MILLION GALLONS
MILLION GALLONS
MILLION GALLONS
MILLION GALLONS
SOURC
SOURC
COLUMNS
FROM
1
3
5
7
9
11
21
31
41
51
61
71
THRU
2
4
6
8
10
20
30
40
50
60
70
80
NO. OF
COLUMNS
?
2
2
2
2
10
10
10
10
10
10
10
E DOCUME
£ CARD
INSTRUCTIONS
SHEET NO, 1 OF 1
NT WATER FLOW SHEET
DFPT. JOB NO,
TYPE
N
X
X
X
X
X
X
X
X
X
X
X
A
x
CO
^
RJ
RJ
RJ
RJ
RJ
RJ
RJ
tr
LU
_>
REMARKS AND INSTRUCTIONS
"KE"=KENTON, "CO"=COVINGTON
PIC 99
PIC 99
PIC 99
PIC 99
PIC 9 (7)V999
PIC 9 (7)V999
PIC 9 (7)V999
PIC 9 (7)V999
PIC 9 (7)V999
PIC 9 (7)V999
PIC 9 (7)V999
-------
OPTION CARD
PUNCHING OR VERIFICATION
NAME WUASRUCM
PROGRAM CARD NO,
TYPE OF CARDS 80 COLUMN
FIELD
NO,
1
FIELD NAME
OPTION
BLANK
SOURC
SOURC
COLUMNS
FROM
1
8
THRU
1
80
NO, OF
COLUMNS
7
73
INSTRUCTIONS
SHEET NO, 1 OF 1
E DOCUMENT RACK TIP OPTION CARD
E
DFPT. JOB NO.
TYPE
N
A
X
CO
—
T,
a:
LU
>
REMARKS AND INSTRUCTIONS
MUST BE "BACK-UP"
-------
OPTION CARD
WUASUCAD
NAME
PROGRAM CARD NO.
PUNCHING OR VERIFICATION INSTRUCTIONS
SHEET NO. 1 OF L
SOURCE DOCUMENT CHAN£E. ADD. DELETE OPTION CARD
FIELD
NO,
1
FIELD NAME
BLANK
OPTION
BLANK
COLUMNS
FROM
1
5
11
THRU
4
10
80
NO, OF
COLUMNS
A
6
70
TYPE
N
A
X
V
T..T
OL
LL)
>
REMARKS AND INSTRUCTIONS
MTT9T RT? "TTPnATp"
-------
PUNCHING
NAME wuAsiir.An
PROGRAM CARD NO,
OR VERIFICATION INSTRUCTIONS
<;HFFT NO. i OF i
SOURCE DOCUMENT IITTT.TV TO CHANGE. ADD. OR DLTE. CM RCDS.
TYPE OF CARDS 80 COLUMN
FIELD
NO,
1
2
3
4
5
6
7
8
9
10
j
1
FIELD NAME
MATCH CODE
ACCOUNT NO.
COST CENTER
COST CATEGORY
CURRENT COST
PREVIOUS PRD CS1
YTD COST
YEARLY BUDGET
NOT USED
PREV YR CST
COLUMNS
FROM
1
5
15
19
21
31
41
51
61
71
THRU
4
14
18
20
30
40
50
60
70
80
SOURC
NO. OF
COLUMNS
4
10
4
2
10
10
10
10
10
10
E
DFPT. JOB NO,
TYPE
N
X
X
X
X
X
X
X
X
X
X
A
X
REMARKS AND INSTRUCTIONS
PIC 9(8)V99
PIC. 9C8)V99
PIC 9(8)V99
PIC 9(8)V99
PIC 9(8)V99
PIC 9(8)V99
-------
PUNCHING OR VERIFICATION INSTRUCTIONS
NAME DATE-TITLE CASH.
SHEET NO,.
1 OF.
PROGRAM CARD NO,.
TYPE OF CARDS 80 COLUMN
SOURCE DOCUMENT STANDARD DATE-TITLE CARD
SOURCE DEPT, JOB NO,.
FIELD
NO.
1
2
FIELD NAME
DATE
TITLE
BLANK
COLUMNS
FROM
1
19
43
THRU
18
42
80
1
NO, OF
COLUMNS
18
24
38
TYPE
N
X
X
A
X
X
]
CO
-)
LJ
:EN
a:
UJ
>
REMARKS AND INSTRUCTIONS
MONTH DD, YYYY
UTILITY NAME
N3
-------
PUNCHING
NAME DATE-TITLE CARD
PROGRAM CARD NO. SPECIAL
OR VERIFICATION INSTRUCTIONS
SHEET NO. 1 OF 1
SOURCE DOCUMENT F°R PROGRAM WUASBDPT
TYPE OF CARDS
FIELD
NO,
1
2
3
FIELD NAME
DATE
TITLE
DEP. ACCT. NO
BLANK
COLUMNS
FROM
1
19
43
53
THRU
18
42
52
80
SOURCE
NO, OF
COLUMNS
18
24
10
28
DFPT. JOB NO,
TYPE
N
X
x
X
A
„
X
X.
V)
—
LJ
CKN
Tn
o:
LU
REMARKS AND INSTRUCTIONS
MONTH nn YYYY
TITTT.TTY NAMF
-------
PUNCHING
NAME DATE-TITLE
PROGRAM CARD NO. SPECIAL
TYPE OF CARDS 80 COLUMN
FIELD
NO.
1
2
3
FIELD NAME
DATE
TITLE
DEPRECIATION PRO
BLANK
COLUMNS
FROM
1
19
43
53
THRU
18
42
52
80
OR VERIFICATION
SOURCE DOCUME
SOURCE
NO. OF
COLUMNS
18
24
10
28
INSTRUCTIONS
SHFFT NO. 1 OF 1
NT FOR
PP.DITRAM TJTTAQ'Rrnp
DEPT. JOB NO.
TYPE
N
X
X
A
X
X
X
to
T,,T
CF
T,.T
tr
LU
REMARKS AND INSTRUCTIONS
MONTH Dn, VYYY
UTILITY NAME
OPTIONS = MONTHTV
QTTARTFRT.V
YEARLY
WKFK7.Y
DEFAIILT=MONTHT.Y
-------
PUNCHING OR VERIFICATION INSTRUCTIONS
NAME DATE-TITLE
PROGRAM CARD NO, SPECIAL
SHEET NO, 1 OF 1
SOURCE DOCUMENT FOR PROGRAMS WUASPLV2, WUASPCAR
TYPE OF CARDS 80 COLUMN
FIELD
NO.
1
2
3
4
5
FIELD NAME
DATE
TITLE
BLANK
FISCAL YEAR BEGIb
BLANK
NUMBER OF WEEKS
REPORT PERIOD
COLUMNS
FROM
1
19
43
I 51
75
79
80
THRU
18
42
50
74
78
79
80
SOURC
NO. OF
COLUMNS
18
24
8
24
4
1
1
E
DEPT. JOB NO,
TYPE
N
X
X
X
X
X
A
X
X
X
to
T,,T
CF
T,J
£T
LLJ
>
REMARKS AND INSTRUCTIONS
MONTH DD. YYYY
UTILITY NAME
MONTH DD. YYYY
1=4, 2=5, 3=13. 4=26. 5=52
1=MONTHLY. 2=OUARTFR. 3=HALFr
4=ANNUAL
-------
SYSTEM FILE LAYOUT
The system file layout is provided to illustrate each cost accounting
system program file.
66
-------
VAMC WUASBCCT
NAME COST CENTER TABLE FILE
FILE RECORD NO. i
FILE LAYOUT FORMAT
RECORD LENGTH
SHEET NO.
10
OF
TYPE OF FILE INDEXED SEQUENTIAL
SOURCE COST CENTER DESCRIPTION SHVFT
FIELD
NO.
1
2
3
FIELD NAME
COST CENTER NO
COLUMNS
FROM
1
COST CENTER NAMEl! 5
COST CENTER NAME2J 18
1
i
THRU
L
17
30
NO. OF
COLUMNS
u
13
13
(.
TYPE
N
X
X
X
A
X
X
•
!
to
i
cc
LU
REMARKS AND INSTRUCTIONS
KEY FIELD
'
1
1
-------
00
MAMC WUASBSAT."XXX"
NAMt SPECIAL ACCT. TABLES (".CCC"
FILE RECORD NO. i
TYPE OF
FIELD
NO,
j
FILE SEQUENTIAL
FIELD NAME
NO. OF RECORDS
BLANK
1
I
1
FILE LAYOUT FORMAT
.".CCT'Y'.FAT", ".DPT") SHEET
RECORD LENGTH
NO. 1 OF 2
22
SOURCE SPECIAL ACCOUNTS INPUT DESCRIPTION SHEET
COLUMNS
FROM
1
5
THRU
4
22
NO. OF
COLUMNS
4
18
I
TYPE
N
X
A
i
i
! ,
CO
K
LU
>
t
REMARKS AND INSTRUCTIONS
1
-------
o-.
U3
!
]
jl
.
L
1
WUASBSAT
MANE SPECIAL ACCT. TABLES
FILE RECORD NO. 2
TYPE OF FILE SEQUENTIAL
| — ••--
1 PLELD
NO.
t — —
I
FIELD NAfvi
FILE LAYOUT FORMAT
SHEET NO. 9 OF 2
RECORD LENGTH
SOURCE
COLUHNS
; PROM JTHRU
SPECIAL ACCT. NO. 1
2 SPECIAL ACCT. NAME 3
i
-
f
i
1
<
o
4-
NO, OF
COLUMNS
22
TYPE
N A
7 Y
V)
Z3
~?
[
22 70 Y y
i
i
1
t 1
i
! 1
i
,
f .
-j
ujj REMARKS AND INSTRUCTIONS
>t
1 INDRYTNC TTP-V J
i
i
;
t
t
i
— T" ;
1
f)
1 i
! ^
j
[
i
• i i ' • " • i
-------
FILE LAYOUT FORMAT
WUASBFAT
NAME FINANCIAL ACCOUNT TABLE FILE SHEET NO. 1 OF 1
FILE RECORD NO. 1
TYPE OF FILE INDEXED SEQUENTIAL
FIELD
NO.
FIELD NAME
i {ACCOUNT NO.
2 'ACCOUNT NAME i
3
4
5
6
ACCOUNT NAME 2
FUND TITLE
GENERAL ACCT.
ACCOUNT NO. INTER*
RECORD LENGTH 58
SOURCE FINANCIAL ACCOUNT INPUT DESCRIPTION SHEET
COLUMNS
FROM
1
11
31
51
53
AL 55
THRU
10
30
NO. OF
COLUMNS
10
20
50 20
52
54
58
2
2
4
TYPE
N
A
X X
X
X
X X
X
X
X
CO
^
1
LLl
REMARKS AND INSTRUCTIONS
KEY FIELD
i
I
-------
FILE LAYOUT FORMAT
WUASBCRF
NAME CROSS REFERENCE FILE (CRF)
FILE RECORD NO. i
TYPE OF FILE TMriFYT?n SEQUENTIAL
FIELD
NO.
1
2
3
4
5
* 6
FIELD NAME
ACCOUNT NUMBER
r ALLOCATION CODE
COST CAT CNON LAB
COST CAT fLARO^
NO. OF COST CENTE,
COST CENTER
MATCH CODE
SHEET NO. 1 OF ,
RECORD LENGTH 265
SOURCE CROSS RFFFRFWrF INPUT DF.Sr.RTPTTnN QHFFT
COLUMNS
FROM
1
11
3R1 12
U
RS 16
THRU
10
1 1
13
is
n
NO. OF
COLUMNS
10
l
2
7
?
4
4
TYPE
N
X
X
X
X
X
JC
A
X
X
V)
cr
LU
>
REMARKS AND INSTRUCTIONS
KEY FIELD
* THE FOLLOWING TWO ITEMS OCCURS 31 TIMES
-------
„..„ WUASBCMF
NAMt COST MATRIX FILE (CMFl
FILE RECORD NO.
TYPE OF FILE JEBEXEB. SEQUENTIAL
FILE LAYOUT FORMAT
RECORD LENGTH
SOURCE CROSS
SHEET NO. i OF 1 |
80
s!
1
REFERENCE FILE 3
J
1 FIELD
| NO,
! i
1 2 -
FIELD NAME
MATCH CODE
ACCOUNT NO.
'] 3 JCOST CENTER
! 4
I 5
I 6
\ 7
COST CATEGORY
CURRENT COST
PREVIOUS COST
YTD COST
I 8 YEARLY BUDGET
ji Q
W
I 10
NOT USED
PREVIOUS YEAR COS1
COLUMNS
FROM
1
5
15
19
21
31
41
51
61
r 71
THRU
4
14
18
20
30
40
50
60
70
80
NO, OF
COLUMNS
4
10
4
2
10
10.
10
10
10
10
TYPE
N
X
X
x
__JL_
L x
V
.A.
X
X
X
r x
A
_JL
(
v>
~
cr
LU
^
REMARKS AND INSTRUCTIONS
1
KEY FTFT.n i
f
-------
-vj
OJ
MAUC WUASBUCM
MAMh COST MATRIX FILE BACKUP (CM
FILE RECORD NO.
TYPE OF
FIELD
NO.
1
2
3
4
5
6
7
8
9
10
FILF- SEQUENTIAL f TAP El
FIELD NAtfE
MATCH CODE
ACCOUNT NO.
COST CENTER
FILE LAYOUT FORMAT
F BACKUP) SHEET
RECORD LENGTH
COLUMNS
FROM
1
5
15
COST CATEGORY I 19
CURRENT COST
PREVIOUS COST
YTD COST
YEARLY BUDGET
NOT USED
PREVIOUS YEAR COS
21
31
41
51
61
: 71
THRU
4
14
SOURCE
NO. OF
COLUMNS
4
10
18 4
20
30
40
50
60
70
80
I 2
! 10
10
10
10
10
10
NO. l OF ,
80
COST MATRIX FILE
TYPE
N
X
X
A
X
X
x
X
X
X
, X
X
1 X
T
1
1
CO
ID
CE
LU
REMARKS AND INSTRUCTIONS
'
!
-------
NAME EDIT FILES *
FILE RECORD NO. 1
TYPE OF FILE SEQUENTIAL
FIELD
NO.
FIELD NA^E
JBLANK
1 SORT SEQUENCE
2 pATE
1
1
1
i
1
FILE LAYOLTT FORMAT
SHEET NO. i OF 3
RECORD LENGTH
26
SOURCE PAYROLL, PAY AUTH. REQ STOCK, SERVICE CONTRACT,
COLUMNS
FROM
1
; 2
3
7
THRU
1
2
26
i :
NO. OF
COLUMNS
-t
1
1
I_ 24
DEPRECIATION, MISC. TRANS.
TYPE
N
X
X
A
X
i
!
I
f '
1
1
it i
v)
^
—)
cr.
LLJ
>
REMARKS AND INSTRUCTIONS
IS LEFT BLANK
DATE FROM INPUT
I
1
1
r
* NOTE: EACH EDIT FILE HAS THE SAME FORMAT.
-------
MANE EDIT FILES
FILE RECORD NO. 2
TYPE OF
FIELD
NO.
1
FILE SEQUENTIAL
FIELD NAf.E
BLANK
FILE LAYOUT FORMAT
SHEET NO. 9 OF 3
RECORD LENGTH
SOURCE
COLUMNS
FROM
1
SORT SEQUENCE i 2
THRU
1
2 '
NO, OF
COLUMNS
1
26
TYPE
N
1 X
A
V)
Z)
-5
a:
LU
>
REMARKS AND INSTRUCTIONS
IS THE SOURCE CODE FROM INPUT
!TITLE
261 24
X ! X
IS THE UTILITY NAME
-------
NANE EDIT FILES
FILE RECORD NO. (DATA) 3
TYPE OF FILE SEQUENTIAL
FIELD
NO.
1
2
3
4
FIELD NAtfE
ACCOUNT NO.
COST CENTER
COST CATEGORY
AMOUNT
FILE LAYOUT FORMAT
SHEET NO. -n OF 3
RECORD LENGTH 26
SOURCE
COLUMNS
FROM
1
11
15
17
THRU
10
14
16
26
NO, OF
COLUMNS
10
4
2
10
26
TYPE
N
X
X
X
X
A
X
!
(/>
3
~5
CL.
LU
>
REMARKS AND INSTRUCTIONS
-------
SECTION 4
PROGRAM FLOW DIAGRAMS
The following program flow diagrams are provided to illustrate the
normal activity sequence within each program.
77
-------
A3 - 1 ,
; /PRINT COST
CENTER
NAME1
NAME2
r A5 - •+
h --- 1
I I
+ 4
' i
i i
I --- _, ---- 1
rC5-+ --- 1
1 1
rD5
I
I
T
i 1 1
-E5- H
~l
- F5 1
^ G5 — < ,
i !
t |
i
- 4-
I
I
r-.js--, ,
i i
J- 4.
i
! I
.- Kl — ->- —
' ~\
I
I
t
I
I
i
i
+
I
I
+ 1
1 + 1
78
-------
NOTE: THIS PROGRAM IS jUSED TO BUILD
SEVERAL DIFFERENT TABLE FILES
USING SAME FORMAT. ONLY JCL
INEEBS-TO BE CHAlteEB, 1
-Bl i 1
nuvt. i
DATA TO
SPECIA1 ACCT.
RECORD
DESCRIPTION
J
I •
, - K i - — —
I-K2 ,
r- K5 - H
i H. i
79
-------
• Al •- •
•A3- H
A3 — H .
- A5 - -i- 1
iREAD IN INDEXED
tLE SPECIAL
E KEYING IN Ol(
COST CAT. I
80
-------
SEARCH TABLE
KEYING IN ON
COST
CATEGORIES
WRITE ON FAT
TABLE FILE ACCT-.
INC.. ACCT. NO.!
/
'R^NT ACCT. NO. A'CCT./
0. DESCRIPTIONS
C^ST CAT. NO. COST j
CAT. DESCRIPTIONS
ra
i O
- Ha
.— J2 ' i
K I
rB5- -I
. H I
1
I , 1
-D5 — H
- G5 — .
- H5 -- -i >
r-KS
I , I
81
1 + 1
-------
ON
ACCOUNT NO.
\6jSEQJJEHCE
NO.
I
82
-------
PRINl ft YES
ERROR " -A-
MESSAGE
- K - —
83
-------
SAVE
ACCT.
NO.
DESCRIPTION
PRINT
ERROR
MESSAGE
READ
COST
CENTER
FILE
I-05 -^ ;
1 , I
,'PRINT ACCT. NO., COST
ENTER, COST CATS.,
CCT. DESCRIPTION, COST
-AT. DESCRIPTION. COST
CENTER DESCRIPTION,
TCH CODE, ALLOCATION
WRITE CM FILE
REC. ACCT. NO.
COST CENTER COST
CAT,, MATCH
,CODE
SAVE
COST
CAT.
DESCRIPTION
_EAT_J-
TAB
FILE
/READ FAT
TAB FILE
KEYING
ON ACCT
NO
I 4- I
-------
r *'••• -
_ .. i
-- K I - * -
-K2-
--K3 —
• K5 - *
+. 1
I 4 1
85
-------
86
-------
SEARCH
TABLE
SEQUENTIALLY
87
-------
1 WRITE DATE/
-TITLE /
CARD ON /
)ISK FILE/
88
-------
/PRINT SUB'
/TOTAL FOR
/ PREVIOUS
/SVC. CONT.
' NO.
PRINT
GRAND
TOTAL
CLOSE
FILES
C STOP J
89
-------
90
-------
1
PRINT SUB
TOTAL FOR
PREVIOUS
MISC. TX.
NO.
91
-------
PRINT SUB
TOTAL FOR
PREVIOUS
PKT. Al'TH.
NO.
92
-------
WRITE
RECORD
OH
'DISK FILE j
93
-------
94
-------
FLAG
ERROR
95
-------
(CLOSE \
FILES >
NO
SAVE
EMPL
NO. A
DA
NEW
OYEE
OT
TE
0
96
-------
97
-------
SORT
EDIT
FILE
INTO A
TEMP SORT
FILE BY
ACCT.
NO.
Q
O
98
-------
99
-------
100
-------
NOTE: WHEN READING
EDIT FJLES ALL
SIX OF4THE EDIT
FILES IfILL BE
READ 01JE AT A
TTMT UNTIL THEY
HAVE ALL BEEN
PROCESSED
JREAD
'CROSS-REF
'ILE) KEY-/ 7
1C IN ON
:COUNT NO
-65 - -f - -- -
1
-C5-
~]
-D5 ,
,_ 1
-E5- -I
- G5 —•
I + I
101
-------
1-A5-
Cl--f 1
62- n ---- .
YES
- C2 -,
SAVE LABOR
COST
CATEGORY
NO.
-^
1
i^V RECORQ/'V
L><_J ;
rC3- + -|
1 1
t t
1 i
1 i
- co --i
•
SAVE LABOR
NON LABOR
COST CATEGORY
NO.
I
J.
I- 1
rB5- -I
! I
r1-
r H3-
r- H4 - * .
I , J
4
-J
r J5 - H
102
— K3-
1
I
-
1
1
-i. (
1
1
t
1
1
l^
r
i
i
4
1
1
K4- -i
4-
I
I
L
-------
ADD COST
CENTER VALUE
TO COST
CENTER
ACCUMULATOR
r-C2- H ,
I / J
1 '•CCtlMULATEDT
VALUES OF/ i
i£OST CENTEW
I ZERO i
OUT INDIVIDUAL1
* ACCUMULATED 4
VALUES i
PRINT
ERROR
i / MESSAGE
SORT
SOLVED
_ . COSTS. _
FILE
BY
r J -COST- —
CENTER
r- 64- 1
READ
SORTED
I / FILE
/ PRINT I
ACCUMULATED/^ > H
/VALUES OF / r
COST CENTER/
I WRITE
ACCUMULATED
W VALUES ON
/DISK TABLE
I "COSTS"
I
103
-------
- Al - -L- 1
.- I
I-B5-4- 1
r-cs-4- 1
1 1
r
E5 1 ,
r- H5 --
! , i
-K5 - J
I + 1
104
-------
COMPUTE
PERCENTAGES
_FgR.ALLOC.
CODE
CALCULATE NON-
| DIRECT COST |
4 TO DIRECT 4
COST :
I
I
t
I
1 ,
^05 -
: i
-E5- -4- ,
, 1
- K 4 - •*• .
rK5 - *
I + 1
105
-------
MOVE CURRENT I
J COST TO i
PREVIOUS PERIOD
COST. MOVE ZERQ TO
CURRENT COST
REWRITE
CM
FILE
II RECORD
EOF X. I YES I
ZERO - YES I
FILE
OPTI
i Y I
MOVE YTD COST 1C)
PREVIOUS YTD COST
-MOVE ZEROS TO+
URjtENT, PREVIOUS,
AND YTD COST'
_ ^ I
r-K2-
- K 3 - •*•
r-K5 -
I + 1
106
-------
- -t .
1
; , i
- D4 - -t 1
I I
rB5- -• •
•C5 - -i
•D5
-E5-
107
-------
NOTE: KEY •= THE
CONCATENATION 01
ACCT . BO. , COST '
CENTER) AND
,CO_ST_ CATEGORY
0—
M r, . . r— ( ^^^ ,_ u i _
_J
108
-------
--A3 - T-
\_ START J,
82-1
B3_,r
OPEN
FILES
>
B4
ADD I
COSTS L
TO COST f
ACCUM. |
r co-
' I
NO- 1
rC5- 1
SORT
TEMP
IIE
ASCENDING
BY MATCH
109
-------
A3- i- .
SORT
TEMP
_V- -FUE - -.
ASCENDING
BY
'-MAfGH
CODE
- A5 - -)-
•- Kl 1- — -- -
r
E4- J
I , I
i-G4- <
. H4
- JJ —
ACCUM
COSTS BYi |
TCH CODE / I
BY/t
L/ !
-ES-4^ 1
SET NEVJ
MATCH CODE TC
PREVIOUS
MATCH CODE
ZERO
COST
ACCUM.
- G5 — -
]
O
r- H5 " -I 1
•i 4-
I
PRINT
ACCUM. L
COSTS BY/,
l/MATCH COD
-------
ADD COSTS
TO
•REVIOUS COS!
[ACCUMULATOR
o
o
111
-------
SET COUNT TO
1 SET
MAX-COUNT
TO 3
EEWIND TEMP
FILE
TO
BEGINNING
112
-------
G
30 - n
-E4- •.
_ -4 .
o
ADD
COSTS
TO COST
ACCUM.
- C4 -
•^
YES !
r
1 1
rB5--. , ,
•- K I ~ — — - —
r
I / PRINT /'
1 / ACCUM. II
COSTS BY/ 7
. MATCH CODE/ '
-------
c
START
OPEN
FTTF.fi
BUILD MATRIX
ACCUMULATOR
WITH COLUMNS
BEING COST
CENTERS &
ROWS BEING
COST CATEGOR-
IES
/READ COST
MATRIX
NX) CURRENT
VALUE IN CMF
RECORD TO MA-
TRIX ACCUMU-
LATOR AT
FIRST POSI-
TION OF COST
CENTER & COST
CATEGORY
114
-------
CqMPUTE DIFFERENCE
IBETWEEN ACTUAL
COSTS AND T
BUDGETED
COSTS
— -&- _.
I ,
rB5- -I- 1
-E5-
115
-------
• AI - ->- ,
• AZ 1
-A3 — H .
r- A5 - •
- Bl '
82-
START
r- B3-i - -
r B4-T ,
-Cl- -+ ,
r-DI 1
OPEN
FILES
I L.
,
, 1
j BUILD A
MATRIX ACCUMULATOR
t BY COST
! CENTERS I
IFIRST POSITION'
P-K2- ,
/READ
CURRENT
PERIOD
DATA
i J '_J
K4 1- 1
l |
I I
T 4
I I
I I
-D5 --.
, I
-E5- -i
~1
r- Ho — i ;
r-K5 - *
I + 1
116
-------
- A5 -
CMF
r-Ci- 4
[—01 1
•El - -I-
I
I
I j... _
-1 rBZ-i
, ' DIVIDE
-LJ i * CURREN
1 MILL 10
<— o
ACCUM. |
T BY ^ ^
T YEAR
H GALS, ;
. , r-B5- -»- •
J „ f 1 ! i / PRINT A I
| ^/^ ^ / READ /: / CURRENT / j j 1
' * 1 / CM / i T / YEAR UNIT/ ' X ' I
.. u...
1 <
J ._>
--| j-D?--.
p- 1 rcJ~ 1 r CO-,
X. ! ' 1 DIVIDE ACCUM '
°F\1 JSf. ,,„.,.
^T \ , PREVIOUS ' i
^ 1 ' 'MILLION GALS. i I
NO
. 1 ,-DJ , r- DO -,
r-D5 - .
1 ADD CURRENT 1 ! 1 • f PRINT / 1
1 COST TO 1 1 ! : / PREVIOUS /: X l 1
| ' MATRIX | t i/ MS? /' ^ ' _l
1 ACCUM. 1 'ill ^^~^>
....
1 ADD PREVIOUS ' ' DIVIDE ACCUM. i
1 ! COST TO ' ' COST BY •
] } MATRIX i CURRENT TOTAL *
1 ACCUM. 1 MILLION GALS. i
-i -F2-,
ADD YTD ! / PRINT / , |
! • ^KT° i ; -/ UN™ r^_j t
ACCUM. i ' i/ COST / . ^**~~^
— , r- &?- -.
-G5-< :
ADD PREVIOUS ' ' | 3IVIDE ACCUM. |
YEAR COST } x ^ COST BY , . i
1 " TO MATRIX | i [PREVIOUS YEAR '
ACCUM. i : I 1TLLION GALS . \
r-H?
• • c
I I
- H5 - .
' ' ' / PRINT A 1
A ' ' /PREVIOUS / ./ f
J " \ ' /YEAR UNIT / " ^ • I
i \ 1 COSTS / ^^^^^"^
- 1 ;- J? - ^H •
+ J i FT
! I 1 | >"
; i 1 i
Tl 4.
/
- -, — K?- 1 ---K3--1 1 ^K4-* ; p- K5 - -i •
: i < ; ! i : i
-»•+ +-> *+ 4* J-
117
1 4 1
-------
. il —I
I L 1
-Bl 1
!
~l
•El !
-Gl — -» - - -
-a? —i
I-C2--1
-E2 ,
-F2
i (i
r B3--.
T)
^ — i
| ^ PRINT /
_/ ACCUM. / :
77 COST / '•
\l 1
\ f PRINT f
jl BUDGET 11
I/ VARIANCE / ,
[/ YTD / '
r-03— ,
1 / PRINT /I
j/ TREATED /[
";"7WATER CUR-/"
i/lENT PERIOD/ i
.»-
w — 1
' / PRINT /'
!/ RPW /!
T7 CURRENT /]
:/ PERIOD / i
,_„
1 !
1 i
+ 4
1
! 1
1 _( j
r..C4 ,
1
1
4
\
1 1
|- D4 - H ;
i +
< i
1 I
1 _, 1
rE4"fc~~]
T t
1
1
1
_4
PRINT
ERCENTAGE / 1
OF TOTAL
PREVIOUS
YTD
li
E / 1
/4
/ |
/ i
--K3- -
+
!
i * I
118
--- + ---
G4- H
r H4 - ------
1 ____ , ___ J
r- J4 - •>
i i
I !
4 4
! I
I I
I +. 1
A5_.
h 1
rB5-+ 1
1
D5 —
-E5- H
~l
- G5
• H5 — -i
H I
J5 - -i 1
I
I
4.
-K5 - +
I + 1
-------
~ A5 •- - --
I ;
i-81 ' :
_Ci - -4 i
•El - •+
V START J
62--,- ---
OPEN
FILES
I-C2 -•
I - ! /READ 7
7 ; / DATE- /
Z hf TITLE / |
I/ CARD / ,
, !
y^ 4/ READ /
r ! / CURRENT I
I/ RPW /
• I / READ /
X ^/ YTD /
-I 7 RP" /
- B3- J
•C3- 4. 1
•D3 —•
. _, i
-E3 - •<
O
94-
CALCULATE'
DOSTS BY ZONE
JSING CURRENT
RE\'ENUE
RODUCING WAT
CALCULATE I
CURRENT UNIT!
COST AND PER-J
CENTAGE BY I
7.nnF<; I
CALCULATE
IOSTS BY ZONE
USING YTD RE
VENUE PRODU-
CING HATER
I
CALCULATE
YTD UNIT
COST AND PER
CENTAGE BY
<. I
1-65-
-C5- -I
-05 —'
-E5- -I ,
PRINT
CURRENT
UNIT COST
PERCENTS
J I
L .
119
-------
c
START
/ OPEN \
( FILES t
I ,- - 1
/ DATE- / X
/ TITLE / ^
/ CARD /
YES
PRINT
ERROR
MESSAGE
NO
O
/WRITE CM
/ FILE
I RECORD ON
/ TAPE
O
0
120
-------
121
-------
:- J3-
r- K ?
-K3- -1
1 » 1
122
-K4 1-
r-K5 - H
I + 1
-------
r- H3 --
- K 2 - :
123
-------
SECTION 5
PROGRAM LISTING
This section includes a source listing of all the computer programs
used in the Cost Analysis System. The programs are written in American
Standard COBOL within an IBM 370 environment, and thus, each program
listing will provide an identification division, an operating environment
division, a data format division, and a procedures division.
124
-------
PGMNAME=WUASBCCT
IDENTIFICATION DIVISION.
PRD&RAM-ID. WUA5&CCT.
AUTHOR. ACT SYSTEMS, INC
-SUITE 2UO
807 U MORSE BLVD
WINTER PARK, PL 32789.
DATE-WRITTEN. MAY 1977.
DATE-COMPILED.
REMARKS. THIS PROGRAM EDITS THE CLST CENTtR DESCRIPTION
CARDS, FLAGS ANY DISCREPANCIES, AND BUILDS TriE
COST CENTER TABLE FILE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CARD1N
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRIMGUI
ACCESS MODE IS SEQUENTIAL.
SELECT COST-CNTR-TABF1
ASSIGN TO DA-3330-I-CCTABFI
ACCESS MODE IS SEQUENTIAL
RECORD *EY IS CC-NUrtBER.
DATA DIVISION.
FILE SECTION.
FD CARD-IN
RECORD CONTAINS 80 CHARACTEkS
LABtL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
05 CC-NO PIC X(4).
05 GVFLONl PIC X.
05 CC-NAMEi PIC X113) .
05 OVFLOW2 PIC X.
05 CC-NAME2 PIC X(13).
05 OVFLDW3 PIC X.
05 FILLER PIC X(47) .
01 DATE-CARD.
05 DATE-IN PIC X(16) .
05 TITLE-IN PIC X(2^).
05 FILLER PIC X(38).
Fui PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
125
-------
LABEL RECORD
DATA RECORD
01 PRINT-LINE
FO COST-CNFR-TA
BLOCK CDNTAI
RECORD CDNTA
LABEL RECORD
DATA RECORD
01 CC-kEC.
05 CC-iMUMBt
05 CC-NAME1
05 CC-NAME2
WORKING-STORAGE
77 TITLE-1
77 LINt-CT
77 PAGfc-NO
77 MAX-LINE
77 CC PIC
77 DD PIC
77 Lh PIC
77 1C
77 LAST-2 PIC
77 LAST-3 PIC
01 LAST-CC-NO.
05 LAST-F
05 LAST-S
05 LAST-I
01 FLAGS.
05 BUF-FLG
01 HEADING-LINE
05 FILLER
05 TITLE
05 FILLER
01 DATE-PAGE-LI
05 FILLER
05 FILLER
05 DATE-1
05 FILLER
05 FILLER
05 FILLER P
05 FILLER
05 PAGE-1
05 FILLER
01 TITLE-LINE.
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
S ARE OMITTED
IS PR I NT-LINE.
PIC X (133 ) .
BFI
NS d RECORDS
INS 30 CHARACTERS
5 ARE STANDARD
IS CC-REC.
R PIC 9(4).
PIC X(13) .
PIC X (13).
SECTION.
PIC X(24).
PIC 9(4) COHP VALUE 0,
PIC 9(4) COMP VALUE 1-
PIC 99 COMP VALUE 56.
9 CUMP-
9 COMP.
9 COMP.
PIC 9 CQMI-.
99.
999.
PIC 9(4) COMP.
PIC 9(4) COMP.
PIC 9(4) COMP VALUE
0.
OCCURS 3 TIMES PIC 9-
PIC
PIC
PIC
NE.
PIC
PIC
PIC
PIC
PIC
1C X(58
PIC X(5
Xi
XI
XI
X
X
X
X
X
51)
24)
56)
VALUE SPACES
VALUE SPACES
VALUE SPACE-
6) VALUE 'DATE:
18) .
3b) VALUE SPACES
3) VALUE 'FuR'.
VALUE SPACES.
VALUE «PAGE '
PIC
PIC
ZZZ9.
XX VALUE
SPACES
PIC X(7) VALUE SPACES.
PIC X18J VALUE
PIC X(32) VALUE
PIC X(l'l) VALUE
PIC X(29) VALUE
PIC X(14) VALUE
FUNCTION'.
SPACES.
•SUBFUNCT10N'.
SPACES.
•IDENTIFICATION
126
-------
05 FILLER PIC X(32) VALUE SPACES.
01 DATA-OUT.
02 DATA-LINE OCCURS 2 TIMES.
05
05
05
FILLER PIC X.
DATA-BLOCK OCCURS 3
10 CC-NO
10 FILLER
10 CC-NAME
10 FILLER
10 ERRDR-MSG
FILLER
PIC
PIC
PIC
PIC
PIC
?IC
TIMtS.
X (4) .
XX.
X(13).
X.
X(20>.
X( 12) .
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN.
OPEiM OUTPUT PRINT-OUT, COST-CNTR-T AB F I .
CLEAR-FIELDS .
MOVE SPACES TO DATA-QUT.
MOVE ZEROS TO FLAGS.
READ-CARDIN.
READ CARD-IN AT END GO TO CLOSE-ROUTINE.
FILL-HEADING.
MOVt DATE-IN TO DATE-1.
MOVE TITLE-IN TO TITLE-1.
PRINT-HEADING .
PERFORM BLANK-LINE.
WRITE PRINT-LINE BEFORE ADVANCING NEW-PAGE.
MOVE 'COST CENTER DESCRIPTIONS' TO TITLE.
MOVt HEADING-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
MOVE PAGE-NU TO PAGE-1.
MOVE DATE-PAGE-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
MOVE TITLE-1 TO TITLE.
MOVE HEADING-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
PERFORM BLANK-LINE THRU WRITE-OUT.
MOVE TITLE-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
PERFORM BLANK-LINE THRU WRITE-OUT.
START-EDIT.
PERFORM READ-CARDIN.
EDIT-STfcPS.
MOVE .1 TO LN.
IF CC-NO OF INPUT-CARD NOT NUMERIC
MOVE 1 TO CC. DD
PERFORM FULL-BUFFER UNTIL FLAGS = ZEROES
MOVE 'NOT NUMERIC1 TO ERROR-MSG (LN, CC)
MOVE 2 TO LN
PERFORM CHECK-OVERRUN THRU CHECK-END
PERFORM FILL-BUFFER THRU WRITE-DISK
127
-------
GO TO START-EDIT.
MOVE CC-NO OF INPUT-CARD TO LAST-3, CC-NUMBER.
IF LA5T-3 = 0
MOVE 1 TO CC, DO
PERFORM FULL-BUFFER UNTIL FLAGS = ZEROES
MOVE CC-NO OF INPUT-CARD TO LAST-F
PERFORM CHECK-SEQ-I THRU CHECK-END
PERFORM FILL-SUFFER THRU *RITE-DISK
GO TO START-EDIT.
MOVE CC-NO OF INPUT-CARD TO LAST-2.
IF LAST-2 = 0
MOVE 2 TO CC, DD
PERFORM FULL-BUFFER UNTIL FLAGS = ZEROES OR DD > 3
MOVE CC-NO OF INPUT-CARD TO LAST-S
PERFORM CHECK-SEQ-F THRU CHECK-ENJ
PERFORM FILL-BUFFER THRU ^RITE-DISK
GO TO START-EDIT.
EDIT-END.
MOVE 3 TO CC , OD.
PERFORM FULL-BUFFER.
PERFORM CHECK-SEQ-S THRU CHECK-END.
PERFORM FILL-BUFFER THRU bRITE-DISK.
GO TO START-EDIT.
CHECK-SEQ-S.
IF CC-NUMBER / 100 * 100 NOT = LAST-S
MOVE 'NO SUBFUNCTION' TO ERROR-MSG (LN, 2).
CHECK-SEQ-F.
IF CC-NUMBER / 1000 * 1000 NOT = LAST-F
MOVE 'NO FUNCTION' TO ERRLR-MSG (LN, 1).
CHECK-SEQ-I.
IF CC-NUMBER NOT > LAST-I
MOVE 'SEQUENCE ERROR1 TO ERROR-MSG (LN, CC)
MOVE 2 TO LN.
MOVE CC-NUMBER TO LAST-I.
CHECK-OVERRUN.
IF QVFLOW1 NOT = SPACE OR OVFLOI*2 NOT = SPACE
OR OVFLOW3 NOT = SPACE
MOVE 'FIELD OVERRUN1 TO ERROR-MSG (LN, CC)
MOVE 2 TO LN.
CHECK-TEXT.
IF CC-NAME1 OF INPUT-CARD = SPACES
AND CC-NAME2 GF INPUT-CARD = SPACES
MOVE 'NO TEXT1 TO ERROR-MSG (LN, CC)
MOVE 2 TO LN.
CHECK-END.
EXIT.
FULL-BUFFER.
* BUFFER EMPTY THEN FLAGS=0 BUFFER FULL THEN FLAGS=1
IF BUF-FLG (DDJ NOT = o
MOVE 0 TO 1C
128
-------
PERFORM WRITE-DATA 2 TIMES
MOVE ZEROES TO FLAGS
PERFORM BLANK-LINE THRU WRITE-OUT
PERFORM PAGE-OVFLOW.
AOD 1 TC DD.
WRITE-DATA.
ADO 1 TO 1C.
MOVE DATA-LINE (1C) TO PRINT-LINE.
PERFORM WRITE-OUT.
MOVE SPACES TO DATA-LIME (1C).
FILL-BUFFER.
MOVE CC-NAME1 OF INPUT-CARD TL CC-NAME (1, CO.
MOVt CC-NAME2 OF INPUT-CARD TO CC-NAME (2, CO.
MOVE 1 TO BUF-FLG (CO.
MOVE CC-NO OF INPuT-CARD TO CC-KO OF DATA-LINE (1, CO
WRITE-D1SK.
IF LN NOT > 1
MOVE CORR INPUT-CARD TO CC-REC
WRITE CC-REC INVALID KEY
MOVE INPUT-CARD TO PRINT-LINE
PERFORM WRITE-OUT
PERFORM BLANK-LINE THRU WRITE-OUT.
BLANK-LINE.
MOVE SPACES TO PRINT-LINE.
WRITE-OUT.
WRITE PRINT-LINE BEFORE ADVANCING 1.
ADD 1 TL) LINE-CT.
PAGE-OVFLOW.
IF LINE-CT > MAX-LINE
ADD 1 TO PAGE-NO
MOVE 0 TO LINE-CT
PERFORM PRINT-HEADING.
CLOSE-ROUTINE.
IF FLAGS > 0
MOVE 0 TO 1C
PERFORM WRITE-DATA 2 TIMES.
CLOSE-FILES.
CLOSE CARD-IN, PRINT-OUT, COST-CNTR-TABFI.
PROGRAM-END.
STOP RUN.
129
-------
PGMNAME=WUASB5AT
IDENTIFICATION DIVISION .
PROGRAM-ID. WUASBSAT.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, FL 32789.
DATE-WRITTEN. JUNE 1977.
DATE-COMPILED.
REMARKS. THIS PROGRAM EDITS THE SPECIAL ACCOUNT DESCRIPTION
CARDS, FLAGS ANY DISCREPANC 115 , ANO BUILDS THE SPECIAL
ACCOUNT SEARCH TABLE FILt.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEH-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-GUT
ASSIGN TO UR-1403-S-PRINTGUT
ACCESS MODE IS SEQUENTIAL.
SELECT SPECIAL-ACCT-TABFI
ASSIGN TO UT-3330-S-SATABF1
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARO-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
05 SA-NO PIC XX.
05 SA-OVFLUW1 PIC X.
05 SA-NAME PIC X(20).
05 SA-OVFLOW2 PIC X.
05 FILLER PIC X(56) .
01 DATE-CARD.
05 DATE-IN PIC X(18) .
05 TITLE-IN PIC X(24) .
05 FILLER PIC X (38) .
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE PIC X(133).
130
-------
FD 5PECI AL-ACCT-TABFI
BLOCK CONTAINS 0 RECORDS
LABtL RECORDS ARE STANDARD
DATA RECORD IS SPEC-ACCT-REC ,
01 SPFC-ACCT-REC.
05 RECCRD-CDUNT.
10 NO-OF-RECS PIC 9(4).
ID FILLER PIC X(ltt ) .
05 5PEC-ACCT OCCURS 1 TO 99 TIMES
DEPENDING ON NO-OF-RECS
ASCENDING KEY IS SA-NO INDEXED 6Y IA
10 SA-NO »IC XX.
10 SA-NAME PIC X(2G).
WORKING-STORAGE SECTION.
77
77
77
77
77
01
L
L
P
M
I
H
AST
INE
AGE
AX-
E
EAD
05
01
01
01
01
0
0
D
0
0
0
0
0
0
0
0
0
T
0
0
0
D
0
0
0
0
0
0
0
0
0
E
0
5
5
ATt
5
5
5
5
5
5
5
5
5
-5A
-CT
-NO
LINE
ING-
FILL
FILL
FILL
-LIN
FILL
FILL
DATE
FILL
FILL
FILL
FILL
PAGE
FILL
1TLE-LI
5
5
5
ATA
5
5
5
5
5
5
5
5
5
RR-
5
FILL
TITL
FILL
-OUT
FILL
SA-N
FILL
PIC
LINt
ER
ER
ER
E.
ER
ER
-1
ER
ER
ER
ER
-1
ER
NE .
ER
E
ER
.
ER
0
ER
PIC
PIC
PIC
PIC
9 C
•
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
SA-NAME
FILL
SA-E
FILL
SA-E
FILL
F IEL
ER
R'ROR
ER
RROR
ER
DS.
ERRLiR-FL
1
2
99
9(
9(
99
UMP
X(
X (
X{
X
X(
X(
X(
X (
X (
X(
zz
XX
X t
X(
X (
PI
PI
PI
PI
PI
PI
PI
PI
PI
V
4)
4)
C
•
52
28
53
VA
6 )
18
40
3)
53
5 )
Z9
A
LUE 0
COMP
COMP
OMP VA
)
)
)
L
)
)
)
•
VA
54
24
55
C
C
C
C
C
C
C
C
C
)
)
)
X
VALU
VALU
VALU
UE SP
VALUE
*
VALU
VALUE
VALU
VALUE
LUE 5
VALU
•
VALU
(41 ) .
•
VA
VA
LU
E
E
E
AC
i
E
i
E
i
PA
E
E
LUE 0.
LbE 1 •
E 56.
SPACES.
'SPECIAL
SPACES.
E.
DATE: «.
SPACES.
FOR' .
SPACES.
PAGE '.
CES.
SPACES.
SHACES.
XX .
X
X
X
X
X
X
X
0 OCCURS
(8 ) .
(20) .
(5) .
(20) .
(5) .
(20) .
(12) .
2 TIMES
PIC X( 2
ACCOUNT DESCRIPTIONS'
PROCEDURE DIVISION.
131
-------
OPEN-FILES.
OPEN INPUT CARD-IN.
OPE,'* OUTPUT PRINT-OUT, SPECIAL-ACCT-TABFI .
CLEAR-FIELDS.
MOVE SPACES TO DATA-OUT.
MOVE SPACES TG ERR-FIELDS.
MOVE ZERO TO NO-OF-RECS.
SET IA TO 1.
READ-CARDIN.
READ CARD-IN AT END GO TO CLOSE-ROUTINE.
FILL-HEADING.
MOVE DATE-IN TO DATE-1.
MOVE TITLE-IN TO TITLE.
PRINT-HEADING.
PERFORM BLANK-LINE.
WRITE PRINT-LINE BEFORE ADVANCING NEW-PAGE.
MOVE HEADING-LINF TG PRINT-LINE.
PERFORM WRITE-OUT.
MOVE PAGE-NO TO PAGE-1.
MOVE DATE-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
MOVE TITLE-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
START-EDIT.
PERFORM READ-CARDIN.
IF SA-NO UF INPUT-CARD = '**'
PERFORM BLANK-LINE THRU WRITE-OUT
MOVE 5A-NAME UF INPUT-CARD TO SA-NAME OF DATA-CUT
MOVE DATA-OUT TO PRINT-LINE
PERFORM WRITE-OUT
PERFORM BLANK-LINE THRU WRITE-OUT
GO TO START-EDIT.
MOVE 1 TO IE.
ERROR-CHECKS.
IF SA-NO OF INPUT-CARD IS NOT NUMERIC
MUVE 'NUT NUMERIC1 TO ERROR-FLO (IE)
MOVE 2 TO IE.
IF SA-NAME OF INPUT-CARD = SPACES
MUVE 'NO TEXT' TO ERROR-FLD (IE)
MOVE 2 TO IE.
IF SA-OVFLOW1 NOT = SPACE OR SA-OVFLOW2 NOT = SPACE
MOVE 'FIELD OVERRUN' TO EkRLR-FLD (IE)
MOVE 2 TO IE.
IF SA-NU OF INPUT-CARD NOT > LAST-SA
AND SA-NO OF INPUT-CARD NOT = ZERUS
MOVE 'SEQUENCE ERROR' TO ERROR-FLD (IE)
MOVE 2 TO IE.
IF IE < 2
PERFORM FILL-DATA.
MOVE SA-NO OF INPUT-CARD TO LAST-SA.
132
-------
WR1TE-DATA.
MOVE CORR INPUT-CARD TO DATA-GUT.
MOVE ERROR-FLO (1) TO SA-ERRCR1.
MOVE ERROR-FLJ (2) TO SA-ERRCR2.
MOVE DATA-OUT TO PRINT-LINE.
PERFORM WRITF-OUT.
MOVE SPACES TG ERR-FI^LDS, DATA-OUT.
GO TO START-EDIT.
FILL-DATA.
MOVE CORR INPUT-CARD TO SPEC-ACCT (IA).
ADD 1 TG NO-OF-RECS.
SET I A UP BY 1.
BLANK-LINE.
MOVE SPACES TG PRINT-LINE.
WRITE-OUT.
WRITE PRINT-LINE bEFORE ADVANCING 1.
ADD 1 TG LINE-CT.
IF LINE-CT > MAX-LINE
ADD 1 TG PAGE-NO
MOVE 0 TO LINE-CT
PERFORM PRINT-HEADING.
CLOSE-ROUTINE.
WRITE SPEC-ACCT-REC.
CLOSE CARD-IN, PRINT-OUT, SPEC I AL-ACCT-TABFI
PROGRAM-END-
STOP RUN.
133
-------
PGMNAME=WUASBFAT
IDENTIFICATION DIVISION.
PROGRAM-IU. WUASBFAT.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 k MCRSE BLVD
WINTER PARK, FL 32789-
DATE-WRITTEN. JUNE 1977.
DATE-COMPILED-
REMARKS. THIS PROGRAM EDITS THE FINANCIAL ACCOUNT DESCRIPTION
CARDS, FLAGS ANY DISCREPANCIES, ANJ BUILDS THE FINANCIAL
ACCOUNT TABLE FILE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-25
-------
SO FILE-SORT
RECORD CONTAINS 80 CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
05 SORT-FIRST-iO PIC X(10).
05 FILLER PIC X(70).
FD SORTED-FILE
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
05 FA-NO PIC X(10).
05 OVFLOWl PIC X.
05 FA-NAME1 PIC X(20).
05 OVFLOW2 PIC X.
05 FA-NAME2 PIC X(20).
05 DVFLOW3 PIC X.
05 FN-TITLc PIC XX.
05 OVFLOW4 PIC X.
05 GA-TITLE PIC XX.
05 QVFLOW5 PIC X.
05 FA-INTERNAL PIC X14).
05 GVFLOW6 PIC X.
05 FILLER PIC X(16) .
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE PIC X1133).
FD FINANCIAL-ACCT-TABF1
BLOCK CONTAINS 8 RECORDS
RECURD CONTAINS 58 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS FA-REC .
01 FA-REC.
05 FA-NUMBER PIC X(10).
05 FA-NAME1 PIC X(20).
05 FA-NAME2 PIC X(20).
05 FN-TITLE PIC XX.
05 GA-TITLE PIC XX.
05 FA-INTERNAL PIC X(4).
FD SPECIAL-ACCT-TABFI
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS SPEC-ACCT-REC .
01 SPEC-ACCT-REC .
05 RECORD-COUNT.
10 NO-OF-RECS PIC 9(4).
10 FILLER PIC X( 18J .
05 5PFC-ACCT OCCURS 1 TO 99 TIKES
135
-------
DEPENDING ON ND-OF-RECS
ASCENDING KEY IS SA-NO INDEXED
10 SA-NO PIC XX.
10 SA-NAME PIC X(20>-
WDRKING-STDRA&E SECTION.
77 IFA PIC 9 CDMP.
77 ISA PIC 9 CUMP.
77 I NO PIC 9 COMP.
77 LAST-FA PIC X(10) VALUE SPACES
77 LINE-CT PIC 9(4> CDMP VALUE 0.
77 PA&t-NO PIC 9(4» COMP VALUE 1.
77 MAX-LINE PIC 99 COMP VALUE 56.
77 SEARCH-NO PIC XX.
01 COLUMN-HEADING
8Y IA
05
05
05
05
05
05
05
05
05
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
01 DATt-LINE
05
05
05
05
05
05
05
05
05
FILLER
FILLER
DATE-1
FILLER
FILLER
FILLER
FILLER
PAGE-1
FILLER
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
X(21> VALUE SPACES.
X(9) VALUE 'ACCOUNT #'.
X(10> VALUE SPACES.
XI121 VALUE 'ACCOUNT NAME
X(34) VALUt SPACES.
X(18) VALUE 'FUNu/ACCOUNT
X(7) VALUE SPACES.
i
SPACtS.
TITLE '
X VALUE '#'
X(21> VALUE
X VALUE SPACE.
X(6> VALUE 'DATE
X(18) .
X(40> VALUE
X(3> VALUE
SPACES
'FOR••
X(53) VALUE SPACES
X(5) VALUE 'PAGE1 .
ZZZ9.
XX VALUE SPACES.
01 HEADING-LINE.
05 FILLER PIC
05 FILLER PIC
05 FILLER PIC
01 TITLE-LINE.
05 FILLER PIC
05 TITLE PIC
05 FILLER PIC
01 DATA-OUT.
X(51)
X(30)
X(52)
X(54)
X(24)
X{55)
VALUE
VALUE
VALUE
SPACES.
•FINANCIAL
SPACES.
ACCOUNT DESCRIPTIONS'
VALUE SPACES.
VALUE SPACES.
05 DATA-LINE OCCURS 2 TIMES
PIC X(21>.
iO-1 PIC XX.
ILLER PIC X.
]-2 PIC XX.
:R PIC X.
]-3 PIC X{4
10
10
FILLER
FA-NO.
15 FA
15 FI
15 FA
15 FI
15 FA
136
-------
PROCE
OPEN-
0
1
1
1
1
1
1
1
1
1
1
1
DURE
FUE
PEN
0
0
0
0
0
0
0
0
0
0
0
s
I
FI
FA
F
F
F
S
F
I
A
I
LLER
-UAME
LLER
-ERk
LLER
A-NAME
I
SA
F
I
SA
F
DIV
.
NPU
I
I
T
LLER
-NO
LLER
-ERR
LLER
S10N.
CARD-
P
P
P
P
P
P
P
P
P
P
P
I
I
I
I
1
I
I
I
I
I
I
I
N
C
C
C
C
C
C
C
C
C
C
C
1
X(
X (
X(
X(
X (
X (
X (
XX
X 1
X (
X (
20 ) .
5
2
5
) .
0) .
) .
20) .
5
•
5
1
5
SPE
) .
) .
0) .
) .
CIAL-ACC1 -TABFI
OPEN OUTPUT PRINT-OUT, FINAMC1AL-ACCT-TABF I .
READ-CARDIN.
READ CARD-IN AT END GO TO CLOSE-ROUT INE.
FILL-HEADING.
MUVE DATE-IN TO DATE-1.
MOVt TITLE-IN TO TITLE.
SORT-ROUTINt.
OPEN OUTPUT SORTEU-FILE.
SORT FILE-SORT ON ASCENDING KEY
SORT-FIR5T-1C
INPUT PROCEDURE READ-SORT-INPuT THRU
RfcAD-SORT-INPUT-ENO
OUTPUT PROCEDURE WRITE-SORT-OUTPUT THRU
WRITE-SURT-OUTPUT-END.
CLOSE-SORT-FILES .
CLOSE SGRTED-FILE, CARD-IN.
OPEN INPUT SORTED-FILE.
PRINT-HEADING.
PERFORM BLANK-LINE.
WRITE PRINT-LINE BEFORE ADVANCING NEW-PAGE.
MOVE HEADING-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
MOVE PAGE-NO TO PAGE-1.
MOVE DATE-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
MOVt TITLE-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
PERFORM BLANK-LINE THRU WRITE-OUT.
MOVE COLUMN-HEADING TO P'RINT-LlNE.
PERFORM WRITE-OUT.
PERFORM BLANK-LINE THRU WRITE-OUT.
READ-SPtCIAL-ACC TS.
REAJ SPECIAL-ACCT-TABFI AT tNU
MOVE 'SPECIAL-ACCT-TABFI CONTAINS NO DATA' TO PRINT-LINE
PERFORM WRITE-OUT
GO TO CLOSE-ROUTINE.
137
-------
START-EJIT.
READ SOKTED-FILE AT END GO TO CLOSE-ROUT INE .
MOVE 1 TO IFA, ISA.
MOVE SPACES TO DATA-OUT.
CHECK-ACCT-NO.
IF FA-NO UF INPUT-CARD = SPACES
MOVE 'BLANK ACCOUNT #' TO FA-ERR (IFA)
MOVE 2 TO IFA.
IF FA-NO UF INPUT-CARD NOT > LAST-FA
MOVE 'SEQUENCE ERROR' TO FA-ERR (IFA)
MOVE 2 TO IFA.
MOVE FA-NO OF INPUT-CARD TO LAST-FA, FA-NO OF DATA-LIME (1)
FA-NUMBER.
CHECK-ACCT-NAME.
IF FA-NAME1 OF INPUT-CARD = SPACES AND
FA-NAME2 OF INPUT-CARD - SPACES
MOVE 'ML TEXT' TO FA-ERR (IFA)
MOVE 2 TO IFA.
MOVE FA-NAME1 OF INPUT-CARD TO FA-NAME (1).
MOVE FA-NAME2 OF INPUT-CARD TO FA-NAME (?).
CHECK-OVFLOW.
IF OVFLOW1 NOT = SPACE OR OVFLOfc2 NOT = SPACE OR
OVFLOK3 NOT = SPACE OR UVFLOW4 NOT = SPACE OR
OVFLOI"5 NOT = SPACE OR GVFLOW6 NOT = SPACE
MOVE 'FIELD OVERFUN' TO FA-ERR (IFA)
MOVE 2 TO IFA,
CHECK-INTERNAL-ACCT.
EXAMINE FA-INTERNAL OF INPUT-CARD REPLACING ALL ' ' BY 0.
IF FA-INTERNAL OF INPUT-CARD NOT NUMERIC
MOVE 'NOT NUMERIC' TO FA-ERK (IFA)
MOVE 2 TO IFA.
MOVE FA-INTERNAL OF INPUT-CARD TO FA-NO-3 (2).
SEARCH-SPEC-ACCTS.
MOVE 1 TO IND.
MOVE FN-TITLE OF INPUT-CARD TO SEARCH-NO, FA-MO-1 (2).
PERFORM SEARCH-ROUTINE.
MOVE 2 TO IN3.
MUVt GA-TITLF. OF INPUT-CARD TO SEARCH-NO, FA-NO-2 (2).
PERFORM SEARCH-ROUTINE.
CHECK-ERRORS.
IF IFA < 2 AND ISA < 2
PERFORM FILL-DATA.
MOVE 1 TO IND.
PERFORM ^RITE-DATA 2 TIMES.
PERFORM BLANK-LINE THRU WRITE-OUT.
PERFORM PAGE-OVFLOW.
GO TO START-EDIT.
SEARCH-ROUTINE .
SET IA TO 1.
SEARCH ALL SPEC-ACCT AT END
138
-------
MOVE 'NO TITLE FOUND' TO SA-NAME OF DATA-LINE (IN0)
MOVE 2 TO ISA
MOVE ALL '*' TO SA-ERR (INO)
MUVE SEARCH-NO TO SA-ND Cf DATA-LINE (INO)
WHEN 5A-NO OF SPEC-ACCT UA) = SEARCH-NU
MOVE CORR SPEC-ACCT (IA) TO DATA-LINE (INO).
WRITE-DATA.
MOVE DATA-LINE (HMD) TO PRINT-LINE.
PERFORM kRITE-OUT.
ADD 1 TO INJ.
FILL-DATA.
MOVE CORR INPUT-CARD TO FA-REC.
WRITE FA-REC INVALID KEY
MOVE 'INVALID KEY1 TO FA-ERR (IFA).
BLANK-LINE.
MOVE SPACES TO PRINT-LINE.
bRITE-OUT.
WRITE PRINT-LINE BEFORE ADVANCING 1.
ADD 1 TO LINE-CT.
PAGE-OVFLOW.
IF LINE-CT > MAX-LINE
ADD 1 TCi PAGE-NO
MOVE 0 TO LINE-CT
PERFORM PRINT-HEADING.
INPUT AND OUTPUT SORT ROUTINES
READ-SORT-INPUT.
READ CARD-IN AT END
GO TO READ-SORT-INPUT-ENO.
RELEASE SORT-INPUT FROM INPUT-RtCS.
GO TO READ-SDRT-INPUT .
REAO-SORT-INPUT-END.
EXIT .
WRITE-SORT-OUTPUT.
RETURN FILE-SORT RECORD INTO INPUT-CARD AT END
GO TO WRITE-SURT-OUTPUT-END.
WRITE INPUT-CARD.
GO TO WRITE-SDRT-OUTPUT.
WRITE-SQRT-OUTPUT-END.
EXIT.
CLOSE-ROUTINE.
CLOSE CARD-IN, PRINT-OUT, SPEC I AL-ACCT-FABF I , SORTED-FILE,
FINANCIAL-ACCT-TABFI .
PROGRAM-END.
STOP RUN.
139
-------
PGMNAME=WUASBCRF
i)0 *
IDENTIFICATION DIVISION.
PROGRAM-ID. WUASSCRF.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, FL 32789.
DATE-WRITTEN. SEPTEMBER 1977.
DATE-COMPILED.
REMARKS. THIS PROGRAM BUILDS A CROSS REFERENCE FILE USED TO BUILD
THE COST MATRIX FILE A,\D FDR COST ALLOCATION.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEb-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CAKDIN
ACCESS MODE IS SEQUENTIAL.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESORT
ACCESS MODE IS SEQUENTIAL.
SELECT SDRTED-FILE
ASSIGN TO UT-333-S-SORTEDFI
ACCESS MODE IS SEQUENTIAL.
SELECT CROSS-REF-FILE
ASSIGN TO DA-3330-I-CRTA13FI
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS ACCT-NO.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORDS ARE INPUT-CARD, DATE-CARD.
01 INPUT-CARD.
05 CODE-NO PIC X.
05 FILLER PIC X(79) .
01 DATE-CARD.
05 DATE-IN PIC X(18).
05 TITLE-IN PIC X(2<»).
05 FILLER PIC X(38> .
SD FILE-SORT
140
-------
RECURO CONTAINS 80 CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
05 SORT-CODE PIC X.
05 FILLER PIC X.
05 SORT-FA-NO PIC X(10).
05 FILLER PIC X(68).
FD SGRTED-FILE
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORDS ARE INPUT-REC, INPUT-1, INPUT-2
01 INPUT-REC.
05 FILLER PIC X(30).
01 INPUT-1.
05 CODE-NO PIC X.
05 FILLER PIC X.
05 FA-NO PIC X(10).
05 C-ALLOC PIC X.
05 FILLER PIC X.
05 C-CAT-BLOCK.
10 C-CAT OCCURS 2 TIMES PIC XX.
05 FILLER PIC XX.
05 C-CNTR-BLK OCCURS 7 TIMES.
10 C-CNTR PIC X(4).
10 MATCH-NO PIC X(4).
05 FILLER PIC X(4).
01 INPUT-2.
05 CODE-NO PIC X.
05 FILLER PIC X.
05 FA-NO PIC X(10) .
05 C-CNTR-6LK OCCURS 8 TIMES.
10 C-CNTR PIC XU).
10 MATCH-NO PIC X(^).
FD CROSS-REF-FILE
RECORD CONTAINS 265 CHARACTERS
BLOCK CONTAINS ** RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CR-RE-C .
01 CR-REC.
05 ACCT-NO PIC X(10) .
05 C-ALLOC PIC x.
05 C-CATS.
10 C-CAT OCCURS 2 TIMES PIC XX.
05 NO-CC PIC 99-
05 C-CNTR-BLK OCCURS 31 TIMES.
10 C-CNTR PIC X(4).
10 MATCH-NO PIC X(4).
FD PRINT-OUT
RECURO CONTAINS 133 CHARACTERS
141
-------
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
PIC X(133) .
SECTION.
PIC 9(4) COMP VALUE
PIC
PIC
PIC
PIC
PIC
PIC
COMP.
COMP.
01 PRINT-LINE
WORKING-STORAGE
77 LINE-CT
77 PAGE-NO
77 MAX-LINE
77 I
77 1C
77 IR
77 ERR-HOLD
77 J
77 IE
77 CGDt-HGLO
01 ACCT-COUNTERS
05 STL-ACCTS
05 TTL-ACCTS
05 STL-GOOD
05 TTL-GOOD
01 ACCT-LINE.
0.
9(4) COMP VALUE 1.
99 COMP VALUE 56.
9 COMP.
99 COMP.
9 COMP.
PIC
PIC
PIC
X,
9
9
9
COMP.
PIC
PIC
PIC
PIC
9(6)
9(6)
9(6)
9(6)
COMP
CO HP
COMP
COMP
VALUE
VALUE
VALUE
VALUE
0,
0.
0,
0,
01
01
05
01
05
05
05
05
05
05
05
05
05
SORT
05
05
05
05
05
HEAD
05
FILL
05
DATE
05
05
05
05
05
05
05
05
FILLER PIC X VALUE SPACE.
TEXT-1 PIC X(4> VALUE 'PAGE'.
FILLER PIC X(ll) VALUE • TOTALS '.
FILLER PIC X(4) VALUE 'ALL '.
ALL-ACCTS PIC Z(5)9.
FILLER PIC XX VALUE SPACES.
FILLER PIC X(5) VALUE 'GOOD '.
GODD-ACCTS PIC Z(5)9.
FILLER PIC X(94> VALUE SPACES.
-ERR-LINE.
FILLER PIC X VALUE SPACE-
CARD-FLU PIC X(80) .
FILLER PIC X(5) VALUE SPACES.
FILLER PIC X(15) VALUE 'SORT CODE ERROR'-
FILLER PIC X(32) VALUE SPACES.
ING-LINE.
FILLER PIC X(54) VALUE SPACES.
ER PIC X(26) VALUE 'CROSS REFERENCE FILE INPUT'
FILLER PIC X(53) VALUE SPACES.
-LINE.
FILLER PIC X VALUE SPACE.
FILLER PIC X(b) VALUE 'DATE: '.
05 DATE-1 PIC X(18).
FILLER PIC x(40) VALUE SPACES.
FILLER PIC X(3> VALUE 'FOR'.
FILLER PIC X(53) VALUE SPACES.
FILLER PIC X(4) VALUE 'PAGE1.
PAGE-1 PIC ZZZ9.
FILLER PIC X(4) VALUE SPACES.
01 TITLE-LINE
142
-------
05 FILLER PIC X(54) VALUE SPACES.
05 TITLE PIC X(24) .
05 FILLER PIC X(55) VALUE SPACES.
01 COL-HEADING-1.
05 FILLER PIC X VALUE SPACE.
05 FILLER PIC X(30) VALUE 'FINANCIAL CATEGORY COST1
05 FILLER PIC X(26) VALUE ' COST / MATCH'.
05 FILLER PIC x(76) VALUE SPACES.
01 COL-HEADING-2.
05 FILLER PIC XX VALUE SPACES.
05 FILLER PIC X(22) VALUE 'ACCOUNT NON-L LABOR '.
05 FILLER PIC X(26) VALUE 'ALLOCATION V CENTERS /'.
05 FILLER PIC X(6) VALUE ' CODE'.
05 FILLER PIC X(71) VALUE SPACES.
05 FILLER PIC X(6) VALUE 'ERRORS'.
01 DATA-OUT.
05 DATA-LINE OCCURS 4 TIMES.
10 FILLER PIC X.
10 FA-NO PIC XUO).
10 C-CAT-BLK OCCURS 2 TlhES.
10
10
10
10
10
15 FILLER PIC
15 C-CAT PIC
FILLER PIC X(9]
C-ALLOC PIC X.
FILLER PIC X (7]
NO-CC PIC Z9.
FILLER PIC XX.
XX.
XX.
I •
F •
10 CC-MC-BLK OCCURS 6
10
10
15 FILLER PIC
15 CC-NO PIC
15 DELIM PIC
15 MATCH PIC
FILLFR PIC X.
ERRS .
XX.
X (4) .
X.
X(4) .
TIMES
15 ERR-NO OCCURS 4 TIMES PIC X.
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN.
OPEiM OUTPUT PRINT-OUT, C ROS S -HE F -F I i_ E , SORTED-FILE
READ-CARDIN.
REAu CARD-IN AT END GD TO CLOSE-FILES.
FILL-HEADING.
MOVE DATE-IN TO DATE-1.
MOVE TITLE-IN TO TITLE.
SORT-ROUTINE.
SORT FILE-SORT ON ASCENDING KEY
SURT-FA-NO
SORT-CODE
INPUT PROCEDURE RE AD-SORT-INPUT THRU
READ-SORT-INPUT-END
143
-------
PRINT-LINE.
THRU WRITE-OUT
TO PRINT-LINE.
TO PRINT-LINE.
THRU WRITE-OUT
CR-REC
OUTPUT PROCEDURE WR1TE-SORT-OUTPUT THRU
WRITE-SORT-OUTPUT-ENO.
CLOSE-SQRT-FILES.
CLOSE SQRTED-FILE, CARD-IN.
OPEN INPUT SORTED-FILE.
PRINT-HEADING.
PERFORM BLANK-LINE.
WRITE PRINT-LINE BEFORE ADVANCING NEW-PAGE
MOVE HEADING-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
MOVE PAGE-NO TO PAGE-1 .
MOVE DATE-LINE TD PRINT-LINE.
PERFORM WRITE-OUT.
MOVE TITLE-LINE TO
PERFORM WRITE-OUT.
PERFORM BLANK-LINE
MOVE COL-HEADIN&-1
PERFORM WRITE-OUT.
MOVE COL-HEADING-2
PERFORM WRITE-OUT.
PERFORM BLANK-LINE
START-EDIT.
MOVE SPACES TO DATA-OUT,
MOVE 0 TO CODE-HOLD.
READ-SORTED-FILE.
MOVE 0 TO It.
READ SORTED-FILE AT END
MOVE CODE-NO OF 1NPUT-1
IF IR NUT > CODE-HOLD
PERFORM WRITE-DISK
PERFORM WRITE-DATA
UNTIL I > <+ OR
PERFORM BLANK-LINE
PERFORM START-EDIT.
MOVE IR TO CODE-HOLD.
CHECK-INPUTS.
IF CODE-NO OF INPUT-1 = •!'
PERFORM CHECK-INPUT-I THRU CHECK-INPUT-1-END
ELSE PERFORM CHECK-1NPUT-2 THRU CHECK-INPUT-2-END .
GG TO READ-SORTED-FILE.
CHECK-INPUT-l.
PERFORM CHECK-FA-NO THRU CHECK-C-ALLDC.
MOVE FA-NO OF INPUT-1 TO FA-NO OF DATA-LINE
-------
PERFORM CHECK-FA-MATCH.
MOVE 1 TD I.
PERFORM CHECK-C-CNTRS THRU CHECK-C-CNTRS-ENt).
CHECK-INPUT-2-END.
EXI T.
CHECK-FA-NO.
IF FA-NO OF INPUT-1 = SPACES
MOVE '!' TO ERR-HOLO
PERFORM ERROR-ROUTINE.
CHECK-C-CAT.
PERFORM FILL-C-CAT VARYING 1 FRUM 1 BY 1 UNTIL I > 2
IF C-CAT-BLOCK OF INPUT-1 = SPACES
MOVE '2' TO ERR-HOLD
PERFORM ERROR-ROUTINE
GO TO CriECK-C-CAT-ENO.
EXAMINE C-CAT-BLOCK OF INPUT-1 REPLACING ALL ' ' oY «U'.
IF C-CAT-BLOCK OF INPUT-1 NOT NUMERIC
MOVE '2' TO ERR-HOLD
PERFORM ERROR-ROUTINE.
CHECK-C-CAT-END.
EXI T.
CHECK-C-ALLOC.
IF C-ALLDC uF INPUT-1 = SPACE
MOVE '3' TO ERR-HOLD
PERFORM ERROR-ROUTINE.
MOVE C-ALLOC OF IfoPUT-1 TO C-ALLOC DF DATA-LINE (1),
C-ALLOC OF CR-REC.
FILL-C-CAT.
MOVt C-CAT OF C-CAT-BLOCK (I) TU C-CAT OF C-CAT-BuK (1. I)
C-CAT OF C-CATS (I).
CHECK-C-CNTRS.
IF C-CNTR-BLK OF INPUT-2 (I) = SPACES
GO TO CHECK-C-CNTRS-RCHK.
IF C-CNTR DF INPUT-2 (I) = SPACES OR
MATCH-NO OF INPUT-2 (I) = SPACES
MOVE '4' TO ERR-HOLO
PERFORM ERROR-ROUTINE
GO TO CHECK-C-CNTR-CONT.
IF C-CNTR OF INPUT-2 (I) .NOT NUKERIC GR
MATCH-NO OF IivPUT-2 (I) NOT NUMERIC
MOVE '4' TO ERR-HOLD
PERFORM ERROR-ROUTINE.
CHECK-C-CNTR-CONT.
ADD 1 TO 1C.
IF 1C > 31 MOVE 'V TO ERR-HOLD
PERFORM ERROR-ROUTINE
GO TO CHECK-C-CNTRS-END.
IF IR = 1 THEN MOVE 1C TO J
ELSE MOVE I TO J.
MOVE C-CNTR DF INPUT-2 (I) TO CC-NO (IR, J),
145
-------
C-CNTR UP CR-REC (1C).
MOVE MATCH-MO OP INPUT-2 (I> TO MATCH (IR, J),
MATCH-NO OF CR-REC (1C).
MOVE 1C TO NO-CC OF DATA-LINE (1), NO-CC OF CR-REC.
MUVE '/' TO DEL1M (IR, J).
MOVE 1C TO IMD-CC OF DATA-LIUE (1), NO-CC UF CR-REC.
ADD 1 TO I
IF I NOT > B GO TO CHECK-C-CNTR5 .
&o TO CHECK-C-CNTRS-END .
CHECK-C-CNTRS-RCHK.
IF IR = 1 AND I = 2 OR IR > 1 AND I = 1
MDVh '<+' TO ERR-HOLO
PERFORM ERROR-ROUTINE.
CHECK-C-CNTRS-END.
EXIT .
CHECK-FA-MATCH.
IF FA-NO UF INPUT-2 NOT = FA-NO OF DATA-LINE (1)
MOVE '!' TD ERR-HOLi)
PERFORM ERROR-ROUTINE
MOVE FA-NO OF INPUT-2 TD FA-NO OF DATA-LINE (2).
ERROR-ROUTINE.
IF IE NUT > 3
ADD 1 TO IE
ELSE MOVE 1 TO IE.
IF IE = 1 MOVE ALL '*' TO ERRS OF DATA-LINE (IR).
MOVE ERR-HOLD TO ERR-NO (IR, IE).
WRITE-DATA.
MOVE DATA-LINE (I) TO PRINT-LINE.
PERFORM WRITE-OUT.
WRITE-DISK.
ADD NO-CC OF CR-REC TO STL-ACCTS, TTL-ACCTS.
IF ERRS OF DATA-LINE (1) = SPACES AND
ERRS OF DATA-LINE (2) = SPACES AND
ERRS OF DATA-LINE (3) = SPACES AND
ERRS OF DATA-LINE (4) = SPACES
ADD NO-CC OF CR-REC TO STL-GOOD, TTL-&OOD
WRITE CR-REC INVALID KEY
SUBTRACT NO-CC OF CK-REC FROM STL-GOOD, TTL-GOOU
MOVE ALL '*' TO ERRS OF DATA-LINE (1)
MOVE 'INVLO KEY1 TO CC-MC-BLK (1, 8).
BLANK-LINE.
MOVE SPACES TO PRINT-LINE.
WRITE-OUT.
WRITE PRINT-LINE BEFORE ADVANCING 1.
ADD 1 TO LlrtE-CT.
CHECK-OVFLOw.
IF LINE-CT > MAX-LINE
PERFORM FILL-STL-ACCT-LINE
PERFORM PRINT-ACCT-LINE
MOVE 0 TO STL-ACCTS, STL-GOOD
146
-------
ADO 1 TU PAGE-NO
MOVE 0 TD LINE-CT
PERFORM PRINT-HEADING.
REAQ-SORT-INPUT.
READ CARD-IN AT END
GO TD REAO-SORT-IN^UT-ENO.
IF CODE-NO OF INPUT-CARD = 'I1 CR '2' OR '?' DR '
RELEASE SORT-INPUT FRLM INPUT-CARD
ELSE MOVE INPUT-CARD TO CARD-FLu UF 5GRT-ERK-LINE
MOVE PRINT-LINE TO SORT-ERR-LINc
PERFORM WRITE-OUT.
GO TO REAO-SORT-IUPUT.
READ-SORT-INPUT-END.
EXI T .
WRITE-SURT-GUTPUT.
RETURN FILE-SbRT RECORD INTu INPUT-kEC AT END
GO TO WRITE-SORT-DUTPUT-END.
WRITE INPUT-REC.
GO TO WRITE-SORT-OUTPUT.
kRITE-SQRT-DUTPUT-EMD.
EXIT.
FILL-STL-ACCT-LINE.
MOVt STL-ACCTS TO ALL-ACCTS.
MOVE STL-GOOD TO GOCD-ACCTS.
FILL-TTL-ACCT-LINiE.
MOVE 'CUMM1 TG TEXT-1.
MOVt TTL-ACCTS TO ALL-ACCTS.
MOVE TTL-GOOD TO GOOD-ACCTS.
PRINT-ACCT-LINE.
PERFORM BLANK-LINE THRU WRITE-OUT.
MOVE ACCT-LINE TO PRINT-LINE.
PERFORM V-RITE-OUT.
CLOSE-ROUTINE.
PERFORM WRITE-DISK.
IF DATA-OUT NOT = SPACES
PERFORM WRITE-DATA CARVING 1 FROM 1 BY 1
UNTIL I > *+ OR DATA-LINE (I) = SPACtS.
PERFORM FILL-STL-ACCT-LiNE.
PERFORM PRI IMT-ACCT-LINE .
PERFORM FILL-TTL-ACCT-LINE THRU PR INT-ACCT~LINE.
CLOSE-FILES.
CLOSE PRINT-OUT, SORTED-FILE, CROSS-REF-FILE .
PROGRAM-FND.
STOP RUN.
147
-------
PGMNAME=WUASBCMF
IDENTIFICATION DIVISION.
PROGRAM-ID. KUASBCMF.
AUTHOR. ACT SYSTEMS, INC
SUITE 2UO
307 W MORSE BLVD
WINTER PARK, FL 327d9.
DATE-rtRI TTEN. AUGUST 1977.
DATE-COMPILED.
REMARKS. THIS PROGRAM EDITS THE COST MATRIX ACCOUNT CARDS, FLAGS
ANY DISCREPANCIES. AND BUILDS THE COST ACCOUNT MATRIX
FILE .
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SDURCE-COMPUTtR. IBM-370-168 .
OBJECT-COMPUTER. IBM-370-168 .
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540K-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELECT CROSS-REF-FILE
ASSIGN TO DA-3330-I-CRTABFI
ACCESS MOUE IS SEQUENTIAL
RECORD KEY IS ACCT-NO.
SELECT COST-MATRIX-FILE
ASSIGN TO DA-3330-I-CMFILE
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CM-NUMBER.
SELECT FINANCIAL-ACCT-TABFI
ASSIGN TO DA-3330-I-FATABFI
ACCESS MODE IS RANOOM
NOMINAL KEY IS FA-N3MINAL
RECORD KEY IS FA-NUMBER.
SELECT COST-CNTR-TABFI
ASSIGN TO DA-3330-I-CCTABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS CC-NOMINAL
RECORD KEY IS CC-NUMBER.
SELECT 5PECIAL-ACCT-TABFI
ASSIGN TO UT-3330-S-SATABFI
ACCESS MODE IS SEQUENTIAL.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESURT
ACCESS MODE IS SEQUENTIAL.
SELECT SORTtD-FILE
ASSIGN TO UT-3330-S-SORTEDFl
ACCESS MODE IS SEQUENTIAL.
148
-------
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTGUT
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARD-IN
RECORD CCNTAliMS 8U CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS DATE-CARD.
01 DATE-CARD.
05 DATE-IN PIC X ( 16) .
05 TITLE-IN PIC X(2M.
05 FILLER PIC X (36) .
FD CROSS-REF-FILE
RECORD CONTAINS 265 CHARACTERS
BLOCK CONTAINS <* RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CR-REC.
01 Ck-REC.
05 ACCT-NO PIC X(10) .
05 C-ALLOC PIC X.
05 C-CATS.
10 C-CAT OCCURS 2 TIMES PIC XX.
05 NO-CC PIC 99.
05 C-CNTR-bLK OCCURS 31 TIMES.
10 C-CNTR PIC X(4).
10 MATCH-NO PIC X(M.
FD FINANCIAL-ACCT-TAbFl
BLOCK CONTAINS 8 RECORDS
RECORD CONTAINS 58 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS FA-REC.
01 FA-REC.
05 FA-NUMBER PIC X(10).
05 FA-NAME PIC X(20) OCCURS 2 TIMES
05 FILLER PIC X(8) .
FD COST-CNTR-TABFI
BLOCK CONTAINS 8 RECORDS
RECORD CONTAINS 30 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CC-REC .
01 CC-REC.
05 CC-NUMBER PIC X{4).
05 CC-NAME PIC X(13) OCCURS 2 TIMES
FD SPECIAL-ACCT-TABFI
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS SPEC-ACCT-REC .
01 SPEC-ACCT-REC.
05 RECORD-COUNT.
149
-------
SD
01
FD
01
FD
01
FD
10 NO-OF-RECS PIC 9(4).
10 FILLER PIC X116) .
05 SPEC-ACCT OCCURS 1 TO 99 TIMES
DEPENDING ON NO-OF-RECS
ASCENDING KEY IS SA-NQ INDEXED
10 SA-NO PK XX.
10 SA-NAME PIC X(20>.
FILE-SORT
RECURD CONTAINS 21 CHARACTERS
DATA RECORD IS SORT-INPUT.
SORT-INPUT.
05 SORT-FIRST-16 PIC Xllb).
05 FILLER PIC X(5) .
SORTED-FILE
RECORD CONTAINS 21 CHARACTERS
BLOCK CONTAINS 10 RECURDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-REC.
INPUT-REC.
05 FA-NO.
10 FA-NO-1 PIC X.
10 FA-ND-2 PIC X(9).
05 CC-NO PIC X(4).
05 SA-NO PIC XX.
05 MATCH-NO PIC X(4).
05 C-ALLOC PIC X-
COST-MATRIX-FILE
RECURD CONTAINS 8J CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CM-REC.
CM-REC.
05 MATCH-NU PIC X(4).
05 CM-NUMBER.
10 FA-NO PIC X(10).
10 CC-NO
10 SA-ND
BY IA
05 AMTS
XX.
9(3)V99
PIC
PIC
PIC
PIC
PRINT-OUT
RECURD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
PIC X(133) .
SECTION.
PIC 9(4) COMP VALUE
PIC 9(4) COMP VALUE
OCCURS 6 TIMES
01 PRINT-LINE
WORKING-STORAGE
77 LINE-CT
77 PAGE-NO
77 MAX-LINE
77 IB
77 1C PIC
77 NF-ERR
0.
1.
PIC 99 COMP VALUE 56.
PIC 9 COMP-
99 COMP.
PIC X(20) VALUE 'RECORD NOT FOUND
150
-------
77
77
01
01
01
01
01
01
01
FA-NOMINAL P
CC-NOMINAL P
ACCT-COUNTERS
05 STL-ACCTS
05 TTL-ACCTS
05 STL-GOOD
05 TTL-GOOD
ACCT-LINE.
05
05
05
05
05
05
05
05
05
DATA
05
05
05
05
05
HEAD
05
05
05
DATE
05
05
05
05
05
05
05
05
05
FI
TE
FI
FI
LLER
XT-1
LLER
LLER P
P
P
P
I
I
I
I
I
I
C
C
C
C
C
C
X
ALL-ACCTS
FI
FI
LLER
LLER
GDOD-ACC
FI
-6
LLER P
LK.
FA-NO
CC
-NO
SA-NO
P
P
I
I
C
C
TS
I
P
P
P
MATCH-ND
C-
ALLOC
C
I
I
I
P
X
C
C
C
1C
X
X
P
P
P
P
X
X
X
(
P
X
X
P
(
X
X
( 10
(4)
1C
1C
1C
1C
9 6) COMP VALUE 0.
9(6) COMP VALUE 0.
9(6) COMP VALUE 0.
9(6) COMP VALUE 0.
VALUE SPACE.
(4
(1
4)
1C
X
(5
1C
94
(1
( 4
)
1
VALUE
) VALUE
VALUE '
Z(5 )9.
•PAGE
1 TO
ALL •
1 .
TALS ' .
.
VALUE SPACES.
)
)
0
)
VALUE
Z(5)9.
VALUE
) .
.
•GOOD
SPACE
•
S.
XX.
P
X(
1C
t*
) .
X.
ING-LINE.
FI
FI
FI
-L
FI
FI
OA
FI
FI
FI
FI
LLER
LLER
LLER
INE.
LLER
LLER
TE-1
LLER
LLER
LLER
LLER
PAGE-1
FI
TITLE-
05
05
05
FI
TI
FI
COL-HE
05
05
05
05
05
05
05
05
FI
FI
FI
FI
FI
FI
FI
FI
LLER
LINE.
LLER
TLE
LLER
ADING-
LLER
LLER
LLER
LLER
LLER
LLER
LLER
LLER
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
1
P
P
P
P
P
P
P
P
1C
1C
I
I
I
C
C
C
1C
I
I
I
I
I
I
I
I
I
.
I
C
C
C
C
C
C
C
C
C
C
1C
I
I
I
I
I
C
C
C
C
C
1C
X
X
X
X
X
X
X
X
X
X
(55
(22
(5
6
VA
(6
(1
1
8
(40
(3
(5
(4
)
3
)
) VALUE
) VALUE
) VALUE
SPAC
•cos
SPAC
F.S.
T MATRIX FILE
ES.
LUE SPACE.
VALUE
) .
) VALUE
VALUE
) VALUE
VALUE
•DATE
SPAC
•FDR'
SPAC
•PAGE
• 1
• *
ES.
.
ES.
i
ZZZ9.
X
X
X
X
X
X
X
X
X
X
X
X
(4
(5
)
4
VALUE
) VALUE
SPACE
SPAC
S.
ES.
(24) .
(5
(7
(1
( 1
(1
(2
( 1
(1
(1
5
)
7
7
1
1
3
0
5
) VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
SPAC
SPACE
ES.
S.
•FINANCIAL ACCOUNT
SPAC
•COS
SPAC
•COS
SPAC
•COS
ES.
T CENTER1 .
ES.
T CATEGORY ' .
ES.
T ALLGCATIDN1.
INPUT
151
-------
01
05
05
05
05
FILLER
FILLER
FILLER
FILLER
PIC
PIC
PIC
PIC
XK» VALUE SPACES.
X(10) VALUE 'MATCH CODE1
X(3> VALUE SPACES.
X(5) VALUE 'ERROR'.
01 COL-HEADING-2.
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
X(6) VALUE
X VALUE '#'
X(l^) VALUE
X(4> VALUE
X(15) VALUE
X VALUE '#'
X(ll) VALUE
X(4) VALUE
X(16) VALUE
X VALUE '#'
X(10) VALUE
X(4) VALUE
X(14) VALUE
X(6» VALUE
X(12> VALUE
X VALUE '#'
X(9> VALUE
X(4) VALUE
SPACES.
.
SPACES.
»NAMc'.
SPACES.
.
SPACES.
'NAME1.
SPACES.
.
SPACES.
'NAME'.
SPACES.
'METHOD1
SPACES.
.
SPACES.
'FLAG1.
DATA-OUT.
05 DATA-LINE
OCCURS 2 TIMES
10
10
10
10
10
10
10
10
10
10
10
10
10
10
10
10
10
10
10
FILLER
FA-NO
FILLER
FA-NAME
FILLER
CC-NO
FILLER
CC-NAME
FILLER
SA-NO
FILLER
SA-NAME
FILLER
C-ALLOC
FILLER
MATCH-NO
FILLER
CM-ERR
FILLER
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
X.
X(10)
X(3) .
X(20)
X(5) .
X( .
X(20)
X(5) .
XX.
X(3) .
X(2C)
X(7) .
X.
X(l^)
X(4> .
X(7).
XX.
XX.
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN,
COST-CNTR-TABFI,
FINANCIAL-ACCT-TABFI
SPECIAL-ACCT-TABFI.
CR05S-REF-FILE.
OPEN
READ-CAROIN.
OUTPUT PRINT-OUT, COST-MATR IX-FILE
152
-------
READ CARD-IN AT EN3 GO TC CLDSE- ROUT I NE .
FILL-HEADING .
MOVE OATE-IN TO OATE-1.
MOVE TITLE-IN TO TITLE.
SORT-ROUTINE .
OPEN OUTPUT SORTEU-FILE.
SORT FILE-SORT ON ASCENDING KEY
SORT-FIRST-16
INPUT PROCEDURE READ-SORT-INPUT THRU
READ-SORT-INPUT-END
OUTPUT PROCEDURE *RITE-SORT-OUTPUT THRU
WRITE-SORT-OUTPUT-END.
CLDSE-Sim-FILES.
CLOSE SORTED-FILE, CARD-IN.
OPEN INPUT SORTED-FILE.
-PRINT-HEADING.
PERFORM BLANK-LINE.
WRITE PRINT-LINE BEFORE ADVANCING NEW-PAGE.
MOVE HEADING-LINE TO PRINT-LINE-
PERFORM WRITE-OUT.
MOVE PAGE-NO TO PAGE-1.
MOVE DATE-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
MOVE TITLE-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
PERFORM BLANK-LINE THRU WRITE-OUT.
MOVE COL-HEADING-1 TO PRINT-LINE.
PERFORM WRITE-OUT.
MOVE COL-HEADING-2 TO PRINT-LINE.
PERFORM WRITE-OUT.
PERFORM BLANK-LINE THRU WRITE-OUT.
READ-SPECIAL-ACCTS.
READ SPECIAL-ACCT-TABFI AT bND
MOVE 'SPECIAL-ACCT-TABF1 CONTAINS NO DATA1 TO PRINT-LINfc
PERFORM WRITE-OUT
GO TO CLOSE-ROUTINE.
START-EDIT.
READ SORTED-FILE AT END
GO TO CLOSE-ROUTINE.
MOVE SPACES TO DATA-OUT.
FIND-FA-INFD.
MOVE FA-NO OF INPUT-REC TO FA-NOMINAL,
FA-NO OF DATA-LINE (1 ) .
IF FA-ND-1 = '-'
MOVE 'CONTRA ACCOUNT1 TU FA-NAMt OF DATA-LINE (1)
GO TO FIND-FA-INFO-CONT.
READ FINANCIAL-ACCT-TABFI INVALID KEY
MOVE NF-ERR TO FA-NAME OF DATA-LINE (1)
MOVE ALL •*' TO CM-ERR OF DATA-LINE (1)
GO TO FINU-CC-INFO.
153
-------
MOVE FA-NAME OF FA-REC (1) TO FA-NAME DP DATA-LINE (1).
MOVE FA-NAME OF FA-REC (2) TJ FA-NAME OF DATA-LINE (2).
FIND-FA-INFC-CONT.
MOVE FA-NUMbER TO FA-NO OF CM-NUMBER.
FIND-CC-INFO.
MOVE CC-NO OF INPUT-REC TO CC-NOMINAL,
CC-NO OF DATA-LINE (1).
READ COST-CNTR-TA6FI INVALID KEY
MOVE NF-ERR TO CC-NAME OF DATA-LINE (1)
MOVE ALL '<•' TO CM-ERR OF DATA-LINE (1)
GO TO FIND-SA-INFO.
MOVE CC-NUMBER TO CC-NO OF CM-NUMBER.
MOVE CC-NAME UF CC-REC (1) TO CC-NAME OF DATA-LINE (1).
MOVE CC-NAME OF CC-REC (2) TO CC-NAME OF DATA-LINE (2).
FIND-SA-INFO.
MOVE 1 TO IB.
PERFORM SEARCH-ROUTINE.
CHECK-COST-ALLCC.
IF C-ALLDC UF INPUT-REC NOT =• SPACE
MOVE C-ALLOC OF INPUT-REC TO C-ALLOC OF DATA-LINE (1)
ELSE MOVE ALL '*• TO CM-ERR OF DATA-LINE (1),
C-ALLOC OF DATA-LINE (1).
CHECK-MATCH-NO.
IF MATCH-NO DF INPUT-REC NOT = SPACES
MOVE MATCH-NO OF INPUT-REC TO MATCH-NO DF CM-REC,
MATCH-NO OF DATA-LINE (1)
ELSE MOVE ALL '*' TO CM-ERR DF DATA-LINE (1).
MATCH-NO OF DATA-LINE (1).
CHECK-ERRORS.
ADD 1 TO STL-ACCTS, TTL-ACCTS.
IF CM-ERR OF DATA-LINE (1) * SPACES
MOVE 1 TO IB
PERFORM ZERO-AMTS 6 TIMES
PERFORM FILL-DATA.
MOVE 1 TO IB.
PERFORM KRITE-DATA 2 TIMES.
PERFORM BLANK-LINE THRU WRITE-OUT.
PERFORM PAGE-OVFLOW.
GO TD START-EDIT.
SEARCH-ROUTINE.
MOVE SA-NO OF INPUT-REC TO SA-NO OF DATA-LINE (IB).
SET IA TD 1.
SEARCH ALL SPEC-ACCT AT END
MOVE NF-ERR TO SA-NAME UF DATA-LINE (IB)
MOVE ALL '*• TO CM-ERR OF DATA-LINE (IB)
WHEN SA-NO OF SPEC-ACCT (IA) = SA-NQ OF INPJT-REC
MOVE SA-NAME DF SPEC-ACCT UA) TO
SA-NAME OF DATA-LINE ( IB)
MOVE SA-NO OF SPEC-ACCT (IA) TO SA-NO OF CM-NUMBER.
FILL-DATA.
154
-------
ADO 1 TO STL-GOOD, TTL-GOUD.
WRITE CM-REC INVALID KEY
SUBTRACT 1 FRUM STL-GOOD, TTL-GOOD
MOVE ALL •*' TO CM-ERk OF DATA-LINE (1)
MOVE 'INVALID KEY' TD FA-NAME OF DATA-LINE (1).
WRITE-DATA.
IF DATA-LINE (IB) NOT = SPACES
MOVE DATA-LINE (IB) TO PRINT-LINE
PERFORM WRITE-OUT.
ADD 1 TO IB.
BLANK-LINE .
MOVE SPACES TO PRINT-LINE.
WRITE-OUT.
WRITE PRINT-LINE BEFORE ADVANCING 1.
ADD 1 TU LINE-CT.
PAGE-OVFLOW.
IF LINE-CT > MAX-LINE
PERFORM FILL-STL-ACCT-L1NE
PERFORM PRINT-ACCT-LINE
MOVE 0 TD STL-ACCTS, STL-GOUO
ADD 1 TG PAGE-NO
MOVE 0 TO LINE-CT
PERFORM PRINT-HEADING.
ZERO-AMTS .
MOVE ZERO TO AMTS OF CM-REC (IB).
ADD 1 TJ IB.
*
* INPUT AND OUTPUT SORT ROUTINES
*
READ-SORT-INPUT.
READ CROSS-REF-FILE AT END
GO TD READ-SORT-INPUT-END.
MOVE SPACES TD DATA-BLK.
MOVE ACCT-NU TO FA-NO OF DATA-BLK.
MOVE C-ALLOC OF CR-REC TO C-ALLUC OF DATA-BLK.
MOVE 1 TO Ib, 1C.
PERFORM STORF-C-CAT 2 TIMES.
GO TO READ-SORT-INPUT .
STORE-C-CAT.
IF C-CAT (IB) NUT = SPACES
MOVE C-CAT (IB) TU SA-NO OF DATA-BLK
PERFORM RELEASE-INPUT VARYING 1C FROM 1 BY 1
UNTIL 1C > NO-CC.
ADD 1 TD IB.
RELEASE-INPUT.
MOVc C-CNTR (1C) TO CC-NO OF DATA-BLK.
MOVE MATCH-NO OF C-CNTR-BLK (1C) TO MATCH-NO OF DATA-BLK
RELEASE SORT-INPUT FROM DATA-BLK.
READ-SORT-INPUT-END.
EXI T.
155
-------
WRITE-SORT-OUTPUT.
RETURN FILE-SORT RECORD INTO INPUT-REC AT END
GO TO WRITE-SORT-OUTPUT-END.
WRITE INPUT-REC.
GO TO WRITE-SORT-UUTPUT.
WRITE-SDRT-OUTPUT-END.
EXIT.
>
FILL-STL-ACCT-LINE.
MOVE STL-ACCTS TO ALL-ACCTS.
MOVE STL-GOOD TL) GOOD-ACCTS.
FILL-TTL-ACCT-L1NE.
MOVE 'CUMM' TO TEXT-1.
MOVE TTL-ACCTS TO ALL-ACCTS.
MOVE TTL-GOOD TO GOOD-ACCTS.
PRINT-ACCT-LINE.
PERFORM BLANK-LINE THRU WRITE-OUT.
MOVE ACCT-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
CLOSE-ROUTINE.
PERFORM FILL-STL-ACCT-LINE.
PERFORM PRINT-ACCT-LINE.
PERFORM FILL-TTL-ACCT-LINE THRU PR INT-ACCT-L INE.
CLOSE PRINT-OUT, SPEC IAL-ACCT-TABFI, SORTED-FILE,
FINANCIAL-ACCT-TABFI, COST-CNTR-TABFI, COST-MATRIX-FILE,
CROSS-REF-FILE.
PROGRAM-END.
STOP RUN.
156
-------
PGMNAME=WUASBDPT
.SYSIN DO *
IDENTIFICATION DIVISION.
PROGRAM-ID. WUASBDPT.
AUTHOR. ACT SYSTEMS, INC
SUITE 2C3
807 W MORSE BLVD
WINTER PARK, PL 32789.
DATE-WRITTEN. JUNE 1977.
DATE-COMPILED.
REMARKS. THIS PROGRAM EDITS THE SPECIAL ACCOUNT DESCRIPTION
CARDS, FLAGS ANY DISCREPANCIES, AND BUILDS THE SPECIAL
DEPRECIATION TABLE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1^»03-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
SELECT SPECIAL-ACCT-TABFI
ASSIGN TO UT-3330-S-SATABFI
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARD-IN
RECORD CONTAINS 8-J CHARACTERS
LABEL RECORDS ARE CHITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
05 CUST-CNTR PIC X (<» I .
05 FILLER PIC X.
05 DEP-AMOUNT PIC 9(8)V99.
05 FILLER PIC X.
05 COUNTY-CODE PIC X.
05 FILLER PIC X(63) .
01 SPECIAL-TITLES.
05 SA-NO PIC XX.
05 FILLER PIC X.
05 SPECIAL-TITLE PIC XI24).
05 FILLER PIC X(53) .
01 DATE-CARD.
05 DATE-IN PIC X( 18) .
157
-------
05 TITLE-IN PIC X(24) .
05 DEP-ACCT-1N PIC X(10) .
05 FILLER PIC X(28) .
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RFCORD IS PRINT-LINE.
01 PRINT-LINE PIC X(133) .
FD SPECIAL-ACCT-TABFI
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS SPEC-ACCT-REC.
01 SPEC-ACCT-REC.
05 RECORD-COUNT.
10 NO-OF-RECS PIC 9(4).
10 DEP-ACCT-UUT PIC X(10).
10 FILLER PIC X(8) .
05 SPEC-ACCT OCCURS 1 TO 99 TIMES
DEPENDING ON NO-OF-RECS
ASCENDING KEY IS SA-Nu INDEXED
BY IA
10 COST-CNTR PIC X(4>.
10 DEP-AMCUNT PIC 9(8 JV99
10 COUNTY-CODE PIC X.
10 FILLER PIC X(7).
WORKING-STORAGE SECTION.
77 LINE-CT PIC 9(4) COMP VALUE
77 PAGE-NO PIC 9(4) COMP VALUE
77 MAX-LINE PIC 99 COMP VALUE 56
77 AMT-ACCUM PIC 9(8)V99
01
01
01
01
HEADI
05
05
05
F
F
F
DATE-
OS
05
05
05
05
05
05
05
05
TI
05
05
05
DA
05
05
F
F
0.
1.
VALUE 0.
NG-LINE.
ILLER
ILLER
ILLER
LINE .
ILLER
ILLER
DATE-1
F
F
F
F
ILLER
ILLER
ILLER
ILLER
PAGE-1
F
TLE
F
T
F
ILLER
-LINE.
ILLER
ITLE
ILLER
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
X(
X(
X(
X
X(
X(
X(
X(
X(
X(
52
28
53
)
)
)
VALUE
VALUE
VALUE
SPAC
ES.
•SPECIAL ACCOUNT
SPAC
ES.
VALUE SPACE.
6)
18
40
3)
53
5)
VALUE
) .
)
VALUE
VALUE
)
V
VALUE
ALUE
•DATE
: • .
SPACES.
•FC.R'
SPAC
•PAGE
.
ES.
• .
ZZZ9.
XX
X(
X(
X{
VALUE SPACES.
54
24
55
)
) ,
)
VALUE
VALUE
SPAC
SPAC
ES.
ES.
TA-OUT.
F
C
ILLER
OST-CNTR
P
P
1C X(
1C X(
52).
4) .
DESCRIPTIONS'
158
-------
05 FILLER PIC X(8 ) .
05 OEP-AMDUNT PIC *BZ.(7)9.99.
05 FILLER PIC X(56) .
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN.
OPEN OUTPUT PRINT-OUT, SPEC 1 AL-ACCT-TABFI .
CLEAR-FIELDS.
MOVE SPACES TO DATA-OUT.
MOVE ZERO TO NO-OF-RECS.
SET IA TO 1.
READ-CARDIN.
READ CARD-IN AT END GO TO CLOSE-ROUTINE.
FILL-HEADIN&.
MOVE DATE-IN TO DATE-1.
MOVE TITLE-IN TO TITLE.
MOVE DEP-ACCT-IN TO 9EP-ACCT-OUT.
PRINT-HEADING.
PERFORM BLANK-LINE.
WRITE PRINT-LINE BEFORE ADVANCING NEW-PAGE.
MOVE HEADING-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
MOVE PAGE-NO TO PA&E-l.
MOVE DATE-LINE TO PRINT-LINE.
PERFORM WRITE-OUT.
MOVE TITLE-uINE TG PRINT-LINE.
PERFORM WRITE-OUT.
WRITE-OUT-RECS.
PERFORM READ-CARDIN.
IF SA-NO = '**' THEN
PERFORM BLANK-LINE THRU WRITE-OUT
MOVE SPECIAL-TITLE TO TITLE
MUVE TITLE-LINE TO PRINT-LINE
PERFORM WRITE-OUT
PERFORM BLANK-LINE. THRU WRITE-OUT
GO TO WRITE-OUT-RECS.
FILL-DATA.
MOVE CORR INPUT-CARD TO DATA-OUT, SPEL-ACCT (IA)
MOVE DATA-OUT TO PRINT-LINE.
PERFORM WRITE-OUT.
MOVE SPACES TO DATA-OUT.
ADD DEP-AMOUNT OF INPUT-CARD TO AMT-ACCUM.
ADD 1 TO NO-OF-RECS.
SET IA UP BY 1.
GO TO WRITE-DUT-PECS.
BLANK-LINE.
MOVE SPACES TO PRINT-LINE.
WRITE-OUT.
WRITE PRINT-LINE BEFORE ADVANCING 1.
ADD 1 TO LlNE-CT.
159
-------
IF LINE-CT > MAX-LINE
ADD 1 TO PAGE-NO
MOVE 0 TO LINE-CT
PERFORM PRINT-HEADING.
CLOSE-ROUTINE.
WRITE SPEC-ACCT-REC.
PERFORM BLANK-LINE THRU WRITE-OUT.
PERFORM WRITE-OUT.
MOVE AMT-ACCUM TO OEP-AMOUNT OF DATA-OUT.
MOVE DATA-OUT TU PRINT-LINE.
PERFORM WRITE-OUT.
CLOSE CARD-IN, PRINT-OUT, SPECIAL-ACCT-TABFI
PROGRAM-END.
STOP RUN.
160
-------
PGMNAME=WUASBCDP
,SYS1N DD *
ID DIVISION.
PROGRAM-ID. WUASBCDP.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, PL 32789-
DATE-WRITTEN. DECEMBER, 1977.
DATE-COMPILED.
REMARKS. THIS PROGRAM READS ONE CARD
AND BUILDS THE CURRENT DEPRECIATION
FILE .
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-25<+OR-S-CAROIN
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1^03-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
SELECT DEPREC IATION-TABFI
ASSIGN TO UT-3330-S-DPTABFI
ACCESS MODE IS SEQUENTIAL.
SELECT COST-CNTR-TABFI
ASSIGN TO DA-3330-I-CCTABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS CC-NOMINAL
RECORD KEY IS CC-NUMBER.
SELECT FINANCIAL-COST-ALLOCATION
ASSIGN TO UT-3330-S-FICALFI
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
05 DATE-IN PIC X(18).
05 TITLE-IN PIC X(24).
05 PERIOD-IN.
10 PERIOD1 PIC X.
10 FILLER PIC X(8>.
161
-------
05 FILLER PIC X(29).
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
05 FILLER PIC X.
05 PRINT-DATA PIC X(132).
FD DEPRECIATION-TABFI
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS DEPREC I AT I DN-REC.
01 DEPRECIATION-REC.
05 RECORD-COUNT.
10 NO-OF-RECS PIC 9(M.
10 ACCT-NO PIC XUO).
10 FILLER PIC X(8>.
05 DEP-REC OCCURS 1 TO 99 TIMES
DEPENDING ON NO-OF-RECS
ASCENDING KEY IS COST-CNTR INDEXED BY CC.
10 COST-CNTR PIC X(^).
10 AMOUNT PIC 9(8)V99.
10 COUNTY-CODE PIC X.
10 FILLER PIC X(7).
FD FINANCIAL-CUST-ALLOCATION
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS DISK-OUT.
01 DISK-OUT.
05 DISK-ACCT-NO.
10 FILLER PIC X(9).
10 DISK-COUNTY-CODE PIC X.
05 DISK-COST-CNTR PIC X (<+ ).
05 DISK-COST-CAT PIC XX.
05 DISK-CURRENT-AMT PIC 59{8)V99.
01 FIRST-TWO-RECS.
05 FILLER PIC X.
05 SORT-SEQUENCE PIC X.
05 DISK-TITLE.
10 DISK-DATE PIC X(13).
10 FILLER PIC X{6».
FD COST-CNTR-TABFI
BLOCK CONTAINS 8 RECORDS
RECORD CONTAINS 30 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CC-REC.
01 CC-REC.
02 CC-NUMBER PIC X (
-------
WORKING-STDRA
77 SOURCE-CD
77
77
77
77
77
77
77
77
77
01
01
01
01
LINE
PAGE
PERI
-CT
-CT
DO
CC-NDMINA
NO-0
AMT-
MAX-
F-CDS
HOLD
LINE
YEARLY-UE
CURR
HEAD
05
05
05
HEAL)
05
05
05
05
05
05
05
HEAD
05
05
05
HEAJ
05
ENT-D
-1.
FILLE
FILLE
FILLE
-2.
GE SECTION
DE
L
T-CNTRS
P-TOTAL
EP-TUTAL
R
R
R
FILLER
DATE-
FILLE
FILLE
FILLE
FILLE
PAGE-
'S.
FILLE
TITLE
FILLE
-4.
FILLE
OUT
R
R
R
R
OUT
R
-OUT
R
R
•
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
I
I
I
I
I
I
I
I
I
I
I
1
I
I
I
I
I
I
I
I
I
I
I
I
C
c
C
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
X
99
9(
99
X(
99
9(
99
9(
9(
X(
X(
X(
X(
X(
X(
X(
X(
X(
L(
X(
X(
X(
X(
VALUE '6
i
.
CLMP VALUE 0.
4)
CLrtP V
ALUE
1 .
VALUE 12.
4)
•
COMP VAL
3)
V99 .
COMP VAL
8)
6)
56
18
58
15
18
31
3)
55
6)
4)
54
24
54
29
UE 0.
UE 56
V99 VALUE ZE
V99 VAL
) VALUE
) VALUE
) VALUE
) VALUE
) .
) VALUE
VALUE
) VALUE
VALUt
•
) VALUE
) .
) VALUE
) VALUE
UE ZE
SPAC
•
RO.
RO .
ES .
•DEPRECIATION TABLE ' .
SPAC
'PER
SPAC
•FOR
SPAC
•PAG
SPAC
SPAC
ES.
IOD ENDING: ' .
ES.
I
•
ES.
E: • .
ES .
ES.
'DEPRECIATION PERIOD
•ERED: '.
01
01
05
05
05
05
05
HEAD
05
05
05
05
05
05
05
05
05
HEAD
05
05
05
05
FILLE
PERIO
FILLE
CGM1
FILLE
-5.
FILLE
FILLE
FILLE
FILLE
FILLE
FILLE
FILLE
FILLE
FILLE
-b.
FILLE
FILLE
FILLE
FILLE
R
D-OUT
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
X
X(
X
X(
X(
X(
X(
x<
X(
X(
X(
X(
x<
X(
X (
X(
X(
x<
VA
7)
VA
54
41
10
7 )
10
4)
11
19
14
14
43
10
6)
10
b)
LUE UUO
•
Tt.
LUE QUOTE.
) VALUE
) VALUE
) VALUE
VALUE
) VALUE
VALUE
) VALUE
) VALUE
) VALUE
) VALUE
) VALUE
) VALUE
VALUE
) VALUE
VALUE
SPAC
SPAC
SPAC
•ACC
SPAC
•COS
SPAC
ES.
ES.
ES .
OUNT1 .
ES.
T' .
ES.
•YEARLY DEPRECIATION1
SPAC
•CUR
SPAC
SPAC
ES.
RENT PERIOD1 .
ES.
ES.
•NUMBER1 .
SPAC
•CEN
ES.
TER1 .
ENT
163
-------
01
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
DATA-LINE .
05 FILLER
05 ACCT-NO-OUT.
10 FILLER
10 COUNTY-CODE
05 FILLER
05 COST-CNTR-OUT
05 FILLER
05 YEARLY-AMT-QUT
05 FILLER
05 CURRENT-AMT-OUT
05 FILLER
05 COMMENT-OUT
05 FILLER
PIC X(16)
PIC X(6)
PIC X( 19)
PIC X(19)
PIC X(21)
PIC X(8)
PIC X(ll )
PIC X( 10}
PIC X(9).
-OUT PIC X.
PIC X(7).
PIC X(^).
PIC X(13)
PIC -(8).
PIC X(20)
PIC -(8 >.
PIC X( 19)
PIC X(25)
PIC XX.
PROCEDURE DIVISION.
OPEN-IO-FILES.
OPEN INPUT CARD-IN,
VALUE SPACES.
VALUE 'AMOUNT'.
VALUE SPACES.
VALUE 'DEPRECIATION
VALUE SPACES.
VALUE 'COMMENTS'.
VALUE SPACES.
AMOUNT
OEPRECIATION-TABFI,
COST-CNTR-TABFI,
OUTPUT PRINT-OUT,
FINANCIAL-COST-ALLOCATION.
HOUSE-KEEP.
MOVE SPACES TO DISK-OUT, DATA-LINE.
PERFORM MOVE-SPACES.
READ-CARDIN.
READ CARD-IN AT END MOVE
•NO DATE CARD ** JOB ABORTED' TO PRINT-DATA,
PERFORM PRINT-LINE-OUT,
GO TO CLOSE-IO-FILES.
MOVE DATE-IN TO DATE-OUT.
MOVE TITLE-IN TO TITLE-OUT.
TEST-PERIOD.
IF PERIDD1 = 'M1 THEN
MOVE • MONTH ' TO PERIOD-OUT
GO TO WRITE-FIRST-TWO-RECS.
IF PERIOD1 = »Y' THEN
MOVE 1 TO PERIOD,
MOVE ' YEAR ' TO PERIOD-OUT,
GO TO WRITE-FIRST-TrtO-RECS.
IF PERIOD1 = 'Q' THEN
MOVE 4 TO PERIOD,
MOVE 'QUARTER1 TO PERIOU-OUT,
GO TO WRITE-FIRST-THO-RECS.
164
-------
IF PERI001 = »W THEN
MOVE 52 TU PERIOD,
MOVE ' WEEK ' TO PERIOD-OUT,
GO TO WRITE-FIRST-TWO-RECS.
INVALID-PER I DO-FALLTHRU.
MOVE PERIOD-IN TO PERIOO-UUT.
MOVE ' **** INVALID PERIOD ENTERED - DEFAULTED TO MDNTH ****'
TO COM1.
WRITE-FIRST-TWO-RECS.
MOVE SPACES TO DISK-OUT.
MOVE DATE-IN TO DISK-DATE.
WRITE DISK-OUT.
MOVE SPACES TO DISK-OUT.
MOVE TITLE-IN TO DISK-TITLE.
MOVE SOURCE-CODE TO SORT-SEQUENCE.
WRITE DISK-OUT.
READ-DEPRECIATION-TABLE.
READ DEPRECIATIUN-TABFI AT END
MOVE 'DEPRECIATION TABLE CONTAINS NO DATA1 TO PRINT-DATA
PERFORM PRINT-LINE-OUT
GO TO CLDSE-IO-FILES.
WRITE-HEADINGS.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE NEW-PAGE.
MOVE PAGE-CT TO PAGE-CUT.
ADD 1 TO PAGE-CT.
MOVE 0 TO LINE-CT.
MOVE HEAD-1 TO PRINT-DATA.
PERFORM PRINT-LINE-UUT.
MOVE HEAD-2 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-3 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRiNT-LINE-OUT.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-4 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR INT-LINE-OUT.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-5 TU PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-6 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT.
PERFORM PRINT-LINE-OUT.
SET-POINTERS.
SET CC TO 0.
MOVE NO-OF-RECS TO NO-OF-COST-CNTRS.
START-EDIT.
SET CC UP BY 1.
165
-------
IF CC > NO-OF-COST-CNTRS THEN
GO TO CLOSE-IO-FILES.
MOVE ACCT-NO TO DI SK-ACCT-NO. ACCT-NO-OUT.
MOVE COUNTY-CODE (CC) TO 0ISK-COUNTY-COOE COUNTY-CODE-OUT.
MOVE COST-CNTR (CC) TO DISK-CGST-CNTR , COST-CNTR-OUT,
CC-NUMINAL.
MOVE AMOUNT (CC) TO AMT-HOLO. YEARLY-AMT-OUT.
ADD AMOUNT (CC) TO YEARLY-DEP-TOTAL.
DIVIDE AMT-HOLD BY PERIOD GIVING DISK-CJRRENT-AMT.
MOVE DISK-CURRENT-AMT TO CURRENT-AMT-OUT.
ADD DlSK-CURRENT-AMT TO CURRENT-DEP-TOTAL.
PERFORM CHECK-COST-CNTR.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE SPACES TO COMMENT-OUT.
WRITE DISK-OUT.
IF LINE-CT > MAX-LINE THEN
PERFORM WRITE-HEADINGS.
GO TO START-EDIT.
CHECK-COST-CNTR.
READ CDST-CNTR-TAdFI INVALID KEY
MOVE 'INVALID COST CENTtR *****' TO COMMENT-OUT.
MOVE-SPACES.
MOVE SPACES TO PRINT-DATA.
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE 1.
ADD 1 TO LINE-CT.
CLOSE-IO-FILES.
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-OUT 2 TIMES.
MOVE SPACES TO DATA-LINE.
MOVE YEARLY-DEP-TOTAL TO YEARLY-AMT-OUT.
MOVE CURRENT-DEP-TOTAL TO CURRENT-AMT-OUT.
MOVE ' DEPRECIATION TOTALS' Tli COMMENT-OUT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
CLOSE CARD-IN, DEPRECIATIUN-TABF1, COST-CNTR-TABFI,
PR I NT-OUT, FINANCIAL-COST-ALLOCATION.
E-O-J.
STOP RUN.
166
-------
PGMNAME=WUASSCER
.SYSIN DO *
IDENTIFICATION DIVISION.
PROGRAM-ID. WUASSCER.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 W MORSE BLVU
WINTER PARK, FLA 32789 .
DATE-WRITTEN. SEPT 23 1977.
DATE-COMPILED. SEPTEMBER 30 1977.
REMARKS. THIS PROGRAM EDITS THE SERVICE CONTRACT DATA
CARDS, TOTALS ALL COSTS, FLAGS ANY DISCREPANCIES
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESORT
ACCESS MODE IS SEQUENTIAL.
SELECT SORTED-FILE
ASSIGN TO UT-3330-S-SORTEDFI
ACCESS MODE IS SEQUENTIAL.
SELcCT FINANCI AL-COST-ALLOCATI ON
ASSIGN TO UT-3330-S-FICALFI
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
02 ID1 PIC X.
02 ID2 PIC X (79) .
01 DATE-CARD.
02 DATE-IN PIC X(13).
02 TITLE-IN PIC X(24).
02 FILLER PIC X(38) .
SO FILE-SORT
RECuRD CONTAINS 80 CHARACTERS
167
-------
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
02 S-SOURCE-CODE-NO PIC X.
02 FILLER PIC X.
02 S-CGNTRACT-NC PIC X(8).
02 FILLER PIC X(70).
FD SORTED-FILE
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS 1NPUT-RECS.
01 INPUT-RECS.
02 SOURCE-COOE-NO PIC X.
02 FILLER PIC X.
02 CONTRACT-NO PIC x(8>.
02 DATA-ITEMS.
05 NUMS OCCURS 7 TIMES PIC X(8).
02 BALANCE PIC X(8).
02 FILLER PIC X(6).
01 INPUT-RECS-NUMERIC.
02 FILLER PIC X(10) .
02 DAT-IN.
05 NUMS2 OCCURS 7 TIMES PIC S9(6)V99.
02 BAL-IN PIC S9(6)V99.
02 FILLER PIC X(6 ) .
FD FINANCIAL-COST-ALLOCATION
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS DISK-OUT.
01 DISK-OUT.
05 DISK-ACCT PIC X(10).
05 OISK-COST-CNTR PIC X (<*) .
05 DISK-COST-CAT PIC X(2).
05 DISK-AMOUNT PIC S9(8)V99.
01 FIRST-TKO-RECS.
05 FILLER PIC X.
05 SORT-SEQUENCE PIC X.
05 DISK-TITLE PIC X(24) .
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE PIC X1133).
WORKING-STORAGE SECTION.
77 LINE-CT PIC 99 COMP VALUE 1.
77 PAGE-CT PIC 9(4) COMP VALUE 1.
77 SOURCE-CODE PIC X VALUE '3«.
77 SEARCH-NO PIC XX VALUE SPACES.
77 ACCT-ND1 PIC X(10) VALUE '680-30
77 ACCT-N02 PIC X{10) VALUE '680-31
168
-------
77
77
77
77
77
77
77
77
77
77
77
01
01
01
01
01
01
01
TOTAL-ALL
BALANCE-ALL
CONTRACT-NO-HOLl)
NUMERIC-HOLD
I
J
MAX-LINE
BALANCE-ACCUM
TUTAL-ACCUM
SUB-TOTAL-BALANCE
SUB-TOTAL-TOTAL
ACCUM-ALL-SUBTOTAL.
05 ACCUM OCCURS 7 T
ACCUM-ALL-TUTAL.
05 ACCUM-ALL OCCURS
HEAOING-1 .
02 FILLER PIC X { 54
02 FILLER PIC X(23
02 FILLER PIC X(56
HEAOING-2.
02 FILLER
02 FILLER
02 DATE-OUT
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 PAGE-OUT
02 FILLER
HEADING-3.
02 FILLER
02 HEAD
02 FILLER
HEADING-4.
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
DATA-LINE .
02 FILLER
02 CONTRACT-OUT
PIC S9( 8) V99 COMP VALUE 0.
PIC S9(8)V99 COMP VALUE 0.
PIC X(8 ) VALUE '99999999' .
PIC X(8) .
PIC 9 COMP VALUE 0.
PIC 9 COHP VALUE 0.
PIC 99 CDMP VALUE 5t> .
PIC S9(6)V99 COMP VALUE 0.
PIC S9(MV99 COMP VALUE 0.
PIC S9(6)V99 CDMP VALUE 0.
PIC S9(6)V99 COMP VALUE 0.
IMES PIC S9(6)V99.
7 TIMES PIC S9(6)V99.
) VALUE SPACES.
) VALUE 'SERVICE CONTRACT REPORT'.
) VALUE SPACES.
PIC X VALUE SPACES.
PIC X(13) VALUE 'DATE ENDING: '.
PIC X(18) VALUE SPACES.
PIC X(33) VALUE SPACES.
PIC X(3) VALUE 'FOR'.
PIC X(53) VALUt SPACES.
PIC X(5) VALUE 'PAGE '.
PIC ZZZ9.
PIC X(3) VALUt SPACES.
PIC X(54) VALUE SPACES.
PIC X(2*») VALUE SPACES.
PIC X(55) VALUE SPACES.
PIC X VALUE SPACES.
PIC X(20) VALUE 'CONTRACT # MATERIAL1
PIC X(5) VALUE SPACES.
PIC X(16) VALUE 'LABOR TRACTOR'.
PIC X(.3> VALUE SPACES.
PIC X(20) VALUE 'COMPRESSOR TRUCKS'.
PIC X(5) VALUE SPACES.
PIC.X(17) VALUE 'OTHER OVERHEAD'.
PIC X(5) VALUE SPACES.
PIC X(18) VALUE 'BALANCE TOTAL'.
PIC X(8) VALUE SPACES.
PIC X(8 ) VALUE 'COMMENTS' .
PIC xm VALUE SPACES.
PIC X VALUE SPACES.
PIC X(8) .
169
-------
02 FILLER
02 OATA-BLK OCCURS
05 DAT
05 FILLER
02 BALANCE-OUT
02 TOTAL-OUT
02 FILLER
02 COMMENT
02 FILLER
01 ERROR-LIST.
02 ERR-LIST-A.
05 ERR-LIST-1
PIC XX VALUE SPACES.
7 TIMES.
PIC -(6).--.
PIC XX.
PIC -(8).— .
PIC -(&>.--.
PIC XX VALUE SPACES.
PIC X(20) VALUE SPACES
PIC X VALUE SPACES.
PIC X(IOO) VALUE
05 ERR-UST-2 PIC X(IOO) VALUE
• INVALID CONTRACT NUM
•MATERIAL NON NUMERIC
•LABOR NON NUMERIC
•TRACTOR NON NUMERIC
•COMPRESSOR N-NUMERIC'.
•TRUCKS NON NUMERIC
•OTHER NON NUMERIC
•OVERHEAD NON NUMERIC
•BALANCE NON NUMERIC
•OUT OF BALANCE '.
02 ERR-LIST-B REDEFINES ERR-LIST-A.
05 ERR-LIST OCCURS 10 TIMES PIC X(20).
01 ERROR-CODE.
02 ERR-CDDE OCCURS 10 TIMES PIC 9.
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN.
OPEN OUTPUT PRINT-OUT,
READ-CARD.
READ CARD^IN__AT END GO
MOVE SPACES TO DISK-OUT.
MOVt DATE-IN TO DATE-OUT,
WRITE DISK-OUT.
MOVE SPACES TO DISK-OUT.
MOVE TITLE-IN TO HEAO, DISK-TITLE
MOVE SOURCE-CODE TO SORT-SEGUENCE .
WRITE DISK-OUT.
WRITE-ERRDR-HEADING.
MOVE SPACES TO PRINT-LINE.
MOVE • THE FOLLOWING CARDS HAVE A
TO PRINT-LINE.
PERFORM PRINT-LINE-OUT THRU MOVE-SPACES
SORT-RECORDS.
OPEN OUTPUT SORTEO-FILE.
SORT FILE-SORT ON ASCENDING KEY
S-CONTRACT-NO
INPUT PROCEDURE REAO-SORT-INPUT THRU
READ-SORT-INPUT-END
OUTPUT PROCEDURE WRITE-SDRT-QUTPUT THRU
FINANCIAL-COST-ALLOCATION
TO CLOSE-FILES.
DISK-TITLE
INVALID SOURCE CODE NUMBER1
2 TIMES
170
-------
WRITE-SORT-OUTPUT-END.
CLOSE-SORT-FILES .
CLOSE SORTEO-FILE, CARD-IN.
OPEN INPUT SORTED-F1LE.
HOUSE-KEEPING.
PERFORM WRITE-HEADINGS.
MOVE ZEROS TO ERRQR-COOE, ACCUM-ALL-5UBTOTAL.
ACCUM-ALL-TOTAL .
REAO-INPUT-REC.
READ SORTED-FILE AT END GO TO CLOSE-FILES.
DATA-TEST-SECTION.
IF CONTRACT-NO NOT = TO CON TRACT-NO-HOLD THtN
MOVE CONTRACT-NO TO CONTRACT-OUT
ELSE MOVE SPACES TO CONTRACT-OUT .
MOVE CONTRACT-NO TO CONTRACT-NO-HOLD.
EXAMINE INPUT-RECS REPLACING ALL ' ' BY '0'.
IF (CONTRACT-NO NOT NUMERIC) OR (CONTRACT-NO = ZERO) THEN
MOVE 1 Tb ERR-CODE (1).
PERFORM TEST-FOR-NUMERIC VARYING I FROM 1 BY 1 UNTIL 1 = 8.
MOVE BAL-IN TLi BALANCE-OUT.
ADD BAL-IN TO SUB-TUTAL-BALANCE.
ADD BALANCE-ACCUM TO TOTAL-ACCUM.
IF bAL-IN NOT = TO BALAiMCE-ACCUK THEN
MOVE 1 TO ERR-CODE (10).
MOVE ZEROS TO BALANCE-ACCUM.
READ-NEXT-INPUT-RtC.
PERFORM REAO-INPUT-REC.
TOTAL-TEST.
MOVE CONTRACT-NO TO NUMERIC-HOLD.
IF NUMERIC-HOLD NOT EQUAL TLI C ON TR ACT-NO-HOL D THEN
MOVE TOTAL-ACCUM TO TOTAL-OUT,
ADD TOTAL-ACCUM TD SUB-TOTAL-TOTAL,
MOVE ZEROS TO TUTAL-ACCUM,
ELSE MOVE ZEROS TO TOTAL-OUT.
ERROR-DETECTION.
MOVE ZEROS TO I.
IF ERROR-CODE NOT EQUAL TO ZEROS THEN
PERFORM PRINT-ERRORS THRU PR I NT-ERRORS-tND UNTIL
ERROR-CODE = ZEROS
ELSE MOVE SPACES TO COMMENT,
MOVE DATA-LINE TO PRINT-LINE,
PERFORM PRINT-LINE-OUT THRU MOVE-SPACES.
TOTAL-TEST-END.
IF TOTAL-OUT NOT = TO ZEROS PERFORM PAGE-OVFLOW.
GO TO DATA-TEST-SECTION.
PRINT-ERRORS.
ADD 1 TU I.
IF ERR-CODE (I) EQUAL TO 1 THEN
MOVE ERR-LIST (I) TO COMMENT
MOVfc DATA-LINE TO PRINT-LINE,
171
-------
PERFORM PRINT-LINE-OUT THRU MOVE-SPACES,
MOVE SPACES TO DATA-LINE
MOVE ZERO TO ERR-CODE ( I >.
PRINT-ERRORS-END.
EXIT.
TEST-FOR-NUMERIC .
ADD 1 I GIVING J.
MOVE NUMS2 (I) TO DAT ( 1 ) .
ADD NUMS2 (I) TO BALANCE-ACCUM , ACCUM (I).
WRITE-HEADINGS.
MOVE PAGE-CT TO PAGE-OUT.
MOVE 0 TO LINE-CT.
WRITE PRINT-LINE BEFORE ADVANCING NEW-PAGE.
MOVE HEADING-1 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT THRU MOVfc-SPACES.
MOVE HEADING-2 TO PRINT-LINE.
PERFORM PRINT-LINE-DUT THRU MOVE-SPACES.
MOVE HEADING-3 TO PRINT-LINE.
PERFORM PRINT-LINE-CUT THRU MOVfc-SPACES 2 TIMES.
MOVE HEADING-^ TO PRINT-LINE.
PERFORM PRINT-LINE-OUT THRU MOVE-SPACES 2 TIMES.
ADD 1 TO PAGE-CT.
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE 1.
ADD 1 TO LINE-CT.
MOVE-SPACES.
MOVE SPACES TU PRINT-LINE.
PAGE-GVFLOW.
IF LINE-CT > MAX-LINE THEN
PERFORM WRITE-SUB-TOTAL
PERFORM WRITE-HEADINGS.
PAGE-OVFLOW-END.
EXIT.
WRITE-SUB-TOTAL.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-OUT-ACCUKS VARYING I FROM 1 BY 1 UNTIL I = 8
MOVE 'SUBTOTAL' TO CONTRACT-OUT.
MOVE SUB-TOTAL-BALANCE TO BALANCE-OUT.
MOVE SUB-TDTAL-TOTAL TO TOTAL-OUT.
ADD SUB-TOTAL-BALANCE TO BALANCE-ALL.
ADD SUB-TOTAL-TOTAL TO TOTAL-ALL.
MOVE ZEROS TO SUB-TOTAL-BALANCE. SUB-TOTAL-TOTAL ,
ACCUM-ALL-SUBTUTAL.
MOVE DATA-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-DUT THRU MOVE-SPACES.
MOVE-OUT-ACCUMS.
MOVE ACCUM (I) TO DAT (I ) .
ADD ACCUM (I) TO ACCUM-ALL (I).
MOVE-OUT-TOTAL-ACCUMS.
MOVE ACCUM-ALL (I) TO DAT (I).
172
-------
* SORT ROUTINE
$
READ-SORT-INPUT.
READ CARD-IN AT END GO TO READ-SORT-INPUT-END.
IF ID1 NOT = TO SUURCE-COUE THEN
WRITE PRINT-LINE FROM INPUT-CARD AFTER ADVANCING 1
PERFORM MOVE-SPACES
GO TO READ-SORT-INPUT.
RELEASE SORT-INPUT FROM IiMPUT-CAR0 .
GO TO READ-SORT-INPUT.
READ-SORT-INPUT-END.
F X!! T .
WRITE-SORT-OUTPUT.
RETURN FILE-SORT RECORD INTU INPUT-RECS
AT END GO TO KRITE-SORT-OUTPUT-END.
WRITE INPUT-RfcCS.
GO TO WRITE-SORT-OUTPUT.
WR I TE-SORT-OUTPUT-END.
EXIT.
«•
* END SURT ROUTINE
it
CLOSE-FILES.
MOVE ZEROS TO CONTRACT-NO-HOLD,
PERFORM TUTAL-TEST THRU ERROR-DETECTION.
PERFORM WRITE-SUB-TOTAL.
PERFORM PRINT-LINE-OUT 2 TIMES.
MOVE 'TOTAL ' TO CONTRACT-OUT.
PERFORM MOVE-OUT-TOTAL-ACCUMS VARYING I
FROM 1 BY 1 UNTIL I = 8.
MOVE BALANCE-ALL TO BALANCE-OUT.
MOVE TOTAL-ALL TO TOTAL-OUT.
MOVE DATA-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
V.RITE-DISK-RECORDS.
MOVE SPACES TO DISK-OUT.
MOVE ACCT-N01 TO DISK-ACCT.
ADD ACCUM-ALL (3)
ACCUM-ALL (
-------
PGMNAME=WUASMTER
,SYSIN DO *
IDENTIFICATION DIVISION.
PROGRAM-ID. WUASMTER.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, FLA 32789 .
DATE-WRITTEN. DCT 5 1977.
DATE-COMPILED. OCT 7 1977.
REMARKS. THIS PROGRAM EDITS THE HISCELLANFDUS TRANSACTIONS
CARDS, TOTALS ALL COSTS, FLAGS ANY DISCREPANCIES.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE-
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TD UR-25fOR-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESURT
ACCESS MODE IS SEQUENTIAL.
SELECT SORTL-D-FILE
ASSIGN TO UT-3330-S-SORTEDFI
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTUUT
ACCESS MODE IS SEQUENTIAL.
SELECT FINANCIAL-ACCT-TABFI
ASSIGN TO DA-3330-I-FATABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS FA-NOMINAL
RECORD KEY IS FA-NUMBER.
SELECT COST-CNTR-TABFI
ASSIGN TO DA-3330-I-CCTABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS CC-NOMINAL
RECORD KEY IS CC-NUMBER.
SELECT SPECIAL-ACCT-TABFI
ASSIGN TO DA-3330-S-SATABFI
ACCESS MODE IS SEQUENTIAL.
SELECT FINANCIAL-COST-ALLOCATION
ASSIGN TO UT-3330-S-FICALFI
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
174
-------
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABtL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
02 ID1 PIC X.
02 ID2 PIC X(79) .
01 DATE-CARD.
02 DATE-IN PIC X(16).
02 TITLF-IN PIC x(2^>.
02 FILLER PIC X(38).
SD FILE-SORT
RECORD CONTAINS so CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
02 S-SUURCE-CODE-ND PIC X.
02 FILLER PIC X.
02 S-ENTRY-NO PIC X(3>.
02 FILLER PIC X.
02 S-ACCT-NO PIC X(10)•
02 FILLER PIC X(64).
FD SORTED-FILE
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-RECS.
01 INPUT-RECS.
02 SOURCE-COOE-NO PIC X.
02 FILLER PIC X.
02 ENTRY-NO PIC xm.
02 FILLER PIC x.
02 ACCT-IN PIC X(10).
02 FILLER PIC X.
02 COST-CTR-IN.
05 CC-FIRST-2-DI&ITS PIC XX.
05 CC-SECOND-2-DIGITS PIC XX.
02 FILLER PIC X.
02 INPUT-AMTS.
05 AMOUNT-IN PIC X(10).
05 AMT-1N REDEFINES AMOUNT-IN PIC S9(8)V99.
02 FILLER PIC X(
-------
01 CC-REC.
02 CC-NUMBER PIC 9U>.
02 CC-NAME PIC X( 13)
FD FINANCIAL-ACCT-TABFI
BLOCK CONTAINS 8 RECORDS
RECORD CONTAINS 58 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS FA-RfcC.
01 FA-REC.
05 FA-NUMBER PIC X( 10)
05 FA-NAME PIC X{20)
05 FILLER PIC X(8J.
FD SPECIAL-ACC T-TABFI
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS COST-CENTERS.
01 COST-CENTERS.
05 RECORD-COUNT.
10 NO-OF-RECS PIC 9K>.
10 FILLER PIC X(18) .
05 COST-CNTRS OCCURS 1 TO 99 TIMES
DEPENDING ON NO-OF-RECS
ASCENDING KEY IS CC-SIZE-2
INDEXED BY CC.
10 CC-SIZE-2 PIC X(2).
10 CC-SIZE-4 PIC X(4>.
10 FILLER PIC X( 16) .
FD FINANCIAL-CQST-ALLOCATION
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS DISK-OUT.
01 DISK-OUT.
05 01SK-ACCT
05 DISK-COST-CNTR
05 DISK-COST-CAT
OCCURS 2 TIMES.
OCCURS 2 TIMES
05 DISK-AMOUNT
01 FIRST-TWD-RECS.
05 FILLER
05 SORT-SEQUENCE
05 DISK-TITLE
WORKING-STORAGE SECTION
77 SOURCE-CODE
77 SEARCH-NO
77 LINE-CT
77 PAGE-CT
77 CR-AMT-ACCUM
77 DB-AMT-ACCUM
77 BALANCE-AMOUNTS
77 CR-TUTAL
PIC
PIC
PIC
PIC
X(10) .
XK).
X(2).
S9(S)V99.
PIC X.
PIC X.
PIC X(24).
PIC X VALUE «5« .
PIC XX VALUE SPACES.
PIC 99 COMP VALUE U.
PIC 9U) CLMP VALUE 0.
PIC S9(8)V99 COMP VALUE ZERO
PIC S9(8)V99 CQMP VALUE ZERO,
PIC S9(8)V99 COMP VALUE ZERO,
PIC S9(8)V99 COMP VALUE ZERO,
176
-------
77
77
77
77
77
77
77
01
01
01
01
01
DB-TOTAL
ENTRY-NO-HOLD
ACCT-HOLD
I
MAX-LINE
FA-NOMINAL
CC-NOMINAL
HEAD
02
02
02
HEAD
02
02
02
02
02
02
02
02
02
HEAD
02
02
02
HEAD
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
I
F
F
F
I
F
F
NG-1 .
ILLER
ILLER
ILLER
NG-2.
ILLER
ILLER
DATE-OUT
F
F
F
F
ILLfR
ILLER
ILLER
ILLER
PAGE-OUT
F
I
F
T
F
I
F
ILLER
NG-3.
ILLER
ITLE-OUT
ILLER
NG-4.
ILLER
FILLER
F
F
F
F
F
F
F
F
F
F
F
F
F
DATA-
02
02
02
02
02
02
02
F
ILLER
ILLER
ILLFR
ILLER
ILLER
ILLER
ILLER
ILLER
ILLER
ILLER
ILLER
ILLER
ILLER
LINE.
ILLER
ENTRY-NO-OUT
F
ILLER
ACCT-OUT
F
ILLER
COST-CTR-OUT
F
ILLER
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
I
I
1
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
C
C
C
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
S9
X(
x<
9
99
X(
XI
X(
X(
X(
X
X(
X(
X(
X(
X(
XI
(8)V99 COMP VALUE ZERO.
3) VALUE ZEROS.
10) VALUE ZERO.
COMP VALUE 0.
COMP VALUE 56.
10) .
4).
49)
33)
51 )
VALUE
i VALUE
> VALUE
SPACE
•M1SC
'ONS
SPACE
S .
ELLANEOUS
RE PORT ' .
S.
VALUE SPACES.
13]
18]
331
3)
53)
5)
I VALUE
1 VALUE
i VALUE
VALUE
VALUE
VALUE
•DATE
SPACE
SPACE
'FOR' .
SPACE
ENDING: '
S .
S.
S.
•PAGE '.
ZZZ9.
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
3)
54)
24]
55]
2)
12]
5)
14]
5)
11)
9)
b)
6)
12]
6)
11)
14]
7)
13]
7) ,
3) ,
12)
10)
10]
4),
8),
VALUE
i VALUE
1 VALUE
1 VALUE
VALUE
1 VALUE
VALUE
I VALUE
VALUE
i VALUE
VALUE
VALUE
VALUE
1 VALUE
VALUE
1 VALUE
1 VALUE
VALUE
1 VALUE
i
i
1 .
i .
\ .
I
»
SPACES
SPACE
SPACE
SPACE
SPACE
.
S.
S.
S.
S .
•ENTRY NUMBER'.
SPACE
S.
'ACCOUNT NUMBER
SPACE
'COST
S.
CENTER ' .
SPACES .
•AMOUNT1 .
SPACE
•CRED
SPACE
'DEBI
SPACE
S.
IT TOTAL' .
S.
T TOTAL' .
S.
•COMMENT' .
SPACE
S.
TRANSACTI
177
-------
01
01
02 AMOUNT-OUT
02 FILLER
02 CR-TOTAL-OUT
02 FILLER
02 OB-TDTAL-DUT
02 FILLER
02 COMMENT
02 FILLER
ERROR-CODE .
02 ERR-CODE
ERROR-LIST.
02 ERR-LIST-A.
05 ERR-LIST1
PIC Z(8).ZZCR.
PIC XX.
PIC Z(8 J.ZZCR.
PIC X(5).
PIC -(8)---.
PIC X(7l.
PIC X(25) VALUE
PIC X(3).
OCCURS 3 TIMtS PIC 9
PIC X(IOO) VALUE
SPACES
05 ERR-LIST2 PIC X(100)
•ACCOUNT NUMBER foOT FOUND
•COST CENTER NOT NUMERIC
'COST CENTER NOT FOUND
'AMOUNT NOT NUMERIC
VALUE 'TOTAL AMOUNT NOT NUMERIC
•CR AMTS NOT = TO CR TOTAL
•DB AMTS NOT = TO DB TOATl
•TOTALS DO NOT BALANCE '.
02 ERR-LIST-B REDEFINES ERR-LIST-A.
05 ERR-LIST OCCURS 8 TIMES PIC X(25).
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN.
OPEN OUTPUT PRINT-OUT, SORTED-FILE,
FINANCIAL-COST-ALLOCATION.
READ-TITLE-CARD.
READ CARD-IN AT END GO TO WRITE-FINAL-TOTALS .
MOVE SPACES TO DISK-OUT.
MOVE DATE-IN TO DATE-OUT, DISK-TITLE.
WRITE DISK-OUT.
MOVE SPACES TU DISK-OUT.
MOVE TITLE-IN TO TITLE-OUT, DISK-TITLE.
MOVE SOURCE-CODE TO SORT-SEQUENCE-
WRITE DISK-OUT.
PERFORM MOVE-SPACES THRU PR 1 NT-LINE-QUT .
MOVE ' THE FOLLOWING CARDS HAVE A INVALID SOURCE CODE'
TU PRINT-LINE .
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT.
SORT-RECORDS .
SORT FILE-SORT ON ASCENDING KEY
S-ENTRY-NO
S-ACCT-NO
INPUT PROCEDURE READ-SORT-INPUT
THRU READ-SORT-INPUT-END
OUTPUT PROCEDURE WRITE-SORT-QUTPUT
THRU WRITE-SORT-OUTPUT-END.
CLOSE-SURT-FILES.
178
-------
CLOSF SGRTED-FILF, CARD-IN.
OPEN INPUT SORTED-FILE. F]NANCIAL-ACCT-TABFI .
CGST-CNTR-TABFI, SPECIAL-ACCT-TABFI.
HOUSEKEEPING.
MOVE ZEROS TO ERROR-CODE.
READ SPECIAL-ACCT-TABFI AT END
MOVE 'COST CENTER TABLE CONTAINS NO DATA1 TO
PRINT-LINE,
PERFORM PRINT-LIME-OUT
GO TO CLOSE-FILES.
WRITE-HEADINGS.
MOVE 0 TO LINE-CT.
ADD 1 TD PAGE-CT.
MOVE PAGE-CT TO PAGE-OUT.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE ADVANCING NEW-PAGE.
MOVE HEADING-1 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
MOVE HEADING-2 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT .
MOVE HEADING-3 TO PRINT-LINt.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR INT-LINE-OUT.
MOVE HEADING-^ TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM MOVt-SPACES THRU PRINT-LINE-OUT.
READ-RECORDS.
READ SORTED-FILE AT END GO TO WRITE-FINAL-TOTALS .
EDIT-RECORDS.
EXAMINE INPUT-AMTS REPLACING ALL SPACES BY ZEROS.
EXAMINE COST-CTR-IN REPLACING ALL SPACES BY ZEROS.
IF ENTRY-NO NOT = TO ENTRY-UD-HULD THEN
MOVE ENTRY-NO TO ENTRY-NO-HbLD , ENTRY-NO-OUT
ELSE MOVE SPACES TO ENTRY-NO-OUT.
IF ACCT-IN NOT - ACCT-HOLD THEN
MOVE ACCT-IN TD ACCT-HOLD, ACCT-OUT, FA-NOMINAL,
READ FINANCIAL-ACCT-TABFI INVALID KEY
MOVt 1 TO ERR-CODE ( 1) .
MOVE ACCT-IN TO DISK-ACCT, ACCT-OUT.
IF COST-CTR-IN NOT NUMERIC
MOVE 1 TO ERR-COOE (2)
MOVE SPACES TO COST-CTR-IN, DISK-COST-CNTR.
IF COST-CTR-IN = TO ZEROS THEN
MOVE SPACES TO COST-CTR-IN, DISK-COST-CNTR
ELSE PERFORM FIND-COST-CNTR .
IF AMOUNT-IN > 0 THEN
ADD AMT-IN TO DB-AMT-ACCUM
ELSE ADD AMT-IN TO CR-AMT-ACCUM.
MOVE AMT-IN TO AMOUNT-OUT, DISK-AMOUNT.
WRlyE-LINE-OUT.
179
-------
IF ERROR-CODE NOT = ZERO THEN
PERFORM hOVfc-IN-ERRORS VARYING I
FROM 1 BY 1 UNTIL ERRGR-COOE = ZEROS
ELSE MOVE DATA-LINE TO PRINT-LINE
PERFORM PRINT-LINE-OUT.
WRITE-DISK.
WRITE DISK-OUT
MOVt SPACES TO DISK-OUT.
PERFORM READ-RECORDS.
IF ENTRY-NO NOT = ENTRY-NO-HDLD THEN
PERFORM WRITE-SUBS.
IF LINE-CT > MAX-LINE THEN
PERFORM WRITE-HEAOINGS.
GO TO EDIT-RECORDS.
FIND-COST-CNTR.
IF CC-FIRST-2-DIGITS NOT = ZEROS THEN
MOVE COST-CTR-IN TO CC-NOKINAL
READ COST-CNTR-TABFI INVALID KEY
MOVE 1 TO ERR-CODE (3)
ELSE PERFORM SEARCH-CC.
MOVE COST-CTR-IN TO DISK-COST-CNTR.
MOVE-IN-ERRORS.
IF ERR-CODE (I) NOT = ZEROS THEN
MOVE ERR-LIST (I) TO COMMENT
MOVE DATA-LINE TO PRINT-LINE
PERFORM PRINT-LINE-OUT
MOVE SPACES TO DATA-LINE
MOVE ZERO TO ERR-CODE (I).
PAGE-OVFLDW.
IF LINE-CT NOT < MAX-LINE THEN
PERFORM WRITE-SUBS
PERFORM WRITE-HEADINGS.
PAGE-OVFLOW-END.
EXIT.
SEARCH-CC.
MOVE CC-SECQND-2-DIGITS TO SEARCH-NO.
SET CC TO 1.
SEARCH ALL COST-CNTRS AT END
MOVE 1 TO ERR-CODE (3)
WHEN CC-SIZE-2 (CC) = TO SEARCH-NO
MOVE CC-SIZE-^ (CC) TO COST-CTR-IN.
WRITE-SUBS.
MOVE SPACES TO DATA-LINE.
MOVE CR-AMT-ACCUM TO CR-TOTAL-OUT .
MOVE DB-AMT-ACCUM TO D3-TOTAL-OUT.
ADD CR-AMT-ACCUM OB-AMT-ACCUM GIVING BALANCE-AMOUNTS.
IF BALANCE-AMOUNTS NOT = 0 THEN
MOVE ' CREDITS t DEBITS NOT = ' TO COMMENT
ELSE MOVE SPACES TO COMMENT.
PERFORM WRITE-LINE-OUT.
180
-------
ADD CR-AMT-ACCUM TO CR-TDTAL.
ADD DB-AMT-ACCUh TO DB-TOTAL.
MOVE ZEROS TO CR-AMT-ACCUM,
DB-AMT-ACCUM.
MOVE SPACES TU DATA-LINE.
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE ADVANCING 1.
ADD 1 TU LINE-CT.
* SORT ROUTINE
tf
READ-SORT-INPUT.
READ CARD-IN AT END GO TO READ-SORT-INPUT-END.
IF 101 NOT = TO SUURCE-CODE THEN
WRITE PRINT-LINE FROM INPUT-CARD AFTER ADVANCING
PERFORM MOVE-SPACES
GO TO READ-SDRT-INPUT.
RELEASE SORT-INPUT FROM INPUT-CARD.
GO TO READ-SORT-INPUT.
READ-SORT-INPUT-END.
EXIT.
WRITE-SGRT-OUTPUT.
RETURN FILE-SURT RECORD INTO INPUT-RECS
AT END GO TO WRITE-SDRT-OUTPUT-END.
WRITE INPUT-RECS.
GO TO WRITE-50RT-OUTPUT.
WRITE-SORT-OUTPUT-END.
EXIT.
*
* END SORT ROUTINE
*
WRITE-F1NAL-TUTALS.
PERFORM WRITE-SUBS.
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT.
PERFORM PRINT-LINE-OUT 2 TIMES.
MOVE SPACES TU DATA-LINE.
MOVE CR-TOTAL TO CR-TUTAL-OUT.
MOVE OB-TOTAL TO DB-TOTAL-OUT.
MOVE DATA-LINE TO PRINT-LINE-
PERFORM PRINT-LINE-OUT.
CLOSE-FILES.
CLOSE SORTED-FILE, FINANCIAL-ACCT-TABFI,
SPECIAL-ACCT-TABFI, FINANCIAL-COST-ALLOCATION,
COST-CNTR-TABFI, PRINT-OUT.
E-O-J.
STOP RUN.
181
-------
PGMNAME=WUASPAER
SYSIN DD *
IDENTIFICATION DIVISION.
PROGRAM-ID. WUASPAER.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 M MORSE BLVD
WINTER PARK, FLA 32789 .
DATE-WRITTEN. OCT 5 1977.
DATE-COMPILED. OCT 6 1977.
REMARKS. THIS PROGRAM EDITS THE PAYMENT AUTHORIZATION DATA
CARDS, TOTALS ALL COSTS, FLAGS ANY DISCREPANCIES.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. 1BM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGu TO UR-2540R-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESORT
ACCESS MODE IS SEQUENTIAL.
SELECT SORTED-FILE
ASSIGN TO UT-3330-S-SORTEDFI
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1A03-5-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
SELECT FINANCIAL-ACCT-TABFI
ASSIGN TO DA-3330-I-FATABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS FA-NOMINAL
RECORD KEY IS FA-NUMBER.
SELECT COST-CNTR-TABFI
ASSIGN TO DA-3330-I-CCTABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS CC-NOMINAL
RECORD KEY IS CC-NUMBER.
SELECT SPECIAL-ACCT-TABFI
ASSIGN TO DA-3330-S-SATABFI
ACCESS MODE IS SEQUENTIAL.
SELECT FINANCIAL-COST-ALLOCATION
ASSIGN TO UT-3330-S-FICALFI
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
182
-------
FD CARO-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
02 101 PIC X.
02 ID2 PIC X (79 ).
01 DATE-CARD.
02 DATE-IN PIC X( IB) .
02 TITLF-IN PIC X(2<+).
02 FILLER PIC X(3d ) .
SD FILE-SORT
RECURD CONTAINS 80 CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
02 S-SOURCE-CODE-NO PIC X.
02 FILLER PIC X.
02 S-PAY-AUTH PIC X(10) .
02 FILLER PIC x(68>.
FD SORTED-FILE
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-RECS.
01 INPUT-RECS.
02 SOURCE-CODE-NO PIC X.
02 FILLER PIC X.
02 PAY-AUTH-IN PIC X( 10) .
02 FILLER PIC X.
02 ACCT-IN PIC X(10).
02 FILLER PIC X.
02 CDST-CTR-IN.
05 CC-FIkST-2-DIGITS PIC XX.
05 CC-SECOND-2-DIGIT5 PIC XX.
02 FILLER PIC X.
02 AMOUNT-IN PIC X(10) .
02 AMT-IN REDEFINES AMOUNT-IN PIC 59(8)V99
02 FILLER PIC X.
02 TUTAL-IN PIC X( 1Q) .
02 TOT-IN REDEFINES TOTAL-IN PIC S9(8)V99.
02 FILLER PIC X(30) .
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE PIC X( 133) .
FD COST-CNTR-TABFI
BLOCK CONTAINS 6 RECORDS
RECORD CONTAINS 30 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CC-REC .
183
-------
X(10)
X(20)
X(6).
TIMES
01 CC-REC.
02 CC-NUMBER PIC
02 CC-NAME PIC
FD FINANCIAL-ACCT-TABFI
BLOCK CONTAINS 8 RECORDS
RECORD CONTAINS 58 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS FA-REC.
01 FA-REC.
05 FA-NUMBER PIC
05 FA-NAME PIC
05 FILLER PIC
FD SPECIAL-ACCT-TABFI
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS COST-CENTERS.
01 COST-CENTERS.
05 RECORD-COUNT.
10 NO-OF-RECS PIC 9(4).
10 FILLER PIC X (18)
05 COST-CNTRS OCCURS 1 TO 99
DEPENDING ON NO-OF-RECS
ASCENDING KEY IS CC-SIZE-2
INDEXED BY CC.
10 CC-SIZE-2 PIC X(2>.
10 CC-SIZE-4 PIC X(4),
10 FILLER PIC X( 16) .
FD FINANCIAL-COST-ALLOCATION
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS DISK-OUT.
01 DISK-OUT.
05 DISK-ACCT PIC X(10) .
05 DISK-COST-CNTR PIC X(4).
05 DISK-COST-CAT PIC X(2).
05 DISK-AMOUNT PIC S9(8)V99
01 FIRST-TwO-RECS.
05 FILLER PIC X.
05 SORT-SEQUENCE PIC X.
05 DISK-TITLE PIC X{24) .
WORKING-STORAGE SECTION.
X(13) OCCURS 2 TIMES
OCCURS 2 TIMtS.
77 SOURCE-CODE
77 SEARCH-NO
77 LINE-CT
77 PAGE-CT
77 AMT-ACCUM
77 AMT-SUB-TOTAL
77 TOTAL-SUB-TQTAL
77 TOTAL-HOLD
PIC X VALUE '4' .
PIC XX VALUE SPACES.
PIC 99 CCMP VALUE 0.
PIC 9(4) CLMP VALUE 1.
PIC S9(8)V99 COMP VALUE 0.
PIC S9(8)V99 COMP VALUE 0.
PIC S9(8)V99 COMP VALUE 0.
PIC S9OJV99 COMP VALUE 0.
184
-------
77
77
77
77
77
77
77
77
77
01
01
01
01
01
TOTAL-ALL
AMT-ALL
PAY-AUTH-HOLD
NUMERIC-HOLD
I
MAX-LINE
FA-NOMINAL
CC-NOMINAL
PRINT-PA Y-AUTH-FLAG
88 FLAG-ON
88 FLAG-OFF
HEAD
02
02
02
HEAD
02
02
02
02
02
02
02
02
02
02
HEAD
02
02
02
HEAD
02
02
02
02
02
02
02
02
02
02
02
02
02
ING-1
FILLE
FILLE
FILLE
ING-2
FILLE
FILLE
DATE-
FILLE
FILLE
FILLE
FILLE
.
R
R
R
.
R
R PIC X(13)
OUT
R
R
R
R
PAGE-OUT
FILLE
FILLE
ING-3
FILLE
TITLE
FILLE
ING- A
FILLE
FILLE
FILLE
R
R
.
R
-OUT
R
.
R
R
R
FILLER
FILLE
FILLE
FILLE
FILLE
FILLE
FILLE
FILLE
FILLE
FILLE
R
R
R
R
R
R
R
R
R
PIC S9
PIC S9
PIC X(
PIC X(
PIC 9
PIC 99
PIC X(
PIC X(
PIC X
VALUE
VALUE
P
P
P
P
I
I
I
I
VA
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
C
C
c
c
X (
X(
X(
X
LUE
C
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
X(
X(
X(
X(
X(
zz
X(
X(
X(
X(
X(
X(
X (
X (
X(
X(
X (
X-(
X(
X(
X(
X (
X(
X(
( 10
( 10
10)
10)
COM
CD
10)
4> .
VAL
' 1 '
•0'
51
28
53
)
)
)
)V99 COMP VALUE 0.
)V99 COMP VALUE 0.
VALUE SPACES.
VALUE SPACES.
P VALUE 0.
MP VALUE 50.
UE ' 1 ' .
VALUE
VALUE
VALUE
SPAC
'PA
'R
SPAC
ES.
YMENT AUTHORIZATION
EPURT ' .
ES.
VALUE SPACES.
•DA
18
33
3)
53
5»
Z9
3)
4)
54
24
55
17
15
8)
9 )
5)
11
9)
6)
11
5)
11
8)
18
)
)
)
•
)
)
)
)
)
)
)
)
)
TE END
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
ING:
SPAC
SPAC
'FOR'
SPAC
i
ES .
ES.
.
ES.
'PAGE '.
SPACE
SPAC
SPAC
SPAC
SPAC
SPAC
S .
fcS.
ES.
ES.
ES .
ES .
•PAYMENT AUTH. #'.
SPACE
S.
'ACCOUNT #'.
SPACE
•cus
SPACE
S .
T CENTER1 .
S.
'AMOUNT' .
SPAC
•TOTA
SPAC
•COrtM
SPAC
ES.
L ' .
ES.
ENTS' .
ES.
DATA-LINE .
02
02
02
02
FILLE
PAY-A
FILLE
ACCT-
R
UTH-OUT
R
OUT
P
P
P
P
I
I
I
I
c
c
c
c
x(
X(
X(
X(
20
)
VALUE
SPAC
ES.
10) .
10
10
)
)
VALUE
,
SPAC
ES .
185
-------
01
01
02 FILLER
02 CQST-CTR-DUT
02 FILLER
02 AMOUNT-OUT
02 FILLER
02 TOTAL-OUT
02 FILLFR
02 COMMENT
02 FILLER
ERROR-CUDE.
02 ERR-CODE
ERROR-LIST.
02 ERR-LIST-A.
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
X!
XI
XI
XI
-1
XI
X
Xi
[8 }
( 4 }
1 8 f
!8 )
15)
I8>
1 5)
(25
(6)
VALUE SPACES
VALUE SPACES.
VALUE SPACES
VALUE SPACES.
i VALUE SPACES
VALUE SPACES
OCCURS 7 TIMES PIC 9
05 ERR-LIST1 PIC X(75) VALUE
05 ERR-LIST2 PIC X{100)
01
•ACCOUNT NUMBER NOT FOUND
•PAY AUTHORTY NOT NUMERIC
•COST CENTER NOT NUMERIC ',
VALUE 'COST CENTER MOT FOUND
•AMOUNT NOT NUMERIC
•TOTAL NOT NUMERIC
•AMOUNTS C TOTAL NOT EQUAL'.
02 ERR-LIST-B REDEFINES ERR-LlST-A.
05 ERR-LIST OCCURS 7 TIMES PIC X(25).
SUB-LINE.
X(5) VALUE SPACES.
X(ll) VALUE SPACES.
X(52) VALUE SPACES.
-(10).--.
X(3) VALUE SPACES.
-( 10) .--.
X(36) VALUE SPACES.
02
02
02
02
02
02
02
PIC
PIC
PIC
PIC
PIC
PIC
PIC
FILLER
S-T-COMMENT
FILLER
AMT-ALL-OUT
FILLER
TOTAL-ALL-OUT
FILLER
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN.
OPEN OUTPUT PRINT-OUT, SORTED-FILE.
FINANCIAL -COST -ALLOCATION.
READ-TITLE-CARD.
READ CARD-IN AT END GO TO WR 1 TE-F INAL-TOT ALS .
MOVE SPACES TO DISK-OUT.
MOVE DATE-IN TO DATE-OUT, DISK-TITLE.
WRITE DISK-OUT.
MOVE SPACES TO DISK-OUT.
MOVE TITLE-IN TO TITLE-OUT, DISK-TITLE.
MOVE SOURCE-CODE TO SOR T -SEQ JENC E .
WRITE DISK-OUT.
MOVE SPACES TO PRINT-LINE.
MOVE ' THE FOLLOWING CARDS HAVE A INVALID SOURCE
TO PRINT-LINE .
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT.
SORT-RECORDS.
CODE
186
-------
SORT FILE-SORT ON ASCENDING KEY
S-PAY-AUTH
INPUT PROCEDURE READ-SORT-lNPUT
THRU READ-SORT-INPUT-END
OUTPUT PROCEDURE WRITE-SORT-OUTPUT
THRU WRITE-SORT-OUTPUT-END.
CLOSE-SORT-FILES.
CLOSE SORTED-FILE, CARD-IN.
OPEN INPUT SQRTED-F1LE, F INANClAL-ACCT-TAbFI ,
COST-CNTR-TABFI, SPfcC1AL-MCCT-TABFI.
HOUSEKEEPING.
MOVE ZEROS TO ERROR-CODE.
READ SPECIAL-ACCT-TABFI AT END
MUVE 'COST CENTER TABLE CuNTAINS tvO DATA' TU
PRINT-LINE,
PERFORM PRINT-LINE-OUT
GO TO CLOSE-FILES.
WRITE-HEADINGS.
MOVE 0 TO LINE-CT.
MUVE PAGE-CT TO PAGE-OUT.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE ADVANCING NEW-PAGE.
MOVE HEADING-1 TO PRINT-LINE.
PERFORM PRINT-LINE-OJT.
MOVE HEADING-2 TO PRINT-LINE.
PERFORM PRIhlT-LINE-OUT.
MOVE HEADING-3 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR1NT-LINE-OUT.
MOVE HEADING-4 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR 1NT-LINE-OUT.
ADD 1 TU PAGE-CT.
READ-RECORDS.
READ SORTED-FILE AT END GO TO WRITE-FINAL-TUTALS .
EDIT-RECORDS.
MOVE ACCT-IN TO ACCT-OUT, FA-NOMINAL, D1SK-ACCT.
READ FINANCIAL-ACCT-TABFI INVALID KEY
MOVE 1 TO ERR-CODt ( 1 ) .
MOVE PAY-AUTH-IN TO PAY-AUTH-HOLD.
IF FLAG-ON MOVE PAY-AUTH-IN TO PAY-AUTH-OUT
ELSE MOVE SPACES TO PAY-AUTH-OUT.
MOVt COST-CTR-IN TO COST-CTR-QUT.
EXAMINE INPUT-RECS REPLACING ALL ' ' BY '0'.
IF PAY-AUTH-IN NOT NUMERIC MOVE 1 TG ERR-CODE (2>
IF COST-CTR-IN NOT NUMERIC MOVE 1 TO ERR-COOE (3)
MOVE ZEROS TO CQST-CTR-1N.
IF COST-CTR-IN NOT = ZEROS THEN
PERFORM FIND-COST-CNTR.
MOVE AMT-1N TO AMOUNT-OUT, DISK-AMOUNT.
187
-------
ADD AMT-IN TO AMT-ACCUM* AMT-SUB-TOTAL .
IF TOT-IN NOT = TU 0 THEN MOVE TOT-IN TO TUTAL-HOLD.
ADD TOTAL-HOLD TO TOTAL-SUB-TOTAL.
MOVE 0 TO TOTAL-OUT.
READ-NEXT-REC.
PERFORM READ-RECORDS.
CHECK-NEXT-REC.
MOVE PAY-AUTH-IN TO NUMERIC-HOLU.
IF NUMERIC-HOLD = TU PAY-AUTH-HOLD THEN
MOVE •()' TIJ PRINT-PAY-AUTH-FLAG
GO TO kRlTE-LlNE-OUT.
MOVE 'I1 TO PRINT-PAY-AUTH-FLAG.
MOVE TOTAL-HOLD TO TOTAL-OUT.
IF TOTAL-HOLD NOT = TO AMT-ACCUM THEN
MOVE 1 TL bRR-COUE (7).
MOVE ZEROS TO AMT-ACCUMt TOTAL-HOLD.
WRITE-LIME-OUT.
IF ERROR-CODE NOT = TO ZEROS THtN
PERFORM MOVE-IN-ERRORS VARYING I
FROM 1 BY 1 UNTIL ERROR-CODE = ZEROS
ELSE MOVE DATA-LINE TO PRINT-LINE
PERFORM PRINT-LINE-OUT
WRITE DISK-OUT
MOVE SPACES TO DISK-OUT.
IF FLAG-ON THEN
PERFORM PAGE-OVFLOW THRU PAGE-OVFLOW-END .
GO TO EDIT-RECORDS.
FIND-COST-CNTR.
IF CC-F1RST-2-DIGITS NOT = ZEROS THEN
MOVE COST-CTR-IN TO CC-NOMINAL
READ COST-CNTR-TABFI INVALID KEY
MOVE 1 TO ERR-CODE (
-------
SEARCH ALL CDST-CNTRS AT END
MOVE 1 TO ERR-COOE (4)
WHEN CC-SIZE-2 (CO = TO SEARCH-NO
MOVt CC-SIZE-4 (CO TO COST-CTR-1N.
WRITE-SUB-TOTALS .
PERFORM MOVE-SPACES THRU PR INT-L I NE-OUT.
PERFORM PRINT-LINE-OUT.
MOVE 'SUB TOTAL ' TO S-T-COMMEKT.
MOVE AMT-SUB-TOTAL TO AMT-ALL-OUT.
MOVE TOTAL-SUB-TOTAL TO TUTAL-ALL-OUT.
MOVE SUB-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
ADO AMT-SUB-TOTAL TO AMT-ALL.
ADD TOTAL-SUB-TGTAL TO TOTAL-ALL.
MOVE ZEROS TO AMT-SUB-TUTAL, TOTAL-SUB-TOTAL.
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE ADVANCING 1.
ADD 1 TU LINE-CT.
•
READ-SORT-INPUT.
READ CARD-IN AT END GO TO READ-SORT-INPUT-END.
IF ini NOT = TO SOURCE-CODE THEN
WRITE PRINT-LINE FROM INPUT-CARD AFTER ADVANCING 1
PERFORM MOVE-SPACES
GO TO READ-SORT-INPUT.
RELEASE SORT-INPUT FROM INPUT-CARD.
GO TO READ-SORT-INPUT.
READ-SORT-INPUT-END.
EXIT.
WRITE-SORT-OUTPUT.
RETURN FILE-SORT RECORD INTO INPUT-RECS
AT END GO TO *RITE-SORT-OUTPUT-END.
WRITE INPUT-RECS.
GO TO WRITE-SORT-OUTPUT.
WRITE-SORT-OUTPUT-END.
EXIT.
<•
* END SORT ROUTINE
<•
WRITE-FINAL-TDTALS.
IF ERROR-CODE = TO ZERO THEN
WRITE DISK-OUT.
MOVE TOTAL-HOLD TO TOTAL-OUT.
MOVE DATA-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR1NT-LIME-OUT.
PERFORM WRITE-SUB-TOTALS.
PERFORM MOVE-SPACES THRU PR I NT-LINE-OUT.
189
-------
PERFORM PRINT-LINE-OUT.
MOVE 'GRAND TUTAL' TO S-T-COMKEMT.
MDVb TOTAL-ALL TO TOTAL-ALL-OUT.
MOVE AMT-ALL TO AMT-ALL-OUT.
MOVE SUB-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
CLOSE-FILES.
CLOSE SORTEU-FILE, FINANCIAL-ACCT-TABF I,
SPECIAL-ACCT-TABFI, FINANCIAL-COST-ALLOCAT ION,
COST-CNTR-TABFI , PRINT-OUT.
E-O-J.
STOP RUN.
190
-------
PGMNAME=WUASRSER
SYSIN DO *
IDENTIFICATION DIVISION.
PROGRAM-ID. WUASRSER.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, FLA 32789 .
DATE-WRITTEN. OCT 3 1977.
DATE-COMPILED. OCT 5 1977.
REMARKS. THIS PROGRAM EDITS THE REQUISITION FOR STUCK DATA
CARDSt TOTALS ALL COSTS, FLAGS ANY DISCREPANCIES.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESORT
ACCESS MODE IS SEQUENTIAL.
SELECT SORTED-FILE
ASSIGN TO UT-3330-S-SORTEDFI
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-GUT
ASSIGN TO UR-1403-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
SELECT FINANCIAL-ACCT-TABFI
ASSIGN TO DA-3330-I-FATABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS FA-NOMINAL
RECORD KEY IS FA-NUMBER.
SELECT COST-CNTR-TABFI
ASSIGN TO DA-3330-I-CCTABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS CC-NOMINAL
RECORD KEY IS CC-NUMBER.
SELECT SPECIAL-ACCT-TABFI
ASSIGN TO DA-3330-S-SATABFI
ACCESS MODE IS SEQUENTIAL.
SELECT FINANCIAL-COST-ALLOCATION
ASSIGN TO UT-3330-S-FICALFI
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
191
-------
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
02 ID1 PIC X.
02 ID2 PIC X(79) .
01 DATE-CARD.
02 DATE-IN PIC X(18).
02 TITLE-IN PIC X(24).
02 FILLER PIC X(38) .
SD FILE-SORT
RECORD CONTAINS eo CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
02 S-SOURCE-CODE-NO PIC X.
02 FILLER PIC X.
02 S-REQ-NO PIC X(lO).
02 FILLER PIC X(b8).
FD SORTED-FILE
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-RECS.
01 INPUT-RECS.
02 SOURCE-CODE-NO PIC X.
02 FILLER PIC X.
02 REQ-IN PIC X(10).
02 FILLER PIC X.
02 ACCT-IN PIC X(10) .
02 FILLER PIC X.
02 COST-CTR-IN.
05 CC-FIRST-2-DIGITS PIC XX.
05 CC-SECOND-2-DIGITS PIC XX.
02 FILLER PIC X.
02 AMOUNT-IN PIC X(10) .
02 AMT-IN REDEFINES AMOUNT-IN PIC S9(8)V99,
02 FILLER PIC X.
02 TOTAL-IN PIC X(10).
02 TUT-IN REDEFINES TOTAL-IN PIC S9(8)V99.
02 FILLER PIC X(30) .
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE PIC X(133>.
FD COST-CNTR-TABFI
BLOCK CONTAINS 8 RECORDS
RECORD CONTAINS 30 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CC-REC.
192
-------
XU3) LCCURS 2 TIMES
X(10)
X(2G)
X(8).
01 CC-REC.
02 CC-NUMBER PIC
02 CC-NAME PIC
FD FINANCIAL-ACCT-TABFI
BLOCK CONTAINS 3 RECORDS
RECORD CONTAINS 5d CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS FA-REC.
01 FA-REC.
05 FA-NUMBER PIC
05 FA-NAME PIC
05 FILLER PIC
FD SPECIAL-ACCT-TABFI
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS COST-CENTERS.
01 COST-CENTERS.
05 RECORD-COUNT.
10 NO-OF-RfcCS PIC 9U).
10 FILLER PIC X< 18) .
05 COST-CNTRS OCCURS i TO 99 TIMES
DEPENDING ON NO-OF-RECS
ASCENDING KEY IS CC-SIZE-2
INDEXED BY CC.
10 CC-SIZE-2 PIC X(2).
10 CC-SIZE-4 PIC X(
-------
77
77
77
77
77
77
77
77
77
01
01
01
01
01
AMI-ALL
REQ-HOLD
NUMERIC-HOLD
TOTAL-HOLD
I
MAX-LINfc
FA-NOMINAL
CC-NOMINAL
PRINT-REQ-FLAG
88 FLAG-ON
88 FLAG-OFF
HEADING-1 .
02 FILLER
02 FILLFR
02 FILLER
HEADING-2.
02 FILLER
02 FILLER
02 DATE-OUT
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 PAGE-OUT
02 FILLER
HEAOING-3.
02 FILLER
02 TITLE-OUT
02 FILLER
HEADING-4.
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLFR
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
DATA-LINE.
02 FILLER
02 REQ-OUT
02 FILLER
02 ACCT-OUT
PIC S9(10)V99 COMP VALUE 0.
PIC X(10) VALUE SPACES.
PIC X(10) VALUE SPACES.
PIC S9(6)V99 COMP VALUE 0«
PIC 9 COhP VALUE 0.
PIC 99 COMP VALUE 50.
PIC X( 10) .
PIC X(O.
PIC X VALUE '1 ' .
VALUE 'I1.
VALUE '0'.
PIC X(i>l) VALUE SPACES.
PIC X(29) VALUE 'REQUISITION
' REPORT1 .
PIC X(53) VALUE SPACES.
PIC X VALUE SPACES.
PIC X(13) VALUE 'DATE ENDING:
PIC X(18) VALUE SPACES.
PIC X(33) VALUE SPACES.
PIC X(3) VALUE 'FOR ' .
PIC X(53) VALUE SPACES.
PIC X(5) VALUE 'PAGE '.
PIC 1119.
PIC X(3> VALUE SPACES.
PIC X(54) VALUE SPACES.
PIC X(24) VALUE SPACES.
PIC X(55) VALUE SPACES.
PIC X VALUE SPACES.
PIC X(10) VALUE SPACES.
PIC X(13) VALUE 'REQUISITION
PIC X(7> VALUE SPACES.
PIC X(9) VALUE 'ACCOUNT »' .
PIC X(6) VALUE SPACES.
PIC X(ll) VALUE 'COST CENTER'
PIC X(8) VALUE SPACES.
PIC X(6) VALUE •AMOUNT1.
PIC X(10) VALUE SPACES.
PIC X(5) VALUE 'TOTAL' .
PIC X(15) VALUE SPACES.
PIC X(8> VALUE 'COMMENTS' .
PIC XU4) VALUE SPACES.
PIC X(10) VALUE SPACES.
PIC X( 10) .
PIC X(10) VALUE SPACES.
PIC X(10) .
FROM STOCK
194
-------
01
01
02 FILLER
02 COST-CTR-OUT
02 FILLER
02 AMOUNT-OUT
02 FILLER
02 TUTAL-OUT
02 FILLER
02 COMMENT
02 FILLER
ERROR-CODE .
02 ERR-CODE
ERROR-LIST.
02 ERR-LIST-A.
05 ERR-LIST1
PIC X(») VALUE S°ACES
PIC X(^) .
PIC X(8) VALUE SPACES
PIC -U ).--.
PIC X(H) VALUE SPACES.
PIC -(8 ).--.
PIC X(9) VALUE SPACES.
PIC X(25) VALUE SPACES
PIC X(13) VALUE SPACES
OCCURS 7 TIMES PIC 9.
PIC X175) VALUE
35 ERR-LIST2 PIC X(100)
01
'ACCOUNT NUMBER NOT FOUND
'REUUISIriON-NO NONNUMERIC
•COST CENTER NOT NUMERIC ' .
VALUE 'COST CENTER NOT FOUND
•AMOUNT NOT NUMERIC
•TOTAL NOT NUMERIC
•AMOUNTS c TOTAL NOT
02 ERR-LIST-B REDEFINES ERR-LIST-A.
35 ERR-LIST OCCURS 7 TIMES PIC X(25) .
SUB-LINE .
p
p
p
p
p
p
p
I
I
I
I
1
I
I
c
c
c
c
c
c
c
X
X
X
X
(
{
{
(
(
(
7
1
4*
1
2
1
)
1)
0)
0)
)
0)
VALUE
VALUE
VALUE
• "" ™ •
VALUE
• ~ ""* •
VALUE
SPAC
SPAC
SPAC
SPACE
SP-AC
ES
ES
ES
S.
ES
02 FILLER
02 S-T-COMMENT
02 FILLER
02 AMT-ALL-OUT
02 FILLER
02 TOTAL-ALL-OUT
02 FILLER
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN.
OPEN OUTPUT PRINT-OUT, SORTED-FJLE,
FINANCIAL-COST-ALLOCATION.
READ-TITLE-CARD.
READ CARD-IN AT END GO TO WRITE-FINAL-TOTALS .
MOVE SPACES TO DISK-OUT.
MOVE DATE-IN TO DATE-OUT, DISK-TITLE.
WRITE DISK-OUT.
MOVt SPACES TO DISK-OUT.
MOVE TITLE-IN TO TITLE-OUT, DISK-TITLE.
MOVE SOURCE-CODE TO SORT-SEQUENCE .
WRITE DISK-OUT.
MOVE SPACES TO PRINT-LINE.
MOVE ' THE FOLLOWING CARDS HAVE A INVALID SOURCE
TO PRINT-LINE .
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR INT-LINE-OUT.
SORT-RECORDS .
CODE
195
-------
SORT FILE-SORT ON ASCENDING KEY
S-REQ-NO
INPUT PROCEDURE READ-SORT-INPUT
THRU READ-SURT-1NPUT-END
OUTPUT PROCEDURE WR1TE-SORT-OUTPUT
THRU WRITE-SORT-OUTPUT-ENO.
CLQSE-sQRT-FILFS.
CLOSE SORTEO-FILE, CARD-IN.
OPEN INPUT SORTED-FILE, F1NANCIAL-ACCT-TABF I .
COST-CNTR-TABFI, SPEC IAL-ACCT-TABFI.
HOUSEKEEPING.
MOVE ZEROS TO ERROR-CODE.
READ SPECIAL-ACCT-TABFI AT END
MOVE 'COST CENTER TABLE CONTAINS NO DATA' TO
PRINT-LINE,
PERFORM PRINT-L1NE-OUT
GO TO CLOSE-FILES.
WRITE-HEADINGS.
MOVE 0 TO LINE-CT.
MOVE PAGE-CT TO PAGE-OUT.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE ADVANCING NEW-PAGE.
MOVE HEADING-1 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
MOVE HEADING-2 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
MOVE HEADING-3 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR1NT-LINE-OUT.
MOVE HEADING-^ TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR 1NT-LINE-OUT.
ADD 1 TO PAGE-CT.
READ-RECORDS.
READ SORTED-FILE AT END GO TO WRITE-FINAL-TOTALS.
EDIT-RECORDS.
MOVE ACCT-IN TO ACCT-DUT, FA-NOMINAL. DISK-ACCT.
READ FINANCIAL-ACCT-TABFI INVALID KtY
MOVE 1 TO ERR-CODE (1).
MOVE REQ-IN TO REU-HOLD.
IF FLAG-ON MOVE REQ-IN TO REQ-OUT
ELSE MOVE SPACES TO REQ-OUT.
MOVE COST-CTR-IN TO COST-CTR-OUT.
EXAMINE INPUT-RECS REPLACING ALL • • BY 'O1.
IF REQ-IN NOT NUMERIC MOVE 1 TO ERR-CODE (2).
IF COST-CTR-IN NOT NUMERIC MOVE 1 TD ERR-CODE (3)
MOVE ZEROS TO COST-CTR-IN.
IF COST-CTR-IN NOT = ZEROS THEN
PERFORM FIND-COST-CNTR.
MOVE AMT-IN TO AMOUNT-OUT, DISK-AMOUNT.
196
-------
ADD AMT-IN TO AMT-ACCUM, AMT-SUB-TDTAL .
IF TOT-IN NOT = TO 0 THEN MOVE TUT-IN TO TOTAL-HLJLD,
ADD TUTAL-HOLD TO TOTAL-SUB-TOTAL.
MOVE 0 TO TOTAL-OUT.
READ-NEXT-REC.
PERFORM READ-RECORDS.
CHECK-NEXT-REC.
MOVE REQ-IN TO NUMERIC-HOLD.
IF NUMERIC-HOLD = TO REQ-HOLD THEN
MOVE 'C» TO PRINT-REU-FLAG
GO TO WRITE-LINE-OUT.
MOVE '!' TO PRINT-REO-FLAG.
MOVE TOTAL-HOLD TO TOTAL-LUT.
IF TOTAL-HOLD NOT = TO AMT-ACCUM THEN
MOVE 1 TO ERR-CODE (7).
MOVE ZEROS TO AMT-ACCUM, TOTAL-HOLD.
WRITE-LINE-OUT.
IF ERROR-CODE NOT = ZERO THEN
PERFORM MQVE-IN-ERRORS VARYING I
FROM 1 BY 1 UNTIL ERROR-CODE = ZEROS
ELSE MOVE DATA-LINE TO PRINT-LINE
PERFORM PRINT-LINE-OUT
WRITE DISK-OUT
MOVE SPACES TO DISK-OUT.
IF FLAG-ON THEN
PERFORM PAGE-OVFLON THRU PAGE-OVFLOW-END.
GO TO EDIT-RECORDS.
FIND-COST-CNTR.
IF CC-FIRST-2-DIGITS NOT = ZEROS THEN
MOVE COST-CTR-IN TO CC-NOMINAL
READ COST-CNTR-TABFI INVALID KEY
MOVE 1 TO ERR-CODE (4)
ELSE PERFORM SEARCH-CC.
MOVE COST-CTR-IN TO 0ISK-COST-CNTR.
MOVE-1N-ERRORS.
IF ERR-CODE (I) NOT = ZEROS THEN
MOVE ERR-LIST (I) TO COMMENT
MOVE DATA-LINE TO PRINT-LINE
PERFORM PRINT-LINE-OUT
MOVE SPACES TO DATA-LINE
MOVE ZERO TO ERR-COOE (I).
PAGE-OVFLQW.
IF LINE-CT NOT < MAX-LINE THEN
PERFORM WRITE-SUB-TOTALS
PERFORM WRITE-HEAOINGS.
PAGE-OVFLOH-END.
EXIT.
SEARCH-CC.
MOVE CC-SECOND-2-DIGITS TO SEARCH-NO.
SET CC TO 1.
197
-------
SEARCH ALL CDST-CNTRS AT END
MOVE 1 TO ERR-CUDE (4)
WHEN CC-SIZE-2 (CO = TO SEARCH-NO
MOVE CC-SIZE-4 (CO TO COST-CTR-IN.
WRITE-SUB-TOTALS.
PERFORM MOVE-SPACES THRU PR INT-LINE-OUT.
PERFORM PRINT-LINE-QUT.
MOVE 'SUB TOTAL ' TO S-T-CUMhENT .
MOVE AMT-SUB-TOTAL TO AMT-ALL-OUT.
MOVE TOTAL-SUB-TOTAL TO TUTAL-ALL-OUT.
MOVE SUB-LINE TL> pRlNT-LINE.
PERFORM PRINT-LINE-OUT.
ADD AMT-SUB-TOTAL TO AMT-ALL.
ADD TOTAL-SUB-TOTAL TO TOTAL-ALL.
MOVE ZEROS TO AMT-SUB-TOTAL, TOTAL-SUB-TOTAL.
MOVE-SPACES.
MOVE SPACES TD PRINT-LINE.
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE ADVANCING 1.
ADD 1 TO LINE-CT.
* SORT ROUTINE
*
READ-SORT-INPUT.
READ CARD-IN AT END GO TD READ-SORT-INPUT-END.
IF ID1 NOT = TO SOURCE-CODE THEN
WRITE PRINT-LINE FROM INPUT-CARD AFTER ADVANCING
PERFORM MOVE-SPACES
GO TO READ-SORT-INPUT.
RELEASE SORT-INPUT FROM INPUT-CARD.
GO TO READ-SDRT-INPUT.
READ-SORT-INPUT-END.
EXIT.
WRITE-SORT-OUTPUT.
RETURN FILE-SORT RECORD INTO 1NPUT-RECS
AT END GO TO WR1TE-SDRT-OUTPUT-END.
WRITE INPUT-RECS.
GO TO WRITE-SORT-OUTPUT.
WRITE-SORT-OUTPUT-END.
EXIT.
*
* END SORT ROUTINE
*
WRITE-FINAL-TOTALS.
IF ERROR-CODE = TU ZERO THEN
WRITE DISK-OUT.
MOVE TOTAL-HOLD TO TOTAL-OUT.
MOVE DATA-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM WRITE-SUB-TOTALS.
PERFORM MOVE-SPACES THRU PR 1NT-LINE-OUT.
198
-------
PERFORM PRINT-LINE-OUT.
MOVE 'GRAND TOTAL1 TD S-T-COMMENT.
MOVE TOTAL-ALL TO TOTAL-ALL-OUT.
MOVE AMT-ALL TO AMT-ALL-OUT.
MOVE SUB-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
CLOSE-FILES.
CLOSE SORTED-FILE, FINANCIAL-ACCT-TABF I ,
SPECIAL-ACCT-TABF1, FINANCIAL-COST-ALLOCATION,
COST-CNTR-TABFI, PRINT-OUT.
E-O-J.
STOP RUN.
199
-------
PGMNAME=WUASPRER
•SYSIN DD *
IDENTIFICATION DIVISION.
PROGRAM-ID. WUASPRER.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, FLA 32789 .
DATE-WRITTEN. OCT 8 1977.
DATE-COMPILED. OCT 10 1977.
REMARKS. THIS PROGRAK EDITS THfc PAYROLL REPORT DATA
CARDS, TOTALS ALL COSTS, FLAGS ANY DISCREPANCIES,
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBrt-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CARD1N
ACCESS MODE IS SEQUENTIAL.
SELECT SORTED-FILE
ASSIGN TO UT-3330-S-SORTEDFI
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRIHTliUT
ACCESS MODE IS SEQUENTIAL.
SELECT FINANCIAL-ACCT-TABFI
ASSIGN TO DA-3330-I-FATABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS FA-NUMINAL
RECORD KEY IS FA-NUMBER.
SELECT COST-CNTR-TABFI
ASSIGN TO DA-3330-I-CCTABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS CC-NOMINAL
RECORD KEY IS CC-NUMBER.
SELECT SPECIAL-ACCT-TABFI
ASSIGN TO DA-3330-S-SATABFI
ACCESS MODE IS SEQUENTIAL.
SELECT FINANCIAL-COST-ALLOCATION
ASSIGN TO UT-3330-S-FICALFI
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
200
-------
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
02 ID1 PIC X.
02 FILLER PIC X(ll) .
02 DATE-DATA PIC X(6).
02 FILLER PIC X(b2).
01 DATE-CARD.
02 DATE-IN PIC X( 18) .
02 TITLE-IN PIC X ( 2<*) .
02 FILLER PIC X(38) .
FD SORTED-FILE
RECORD CONTAINS 30 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-RECS.
01 INPUT-RECS.
02 SOURCE-CODE-NO PIC X.
02 FILLER PIC X.
02 EMPL-NO-IN.
05 EMP1-IN PIC X(3).
05 EMP2-IN PIC XX.
05 EMP3-IN PIC X(
-------
BLOCK CONTAINS 8 RECORDS
RECORD CONTAINS 58 CHARACTERS
LABEL RECORUS ARE STANDARD
DATA RECORD IS FA-REC.
01 FA-REC.
05 FA-NUMBER PIC X(10)
05 FA-NAME PIC X(20)
05 FILLER PIC X(8 I.
FD SPECIAL-ACCT-TABFI
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS COST-CENTERS.
01 COST-CENTERS.
05 RECORD-COUNT.
10 NO-OF-RECS PIC 9(4>.
10 FILLER PIC X( 18) .
05 COST-CNTRS OCCURS 1 TO 99 TIMES
DEPENDING ON NO-DF-RECS
ASCENDING KEY IS CC-SIZE-2
INDEXED BY CC.
10 CC-SIZE-2 PIC X12).
10 CC-SIZE-4 PIC X(4).
10 FILLER PIC X(16).
FD FINANCIAL-COST-ALLOCATION
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORUS ARE STANDARD
DATA RECORD IS DISK-OUT.
01 DISK-OUT.
05 DISK-ACCT
05 01SK-COST-CNTR
05 D1SK-CDST-CAT
05 DISK-AMOUNT
01 FIRST-TWO-RECS.
05 FILLER
05 SORT-SEQUENCE
05 DISK-TITLE
WORKING-STORAGE SECTION
77 SOURCE-CODE
77 SEARCH-NO
77 LINE-CT
77 PAGE-CT
77 TOTAL-ACCUM
77 GRANO-TOTAL-ACCUM
77 TOTAL-SUBTOTAL
77 GROSS-SUB-TOTAL
77 GRAND-SUBTOTAL
77 TOTAL-ALL
77 GROSS-ALL
77 GRAND-ALL
OCCURS 2 TIMtS.
p
p
p
p
p
p
p
p
p
p
p
p
I
I
I
I
I
I
I
I
I
I
I
I
PI
p
p
p
p
p
p
I
I
I
I
I
I
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
X(10) .
X(4>.
X(2) .
S9( 8)V99.
X.
X.
X(24) .
X VALUt '1 ' .
XX VALUE SPACES.
99
9(4
59(
S9(
S9(
591
S9(
S9(
S9(
59 (
COMP VALUE 0.
>
8)
8)
8)
8)
8)
10
10
10
CUMP
V99
V99
V99
V99
V99
)V99
)V99
)V99
VALUt
COMP
CDMP
COMP
COMP
COMP
COMP
COMP
COMP
0.
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
0
0
0
C
0
0
0
0
202
-------
77 EMPL-NO-HOLO
77 DATE-HOLD
77 GROSS-HULO
77 I
77 MAX-LINE
77 FA-NOMINAL
77 CC-NOMINAL
77 PRIUT-EMPL-FLAG
88 FLAG-ON
38 FLAG-OFF
01 HEADING-l.
02 FILLER
02 FILLER
02 FILLER
01 HEAi)ING-2.
02 FILLER
02 FILLER
02 OATE-OUT
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 PAGE-OUT
02 FILLER
01 HEAOING-3.
02 FILLER
02 TITLE-OUT
02 FILLER
01 HEADING-^.
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
01 DATA-LINE.
02 FILLER
02 EMPL-NO-OUT.
05 EMP1-OUT
PIC X(9) VALUE SPACES.
PIC X(6) VALUE SPACES.
PIC S9(8)V99' COMP VALUE 0.
PIC 9 COMP VALUE 0.
PIC 99 COMP VALUE 53.
PIC X( 10) .
PIC X(4 ).
PIC X VALUE ' 1 ' .
VALUE ' 1 ' .
VALUE '0'.
PIC X(59) VALUE SPACES.
PIC X(14) VALUE 'PAYROLL
PIC X(6C) VALUE SPACES.
PIC X VALUE SPACES.
REPORT '
PIC X(13) VALUE
PIC X(18) VALUE
PIC X(33) VALUE
PIC X(3J VALUE
PIC X(53) VALUE
PIC X(5) VALUE
PIC ZZZ9.
PIC X(3) VALUE SPACES.
'DATE ENDING
SPACES.
SPACES.
'FOR' .
SPACES.
'PAGE '.
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
(54
(24
(5.5
(5)
(15
(6>
(4)
(4>
( 14
(5 )
( 11
(6
(1
(5
(9
(6
(9
(1
(8
(6
)
0
)
J
I
)
0
)
)
) VALUE
) VALUE
) VALUE
VALUE
) VALUE
VALUE
VALUE
VALUE
) VALUE
VALUE
) VALUE
VALUE
) VALUE
VALUE
VALUE
VALUE
VALUE
) VALUE
VALUE
VALUE
SPAC
SPAC
SPAC
SPACE
'EMP
SPACE
'DATE
SPACE
' ACC
SPACE
'CDS
SPACE
•TOT
SPACE
•GRUS
SPACE
•TOTA
SPAC
•COMM
SPACE
ES.
ES.
ES.
S .
LOY
S.
1
S.
OUiM
S.
T C
S
.
AL
S
S
S
L
E
E
S
.
EE NUMBER1
T NUMBER1 .
ENTER' .
COST ' .
PAY ' .
*
S
N
.
P
•
T
AY ' .
S1 .
PIC X(7) VALUE SPACES.
PIC X(3).
203
-------
02
02
02
02
02
02
02
02
02
02
02
02
02
02
01 ERR
02
05 DASH1
05 EMP2-OUT
05 DASH2
05 EMP3-OUT
FILLER
DATt-DATA-OUT
FILLER
ACCT-OUT
FILLER
COST-CTR-OUT
FILLER
TOTAL-COST-OUT
FILLER
GROSS-PAY-OUT
FILLER
GRAND-PAY-OUT
FILLER
COMMENT
OR-CODE.
ERR-CODE OCCURS 3
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
1C
1C
1C
I
I
I
1
I
I
I
I
I
I
C
C
C
C
C
C
C
C
C
C
X
XX
X
X(
X(
X(
X(
X{
XI
X(
X(
-(
X(
1C -(
I
I
I
I
T
C
C
C
C
XJ
- (
X(
X(
1MES
VALUE '-'.
VALUE '-'.
4*
?y
t>\
5)
10
10
4)
8}
8)
4 >
8 >
4)
8)
4 )
20
P
•
•
)
)
•
•
•
•
)
I
VALUE
VALUE
.
VALUE
VALUE
— .
VALUE
-- .
VALUE
VALUE
VALUE
C 9.
SPACE
S.
SPACES.
SPAC
SPAC
ES.
ES.
SPACES.
SPACE
SPACE
SPAC
S.
S.
ES.
01 ERROR-LIST.
02
ERR-LIST-A.
05 ERR-L1ST1 PI
C
X
(80
)
VALUE
i
i
i
ACCOUNT
EMP
COS
•COST
05 ERR-LIST2 PIC
X
(
80)
VA
LUE
i
i
i
LOYE
T CT
CNTR
TOTAL I
GROSS P
GROSS t
•DATE
02
ERR-LIST-B REDEFI
NE
s
05 ERR-LIST OCCURS
01 SUB
02
02
02
02
02
02
02
02
02
-LINE.
FILLER
S-T-COMMENT
FILLER
TOTAL-ALL-OUT
FILLER
GROSS-ALL-OUT
FILLER
GRAND-ALL-OJT
FILLER
P
P
P
P
P
P
P
P
P
I
I
C
C
1C
I
I
I
I
I
I
C
C
C
C
C
C
ERR-L
8 T
X(
X(
X(
- (
X(
-(
XX
-(
X(
IME
5)
11
50
10
2)
10
)
)
)
)
IST-A.
S PIC
VALUE
VALUE
VALUE
. — .
VALUE
m " ^ •
X(20)
SPAC
SPAC
.
ES.
ES.
NOT
SPACES.
SPACES.
VALUE SPACES.
10
24
)
)
. — .
VALUE
SPAC
ES.
H NOT FOUND
E # N-NUMERIC
R NOT NUMERIC
NOT FOUND '.
N NOT NUMERIC
AY NOTNUMERIC
TOTAL NOT =
NUMERIC '.
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN.
OPEN OUTPUT PRINT-OUT, SORTEO-F1LE,
FINANCIAL-COST-ALLOCATION.
READ-TITLE-CARD.
READ CARD-IN AT END GO TO WRITE-FINAL-TOTALS
MOVE SPACES TU DISK-OUT.
204
-------
MOVE DATE-IN TO DATE-OUT, DISK-TITLE.
WRITE DISK-OUT.
MOVE SPACES TO DISK-OUT.
MOVE TITLE-IN TO TITLE-OUT, DISK-TITLE.
MOVE SOURCE-CODE TO SURT-SEUUENCE.
WRITE DISK-OUT.
MOVt SPACES TO PRINT-LINE.
MOVE ' THE FOLLOWING CARDS HAVE A INVALID SOURCE CODE1
TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR1NT-LINE-OUT.
MOVE-INPUT-TO-DISK.
REAu CARD-IN AT END GG T3 RE-OPkN-FJLfcS.
IF 101 NOT = SOURCE-CODE THEN
WRITE PRINT-LINE FROM INPUT-CARD AFTER 1
PERFORM MOVE-SPACES
GO TO MOVE-INPUT-TO-DISK.
MOVt INPUT-CARD TO INPUT-RECS.
WRITE INPUT-RECS.
GO TO MOVE-INPUT-TO-DISK.
RE-OPEN-FILES.
CLOSE SORTED-FILE, CARD-IN.
OPEN INPUT SORTED-FILE, F INANCIAL-ACCT-TABF I ,
COST-CNTR-TABFI, SPECIAL-ACCT-TABFI.
HOUSEKEEPING.
MOVE ZEROS TO ERROR-CODE.
READ SPECIAL-ACCT-TABFI AT END
MOVE 'COST CENTER TABLE CONTAINS NO DATA1 TU
PRINT-LINE,
PERFORM PRINT-LINE-OUT
GO TO CLOSE-FILES.
WRITE-HtADINGS.
MOVE 0 TO LINE-CT.
ADD 1 TU PAGE-CT .
MOVE PAGE-CT TO PAGE-OUT.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE ADVANCING NEW-PAGE.
MOVE HEADING-1 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.-
MOVE HEADING-2 TO PRINT-LINfc.
PERFORM PRINT-LINE-OUT.
MOVE HEAD1NG-3 TO PRINT-LINE.
PERFORM PRINT-LINE-CUT.
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT.
MOVE HEADING-** TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR 1NT-LINE-QUT .
READ-RECORDS.
READ SORTED-FILE AT END GO TO WRITE-FINAL-TUTALS .
EDIT-RECORDS.
205
-------
MOVE ACCT-IN TO ACCT-OUT, FA-NOMINAL. OISK-ACCT.
READ FINANCIAL-ACCT-TABFI INVALID KEY
MOVE 1 TO ERR-CODE (1) .
MOVE COST-CTR-IN TG CGST-CTR-uUT.
MOVE EMPL-NO-IN TG EMPL-NO-HDLD.
MOVE DATE-DATA-IN TD DATE-HOLD.
EXAMINE INPUT-RECS REPLACING ALL ' ' BY '0'.
IF EMPL-NO-IN NOT NUMERIC MOVE 1 TO ERR-CODE (2).
IF DATE-DATA-IN NGT NUMERIC MOVE 1 TD ERR-CUDE (8).
IF FLAG-ON THEN
MOVE EMP1-IN TO EMP1-QUT,
MOVE EMP2-IN TO EMP2-QUT,
MOVE EMP3-IN TO EMP3-QUT.
MOVE '-' TO DASH1, OASH2,
MOVE DATE-DATA-IN TO DATE-DATA-OUT.
ELSE MOVE SPACES TO EMPL-ND-OUT, DATE-DATA-OUT.
TEST-COST-CNTR.
IF COST-CTR-IN NOT NUMERIC MOVE 1 TO ERR-CODE (3)
MOVE ZEROS TO COST-CTR-IN.
IF COST-CTR-IN NOT = ZEROS THEN
PERFORM FIND-COST-CNTR.
MOVE TOT-COST-IN TO TOTAL-COST'OUT, DISK-AMOUNT.
ADD TOT-COST-IN TG TOTAL-ACCUM.
IF GRO-PAY-IN > 0 THEN MOVE GRO-PAY-1N TO GROSS-HOLD.
MOVE ZEROS TO GROSS-PAY-OUT, GRAND-PAY-OUT.
READ-NEXT-REC.
PERFORM READ-RECORDS.
CHECK-NEXT-REC.
IF (EMPL-NO-IN = EMPL-NO-HOLD) AND (DATE-DATA-IN = DATE-HOLD)
THEN MOVE '0' TD PRINT-EMPL-FLAG ,
GO TD WRITE-LINE-OUT.
MDVE-GROSS-OUT.
MOVE '!' TO PRINT-EMPL-FLAG.
MOVE GROSS-HOLD TG GROSS-PAY-OUT.
IF GROSS-HOLD NOT = TOTAL-ACCUM THEN
MOVE 1 TO ERR-CODE (7).
ADD TOTAL-ACCUM TO GRAND-TOTAL-ACCUM, TOTAL-SUBTOTAL.
ADD GROSS-HOLD TO GROSS-SUB-TOTAL.
MOVE ZEROS TO TOTAL-ACCOM, GROSS-HOLD.
MOVE-GRAND-OUT.
IF EMPL-ND-IN NOT = EMPL'NO-HDLD THEN
MOVE GRAND-TDTAL-ACCUM TO GRAND-PAY-OUT
ADD GRAND-TOTAL-ACCUtt TD GRAND-SUBTOTAL
MOVE ZEROS TO GRAND-TOTAL-ACCUM.
WRITE-LINE-OUT.
IF ERROR-CODE NOT = ZERO THEN
PERFORM MGVE-IN-ERRORS VARYING I
FROM 1 BY 1 UNTIL ERROR-CODE = ZEROS
ELSE MOVE DATA-LINE TO PRINT-LINE
PERFORM PRINT-LINE-OUT
206
-------
WRITE DISK-OUT
MOVE SPACES TO DISK-OUT.
CHECK-FDR-END-OF-PAGE.
IF FLAG-ON THEN
PERFORM PAGE-OVFLOW THRU PA&E-0V FLOW-END.
GO TO EDIT-RECORDS.
FIND-COST-CNTR.
IF CC-FIRST-2-DIGITS NOT = ZEROS THEN
MOVE COST-CTR-IN TO CC-NOMINAL
READ COST-CNTR-TABF1 INVALlu KEY
MOVE 1 TO ERR-CQDE (4)
ELSE PERFORM SEARCH-CC.
MOVE COST-CTR-IN TO 01SK-COST-CNTR .
MOVE-IN-ERRORS.
IF ERR-CODE (I) NOT = ZEROS THEN
MUVE ERR-LIST (I) TO COMMENT
MOVE DATA-LINE TO PRINT-LINt
PERFORM PRINT-LINE-OUT
MOVE SPACES TO DATA-LINE
MOVE ZERO TO ERR-CODE (I }.
PAGE-OVFLOW.
IF LINE-CT NOT < MAX-LINE THEN
MOVE '!' TO PRINT-EMPL-FLAG
PERFORM WRITE-SUB-TQTALS
PERFORM WRITE-HEADINGS.
PAGE-CVFLOW-END.
EXIT.
SEARCH-CC .
MOVE CC-SECONO-2-UIGITS TO SEARCH-NO.
SET CC TO 1.
SEARCH ALL C05T-CNTRS AT END
MOVE 1 TO ERR-CODE (4)
WHEN CC-SIZE-2 (CO = TO SEARCH-NO
MOVE CC-SIZE-^ (CC) Td COST-CTR-IN.
WRITE-SUB-TOTALS.
PERFORM MOVE-SPACES THRU PR I NT-LINE-OUT.
PERFORM PRINT-LINE-OUT.
MOVE «SUB TOTAL ' TO 5-T-COMHENT.
MOVE TOTAL-SUBTOTAL TO TOTAL-ALL-OUT.
MOVE GRUSS-SUB-TOTAL TO GROSS-ALL-OUT .
MOVE GRAND-SUBTOTAL TO GRAND-ALL-OUT .
MOVE SUB-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
ADD TOTAL-SUBTOTAL TO TOTAL-ALL.
ADD &ROSS-SUB-TOTAL TO GROSS-ALL.
ADD GRAND-SUBTOTAL TO GRAND-ALL.
MOVE ZEROS TO TOTAL-SUBTOTAL. GROSS - SUB-TOTAL
GRAND-SUBTOTAL .
MOVE-SPACES.
MOVE SPACES TU PRINT-LINE.
207
-------
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE ADVANCING 1.
ADD 1 TO LINE-CT.
WRITE-F1NAL-TOTALS.
MOVE ZEROS TO EMPL-NO-HOLD.
PERFORM MOVE-GROSS-OUT THRU WRITE-LINE-OUT.
PERFORM WRITE-SUB-TOTALS.
PERFORM MOVt-SPACES THRU PR INT-LINE-DUT.
PERFORM PRINT-LINE-OUT.
MOVE 'GRAND TOTAL' TO S-T-COMHENT.
MOVE TOTAL-ALL TO TOTAL-ALL-OUT.
MOVt GROSS-ALL TO GROSS-ALL-OUT.
MOVE GRAND-ALL TO GRAND-ALL-OUT.
MOVE SUB-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
CLOSE-FILES.
CLOSE SORTED-FILE, FINANCIAL-ACCT-TABFI .
SPECIAL-ACCT-TABFI, FINANCIAL-COST-ALLOCATION.
COST-CNTR-TABFI, PRINT-OUT.
E-O-J.
STOP RUN.
208
-------
PGMNAME=WUASCARP
.SYSIN DO *
IDENTIFICATION DIVISION.
PROGRAM-ID. WUASCARP.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, FLA 32789.
DATE-WRITTEN. OCT 24 1977.
DATE-COMPILED. OCT 26 1977.
REMARKS. THIS PROGRAM READS THE COST ALLOCATION
FILES, TOTALS THE COSTS AND PRODUCES
A COST QLLOSQTYON RUP/RT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESORT
ACCESS MODE IS SEQUENTIAL.
SELECT FINANCIAL-COST-ALLOCATION
ASSIGN TO UT-3330-S-FICALFI
ACCESS MODE IS SEQUENTIAL.
SELECT FINANCIAL-ACCT-TABFI
ASSIGN TO DA-3330-I-FATABFI
ACCESS MODE RANDOM
NOMINAL KEY IS FA-NOMINAL
RECORD KEY IS FA-NUMBER.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD PRINT-OUT
RECORD CONTAINS 81 .CHARACTEkS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
02 FILLER PIC X.
02 PRINT-DATA PIC X(80).
FD FINANCIAL-ACCT-TABFI
BLOCK CONTAINS 8 RECORDS
RECORD CONTAINS 58 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS FA-REC.
01 FA-REC.
209
-------
02
02
02
02
FA-NUMB
FA-NAME
FA-NAME
FILLER
ER
1
2
P
P
P
P
I
I
I
I
C
C
C
C
X
X
X
X
(1C
(20
( 20
(8 )
SD FILE-SORT
RECORD CONTAINS 26 CHARACTERS
DATA RECORD IS SORT-DATA.
01 SORT-DATA.
02 S-ACCT-NO PIC X(10)
02 FILLER PIC X(16)
FD FINANCIAL-CDST-ALLQCATION
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-RECS.
01 INPUT-RECS.
02 ACCT-IN P
02 COST-CNTR-IN P
02 COST-CAT-IN P
02 AMOUNT-IN P
01 FIRST-TWD-RECS.
02 FILLER P
02 S-CODE P
02 TITLE-IN.
05 DATE-IN P
05 FILLER P
WORKING-STORAGE SECTION.
77 DEBIT-TOTAL P
77 CREDIT-TOTAL P
77
77
77
77
77
77
77
01
01
FA-NOMINAL
ACCT
ACCT
-TOTA
-HOLD
L
SOURCE-CODE
LINE
-CT
PAGE-CT
MAX-
HEAD
02
02
02
02
HEAD
02
02
02
02
02
02
02
LINE
1 .
FILLE
FILLE
TOP-T
R
R
ITLE
FILLER
2.
FILLER
DATE-
FILLE
FILLE
FILLE
FILLE
OUT
R
R
R
R
PAGE-OUT
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
I
I
I
I
I
I
I
1
I
I
I
I
I
C
C
C
C
C
C
C
C
C
C
C
C
C
1C
I
I
I
I
I
C
C
C
C
C
1C
I
I
I
I
I
I
I
I
C
C
C
C
C
C
C
C
X(
X(
X(
59
X.
9.
X(
X(
59
59
X(
59
X(
X.
99
9 (
99
X(
X(
i
X(
X(
X(
X(
X(
X(
X(
X(
Z(
10
2 )
(8
13
6)
(8
( 8
10
(8
10
)V99.
)V99 VA
)V99 VA
) VALUE
)V99 VA
) VALUE
CDMP VAL
4 )
CUMP V
CUMP VAL
13
29
FI
29
9)
b)
18
14-
3)
29
b)
4)
) VALUE
) VALUE
NANCIAL
) VALUE
VALUE
VALUE
) .
) VALUE
VALUE
) VALUE
VALUE
.
LUE +0.
LUE +0.
SPAC
LUE Z
SPAC
UE 0.
ALUE
UE 5^
SPAC
COST
SPAC
SPAC
'DATE
SPAC
*FOR '
ES.
ERO.
ES.
1 .
ft
ES.
ALLOCATION
ES.
ES.
: i .
ES.
,
SPACES.
•PAGE
• i .
OF
210
-------
01
01
Cl
01
HEAD
02
02
02
02
02
02
02
02
02
02
02
02
DATA
02
02
02
02
02
02
02
02
02
TCP-
02
3 .
FILLER
TITLE-OUT
FILLER
f.
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
-LINE.
FILLER
COMMENT.
05 FILLER
05 ACCT-OUT
FILLER
FA-NAME-OUT
FILLER
AMOUNT-OUT
FILLER
ACCT-TOTAL-OUT
FILLER
TITLES.
TL1.
05 FILLER PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
XI 87)
XI
X!
XI
X 1
XI
Xi
X 1
XI
XI
X'
XI
XI
XI
XI
XI
XI
XI
XI
- 1
X i
- 1
XI
[23)
;24)
128)
15)
! 14)
110)
112)
111)
16)
(6 }
I 13)
[3 J
: 6>.
iti.
110)
17)
120)
; i>
[8)9
I 4)
(8 )9
16)
VALUE
VALUE
.
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
.
VALUE
VALUE
VALUE
.99.
VALUE
.99.
VALUE
•PAYR
SPACES .
SPACES.
SPACES.
•ACCOUNT NUMBER1
SPACES.
•ACCOUNT NAME ' .
SPACES .
•AMOUNT ' .
SPACES.
•ACCOUNT TOTAL ' .
SPACES.
SPACES.
SPACES.
SPACES.
SPACES.
SPACES.
DLL REPORT TRANSA
05 FILLER PIC X ( 87 )
1 REQUISITIONS FROM STOCK
•SERVICE CONTRACT TRANSACTIONS'
VALUE ' PAYMENT AUTHORIZATIONS
•MISCELLANEOUS TRANSACTIONS
•DEPRECIATION VALUES •
02
TL2 REDEFINES TLl.
05 TITLES OCCURS 6 TIMES PIC X(29)
PROCEDURE DIVISION.
OPEN-SORT-FILES.
OPEN INPUT FINANCIAL-ACCT-TAbFI
OUTPUT PRINT-OUT.
SORT-RECORDS.
SORT FILE-SORT LN ASCENDING KEY
S-ACCT-NO
USING FINANCIAL-C
GIVING FlNANCIAL-<
OPEN-FCA-FILE .
OPEN INPUT FINANCIAL-COST-ALLOCATION.
READ-FIRST-2-REC .
PERFORM READ-INPUT.
MOVE DATE-IN TO DATE-LUT.
-COST-ALLOCATION
•COST-ALLOCATION.
211
-------
PERFORM READ-INPUT.
MOVE TITLES (S-CDOE) TO TOP-TITLE.
MOVE S-CDOE TO SOURCE-CODE.
MOVE TITLE-IN TO TITLE-OUT.
WRITE-HEADINGS.
MOVE 0 TO LINt-CT.
MOVE PA&E-CT TO PAGE-OUT.
ADD 1 TO PAGE-CT.
PERFORM KOVt-SPACES.
WRITE PRINT-LINE bEFQRE NEW-PAGE.
MOVE HEAD1 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD2 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD3 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRiNT-LINE-OUT.
MOVE HEAD^ TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT.
HOUSEKEEPING.
MOVE SPACES TO DATA-LINE.
PERFORM READ-INPUT.
READ-FA-FILE.
MOVE ACCT-IN TO ACCT-HOLD, ACCT-OUT, FA-NOMINAL,
READ FINANCIAL-ACCT-TABFI INVALID KEY
MOVE 'ACCT tf INVALID ****** TO FA-NAME1
MOVE SPACES TO FA-NAME2.
PERFORM MOVE-OUT-AMOUNTS.
MOVE FA-NAME1 TO FA-NAME-OUT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE SPACES TO DATA-LINE.
MOVE FA-NAME2 TO FA-NAME-QUT.
PERFORM READ-INPUT.
IF ACCT-IN NOT = TO ACCT-HOLD THEN
PERFORM WRITE-ACCT-TOTAL
PERFORM CHECK-L1NE-CT
GO TO READ-FA-FILE.
WRITE-DATA.
PERFORM MOVE-GUT-AMOUNTS.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE SPACES TO DATA-LINE.
PERFORM CHECK-LINE-CT.
PERFORM READ-INPUT.
IF ACCT-IN NOT = TO ACCT-HTtD THEN
PERFORM WklTE-ACCT-TOTAL
PERFORM READ-FA-FILE.
GO TO WRITE-DATA.
212
-------
MOVE-OUT-AMDUNTS.
MOVt AMOUNT-IN TO AMOUNT-OUT.
ADD AMOUNT-IN TO ACCT-TOTAL.
IF AMOUNT-IN < 0 THEN
ADD AMOUNT-IN TO CREDIT-TOTAL
ELSE ADD AMOUNT-IN TO DEB I T-TbTAL .
CHECK-LINE-CT.
IF LINE-CT NOT < MAX-LINE THEN
MOVE ACCT-HOLD TO ACCT-OUT
PERFORM WklTE-HEADIN&S.
WRITE-ACCT-TOTAL.
MOVE ACCT-TOTAL TO ACCT-TOTAL-OUT.
'MOVE ZERO TO ACCT-TOTAL.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR 1 NT-LINE-OUT.
MOVt SPACES TO DATA-LINE.
READ-INPUT.
READ FINANCIAL-COST-ALLOCAT I ON AT END
GO TO WRITE-FINAL-TUTALS.
MOVE-SPACES.
MOVE SPACES TO PRINT-DATA.
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE 1.
ADD 1 TO LINE-CT.
WRITE-FINAL-TOTALS.
PERFORM WRITE-ACCT-TOTAL.
MOVE SPACES TO DATA-LINE.
MOVE 'DEBIT TOTAL ' TO COMMENT.
MOVE DEBIT-TOTAL TO AMOUNT-OUT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-GUT.
MOVE 'CREDIT TOTAL1 TO COMMENT.
MOVE CREDIT-TOTAL TO AMOUNT-OUT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
CLOSE-ALL-FILES.
CLOSE FINANCIAL-COST-ALLOCATILN, PRINT-OUT,
F1NANCIAL-ACCT-TA&FI.
E-O-J.
STOP RUN.
213
-------
PGMNAME^WUASPAAC
.SYSIN DO *
ID QIVI SIGN.
PRD&RAM-IO. WUASPAAC.
AUTHOR. ACT SYSTEMS INC,
SUITE 200
807 W MORSE BLVD
WINTER PARK, FLA 32789.
DATE-fcRITTEN. APRIL 1978.
DATE-COMPILED. APRIL 1978.
REMARKS. THIS PROGRAM MERGES ALL EDIT FILES
INTO ONE TEMP FILE tMERGED-FILE)
THEN SUMS UP THE COST BY
ACCOUNT NUMBERS WITHIN COUNTY CODES
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PRINT-OUT
ASSIGN TO UT-1403-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
SELECT MERGED-FILE
ASSIGN TO UT-3330-S-MERGEUF1
ACCESS MODE IS SEQUENTIAL.
SELECT MERGIN&-FILE
ASSIGN TO UT-3330-S-MERGERFI
ACCESS MODE IS SEQUENTIAL.
SELECT PAY-ROLL-FILE
ASSIGN TO UT-3330-S-PAYROLL
ACCESS MODE IS SEQUENTIAL.
SELECT REQ-STOCK-FILE
ASSIGN TO UT-3330-S-REQSTOCK
ACCESS MODE IS SEQUENTIAL.
SELECT PAY-AUTH-FILE
ASSIGN TO UT-3330-S-PAYAUTH
ACCESS MODE IS SEQUENTIAL.
SELECT MISC-TRAN5-FILE
ASSIGN TO UT-3330-S-MISCTRAN
ACCESS MODE IS SEQUENTIAL.
SELECT SERVICE-CONTRACT-FILE
ASSIGN TO UT-3330-S-SERVCDNT
ACCESS MODE IS SEQUENTIAL.
SELECT DEPRECIATION-FILE
ASSIGN TO UT-3330-S-DEPREC
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
214
-------
FILE SECTION.
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
05 FILLER PIC X.
05 PRINT-DATA PIC X(132).
FD MER&ED-FILE
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-RFC.
01 INPUT-REC.
05 ACCT-NO.
10 DATE-TITLE-CODE PIC X.
10 FILLER PIC X(8).
10 COUNTY-CODE PIC X.
05 FILLER PIC X(6).
05 AMOUNT PIC S9(8)V99
SD MERGIN&-FILE
RECORD CONTAINS 26 CHARACTERS
DATA RECORD IS MER&E-REC.
01 MER&E-REC.
05 MERGE-ACCT.
10 SORT-ACCT PIC X(9>.
10 SORT-COUNTY PIC X.
05 FIL.ER PIC X(16>).
FD PAY-RO -FILE
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS PAYRULL-REC.
01 PAYRCLL-REC PIC X(26) .
FD REQ-STOCK-FILE
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS REG-REC.
01 REQ-REC PIC X(26) .
FD PAY-AUTH-FILE
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS PAYAUTH-REC.
01 PAYAUTH-REC PIC X(26) .
FD M1SC-TRANS-FILE
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORDS ARE STANDARD
215
-------
DATA RECORD IS MISC-REC.
01 MISC-REC PIC XU6).
FD SERVICE-CONTRACT-FILE
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS SERVICE-REC.
01 SERVICE-REC PIC X(26).
FD DEPRECIATION-FILE
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS DEPRECI AT ION-REC
01 DEPRECIATION-REC
WORKING-STORAGE SECTION
PIC XU6)
77
77
77
77
77
77
77
77
77
01
LINE-CT
MAX-LINE
COUNTY-COOE-HOLO
DEBIT-SUBTOTAL
CREDIT-SUBTOTAL
DEBIT-TOTAL
CREDIT-TOTAL
ACCT-TOTAL
ACCf-HOLD
HEAD-1.
05
05
05
05
05
FILLER
FILLER
FILLER
FILLER
FILLER
p
p
p
p
1C
1C
I
I
PI
p
p
p
p
p
p
p
p
p
1
I
I
I
I
I
c
c
c
c
c
c
c
c
c
1C
I
I
c
c
99
99
X
S9
S9
59
S9
59
X(
X(
X(
X(
X(
X(
VALUE 0.
VALUE 56.
VALUt SPACES.
(
{
1
(
(
1
1
1
1
6
9
6)
a)
8)
8)
8)
0)
0)
M
0)
}
2)
V99 VA
V99 VA
V99 VA
V99 VA
V99 VA
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
LUE +0.
LUE +0.
LUE +0.
LUE +0.
LUE +0.
SPACES.
SPACES.
•ACCOUNT NUMdER
SPACES.
•AMOUNT ».
SPACES.
01 DATA-LINE
FILLER
ACCT-OUT
FILLER
AMOUNT-OUT
FILLER
PROCEDURE DIVISION.
MERGE-F1LES.
MERGE MERGIN&-FILE
MERGE-ACCT
05
05
05
05
05
PIC XI12) .
PIC X(10).
PIC xm.
PIC -(8). — .
PIC X(92) VALUE
ON ASCENDING KEY
SPACES
USING PAY-ROLL-FILE
REQ-STOCK-FILE
PAY-AUTH-FILE
SERVICE-CONTRACT-FILE
MISC-TRANS-FILE
DEPRECIATION-FILE
MERGED-FILE.
GIVING
SORT-FILES.
SORT MERGING-FILE
SORT-COUNTY
ON ASCENDING KEY
216
-------
SQRT-ACCT
USING MERGED-FILE
GIVING MERGED-FILE.
OPEN-FILES.
OPEN INPUT MERGED-FILE
OUTPUT PRINT-OUT.
WRITE-HEADINGS.
MOVE 0 TO LINE-CT.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE NEW-PAGE.
MOVE HEAD-1 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR 1 NT-LINE-OUT.
PERFORM PRINT-LINE-OUT 2 TIMES.
MDVE SPACES TO DATA-LINE.
READ-INPUT.
READ MERGED-FILE AT END
GO TO WRITE-FINAL-TUTALS.
VERIFY-OATA.
IF GATE-TITLE-CODE = SPACES THEN
GO TO READ-INPUT.
IF COUNTY-CODE NOT = COUNTY-CODE-HOLD THEN
PERFORM WRITE-SUBTOTALS THRU TOP-NEW-PAGE
START-TOTALING.
IF ACCT-NO NOT = ACCT-HOLD THEN
PERFORM WRITE-DATA-LINE .
ADD AMOUNT TO ACCT-TQTAL.
GO TO READ-INPUT.
WRITE-DATA-LINE .
MOVE ACCT-HOLD TO ACCT-OUT.
MOVE ACCT-TOTAL TU AMOUNT-OUT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE ACCT-NO TO ACCT-HOLD.
IF ACCT-TOTAL > 0 THEN
ADD ACCT-TOTAL TO DEB IT-SUBTOTAL
ELSE ADD ACCT-TOTAL TO CREDIT-SUBTOTAL.
MOVE ZERO TO ACCT-TOTAL.
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT.
IF LINE-CT > MAX-LINE THEN
PERFORM WRITE-HEADINGS.
WRITE-SUBTOTALS.
MOVE ZERO TU LINE-CT.
PERFORM WRITE-DATA-LINE.
PERFORM MOVE-SPACES THRU PR INT-LINE-OUT.
MOVE 'SUBTOTAL ' TO ACCT-OUT.
MOVE ZERO TO AMOUNT-OUT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MDVE ' DEBIT ' TO ACCT-OUT.
217
-------
MOVE DEBIT-SUBTOTAL TD AMOUNT-OUT.
Movt DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE ' CREDIT' TO ACCT-OUT.
MOVE CREDIT-SUBTOTAL TO AMOUNT-OUT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
ADD DEBIT-SUBTOTAL TO DEB I T-TLtTAL .
ADD CREDIT-SUBTOTAL TO CREDIT-TOTAL.
MOVE ZEROS TO DEBIT-SUBTOTAL, CREDIT-SUBTOTAL
MOVE COUNTY-CODE TO COUNTY-CODE-HOLD.
TOP-NEW-PA&E.
PERFORM WRITE-HEADINGS.
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE 1.
ADD 1 TO LINE-CT.
WRITE-FINAL-TOTALS.
PERFORM WRITE-SUBTOTALS.
PERFORM MOVE-SPACES THRU PR1NT-LINE-OUT.
MOVE 'GRANDTOTAL1 TO ACCT-OUT.
MOVE ZERO TO AMOUNT-OUT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE ' DEBIT ' TO ACCT-OUT.
MOVE DEBIT-TOTAL TO AMOUNT-OUT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE ' CREDIT' TO ACCT-OUT.
MOVE CREDIT-TOTAL TO AMOUNT-OUT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
CLOSE-FILES.
CLOSE MER&ED-FILE
PRINT-OUT .
E-O-J.
STOP RUN.
218
-------
PGMNAME=WUASCAP1
-SYSIN DD *
ID DIVISION.
PRD&RAM-ID. WUASCAP1.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, PL 32789.
DATE-WRITTEN. DECEMBER 1977.
DATE-COMPILED.
REMARKS. THIS PROGRAM READS THE FINANCIAL COST ALLOCATION
INTERFACE FILES, EDITS DATA FOR ERRORS AND BUILDS
TWO FILES ONE FOR RESOLVED COST CENTERS AND ANOTHER
FOR UNRESOLVED COST CENTERS.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-COUTROL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTLUT
ACCESS MODE IS SEQUENTIAL.
SELECT FINANCIAL-COST-ALLOCATION
ASSIGN TO UT-3330-S-FKALFI
ACCESS MODE IS SEQUENTIAL.
SELECT CROSS-REF-FILE
ASSIGN TO DA-3330-I-CRTABFI
ACCESS MODE IS RANDOM
RECORD KEY IS ACCT-NO
NOMINAL KEY IS ACCT-NGM1NAL-
SELECT CDST-ALLOCATION-RESOLVED
ASSIGN TO UT-3330-S-RESOCAFI
ACCESS MODE IS SEQUENTIAL.
SELECT COST-ALL DCATI ON-UNRESOLVED
ASSIGN TO UT-3330-S-UNRSCAF1
ACCESS MODE IS SEQUENTIAL.
SELECT CARD-IN
ASSIGN TO UR-25^0R-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD PRIiMT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
05 FILLER PIC X.
219
-------
05 PRINT-DATA PIC X(132).
FD FINANCIAL-COST-ALLOCATION
BLOCK CONTAINS 20 RECORDS
RECORD CONTAINS 26 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-RECS.
01 INPUT-RECS.
05 ACCT-NO-IN.
10 FILLER PIC X(9).
10 COUNTY-CODE PIC X.
05 COST-CNTR-IN PIC X(4).
05 FILLER PIC X(2>.
05 AMOUNT-IN PIC S9(8)V99.
01 FIRST-TWO-RtCS.
05 FILLER PIC X.
05 SOURCE-COUE-IN PIC 9.
05 TITLE-IN.
10 DATE-IN PIC X(18).
10 FILLER PIC X(6).
FO CROSS-REF-FILE
BLOCK CONTAINS <• RECORDS
RECORD CONTAINS 265 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CR-REC.
01 CR-REC.
05 ACCT-NO PIC X(10) .
05 ALLOC-CODE PIC X.
05 C-CATS.
10 C-CAT OCCURS 2 TIMES PIC XX
05 NO-OF-CC PIC 99.
05 CC-BLK OCCURS 31 TIMES.
10 COST-CNTR PIC XU>.
10 MATCH-CODE PIC X(M.
01 CR-REC-1.
05 FILLER PIC XU7).
05 CC-BLK-1 OCCURS 31 TIMES.
10 FILLER PIC X(^).
10 PERCENT PIC V9999.
FD COST-ALLOCATIUN-RESOLVED
BLOCK CONTAINS f> RECORDS
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS RES-REC.
01 RES-REC.
05 RES-REC-DATA PIC X(30).
05 FILLER PIC X(bO).
FD COST-ALLOCATION-UNRESOLVED
BLOCK CONTAINS 5 RECORDS
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
220
-------
IS UNKES-REC.
DATA RECORD
01 UNRtS-REC.
05 UNRES-REC-DATA PIC
05 FILLER PIC
FD CARD-IN
RECORD CONTAINS 80 CHARAC
LABEL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD
01 INPUT-CARD.
05 COUNTY-CODE-IN PIC
05 FILLER PIC
WORKING-STORAGE SECTION.
77 LINE-CT PIC
77 PAGE-CT PIC
77 MAX-LINE PIC
77 SOURCE-CODE PIC
77 ACCT-NOMINAL PIC
77 I PIC
77 PERCENT-34C1 PIC
77 PERCENT-2101 PIC
77 HOLD-AMT PIC
77 CQST-CNTR-3401 PIC
77 COST-CNTR-2101 PIC
77 MATCH-3401 PIC
77 MATCH-2101 PIC
77 RES-FLAG PIC
77 COUNTY-CODE-HOLD PIC
01 ERROR-LIST.
05 ERR1
01 FILE-NAMES.
05 FILENAMESl.
10 FILLER
X(30).
X(50).
TERS
X.
X(79) .
99 COMP VALUE 0.
9(4) COMP VALUE 1.
99 CuMP VALUE 56
9.
X(10) VALUE ZERO.
99.
V9(4) VALUE ZERO.
V9(4) VALUE ZERO.
S9(81V99.
X(4) VALUE '3401'.
X(4) VALUE '2101'.
9 VALUE ZERO.
X VALUE SPACES.
PIC X<20) VALUE 'INVALID COST CENTER
PIC X(72) VALUE
05 FILENAMES REDEFINES I
10 FILE-NAME OCCURS
01 HEAD-1.
05 FILLER PIC
05 FILLER PIC
05 FILE-NAME-OUT PIC
05 FILLER PIC
01 HEAD-2.
05 FILLER PIC
05 DATE-OUT PIC
05 FILLER PIC
05 FILLER PIC
'PAYROLL
'REU OF STOCK
'SERVICE
•PAYMENT AUTH
•MISC TRANS
•DEPRECIATION1.
ILENAMfcSl.
6 TIMES PIC X(12)
X(44) VALUE SPACES.
X(34) VALUE 'INITIAL COST ALLOCATION
' REPORT OF '.
X(12) .
X(42) VALUE SPACES.
X(13) VALUE 'DATE ENDINGS '.
X(18 ) .
X(33) VALUE SPACES.
X(3) VALUE SFOR'.
221
-------
01
01
01
01
05
05
05
HEAD
05
05
05
HEAD
05
05
05
05
05
HEAD
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
DATA
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
FILLER
FILLER
PAGE-OUT
-3.
FILLER
TITLE-OUT
FILLER
-4.
FILLER
FILLER
FILLER
FILLER
FILLER
-5.
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
-LINE.
ACCT-NO-OUT
FILLER
COST-CNTR-OUT-1
FILLER
AMOUNT-OUT-1
FILLER
COST-CNTR-OUT-2
FILLER
COST-CAT-OUT
FILLER
MATCH-CODE-OUT
FILLER
AMOUNT-OUT-2
FILLER
RES-OUT
FILLER
COMMENT-GUT
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
PI
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
I
I
I
I
I
I
I
I
I
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
1C
I
I
I
I
I
c
c
c
c
c
1C
I
PI
PI
c
c
c
X(
X(
Z(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
x(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
- (
X(
X(
X(
XX
X(
X(
X(
- (
X(
XX
X(
X(
55
6)
4)
54
24
54
15
10
53
19
35
7)
4)
ID
d)
6)
6}
12
9 >
3)
8)
2)
10
5)
10
8)
10
7)
7)
10
3)
4)
13
b)
14
4)
9>
•
6 )
4)
3>
8)
7)
•
7)
20
) VALUE
VALUE
.
) VALUE
) .
) VALUE
) VALUE
) VALUE
) VALUE
) VALUE
) VALUE
VALUE
VALUE
) VALUE
VALUE
VALUE
VALUE
) VALUE
VALUE
VALUE
VALUE
VALUE
) VALUE
VALUE
) VALUE
VALUE
) VALUE
VALUE
VALUE
) .
.
.
) .
. — — .
) .
.
.
.
.
.
. — .
.
.
) .
SPACES.
'PAGE: '.
SPACES.
SPACES.
SPACES .
'INPUT DATA'.
SPACES.
•RESOLVED INPUT
SPACES.
' ACCT #• .
SPACES.
'CQST/CNTR '.
•COST/CAT ' .
SPACES.
•AMOUNT ' .
SPACES.
•COST-CNTR' .
SPACES.
•COST-CAT1 .
SPACES.
•MATCH/CODE' .
SPACES.
•AMOUNT '.
•RESOLVED' .
SPACES.
'COMMENT1 .
SPACES.
DATA
222
-------
01 DISK-RECORD.
05 OISK-ACCT-NG PIC X(10).
05 DISK-CDST-CNTR.
10 DISK-ALLDC-CDDE PIC X.
10 FILLER PIC X(3).
05 DISK-COST-CAT PIC XX.
05 D1SK-MATCH-COOE PIC XK).
05 DISK-AMT OCCURS 6 TIMES PIC S9(8JV99.
PROCEDURE DIVISION.
OPEN-FILES.
OPEN OUTPUT PRINT-OUT,
COST-ALLOCATIGN-RESLiLVED.
COST-ALLOCATION-UNRESOLVED,
INPUT FINANCIAL-CDST-ALLOCATION,
CARU-IN
CROSS-REF-FILE.
HOUSE-KEEP.
MOVE SPACES TG RES-REC, UNRES-REC, DATA-LINE.
*
* INVALID OPTION CARD OR NO OPITION CARD DEFAULTS
* TO A BLANK COUNTY CODE
*
READ-OPTION-CARD .
READ CARD-IN AT END GO TO FILL-HEADINGS.
IF COUNTY-CODE-IN = »C' THEN
MQVE 'C1 TO COUNTY-CODE-HOLD.
FILL-HEADINGS.
READ FINANCIAL-CDST-ALLOCATION AT END
GO TO CLOSE-FILES.
MOVE DATE-IN TO DATE-OUT.
READ FINANCIAL-COST-ALLOCATION AT END
GO TO CLOSE-FILES.
MOVE TITLE-IN TO TITLE-OUT.
MOVE SOURCE-CODE-IN TO SOURCE-CODE.
MOVE FILE-NAME (SOURCE-CODE) TO FILE-NAME-OUT .
WRITE-HEADINGS.
MOVE PAGE-CT TO PAGE-OUT.
ADD 1 TU PAGF-CT.
MOVE 0 TO LINE-CT.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE NEW-PAGE.
MOVE HEAD-1 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-2 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-3 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-OUT 2 TIMES.
MOVE HEAD-^t TO PRINT-DATA.
223
-------
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-OUT 2 TIMES.
MOVE HEAD-5 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRiNT-LINE-OUT.
READ-INPUT.
READ FlNANClAL-CoST-ALLOCATlON AT END
GO TO CLOSE-FILES.
IF AMOUNT-IN = 0 THEN
GO TO READ-INPUT.
IF COUNTY-CODE NOT = TO COUNTY-CODE-HOLD THEN
GO TO RdAD-INPUT.
START-EDIT.
MOVE ACCT-NO-IN TO ACCT-NOMI MAL.
READ CRQSS-REF-FILE INVALID KEY
MOVE SPACES TO DATA-LINE
MOVE 'ACCT « NOT FOUND ' TO COMMENT-OUT
MOVE ACCT-ND-IN TO ACCT-NO-OUT
MOVE DATA-LINE TO PRINT-DATA
PERFORM PRINT-LINE-OUT
MOVE SPACES TO DATA-LINE
PERFORM PAGE-QVFLOW
GO TO READ-INPUT .
CHECK-4-VALID-COST-CNTR.
EXAMINE COST-CNTR-IN REPLACING ALL • ' BY »o'.
IF (COST-CNTR-IN NOT = ZERO) AND (ALLCC-CODE NOT = 'H') THEN
PERFORM CHECK-COST-CENTERS
ELSE GO TO CHECK-ALLOC-CODE.
IF RES-FLAG = 0 THEN
MOVE !I ' TO ALLOC-COOE
GO TO RtSOLVED-CC .
CHECK-ALLOC-CODE.
IF ALLOC-CDDE = 'A' OR »H' OR '!• OR 'J' THEN
GO TO RESOLVED-CC
ELSE GO TO UN-RESOLVED-CC.
RESOLVED-CC.
MOVE ACCT-NO-IN TO DISK-ACCT-NO, ACCT-NO-OUT.
IF COST-CNTR-IN NOT = ZEROES THEN
MOVE COST-CNTR-IN TU COST-CNTR-OUT-1
ELSE MOVE SPACES TO COST-CNTR-OUT-1 .
PERFORM CHECK-COST-CAT.
MOVE AMOUNT-IN TO AMOUNT-OUT-l.
IF ALLOC-CODE NOT = 'H' THEN
GO TO CHECK-A-I-J.
IF PERCENT-3401 = ZERO THEN
PERFORM GET-H-PERCENTAGES.
MULTIPLY AMOUNT-IN BY PERCENT-3401 GIVING HOLD-AMT.
MOVE HOLD-AMT TO DISK-AMT (1>, AMOUNT-OUT-2.
MOVE MATCH-3401 TO DISK-MATCH-CLDE, MATCH-CODE-UUT .
224
-------
MOVE COST-CNTR-3401 TO 0 ISK-COST-CNTR , COST-CNTR-OUT-2.
PERFORM WRITE-RES-REC .
MOVE SPACES TO ACCT-NO-QUT, COST-CNTR-OUT-1.
MOVE ACCT-NO-IN TO DISK-ACCT-NO.
MOVE ZEROS TO AMOUNT-OUT-1.
MULTIPLY AMOUNT-IN BY PERCENT-2101 GIVING HOLD-AMT.
MOVE HOLD-AMT TO DISK-AMT (1), AMOUNT-OUT-2.
MOVE MATCH-2101 TO DISK-MATCH-CODE, MATCH-CODE-OUT.
MOVE COST-CNTR-2101 TQ DISK-COST-CNTR, COST-CNTR-OUT-2.
PERFORM CHECK-COST-CAT.
PERFORM WRITE-RES-REC.
GO TO READ-INPUT.
CHECK-A-I-J.
IF ULLOC-CODE = 'I') AND (CDST-CNTR-IN NOT = SPACES OR ZERO)
THEN MOVE COST-CNTR-IN TO COST-CNTR (1)
MOVE SPACES TO COMMENT-OUT.
MOVE AMOUNT-IN TO DISK-AMT (1), AMOUNT-OUT-2.
MOVE COST-CNTR (1) TO DISK-COST-CNTR, COST-CNTR-OUT-2.
MOVE MATCH-CODE (1) TO D ISK-MATCH-CODt, MATCH-CODE-OUT.
PERFORM WRITE-RES-REC.
GO TO READ-INPUT .
WRITE-RES-REC.
MOVE DATA-LINE TO PRINT-OATA.
PERFORM PRINT-LINE-OUT.
MOVE DISK-RECORD TO RES-REC-DATA.
WRITE RES-REC.
MOVE SPACES TO DISK-RECORD, DATA-LINE.
PERFORM PAGE-OVFLOW.
UN-RESOLVED-CC.
MOVE ACCT-NO-IN TO DISK-ACCT-NO, ACCT-NO-DUT.
IF COST-CNTR-IN NOT = ZEROES THEN
MOVE COST-CNTR-IN TO COST-CNTR-OUT-1
ELSE MOVE SPACES TO COST-CNTR-OUT-1.
PERFORM CHECK-COST-CAT.
MOVE AMOUNT-IN TO AMOUNT-OUT-1, AMOUNT-OUT-2. DISK-AMT (1).
MOVE SPACES TO DISK-MATCH-CUDE» MATCH-CODE-QUT.
MOVE ALLOC-CODE TO DISK-ALLOC-CODE.
MOVE 'NO1 TU RES-OUT
MOVE DATA-LINE TO PRINT-OATA.
PERFORM PRINT-LINE-OUT.
MOVE DISK-RECORD TO UNRES-REC-DATA.
WRITE UNRES-REC.
MOVE SPACES TO DISK-RECORD, DATA-LINE.
PERFORM PAGE-OVFLOW.
GO TO READ-INPUT.
PAGE-OVFLOW.
IF LINE-CT NOT < MAX-LINE THEN
PERFORM WRITE-HEADINGS.
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
225
-------
COST-CAT-OUT
COST-CAT-OUT.
PRINT-LINE-DUT.
WRITE PRINT-LINE BEFORE 1.
ADO 1 TD LINE-CT.
CHECK-COST-CAT.
IF SOURCE-CODE = 1 THEN
MOVE C-CAT (2) TO DISK-COST-CAT,
ELSE MOVE C-CAT (1) TO DISK-COST-CAT,
CHECK-CUST-CENTERS.
MOVt 0 TO RES-FLAG.
PERFORM CHECK-C05T-CNTR THRU CHtCK-COST-CNTR-END
VARYING I FROM 1 BY 1 UNTIL
I > NO-OF-CC.
CHECK-CQ5T-CNTR.
IF COST-CNTR (I) = TO COST-CNTR-IN
ADD NO-OF-CC TO I
GO TO CHECK-COST-CNTR-END.
IF I = TO NO-OF-CC THEN
MOVE 1 TO RES-FLAG.
CHECK-COST-CNTR-END.
EXIT.
GET-H-PERCENTAGES.
IF CDST-CNTR (1) - «3401' THEN
MOVE MATCH-CODE (1) TO MATCH-3^01
MOVE PERCENT (2) TO PERCENT-3401
(3) TO MATCH-2101
TO PERCENT-2101
THEN
MATCH-CODE
PERCENT (4)
MOVE
MOVE
ELSE
MOVE
MOVE
MOVE
MOVE
CLOSE-FILES.
CLOSE FINANCIAL-COST-ALLOCATIDN, CROSS-REF-FILE,
COST-ALLOCATION-RESOLVED, COST-ALLOCATION-UNRESOLVED,
CARD-IN, PRINT-OUT.
E-O-J.
STOP RUN.
MATCH-CODE
PERCENT (2)
MATCH-CODE
PERCENT (4>
(1) TO MATCH-2101
TD PERCENT-2101
(3) TO MATCH-3401
TO PERCENT-3401.
226
-------
PGMNAME=WUASCAP2
SYSIN DO *
ID DIVISION.
PROGRAM-ID. WUASCAP2
AUTHOR. ACT SYSTEMS, INC
SUITE 200
307 W MORSE BLVD
WINTER PARK, FL 32789.
DATE-WRITTEN. DEC 14, 1977.
DATE-COMPILED.
REMARKS. THIS PROGRAM READS THt RESOLVED FILE
(RESOCAFI) AND BUILDS A TABLE OF COST
CENTER VALUES TO BE USED IN CAP3.
ENVIRONMENT DIVISION.
CONFIGUkATJDN SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEK-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTGUT
ACCESS MODE IS SEQUENTIAL.
SELECT COST-ALLOCATION-RBSOLVED
ASSIGN TO UT-3330-S-RESOCAF1
ACCESS MODE IS SEQUENTIAL.
SELECT COST-ALLOCATION-RESOLVED-COST5
ASSIGN TC UT-3330-S-RECTABF1
ACCESS MODE IS SEQUENTIAL.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESURT
ACCESS MODE IS SEQUENTIAL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CARD1N
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
05 FILLER PIC X.
05 PRINT-DATA PIC X(80).
05 FILLER PIC X(52) .
FD COST-ALLOCATION-RESOLVEO
BLOCK CONTAINS 5 RECORDS
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
227
-------
IS RES-REC
PIC X(10).
PIC XU> .
PIC X(6).
TIMES PIC S9(8)V99.
DATA RECORD
01 RES-REC.
05 FILLER
05 COST-CNTR-IN
05 FILLER
05 AMOUNT OCCURS 6
FO COST-ALLOCATION-RESOLVED-COSTS
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS RES-COSTS.
01 RES-COSTS.
05 RECORD-COUNT.
10 NO-OF-RECS PIC 9{2>.
10 FILLER PIC X(12) .
05 RES-CGST-REC OCCURS 1 TD 99 TIMES
DEPENDING ON NO-OF-RECS
ASCENDING KEY IS COST-CNTR
INDEXED BY CC.
10 COST-CNTR PIC XK).
10 CC-AMOUNT PIC S9(8)V99.
SO FILE-SORT
RECORD CONTAINS 80 CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
05 FILLER PIC X(10) .
05 S-COST-CNTR PIC X(4).
05 FILLER PIC x«>6).
FO CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
05 DATE-IN
05 TITLE-IN
05 FILLER
WORKING-STORAGE SECTION
77 LINE-CT
77 PAGE-CT
77 MAX-LINE
77 COST-CNTR-HOLD
77 AMOUNT-ACCUM
77 COST-CNTR-CT
01 HEAD-1.
05 FILLER
05 FILLER
05 FILLER
01 HEAD-2.
05 FILLER
05 DATE-OUT
05 FILLER
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
X( 18 )
X ( 24 )
X(38)
9(2>
9 (4 }
9(2>
X ( 4 )
S9{8)
99 VA
PIC
CDMP VALUE 0.
COMP VALUE 0.
COMP VALUE 56
VALUE ZERO.
V99 VALUE 0.
LUE 0.
PIC X(36) VALUE SPACES.
X(26) VALUE 'TOTAL COST BY COST CENTERS'
PIC X(18) VALUE SPACES.
PIC
PIC
PIC
X(13)
XI 18)
X(17)
VALUE 'DATE ENDING: '
VALUE SPACES
228
-------
05
05
05
05
FILLER
FILLER
FILLER
PAGE-OUT
01
01
HEAO-3.
05 FILLER
05 TITLE-OUT
05 FILLER
HEAD-4.
05
05
05
05
05
FILLER
FILLER
FILLER
FILLER
FILLER
01
DATA-LINE
05
05
05
05
05
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
X (
X(
X(
zz
X (
X{
X(
X(
X(
X(
X(
X(
X(
Z(
X(
Z(
X(
3)
19)
6)
Z9.
37)
24)
19]
23)
11 )
26)
5)
15]
27]
4),
23)
8 ) .
13!
VALUE
i VALUE
VALUE
t
VALUE
.
I VALUE
i VALUE
i VALUE
VALUE
VALUE
1 VALUE
I VALUE
t
I .
.99CR.
* •
SPACES.
SPACES.
SPACES .
'COST CENTER1
SPACES.
•VALUE ' .
SPACES.
SPACES.
FILLER
COST-CNTR-OUT
FILLER
AMOUNT-OUT
FILLER
PROCEDURE DIVISION.
OPEN-IO-FILES.
OPEN INPUT CARD-IN
OUTPUT PRINT-OUT
COST-ALLOCATION-RE SOLVED-COSTS .
SORT-RES-FILE.
SURT FILE-SORT UN ASCENDING KEY
S-COST-CNTR
USING COST-ALLOCATION-RESOLVED
GIVING COST-ALLOCATION-RESOLVED.
OPEN-CAR-FILE.
OPEN INPUT COST-ALLOCATION-RESOLVED.
HOUSE-KEEP.
PERFORM MOVE-SPACES.
READ-CARD-IN.
READ CARD-IN AT END
MOVE 'NO DATE CARD ** JOB ABORTED' TO PRINT-DATA
PERFORM PRINT-L1NE-OUT
GU TO CLOSE-IO-FILES.
MOVE DATE-IN TO DATE-OUT.
MOVE TITLE-IN TO TITLE-OUT.
WRITE-HEADINGS.
ADD 1 TO PAGE-CT.
MOVE 0 TO LINE-CT.
MOVE PAGE-CT TO PAGfc-OUT
WRITE PRINT-LINE BEFORE NEW-PAGE.
MOVE HEAD-1 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT .
MOVE HEAD-2 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
229
-------
MOVE HEAD-3 TO PRINT-DATA.
PERFORM PRINT-LINE-OJT.
PERFORM MOVt-SPACES.
PERFORM PRINT-LINE-OUT 2 TIMES.
MOVE HEAD-4 TO PRINT-DATA.
PERFORM PRINT-LINE-UUT.
PERFORM MOVE-SPACES THRU PRiNT-LINE-OUT.
SET-POINTER.
SET CC TO 1.
READ-INPUT.
REAJ COST-ALLOCATION-RESOLVED AT END
GO TO WRITE-COST-TABLE.
START-TUTAL1N&.
MOVE COST-CNTR-IN TO COST-CNTR (CC), COST-CNTR-UUT,
COS r-CNTR-HOLD.
ADO-AMOUNTS.
ADD AMOUNT (!) TO AMOUNT-ACCUM
PERFORM READ-INPUT.
IF COST-CNTR-IN NOT = COST-CNTR-HDLD THEN
PERFORM WRITE-COST-CNTR
GO TD START-TOTALING
ELSE GO TO ADD-AMOUMTS.
WRITE-CGST-CNTR.
MOVE AMOUNT-ACCUM TO AMOUNT-OUT, CC-AMOUNT (CC).
MOVE IERO TO AMOUNT-ACCUM.
SET CC UP BY 1.
ADD 1 TO CDST-CNTR-CT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-DUT.
IF LINE-CT NOT < MAX-LINE THEN
PERFORM WRITE-HEADINGS.
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-LiNE-OUT.
WRITE PRINT-LINE BEFORE 1.
ADD 1 TU LINE-CT.
WRITE-COST-TABLE.
MOVE COST-CNTR-CT TO NO-OF-RECS.
PERFORM WRITE-COST-CNTR.
WRITE RES-COSTS.
CLOSE-IO-FILES.
CLOSE COST-ALLOCATION-RESOLVED
CDST-ALLOCATION-RESOLVED-COSTS
CARD-IN
PRINT-OUT.
E-O-J.
STOP RUN.
230
-------
PGMNAME=WUASCAP3
.SYSIN DO *
ID DIVISION.
PROGRAM-ID. WUASCAP3.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, FL 32789.
DATE-WRITTEN. DEC 15, 1977.
DATE-COMPILED.
REMARKS. THIS PROGRAM READS THE UNRESOLVED FILE
(UNRSCAFI) ANO USING THfc TABLE DF COST
CENTER VALUES, RESOLVES THE FILE AND
ADDS THE RESOLVED RECORDS TO THE RESLLVtD
FILE (RESOCAFI).
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. I6M-370.
SPECIAL-NAMES.
C01 IS UEw-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CAKOIN
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PiUUTUUT
ACCESS MODE IS SEQUENTIAL.
SELECT COST-ALLDCAT10N-RESOLVED
ASSIGN TO UT-3330-S-RESOCAFI
ACCESS MODE IS SEQUENTIAL.
SELECT COST-ALLOCATION-UNRESOLVED
ASSIGN TO UT-3330-S-UNRSCAF1
ACCESS MODE IS SEQUENTIAL.
SELECT COST-ALLOCAT10N-RESOLVEO-C LISTS
ASSIGN TO UT-3330-S-RECTAbFI
ACCESS MODE IS SEQUENTIAL.
SELECT CROSS-REF-FILE
ASSIGN TO DA-3330-I-CRTABFI
ACCESS MCUE IS RANDOM
RECORD KEY IS CRF-ACCT-KD
NOMINAL KEY IS ACCT-NOMINAL .
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESORT
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARU-IN
RECORD CONTAINS 80 CHARACTEKS
231
-------
LABEL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
05 OATE-IN PIC X( 18) .
05 TITLE-IN PIC X(24).
05 FILLER PIC X(38) .
FO PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
05 FILLER PIC x.
05 PRINT-DATA PIC X(132).
FD COST-ALLOCATIUN-RESOLVED
BLOCK CONTAINS 5 RECORDS
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS RES-REC.
01 RES-REC.
05 RES-ACCT-NO PIC X(1C).
05 RES-CDST-CNTR PIC X ( <+ ) .
05 RES-COST-CAT PIC XX.
05 RES-MATCH-CODE PIC XK).
05 RES-AMTS OCCURS 6 TIMES PIC S9(8)V99
FO COST-ALLOCATION-UNRESOLVED
BLOCK CONTAINS 5 RECORDS
RECORD CONTAINS 80 CHARACTERS
LABcL RECORDS ARE STANDARD
DATA RECORD IS UNRES-REC.
01 UNRES-REC.
05 ACCT-NO PIC XUO>.
05 ALLOC-CUDE PIC x.
05 FILLER PIC X(3).
05 COST-CAT PIC XX.
05 MATCH-CODE PIC 9(4>.
05 AMTS OCCURS 6 TIMES PIC S9(8)V99.
FD COST-ALLCCATI ON-RESOLVED-COSTS
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS RES-COST-RECORD.
01 RES-COST-RECORD.
05 RECORD-COUNT.
10 NO-OF-RECS PIC 9(2).
10 FILLER PIC XU2).
05 RES-COSTS OCCURS 1 TO 99 TIMES
DEPENDING ON NO-OF-RECS
ASCENDING KEY IS COST-CNTR
INDEXED BY CC.
10 COST-CNTR PIC XU).
10 CC-AMOUNT PIC S9(8)V99.
232
-------
FO
01
CROSS-REF-F1LE
BLOCK CONTAINS
-------
01
01
05 FILLER
05 TITLF-OUT
05 FILLER
HEAO-4.
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
HEAD-5.
PIC X(54)
PIC X(2<+)
PIC X(54)
05
05
05
05
05
05
05
05
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
I
I
I
I
I
c
c
c
c
c
1C
I
I
I
I
I
I
I
I
I
I
I
I
c
c
c
c
c
c
c
c
c
c
c
c
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
(8
(5
u
(3
(5
(3
(5
(1
(4
(4
(7
(4
(8
(2
(4
(3
(6
(9
)
)
)
)
>
>
)
1
I
1
)
)
*
)
I
}
}
8
VALUE SPACES.
k
VALUE SPACES.
VALUE ' ACCOUNT'.
VALUE SPACES.
VALUE 'COST'.
VALUE SPACES.
VALUE 'ALLOC'.
VALUE SPACES.
VALUE 'TOTAL'.
VALUE SPACES.
VALUE 'RESOLVED AMOUNT ALLOCAT
•ED COST CENTERS(S)•.
VALUE SPACES.
VALUE ' NUMBER'.
VALUE SPACES.
VALUE 'CATEGORY'.
VALUE SPACES.
VALUE 'CODE'.
VALUE SPACES.
VALUE 'AMOUNT1.
VALUE SPACES.
01 DATA-LIME.
05 ACCT-NC-CUT PIC X(10)
05 FILLER PIC X(4J.
05 CQST-CAT-OUT PIC X(2).
05 FILLER PIC X(6 >.
05 ALLOC-CODE-OUT PIC X.
05 AMOUNT-OUT PIC -(7)9
05 RES-DATA OCCURS 6 TIMES.
10 AMT-OUT PIC -(7)9
10 SLASH-OUT PIC X.
10 COST-CNTR-OUT PIC X(4)
01 B-PERCENTAGES.
05 B-PERCENT OCCURS 15 TIMES
01 C-PERCENTAGES.
05 C-PERCENT OCCURS 15 TIMES
01 D-PtRCENTAGtS.
05 D-PERCENT OCCURS 15 TIMES
01 E-PERCENTAGtS.
05 E-PERCENT OCCURS 15 TIMES
01 F-PiiRCENTAGES.
05 F-PERCENT OCCURS 15 TIMES
01 G-PtRCEMTAGES.
05 G-PERCENT OCCURS 15 TIMES
01 COMMON-PERCENTAGES.
05 COMMON-PERCENT OCCURS 15 T
01 COMMON-AMOUNTS.
.99.
.99.
•
PIC 9V99.
PIC 9V99.
PIC 9V99.
PIC 9V99.
PIC 9V99-
PIC 9V99.
IMES PIC 9V99
234
-------
05 COMMON-AMI OCCURS 13 TIMES PIC S9(8)V99.
PROCEDURE DIVISION.
OPEN-IO-FILES.
OPEN INPUT CARD-IN,
COST-ALLOCATION-RESOLVED-COSTS,
CROS5-REF-FILE,
OUTPUT COST-ALLOCATIDN-RESOLVED,
PRINT-OUT .
SORT-UNRES-FILE .
SORT FILE-SORT ON ASCENDING KEY
S-ACCT-NO
USING COST-ALLOCATION-UNRESOLVED
GIVING COST-ALLOCATION-UNRESOLVED.
OPFN-CAU-FILE.
OPEN INPUT COST-ALLOCATION-UNRESOLVED.
FILL-HEADING.
READ CARD-IN AT END MOVE
'*** NO DATE/TITLE CARD *<•* JOB ABORTED **•>'
TO PRINT-DATA,
PERFORM PRINT-LINE-OUT
GO TO CLOSE-IO-FILES.
MOVE DATE-IN TO DATE-GUT.
MOVE TITLE-IN TO TITLE-OUT.
READ-COSr-TABLE-IN.
READ COST-ALLOCATION-RESOLVED-COSTS AT END MOVE
'*<"> COST TABLE CONTAINS NO DATA ** JOB ABORTED
TO PRINT-DATA
PERFORM PRINT-LINE-OUT
GO TO CLOSE-IG-FILES.
WRITE-HEADINGS.
ADD 1 TO PAGE-CT.
MOVE PAGE-CT TO PAGE-OUT.
MLVt ZERO TC LINE-CT.
PERFORM MOVt-SPACES.
WRITE PRINT-LINE BEFORE NEW-PAGE.
MOVE HEAD-1 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MCVE HEAD-2 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-3 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-OUT 2 TIHFS.
MCVE HEAD-4 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MLVE HEAD-5 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR I NT-LINE- OUT .
HOU5E-KEFP-
MGVE SPACES TO DATA-LINE.
235
-------
MOVE ZERO TO COMMON-PERCENTAGES,
B-PtRCENTAGES,
C-PERCENTAGFS,
D-PERCENTAGES,
E-PERCENTAGES,
F-PERCENTAGES,
G-PERCENTAGE5.
READ-INPUT.
READ COST-ALLOCATION-UNRESOLVED AT END
GO TD kRITE-SUBTOTAL.
START-RESOLVING.
MOVE ACCT-NG TO ACCT-HOLD, ACCT-NDMINAL, RES-ACCT-NO.
ACCT-NO-OUT.
MOVE ALLOC-CDOE TO ALLOC-CDDE-HULD, ALLOC-CODE-QUT.
MOVE COST-CAT TO RES-COST-CAT, COST-CAT-OUT.
MOVE AMTS (1) TD AMOUNT-OUTf AMT-HDLD, AMT-HOLD-OVFLOh.
ADD AMTS (1) TD SUBTOTAL-
READ-CRF.
READ CROSS-REF-FILE INVALID KEY
MOVE DATA-LINE TO PRINT-DATA
PERFORM PRINT-LINE-OUT
MOVE '*** ABOVE ACCOUNT NUMBER NOT FOUND ***' TO
PRINT-DATA
PERFORM PRINT-LINE-OUT
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT
GO TD READ-INPUT.
IF ALLOC-CODE = 'B' THEN
GO TO ALLOCATION-B.
IF ALLOC-CODE = 'C1 THEN
GO TO ALLOCATION-C.
IF ALLOC-CDDE = '0' THEN
GO TO ALLOCATION-D.
IF ALLOC-COOE = •£' THEN
GO TD ALLOCATION-E.
IF ALLOC-COOE = 'F' THEN
GO TO ALLOCATION-F.
IF ALLOC-CODE = «G» THEN
GO TO ALLOCATION-G.
INVALID-ALLOC-CDDE-FALLTHRU.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRIlMT-LINE-OUT.
MOVE '*** ABOVE RECORD HAS INVALID ALLOC CODE ***'
TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR1NT-LINE-OUT.
GC TO READ-INPUT.
ALLOCATION-B.
IF B-PERCENTAGES = ZERO THEN
PERFORM GET-B-PERCENTAGES.
PERFORM MOVE-B-PERCENT-TO-COMMON VARYING I
236
-------
FROM 1 BY 1 UNTIL I > NQ-GF-CC.
ALLOCATIDN-b-1 .
PERFORM WRITE-RESDLVED-COSTS THRU WR 1 TE-RESOLVED-COSTS-ENO.
PERFORM REAJ-INPUT.
IF ACCT-NQ = TO ACCT-HOLD THEN
PERFORM STAKT-RESOLVING
GD TO ALLOCATION-B-I
ELSE GO TO START-kESOLVING.
ALLOCATION-C .
IF C-PERCENTAGES = ZERO THEN
PERFORM GET-C-PERCENTAGES.
PERFORM MGVE-C-PERCENT-TO-COMMON VARYING I
^ROM 1 BY 1 UNTIL I > NO-OF-CC.
ALLOCATiCN-C-1.
PERFORM WRITE-RESOLVED-CDSTS THRU WR I TE-RESULV ED-COSTS-END.
PERFORM READ-INPUT.
IF ACCT-NO = TO ACCT-HOLD THEN
PERFORM START-RESOLVING
GD TO ALLOCATION-C-1
ELSE GO TO START-RESOLVING.
ALLOCATION-D.
IF 0-PERCENTAGES = ZERO THEN
PERFORM GET-D-PERCENTAGES.
PERFORM MOVE-D-PERCENT-TO-COMMON VARYING I
FROM 1 BY 1 UNTIL I > NO-OF-CC.
ALLOCATION-D-1.
PERFORM WRITE-RESOLVED-COSTS THRU WR I TE-RE SOLVED-COSTS-END.
PERFORM READ-INPUT.
IF ACCT-NO = TO ACCT-HOLO THEN
PERFORM START-RESOLVING
GO TO ALLOCATION-D-1
ELSE GO TO START-RESOLVING.
ALLOCATION-E.
IF E-PERCENTAGES = ZERO THEN
PERFORM GET-E-PERCENTAGES.
PERFORM MOVE-E-PERCENT-TO-COMMON VARYING I
FROM 1 BY 1 UNTIL I > ND-OF-CC.
ALLOCATION-E-1.
PERFORM WRITE-RESOLVED-COSTS THRU WR ] TE-RESOLVED-COSTS-END
PERFORM READ-INPUT.
IF ACCT-NO = TO ACCT-HOLD THEN
PERFORM START-RESOLVING
GO TO ALLOCATION-E-1
ELSE GO TO START-RESOLVING.
ALLOCAT10N-F.
IF F-PERCENTAGES = ZERO THEN
PERFORM GET-F-PERCENTAGE5.
PERFORM MOVE-F-PERCENT-TO-COMMON VARYING I
FROM 1 BY 1 UNTIL I > NO-OF-CC.
ALLOCAT1CN-F-1.
237
-------
PERFORM WRITE-RESOLVED-COSTS THRU WR ITE-RESOLVED-COSTS-END.
PERFORM READ-INPUT.
IF ACCT-ND = ACCT-HDLO THEN
PERFORM START-RESOLVING
GO TO ALLOCATION-F-1
ELSE GO TO START-RESOLVING.
ALLOCATION-&.
IF G-PERCENTAGES = ZERO THEN
PERFORM GET-G-PERCENTAGES.
PERFORM MOVE-&-PERCENT-TO-COMMON VARYING I
FROM 1 BY 1 UNTIL I > NQ-DF-CC.
ALLOCATION-G-1.
PERFORM WRITE-RESOLVED-COSTS THRU WRITE-RESGLVED-COSTS-END.
PERFORM READ-INPUT.
IF ACCT-NO = ACCT-HOLD THEN
PERFORM START-RESOLVING
GD TO ALLOCATION-G-1
ELSE GO TO START-RESOLVING.
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE 1.
ADD 1 TO LINE-CT.
GET-COMMON-PERCENTAGES.
MOVE ZEROS TO COMMON-AMOUNTS, COMMON-AMOUNTS-ACCUM.
PERFORM SEARCH-COST-TABLE VARYING I FROM 1 BY 1
UNTIL I > NO-OF-CC.
PERFORM TOTAL-AMTS VARYING I FROM 1 BY 1
UNTIL I > NO-OF-CC.
IF COMMON-AMOUNTS-ACCUM = ZEROS THEN
PERFORM MOVE-IN-EQUAL-PERCENTAGES VARYING
I FROM 1 BY 1 UNTIL I > NO-OF-CC
ELSE MOVE 1 TO PERCENT-100
PERFORM M&VE-IN-PERCENTAGES VARYING
I FROM 1 BY 1 UNTIL I > NO-OF-CC
SEARCH-CCST-TABLE.
MOVE CRF-COST-CNTR (I) TO SEARCH-NO.
SET CC TC 1.
SEARCH ALL RES-COSTS AT END
MOVE ZERO TO COMMON-AMT (I)
WHEN COST-CNTR (CC) = SEARCH-NO
MOVE CC-AMOUNT (CO TO COMMON-AMT (I).
TOTAL-AMTS.
IF CDMMON-AMT (I) < ZERO THEN
MOVE ZERO TO COMMON-AMT (I).
ADD CQMMON-AMT (I) TO COMMOU-AMUUNTS-ACCUM.
MGVE-IN-EQUAL-PERCENTAGES.
DIVIDE 1 BY NO-OF-CC GIVING COMMON-PERCENT (I) ROUNDED.
MDVE-IN-PERCENTAGES.
DIVIDE COMMON-AMT (I) BY COMMON-AMOUNTS-ACCUM
238
-------
GIVING COMMON-PERCENT (I) ROUNDED.
SUBTRACT COMMON-PERCENT (I) FROM PERCtNT-100.
IF 1 = NO-OF-CC THEN
ADD PERCENT-100 TO COMMON-PERCENT (I).
V.RITE-RESOLVED-COSTS.
MCVE 1 TO I, J.
FILL-PRINT-LINE .
MOVE ACCT-ND TO RES-ACCT-NO.
MULTIPLY COMMON-PERCENT (I) BY AMT-HOLD GIVING RES-AMTS (1)
MOVE RES-AMTS (1) TO AMT-LiUT DF RES-DATA (J).
SUBTRACT RES-AMTS m FROM AMT-HGLD-OVFLOW.
MOVE SLASH TO SLASH-OUT OF RES-DATA (J).
MOVE CRF-COST-CNTR OF CC-BLK (I) TO
COST-CNTR-OUT OF RES-OATA (J),
RES-COST-CNTR.
MOVE COST-CAT TO RES-COST-CAT.
MOVE CRF-MATCH-CODE OF CC-BLK (I) TO
RES-MATCH-CCDE.
3ALANCE-LAST-AMOUNT.
IF I = NO-OF-CC THEN
ADD RES-AMTS (1) TO AMT-HULD-OVFLOW
MuVE AMT-HOLD-OVFLOW TO RES-AMTS (1)
AMT-OUT OF RES-DATA (J).
WRITE-DISK-REC.
WRITE RES-REC.
CHECK-NG-OF-CC .
IF I = NO-OF-CC THEN
GO TO WRITE-PRINT-LINE.
IF J = 6 THEN PERFORM
WRITE-PRINT-LINE,
MOVE 0 TO J.
ADD 1 TO I. J.
GU TO FILL-PRINT-LINE.
WRITE-PRINT-LINt .
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE SPACES TO DATA-LINE.
SKIP-A-LINE.
PERFORM MOVE-SPACES THRU PR INT-LINE- OUT .
IF LINE-CT > MAX-LINE THEN
PERFORM WRITE-HEADIN&S.
WRlTE-RcSOLVED-COSTS-END.
EXIT.
GET-B-PERCENTAGES.
PERFORM GET-COMMON-PERCENTAGES.
PERFORM MOVE-COMMON-TO-B-PERCENT VARYING
I FROM 1 BY 1 UNTIL I > NO-QF-CC.
MOVE-COMMON-TO-6-PERCENT .
MOVE COMMON-PERCENT (I) TO B-PERCENT (I).
f.ET-C-PEPCENTAGtS.
239
-------
PERFORM GET-COMMDN-PERCENTAGES.
PERFORM MCVE-COMMON-TC-C-PERCENT VARYING
I FROM 1 BY 1 UNTIL I > NO-LF-CC.
MOVE-COMMON-TO-C-PERCENT.
MOVE COMMON-PERCENT (I) TO C-PERCENT (I)
GET-D-PERCENTAGfcS.
PERFORM GET-COMMON-PERCENTAGES.
PERFORM MOVE-COMMUN-TO-D-PEkCENT VARYING
I FROM 1 BY 1 UNTIL I > NG-UF-CC.
MOVE-COMMON-TO-U-PERCENT.
MOVE COMMON-PERCENT m TO D-PERCENT m
GET-E-PERCENTAGES.
PERFORM GET-COMMON-PERCENTAGES.
PERFORM MOVE-COMMON-TO-E-PERCENT VARYING
I FROM 1 BY 1 UNTIL I > NO-L1F-CC.
MOVE-COMMON-TO-E-PERCENT.
MOVE COMMON-PERCENT d) TO E-PERCENT m
&ET-F-PERCENTAGtS.
PERFORM GET-COMMON-PERCENTAGES.
PERFORM MOVE-COMMON-TO-F-PFRCENT VARYING
I FROM 1 BY 1 UNTIL I > NO-OF-CC.
MOVE-COMMON-TO-F-PERCENT.
MOVE COMMON-PERCENT (I) TO F-PERCENT (I)
r.ET-G-PtRCEfMTAGcS.
PERFORM GET-COMMON-PERCENTA&ES.
PERFORM M&VE-COMMON-TQ-G-PERCfcNT VARYING
I FROM 1 BY 1 UNTIL I > NO-OF-CC.
MOVt-COMMON-TO-G-PERCENT.
MOVE COMMON-PERCENT (I) TO &-PERCENT (I),
MOVE-B-PERCENT-TO-COMMON.
MOVE B-PERCENT (I) TO COMMON-PERCENT (I)
MOVE-C-PERCENT-TO-COMMON.
MOVE C-PERCENT (I) TO COMMON-PERCENT (I)
MGVE-D-PERCENT-TO-COMMON.
MOVE D-PERCENT (I) TO COMMON-PERCENT (I)
MOVE-E-PERCENT-TO-COMMON.
MOVE E-PERCENT (I) TO COMMON-PERCENT (I)
MDVE-F-PERCENT-TO-COMMON.
MOVE F-PERCENT (I) TO COMMON-PERCENT (I)
MOVE-G-PERCENT-TO-COMMON.
MOVE &-PERCENT (I) TO COMMON-PERCENT (I)
KRITE-SUBTOTAL.
MOVE SPACES TO DATA-LINE.
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-OUT 2 TIMES.
MOVE 'SUBTOTAL ' TO ACCT-NO-OUT.
MOVE SUBTOTAL TO AMOUNT-OUT.
MOVE DATA-LINE TD PRINT-DATA.
PERFORM PRINT-LINE-OUT.
CLOSE-IO-FILES,
240
-------
CLOSE COST-ALLOCATION-RESQLVED,
COST-ALLOCAT I ON-UNRESOLVED,
COST-ALLOCATION-RESOLVED-COSTS,
CROSS-REF-FILE,
CARD-IN,
PRINT-OUT.
E-O-J.
STOP RUN.
241
-------
,SYSIN DD *
ID DIVISION.
PRD&RAM-ID. WUASUZFI.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
8o7 W MORSE BLVD
WINTER PARK, FL 32789.
DATE-wRITTEiM. DEC 1977.
DATE-COrtPILED.
REMARKS. THIS PROGRAM ZEROS OUT THE AMOUNT
FIELDS IN THE COST-MATRIX FILE
DEPENDING ON THE PARAMETER CARD(S).
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-25^0R-S-CAROIN
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
SELECT COST-MATRIX-FILE
ASSIGN TO DA-3330-I-CMFILE
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CM-NUMBER.
DATA DIVISION.
FILE SECTION.
Fu CDST-MATRIX-FILE
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-REC.
01 INPUT-REC.
05 MATCH-CODE PIC X(4).
05 CM-NUMBER PIC X(16).
05 AMOUNTS.
10 AMTS OCCURS 6 TIMES PIC S9(8IV99.
*****
* THE ABOVE AMTS (AMOUNTS) ARE AS FOLLOWS
* (1) -- CURRENT COST AMOUNT
* (2) -- PREVIOUS MONTH COST AMOUNT
* (3) -- CURRENT COST AMOUNT YEAR TO DATE
-------
(6) -- PREVIOUS YEAR COST AMOUNT (PYC)
*
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
05 PARM-CODE PIC X.
05 FILLER PIC X(79) .
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTtRS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
05 FILLER PIC X.
05 PRINT-DATA PIC X(80).
05 FILLER PIC X(52) .
PROCEDURE DIVISION.
OPEN-FILF.S.
OPEN 1-0 COST-MATRIX-FILE,
INPUT CARD-IN,
OUTPUT PRINT-OUT.
TOP-OF-iMEWPAGE.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE NEW-PAGE.
PERFORM PRINT-LINt-OUT 10 TIMES.
MOVE 'THE CUST MATRIX FILE IS BEING CHANGED BY THE FQLLOWl
'NG METHOD' TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR1NT-LINE-OUT.
READ-CARD-IN.
READ CARD-IN AT END GO TO STANDARD-ZERO-PROCEDURE.
IF PARM-CODE - 'F' THEN
GO TO FISCAL-YEAR-CHANGE-PRUCEDURE.
IF PARM-CODE = 'Z' THEN
GO TO ZERO-OUT-FILE-PROCEDURE.
INVALID-PARM-COOE-FALLTHRU.
MOVE ' THE FOLLOWING PARAMETER CARD WAS INVALID -- JOB ABO
'RTEO' TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE INPUT-CARD TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
GO TO CLOSE-FILES.
STANDARD-ZERO-PROCEDURE.
MCVE ' NORMAL PERIOD CHANGE OVER' TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
START-ZERO-1 .
PERFORM RcAD-CM-FILE.
MOVE AMTS (1) TG AMTS (2) .
MGVE ZEROS TO AMTS ( 1 ) .
243
-------
PERFORM REWRITE-CM-FILE.
GO TO START-ZERO-1.
FISCAL-YEAR-CHANGE-PROCEDURE.
MOVE ' FISCAL YEAR CHANGE OVER • TU PRINT-DATA.
PERFORM PRINT-LINE-DUT.
START-ZERO-2.
PERFORM READ-CM-FILE .
MOVE AMTS ( 1 ) TO AMTS ( 2) .
MOVE AMTS (3) TO AMTS (6).
MOVE ZEROS TO AMTS (1), AMTS (3), AMTS (M. AMTS (5)
PERFORM REWRITE-CM-FILE.
GO TO START-ZERO-2.
ZERO-OUT-FILE-PROCEDURE.
MCVE ' COST MATRIX FILE IS BEING ZEKOED OUT' TO
PRINT-DATA.
PERFORM PRINT-LINE-OUT.
START-ZERO-3.
PERFORM READ-CM-FILE.
MOVE ZEROS TO AMOUNTS.
PERFORM REWRITE-CM-FILE.
GO TO START-ZERO-3.
READ-CM-FILE.
READ COST-MATRIX-FILE AT END
MOVE 'REVISION OF CM FILE COMPLETED' TO PRINT-DATA
PERFORM PRINT-LINE-OUT
GO TD CLOSE-FILES.
REWRITE-CK-FILE.
REWRITE INPUT-REC.
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE 1.
CLOSE-FILES.
CLOSE COST-MATRIX-FILE,
CARD-IN,
PRINT-OUT.
E-O-J.
STOP RUN.
244
-------
PGMNAME=WUASCUPD
SYSIN DO *
ID DIVISION.
PROGRAM-ID. WUASCUPD.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
907 W MORSE Bl_VD
WINTER PARK, FL 32789.
DATE-WRITTEN. OEC 1977.
DATE-COMPILED.
REMARKS. THIS PROGRAM READS THE COST ALLOCATION R.ESOLVED
FILE (RESOCAFI) AND UPDATES THE COST MATRIX FILE
(CMFILE) WITH THE CURRENT COSTS.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT COST-ALLOCATION-RESOLVED
ASSIGN TO UT-3330-S-RESOCAFI
ACCESS MODE IS SEQUENTIAL.
SELECT COST-MATRIX-FILE
ASSIGN TO DA-3330-I-CMFILE
ACCESS MODE IS RANDOM
RECORD KEY 15 CM-NUMBER
NOMINAL KEY IS CM-NOMINAL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILE50RT
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD COST-MATRIX-FILE
BLOCK CONTAINS 5 RECORDS
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CM-REC..
01 CM-REC.
05 MATCH-CODE PIC XU).
05 CM-NUMBER.
10 ACCT-NO PIC X(10).
10 COST-CNTR PIC X ( <» > .
10 COST-CAT PIC X(2).
05 AMOUNTS.
10 AMT OCCURS 6 TIMES PIC S9(8)V99.
245
-------
FD CDSr-ALLOCATIDN-RESDLVED
BLOCK CONTAINS 5 RECORDS
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS RES-REC.
Cl RES-REC.
05 RES-NUM PIC
05 RES-MATCH-CGDE PIC
05 RES-AMOUNTS.
1C RES-AMT OCCURS 6
SD FILE-SORT
RECORD CONTAINS 80 CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
05 SORT-FIELD PIC X(16)
05 FILLER PIC X(64)
FD PRINT-OUT
RECORD CONTAINS 133 -CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
05 FILLER PIC
05 PRINT-DATA PIC
WORKING-STORAGE SECTION.
X(16)
TIMES PIC S9(8)V99.
X.
X(132)
77 CM-NOMINAL
77 REAu-COUNT
77 UPDATE-COUNT
77 GOOD-COUNT
77 BAD-COUNT
01 AMOUNT-HOLD.
05 AMT-HOLD
01 DATA-LINE.
PIC X(16) VALUE
PIC 9(7) VALUE
PIC 9(7) VALUE
PIC 9(7) VALUE
PIC 9(7) VALUE
SPACES
ZERO.
ZERO.
ZERO.
ZERO.
OCCURS 6 TIMES PIC S9(8)V99
05
05
05
05
05
05
PIC
PIC
PIC
PIC
PIC
PIC
X( 10)
X( 13)
XX
Z(7).
X(80)
X(15)
VALUE
VALUE
VALUE
FILLER
COMMENT
FILLER
COUNT-OUT
ERROR-REC
FILLER
PROCEDURE DIVISION,
SORT-RECORDS.
SORT FILE-SORT
SORT-FIELD
USIMG COST-ALLOCATION-RESOLVED
GIVING COST-ALLOCATION-RESOLVED.
OPEN-FILES.
CQST-MATRIX-FILE.
COST-ALLOCATION-RE SOLVED
PRINT-OUT.
SPACES
SPACES
SPACES
ON ASCENDING KEY
OPEN
1-0
INPUT
OUTPUT
HOUSE-KEEP.
MOVE SPACES
TO DATA-LINE
246
-------
MOVE ZEROS TO AMOUNT-HOLD.
TOP-NEW-PAGE .
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE NEW-PAGE.
MOVE 'UPDATE CM FILE PGM1 TO COMMENT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-DUT.
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-OUT 3 TIMES.
READ-RES-REC.
READ COST-ALLOCATION-RESOLVED AT END
GO TD WRITE-COUNTS.
ADD 1 TO READ-COUNT.
MOVE-NOMINAL-KEY.
MOVE RES-NUM TO CM-NOMINAL.
READ COST-MATRIX-FILE INVALID KEY
MOVE 'INVALID RECORD KEY' TO COMMENT
MOVE RES-REC TO ERROR-REC
MOVE DATA-LINE TO PRINT-DATA
PERFORM PRINT-LINE-OUT
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT
MOVE SPACES TO DATA-LINE
ADD 1 TO BAD-COUNT
GO TO RtAD-RES-REC .
MOVE AMOUNTS TO AMOUNT-HOLD.
MOVE ZEROS TC AMT-HOLO (1).
START-UPDATE.
ADD RES-AMT (1) TO AMT-HOLD (1) AMT-HOLO (3)
ADD 1 TO GOOD-COUNT.
CHECK-NEXT-REC.
PERFORM READ-RES-REC .
IF RES-NUM - TO CM-NOMINAL THEN
GO TO START-UPDATE.
REWRITE-CM-REC.
MOVE AMUUNT-HOLD TO AMOUNTS.
REWRITE CM-kEC.
ADD 1 TO UPOATE-COUNT .
MOVE SPACES TO CM-NUMBER.
GO-TO-MOVE-NOMINAL-KEY.
GO TO MOVE-NOMINAL-KEY.
MOVE-SPACES.
MDVE SPACES TO PRINT-LINE.
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE 1.
WRITE-COUNTS.
IF CM-NUMBER NOT = SPACES THEN
PERFORM REWRITE-CM-REC.
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-OUT 3 TIMES.
MOVE 'INPUT RECORD COUNT1 TO COMMENT.
247
-------
MOVE READ-COUNT TO COUNT-OUT.
PERFORM PRINT-LINE-OUT.
MOVE 'ERROR RECORD COUNT1 TO COMMENT
MOVE BAD-COUNT TO COUNT-OUT.
PERFORM PRINT-LINE-OUT.
MOVE 'GOOD RECORD COUNT* TO COMMENT
MOVE GOOD-COUNT TO COUNT-OUT.
PERFORM PRIiMT-LINE-OUT.
MOVE 'UPDATED REC COUNT' TO COMMENT,
MOVE UPDATE-COUNT TO COUNT-OUT.
PERFORM PRINT-LINE-DUT.
CLOSE-FILES.
CLOSE COST-MATRIX-FILE,
COST-ALLOCATION-RE SOLVED
PRINT-OUT.
E-O-J.
STOP RUN.
248
-------
SYSIN OD *
ID DIVISION.
PROGRAM-ID. WUASLV4<».
AUTHOR. ACT SYSTEMS INC
SUITE 200
807 W MGRSE BLVD
WINTER PARK, FLA 32789.
DATE-WRITTEN. JAN 1978.
DATE-COMPILED.
REMARKS. THIS PROGRAM SORTS THE COST MATRIX FILE BY
MATCH CODE AND PRINTS OUT LEVEL IV
(SUPPORT SERVICES) REPORT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEK-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
SELECT COST-MATRIX-FILE
ASSIGN TO DA-3330-I-CMFILE
ACCESS MODE IS SEQUENTIAL
RECLRD KEY IS CM-NUMBER.
SELtCT FINANCIAL-ACCT-TABFI
ASSIGN TO DA-3330-I-FATABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS FA-NOMINAL
RECORD KEY IS FA-NUMBER.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILE5LRT
ACCESS MODE IS SEQUENTIAL.
SELECT SORTED-F1LE
ASSIGN TO UT-3330-S-SORTEDFI
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARJ-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
05 DATE-IN PIC X(l8) .
249
-------
05 TITLE-IN PIC X(24).
05 FILLER PIC X<38).
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
05 FILLER PIC X.
05 PRINT-DATA PIC XI132).
FD CDST-MATRIX-FILE
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CM-REC.
01 CM-REC.
05 MATCH-CUDE-POS1 PIC X.
05 FILLER PIC X(3».
05 CM-NUMBER PIC X( 10) .
05 FILLER PIC X(66).
FD FINANCIAL-ACCT-TABFI
BLOCK CONTAINS 8 RECORDS
RECORD CONTAINS 58 CHARACTERS
LABtL RECORDS ARE STANDARD
DATA RECORD IS FA-REC.
01 FA-RFC.
05 FA-NUMBER PIC X(10) .
05 FA-NAME PIC X(20) OCCURS 2 TIMES.
05 FILLER PIC X(8).
SD FILE-SORT
RECORD CONTAINS 80 CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
05 S-MATCH-CODE PIC X(4).
05 FILLER PIC X(16).
05 FILLER PIC X(60>.
FD SORTED-FILE
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-REC.
01 INPUT-REC.
05 MATCH-CODE PIC X ( PIC S9(8)V99 OCCURS 6 TIMES
250
-------
*
<•
*
*
if
*
«
THE
(
(
(
(
(
(
ABOVE
1 )
2)
3)
4)
5)
6)
--
—
--
--
--
—
AMTS ARE AS FOLLOWS
CURRENT COST AMOUNT
PREVIOUS MONTH COST AMOUNT
CURRENT COST AMOUNT YEAR TO DATE
c
1C
1C
1C
1C
1C
1C
9
9
X
9
X
X
9
X
X
X
X
X
X
X
X
X
X
z
X
X
X
X
X
X
:«*
c
X
X
X
X
X
X
(4) VALUE ZERO
(2) VALUE ZERO
(10) VALUE SPAC
(4) VALUE SPAC
VALUE '4» .
(2) COMP VALUE
VALUE 'O1.
(57) VALUE SPAC
(1
(5
(6
( 1
8
7
>
8
(30
(2
6
(42
(6
(4
(5
)
)
5
(24
(5
3
( 26
(2
( 1
*s
S
(2
(3
(8
( 1
(9
(1
)
)
)
)
)
)
)
V
V
V
V
ALUE
ALUE
ALUE
ALUE
VALUE
V
i
ALUE
FOR1
VALUE
VALUE
»
)
)
)
)
V
V
V
V
V
02)
*
)
1
)
3
*
)
)
**
*£
V
V
V
V
ALUE
ALUE
ALUE
ALUE
ALUE
VALU
* S
****
ALUE
ALUE
ALUE
ALUE
) VALUE
2
)
V
ALUE
i
S
i
E
E
E
LEVE
PAC
DAT
SPAC
SPAC
i
.
SUP
SPAC
i
S
E
E
E
E
P
E
P-AGE
PAC
SPAC
S
i
'
PAC
COS
ONS
SPAC
E
U
**
S
S
1
S
1
S
i *«•
P
** *
PAC
PAC
CUS
PAC
E
E
E
T
i
E
c
P
*
E
E
S.
S .
56.
S.
L IV REPORT OF • .
S.
: •.
S .
S.
ORT SERVICES COSTS
S.
» 1
» t
S.
S .
S.
CATEGORY OESCRIPTI
•
S.
**>*«*«**#**»*#*****
ORT S E R V I
#$$$######$$$##£##$
S.
S.
TOMER1 .
E
GENE
PAC
E
S.
RAL t' .
S.
252
-------
05 FILLER
05
05
05
FILLER
FILLER
FILLER
01 HEAD-b
05
05
05
05
05
05
05
05
05
05
05
DATA
05
05
05
FILLER
FILLER
FILLER
FILLER
PILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
-LINE .
FILLER
OESC
AMOUNT
PIC X(34) VALUE
'RVICE AREAS' .
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
01
OCCURS
10 FILLER
10 AMT
10 FILLER
01 ACCJMS.
05 ACCUM
01 SUBTOTALS.
05 SUBS
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT
INPUT
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
TIME
PIC
PIC
PIC
PIC
PIC
X(
X(
X(
X(
x<
X(
X(
X{
X(
X(
X(
X(
X(
X(
X(
X(
s.
X(
-(
X(
59
S9
12)
7)
b)
30)
10)
9)
14)
10)
11)
11)
12)
9>
14)
2)
2)
20)
b).
8).
5).
(3)
18)
'MAINTANCE OF OUTSIDE SE
SPACfcS.
'COST OF'.
SPACES.
SPACES.
•ACCOUNTING1.
SPACES.
'ADMINISTRATIVE'.
SPACES.
•TAYLOR
SPACES.
•iNDEPEf
SPACES.
•MATERIALS
SPACES.
MILL'
SOLD
VALUE SPACES
V99 OCCURS 5 TIMES
V99 OCCURS 5 TIMES
CARD-IN,
CARD-IN,
COST-MATRIX-FILE ,
FINANCIAL-ACCT-TAbFI ,
PRINT-OUT.
CARD ** JOB ABORTED ***' TO
OUTPUT
READ-CARD-IN.
READ CARD-IN AT END
MOVE '*** NO DATE/TITLE
PRINT-DATA,
PERFORM PRINT-LINE-OUT,
GO TO CLOSE-FILES.
MOVE DATE-IN TO DATE-OUT.
MOVE TITLE-IN TO TITLE-OUT.
SORT-CM-FILE.
OPEN OUTPUT SQRTED-FILE.
SORT FILE-SORT ON ASCENDING
S-MATCH-CODE
INPUT PROCEDURE
READ-SORT-INPUT THRU READ-SLRT-INPUT-END
OUTPUT PROCEDURE
KEY
252
-------
WRITE-SCRT-QUTPUT THRU MR1TE-SCRT-OUTPUT-ENO .
CLOSE SORTEO-FILE.
DPE1M INPUT SDRTED-FILE.
WRITE-HEADINGS.
MOVE ZERO TL) LlNE-CT.
ADD 1 TO PA&E-CT.
MOVE PA&E-CT TO PAGE-OUT.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE NEW-PAGE.
MQVE HEAD-1 TL PRINT-DATA.
PERFORM PRlNT-LINE-OUT.
MOVE HEAD-2 TO PRINT-DATA.
PERl-URM PRINT-LINE-OUT.
MOVE HEAD-3 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR I NT-LINE-OUT.
MOVE HEAD-4 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-5 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-6 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR I NT-LINE-OUT.
ZERO-ACCUMS.
MOVE ZEROS TO SUBTOTALS.
HOUSE-KEEP.
MOVE SPACES TO DATA-LINE.
MOVE ZEROS TO ACCUMS.
READ-SORTED-FILE .
READ SORTED-FILE AT END PERFORM WR I TE-LINE-OUT ,
&0 TO WRITE-TUTALS.
NEW-MATCH-CUDE.
MOVE MATCH-CODE TO MATCH-HOLD.
IF (MATCH-CODE = '^815') AND (SUBTOTAL-FLAG = '0') THEN
PERFORM WRITF-SUB-TOTAL
MOVE '!' TO SUBTOTAL-FLAG
&G TO READ-SDRTED-FILE .
MOVE ACCT-NJ TO FA-NOMINAL.
READ FINANCIAL-ACCT-TABFI- INVALID KEY
MOVE SPACES TO FA-NAME (1), FA-NAME (2).
TOTAL-COST-CNTR5.
IF CC-POS2 < 3 THEN
ADD AMTS (1) TO ACCUM (CC-PDS2), SUBS (CC-PQS2)
GO TO READ-NBXT-REC .
IF CC-POS2 = 4 THEN
MOVE 5 TO CC-POS2
ADD AMTS (1) TO ACCUM (CC-PDS2), SUBS (CC-POS2)
GO TO READ-NEXT-REC .
IF CC-POS't = 2 THEN
MOVE 4 TO CC-POS2
253
-------
ADO AMIS (1) TO ACCUM (CC-PGS2), SUBS (CC-PDS2)
E|_Sc ADD AMIS (1) TO ACCUM (CC-PDS2), SUBS (CC-POS2).
READ-NEXT-REC.
PERFORM READ-SORTED-FILE.
IF MATCH-CODE EQUAL TO MATCH-HOLD THEN
GO TO TOTAL-COST-CNTRS.
URITE-LINE-OUT.
MOVE FA-NAME (1) TO DESC.
PERFORM MOVt-ACCUMS VARYING I FROM 1 BY 1 UNTIL I - 6.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
IF FA-NAME (2) NOT EQUAL TO .SPACES THEN
MOVE SPACES TO DATA-LINE,
MOVE FA-NAME (2) TO DtSC.
MOVE DATA-LINE TO PRINT-DATA,
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR 1NT-LINE-OUT .
PERFORM HOUSE-KEEP.
CHECK-FJR-NEW-HEAUING.
IF LINE-CT NOT < MAX-LINE THEN
PERFORM WRITE-HEADINGS.
GO TO NEW-MATCH-CODE.
KRITE-TUTALS.
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-OUT 2 TIMES.
PERFORM HOUSE-KEEP.
MOVE 'TOTALS' TO DESC.
PERFORM MOVE-AMOUNTS VARYING I FROM 1 BY 1 UNTIL I = 6.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-DUT.
GO TO CLOSE-FILES.
WRITE-SUB-TOTAL.
PERFORM MOVE-AMUUNTS VARYING I FROM 3 BY 1 UNTIL I = 6.
MOVE 'EXPENCES COVERED BY' TO DESC.
MDVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-DUT.
MOVE SPACES TO DATA-LINE.
MOVE 'OTHER REVENUE' TO DESC.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR INT-LINE-OUT.
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE 1.
Ai>D 1 TO LINE-CT.
MOVE-ACCUMS.
MOVE ACCUM (I) TO AMT OF AMOUNTS (I).
MOVE-AMOUNTS.
MOVE SUBS (I) TO AMT GF AMOUNTS (I).
254
-------
MOVE ZERO TO SUBS (I) .
READ-SORT-INPUT.
READ COST-MATRIX-FILE AT END
GO TO READ-SORT-INPUT-END.
IF MATCH-CDOE-POS1 NOT = TO MATCH-POS1
THEN GO TU READ-SDRT-INPUT.
RELEASE SORT-INPUT FRUM CM-REC.
GO TO READ-SQRT-INPUT .
READ-SOKT-INPUT-END.
EXI T.
WRITE-SORT-OUTPUT.
RETURN FILE-SORT RECORD INTO INPUT-REG
AT ENO GO TO wR ITE-SORT-PUTPUT-ENU
WRITE INPUT-REC.
GO TO WRITE-SQRT-OUTPUT.
WRITE-SURT-OUTPUT-END.
EXI T.
CLOSE-FILES.
CLOSE SORTED-FILE.
CARD-IN,
COST-MATRiX-FILE,
FINANCIAL-ACCT-TABFI,
PRINT-OUT.
E-O-J.
STOP RUN.
255
-------
PGMNAME=PLV43CCV
SYSIN DO *
ID DIVISION.
PROGRAM-ID. PLV^SCOV.
AUTHOR. ACT SYSTEMS INC
SUITE 200
807 W MORSE BL.VD
WINTER PARK, FLA 32789.
DATE-HRITTEN. JAN 1978.
DATE-COMPILED.
REMARKS. THIS PROGRAM SORTS THE COST MATRIX FILE BY
MATCH CODE AND PRINTS OUT LEVEL IV (DELIVERY)
REPORT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1<+03-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
SELECT COST-MATRIX-FILE
ASSIGN TO DA-3330-I-CMFILE
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CM-NUMBER.
SELECT PRINT-FILE
ASSIGN TO UT-3330-S-PRINTFI
ACCESS MODE IS SEQUENTIAL.
SELECT FINANCIAL-ACCT-TABFI
ASSIGN TO DA-3330-I-FATABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS FA-NOMINAL
RECORD KEY IS FA-NUMBER.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESORT
ACCESS MODE IS SEQUENTIAL.
SELECT SORTED-FILE
ASSIGN TO UT-3330-S-SORTEDFI
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
256
-------
DATA RFCDRO IS INPUT-CARD.
01 INPUT-CARD.
05 DATE-IN PIC X(l8).
05 TITLE-IN PIC X ( 24).
05 FILLER PIC X(38).
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
05 FILLER PIC X.
05 PRINT-DATA PIC X(132).
FD COST-MATRIX-FILE
RECORD CONTAINS so CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CM-REC .
01 CM-REC.
05 MATCH-CODE-POS1 PIC X.
05 FILLER PIC X(3).
05 CM-NUMBER PIC X(10) .
05 FILLER PIC X(66).
FD PRINT-FILE
BLOCK CONTAINS 6 RECORDS
RECORD CONTAINS 2<+0 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS PR I NT-LINE-HOLD.
01 PRINT-LINE-HOLD.
05 DESC-HOLD PIC X(20) OCCURS 2 TIMES.
05 AMTS-HOLD PIC S9(8)V99 OCCURS 20 TIMES
FD FINANCIAL-ACCT-TABFI
BLOCK CONTAINS 8 RECORDS
RECORD CONTAINS 58 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS FA-REC.
01 FA-REC.
05 FA-NUMBER PIC X( 10) .
05 FA-NAME PIC X{20) OCCURS 2 TIMtS.
05 FILLER PIC X(8).
SD FILc-SORT
RECORD CONTAINS 80 CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
05 S-MATCH-CODE PIC X(<+).
05 FILLER PIC X(16).
05 FILLER PIC x<60).
FD SORTEO-FILE
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
257
-------
01
DATA RECORD
INPUT-REC.
IS INPUT-REC
05
05
05
05
05
*****
MATCH-CUDE
ACCT-NO
COST-CNTR.
10 FILLER
10 CC-POS2
10 FILLER
10 CC-POS^
COST-CAT
AMTS
THE ABOVE AMTS
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
X(4).
X(10) .
X.
9.
X.
9.
XX.
S9(8)V99
OCCURS 6 TIMES
*
*
*
*****
WORKING-STORAGE
( 1)
(2)
(3)
m
(5)
(6)
-- CURRE
-- PREVI
-- CURRE
-- BUDGE
-- BUDGE
-- PREVI
ARE AS FOLLOWS
NT COST AMOUNT
OUS MONTH COST AMOUNT
NT COST AMOUNT YEAR TO DATE (YTD)
T AMOUNT
T AMOUNT YEAR TO DATE
DUS YEAR COST AMOUNT (PYC)
SECTION
77
77
77
77
77
77
77
77
77
77
77
77
77
77
01
01
PAGE-CT
LINE-CT
FA-NOMINAL
I
J
K
L
M
N
0
MATCH-HOLD
MATCH-POS1
MAX-LINE
MINUS-ONE
HEAJ-1.
05 FILLER
05 FILLER
05 FILLER
HEAD-2.
05 FILLER
05 DATE-OUT
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 PAGE-OUT
05 FILLER
05 PAGE-LETTER-
OUT
01 HEAD-3
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
9( .
X(3)
X.
VALUE
VALUE
VALUE
VALUE
VALUE
COMP
V99 VA
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
ZERO.
ZERO.
SPACES.
SPACES.
'3« .
VALUE 56
LUE -0.0
SPACES .
'LEVEL
SPACES.
•DATE :
SPACES.
SPACES.
•
1.
IV
t
•
1 DELIVERY
SPACES.
•PAGE :
' - • .
1
•
REPORT OF
COSTS FOR
258
-------
Cl
01
01
01
01
01
05 FILLER
05 TITLE-OUT
05 FILLER
HEAO-4.
05 FILLER
05 FILLER
05 FILLER
HEAU-5.
05 FILLER
05 HEAD-OUT
05 FILLER
DATA-LINE.
05 FILLER
05 DESC
05 FILLER
05
PIC X(55) VALUE SPACES.
PIC X(2M VALUE SPACES.
PIC X(53) VALUE SPACES.
PIC XU9) VALUE SPACES.
PIC X(79) VALUE '***<«»**<.:
DELIVERY
***
* <•<•**
PIC XU)
VALUE SPACES.
VALUE SPACES.
PIC X(<+9)
PIC X(79) .
PIC XU> VALUE SPACES.
PIC XK> VALUE SPACES.
PlC X(20) .
PIC X(19) VALUE SPACES.
AMOUNTS OCCURS 5 TIMES.
10 FILLER PIC X(6).
10 AMT PIC -(8).— .
05 FILLER PIC X(4).
ACCUMS.
05 ACCUM-A OCCURS 4 TIMES.
10 ACCUM-B OCCURS 5 TIKES.
15 ACCUM PIC S9(8)V99.
SUBTOTAL.
05 SUB-A OCCURS <* TIMES.
10 SUB-B OCCURS 5 TIMES.
15 SUBS
HEAU-DATA-HOLD.
05 HEAD-DATA-A.
FILLER
10
10
10
10
10
10
10
FILLER
FILLER
FILLFR
FILLER
FILLER
FILLER
PIC S9(8)V99.
PIC X179) VALUE '
' TRANSMISSION
i. _____ — __ — _i (
PIC X(79) VALUE ' ZONE 5 ZO
•NE 6 ZONE 7 ZONE 8
1 ZONE 9 '.
PIC X(79) VALUE '
• DISTRIBUTION
• ___ —i
PIC X(79) VALUE ' ZONE 5 ZO
•NE 6 ZONE 7 ZONE 8
1 ZONE 9 ».
PIC X(79) VALUE '
• STORAGE
i _____________ — —--i
PIC X(79) VALUE ' BROMLEY IDA
•SPENCE OEVOG PARK
PIC X(79) VALUE '
259
-------
PUMP STATIONS
10 FILLER PIC X(79) VALUE ' COLD SPRINGS IDA
'SPENCE DEVOG PARK BOONE CN
•TY '•
05 HEAD-OATA-B REDEFINES HEAD-DATA-A.
10 HEAD-DATA PIC X(79) OCCURS 8 TIMES.
01 PAGE-LETTER-HOLD.
05 PG-LTR-A PIC XK» VALUE 'ABCD'.
05 PG-LTR-B REDEFINES PG-LTR-A.
10 PAGE-LETTER PIC X OCCURS <+ TIMES.
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN,
COST-MATRIX-FILE .
FINANCIAL-ACCT-TABFI ,
OUTPUT PRINT-OUT,
PRINT-FILE.
READ-CARD-IN.
READ CARD-IN AT END
MOVE '*** NO DATE/TITLE CARD ** JOB ABORTED *<">' TO
PRINT-DATA,
PERFORM PRINT-LINE-OUT,
GO TO CLOSE-FILES.
MOVE DATF-IN TO DATE-OUT.
MOVE TITLE-IN TO TITLE-OUT.
SORT-CM-FILE.
OPEN OUTPUT SURTEO-FILE.
SORT FILE-SORT ON ASCENDING KEY
S-MATCH-CODE
INPUT PROCEDURE
READ-SORT-INPUT THRU READ-SLRT-INPUT-END
OUTPUT PROCEDURE
WRITE-SORT-OUTPUT THRU kRITE-SORT-OUTPUT-END .
CLOSE SORTED-FILE.
OPEN INPUT SORTED-FILE.
ZERO-ACCUMS.
MOVE 1EROS TO -SUBTOTAL.
MOVE MINUS-ONE TO SUBS (3, <* ) SUBS (3, 5) SUBS (4. 1).
HOUSE-KEEP.
MOVE SPACES TO PRINT-LINE-HOLD.
MOVE ZEROS TO ACCUMS.
MOVE MINUS-ONE TO ACCUM (3, O ACCUM (3, 5) ACCUM U, 1).
READ-SORTED-FILt.
READ SORTED-FILE AT END PERFORM WRITE-PRI NT-F 1 LE»
GC TO WklTE-SUBTOTALS.
NEW-MATCH-CODE.
MOVE MATCH-CODE TO MATCH-HOLD.
MOVE ACCT-NU TO FA-NOMINAL.
READ FINANCIAL-ACCT-TABFI INVALID KEY
260
-------
MOVE SPACES TQ FA-NAME 11), FA-NAME (2).
TOTAL-COST-CNTRS.
ADD AMIS (1) TO ACCUM (CC-POS2, CC-POS4)
SUBS (CC-POS2, CC-POS4).
PERFORM READ-SDRTED-FILt.
IF MATCH-CODE EQUAL TO MATCH-HOLD THEN
GO TO TUTAL-COST-CNTRS.
WRITE-PRINT-FILE.
MOVE FA-NAME (1) TO DESC-HOLD (1).
MOVE FA-NAME (2) TO DESC-HOLD (2).
MOVE 1 TO K.
PERFORM MOVE-ACCUMS VARYING I FkDM 1 BY 1 UNTIL I = 5.
WRITE PRINT-LINE-HOLD.
PERFORM HOUSE-KEEP.
RETURN-TO-NEW-MATCH-CUDE.
GO TO NEW-MATCH-CODE.
MOVE-ACCUMS.
PERFORM MOVE-ACCUMS-A VARYING L FROM 1 BY 1 UNTIL L = 6,
MOVE-ACCUMS-A.
MOVE ACCUM (It L) TO AMTS-HOLD (K).
ADD 1 TO K.
WRITE-SUBTDTALS.
WRITE PRINT-LINE-HOLD.
MOVE 1 TO K.
PERFORM MOVE-SUBS VARYING I FROM 1 BY 1 UNTIL I = 5.
MOVE 'TOTALS1 TO DESC-HOLO (1).
MOVE SPACES TO DESC-HOLD (2).
WRITE PRINT-LINE-HOLD.
GO TO HOUSE-KEEP-1.
MOVE-SUBS .
PERFORM MOVE-SUBS-A VARYING L FROM 1 BY 1 UNTIL L = 6.
MOVE-SUBS-A.
MOVE SUBS (I, L) TO AMTS-HOLD (K).
ADD 1 TO K.
HOUSE-KEEP-1 .
MOVE -1 TO J.
MOVE 0 TO 0.
PERFORM START-PRINTING THRU START-PRINTING-END
VARYING I FROM 1 BY 1- UNTIL I = 5.
GO TO CLOSE-FILES.
START-PKINTING.
ADD 2 TO J, 0.
PERFORM REWIND-PRINT-FILE.
WRITE-HtADINGS.
ADD 1 TO PAGE-CT.
MOVE 1 TO LINE-CT.
MOVE PAGE-CT TO PAGE-OUT.
MOVE PAGE-LETTFR (I) TO PAGE-LETTER-OUT.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE NEW-PAGE.
261
-------
MOVE HEAD-1 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-2 TO PRINT-DATA.
PERFORM PRINT-LINE-GUT.
MOVE HEAD-3 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT.
MUVE HEAD-4 TO PRINT-DATA.
PERFORM PRINT-LINE-QUT.
MOVE HEAD-DATA (J) TO HEAD-OUT.
MOVE HEAD-5 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-DATA (0) TO HEAD-OUT.
MOVE HEAD-5 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR 1NT-LINE-OUT.
READ-PRINT-FILE.
READ PRINT-FILE AT END GO TU START-PRINTING-END
MOVE-VALUES-OUT.
IF I = 1 THEN
MOVE 1 TO N.
IF I
IF I
IF I
MOVE
= 2
MOVE
= 3
MOVE
= 4-
MOVE
1 T
THEN
6 TO
THEN
11 TO
THEN
16 TO
0 M.
N
N
N
PERFORM MOVE-VALUES 5 TIMES.
MOVE DESC-HOLD (1) TO DESC.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
IF DESC-HOLD (2) NOT = SPACES THEN
MOVE SPACES TO DATA-LINE
MUVE DESC-HOLD (2) TO DESC
MOVE DATA-LINE TO PRINT-DATA
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR1NT-LINE-OUT.
IF LlNE-CT > MAX-LINE THEN
PERFORM WRITE-HEADINGS .
PERFORM READ-PRINT-FILE.
IF PR1NT-LINE-HOLU = SPACES THEN
PERFORM MOVE-SPACES THRU PR 1 NT-LINE-OUT
PERFORM READ-PRINT-FILE.
GO TO MOVE-VALUES-OUT.
START-PRINTING-END.
EXIT.
MOVE-VALUES.
IF AMTS-HOLD (N) = MINUS-ONE THEN
MOVE ZERO TO AMT OF AMOUNTS (M)
262
-------
ELSE MOVE AMIS-HOLD (N) TO AMI LF AMOUNTS (M)
ADD 1 TG M.
ADD 1 TG N.
REWIND-PRINT-FILE .
MOVE ZERO TO PA&E-CT.
CLOSE PRINT-FILE.
OPEN INPUT PRINT-FILE.
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-LINE-GUT.
WRITE PRINT-LINE BEFORE 1.
ADD 1 TU LINE-CT.
READ-SORT-INPUT.
REAJ COST-MATRIX-FILE AT END
GO TO REAO-SORT-INPUT-END.
IF MATCH-CODE-PDS1 NOT = TO MATCH-POS1
THEN GO TQ kEAD-SORT-INPUT.
RELEASE SORT-INPUT FRUM CM-REC.
GO TO READ-SORT-INPUT.
REAO-SORT-INPUT-END.
EXI T.
WRITE-SGRT-GUTPUT .
RETURN FILE-SORT RECORD INTG INPUT-REC
AT END GO TQ WRITE-SORT-OUTPUT-END.
WRITE INPUT-RtC.
GO TO WRITE-SQRT-OUTPUT.
WRITE-SORT-QUTPUT-END.
EXI T .
CLOSE-FILES.
CLOSE SURIED-FILE,
CARD-IN,
CUST-MATRIX-FILE,
FINANCIAL-ACCT-TABF1.
PRINT-FILE,
PRINT-OUT.
E-O-J.
STOP RUN.
263
-------
PGMNAME=«UASLV43
.SYSIN 00 *
ID DIVISION.
PROGRAM-ID. WUASLV43.
AUTHOR. ACT SYSTEMS INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, FLA 32789.
DATE-i«RlTTEN. JAN 1978.
DATE-COMPILED.
REMARKS. THIS PROGRAM SORTS THE COST MATRIX FILE BY
MATCH CODE AND PRINTS OUT LEVEL IV (DELIVERY)
REPORT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-25^0R-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTDUT
ACCESS MODE IS SEQUENTIAL.
SELECT COST-MATRIX-FILE
ASSIGN TO DA-3330-I-CMFILE
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CM-NUMBER.
SELECT PRINT-FILE
ASSIGN TO UT-3330-S-PRINTFI
ACCESS MODE IS SEQUENTIAL.
SELECT FINANCIAL-ACCT-TABFI
ASSIGN TO DA-3330-I-FATABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS FA-NOMINAL
RECORD KEY IS FA-NUMBER.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILfcSORT
ACCESS MODE IS SEQUENTIAL.
SELECT SDRTED-FILE
ASSIGN TO UT-3330-S-SORTEDF1
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
264
-------
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
05 DATE-IN PIC X(18).
05 TITLE-IN PIC X(2M .
05 FILLER PIC X(i8) .
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABtL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
05 FILLER PIC X.
05 PRINT-DATA PIC X(132).
FO COST-MATRIX-FILE
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CM-REC .
01 CM-REC.
05 MATCH-CODE-POS1 PIC X.
05 FILLER PIC X(3).
05 CM-NUMBER PIC xiio).
05 FILLER PIC X(66).
FD PRINT-FILE
BLOCK CONTAINS 6 RECORDS
RECORD CONTAINS 220 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS PRINT-LINE-HOLD.
01 PRI uT-LINE-HOLD.
05 DESC-HOLD PIC X(20) OCCURS 2 TIMES.
05 AMTS-HOLD PIC S9(8)V99 OCCURS 18 TIMES
FD FINANCIAL-ACCT-TABFI
BLOCK CONTAINS 8 RECORDS
RECORD CONTAINS 58 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS FA-REC.
01 FA-REC.
05 FA-NUMBER PIC X(10) .
05 FA-NAME PIC X(20) OCCURS 2 TIMES.
05 FILLER PIC X(8 ).
SO FILE-SORT
RECORD CONTAINS 80 CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
05 S-MATCH-CODE PIC XU).
05 FILLER PIC X(16) .
05 FILLER PIC X(oO).
FD SORTED-FILE
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
265
-------
01
DATA RECORD
INPUT-REC.
IS INPUT-REC
*
*
*
*
*
*
*
* * * * *
WORK
77
77
77
77
77
77
77
77
77
77
77
77
77
77
01
01
05 MATCH-CODE
05 ACCT-NO
05 COST-CNTR.
10 FILLER
10 CC-PDS2
10 FILLER
10 CC-POS4
05 COST-CAT
05 AMTS
THE ABOVE AMTS ARE
(1) -- CURRENT C
(2) -- PREVIOUS
(3) — CURRENT C
PIC X ( 4 ) •
PIC X( 10) .
PIC X.
PIC 9.
PIC X.
PIC 9.
PIC XX.
PIC S9(8)V99 OCCURS 6 TIMES.
AS FOLLOWS
OST AMOUNT
MONTH COST AMOUNT
OST AMOUNT YEAR TO DATE (YTD)
(4) -- BUDGET AMOUNT
(5) -- BUDGET AMOUNT YEAR TO DATE
(6) -- PREVIOUS
ING-STORAGE SECTION.
PAGE-CT
LINE-CT
FA-NOMINAL
I
J
K
L
M
N
0
MATCH-HLLO
MATCH-POS1
MAX-LINE
MINUS-ONE
HEAU-1.
05 FILLER
05 FILLER
05 FILLER
HEAD-2.
05 FILLER
05 DATE-OUT
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 PAGE-OUT
05 FILLER
05 PAGE-LETTER-OUT
YEAR COST AhDUNT (PYC)
PIC 9(4J VALUE ZERO.
PIC 9(2) VALUE ZERO.
PIC X(10) VALUE SPACES.
PIC 9.
PIC 599.
PIC 99.
PIC 99.
PIC 99.
PIC 99.
PIC 99.
PIC X(4) VALUE SPACES.
PIC X VALUE '3'.
PIC 9(2) COMP VALUE 56.
PIC S9( 8JV99 VALUE -0.01.
PIC X(57) VALUE SPACES.
PIC X(18) VALUE 'LEVEL IV REPORT
PIC X(57) VALUE SPACES.
PIC X(6) VALUE 'DATE: '.
PIC X(18) VALUE SPACES.
PIC X(32) VALUE SPACES.
PIC X(21) VALUE ' DELIVERY COSTS
PIC X(41) VALUE SPACES.
PIC X(6» VALUE 'PAGE! ».
PIC 2(4).
PIC X(3) VALUE ' - • .
PIC X.
OF
FOR
01 HEAD-3.
266
-------
01
01
01
01
01
01
05 FILLER
05 TITLE-OUT
05 FILLER
HEAO-4.
05 FILLER
05 FILLER
05
05
FILLER
FILLER
05 FILLER
HcAD-5.
05 FILLER
05 HEAD-OUT
05 FILLER
DATA-LINE .
05 FILLER
05 OESC
05 FILLER
05 AMOUNTS OCCURS
10 FILLER
10 AMT
05 FILLER
ACCUMS.
05 ACCUM-A OCCURS
10 ACCuM-B OCC
15 ACCUM P
SUBTOTAL.
05 SUB-A OCCURS 4 TIME
10 SUB-B OCCURS 6
P
P
P
P
P
P
P
1
1
P
P
P
P
P
P
P
T
P
P
P
I
I
I
I
I
I
I
*
*
I
I
I
I
I
I
I
I
I
I
I
C
C
C
C
C
C
C
*
*
C
C
C
C
C
C
C
M
C
C
C
X
X
X
X
X
X
X
**
fr*
X
X
X
X
X
X
X
ES
X
-
X
{
(
(
(
{
(
(
*
*
{
(
(
(
(
{
(
•
(
(
(
55
24
53
2)
26
6)
96
& $
£ &
2 >
34
96
2)
4J
20
2)
6)
8)
2 )
)
)
)
)
)
*
*
VA
VA
VA
VA
VA
VA
VA
***
** <•
Lue
LUE
LUE
LUE
LUE
LUE
LUE
**
<• ** !
VALUE
)
)
VA
•
LUt
VALUE
VALUE
)
•
VALUE
•
•
•
SPAC
SPAC
SPAC
SPAC
'CDS
•DNS
SPAC
' <•<• *
D
(•*<•**
SPAC
SPAC
SPAC
SPAC
SPAC
E
E
E
E
T
i
E
S .
S.
S.
S.
CATEGORY DESCRIPTI
•
S.
$$#$$$&$$$$#$$###$£$
*
E
E
E
E
E
E L I V E R Y *
*««r0*»*
-------
DUDLEY PIKE
05
•E HWY KYLES LANE
•Y FOOT LAFAYETTE'.
HEAD-DATA-B REDEFINES HEAD-DATA-A.
HEAD-DATA PIC X(96) OCCURS 6 TIMES
TURKE
10
VALUE 'ABC1
CARD ** JOB ABORTED ***• TO
KEY
01 PAGE-LETTER-HOLD.
05 PG-LTR-A PIC X(3)
05 PG-LTR-B REDEFINES PG-LTR-A.
10 PAGE-LETTER PIC X OCCURS 3 TIMES
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN,
COST-MATRIX-FILE.
FINANCIAL-ACCT-TABFI,
OUTPUT PRINT-OUT.
PRINT-FILE.
READ-CARD-IN.
READ CARD-IN AT END
MOVE '<"** ND DATE/TITLE
PRINT-DATA,
PERFORM PRINT-LINE-OUT.
GO TO CLOSE-FILES.
MOVE DATE-IN TO DATE-OUT.
MOVE TITLE-IN TO TITLE-OUT.
SORT-CM-FILE.
OPEN OUTPUT SQRTEO-FILE.
SORT FILE-SORT ON ASCENDING
S-MATCH-CODE
INPUT PROCEDURE
READ-SORT-INPUT THRU READ-SORT-INPUT-END
OUTPUT PROCEDURE
WRITE-SORT-DUTPUT THRU WRITE-SORT-OUTPUT-END
CLOSE SDRTEO-FILE.
OPEN INPUT SORTED-FILE.
ZERCJ-ACCUMS.
MOVt ZEROS TO SUBTOTAL.
MOVE MINUS-ONE TO SUBS
SUBS
HOUSE-KEEP.
MOVE SPACES_ TG PR I NT-L I NE-HG LD
MGVE ZEROS TO ACCUMS.
MOVE MINUS-ONE TO ACCUM (1,
ACCUM (?,
READ-SORTED-FILE .
READ SDRTED-FILE AT END PERFORM WRITE-PRINT-FILE,
GO TO WRITE-SUBTOTALS .
NEW-MATCH-CODE.
MOVE MATCH-CODE TO MATCH-HOLD.
MOVE ACCT-NO TO FA-NOMINAL.
READ FINANCIAL-ACCT-TABFI INVALID KEY
MUVE SPACES TO FA-NAME 11), FA-NAME (2).
(1.
U,
<*)
SUBS
SUBS
ACCUM
ACCUM
U.
(2.
(1,
(2,
5)
5)
5)
5)
SUBS
SUBS
ACCUM
ACCUM
(1,
(2,
(1,
(2,
6)
6)
6)
6)
268
-------
TGTAL-COST-CNTRS .
ADD AMIS (1) TO ACCUM (CC-PQS2, CC-POS4)
SUBS (CC-POS2, CC-POS4) .
PERFORM READ-SDRTED-FILE.
IF MATCH-CODE EQUAL TO MATCH-HOLD THEN
GO TO TOTAL-COST-CNTRS.
WRITE-PRINT-FILE .
MOVE FA-NAME (1) TO DESC-HOLD (1).
MOVE FA-NAME (2) TO DESC-HOLD (2).
MOVE 1 TO K.
PERFORM MOVE-ACCUMS VARYING I FROM 1 BY 1 UNTIL I = 5.
WRITE PRINT-LINE-HOLD.
PERruRM HOUSE-KEEP.
RETURN-TO-NEK-MATCH-CODE.
GO TO NEW-MATCH-CODE.
MOVE-ACCUMS.
PERFORM MOVE-ACCUMS-A VARYING L FROM 1 BY 1 UNTIL L = 7
MOVE-ACCUMS-A.
IF ACCUM (I. L) NOT = MINUS-ONE THEN
MOVE ACCUM (I. L) TO AMTS-HOLD (K)
ADD 1 TLi K.
WRITE-SJRTDTALS.
WRITE PRINT-LINE-HOLD.
MOVE 1 TO K.
PERFORM MOVt-SUBS VARYING I FROM 1 BY 1 UNTIL I = 5.
MOVE 'TOTALS' TO OE5C-HOLD 11).
MOVE SPACES TO DESC-HOLD (2).
WRITE PRINT-LINE-HOLD.
GO TO HOUSE-KEEP-1.
MOVE-SUBS.
PERFORM MOVE-SUBS-A VARYING L FROM 1 BY 1 UNTIL L = 7.
MOVE-SUBS-A.
IF SUBS (I* L) NOT = MINUS-ONE THEN
MOVE SUBS (I. L) TO AMTS-HOLD (K)
ADD 1 TO K.
HOUSE-KEEP-1 .
MOVE -1 TO J.
MOVE 0 TO 0.
PERFORM START-PRINTING THRU START-PR INT ING-END
VARYING I FROM 1 BY 1 UNTIL I = 4.
GO TO CLOSE-FILES.
START-PRINTING.
ADD 2 TU J, 0.
PERFORM REWINO-PRINT-FILE.
WRITE-HEAUINGS.
ADD 1 TO PAGE-CT.
MOVE 1 TO LINE-CT.
MOVE PAGE-CT TO PAGE-OUT.
MOVE PAGE-LETTER (I) TO PAGE-LETTER-OUT.
PERFORM MOVE-SPACES.
269
-------
WRITE PRINT-LINE BEFORE NEW-PAGE.
MOVE HEAO-1 TO PRINT-DATA.
PERFORM PRINT-LINE-DUT.
MOVE HEAD-2 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-3 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRINT-L1NE-OUT.
MOVE HEAD-4 TO PRINT-DATA.
PERFORM PRINT-LINE-GUT.
MOVE HEAD-DATA (J) TO HEAD-OUT.
MOVE HEAD-5 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-DATA (0) TO HEAD-OUT.
MOVE HEAD-5 TO PRINT-DATA.
PERFORM PRINT-LINE-DUT.
PERFORM MOVE-SPACES THRU PRINT-LINE-DUT.
READ-PRINT-FILE.
READ PRINT-FILE AT END GO TO START-PRINTING-END,
MDVE-VALUES-OUT.
IF I = 1 THEN
MOVE 1 TO N.
IF I = 2 THEN
MOVE 7 TO N.
IF I = 3 THEN
MOVE 13 TO N.
MOVE 1 TO M.
PERFORM MOVE-VALUES 6 TIMES.
MOVE DESC-HOLO (1) TO DESC.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
IF DESC-HOLO (2) NOT - SPACES THEN
MOVE SPACES TO DATA-LINE
MOVE DESC-HOLD 12) TO DESC
MOVE DATA-LINE TO PRINT-DATA
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRINT-LINE-DUT.
IF LINE-CT > MAX-LINE THEN
PERFORM WRITE-HEAUINGS.
PERFORM READ-PRINT-FILE.
GO TO MUVE-VALUES-DUT.
START-PRINTING-END.
EXIT.
MOVE-VALUES.
MOVE AMTS-HOLD (N) TO AMT OF AMOUNTS (M>.
ADD 1 TO N.
ADD 1 TO M.
REWIND-PRINT-FILE.
MOVE ZERO TO PAGE-CT.
CLOSE PRINT-FILE.
270
-------
OPEN INPUT PRINT-FILE.
MOVE-SPACES.
MOVt SPACES TO PRINT-LINE.
PRINT-LINE-DUT.
WRITE PRINT-LINE BEFORE 1.
ADD 1 TO LINE-CT.
READ-SORT-INPUT.
READ COST-MATRIX-FILE AT END
GO TO READ-SCRT-INPUT-END.
IF MATCH-COuE-PDSl NOT = TO MATCH-POS1
THEN GO TO READ-SORT-INPUT.
RELEASE SORT-INPUT FROM CM-REC.
GO TO READ-SORT-INPUT.
READ-SORT-INPUT-FND.
EXIT.
WRITE-SORT-OUTPUT.
RETURN FILE-SORT RECORD INTL INPUT-REC
AT END GO TO WR1TE-SORT-OUTPUT-END
WRITE INPUT-REC.
GO TO WRITE-SORT-OUTPUT.
WRITE-SORT-OUTPUT-END.
EXIT .
CLOSE-FILES.
CLOSE SORTEU-FILE,
CARD-IN,
COST-MATRIX-FILE,
FINANCIAL-ACCT-TABF1
PRINT-FILE,
PRINT-OUT.
F-D-J.
STOP RUN.
271
-------
PGMNAME=WUASLV42
SYSIN 00 *
ID DIVISION.
PROGRAM-ID. WUASLV42.
AUTHOR. ACT SYSTEMS INC
SUITE 200
307 W MORSE BLVD
WINTER PARK, FLA 32789.
DATE-WRITTEN. JAN 1973.
DATE-COMPILED.
REMARKS. THIS PROGRAM SORTS THE COST MATRIX FILE BY
MATCH CQDE AND PRINTS OUT LEVEL IV (TREATMENT)
REPORT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-5-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
SELECT COST-MATRIX-FILE
ASSIGN TO DA-3330-I-CMF1LE
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CM-NUMBER.
SELECT FINANCIAL-ACCT-TABFI
ASSIGN TO DA-3330-I-FATABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS FA-NOMINAL
RECORD KEY IS FA-NUMBER.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESORT
ACCESS MODE IS SEQUENTIAL.
SELECT SORTED-F1LE
ASSIGN TO UT-3330-S-SORTEDF1
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABtL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
05 DATE-IN PIC X(18) .
272
-------
05 TITLE-IN PIC X{24) .
05 FILLER PIC X(39) .
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
95 FILLER PIC X.
05 PRINT-DATA PIC X(132 ) .
FD COST-MATRIX-FILE
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CM-REC .
01 CM-REC.
05 MATCH-CODfc-POSl PIC X.
05 FILLER PIC X(3).
05 CM-NUMBER PIC x(10).
05 FILLER PIC X(66) .
FU FINANCIAL-ACCT-TA6FI
BLCCK CONTAINS e RECORDS
RECORD CONTAINS 58 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS FA-REC .
01 FA-REC.
05 FA-NUMBER PIC X(10).
05 FA-NAME PIC X(20) LCCURS 2 TIMES.
05 FILLER PIC X(8) .
SO FILE-SORT
RECORD CONTAINS 80 CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
05 S-MATCH-CUDE PIC X(4).
05 FILLER PIC X( 16) .
05 FILLER PIC X(60).
FD SORTED-FILE
RECORD CONTAINS eo CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-REC.
01 INPUT-REC.
05 MATCH-CODE PIC X(4).
05 ACCT-NO PIC X-( 10) .
05 COST-CNTR.
10 FILLER PIC X.
10 CC-POS2 PIC 9.
10 FILLER PIC XX.
05 COST-CAT PIC XX.
05 AMTS PIC S918JV99 OCCURS 6 TIMES
273
-------
*
•\f
••'f
*
if
*
*
THE
(
(
(
(
(
(
ABO
1
2
3
4
5
6
)
)
)
)
)
)
-
-
-
-
-
-
VE
-
-
-
-
-
-
AMIS ARE AS FOLLOWS
CURRENT COST AMOUNT
PREVIOUS MONTH COST AMOUNT
CURRENT COST AMOUNT YEAR TO DATE (YTDJ
BUDGET AMOUNT
BUDGET AMOUNT YEAR TC DATE
PREVIOUS YEAR COST AMOUNT (PYC)
WORKING-STORAGE SECTION.
77 PAGc-CT
77 LINE-CT
77 FA-NOMINAL
77 I
77 MATCH-HOLD
77 MATCH-POS1
77 MAX-LINE
01 HEAD-1.
05 FILLER
05 FILLER
05 FILLER
01 HEAD-2.
05 FILLER
05 DATE-OUT
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 PAGE-OUT
01 HEAD-3.
05 FILLER
05 TITLE-OUT
05 FILLER
01 HEAu-4.
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
01 HEAO-5.
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
01 HEAD-6.
05 FILLER
05 FILLER
05 FILLER
P
p
I
I
PI
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
1C
I
I
I
I
I
I
I
I
c
c
c
c
c
c
c
c
91
91
X(
9 ,
XI
X
91
x<
XI
XI
XI
XI
XI
XI
XI
XI
Zl
XI
X
Xi
Xi
X'
X
Xi
Xi
X
X
X
X
X
X
X
X
!4»
[2 )
;io>
k
4)
:2>
57)
: is)
157)
!6)
; is)
132)
!21)
145)
(6)
!4>.
155)
(24)
(53)
127)
(26)
(18)
(39)
(22)
(71)
( 12)
(13)
(14)
(22)
(75)
(5)
(20)
VALUE
VALUE
VALUE
VALUE
VALUE
COMP
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
1 N
VALUE
VALUE
VALUE
VALUE
VALUc
VALUE
VALUE
VALUE
VALUE
ZERO.
ZERO.
SPACES.
SPACES.
•2' .
VALUE 56.
SPACES.
•LEVEL IV REPORT OF • .
SPACES.
•DATE: '.
SPACES.
SPACES.
' TREATMENT COSTS FOR '.
SPACES.
•PAGE: ».
SPACES .
SPACES.
SPACES.
SPACES.
•COST CATEGORY DESCRIPTI
•ONS1 .
SPACES.
********* T R E A T M E
T <.<.<•$*$&»*!.
SPACES.
SPACES.
•PURIFICATION1 .
SPACES.
•PLANT OVERHEAD1 .
SPACES.
SPACES.
•RIVER • .
SPACES.
274
-------
01
05 FILLER
05 FILLER
DATA-LINE.
PIC
PIC
X(5 )
XI27
VALUE
VALUE
'RIVER1
SPACES .
PIC S9(8)V99 OCCURS 2 TIMES
PIC Sg(3)V99 OCCURS 2 TIMES
JOB ABORTED ***' TO
05 FILLER PIC XCsOi
05 DESC PIC X(20
05 FILLER PIC X(6)
05 AMOUNTS OCCURS 2 TIMES.
10 FILLER PIC X(1V
10 AMT PIC - (8)
05 FILLER PIC X(26
01 ACCUMS.
05 ACCUM
01 SUBTOTALS.
05 SUBS
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN,
COST-MATRIX-FILE .
FINANCIAL-ACCT-TABFI
OUTPUT PRINT-OUT.
READ-CARD-IN.
READ CAKD-IN AT END
MOVE '*** NO JATE/TITLE CARD
PRINT-DATA,
PERFORM PRINT-LINE-OUT,
GO TO CLOSE-FILES.
MOVE DATE-IN TO DATE-OUT.
MOVt TITLE-IN TO TITLE-OUT.
SORT-CM-FILE.
OPEN OUTPUT SORTED-FILE.
SORT FILE-SORT ON ASCENDING KEY
.S-MATCH-CuDE
INPUT PROCEDURE
READ-SORT-INPUT THRU READ-SORT-INPUT-END
OUTPUT PROCEDURE
WRITE-SORT-OUTPUT THRU URITE-SORT-OUTPUT-ENO
CLOSE SURTEO-FILE.
OPEN INPUT SORTFO-FILE.
WRITE-HEAOINGS.
MOVE ZERO TO LINE-CT.
ADD 1 TO PA&E-CT.
MOVE PA&E-CT TO PAGE-GUT.
PERFORM MQVt-SPACES .
WRITE PRINT-LINE BEFORE NEW-PAGE.
MOVE HEAD-1 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT .
MOVE HEAD-2 TO PRINT-DATA.
PERFORM PRINT-LINE-QUT.
MOVE HEAD-3 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
275
-------
PERFORM MOVE-SPACES THRU PR INT-LINE-OUT.
MOVE HEAD-4 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-5 TO PRINT-DATA.
PERFORM PRINT-LINE-DUT.
MOVE HEAD-6 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR1NT-LINE-DUT.
ZERO-ACCUMS.
MOVE ZEROS TO SUBTOTALS.
HOUSE-KEEP.
MOVE SPACES TO DATA-LINE.
MOVE ZEROS TO ACCUMS.
READ-SORTED-FILE.
READ SORTED-FILE AT END PERFORM WRITE-LINE-OUT,
GO TO WRITE-SUBTOTALS.
NEW-MATCH-CODE.
MOVE MATCH-CODE TO MATCH-HOLD.
MOVE ACCT-NO TO FA-NOMINAt.
READ FINANCIAL-ACCT-TABFI INVALID KEY
MOVE SPACES TO FA-NAME (1), FA-NAME (2).
TOTAL-COST-CNTRS.
ADD AMTS (1) TO ACCUM (CC-PCS2), SUBS (CC-PQ52).
PERFORM READ-SORTED-FILE.
IF MATCH-CODE EQUAL TO MATCH-HOLD THEN
GO TO TOTAL-COST-CNTRS.
WRITE-LIME-DUT.
MOVE FA-NAME (1) TO DESC.
PERFORM MOVE-ACCUMS VARYING I FROM 1 BY 1 UNTIL I = 3.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
IF FA-NAME (2) NOT EQUAL TO SPACES THEN
MOVE SPACES TO DATA-LINE.
MOVE FA-NAME (2) TO DESC,
MOVE DATA-LINE TQ PRINT-DATA,
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR I NT-LINE-OUT .
PERFORM HOUSE-KEEP.
CHECK-FOR-NEW-HEADING.
IF LINE-CT NOT < MAX-LINE THEN
PERFORM WRITE-HEAOINGS.
GO TO NEW-MATCH-CODE.
WRITE-SUBTOTALS.
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-OUT 2 TIMES.
PERFORM HOUSE-KEEP.
MOVE 'TOTALS' TO DESC.
PERFORM MOVE-AMOUNTS VARYING I FROM 1 BY 1 UNTIL I = 3.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
276
-------
GO TO CLOSE-FILES.
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE 1.
ADD 1 TD LINE-CT.
MOVE-ACCUMS.
MOVE ACCUM ( I ) TO ART OF AMOUNTS (I).
MOVE-AMOUNTS.
MOVE SUBS (I) TO AMT OF AMOUNTS (I).
READ-SORT-INPUT.
READ COST-MATRIX-FILE AT END
GO TO REAO-SORT-INPUT-END.
IF MATCH-CODE-POS1 NOT = TO MATCH-POS1
THEN GO TO RFAD-SORT-INPUT.
RELEASE SORT-INPUT FROM Cn-REC.
GO TO READ-SORT-INPUT.
REAO-SORT-INPUT-END.
EXIT.
WRITE-SURT-OUTPUT.
RETURN FILE-SORT RECORD INTO INPUT-REC
AT END GO TO wRITE-SORT-OUTPUT-END.
WRITE INPUT-REC.
GO TO WRITE-SORT-OUTPUT.
WR I TE-SORT-OUTPUT-END.
EXIT.
CLOSE-FILES.
CLOSE SURTED-FILE,
CARD-IN,
COST-MATRIX-FILE,
FINANCIAL-ACCT-TABFI.
PRINT-OUT.
E-O-J.
STOP RUN.
277
-------
PGMNAME=WUASLV41
.SYSIN DO *
ID DIVISION.
PROGRAM-ID. WUA6LV41.
AUTHOR. ACT SYSTEMS INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, FLA 32789.
DATE-WRITTEN. JAN 1978.
DATE-COMPILED-
REMARKS. THIS PROGRAM SORTS THE COST MATRIX FILE BY
MATCH CODE AND PRINTS OUT LEVEL IV (ACQUISITION)
REPORT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
CGI IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CARD1N
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-K03-S-PRINTDUT
ACCESS MODE IS SEQUENTIAL.
SELECT COST-MATRIX-FILE
ASSIGN TO DA-3330-I-CMFILE
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CM-NUMBER.
SELECT FINANCIAL-ACCT-TABFI
ASSIGN TO DA-3330-I-FATABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS FA-NOMINAL
RECORD KEY IS FA-NUMBER.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESORT
ACCESS MODE IS SEQUENTIAL.
SELECT SORTED-FILE
ASSIGN TO UT-3330-S-SORTEDFI
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
05 DATE-IN PIC X(18) .
278
-------
05 TITLE-IN PIC X(24).
05 FILLER PIC X(38).
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
05 FILLER PIC X.
05 PRINT-DATA PIC X(132).
FD COST-MATRIX-FILE
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CM-REC .
01 CM-REC.
05 MATCH-CQDE-PDS1 PIC X.
05 FILLER PIC xi 3) .
05 CM-NUMBER PIC X( 10) .
05 FILLER PIC X(66) .
FD FINANCIAL-ACCT-TABFI
BLOCK CONTAINS 8 RECORDS
RECORD CONTAINS 58 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS FA-REC.
01 FA-REC.
05 FA-NUMBER PIC X( 10) .
05 FA-NAME PIC X(20) OCCURS 2 TIMES.
05 FILLER PIC X(8).
SO FILE-SORT
RECORD CONTAINS 80 CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SGRT-INPUT.
05 S-MATCH-CODE PIC X(^).
05 FILLER PIC x( i6> .
05 FILLER PIC x(eo> .
FD SORTED-FILE
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-REC.
01 INPUT-REC.
05 MATCH-CODE PIC X(4).
05 ACCT-NO PIC X{ 10) .
05 COST-CNTR.
10 FILLER PIC X.
10 CC-POS2 PIC 9.
10 FILLER PIC XX.
05 COST-CAT PIC XX.
05 AMTS PIC S9(8)V99 OCCURS 6 TIMES
279
-------
* THE ABOVE AMTS ARE AS FOLLOWS
* (1) -- CURRENT COST AMOUNT
„ (2) -- PREVIOUS MONTH COST AMOUNT
* j3) .. CURRENT COST AMOUNT YEAR TO DATE (YTO)
* (4) -- BUDGET AMOUNT
* (5) -- BUDGET AMOUNT YEAR TO DATE
* (6) -- PREVIOUS YEAR COST AMOUNT (PYC)
WORKING-STORAGE SECTION.
77 PAGE-CT
77 LINE-CT
77 FA-NOMINAL
77 I
77 MATCH-HOLD
77 MATCH-POS1
77 MAX-LINE
01 HEAD-1.
05 FILLER
05 FILLER
05 FILLER
01 HEAD-2.
05 FILLER
05 DATE-OUT
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 PAGE-OUT
01 HEAO-3.
05 FILLER
05 TITLE-OUT
05 FILLER
01 HEAD-4.
05 FILLER
05 FILLER
-
05 FILLER
05 FILLER
—
-
-
05 FILLER
01 HEAD-5.
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
9i
91
XI
9,
Xi
X
91
XI
XI
X!
XI
XI
x<
XI
XI
XI
Zl
XI
Xi
XI
XI
Xi
X
XI
X
Xi
Xi
Xi
XI
X
Xi
X
(4)
12)
I 10)
»
[4)
12}
157)
(18)
157)
!6>
: is)
:32)
121)
145)
16)
(4).
[55)
(24)
[53)
15)
126)
(14)
[82)
(5)
(49)
15)
( 14)
[12)
(11)
(12)
(9 )
VALUE
VALUE
VALUE
VALUE
VALUE
COMP
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
ZERO.
ZERO.
SPACES.
SPACES.
•I1 .
VALUE 56.
SPACES.
•LEVEL IV REPORT OF1.
SPACES.
•DATE: '.
SPACES.
SPACES.
'ACQUISITION COSTS FOR1 .
SPACES.
•PAGE: •.
SPACES.
SPACES.
SPACES.
SPACES.
•COST CATEGORY DESCRIPTI
•ONS« .
SPACES.
i »* ft*** s* ***** ** *»#* <.*<• *
•** A C Q U I S I T
'ION $$$**<.*$**$*«•
I #«###$####$## 1
SPACES.
SPACES.
•RIVER1 .
SPACES.
•TRANSMISSION' .
SPACES.
•PUMP STATION1.
SPACES.
280
-------
05 FILLER PIC X(15) VALUE 'PURCHASED WATER'.
35 FILLER PIC X(5) VALUE SPACES.
01 DATA-LINE.
05 FILLER Pic X(8).
05 DfcSC PIC X(20) .
05 FILLER PIC XKJ.
05 AMOUNTS OCCURS 4 TIMES.
10 FILLER PIC X(12).
10 AMT PIC -(8).--.
05 FILLER PIC X(8).
01 ACCUMS.
05 ACCUM PIC S9(8)V99 OCCURS <* TIMES.
01 SUBTOTALS.
05 SUBS PIC S9(8)V99 OCCURS 4 TIMES.
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN,
COST-MATRIX-FILE ,
FINANCIAL-ACCT-TABFI,
OUTPUT PRINT-OUT.
REAO-CARO-IN.
READ CARD-IN AT END
MOVE '<">* NO DATE/TITLE CARD ** JOB ABORTED ***' TO
PRINT-DATA,
PERFORM PRINT-LINE-OUT,
GO TO CLOSE-FILES.
MOVE DATE-IN TO DATE-OUT.
MOVE TITLE-IN TO TITLE-OUT.
SORT-CM-FILE.
OPEN OUTPUT SORTED-FILE.
SORT FILE-SORT ON ASCENDING KEY
S-MATCH-CODE
INPUT PROCEDURE
READ-SORT-INPUT THRU READ-SORT-INPUT-END
OUTPUT PROCEDURE
WRITE-SORT-OUTPUT THRU WRITE-SORT-OUTPUT-END.
CLOSE SORTED-FILE.
OPEN INPUT SORTED-FILE.
WRITE-HEADINGS.
MOVE ZERO TO LlNE-CT.
ADD 1 TO PAGE-CT.
MOVE PAGE-CT TO PAGE-OUT.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE NEW-PAGt.
MOVE HEAD-1 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-2 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-3 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
281
-------
PERFORM MOVb-SPACES THRU PR1NT-LINE-OUT.
MOVE HEAD-4 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAO-5 TQ PRINT-OATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR1NT-LINE-OUT.
ZERO-ACCUMS.
MOVE ZEROS TO SUBTOTALS.
HOUSE-KfcEP-
MOVE SPACES TO DATA-LINE.
MOVE ZEROS TO ACCUMS.
READ-SORTED-FILE.
READ SORTED-F1LE AT END PERFORM WRITE-LINE-OUT ,
GO TO WRITE-SUBTOTALS.
NEW-MATCH-CODE.
MOVfc MATCH-CODE TO MATCH-HOLD.
MOVE ACCT-NO TO FA-NOMINAL.
READ FINANCIAL-ACCT-TABFI INVALID KEY
MOVE SPACES TO FA-NAME (1), FA-NAME (2).
TLTAL-COST-CNTRS.
ADD AMTS (1) TO ACCUM (CC-POS2), SUBS (CC-POS2).
PERFORM REAO-SORTED-FILE.
IF MATCH-CODE EQUAL TO MATCH-HOLD THEN
GO TO TUTAL-COST-CNTRS.
WRITE-LINE-DUT.
MOVE FA-NAME (1) TO DESC.
PERFORM MOVE-ACCUMS VARYING I FROM 1 BY 1 UNTIL I = 5.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
IF FA-NAME (2) NOT EQUAL TO SPACES THEN
MOVE SPACES TO DATA-LINE,
MOVE FA-NAME (2) TO DESC,
MOVE DATA-LINE TO PRINT-DATA,
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR 1 NT-LINE-OUT .
PERFORM HOUSE-KEEP.
CHECK-FOR-NEW-HEADING.
IF LINE-CT NOT < MAX-LINE THEN
PERFORM WRITE-HEADINGS.
GO TO NEW-MATCH-CODE.
WRITE-SU6TOTALS.
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-OUT 2 TIMES.
PERFORM HOUSE-KEEP.
MOVE 'TOTALS1 TO DESC.
PERFORM MOVE-AMOUNTS VARYING I FROM 1 BY 1 UNTIL I = 5
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
GO TO CLOSE-FILES.
MOVE-SPACES.
282
-------
MOVE SPACES TO PRINT-LINE.
PRINT-LINE-OUT .
WRITE PRINT-LINE BEFORE 1.
ADD 1 TO LINE-CT.
MGVE-ACCUMS.
MOVE ACCUM (I) TO AMT OF AMOUNTS (I).
MOVE-AMOUNTS.
MOVE SUBS (1) TO AMT OF AMOUNTS (I).
REAU-SORT-INPUT.
READ COST-MATRIX-FILE AT END
GO TO READ-SORT-INPUT-END.
IF MATCH-COOE-PDS1 NOT = TO MATCH-POSl
THEN GO TO KEAD-SLRT-INPUT.
RELEASE SORT-INPUT FROM CM-REC.
GO TO READ-SORT-INPUT.
REAO-SORT-INPUT-END.
EXIT.
WRITE-SORT-OUTPUT.
RETURN FILE-SORT RECORD INTO INPUT-REC
AT END GC TO WRITE-SORT-OUTPUT-ENO
WRITF INPUT-REC.
GO TO WR ITE-SORT-QUTPUT.
^'RITE-SORT-OUTPUT-END.
EXIT.
CLOSE-FILES.
CLOSE SORTED-FILE,
CARD-IN,
COST-MATRIX-FILE.
FINANCIAL-ACCT-TABFI,
PRINT-OUT.
E-O-J.
STOP RUN.
283
-------
PGMNAME=fcUASPLV3
.SYS1N DD *
10 DIVISION.
PROGRAM-ID. WUASPLV3.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, FL 32789.
OATE-wRITTEN. NOV 16, 1977.
DATE-COHPILED. NOV 18, 1977.
REMARKS. THIS PROGRAM READS THE COST MATRIX FILE,
SUMS ALL TOTALS AND PRODUCES A LEVEL III
REPORT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT COST-MATRIX-FILE
ASSIGN TO DA-3330-I-CMFILE
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CM-NUMBER.
SELECT PRINTER
ASSIGN TO UR-1403-S-PRINTGUT
ACCESS MODE IS SEQUENTIAL.
SELECT READER
ASSIGN TO UR-2540R-S-CAROIN
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD COST-MATRIX-FILE
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-REC.
01 INPUT-REC.
05 MATCH-CODE PIC 9(4).
05 CM-NUMBER.
10 ACCT-NO PIC X<10) .
10 COST-CNTR.
15 CC-POSl PIC 9.
15 FILLER PIC 999.
10 CUST-CAT PIC 99.
05 AMTS PIC S9(8)V99 OCCURS 6 TIMES
FD READER
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
284
-------
IS CARD-IN.
DATA RECORD
01 CARu-IN.
05 DATE-IN PIC X( 18) .
05 TITLE-IN PIC X(2M.
05 PERIDD-IN PIC X(7).
05 FILLER PIC X(31) .
FD PRINTER
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PR INTER-JATA.
01 PRINTER-DATA.
02 FILLER PIC X.
02 PRINT-LINE PIC X(132 )
WDRKING-5TORAGE SECTION.
77
77
77
77
77
77
77
77
01
01
01
01
01
01
01
PER
CAT
I
J
K
PIC 9 COMP VALUE 0.
PIC 99 COMP VALUE 0,
PIC 9 COMP VALUE 0.
PIC 99 COMP VALUE 0
PIC 99 COMP VALUE 0,
PIC 9 COMP VALUt 0.
PIC X(10).
LINE-TOTAL-I PIC S9(8)V99
LINE-TOTAL-1
LINE-TOTAL REDEFINES
ACCUM-MAT.
05 PERIOD-1 OCCURS 2 TIMES.
10 CATEGORY-1 OCCURS 12 TIMES.
15 FUNCTION-1 OCCURS 6 TIMES.
2C AMOUNT-1 PIC XUO).
ACCUM-MATRIX REDEFINES ACCUM-MAT.
05 PERIOD OCCURS 2 TIMES.
10 CATEGORY OCCURS 12 TIMES.
15 FUNCTION OCCURS 6 TIMES.
2C AMOUNT PIC S9(8)V99.
SUBS-1.
05 SUB-TOTALS-1 OCCURS 2 TIMES.
10 SUB-TOTAL-1 OCCURS 8 TIMES PIC
SUBS REDEFINES SUBS-1.
05 SUB-TOTALS OCCURS 2 TIMES.
10 SUB-TOTAL OCCURS 3 TIMES PIC
GRAND-1.
05 GRAND-TOTALS-1 OCCURS 2' TIMES.
10 GRAND-TOTAL-1 OCCURS 6 TIMES
GRAND REDEFINES GRAND-1.
05 GRAND-TOTALS OCCURS 2 TIMES.
10 GRAND-TOTAL OCCURS 8 TIMES PIC
CATEGORY-TITLES.
05 TITLES1.
10 TLl PIC X(108) VALUE
X ( 10)
S9(8)V99,
PIC X(10)
S9(8)V99.
1 COST CATEGORY
'PAYROLL COST:
' MANAGEMENT AND
' SUPERVISION
285
-------
01
01
01
01
10 TL2
PIC XU08) VALUE
OPERATION
LABOR '
MAINTENANCE
OTHER
TOTAL
BENEFITS
TOTAL PAYROLL
COST ',
10 TL3
PIC XU08) VALUE
10 TL4
PIC X(72) VALUE
05
HEAD
02
02
02
02
HEAD
02
02
02
02
02
02
HEAD
02
02
02
HEAD
02
02
02
02
02
02
02
02
02
02
02
02
02
T
I
ITLE
NG-1
S REDEFINES T
PERIOD-UUT
F
F
F
I
F
ILLE
ILLE
ILLE
NG-2
ILLE
OATE-
F
F
F
ILLE
ILLE
ILLE
R
R
R
.
R
OUT
R
R
R
PAGE-OUT
1
F
L
F
I
F
F
F
F
F
F
F
F
F
F
F
F
F
NG-3
ILLE
OCAT
.
R
ION-OUT
ILLER
NG-4
ILLE
ILLE
ILLE
ILLE
ILLE
ILLE
ILLE
ILLE
ILLE
ILLE
ILLE
ILLE
ILLE
.
R
R
R
R
R
R
R
R
R
R
R
R
R
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
TLE
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
SI
( 7 y ,
(45)
(26)
(54
(9 J
(20
(34
(3)
(54
(12
(52
( 25
(55
(18
(11
XX
X
X
X
X
X
X
X
X
X
X
(11
(3)
(9
(5
(6
(5
(7
(6
(8
(8
OCCURS
VALUE
VALUE
•LEVE
VALUE
VALUE
VALUE
VALUE
VALUE
1 VALUE
> VALUE
VALUE
( VALUE
) VALUE
) VALUE
> VALUE
VALUE
) VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
22 TIMES PIC
SPACES
L III
SPACES
•ENDING
SPACES
SPACES
•FOR' .
SPACES
•PAGE
SPACES
SPACES
SPACES
SPACES
•FUNCT
SPACES
'ACQUI
SPACES
•
SUMMARY
•
: '.
•
•
•
1 OF 2
•
•
•
•
ION: '
•
SITION'
•
•TREATMENT1 .
SPACES
•
'DELIVERY ' .
SPACES
•SUPPOR
SPACES.
•
T ' .
•INTEREST' .
SPACES
•
CHEMICALS
POWER
MISCELLANEOUS
•TOTAL PAYROLL AND
•DEPRECIATION ».
'TOTAL
•INTEREST
•TAXES
•OTHER DIRECT COSTS',
X( 18) .
OF COST1
286
-------
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
02 FILLER
01 HEAOING-5.
02 FILLER
02 FILLER
02 FILLER
02 FILLER
01 DATA-LINE.
05 TITLE-OUT
05 FILLER
05 PERIODS
os AMOUNTS-OUT
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT COST-MATRIX-FILE,
OUTPUT PRINTER.
READ-CARD-IN.
READ READER AT END MOVE
TO PRINT-LINE
PERFORM PRINT-LINE-OUT
GO TO CLOSE-FILES.
MOVE DATE-IN TO DATE-OUT.
MOVE TITLE-IN TO LOCATION-OUT
MOVE PERIOD-IN TO PERIOD-OUT.
CLOSE-READER.
CLOSE READER.
HOUSEKEEPING.
MOVE SPACES TO
P
p
p
p
p
p
p
p
p
p
p
p
p
D
I
I
I
I
I
I
I
I
I
I
I
I
I
T
C
c
C
c
c
c
c
c
c
c
c
c
c
r
X
X
X
X
X
(
(
(
(
(
5
6
5
8
5
)
)
XX
X
X
X
X
X
X
X
(
(
{
(
(
(
(
7
8
4
1
1
3
7
2)
>
2)
0)
8)
)
)
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
'TOTA
SPAC
'TAXE
SPACE
L
E
S
S
'TOTAL
SPAC
SPAC
'SERV
SPAC
E
E
I
E
S
1
1
S
S
c
S
'WITH
SPAC
SPAC
SPAC
QO nr
E
E
E
S
S
S
•
•
•
•
•
•
ES' .
•
TAXES '
•
•
•
rllD a Q T
TIMES
READER
NO DATE CARD
LlNE-TOTAL-1, GRAND-1, SUBS-1
END
OR (CC-POS1 < 1 OR > 6) THEN
ACCUM-MAT.
DATA-LINE.
TGTAL-UP-MATRIX.
READ COST-MATRIX-FILE AT
GO TO WRITE-HEADINGS.
IF (COST-CAT < 1 OR > 12)
GO TO TOTAL-UP-MATRIX.
MOVE 1 TCX I , J.
PERFORM ADO-AMOUNTS 2 TIMES.
GO TO TOTAL-UP-MATRIX.
ADO-AMOUNTS.
IF AMOUNT-1 (I, COST-CAT, CC-POS1) = SPACES THEN
MOVE ZERO TO AMOUNT (I, COST-CAT, CC-POS1).
ADD AMTS (J) TO AMOUNT (I, COST-CAT, CC-POS1).
ADD 1 TO I.
ADD 2 TG J.
WRITE-HEADINGS.
PERFORM MOVE-SPACES.
WRITE PRINTER-DATA BEFORE NEW-PAGE.
287
-------
MOVE HEADING-1 TD PRINT-LINE.
PERFORM PRINT-LINE-OUT.
MOVE HEADING-2 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
MOVE HEADING-3 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR1NT-LINE-OUT.
MOVE HEADING-** TD PRINT-LINE.
PERFORM PRINT-LINE-OUT.
MOVE HEADING'S TO PRINT-LINE.
PERFORM PRINT-LINE-DUT.
PERFORM MOVE-SPACES THRU PR1NT-LINE-OUT.
MOVE TITLES (1) TO TITLE-OUT.
MOVE OATA-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR INT-LINE-OUT.
WRITE-SUBTITLE.
MOVE TITLES (2) TO TITLE-OUT.
MOVE DATA-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT.
WRITE-MANAGEMENT-SUPERVISION.
MOVE 3 TO I.
MOVc 4 TO J.
PERFORM WRITE-CATEGORIES.
WRITE-OPERATION-LABOR.
MOVE 5 TO I.
MOVE 6 TO J.
PERFORM WRITE-CATEGORIES.
WRITE-MAINTENANCE-LABOR.
MOVE 7 TO I.
PERFORM WRITE-CATEGORIES.
WRITE-OTHER-LABOR.
MOVE 8 TD I.
PERFORM WRITE-CATEGORIES.
WRITE-SUBTOTAL-T1.
MOVE 9 TO I.
MOVE 13 TO J.
PERFORM WRITE-SUBTOTALS.
WRITE-BENIFITS.
MOVE 10 TO I.
PERFORM WRITE-CATEGORIES.
KRITE-RUNNING-SUBTOTAL-T2.
MOVE 11 TO I.
MOVE 12 TO J.
PERFORM WRITE-RUNNING-SUBTOTALS.
WRITE-SUBTITLE-ODC.
PERFORM PRINT-LINE-OUT.
MOVE 'OTHER DIRECT COST:1 TO TITLE-OUT.
MOVE OATA-LINE TO PRINT-LINE.
288
-------
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT
WRITE-MAINTENANCE.
MQVt 7 TO I.
MOVE 13 TO J.
PERFORM WRITE-CATEGORIES.
V,RITE-CHEMICALS .
MUVE 14 TO I.
PERFORM WRITE-CATEGORIES.
WRITE-PQWEP.
MOVE 15 TO I.
PERFORM WRITE-CATEGORIES.
WRITE-MISCELLANEOUS.
MOVE 16 TO I.
PERFORM WRITE-CATEGORIES.
WRITE-SUBTCTAL-T3.
MOVE 9 TO I.
PERFORM WRITE-SUBTOTALS.
WRITE-SECOND-PAGE.
MOVE 'PAGE Z OF 2 ' TO PAGE-UUT.
PERFORM WRITE-HEADINGS.
PERFORM PRINT-LINE-OUT.
WRITE-RUNNING-SUB TOT*L-T4.
MOVE 17 TO I.
MOVE 22 TO J.
PERFORM WRITE-RUNNING-SUBTOTALS.
WRITE-DEPRICIATION.
MOVE 18 TO I .
MOVE 13 TO J.
PERFORM WRITE-CATEGORIES.
WRITE-RUNNING-SUB TOTAL-T5.
MUVE 19 TO I .
PERFORM WRITE-RUNNING-SUBTOTALS.
WRITE-INTEREST.
MOVE 20 TO I .
PERFORM WRITE-CATEGORIES.
WRITE-TAXES.
MOVE 21 TO I.
PERFORM WRITE-CATtGQRIES.
PERFORM PRINT-LINE-OUT.
WRITE-GRAND-TOTAL-T6.
MOVE 19 TO I .
PERFORM WRITE-RUNNING-SUBTOTALS.
GO TO CLOSE-FILES.
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-LINE-OUT.
WRITE PRINTER-DATA BEFORE 1.
WRITE-CATEGORIES.
MOVE 1 TO PfcR.
289
-------
ADD 1 TO CAT.
PERFORM MOVE-AMOUNTS VARYING FUN FROM 1 BY 1 UNTIL FUN = 6
PERFORM TOTAL-AMOUNTS.
MOVE TITLES (I) TO TITLE-OUT.
MOVE PERIOD-IN TO PERIODS.
MOVE DATA-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
MOVE SPACES TO DATA-LINE.
MOVfc 2 TO PER.
PERFORM MOVE-AMOUNTS VARYING FUN FROM 1 BY 1 UNTIL FUN = 6,
PERFORM TOTAL-AMOUNTS.
MOVE TITLES (J) TO TITLE-OUT.
MOVE 'YTD ' TO PERIODS.
MOVE DATA-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRiNT-LINE-OUT.
MOVE SPACES TO DATA-LINE.
MOVE-AMOUNTS.
IF AMOUNT-1 (PER, CAT, FUN) NOT = SPACES THEN
PERFORM CHECK-LINE THRU ADD-TOTALS.
CHECK-LINE.
IF LINE-TOTAL-1 = SPACES THEN
MOVE ZERO TO LINE-TOTAL.
CHECK-SUB.
IF SUB-TOTAL-1 (PER, FUN) = SPACES THEN
MOVE ZERO TO SUB-TOTAL (PER, FUN).
CHECK-GRAND.
IF GRAND-TOTAL-1 (PER, FUN) = SPACES THEN
MOVE ZERO TO GRAND-TOTAL (PER, FUN).
ADD-TOTALS.
MOVE AMOUNT (PER, CAT, FUN) TO AMOUNTS-OUT (FUN).
ADD AMOUNT (PER, CAT, FUN) TO LINE-TCTAL,
SUB-TOTAL (PER, FUN), GRAND-TOTAL (PER, FUN).
TOTAL-AMOUNTS.
MOVE 6 TO FUN.
PERFORM TOTAL-AMTS-FIX.
IF AMOUNT-1 (PER, CAT, FUN) NOT = SPACES THbN
MOVE 7 TO FUN
PERFORM CHECK-LINE THRU CHECK-GRAND
MOVE AMOUNT (PER, CAT, 6) TO AMOUNTS-OUT (7)
ADD AMOUNT (PER, CAT, 6) TO LINE-TOTAL, SUB-TOTAL (PER, 7)
GRAND-TOTAL (PER, 7).
MOVE 8 TO FUN.
PERFORM TOTAL-AMTS-FIX.
MOVE SPACES TO LINE-TOTAL-1.
TOTAL-AMTS-FIX.
IF LINE-TOTAL-1 NOT = SPACES THEN
PERFORM CHECK-SUB THRU CHECK-GRAND
MOVE LINE-TOTAL TO AMOUNTS-OUT (FUN)
ADD LINE-TOTAL TO SUB-TOTAL (PER, FUN),
290
-------
GRAND-TOTAL (PER, FUN).
WRITE-SJBTCTALS.
MOVE 1 TO K.
PERFORM MOVE-SUBTOT-TO-DATALINE VARYING PER
FROM 1 BY 1 UNTIL PER = 9.
MOVE TITLES (I) TO TITLE-OUT.
MOVE PERIOD-IN TO PERIODS.
MOVE DATA-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
MOVE 2 TO K.
PERFORM MOVE-SUBTOT-TO-DATALINE VARYING PER
FROM 1 BY 1 UNTIL PER = 9.
MOVE TITLES (J) TO TITLE-OUT.
MOVE 'YTD ' TO PERIODS.
MOVE DATA-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
MOVE SPACES TO DATA-LINE, SUBS-1.
PERFORM MOVE-SPACES THRU PR 1NT-LINE-OUT.
PERFORM PRINT-LINE-OUT.
WRITE-RUNNING-SUBTOTALS.
MOVE 1 TO K.
PERFORM MOVE-GRTOT-TO-DATAL1NE VARYING PER
FROM 1 BY 1 UNTIL PER = 9.
MOVE TITLES (I) TO TITLE-OUT.
MOVE PERIOD-IN TO PERIODS.
MOVE DATA-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-DUT.
MOVt 2 TO K.
PERFORM MGVE-GRTOT-TO-DATALINE VARYING PER
FROM 1 BY 1 UNTIL PER = 9.
MOVE TITLES (J) TO TITLE-OUT.
MOVE 'YTD ' TO PERIODS.
MOVE DATA-LINE TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
MOVE SPACES TO DATA-LINE, SUBS-1.
PERFORM MOVE-SPACES THRU PR 1NT-LINE-OUT.
PERFORM PRINT-LINE-OUT.
M&VE-SUaTLT-TO-DATA LINE.
IF SUB-TDTAL-1 (K, PER) NOT = SPACES THEN
MOVE SUB-TOTAL (K, PER) TO AMOUNTS-OUT (PER).
MOVE-GRTCT-TO-DATALINE.
IF GRAND-TDTAL-1 (K, PER) NOT = SPACES THEN
MOVE GRAND-TOTAL (K, PER) TO AMOUNTS-OUT (PER)
CLOSE-FILES.
CLOSE COST-MATRIX-FILE, PRINTER.
E-O-J .
STOP RUN.
291
-------
PGMNAME=WUASPLV2
5YSIN DO *
ID DIVISION.
PROGRAM-ID. WUASPLV2
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 W MDRSE BLVD
WINTER PARK, PL 32789.
DATE-WRITTEN. JAN 1973.
DATE-COMPILED.
REMARKS. THIS PROGRAM READS THE COST MATRIX FILE
AND PRINTS THE LEVEL TWO WATER UTILITY
REPORT CALLED 'COST COMPARISON'.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. lBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEfc-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELECT COST-MATRIX-FILE
ASSIGN TO DA-3330-I-CMFILfc
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CM-NUMBER.
SELECT FINANCIAL-ACCT-TABFI
ASSIGN TO DA-3330-I-FATABFI
ACCESS MODE IS RANDOM
NOMINAL KEY IS FA-NOMINAL
RECORD KEY IS FA-NUMBER.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESORT
ACCESS MODE IS SEQUENTIAL.
SELECT SORTED-FILE
ASSIGN TO UT-3330-S-SDRTEDFI
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS DATE-CARD.
01 DATE-CARD.
05 DATE-IN.
292
-------
10 MO-1N PIC X(3).
10 DAY-YR PIC X (15) .
05 TITLE-IN PIC X(24) .
05 FILLER PIC X(8),
05 FISCAL-YR PIC X(24i
05 FILLER PIC X(4),
05 NO-WKS PIC X.
05 RPT-PERIOD PIC X.
FD COST-MATRIX-FILE
RECURO CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CM-REC.
01 CM-REC.
05
05
05
THE
MATCH-NU PIC X(4) .
CM-NUMBER.
10 FA-NU PIC X ( 10) .
10 CC-NU.
15 CC1 PIC X.
15 FILLER PIC X(3).
10 SA-NU PIC XX.
AMT-5 PIC S9(8)V99 OCCURS 6
AbOVE AMOUNTS ARE AS FOLLOWS
(1) -- CURRENT COST AMOUNT
(2) -- PREVIOUS MONTH COST AMOUN
(3) -- CURRENT COST AMOUNT YEAR
(4) -- BUDGET AMOUNT
(5) -- BUDGET AMOUNT YEAR TO DAT
(6) -- PREVIOUS YEAR COST AMOUNT
TIMES.
T
TO DATE
E (YTD)
(PYC)
(YTU)
FD FINANCIAL-ACCT-TABFI
BLOCK CONTAINS 8 RECORDS
RECORD CONTAINS 58 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS FA-REC.
01 FA-RFC.
05 FA-NUMBER PIC X(10>.
05 FA-NAME-1 PIC X(40>.
05 FILLER PIC X(8).
SD FILE-SORT
RECORD CONTAINS 80 CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
05 FILLER PIC X(4).
05 FIRST-10 PIC XllO).
05 CC-NOS.
10 CC-1 PIC X.
10 CC-3 PIC X(3).
05 SA-NOS PIC XX.
293
-------
FD
01
05 FILLER PK X(30).
05 BUDGET PIC 9(8>V99
05 FILLER PIC X(20) .
SORTEU-FILE
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS INPUT-REC.
INPUT-REC.
FD
01
05 MATCH-NO PIC X(4).
05 FA-NO.
10 FA-NO-1 PIC X(2).
10 FA-NO-2 PIC X(8).
05 CC-ND.
10 CC-NO-1 PIC X.
10 CC-NO-2 PIC XXX.
05 SA-NO PIC XX.
05 AMTS.
10 AttT-1 PIC S9(8»V99.
10 AMT-2 PIC S9(8>V99.
10 AMT-3 PIC S9(8)V99.
10 AMT-4 PIC S9(8)V99.
10 AMT-5 PIC S9(8)V99.
10 AMT-6 PIC S9(8)V99.
PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-DATA.
PRINT-DATA.
05
05
WORKING-
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
SCT-
SCT-
LINE
PAGE
MAX-
SUB-
SUB-
FILLER
PRINT-LINE
STORAGE SECTI
ONE
TWO
-CT
-CT
LINE
Tl
T2
FA-iMOMlNAL
P
P
P
P
P
P
P
P
PIC
PIC
X.
X(132)
ON.
I
I
I
I
I
I
I
I
C
C
c
c
c
c
c
c
BUD-ACCT
NEGS
YEAR
YEAR
-IN
-IN
-OUT
MONTH
I
J
K
CC-J
SA-K
P
P
P
P
P
P
P
P
P
I
I
I
I
1
I
I
I
I
c
c
c
c
c
c
c
c
c
9(
9(
9(
9(
99
X<
X(
x(
P
XI
X(
9 (
91
99
9
99
9
99
5)
5 )
4 )
4 )
6)
6)
10
1C
2)
3)
4 )
2)
COMP
COMP
COMP
COMP
COMP
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
SPACE
'CON
T
> VALUE SPAC
X(10)
VALUE
JUSTI
COMP
COMP
COMP
COMP
CDMP
VALUE
i #» i
FIED
VALUE
VALUE
VALUE
VALUE
VALUE
COMP VALUE
COMP VALUE
,
R
0
0
0.
0.
0.
1.
56.
S.
-0*.
ES.
SPACES
IGHT.
0.
1.
0.
0.
0.
•
.
294
-------
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
77
01
01
P-ERRlJR
DEPRE-C
DEPRE-P
INT-C
INT-P
TAX-C
TAX-P
TEMP-1
TEMP-2
TEMP-3
S-TOT-1
S-TOT-2
S-TOT-3
S-TOT-4
S-TQT-5
5-TOT-6
TUT-1
TOT-2
TOT-3
TOT-4
TOT-5
TOT-6
TQT-T3
TQT-T<»
TOT-T5
PRINT-REO-FLAG
88 FLAG-O
88 FLAG-1
88 FLAG-2
RPT-FLAG
88 RPT-A
88 RPT-B
INT-FLAG
88 FLAG-NO
88 FLAG-YES
YEAR-PT5 .
05 YR-A
05 YR-6
MONTH-NAMES.
05 MO-A
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
I
1
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
1
I
I
I
I
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
PI
591
S9(
59(
591
S9(
S9(
S9(
S9(
S9(
591
S9|
S9(
59(
591
591
591
S9 i
59!
S9i
59'
S9i
S9
S9l
59
59
C X
8 )
8 )
8 )
;8)
8)
:si
8)
8)
;s )
;aj
8 )
8)
,8)
[8 ]
1 81
[81
[8 ]
[8 I
is ;
(8!
is :
(8
[8]
(8 ;
(8
V99
V99
V99
V99
V99
iV99
V99
V999
iV999
i V999
iV99
V99
iV99
IV99
IV99
IV99
IV99
IV99
IV99
IV99
IV99
IV99
IV99
IV99
)V99
VALU
CCMP
COMP
CGMP
CGMP
CGMP
COMP
COMP
CDKP
COMP
COMP
CGMP
CGMP
COMP
CGMP
COMP
CGMP
CGMP
CGMP
COMP
COMP
COMP
CGMP
COMP
COMP
COMP
E 'C1
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
.
+ 0
+ 0
+ 0
+ 0
-i-O
-t-0
+ 0
•f
+
•
•
•
•
•
*
•
0
0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
.
•
•
•
•
•
•
*
•
•
•
•
•
•
•
VALUE '0 ' .
VALUE '!'.
PI
C X
VALU
VALU
E »2'
E '1 '
.
.
VALUE '1 ' .
VALUE '2'.
PI
C X
VALUE '0 ' .
VALUE '0'.
VALUE ' 1 ' .
PI
PI
PI
C X
C X
C X
(2
.
) .
(36)
VALUE
•JANFEBMARAPRMAYJUN
' JULAUGSEPOCTNOVDEC' .
05 MO-B REDEFINES MO
10 MO-NAME OCCUR
01 NAME-LIST.
05 LIST-A.
10 NAMES-1A P
-A.
S 12 TIMES PIC X(3).
1C X(12Q) VALUE '
•SOURCE OF SUPPLY
•PUMPING
'fcATER TREATMENT
'TRANSMISSION AND DISTRIBUTION '.
295
-------
10 NAMES-2A
01
01
01
01
01
01
05 NAME-A REDEFINES
10 NAME OCCURS 8 TIMES PIC
LOWER-LIMITS.
05 LIM-LA PIC X(16) VALUE
05 LIM-LB REDEFINES LIM-LA.
10 LD-LIM OCCURS 8 TIMES
UPPER-LIMITS.
05 LIM-UA PIC X(16) VALUE
05 LIM-UB REDEFINES LlM-UA.
10 HI-LIM OCCURS 8 TIMES
COST-CENTERS.
05 CC-LIST-1 PIC X(120) VALUE
PIC X(120) VALUE
'CUSTOMER ACCOUNTS
•ADMINISTRATIVE AND
•NON BUDGETED COSTS
•TOTAL ACTUAL COSTS TO
LIST-A.
X(30).
GENERAL
BUDGET
'6062646690920000
PIC X(2).
•61636567909399991
PIC X(2) .
•ACQUISITION
•TREATMENT
•DELIVERY
•SUPPORT SERVICES
•INTEREST
•TAXES
05 CC-LIST-2 REDEFINES CC-LIST-1.
10 CC-MAME OCCURS 6 TIMES PIC
CAT-LIST.
X(20)
05
CAT-A.
10 C-CAT-1
PIC X(100) VALUE
10 C-CAT-2
PIC X(100) VALUE
05 CAT-B REDEFINES CAT-A.
10 CAT-NAME OCCURS 10 TIMES
HEADING-1.
05 FILLER
05 FILLER
05 FILLER
HEAOING-2.
05 FILLER
05 DATE-OUT
05 FILLER
05 FILLER
•MANAGEMENT t SUPRV
•OPERATION LABOR
•MAINTENANCE LABOR
•OTHER LABOR
•BENEFITS
•MAINTENANCE
•CHEMICALS
•POWER
•MISCELLANEOUS
'DEPRECIATION
PIC X(2J>
REPORT
p
p
p
p
p
p
p
1C
1C
1C
1C
1C
1C
1C
XI
XI
XI
XI
XI
XI
XI
!55>
I 22)
[55)
I 12)
[18 )
134)
[3>
VALUE
VALUE
VALUE
VALUE
.
VALUE
VALUE
SPACE
•COST
SPACE
•LAST
SPACE
•FOR'
S.
COMPARI
S.
ENTRY:
s.
.
SON
i
296
-------
01
01
05
05
05
HEAD
05
05
05
05
05
05
HEAD
05
05
05
05
05
FILLER
FILLER
PAGE-OUT
ING-3.
FILLER
RPT-PD
WKS-CUT
FILLER
TITLE-DUT
FILLER
ING-12.
FILLER
FISC-YR
FILLER
FILLER
FILLER
PIC X(55 )
PIC X(6>
PIC Z(4) .
VALUE
VALUE
SPACES
•PAGE:
PIC X(12) VALUE 'RPT PERIOD:
PIC X{8 J .
PIC X(6 ) .
PIC X(26) VALUE SPACES.
PIC X(24 ).
PIC X(54> VALUE SPACES.
PIC X(12) VALUE 'YTO START:
PIC X(24) .
PIC X(24) VALUE SPACES.
PIC X(12 ) VALUE M LEVFL II ) '
PIC X(60> VALUE SPACES.
PART-A HEADINGS
01
01
01
01
HEADING-4.
05 FILLER
05 SUB-OUT
05 FILLER
HEAOING-5.
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
HEAOING-6 „
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05
05
FILLER
FILLER
05 FILLER
05 FILLER
05 FILLER
HEADING-?.
05 FILLER
05 FILLER
05 FILLER
PIC X(36) VALUE
•COMPARISON OF
•T TO BUDGET '
ACTUAL COS
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
I
c
1C
I
I
I
I
I
I
I
I
I
I
I
c
c
c
c
c
c
c
c
c
c
c
1C
1C
I
1
c
c
1C
1C
1C
I
c
X
X
X
X
X
X
X
X
X
fc
) .
90)
1
7
42
1
1
1
1
2
5
4
0
22
X(l
X(2
X(l
4)
0)
9 )
X (24)
X(4
)
X(24)
X(4
X(2
X(2
X(2
XU
X(4
)
1)
)
)
& )
>
VALUE
VA
VA
VA
VA
VA
LUE
LUE
LUE
LUE
LUE
VALUE
VALUE
VA
VA
LUE
LUE
VALUE
VA
LUE
VALUE
SPAC
E
S
•
•BUDGET CATEGORIES'
SPAC
E
S
•
'ACTUAL COSTS ' .
SPAC
E
S
•BUDGE
SPAC
'VAR
.
1 <•*<•
SPAC
• «*
1 * ' .
SPAC
E
I
*
E
o
E
S
•
TED CQSTS ' .
•
ANCE YR TO DATE
*
»
S
ft
S
***** ft*..
»0ftftftft»ftftft«ftftftft
•
ft tf * if ^ ^ « ft * ft «. * * ft *
•
VA-LUE i*******************
VA
VA
VA
VA
VA
VA
LUE
LUE
LUE
LUE
LUE
LUE
'*'.
SPAC
»<•*!>
SPAC
SPAC
•ACC
E
*
E
E
T
•NAME
S
»
S
S
1
•
*##»*$*****»»»«
•
•
# ACCOUNT '.
•
297
-------
05
05
05
05
05
05
01 BUDG
05
05
01 DATA
05
05
05
05
05
f\ r-
05
05
05
05
05
05
05
FILLER
FILLER P
FILLER
FILLER
FILLER
FILLER
ET-CAT.
NAME-OUT
FILLER
-LINE-A.
HEAD-STRIp-OUT
COL-1A
COL-2A
FILLER
COL-3A
Cr°> i /A
OL-4A
FILLER
COL-5A
FILLER
COL-6A
FILLER
NEG-OUT
P
1C
P
P
P
P
p
P
P
P
P
P
P
P
P
P
P
P
P
1C
X
(
29)
VALUE
X(2M VALUE 'C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
I/*
L
1C
1C
1C
1C
1C
1C
X
X
X
X
X
X
X
X
X
X
-
X
X
(
(
(
(
(
(
(
(
(
(
(
(
(
5)
13)
15)
22)
30
102
52)
— • ~
1)
~ t •*
1)
— » ~*
2)
5).
1)
2) .
VALUE
VALUE
VALUE
VALUE
•
) VALUE
.
» — — — « — —
— — • t — — — .
VALUE
——»———.
VALUE
VALUE
™ •
VALUE
SPACES.
URR
SPAC
•YR
PERIOD
ES.
TO JATE
•ANNUAL AMT
i
BALANCE
SPACES.
.
•
SPAC
SPAC
"
SPAC
SPAC
ES.
ES.
ES.
ES.
01 HEAD-STRIP-1A.
05
05
05
05
FILLER
ACCT-ND
FILLER
ACCT-NAME
P
P
P
P
1C
1C
1C
1C
X
X
X
X
{
2)
VALUE
SPAC
ES.
(9).
(
(
1)
40)
VALUE
•
SPAC
ES.
01 HEAJ-STRIP-2A.
05
05
*** **
*
NAME-8
FILLER
P
P
1C
1C
X
X
(
(
3U>
22)
•
VALUE
SPAC
ES.
YR TO DATE'
PERCENT
PART-B HEADINGS
01 HEADING-8.
05 FILLER
05 SUBS-OUT
05 FILLER
01 HEAOING-9-
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 CURR-YR
05 FILLER
05 FILLER
05 PREV-YR
05 FILLER
PIC X(40> VALUE
•COMPARISON
•T TO PRIOR
OF ACTUAL
YEAR ».
COS
P
P
P
P
p
P
P
P
P
P
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
X(
X(
X(
X(
X(
X(
9(
X(
X(
9<
6).
86)
6>
15)
28)
13)
4) .
10)
13)
4) .
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
SPACES
SPACES
•COST
SPACES
•
•
CATEGORIES' .
•
•ACTUAL COSTS '.
SPACES
•ACTUA
•
L COSTS ' .
PIC X(14> VALUE SPACES.
298
-------
01
01
01
01
01
01
01
05
05
HEAD
05
05
05
05
05
05
05
05
05
HEAD
05
05
05
05
05
05
05
DATA
05
05
05
05
05
05
05
05
05
05
HEAj
05
05
05
HEAD
05
05
05
05
DATA
05
05
05
DATA
05
05
05
F
F
ILLE
R
ILLER
P
P
1C
1C
X
X
( 19)
(6)
VA
LUE
VALUE
•VAR
SPAC
IANCE YR TO DATE1
ES.
ING-10.
F
F
F
F
F
F
F
F
F
I
F
F
F
F
F
F
F
ILLE
R
ILLER
ILLE
ILLE
ILLE
ILLE
ILLE
ILLE
ILLE
NG-1
ILLE
ILLE
ILLE
ILLE
ILLE
ILLE
R
R
R
R
R
R
R
1.
R
R
R
R
R
R
ILLER
-LINE
HEAD-
C
F
C
F
C
F
C
F
OL-1
ILLE
OL-2
ILLE
OL-5
ILLE
-B .
OUT
B
R
B
R
B
R
OL-6B
ILLE
NEGS-
-
F
C
F
-
F
F
C
F
-
f
C
F
STRI
ILLE
-CAT
ILLE
STRI
ILLE
ILLE
R
OUT
P-1B.
R
-OUT
R
P-2B .
R
R
C-OUTS
ILLE
LINE
ILLE
C-UU
ILLE
-LINE
F
C
£
ILLE
R
-D.
R
T
R
-E.
R
-CAT-SUB
ILLE
R
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
1C
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
-
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
(6)
( 30)
(13 )
( 17)
( 10)
( 17 )
( 11 )
(24)
(41
(53)
( 10)
(17)
( 10)
( 17)
( 19)
(6)
(49)
*
( 13)
1
( 11)
t —
(4)
( 5) -
(4)
( 2) .
( 10)
( 30)
(9)
(6)
(14 )
(20)
(9)
(6)
(20)
( 106
(8)
(20)
( 104
VALUE
VA
VA
VA
LUE
LUE
LUE
VALUE
VALUE
VALUE
VA
VA
LUE
LUE
VALUE
VA
VA
VA
VA
VA
LUE
LUE
LUE
LUE
LUE
VALUE
,
VA
VA
t
VA
VA
VA
.
VA
VA
.
VA
VA
.
) V
VA
.
) V
LUE
LUE
•
LUE
LUE
LUE
LUE
LUE
VALU
LUE
LUE
ALUt
LUE
ALUt
SPAC
• *=**
• *»*
SPAC
» *<•*
SPAC
• *•<•*
SPAC
•<.o
SPAC
SPAC
•YR
SPAC
'YR
SPAC
ES .
»***«*<. * (.*»* * *$**
**<•'.
ES.
$£«£ $$$$$*<•<.$<• 1 .
ES.
«*<.«.$«*»«$$*»» 1 .
ES .
*»<•***<•*<•****<•***
ES.
ES.
TO DATE' .
ES.
TO DATE' .
ES.
' BALANCE PERCENT1
SPAC
SPAC
SPAC
•
ES.
ES.
ES.
SPAC-ES.
SPAC
SPAC
SPAC
SPAC
E 'T
SPAC
SPAC
ES.
ES.
ES.
ES .
OTAL COST OF ' .
ES.
ES.
SPACES.
SPAC
ES.
SPACES .
299
-------
*
* START OF PROGRAM
PROCEDURE DIVISION.
OPEN-FILES.
OPEN INPUT CARD-IN, COST-MATRIX-FILE,
FINANCIAL-ACCT-TABFI .
OUTPUT PRINT-OUT.
READ-TITLE-CARD.
READ CARD-IN AT END GO TO TITLE-PARAGRAPH.
GD TO READ-TITLE-CARD.
TITLE-PARAGRAPH.
PERFORM FILL-HEADINGS.
PERFORM TOP-NEW-PAGE.
PERFORM WRITE-PAGE-HEAD1NG.
SORT-RECORDS.
OPEN OUTPUT SORTED-FILE.
SORT FILE-SORT ON ASCENDING KEY FIRST-10
DESCENDING KEY BUDGET
INPUT PROCEDURE READ-SORT-INPUT
THRU READ-SDRT-INPUT-END
OUTPUT PROCEDURE WR I TE-SORT-OUTPUT
THRU WRITE-SORT-OUTPUT-END.
REWIND-FILE.
CLOSE SORTED-FILE.
OPEN INPUT SORTED-FILE.
REPORT-PART-A.
PERFORM WRITE-SUB-TITLE-A.
MOVE 'O1 TO PRINT-REQ-FLAG.
MOVE SPACES TO BUD-ACCT.
PERFORM NEW-BUDGET-CAT THRU TE ST-ACC T-L1M I T- END VARYING I FRO
M 1 BY 1 UNTIL I GREATER THAN 7.
PERFORM WRITE-TOTALS.
PERFORM WRITE-DEPREC-INT-TAXES.
MOVE TOT-2 TO TOT-T4
PERFORM WRITE-TLTALS.
MOVE ZEROS TO DEPRE-C, DEPRE-P, INT-C, 1NT-P. TAX-C, TAX-P.
MOVE ZEROS TO SCT-ONE, TEMP-1, TEMP-2.
MOVE 'O1 TO INT-FLAG.
MOVE '2' TO RPT-FLAG.
MOVE SUB-T1 TU SUB-OUT, SUBS-bUT.
DOUBLE-SORT.
CLOSE SORTED-FILE, COS T -M ATR IX -F I LE .
OPEN INPUT COST-MATRIX-FILE.
OPEN OUTPUT SORTED-FILE.
SORT FILE-SORT ON ASCENDING KEY
CC-1
SA-NOS
300
-------
INPUT PROCEDURE READ-SORT-I NPUT
THRU READ-SQRT-1NPUT-ENO
OUTPUT PRUCEDURE WR1 TE-SORT-OUTPUT
THRU WRiTE-SDRT-OUTPUT-END.
REPORT-PART-B .
PERFORM TOP-NEW-PAGE .
PERFORM WRITE-PAGE-HEAOING.
PERFORM WRITE-SUB-TITLE-B.
PERFORM ZERO-SUB-TOTALS.
PERFORM ZERO-TOTALS.
PERFORM REWIND-FlLE-
PERFORM WRITE-CGST-CENTER THRU COST-CENTER-END VARYING J FROM
i BY 1 UNTIL J GREATER THAN 4.
PERFORM WRITE-OP-COSTS.
PERFORM WRITE-INTEREST.
PERFORM WRITE-TAXES.
PERFORM WRITE-LAST-LINE .
PERFORM TUP-NEW-PAGE.
PERFORM WRITE-CCUNTERS.
GO TO CLOSE-FILES.
END OF PROGRAM.
*****
*
* SUBROUTINES FOLLOW,
* 1 . GENERAL SUBROUTINES
* 2. ROUTINES FOR PART-A
* 3. ROUTINES FUR PART-B
$****
*
* GENERAL SUBROUTINES
*
#*?**
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-LINE-OUT.
WRITE PRINT-DATA BEFORE 1.
ADD 1 TO LINE-CT.
SKIP-LINE .
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-OUT.
PAGE-OVFLDW.
IF LINE-CT NOT < MAX-LINE THEN
PERFORM TOP-NEW-PAGE
MOVE SUB-T2 TO SUB-OUT, SUBS-OUT
301
-------
PERFORM WRITE-PAGE-HEAD1NG
IF kPT-A THEN PERFORM WRITE-SuB-TITLE-A
ELSE PERFORM WR ! T E-SUB-T I T|_E-B .
ZERO-SUB-TOTALS.
MCVE ZEROS TO S-TOT-1, S-TOT-2, S-TOT-3, S-TOT- 900 THEN
SUBTRACT 900 FROM YEAR-OUT.
ADD 1900 YEAR-OUT GIVING CURR-YR
ADD 1899 YEAR-OUT GIVING PREV-YR
IF
IF
IF
IF
IF
EN MOVE
EN MOVE
EN MOVE
4 WKS)
5 WKS)
13 WKS)
26 WKS)
52 WKS)
•QUARTER '
•HALF YR '
•ANNUAL '
' TD WKS-OUT
• TO WKS-OUT
' TD WKS-OUT
• TO WKS-UUT
• TO WKS-OUT
1 BY 1 UNTIL I GREATER
•078' TD YEAR-IN.
302
-------
FIND-MONTH.
IF MO-IN EQUAL MO-NAME (I) MOVE I TO MONTH.
WRITE-DATA-LINE-A.
MOVE UATA-LINE-A TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
URITE-DATA-LINE-B.
MOVE DATA-L1NE-B TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
VARI-AND-PERCENT .
MOVE SPACES TO NEG-OUT, NEGS-OUT.
IF RPT-B AND TEMP-2 = 0 THEN MOVE 0 TO TEMP-1.
SUBTRACT TEMP-1 FROM TEMP-2 GIVING TEMP-3.
MOVE TEMP-3 TO COL-5A, COL-5B.
MULTIPLY 100 BY TEMP-1.
IF TEMP-2 > 0 DIVIDE TEMP-2 INTO TEMP-1 FL5E
MOVE ZERO TO TEMP-1.
IF TEMP-1 > 100 MOVE NEGS-1N TO NEG-OUT, NcGS-OUT
ADD ,C^5 TO TEMP-1.
MOVE TEMP-1 TO COL-6A, COL-6B.
Xf
* SUBROUTINES FOR PART-A
WRITE-SU6-TITLE-A.
MOVE HEADING-^ TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM SKIP-LINE.
MOVE HEADING-5 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
MOVE HEADING-6 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
MOVE HEADING-7 TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM SKIP-LINE.
NEW-BUO&ET-CAT.
IF I EQUAL 7 THEN
MOVE '0' TO PRINT-REQ-FLAG
MOVE SPACES TO BUD-ACCT
PERFORM REWIND-FILE.
PERFORM PAGE-OVFLOW.
MOVE NAME (I) TO NAME-OUT.
PERFORM SKIP-LINE.
MOVE BUDGET-CAT TO PRINT-LINE.
PERFORM PRINT-LINE-OUT.
READ-SOSTED-FILE .
READ SORTED-FILE AT END GO TO RE AD-F I LE-C DMPLE TE
IF AMT-<» > 0 THEN MOVE FA-NO TO BUD-ACCT.
IF 1 = 7 THEN GO TO STEP-TWO.
IF FA-NO-1 < LO-LIM (I) GO TO RE AD-S ORTE D -F I LE .
303
-------
IF FA-NO EQUAL BUD-ACCT THEM GO TO NEXT-STEP.
IF AMT-<* = 0 THEN GO TO TEST-ACC T-L IMIT.
GD TO NtXT-STEP.
STEP-TWO.
MOVE 'O1 TO INT-FLAG.
PERFORM DEPREC-INT-TAXES THRU TAXES-END.
IF FLAG-YES THEN GO TO TEST-ACCT-LIMIT .
IF FA-NO EQUAL BUD-ACCT THEN GO TO READ- SOP FED-F 1LE .
IF AMT-4 > 0 GO TO REAU-SORTED-FILE .
IF AMT-5 > 0 GO TO READ-SOKTED-FILE .
IF AMT-3 =0 GO TO REAO-SORTED-FILE .
MOVE ZERO TO COL-3A, COL-4A, COL-5A, COL-6A.
MOVE SPACES TO NEG-QUT.
NEXT-STEP.
IF FLAG-O THEN
MOVE FA-NO TO FA-NOMINAL, ACCT-NO
READ FINANCIAL-ACCT-TABFI INVALID KEY
MOVE SPACES TO ACCT-NAME
IF FLAG-2 THEN
READ FINANCIAL-ACCT-TABFI INVALID KEY
MOVE SPACES TO ACCT-NAME
IF FLAG-O OR FLAG-2 THEN
MOVE FA-NAME-1 TO ACCT-NAME
MOVE HEAD-STRIP-1A TO HEAD-STRIP-OUT.
IF FA-NO NOT EQUAL FA-NOMINAL GL TO WRITE-DATA-LINE .
ADD AMT-1 TO S-TDT-1.
ADD AMT-3 TO S-TOT-2.
ADD AMT-5 TO S-TOT-3.
ADD AMT-4 TO S-TOT-4.
MOVC '!• TD PRINT-REQ-FLAG.
GO TO READ-SORTED-FILE.
WRITE-DATA-LINE.
IF I ^ 7 THEN
MOVE S-TOT-1 TO COL-1A
MOVE S-TOT-2 TO COL-2A
ADO S-TOT-1 TO TQT-1
ADD S-TOT-2 TO TOT-2
ELSE PERFORM ADD-SUB-TO-TDTALS.
PERFORM WRITE-DATA-LINE-A.
PERFORM PAGE-OVFLOW.
ADD S-TOT-5 TO TOT-5.
MOVE AMT-1 TO S-TOT-1.
MOVE AMT-3 TO S-TOT-2.
MOVE AMT-5 TO S-TCJT-3.
MOVc AMT-^t TO S-TQT-4.
MGVt '2' TO PRINT-REQ-FLAG.
MOVE FA-NO TO FA-NOMINALt ACCT-NO.
TEST-ACCT-LIMIT.
IF FA-NO-1 NOT GREATER THAN HI-LIM (I)
GO TO READ-SORTED-FILE.
304
-------
IF FLAG-I THFN PERFORM AOD-SUB-TO-TOTALS
PERFORM WRITE-DATA-LINE-A
PERFORM PAGE-nVFLOK
MOVE ZEROS TO S-TOT-1, S-TOT-2, S-TOT-3,
S-TOT-<«. S-TOT-5, S-TOT-6
MOVE '0' TO PRINT-REU-FLAG.
GO TO TEST-ACCT-LIMIT-END.
READ-FILE-COMPLETE.
IF FLAG-2 THEN
READ FINANC1AL-ACCT-TABF I INVALID KEY
MOVE SPACES TO ACCT-NAME.
IF FLAG-2 THEN
MOVE FA-NAME-1 TO ACCT-NAME
MOVE HEAD-STRIP-1A TO HEAD-STRIP-OUT.
IF FLAG-0 THEN GO TO TEST-ACCT-LIMIT-tNO.
IF I - 7 THEN
MOVE S-TOT-1 TO COL-1A
MOVE S-TOT-2 TO CDL-2A
ADD S-TOT-1 TO TOT-1
ADD 5-TOT-2 TO TQT-2
ELSE PERFORM ADO-SUB-TO-TOTALS.
PERFORM WRITE-DATA-LINE-A.
MOVE SPACES TO FA-NOMINAL.
TEST-ACCT-LIMIT-END.
IF I = 6 PERFORM WRITE-TOTALS .
WRITE-TOTALS.
PERFORM SKIP-LINE.
MOVE NAME (8) TO NAME-8.
IF I = 6 THEN DIVIDE 12 INTO TOT-4 GIVING TOT-3,
MULTIPLY TOT-3 BY MONTH GIVING TOT-3.
IF I GREATER THAN 6 MOVE 'TOTAL1 TO NAME-8.
MOVE HEAD-STRIP-2A TO HEAD-STR IP-OUT .
MOVE TOT-1 TO COL-1A.
MOVE TOT-2 TO COL-2A, TEMP-1 .
MOVE TOT-3 TO COL-3A, TEMP-2.
MOVE TOT-4 TO COL-4A.
PERFORM VARI-AND-PERCENT.
PERFORM WRITE-DATA-LINE-A.
ADD-SUB-TO-TOTALS.
MULTIPLY MONTH BY S-TQT-4 GIVING TEMP-3.
DIVIDE 12 INTO TEMP-3.
ADD .005 TO TEMP-3.
MOVE TEMP-3 TO S-TOT-3.
ADD S-TOT-1 TO TOT-1.
ADD S-TOT-2 TO TOT-2.
ADD S-TOT-3 TO TOT-3.
ADO S-TOT-4 TO TOT-4.
IF ACCT-NO EQUAL '932-50 ' THEN
COMPUTE P-ERROR = (MONTH * TOT-4 / 12) - TOT-3
ADD P-ERROR TO S-TOT-3.
305
-------
IF MONTH EQUAL 12 THEN MOVE S-TOT-4 TU 5-TOT-3
MGVc S-TOT-1 TO COL-1A.
MOVE S-TOT-2 TO COL-2A, TEMP-1.
MOVE S-TOT-3 TO COL-3A. TEMP-2.
MOVE S-TOT-4 TO CQL-4A.
PERFORM VAR1-AND-PERCENT.
DEPREC-INT-TAXE5.
IF CC-NO-1 EQUAL '5» THEN
ADD AMT-1 TO INT-C
ADD AMT-3 TO INT-P
MOVE '!' TO INT-FLAG
GO TO TAXES-END.
IF CC-NO-1 EQUAL '6' THEN
ADD AMT-1 TO TAX-C
ADD AMT-3 TO TAX-P
MOVE 'I1 TO INT-FLAG
GO TO TAXES-END.
IF SA-NO EQUAL '10' THEN
ADD AMT-1 TO DEPRE-C
MOVE •!' TO INT-FLAG.
TAXES-END.
EXI T.
WRITE-DEPREC-INT-TAXES.
MOVE SPACES TO NEG-OUT.
PERFORM SKIP-LINE.
MOVE CAT-NAME (10) TO NAME-8.
MOVE HEAD-STRIP-2A TO HEAD-STRIP-OUT.
MULTIPLY MONTH BY DEPRE-C GIVING DEPRE-P.
MOVE DEPRE-C TO COL-1A.
MOVE DEPRE-P TO COL-2A.
MOVE ZEROS TO COL-3A, COL-4A. CDL-5A, COL-6A.
PERFORM HRITE-DATA-LINE-A.
PERFORM PAGE-OVFLOW.
ADD OEPRE-C TO TOT-1.
ADD DEPRE-P TO TOT-2.
MOVE TOT-2 TO TOT-T3
PERFORM WRITE-TOTALS.
MOVE SPACES TO NEG-OUT.
MOVE CC-NAME (5) TO NAME-8.
MOVE HEAD-STRIP-2A TO HEAD-STRIP-OUT.
MOVE INT-C TO COL-1A.
MOVE INT-P TO COL-2A.
MOVE ZEROS TO COL-3A, COL-4A, COL-5A. COL-6A.
PERFORM WRITE-DATA-LINE-A.
ADD INT-C TO TOT-1.
ADD INT-P TO TOT-2.
MOVE CC-NAME (6) TO NAME-8.
MOVE HEAD-STRIP-2A TO HEAD-STRIP-OUT.
MOVE TAX-C TO COL-1A.
MOVE TAX-P TD COL-2A.
306
-------
PERFORM WRITE-DATA-LINE-A
ADD TAX-C TD TOT-1.
ADO TAX-P TC TOT-2.
SUBROUTINES FDR PART-B
KRITE-SUB-TITLE-B .
MOVE HEADING'S TD PRlNT-LINt.
PERFORM PRINT-LINE-OUT.
PERFORM SKIP-LINE.
MOVE HEAD1N&-9 TD PRINT-LINE.
PERFORM PRINT-LINE-OUT.
MOVE HEADING-ID TD PRINT-LINE.
PERFORM PRINT-L1NE-UUT.
MOVE HEADING-11 TG PRINT-LINE.
PERFORM PRINT-LINE-OUT.
PERFORM SKIP-LINE 2 TIMES.
WRITE-COST-CFNTER .
PERFORM PAGE-OVFLOW.
MUVE CC-NAME (J) TO CC-OUT, CC-GUTS.
MOVE DATA-LINE-D TD PRINT-LINE.
PERFORM PRINT-L1NE-DUT .
IF J < 5 MOVE 'PAYROLL COSTS: ' TD C-CAT-SUB,
MOVE DATA-LINE-E TO PRINT-LINE,
PERFORM PRINT-LINE-OUT.
PERFORM OOU6LE-SDRTED-FILE THRU 0 A TA -L I NE-EX 1 T VARYING K
FROM 1 BY 1 UNTIL K GREATER THAN 10.
PERFORM SKIP-LINE 3 TIMES.
COST-CENTER-END.
EXI F.
DOUBLE-SORTED-FILE.
MOVt '0' TD PRINT-REO-FLAG.
READ-DS-FILE .
READ SORTED-FILE AT END GU TO DS-'F I LE-COMPLE TE .
MULTIPLY MONTH BY AMT-6.
DIVIDE AMT-t. BY 12 GIVING AMT-6.
IF FLAG-YES THEN PERFORM I NT -ANU-TAX ES .
IF FLAG-0 THEN
MOVE CAT-NAME (K) TO C-CAT-OUT
MGVE HEAD-STRIP-IB TO HEAD-OUT.
MCVt CC-ND-1 TD CC-J.
MOVE SA-NO TO SA-K.
IF CC-J NOT EQUAL J OR SA-K NOT EQUAL K THEN
GO TO WRITE-DATA-LINES.
MOVE 'I1 TD PRINT-REO-FLAG.
ADD AMT-3 TO S-TOT-1.
ADD AMT-6 TU S-TDT-2.
GO TO REAU-DS-FILE .
307
-------
WRITE-DATA-LINES.
AOD S-TUT-1 TO TOT-1. TGT-3, TEMP-1.
ADD S-TDT-2 TO TOT-2. TOT-4, TEMP-2.
MOVE S-TDT-1 TD COL-IB.
MOVE S-TOT-2 TO COL-2B.
PERFORM VARI-AND-PERCENT.
MOVE AMT-3 TO S-TOT-1.
MOVE AMT-6 TO S-TGT-2.
IF K EQUAL 6 AND J LESS THAN 5 THEN
MOVfc 'OTHER DIRECT COSTS: ' TO C-CAT-SUB
MOVE DATA-LINE-E TO PRINT-LINE
PERFORM PRINT-LINE-OUT .
PERFORM WRITE-DATA-LINE-B.
PERFORM WRITE-CC-TOTALS.
PERFORM PAGE-OVFLOW.
MOVE '0' TO PRINT-REQ-FLA&.
IF K EQUAL 10 AND J EQUAL 4 THEN
MOVE '!' TO INT-FLA&
GO TO READ-DS-FILE.
OATA-LINE-EXIT.
EXIT.
WRITE-CC-TOTALS.
IF K EQUAL 10 AND J LESS THAN 5 THEN
MOVE TOT-3 TO COL-IB; TEMP-1
MOVE TOT-4 TO COL-2B; TtMP-2
MOVE HEAO-STRIP-2B TO HEAD-OUT
PERFORM VARI-AND-PERCENT
PERFORM WRITE-OATA-L1NE-B
MOVE ZEROS TO TOT-3, TOT-4, TOT-5, TOT-6
DS-FILE-COMPLETE.
IF FLAG-1 THEN
ADD S-TOT-1 TO TQT-1, TEMP-1
ADD S-TOT-2 TO TOT-2, TEMP-2
MOVE S-TOT-1 TO COL-IB
MOVE S-TOT-2 TO COL-2B
PERFORM VARI-AND-PERCENT
PERFORM WRITE-DATA-LINE-B
PERFORM WRITE-CC-TOTALS.
&0 TO DATA-LINE-EXIT.
WRITE-OP-COSTS.
MOVt 'OPERATING ' TO CC-OUTS.
MOVE TOT-1 TO COL-IB, TtMP-1.
MOVE TOT-2 TO COL-2B, TEMP-2.
MOVE TOT-1 TO TOT-T5
PERFORM VARI-AND-PERCENT.
MOVE HEAD-STRIP-2B TO HEAD-DUT.
PERFORM URITE-OATA-LINE-B.
INT-AND-TAXES.
IF CC-NO-1 EQUAL '5' THEN
ADD AMT-3 TO INT-C
308
-------
ADD AMT-6 TO INT-P
GO TO READ-DS-FILE.
IF CC-NO-1 EQUAL '6' THEN
ADD AMT-3 TO TAX-C
ADD AMT-6 TO TAX-P.
GO TO READ-US-FILE.
WRITE-INTEREST.
PERFORM SKIP-LINE.
ADD 1NT-C TO TOT-1 .
ADD INT-P TO TOT-2.
MOVE INT-C TO COL-IB, TEMP-1.
MOVE INT-P TO COL-2B, TEMP-2.
PERFORM VARI-AND-PERCENT.
MOVE CC-NAME (5) TO C-CAT-OUT.
MOVE HEAD-STRIP-IB TO HEAD-OUT.
PERFORM WRITE-DATA-LINE-B.
WRITE-TAXES.
ADD TAX-C TO TOT-1.
ADD TAX-P TO TOT-2.
MOVE TAX-C TO COL-IB, TEMP-1.
MOVE TAX-P TO COL-2B, TEMP-2.
PERFORM VARI-AND-PERCENT.
MOVE CC-NAME (6) TO C-CAT-OUT.
MOVE HEAD-STRIP-IB TO HEAD-OUT.
PERFORM WRITE-DATA-LINE-B.
WRITE-LAST-LINE.
PERFORM SKIP-LINE.
MOVE TOT-1 TO COL-IB, TEMP-1.
MOVE TOT-2 TO COL-2B, TEMP-2.
PERFORM VARI-AND-PERCENT.
MOVE 'ALL ITEMS' TO CC-OUTS.
MOVE HEAD-STRIP-2B TO HEAD-OUT.
PERFORM WRITE-DATA-LINE-B.
PERFORM TOP-NEW-PAGE.
IF TOT-T3 NOT EQUAL TOT-T5 GO TO WRITE-ERROR.
IF TOT-T4 NOT EQUAL TOT-1 GO TU WRITE-ERROR.
WRITE-ERROR.
PERFORM WRITE-PAGE-HEADING.
PERFORM SKIP-LINE 5 TIMES.
MOVE 'ERROR — PART-A AND PART-B TOTALS DO NOT MATCH. '
TO PRINT-LINE.
PERFORM PRIM-LINE-OUT.
MOVE ZERO TO CDL-6B.
MOVE TOT-T3 TO COL-IB.
MOVE TOT-T5 TO COL-2B.
SUBTRACT TOT-T5 FROM TOT-T3 GIVING COL-5B.
MOVE 'PART-A, PART-B TOTALS fc ERROR.1 TO C-CAT-OUT.
MOVE HEAD-STRIP-IB TO HEAD-OUT.
PERFORM WRITE-DATA-LINE-B.
MOVE TOT-T4 TO COL-IB.
309
-------
MOVE TDT-1 TO CDL-2B.
SUBTRACT TDT-1 FROM TUT-T4 GIVING COL-5B
PERFORM WRI f E-DATA-L I NE-B .
PERFORM TOP-NEW-PAGE.
PERFORM WRITE-COUNTERS.
GO TO CLOSE-FILES.
FINI
READ-SORT-INPUT.
READ COST-MATRIX-FILE AT END
GG TO READ-SDRT-INPUT-END.
IF CC-Nu EQUAL '4301' OR ^302' OR
OR '4321' OR '4322' OR '4421«
GO TO READ-SORT-INPUT.
IF SA-NU GREATER THAN '12' THEN GO TO READ-SORT-INPUT
RELEASE SORT-INPUT FROM CM-REC .
ADD 1 TO SCT-ONE.
GO TO READ-SORT-INPUT.
READ-SORT-INPUT-END.
EXIT.
WRITE-SORT-OUTPUT.
RETURN FILE-SORT RECORD INTO INPUT-REC
AT END GO TO WR I T E-SORT-CUTPUT-E ND .
WRITE INPUT-REC.
ADD 1 TO SCT-TWO.
GO TO WRITE-SORT-OUTPUT.
WRITE -SORT-OUTPUT -END.
EXIT.
WRITE-COUNTERS.
MOVE 'NUMBER OF ACCOUNTS SORTED' TO HEAD-OUT.
MOVE SCT-ONE TO COL-IB.
MOVE SCT-TWO TO COL-2B.
MOVE OATA-LINE-B TO PRINT-LINE.
MOVE ZEROS TO COL-5B, COL-6B.
PERFORM PRINT-LINE-OUT.
MOVE ZEROS TO SCT-ONE, SCT-TWO.
MOVE ZEROS TO COL-IB. COL-2B. CDL-5B.
CLOSE-FILES.
CLOSE CARO-IN, COST-MATR I X-F I L E ,
FINANCIAL-ACCT-TABFI .
SORTED-FILE, PRINT-OUT.
E-O-J.
STOP RUN.
310
-------
PGMNAME=WUASPLV1
SYSIN DD *
IDENTIFICATION DIVISION.
PROGRAM-ID. WUASPLV1.
AUTHOR. ACT SYSTEMS. INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, FLA 32789.
DATE-hRITTEN. 02/06/78.
REMARKS. THIS PROGRAM READS COST MATRIX FILE
AND BUILDS THE LEVEL 1 REPORT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELcCT CARD-IN
ASSIGN TO UR-25
-------
01 INPUT-CARD.
05 DATE-IN
05 TITLE-IN
05 FILLER
01 NUMBER-CARD.
05 MIL-GALS OCCURS
05 ACTUAL-TO-BUOGET
05 FILLER
PIC
PIC
PIC
X118).
X(24).
X(38 ).
TIMES PIC 9(7>V999.
pIC 9(3)y99.
PIC X(35).
ABOVE MIL-GALS IS AS FOLLOWS
(1) RPW (REVENUE PRODUCING WATER)
(2) TREATED WATER MONTH
(3) RPW YEAR TO DATE
(4) RPW PREVIOUS YEAR.
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
05 FILLER PIC X.
05 PRINT-DATA PIC XU32)
WORKING-STORAGE SECTION.
77 MILLION-GAL
77 PREVIOUS-MILLION-GAL
77 ACCUM-ACROSS
77 SAVt-AMT
77 I
77 PAGE-CTR
77 J
77 K
77 PCT-CTR
77 FIN-PCT
01 HEADING-1.
05 FILLER
05 FILLER
05 FILLER
01 HEADING-2.
05 FILLER
05 DATE-OUT
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 PAGE-NR
01 HEADING-3.
05 FILLER PIC X(53) VALUE
05 TITLE-OUT PIC X(2
ES
ES
ES
*
»
•
'.
»
•
•
' .
INFURMATI
SPACES
SPACES
SPACES
312
-------
01
01 HEADING-**.
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
01 HEADING-5.
05 FILLER
05 FILLER
05 FILLER
01 HEAUING-6.
05 FILLER
FILLER
FILLER
FILLER
FILLER
01 DATA-LINE.
05 FILLER
05 DESCRIPTION
FILLER
POSIT OCCURS
10 AMTS
10 FILLER
FILLER
PCT-LINE .
05 FILLER
05 DESCRIPTIONI
FILLER
PERCENT
FILLER
01 MATRIX.
05 FUNCTIONS OCCURS
10 SUB-FUNCTIONS
15 ACCT
01 TITLE-1.
05 TITLE-ONE.
10 FILLER
FILLER
FILLER
FILLER
FILLER
TITLE-TWO
10 TITLE OCCURS
01 TITLE-1-A.
05 TITLE-ONE-A.
10 FILLER
10 FILLER
10 FILLER
10 FILLER
10 FILLER
PIC
PIC
PIC
PIC
PIC
X (26)
X (26)
X (26)
X(26)
X (26)
VALUE
VALUE
VALUE
VALUE
VALUE
1
1
•MENT
•RT
i
CATEGORY
ACQUISITION
DELIVERY
INTEREST
TAXES T
TREAT '
SUPPO'
TOTAL'
OTAL '
PIC X(60)
PIC X(12)
PIC X160I
VALUE
VALUE
VALUE
SPACES .
M LEVEL
SPACES.
I )
05
05
05
05
05
05
05
05
05
05
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
8 T
PIC
PIC
PIC
PIC
PIC
PIC
PIC
X{26) VALUE '
X(26) VALUE '
X(26) VALUE '
X(26) VALUE '<•<•
X(26) VALUE '
X(10) VALUE SPACES.
X(20) VALUE SPACES.
X(3) VALUE SPACES.
IMES.
-(8).--.
PIC X.
XXX VALUE SPACES.
X(10) VALUE SPACES.
X(20) VALUE SPACES.
X(3) VALUE SPACES.
-(8) OCCURS 8
XXX VALUE SPACES.
a* <•
<><•<>
Ot>»OC>»4
TIMES
6 TIMES.
OCCURS 5 TIMES.
PIC SSM8JV99.
10
10
10
10
05
PIC
PIC
PIC
PIC
PIC
REDE
X
X
X
X
X
F
(20)
(20)
(20)
(20)
(20)
INES
VALUE
VALUE
VALUE
VALUE
VALUE
TITLE
'CURRENT
•PREVIOUS
•CURRENT
•CURRENT
'PREVIOUS
-ONE .
PE
P
Pt
YE
Y
RIOD
ERIGD
RIOD
AR (Y
EAR (
T
Y
i
i
i
D) '
TO) '
5 TIMES PIC X(20)
P
P
P
P
P
I
I
I
I
I
C
C
C
C
C
X(
X(
X(
X(
X(
20)
20)
20)
20)
20)
VALUE
VALUE
VALUE
VALUE
VALUE
'UNIT COST WMG
•UNIT COST WMG
'PREVIOUS YEAR */MG
'UNIT COST S/MG
'UNIT COST S/MG
313
-------
05 TITLE-TWO-A REDEFINES TITLE-ONE-A.
10 T1TLE-A OCCURS 5 TIMES PIC X(20).
01 TITLE-3.
05 TITLE-THREE.
10 FILLER PIC X(20) VALUE 'CURRENT PERIOD '
19 FILLER PIC X(20> VALUE 'YEAR TO DATE '
05 TITLE-FOUR REDEFINES TITLE-THREE.
10 TITLE-B OCCURS 2 TIMES PIC X(20).
01 TITLE-3-A.
05 TITLE-THREt-A.
10 FILLER PIC X(20) VALUE 'TOTAL COST '
10 FILLER PIC X(20) VALUE 'TOTAL COST '
05 TITLE-FOUR-A REDEFINES TITLE'THREE-A.
10 T1TLE-X OCCURS 2 TIMES PK X<20).
01 TITLE-5.
05 TITLE-FIVE.
10 FILLER PIC X(20) VALUE ' % OF TOTAL '
10 FILLER PIC X(20) VALUE '* OF PREVIOUS '
05 TITLE-SIX REDEFINES TITLE-FIVE.
10 TITLE-C OCCURS 2 TIMES PIC X(20).
01 TITLE-5-A.
05 TITLE-FIVE-A.
10 FILLER PIC X(20) VALUE 'YEAR TO DATE '
10 FILLER PIC X(20) VALUt 'TUTAL (YTD) '
05 TITLE-SIX-A REDEFINES TITLE-FIVE-A.
10 TITLE-D OCCURS 2 TIMES PIC X(20).
PROCEDURE DIVISION.
OPEN-FILES.
DREW INPUT CARD-IN, COST-MATRIX-FILE
OUTPUT PRINT-OUT.
HOUSEKEEPING.
MOVE ZEROS TO MATRIX, PCT-CTR.
READ-TITLE-CARD.
READ CARD-IN, AT END GO TO END-OF-JOB.
MOVE DATE-IN TO DATE-GUT.
MOVE TITLE-IN TO TITLE-OUT.
READ-PREVIOUS-DIVISDR-CARD.
READ CARD-IN AT END GO TO END-OF-JOB.
EXAMINE NUMBER-CARD REPLACING ALL ' > BY 'O1.
MOVE MIL-GALS (1) TO PREV IOUS-MlLLION-GAL .
PEAD-DIVISOR-CARD.
READ CARD-IN, AT END GO TO END-DF-JOB.
EXAMINE NUMBER-CARD REPLACING ALL ' ' BY '0'.
MOVE MIL-GALS (1) TO MILLION-GAL.
WRITE-HEADING5.
ADD 1 TO PAGE-CTR.
PERFORM MOVE-SPACES.
MOVE PAGE-CTR TO PAGE-NR.
WRITE PRINT-LINE BEFORE ADVANCING NEW-PAGE.
MOVE HEADlNG-1 TO PRINT-DATA.
314
-------
PERFORM PRINT-LINE-OUT.
MOVE HEAD1NG-2 TO PRINT-DATA.
PERFORM PRIiNT-LINE-OUT.
MOVE HEAD1N&-3 TO PRINT-DATA.
PERFORM PRINT-LINE-DUT.
MOVE HEADING-5 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR 1 NT-LINE-OUT.
PERFORM PRINT-LINE-DUT.
MOVE HEADING-^ TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MCVE HEADING-6 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM SKIP-LINE 2 TIMES.
PROCESS-MATRIX.
READ COST-MATRIX-FILE AT END GO TO PROCESS-TIME.
IF (COST-CAT < 1 OR > 12) OR (PQS1 < 1 UR > M THEN
GO TO PROCESS-MATRIX.
ADD FIGS (1) TO ACCT (POS1, 1 ) .
ADD FIGS (2) TO ACCT IPOS1, 2) .
ADD FIGS (3) TO ACCT (POS1, <*) .
ADD FIGS (6) TO ACCT (POS1, 3).
ADD FIGS (6) TO ACCT (PQS1, 5).
GO TO PROCESS-MATRIX.
PROCESS-TIME .
PERFORM MOVE-AMOUNTS VARYING J FROM 1 BY 1 UNTIL J > 5.
MOVE 1 TO J K.
PERFORM MOVE-AMOUNTS-1 2 TIMES.
PERFORM GET-PERCENTAGES.
GO TO END-OF-JOB.
MOVE-AMOUNTS.
IF J = 2 THEN
MOVE PREVIOUS-MILLION-GAL TL MILLION-GAL.
IF J = <+ THEN
MOVE MIL-GALS (3) TO MILLION-GAL.
PERFORM MOVE-AMOUNTS-A VARYING i FROM i BY i JNTIL I > 5.
MOVE ACCUM-ACKOSS TO AMTS OF POSIT (6).
DIVIDE ACCT (6, J) BY MILLION-GAL GIVING AKT.S OF POSIT (7)
DIVIDE ACCT (6, J) BY MILLION-GAL GIVING SAVE-AMT.
AUD ACCUM-ACROSS, SAVE-AMT GIVING AMTS OF POSIT (8).
MOVE TITLE (J) TO DESCRIPTION.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE SPACES TU DATA-LINE.
MOVE TITLE-A (J) TO DESCRIPTION.
MOVE tJATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR I NT-LINE-OUT.
MOVE SPACES TO DATA-LINE.
MLVE ZEROS TO ACCUM-ACROSS.
315
-------
MOVE-AMOUNTS-l.
PERFORM MQVE-AMDUNTS-B VARYING I FROM 1 BY 1 UNTIL I > 5.
MOVE ACCUM-ACRD5S TU AMTS OF POSIT (6).
MOVE ACCT (6, J) TO AMTS OF POSIT (7).
ADD ACCT (6, J), ACCUM-ACROSS GIVING AMTS OF POSH (8).
MOVE TITLE-B (K) TO DESCRIPTION.
PERFORM DATA-LINE-OUT.
MOVE SPACES TO DATA-LINE.
MOVE TITLE-X (K.) TO DESCRIPTION.
PERFORM DATA-LINE-OUT THRU PR I NT-LINE-OUT.
MOVE ZEROS TO ACCUM-ACROSS.
MOVE SPACES TO DATA-LINE.
ADD 1 TC K.
ADD 3 TO J.
MOVE-AMOUNTS-A.
DIVIDE ACCT (I, J) BY MILLION-GAL GIVING AMTS OF POSIT (j)
DIVIDE ACCT (I, J) BY MILLION-GAL GIVING SAVE-AMT.
ADD SAVE-AMT TO ACCUM-ACROSS.
MOVE-AMOUNTS-B.
MOVE ACCT (I, J) TO AMTS OF POSIT (I).
ADD ACCT (I, J) TO ACCUM-ACROSS.
GET-PERCENTAGES.
PERFORM MOVE-SPACES THRU PR1NT-LINE-OUT .
MOVE 'BUDGET VARIANCE • TO DESCRIPTION.
MOVE ACTUAL-TO-BUDGET TO AMTS OF POSIT (8).
PERFORM DATA-LINE-OUT.
MOVE SPACES TO DATA-LINE.
MOVE 'YEAR TO DATE ' TO DESCRIPTION.
PERFORM DATA-LINE-DUT THRU PR INT-LINE-OUT.
MOVE 'TREATED WATER ' TO DESCRIPTION.
MOVE MIL-GALS (2) TO AMTS OF POSIT (8).
PERFORM DATA-LINE-OUT.
MOVE SPACES TO DATA-LINE.
MOVE 'CURRENT PERIOD ' TO DESCRIPTION.
PERFORM DATA-LINE-OUT THRU PR INT-LINE-OUT .
MOVE 'REVENUE PRODUCING • TG DESCRIPTION.
MOVE MIL-GALS (1) TO AMTS OF POSIT (8).
PERFORM DATA-LINE-OUT.
MOVE SPACES TG DATA-LINE.
MOVE 'WATER CURRENT PERIOD1 TO DESCRIPTION.
PERFORM DATA-LINE-OUT THRU PR I NT-LINE-OUT .
MOVE 'REVENUE PRODUCING ' TO DESCRIPTION.
MOVE MIL-GALS (3) TO AMTS OF POSIT (8).
PERFORM DATA-LINE-OUT.
MOVc SPACES TO DATA-LINE.
MOVE 'WATER (YTD) ' ' TU DESCRIPTION.
PERFORM DATA-LINE-OUT THRU PRINT-LINE-OUT.
MOVE 'REVENUE PRODUCING ' TG DESCRIPTION.
MOVE MIL-GALS (4) TO AMTS OF POSIT (8).
PERFORM DATA-LINE-OUT.
316
-------
MOVE SPACES TO DATA-LINE.
MOVE 'WATER PREVIOUS YTD ' TO DESCRIPTION.
PERFORM DATA-LINE-OUT THRU PRINT-LINE-OUT.
MOVE 1 TO K .
MOVE 4 TO J.
PERFORM PERCENT-ROUTINE 2 TIMES.
PERCENT-ROUTINE.
MOVE ZEROS TO PCT-CTR.
PERFORM FIND-PERCENT VARYING I FROM 1 BY 1 UNTIL I > &.
ADD ACCT (6, J) TO ACCUM-ACROSS.
PERFORM FIND-PERCENT-A VARYING 1 FROM 1 BY 1 UNTIL 1 > 5-
IF ACCUM-ACROSS > 0 THEN DIVIDE ACCT (6, J) BY ACCUM-ACROSS
GIVING PCT-CTR ROUNDED ELSE MOVE ZEROS TCI PCT-CTR.
MULTIPLY PCT-CTR BY 100 GIVING PERCENT (7).
IF ACCUM-ACkOSS > 0 THEN
MOVE 100 TO PERCENT (8).
MOVt TITLE-C (K) TO DESCR IPTI ONI.
MOVE PCT-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE SPACES TO PCT-LINE.
MOVE TITLE-D (K) TO DESCR I PT IDN1 .
MOVE PCT-LliNE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR 1NT-LINE-OUT.
ADD 1 TO J K.
FIND-PERCENT.
ADD ACCT (I, J) TU ACCUM-ACROSS.
FINO-PERCENT-A.
IF ACCUM-ACROSS > 0 THEN DIVIDE ACCT (I, J) BY ACCUM-ACROSS
GIVING PCT-CTR ROUNDED ELSE MOVE ZEROS TO PCT-CTR.
MULTIPLY PCT-CTR BY 100 GIVING PERCENT (I).
DATA-LINE-OUT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE-SPACES.
MOVE SPACES TO PRINT-DATA.
PRINT-LINE-OUT.
WRITE PRINT-LINE BEFORE ADVANCING 1.
SKIP-LINE .
PERFORM MOVE-SPACES THRU PR 1 NT-LINE-OUT .
END-OF-JOB.
CLOSE CARD-IN, COST-MATRIX-FILE
PRINT-OUT.
STOP RUN.
317
-------
PGMNAME=WUASPWAR
S Y 5 KM 00 *
ID DIVISION.
PROGRAM-lL). WUASPWAR.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 M MORSE BLVD
WINTER PARK, FL 32769.
DATE-WRITTEN. JAN 1978.
DATE-COMPILED.
REMARKS. THIS PROGRAM READS THE COST MATRIX FILF
AND PRINTS THE WATER UTILITY REPORT
CALLED 'WATER SUPPLY DATA ANALYSIS REPORT'
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CARD1N
ACCESS MODE IS SEQUENTIAL.
SELECT COST-MATRIX-FILE
ASSIGN TO DA-3330-I-CMF1LE
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CM-NUMBER.
SELECT FILE-SORT
ASSIGN TO UT-3330-S-FILESORT
ACCESS MODE IS SEQUENTIAL.
SELECT SORTED-FILE
ASSIGN TO UT-3330-S-SORTEDFI
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS DATE-CARD.
01 DATE-CARD.
05
05
05
05
DATE-IN.
10 MO-IN
10 DAY-YR
TITLE-IN
FILLER
F1SCAL-YR
PIC X ( 3 ) .
PIC X( 15) .
PIC X(24) .
PIC X( 8)
PIC X(24
318
-------
05 FILLER
05 NG-UKS
05 RPT-PERIQD
01 WATER-CARD.
05 WU-NAME
05 SYSTEM
05 SERIES
05 PARALLEL
05 SER-PAR
05 WATtR-SULD PIC S9(7)V999-
05 ZQNF-WAThR.
10 MIL-GAL OCCURS 6 TIMES PIC S9(7)V999
FD COST-MATRIX-FILE
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 5 RECORDS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CM-REC.
01 CM-REC.
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
X(4
X.
X.
XX.
99.
99.
99.
99.
S9(
05
05
05
MATCH-NU
CM-NUMBER .
10 FA-NU
10 CC-NU
10 SA-NU
AMT-S
PIC X (4 ) .
PIC X(10) .
PIC X<4) .
PIC XX.
PIC S9(8)V99
OCCURS b TIMES
*** **
THE ABOVE AMOUNTS ARE AS FOLLOWS
(1) -- CURRENT COST AMOUNT
(2) — PREVIOUS MONTH COST AMOUNT
(3) — CURRENT COST AMOUNT YEAR Tb
(4) — BUDGET AMOUNT
(5) — BUDGET AMOUNT YEAR
(6) -- PREVIOUS YEAR COST
*
*
*
*****
SD FILt-SORT
RECCJRD CONTAINS 80 CHARACTERS
DATA RECORD IS SORT-INPUT.
01 SORT-INPUT.
05
05
DATE (YTD)
TLJ DATE (YTD)
AMOUNT (PYC)
FILLER DIC X(4) .
FIRST-ID PIC X(10)
05 CC-NOS PIC X(4).
05 5A-NOS PIC XX.
05 FILLER PIC X(60) .
FD SORTEO-FILE
BLOCK CONTAINS 5 RECORDS
RECORD CONTAINS 80 CHARACTERS
LABfcL RECORDS ARE STANDARD
DATA RECORD IS INPUT-REC.
01 INPUT-REC.
05 MATCH-NO PIC X(4).
05 FA-NO.
319
-------
10 FA-NO-1
10 FA-NO-2
05 CC-ND.
10 CC-NO-1
10 CC-NO-2
10 CC-NO-3
10 CC-NO-4
05 5A-ND
05 AMIS.
10 AMT-1
10 AMT-2
10 AMT-3
10 AMT-4
10 AMT-5
10 AMT-6
FD PRINT-OUT
RECORD CONTAINS
LABEL RECURDS AR
DATA RECORD IS P
01 PRINT-DATA.
05 FILLER
05 PRINT-LIME
WORKING-STORAGE SECT
77 LINE-CT
77 PAGE-CT
77 MAX-LINE
77 I
77 J
77 K
77 L
77 N
77 ZUNES
77 DOLi
77 TEMP-1
77 TEMP-2
77 RPT-FLAG
88 RPT-A
88 RPT-B
01 COST-CENTERS.
05 CC-LIST.
10 CC-LIST-
P1C
PIC
X 12)
X(8)
PIC X.
PIC X.
PIC X.
PIC X.
PIC XX
PIC
PIC
PIC
PIC
PIC
PIC
59(8)V99.
59(8)V99.
S9(8)V99.
S9(8 )V99.
S9(8)V99.
59(8 } V99.
133 CHARACTERS
F OMITTED
RINT-UATA.
T
P
P
P
I
P
P
P
P
P
P
P
P
P
I
I
I
PI
PI
C
C
X.
X (132) .
ON.
I
I
I
I
I
I
I
I
I
C
c
C
c
c
c
c
c
c
c
c
c
9(
9{
99
99
99
99
99
99
99
S9(
S9(
S9(
P
4
4
) COM
P
) COUP
COMP
COM
COM
P
P
CDMP
COM
COM
P
P
COMP
8
8
8
I
)V99
JV999
)V999
C X
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VA
G.
1.
57.
0
0
u.
•
.
u .
1 .
1 .
LUE +0.
VALUE +0.
VALUE +0.
VA
VA
LUE '
LUE '
VALUE '
1
1
2
1
1
1
•
•
•
PIC X(12U) VALUE
10 CC-LI5T-2
PIC X(120) VALUE
'ACQUISITION
•TREATMENT
' TRANSMISSION
' DISTRIBUTION
' STORAGE
PUMPING
•SUPPORT SERVICES
' INTEREST
320
-------
1 TAxEb
1 TOTAL
1 DELIVERY
05 CC-NAHES REDEFINES CC-L1ST.
10 CC-NAME OCCURS 12 TIMES PIC X(20).
01 MATR IX .
05 FUNCTIONS OCCURS 10 TIMES.
10 SUB-FUNCTIONS OCCURS 7 TIMES.
15 POSIT PIC S9(8)V99.
01 SUB-SUB-TOTAL.
05 SS-TOT PR S9(8)V99
01 SUB-TOTAL.
05 S-TOT PIC S9(6)V99
01 COL-TOTAL.
05 C-TUT PIC 69(fe)V99
OCCURS 7 TIKES .
UCCUkS 7 TIMES .
OCCURS 7 TIMES .
*
*
*****
01
01
01
H
0
0
0
H
0
0
0
0
0
0
0
EAO
5
5
5
EAD
5
5
5
5
5
5
5
HEAD
0
0
0
0
5
5
5
5
05
01
0
H
5
EAD
05
01
0
0
5
5
HEAD
0
0
0
0
0
5
5
5
5
5
I
F
F
F
I
F
D
F
F
F
F
NG-
I
I
I
LL
LL
LL
NG-
I
A
I
I
I
I
LL
TE
LL
LL
LL
LL
H
1
E
E
E
2
E
EADI
*
R
R
R
.
R
-OU
E
E
E
E
PAGE-
I
F
R
NG-
I
P
WK
F
T
F
I
F
F
F
I
F
F
F
F
F
I
1
1
LL
T-
3
E
P
R
R
R
R
T
OUT
.
R
D
S-OUT
LL
TL
LL
NG-
I
I
I
LL
SC
LL
NG-
I
I
I
1
I
LL
LL
LL
LL
LL
E
E
E
6
E
-
E
4
E
E
E
E
E
R
-OUT
R
.
R
YR
R
.
R
R
R
R
R
PIC
P
P
P
P
P
P
P
P
P
P
1
I
I
I
I
I
1
I
I
I
C
C
C
C
C
C
C
C
C
C
X (56
X(20
X (56
X 12
X
X
X
X
X
z
18
34
3)
55
6)
4)
)
)
)
)
)
)
)
„
VALUE
VALUE
VALUE
VALUE
•
VALUE
VALUE
VALUE
VALUE
SPAC
'
COS
SPAC
»
5
«
LAS
PAC
FOR
SPAC
i
PAG
F
T
E
T
E
i
E
E
S.
ANALYb
S.
ENTRY:
S.
.
S.
• 1
• •
IS
i
REPORT '
PIC X(12) VALUE 'RPT PERIUO: '
PIC X(8 ) .
PIC X(8 ) .
PIC X(26) VALUE SPACES.
PIC X(24) .
PIC X(54) VALUE SPACES.
PI
PI
X (9
PI
PI
PI
PI
PI
C
C
6
C
C
C
C
C
X
X
X
X
X
X
X
(12)
(24) .
(20)
(1
(1
(1
(1
2)
4)
4)
4)
•VALU
VALU
VALU
VALU
VALU
VALU
E
E
E
E
E
E
'Y
1 I
SP
i
i
i
TD START:
TEM DESC
ACES .
zu
ZL
ZLi
RIP
NE
NE
NE
1
•
TI
1
2
3
ON
•
1
•
321
-------
05 Z-4
05 Z-5
05 FILLER
05 Z-OUT
05 FILLER
01 HEADING-5.
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
01 DATA-LINE-A.
05 LTR-DUT
05 NAME-OUT
05 COLS
05 FILLER
01 DATA-LIIME-B.
05 FILLER
05 PERCENT OCCURS 7
10 PERC
05 FILLER
01 DATA-LINE-C.
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
*****
*
* START OF PROGRAM
*
*****
PROCEDURE DIVISION.
OPEN-FILES.
OPE.M INPUT CARO-IN, COST-MATRIX-FILE,
OUTPUT PRINT-OUT.
READ-TITLE-CARD.
READ CARD-IN AT END GO TO TITLE-PARAGRAPH.
PERFORM FILL-HEADINGS.
READ-kATER-CARD.
READ CARD-IN AT END GO TO TITLE-PARAGRAPH.
TITLE-PARAGRAPH.
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
T
P
P
P
P
P
P
P
P
P
P
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
1
I
I
I
I
I
I
I
I
I
C
C
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
M
c
c
c
c
c
c
c
c
c
c
Xi
Xi
XI
X!
X I
X 1
Xi
X I
X \
X
X
Xi
Xi
X
X 1
XI
XI
X
Xi
ES,
! 1
( 1
[4
: i
;i
[ i
( i
1 2
( 1
(1
( 1
4 )
4)
I
0)
6)
5)
5)
)
4 )
4)
4)
(14)
( 1
(1
(1
12
4 )
4 )
6)
) .
.
.
VALU
.
VALU
VALU
i VALU
VALU
VALU
i VALU
' VALU
i VALU
VALU
VALU
VALU
E
E
E
E
E
E
E
E
E
E
E
E
SPAC
1
i ***
ES.
TOTA
** **** *** **
LS
*•
t**** ****** i
SPAC
i
i
i
i
i
i
i
ES .
**********
****** * * * *
**********
**********
**********
**********
********
i
•
i
i
.
i
•
i
•
**
(30) .
(2
(3
*
"
) VALUE
1 )
bBB-(
X
X
X
X
x>
X
X
X
X
(3
)
(34]
( 1
(1
(1
4]
4)
4 )
(14]
(1
4]
(141
(1
4]
i VALU
9) .-.
VALU
1 VALU
1 VALU
VALU
> VALU
i VALU
1 VALU
1 VALU
1 VALU
E
E
E
E
E
E
E
E
E
E
n r
SPAC
SPAC
SPAC
SPAC
i
i
i
i
i
i
i
CURS 7 TIME
ES .
ES .
ES .
ES.
•/,
*
%
'4
S.
' .
i
.
1 .
i
' .
i
1 .
322
-------
PERFORM TOP-NEW-PAGE.
PERFORM WRITE-PAGE-HEADING.
HOUSEKEEPING.
MCVt ZEROS TO MATklX.
PERFORM ZERU-SUB-TCTALS THRU ZEkH-TQTALS.
SORT-RECORDS.
OPEN OUTPUT SORTED-FILE.
SORT FILE-SORT ON ASCENDING KEY CC-NOS
INPUT PROCEDURE RE AD-SORT-INPUT
THRU READ-SORT-INPUT-EKD
OUTPUT PROCEDURt WRITh-SORT-DUTPUT
THRU kRlTE-50KT-OUTPUT-LNU.
PERFORM REW1 ND-J-ILE .
TEST-CONFIGURATION.
IF SYSTEM = C THEN GO TO MITE-MATRIX.
IF SYSTEM = 1 THEN GO TO SER1ES-CONF I G.
IF SYSTEM - 2 THEN GO TO PAKA-CGNFIG.
IF SYSTEM = 3 THEN GO TO HAk-SER-CONFIG.
IF SYSTEM = 4 THEN GLJ TO S ER-P AR-S ER-C ONF I G .
GO TO WRITE-MATRIX.
SERIFS-CONFIG.
MOVE ZERO TO L.
MOVE SERIES TG ZONES.
GU TO READ-SORTED-FILE.
PARA-CONFIG.
MOVE ZERO TG L.
MUVE PARALLEL TU ZONES.
READ-SORTED-FILE.
RtAD SORTED-FILE AT ENO GO TO END-5URTED-F I L F. .
IF PAGE-CT EQUAL 2 THEN MUVE AMT-1 TO-DULS
ELSE MOVE AMT-3 TO DDLS.
IF DDLS = (j GO TG R E AO-SORT E D-F I L E .
MCVc CC-NO-1 TO I.
IF CC-NO-1 NOT EQUAL '3' THEN GO TO STEP-^.
MUVE CC-NO-2 TO L.
SUBTRACT 1 FROM L.
STEP-^.
ADD L TO I .
IF I > 10 THEN MOVE 10 TO I .
MLVt CC-NO-<+ TO J.
IF CC-NU-1 NOT EQUAL '3' THEN ADD DDLS TO PLSIT (I, 6)
ADD DIJLS TO PuSIT (10, 6)
IF WU-NAME EQUAL 'KE' PERFORM KENTON-CO-EXCEPTI DNS
THRU KENTON-END.
IF rtU-NAME EQUAL 'CO' PERFORM COVINGTON-EXCEPT 1UNS
THRU CGVlNGTON-tND.
IF CC-NU-1 - '3' THEN ADD DOLS TO POSIT (I, J).
IF CC-NU-1 = '3' THEN ADD DQLS TO POSIT (10, J).
ADD DULS TO POS IT II, 7) .
ADD DDLS TO POSIT (1C, 7) .
323
-------
GO TO READ-SQRTED-FILE.
END-SDRTED-FILE.
ADD DDLS TO POSIT (10, 7) .
ADD DULS TO PCSIT (9, 7) .
MOVE 3 TO I.
PERFORM CALCULATE-COSTS THRU END
IF WU-NAME EQUAL 'CD' THEN GD TD
MOVE 6 TO I.
PERFORM CALCULATE-COSTS
STEP-3.
MOVE 0 TO J.
PERFORM ADD-DEL-COSTS 5
PERFORM ZERO-SUB-TOTALS
GO TO WRITE-MATRIX.
ADD-DEL-COSTS.
-COSTS .
5TEP-3.
THRU END-COSTS.
T 1M t 5 .
THRU ZERO-TOTALS.
ADD
MOVE
ADD
1 TO
POS
POSI
J.
IT
T 1
(3, J)
:<*» J)t
TO
PO
s
POS
IT
TO
I
(
P
T (
5,
OS1
1
J
T
0
)
t
,
(1
OR
KENTON-CG-EXCEPTIONS
IF CC-NO-2 EQUAL
IF CC-NO-2 EQUAL
GO TO KENTON-END
STORAGE-CHANGES.
IF CC-NO-4 - '5'
IF CC-NU-4 = '!'
GO TO KENTON-END
PUMPING-CHANGES.
IF CC-NU-4 > '4'
IF CC-NO-4 = '1
KENTON-END.
IF J > 7 THEN MOVE
COVINGTON-EXCEPTIONS
IF CC-NO-2 EQUAL
GO TO COVINGTON-END
COV-PUMP-CHANGES.
IF CC-NO-4 >
IF CC-NO-4 =
COVINGTON-END.
IF J > 7 THEN
CALCULATE-COSTS.
IF WATER-SOLD = 0
MOVE POSIT (I, 1)
THEN
THEN
GU
GO
TO
TO
J).
POSIT (6, J)
0, J ) .
STORAGE-CHANGES.
PUMPIUG-CHANGES.
i' THEN
ELSE
THEN MOVE 1
MOV
HOV
TO
E 3 TO J
E 2 TO J.
J.
THEN
ELSE
THEN
E 7
14 »
MOV
MOV
MOV
TO J
THEN
E
E
E
3
2
1
GO
TO
TO
TO
TO
J
J.
J.
CD
•2
'2
THEN SUBTRACT 1
THEN MOVE 5 TC
CDV-PUMP-CHANGES
FROM J.
J.
MOVE 7 TO J.
IF SYSTEM EQUAL 2
COMPUTE POSIT (I
MLVE POSIT (I, 2)
THEN GO TO END-COSTS.
TO 5-TOT (1).
THEN MOVE ZERO
GO TO CALC-PAK
1) = POSIT (I,
/ WATER-S
TO S-TOT (2).
TO POSIT ( 1 , 1)
A-COSTS.
1) * MIL-GAL (1)
OLD.
324
-------
COMPUTE POSIT (I, 2) = (POSIT (I, 2) + S-TOT (1)
- PDSIT (I, 1)) * MIL-GAL (2) / (WATER-SOLD
- MIL-GAL (i ) ) .
SUBTRACT POSIT (I, 1), POSIT (I, 2) FnOM POSIT (I, 7)
GIVING PUSIT (I, 3).
GO TO END-CCSTS.
CALC-PAkA-COSTS.
COMPUTE S-TGT (N) = S-TOT (1) * MIL-GAL (N) / WATER-SOLD.
ADD S-TOT (N ) TO POSIT ( I , N ) .
ADD 1 TD N.
IF N NOT GREATER THAN PARALLEL GO TO CALC~PARA-COSTS .
MOVE 1 TO N.
SUBTRACT POSIT (I, 2), POSIT (I, 3), POSIT (I, H),
POSIT (I, 5) FROM PLS1T (1, 7) GIVING PUSIT (1, 1)
END-COSTS.
EXIT .
MEXT-PAGE .
IF PAGE-CT > 2 THEN GO TO CLOSE-FILES.
PERFORM REAU-WATER-CARD THRU HOUSEKEEPING.
MOVE 'I1 TO RPT-FLAG.
PERFORM REWIND-FILE.
GO TCI TEST-CONFIGURATION.
PAR-SbR-CONFIG.
GO TO WRITE-MATRIX.
SER-PAR-SER-CUNFIG.
GO TO WRITE-MATRIX.
WRITE-MATRIX.
PERFORM WRITE-MATRIX-LINE VARYING I FROM 1 BY 1 UNTIL
I GREATER THAN 10.
IF RPT-B THEN G(j TO NEXT-PAGE
ELSE PERFORM SKIP-LINE 2 TIMES.
GO TO WRITE-COSTS-BY-ZONE.
WRITE-MATRIX-LINE.
MOVE CC-NAME (I) TO NAME-OUT.
PERFORM MATRIX-COL VARYING J FROM 1 BY \ UNTIL
J GREATER THAN 7.
PERFORM WRITE-DATA-LINE-A.
IF RPT-B THEN
MOVE POSIT ( I , -7 ) TL TEMP-1
MOVE POSIT (10, 7) TO TEMP-2
MOVE 7 TO J
PERFORM VARI-AND-PERCENT
PERFORM WRITE-DATA-LINE-C
PERFORM WRITE-DATA-LINE-B
PERFORM WRITE-5UB-TUTALS THRU ST-END.
IF I = 2 THEN MOVE CC-NAME (11) TO PRINT-LINE
PERFORM PRINT-LlNfc-OUT .
MATRIX-COL .
MOVE POSIT (I, J) TO COLS (J) .
IF RPT-B PERFORM PERCENT-LINE.
325
-------
PERCENT-LINE.
MOVE C-TGT (J) TO TEMP-2.
MOVE PGSIT (I , J) TO TEMP-1 .
PERFORM VARI-AND-PERCENT .
WRITE-SUB-TUTALS.
IF 1 < 6 OR I = 7 THEN GO Tu ST-END.
IF I > 8 ThfcN GO TO ST-ENO.
MOVE 'SUB TOTAL ' TO NAMt-GUT.
MOVE 0 TO J.
PERFORM LOAU-SUb-TOTALS 7 TIKES.
PERFORM WRITE-DATA-LINE-A THRU WR I TE -0 AT A-L I NE-6 .
ST-ENO.
EXIT .
LOAD-SUB-TOTALS.
ADD 1 TO J.
MOVE C-TOT (J) TO TEMP-2.
IF I = 6 THEN MOVE SS-TOT (J) TO COLS (J), TEMP-1
ELSE MOVE S-TOT (J) TO CGLS (J), TEMP-1.
PERFORM VARI-AND-PERCENT.
WRITE-CUSTS-BY-ZCNE.
PERFORM ZERO-5UB-TOTALS THRU ZERO-TOTALS.
MOVE ZEROS TO TEMP-1, TEMP-2.
MOVt 'TOTAL COSTS BY ZONE:' TO PRINT-LINE.
PERFORM PRIIMT-L1NE-OUT.
MOVE 'DIRECT' TO NAME-OUT.
MOVt 0 TO J.
PERFORM DIRECT-COSTS 5 TIMES.
MOVE ZERO TO COLS (6).
MOVE C-TOT (7) TO COLS (7).
PERFORM WRITE-DATA-LINE-A.
MOVE 'INDIRECT' TO NAME-OUT.
MOVE 0 TO J.
ADD POSIT (1, 7), POSIT (2, 7), POSIT (7, 7), POSIT (8, 7)
POSIT (9, 7) TO TEMP-1.
MOVE TEMP-1 TO COLS (7).
ADD TEMP-1 TO C-TUT (7).
PERFORM INDIRECT-COSTS 5 TIMES.
PERFORM WRITE-DATA-LINE-A.
MOVE 'TOTAL' TO NAME-OUT.
MOVE U TO J.
PERFORM LOAD-TOTALS 7 TIMES.
PERFORM WRITE-DATA-LINE-A.
MOVE ZERO TO K.
PERFORM SKIP-LINE 2 TIMES.
GO TO WRITE-WATER-PROLJUCEO.
DIRECT-COSTS.
ADD 1 TO J.
MOVE POSIT (10, J) TO COLS (J).
ADD POSIT (10, J) TO C-TOT (J).
ADD POSIT (10, J) TO C-TOT (7).
326
-------
INDIRECT-COSTS.
AOD 1 TO J.
MOVE POSIT (lUt 6) TO TEMR-i .
MULTIPLY MIL-GAL (J) bY TbMP-1.
IF HATER-SOLD > 0 THElM
DIVIDE TEMP-1 BY WATER-SOLO GIVING TEMP-1
ADD .005 TD TEMP-1
ELSE MOVE ZERU TO TtMP-1 .
IF TEMP-1 < 0 THEN SUBTRACT .01 FROM TEMP-1.
MOVh TEMP-1 TO CCLS (J).
ADD TEMP-1 TO C-TGT (J) .
IF J = 1 THEN ADD .01 TO C-TOT (1).
IF WU-NAME = 'KE' AND J = 3 THEN
COMPUTE S-TOT (2) = POSIT (10, b) - S-TOT (1)
MOVE S-TOT (2) TO COLS (3)
COMPUTE C-TOT (3) - C-TOT (7) - (C-TOT (1) +
C-TOT (2)).
ADD TEMP-l TO S-TOT (1).
LOAD-TOTALS.
ADD 1 TO J.
MOVc C-TOT {J) TO COLS (J) .
kRITE-WATER-PRODUCED.
MUVt 'Rt ' TU LTR-OUT.
MOVE 'VENUE PRODUCING WATER (MG)' TU NAME-OUT.
MCVE ZERO TU J.
ADD .005 TQ WATER-SOLD.
MOVE WATER-SOLD TO COLS (?), TEMP-2.
MOVE 100 TO PERC (7).
PERFORM LuAD-wATER 6 TIMES.
PERFORM WklTE-DATA-LINF-A.
PERFORM WRITE-DATA-LINE-C.
PERFORM WR ITE-DATA-LINE-B.
MOVE ' ' TO LTR-UUT.
MOVt ZERO TU J.
PERFORM ZtRO-SUB-TOTALS THRU ZERO-TOTALS.
PERFORM SKIP-LINE 2 TIMES.
GL TO CALCULATE-UNIT-COSTS.
LUAD-WATER.
ADD 1 TU J.
ADD .005 TO MIL-GAL (J) .
MLVE MIL-GAL (J) TO COLS (J). TEMP-1.
PERFORM VARI-AND-PERCENT.
CALCULATE-UNIT-COSTS.
MOVE 'UNIT COSTS bY ZONE:' TO PRINT-LINE.
PERFORM PRI,\T-LIN'E-OUT .
MLVE ZEROS TO POSIT (1, 6), PLS1T (2, 6), POSIT (7t 6),
POSIT (8, 6), POSIT (9, 6), POSIT (10, fa).
IF ZONES > 7 THEN MOVE 7 TO ZONES.
PERFORM LOAD-UN IT-COSTS VARYING I FROM 1 bY 1 UNTIL
I GREATER THAN 10.
327
-------
MGVt '2' TO RPT-FLAG.
GO TO WRITE-MATRIX.
LUAD-UNIT-CQSTS.
IP WATER-SOLD > 0 THEN DIVIDE PUSIT (I, 7) 6Y WATER-SOLO
GIVING TEMP-1
ADO .005 TO TEMP-1
ELSE MOVE ZERO TO TEMP-1.
MOVE TEMP-1 TO POSIT ( I , 7) .
IF I < 7 ADD TEMP-1 TO SS-TLiT (7).
IF I < 9 ADD TEMP-1 TO S-TOT (7).
IF I < 10 THEN ADD TEMP-1 TO C-TflT (7)
ELSE MOVE C-TOT (7) TO POSIT (10, 7).
PERFORM LOAD-COLS THRU LOAO-CCNTD VARYING J FROM 1 6Y 1 UNTIL
j GREATER THAN ZONES.
LOAD-COLS.
IF i < 3 OR > 6 THEN GO TO LOAD-CONTD.
IF MIL-GAL (J) > 0 THEN DIVIDE POSIT (I, J) PY
MIL-GAL (J) GIVING TEMP-1
ADD .005 TO TEMP-1
ELSE MOVE ZERO TO TEMP-1.
LOAD-CONTD.
MOVE TEKP-1 TO POSIT (I, J).
IF I < 7 THEN ADD TEMP-1 TO SS-TOT (J).
IF I < 9 THEN ADD TEMP-1 TO S-TOT (J).
IF I < 10 THEN ADD TEMP-1 TU C-TOT (J)
ELSE MOVE C-TOT (J) TO POSIT (10, J).
GENERAL SUBROOTINES
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-LINE-GUT.
WRITE PRINT-DATA BEFORE 1.
ADD 1 TO LINE-CT.
S K I P - L I N E .
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-OUT.
PAGE-GVFLOW.
IF LINE-CT NOT < MAX-LINE THFN
PERFORM TOP-NEW-PAGE.
PERFORM WRITE-PAGE-HEADING.
ZERQ-SUB-TOTALS.
MOVE ZEROS TO SUB-SUB-TOTAL.
MOVE ZEROS TO SUB-TOTAL.
ZERO-TOTALS .
MOVE ZEROS TO COL-TOTAL.
TOP-NEW-PAGE .
PERFORM MOVE-SPACES.
328
-------
WRITE PRINT-DATA dE
MUVE PAGE-CT TO PAG
MOVE o TO LINE-CT.
ADD 1 TU PAG F~CT .
FILL-HEADINGS .
MOVE DATE-IN TO DAT
MOVE SPACES TU Z-4,
MUVE 'ZONES 1..3' T
IF WU-NAME EQUAL 'C
MOVE '
MOVc '
MOVfc 'ZONES
MOVE FISCAL-YR TD F
MOvt 'MONTHLY '
I F RPT-PERIUD '2'
IF KPT-PERIOD = '3'
IF RPT-PERIUD = '4'
MUVt SPACES TU WKS-
I F NO-WKS = '1 ' MOV
IF NO-WKS = '2' MuV
IF NO-WKS = '3' MUV
IF NO-WKS = '4' MOV
IF NO-WKS = '5' MUV
MOVE PAGE-CT TO PAG
MOVt TITLE-IN TO TI
FORE NtW-PAGE.
E-OUT .
E-OUT.
Z-5.
0 Z-OUT.
0' THEN
ZONF <*'
ZONE 5>
1 . .5 ' TU
ISC-YR.
TO RPT-PO
THEN MOVE
THEN MOVE
THEN MOVE
OUT.
TL Z--+
TU 1-5
Z-UUT.
'(jUART ER
'HALF YR
'ANNUAL
TH RPT-PU.
TO RPT-PU.
TO RPT-Pu.
( 4
( 5
(13
( 26
( 52
E-UUT .
TLE-UUT
WKS) '
WKS) '
WKS) '
WKS) '
WKS) '
TO
TO
TO
TO
TO
WKS-UUT
WKS-QUT
WKS-GUT
WKS-UUT
WKS-uUT
WRITE-PAGE-HEADIKG.
MOVE riEADING-1 TC1 P
PERFORM PRINT-LINE-
MUVE HEADING-2 TO P
PERFORM PRINT-LINE-
MOVE HEADING-3 TO P
PERFORM PRINT-LINE-
MOVE HEADING-6 TD P
PERFORM PRINT-LINE-
PERFORM SKIP-LINE 2
MOVE HEADING-^ TD P
PERFORM PRINT-L1NE-
MOVE HEADING-5 TO P
PERFORM PRINT-LINE-
PERFORM SKIP-LINE.
IF PAGE-CT EQUAL 2
R 1 N T - L I N t .
OUT .
RINT-LINL.
OUT .
RINT-LINE.
OUT .
RINT-LINE.
OUT.
T IMES .
RINT-L INE .
OUT.
RINT-LINE .
OUT;
PERFORM PRINT-LINE-
WR ITE-DATA-LINE-A.
MOVE OATA-L1NE-A TO
PERFORM PRINT-LINE-
WRITE-DATA-LINE-C.
MOVE UATA-LINE-C TO
THEN MOVE 'FUNCTION COSTS FOR PERIOD
TO PRINT-LINE
ELSE MUVE 'FUNCTION COSTS YEAR TO DATE:1
TU PRINT-LINE.
OUT.
PRINT-LINE.
OUT .
PR INT-LINE.
329
-------
WRITE PRINT-DATA BEFORE 0.
KRITE-DATA-LINE-B.
MGVt DATA-LINE-6 TO PRINT-LINfc.
PERFORM PRINT-LINE-DUT.
VARI-ANli-PERCENT .
MULTIPLY 10U BY TEMP-1.
IF TEMP-2 > 0 DIVIDE TEMP-2 INTO TEMP-1 ELSt
MGVt ZERO TG TEMP-1
MULTIPLY 1 By TEMP-1 GIVING PhRC (J) ROUNDED.
* FINI
*
*****
READ-SORT-INPUT.
READ COST-MATRIX-FILE AT END
GO TO RcAD-SORT-INPUT-END.
IF CC-NU EQUAL '4301' OR '4302' OR
OR '4321 ' OR '4322 ' OR '4421 '
GO TU READ-SORT-INPUT
RELEASE SGRT-INPUT FROM CM-REC.
GO TO READ-SORT-INPUT.
READ-SORT-INPUT-END.
EXIT.
WRITF-SGRT-OUTPUT .
RETURN FILE-SLRT RECORD INTO INPUT-REC
AT END GO TG WR I T E-SORT-OUTPUT -E NU .
WRITE INPUT-REC.
GO TO WRITE-SORT-OUTPUT .
WRITE-5GRT-GUTPUT-END.
EXIT.
REWIND-FILE.
CLOSE SORTED-FILE.
OPEN INPUT SURTED-FILE.
CLOSE-FILES.
CLOSE CARO-IM, COST -M ATR I X -F I L E ,
SORTED-FILE, PRINT-OUT.
E-O-J.
STOP RUN.
330
-------
PGMNAME=WUA5BUCM
SYS1N DO *
ID DIVI SIGN.
PROGRAM-ID. WUASBUCM.
AUTHOR. ACT SYSTEMS, INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, PL 32789.
DATE-WRITTEN. JAN 197tt
DATE-COMPILED.
REMARKS. THIS PROGRAM BACKS UP THE CM FILE
AND PRODUCES A COPY OF SAME.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SLURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARD-IN
ASSIGN TO UK-2540R-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTGUT
ACCESS MODE IS SEQUENTIAL.
SELECT COST-MATRIX-FILE
ASSIGN TO DA-3330-I-CMFILE
ACCESS MOUF IS SEQUENTIAL
RECORD KEY IS CM-NUMBER.
SELECT TAPE-OUT
ASSIGN TO UT-2400-S-TAPEOUT
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD COST-MATRIX-FILE
BLOCK CONTAINS 5 RECORDS
RECURU CONTAINS 80 CHARACTERS
LABEL RECORUS ARE STANDARD
DATA RECORD IS INPUT-REC.
01 INPUT-REC.
05 MATCH-COOE-IN.
1.0 DELETE-POS PIC X.
10 FILLER PIC X(3).
05 CM-NUMBLR.
10 ACCT-ND-IN PIC XI10) •
10 COST-CNTR-IN PIC X(M.
10 CQST-CAT-IN PIC X(2).
05 flMOUNTS-IN OCCURS h TIMES.
10 AMT-IN PIC S9(8)V99.
331
-------
FD TAPE-OUT
BLOCK CONTAINS 5 RECORDS
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS TAPE-REC.
01 TAPE-REC PIC X(8C).
FD PRINT-OUT
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-LINE.
01 PRINT-LINE.
05 FILLER PIC X.
05 PRINT-DATA PIC X(132)
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS INPUT-CARD.
01 INPUT-CARD.
05 DATE-IN.
10 BACKUP-OPTION PIC X(7).
10 FILLER PIC X( 11) .
05 TITLE-IN PIC X(24).
05 FILLER PIC X(38) .
WORKING-STORAGE SECTION.
77 LINE-CT PIC 99 COMP VALUE 0.
77 PAGE-CT PIC 9(4> CDMP VALUE 0.
77 MAX-LINE PIC 99 COMP VALUE 56.
77 I PIC 9.
77
77
77
01
01
01
01
BACKUP-FLAG
ACCT
ACCT
HEAD
05
05
05
-HOLD
-COUN
-1.
FILLE
FILLE
FILLE
T
R
R
R
P
P
P
P
P
P
I
I
I
c
c
c
1C
I
I
c
c
9
XI
VALUE 0.
;io>
VALUE
999 VALUE Z
XI
XI
XI
:53)
127)
152)
VALUE
VALUE
VALUE
SPACE
ERO.
SPACE
•COST
•CKUP
SPACE
S.
S.
ALLOCATION
1
•
S.
HEAD-2.
05
05
05
05
05
05
05
HEAD
05
05
05
FILLER
DATE-
FILLE
FILLF
FILLE
FILLE
OUT
R
R
R
R
PAGE-OUT
-3.
FILLER
TITLE
FILLE
-OUT
R
P
P
P
P
P
P
P
P
P
P
I
I
I
I
I
I
c
c
c
c
c
c
1C
I
I
I
c
c
c
XI
XI
XI
XI
XI
XI
Zl
XI
XI
Xi
113)
118)
134)
!3>
154)
[b»
[4>.
155)
124)
(53)
VALUE
.
VALUE
VALUE
VALUE
VALUE
VALUE
.
VALUE
•DATE
SPACE
•FOR '
SPACE
'PAGE
SPACE
ENDING: ».
s.
.
s.
: • .
S.
SPACES.
HEAD-4.
05
FILLE
R
P
I
c
Xi
[2 )
332
VALUE
SPACES .
FILE BA
-------
05 FILLER
05
05
05
05
05
05
05
05
05
05
05
05
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
01 HEAO-5.
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
05 FILLER
01 DATA-LINE.
05 FILLER
05 CM-NUMBER-1.
10 ACCT-NO
10 FILLER
10 COST-CNTR
10 FILLER
10 COST-CAT
05 FILLER
05 rtATCH-CGDE
05 FILLER
05 AMOUNTS OCCURS
10 AMT
01 ACCOUNT-ACCUM.
05 ACCT-ACCUM
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
T
P
I
I
I
I
I
I
I
1
r
i
i
i
i
i
i
i
i
i
i
i
i
i
i
i
i
i
i
i
i
i
i
i
i
i
i
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
1C
i
i
i
i
c
c
c
c
1C
I
I
I
c
X(
X (
X(
X (
XI
X(
X(
X(
X (
X(
X(
X(
X(
XI
XI
X(
X(
X
XI
X
XI
XI
XI
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
35)
28)
7)
4)
6
5
7
5
7
4
7
5
8 )
2)
10)
4 )
9 )
4 )
8)
4 )
10)
16)
4 )
4)
10)
2 >
10)
4)
6)
(2 )
! 12)
(2 )
(9)
(2 ).
(10)
(6).
! 4 ) •
(10)
(2>.
( 10)
(4 ) .
( 12)
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE S
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
t
.
.
.
• ***
'L D
SPAC
'CUR
SPAC
'PRE
SPAC
•CUR
SPAC
•YEA
PACE
I* C
*<•*<•<">**
ES.
RENT' .
ES.
VIOUS • .
ES.
RENT' .
ES .
RLY ' .
S.
•CURRENT' .
SPAC
'PRE
SPAC
•ACC
SPAC
ES .
VIOUS ' .
ES .
OUNT NO ' .
ES.
•COST CNTR' .
SPAC
'COS
SPAC
ES.
T CAT ' .
ES.
•MATCH CODE ' .
SPAC
'COS
SPAC
ES.
T ' .
ES.
•MONTH COST ' .
SPAC
•COS
SPAC
ES.
T (YTD) ' .
ES.
•BUDGET ' .
SPAC
ES.
•BUDGET (YTD)
SPAC
•YEA
ES.
R COST' .
MES.
c
-
(9).
— ™ •
F I E
PIC S9(8)V99 OCCURS 6 TIMES
333
-------
01 SUBTOTAL.
05 SUBS PIC S9OJV99 OCCURS 6 TIMES
PROCEDURE DIVISION.
OPEN-FILES.
DPErt INPUT CQST-MATRIX-FILE»
CARD-IN,
OUTPUT PRINT-OUT.
FILL-HEADING.
READ CARD-IN AT END
PERFORM ERROR-CARD-IN
GD TO CLOSE-FILES.
MOVE DATE-IN TO DATE-OUT.
MOVE TITLE-IN TO TITLE-OUT.
READ CARD-IN AT END
GO TO HOUSEKEEP.
IF BACKUP-OPTION NOT = 'BACK-UP1 THEN
GD TO HOUSEKEEP.
OPEN-BACKUP-FILE.
MOVE 1 TO BACKUP-FLAG.
OPEN OUTPUT TAPE-OUT.
HOUSEKEEP.
MDVt ZEROS TO SUBTOTAL. ACCOUNT-ACCUM.
WRITE-HEADINGS.
ADD 1 TO PAGE-CT.
MOVE PAGE-CT TO PAGE-OUT.
MOVE 0 TO LINE-CT.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE NEW-PAGE.
MOVE HEAD-1 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-2 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-3 TO PRINT-DATA.
PERFORM PRINT-L1NE-DUT.
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-DUT 2 TIMES.
MOVE HEAD-4 TO PRINT-DATA.
PERFORM PRINT-LINc-OUT.
MOVE HEAD-5 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRINT-LINE-DUT.
INIT-ACCT-HOLD.
PERFORM READ-INPUT-REC.
MOVE ACCT-NO-IN TO ACCT-HOLD.
GD TO START-BACKUP.
READ-INPUT-REC.
READ COST-MATRIX-FILE AT END
GO TO URITE-SUBTOTAL.
START-BACKUP.
IF ACCT-NO-IN NOT = ACCT-HOLD
334
-------
THEN PERFORM SUB TOTAL-ACCT.
ADD 1 TO ACCT-COUNT.
MOVE ACCT-NO-IN TD ACCT-NO.
MOVE COST-CNTR-IN TO COST-CNTR.
MOVE COST-CAT-IN TO COST-CAT.
MOVE MATCH-CODE-IN TO MATCH-CODE.
PERFORM MOVE-AMOUNTS VARYING I FROM 1 BY 1 UNTIL I
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
IF LINE-CT > MAX-LINE
THEN PERFORM WRITE-HEADINGS.
IF BACKUP-FLAG = 1 THEN
MOVE INPUT-REC TO TAPE-REC
WRITE TAPE-REC.
GO TO READ-INPUT-REC.
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-LINE-CUT.
WRITE PRINT-LINE BEFORE 1.
ADD 1 TO LINE-CT.
MOVE-AMOUNTS.
MOVE AMT-IN (I) TO AHT (I).
ADD AMT-IN (I) TO SUBS (I) ACCT-ACCUM (I).
MOVE-SUBTOTALS.
MOVE SUBS (I) TO AMT (I).
ERROR-CARD-IN.
MOVE '*** NU DATE/TITLE CARD fr** JOB ABORTED'
TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
SUBTOTAL-ACCT.
MOVE SPACES TO DATA-LINE.
PERFORM MOVE-ACCT-SUB VARYING I FROM 1 BY 1 UNTIL I = 7.
IF (ACCT-COJNT > 1) AND (ACCDUNT-ACCUM HOT = ZERO) THEN
MOVE 'SUB TOTAL ' TO ACCT-NO,
MOVE DATA-LINE TO PRINT-OATA,
PERFORM PRINT-LINE-DUT.
MOVE 1 TO ACCT-COUNT.
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT.
MOVE ZEROS TO ACCOUNT-ACCUM.
MOVE ACCT-ND-IN TO ACCT-HOLD.
MOVE-ACCT-5UB.
MOVE ACCT-ACCUM (1) TO AMT (I).
KRITE-SUBTOTAL.
PERFORM MOVE-SPACES THRU PR 1NT-LINE-OUT 2 TIMES.
MOVE SPACES TO DATA-LINE.
PERFORM MOVE-SUBTOTALS VARYING I FROM 1 BY 1 UNTIL I = 7
MOVE 'TOTAL ' TO ACCT-NO.
MOVE DATA-LINE TD PRINT-DATA.
PERFORM PRINT-LINE-OUT.
CLOSE-FILES.
335
-------
CLOSE COST-MATRIX-FILE,
CARD-IN,
PRINT-OUT.
CLOSE-TAPE-FILE.
IF BACKUP-FLAG NOT = 1 THEN
GO TO E-O-J.
CLOSE TAPE-OUT.
E-O-J.
STOP RUN.
336
-------
PGMNAME=WUASUCAD
• SYSIN 00 *
ID DIVISION.
PROGRAM-ID. WUASUCAD.
AUTHOR. ACC SYSTEMS, INC
SUITE 200
807 W MORSE BLVD
WINTER PARK, FL 32789.
DATE-WRITTEN. MARCH 1978.
DATE-COMPILtD .
REMARKS. THIS PROGRAM READS A CARD IMAGE OF A
COST MATRIX RECORD AND EITHER CHANGES,
ADDS OR DELETES THE RECORD.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
C01 IS NEW-PAGE.
INPUT-OUTPUT SECTION.
FILE-CONTROL .
SELECT CARD-IN
ASSIGN TO UR-2540R-S-CARDIN
ACCESS MODE IS SEQUENTIAL.
SELtCT PRINT-OUT
ASSIGN TO UR-1403-S-PRINTOUT
ACCESS MODE IS SEQUENTIAL.
SELECT COST-MATRIX-FILE
ASSIGN TO DA-3330-I-CMF1LE
ACCESS MODE IS RANDOM
RECORD KEY IS CM-NUMBER
NOMINAL KEY IS CM-NOMINAL.
SELECT TAPE-IN
ASSIGN TO UT-2400-S-TAPEIN
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD COST-MATRIX-FILE
BLOCK CONTAINS 5 RECORDS
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS CM-REC.
01 CM-REC.
05 MATCH-CODE.
10 DELETE-PDS PIC X.
10 FILLER PIC X(3).
05 CM-NUMBER.
10 ACCT-NO PIC XI10).
10 COST-CNTR PIC X ( <» ) .
10 COST-CAT PIC X(2).
337
-------
05 AMOUNTS.
10 AMTS
FD TAPE-IN
BLOCK CONTAINS 5 RECORDS
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS TAPE-REC.
01 TAPE-REC PIC XI80)
FD CARD-IN
RECORD CONTAINS 80 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS INPUT-REC.
01 INPUT-REC.
05 OATE-IN
05 TITLE-IN
05 FILLER
01 INPUT-REC-1.
05 MATCH-CODE-IN
05 INPUT-KEY.
10 ACCT-IN
10 COST-CNTR-IN
10 COST-CAT-IN
05 AMOUNTS-IN
01 INPUT-REC-2.
05 FILLER
05 AMTS-IN
FD PRINT-OUT
RECORD CONTAINS 133 (
LABEL RECORDS ARE DM
DATA RECORD IS PRINT-
01 PRINT-LIME.
05 FILLER
05 PRINT-DATA
WORKING-STORAGE SECTION.
77 PAGE-CT
77 LINE-CT
77 MAX-LINE
77 INPUT-CT
77 AOD-CT
77 CHANGE-CT
77 DELETE-CT
77 ERROR-CT
77 CM-NOMINAL
77 I
77 UPDATE-FLAG
77 INPUT-DEVICE
01 HEAD-1.
05 FILLER
05 FILLER
PIC S9(8)V99 OCCURS 6 TIMES
PIC X(
PIC X(
PIC XI
PIC X(
PIC X(
PIC X(
PIC X(
PIC X(
PIC X(
PIC 59
HARACT
TTED
LINE.
PIC X.
PIC X(
PIC 9(
PIC 9(
PIC 9(
P
P
P
P
P
P
P
P
P
P
P
I
I
c
c
1C
I
I
I
I
I
I
I
c
c
c
c
c
c
c
1C
9(
9(
9(
9(
9(
X(
99
9
9
X(
X(
18).
24) .
38) .
4).
10) .
4) .
2).
60) .
20) .
(8)V99 DC
ERS
132) .
4> COMP
2) CDMP
2) COMP
4>V99
4)V99
4)V99
4}V99
4>V99
16) V
CURS
VALUE
VALUE
VALUE
VALUE
VALUE
VAL
VAL
VAL
ALUE
COMP
VALUt
VALUE
54) V
0.
0.
ALUE
24) VALUE
UE
UE
UE
0.
0.
0.
0.
0.
SPAC
VALUE
S
i
1
PAC
6 TIMES
0-
0.
56.
ES.
0.
ES.
CHANGES AD
S1 .
AND DELETE
338
-------
01
01
01
01
01
05
HEA
05
05
05
05
05
05
05
HEA
05
05
05
HEA
05
05
05
HEA
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
HEA
05
05
05
05
05
05
05
05
05
FI
D-2
FI
OA
FI
FI
FI
FI
LLE
.
LLE
TE-
LLE
LLE
LLF
LLE
R
R
OUT
R
R
R
R
PAGE-DUT
0-3
FI
Tl
FI
D-4
FI
FI
FI
0-5
FI
FI
FI
FI
FI
FI
FI
FI
FI
FI
FI
FI
FI
FI
FI
FI
FI
FI
FI
FI
FI
FI
0-6
FI
FI
FI
FI
FI
FI
FI
FI
FI
.
LLE
TLE
LLE
.
LLE
LLE
LLE
.
LLE
LLE
LLE
LLE
LLE
LLE
LLF
LLE
LLE
LLE
LLE
LLE
LLE
LLE
LLE
LLE
LLE
LLE
LLE
LLE
LLE
LLE
.
LLE
LLE
LLE
LLE
LLE
LLE
LLE
LLE
LLE
R
-OUT
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
R
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
P
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
C
C
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
X( 54 )
X(6)
X(18 )
XU1 )
X( 2)
X(55)
X(6)
1 ( 4 > .
X ( 54)
X ( 24)
X{ 54)
X(58)
X(16)
XI58)
X(7)
X(6)
X ( 4 )
X(3)
X(<4)
X( 2)
X(5)
X (6 )
X(7)
X(5 )
X(8)
XI Q )
\ * f
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
3)
8 )
6)
9 )
3)
6)
8 )
7)
8)
8 )
7)
5)
6)
2)
3)
3)
4)
7)
X(6>
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
.
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
SPACE
•DATE
SPACE
•ON1 .
SPACE
'PAGE
SPACE
SPACE
SPACE
•COST
SPACE
S.
. i >
S.
S.
; > .
S.
S.
S .
MATRIX
S.
•ACCOUNT' .
SPACE
'COST
SPACE
•COST
SPACE
•MATC
SPACE
'CURR
SPACE
'PREV
SPACE
•YTD '
SPACE
'YEAR
SPACE
•YTD'
SPACE
'PREV
SPACE
S.
1 .
S.
1
S.
H ' .
S.
ENT' .
S.
IDUS' .
S.
.
S .
LY ' .
S.
.
S.
IOUS ' .
S.
•COMMENTS' .
SPACE
S.
• NUMBER' .
SPACE
'CENT
SPACE
'CAT '
SPACE
'CODE
SPACE
S.
ER • .
S .
.
S.
' .
S.
•AMOUNT ' .
FILE '
339
-------
05
05
05>
05
05
05
05
05
05
05
05
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
FILLER
p
p
p
p
p
p
p
p
p
p
p
I
I
I
I
I
I
I
I
I
I
I
c
c
c
c
c
c
c
c
c
c
c
X
X
X
X
X
X
X
X
X
X
X
(7
(5
(9
(6
(7
(b
(7
(6
(c
(4
)
)
J
>
J
)
)
)
)
J
(24)
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
SPACES
•MONTH
SPACES
.
i
.
•AMOUNT •
SPACES
•BUDGE
SPACES
.
T "
.
•BUDGET '
SPACES
•YEAR1
SPACES
.
.
.
T
UT
CCCUR
E
P
P
P
P
P
P
P
P
S
P
P
P
I
I
I
I
I
I
I
I
I
I
I
PI
C
c
c
c
c
c
c
c
6
C
c
c
c
X
X
X
X
X
X
X
X
T
X
-
X
X
(1
(3
(4
U
(2
(3
( 4
.
IM
(2
(6
(3
(2
0)
) .
) .
) .
) .
) .
) .
ES
) .
) .
1 *
0)
01 DATA-LINE.
05 ACCT-OUT
05 FILLER
05 COST-CNTR-OUT
05 FILLER
05 CQST-CAT-UUT
05 FILLER
05 MATCH-CODE-OUT
05 FILLER
05 AMOUNTS-DUT
10 CODE-NAME
10 AMTS-OUT
05 FILLER
05 COMMENT
PROCEDURE DIVISION.
OPEN-FILES .
OPEN I-D COST-MATRIX-FI
INPUT CARD-IN,
OUTPUT PRINT-OUT.
FILL-HEADING.
READ CARD-IN AT END GO TO
MOVE DATE-IN TO DATE-OUT.
MOVE TITLE-IN TO TITLE-OUT.
WRITE-HEAOINGS.
AuD 1 TO PAGE-CT.
MOVE 0 TO LINE-CT.
MOVE PAGE-CT TO PAGE-OUT.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE NEW-PAGE.
MOVE HEAD-1 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-2 TO PRINT-DATA.
PERFORM PR1NT-LINE-DUT.
MOVE HEAD-3 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-4 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES.
PERFORM PRINT-LINE-OUT 2 TIMES.
LE
WRITE-RECORD-COUNTS
340
-------
MOVE HEAD-5 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE HEAD-6 TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR 1NT-LINE-OUT.
HOUSEKEEP.
MOVE SPACES TO DATA-LINE.
UPDATE-FILE-YES-OR-NO.
READ CARD-IN AT END GO TO WRITE-RECORD-COUNTS .
IF ACCT-IN NOT = 'UPDATE • THEN
AOD 1 TO INPUT-CT
GO TO START-UPDATE.
MOVE 1 TO UPDATE-FLAG.
TEST-FOR-INPUT-DEVICE.
READ CARD-IN AT END
MOVE 1 TO INPUT-DEVICE
PERFORM OPEN-TAPE-FILE
GO TO READ-INPUT.
* THE ABOVE CONDITION IS FOR TAPE INPUT USED
* TO RECREATE THE CM FILE FROM THE BACKUP TAPE
THE FOLLOWING IS FOR CARD INPUT USED TO
MAKE CHANGES, ADDS* OR DELETES TO THE CM-FILE.
ADD 1 TO INPUT-CT.
GO TO START-UPDATE.
READ-INPUT.
IF INPUT-DEVICE = 0 THEN
PERFORM READ-CARD-IN
ELSE PERFORM READ-TAPE-IN.
ADD 1 TO INPUT-CT.
START-UPDATE.
MOVE ACCT-IN TO ACCT-OUT.
MOVE COST-CNTR-IN TO COST-CNTR-CUT.
MOVE COST-CAT-IN TO COST-CAT-OUT.
IF (MATCH-CUDE-IN = SPACES) AND (AMDUNTS-1N = SPACES) THEN
GO TO DELETE-RECOKD.
MOVE MATCH-CODE-IN TO MATCH-CODE-OUT.
EXAMINE AMOUNTS-IN REPLACING ALL ' • BY '0'.
PERFORM MOVE-AMTS-IN-TO-AMTS-OUT VARYING I
FROM 1 BY 1 UNTIL I = 7.
VERIFY-KEY.
IF (ACCT-IN = SPACES) OR (COST-CNTR-IN = SPACES) OR
(COST-CAT-IN = SPACES) OR (MATCH-CODE-IN = SPACES)
THEN MOVE •*** INVALID KEY ***' TO COMMENT
MOVE DATA-LINE TO PRINT-DATA
341
-------
PERFORM PRINT-LINE-OUT
PERFORM MUVE-SPACES THRU PR1NT-LINE-OUT
ADD 1 TU ERROR-CT
GO TO READ-INPUT.
READ-CM-FILE.
MOVE INPUT-KEY TO CM-NOMINAL.
READ COST-MATRIX-FILE INVALID KEY
GO TO ADD-RECORD.
CHANGE-RECORD.
MOVE '*** NEW RECORD ***' TO COMMENT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
MOVE MATCH-CODE TO MATCH-CODE-OUT.
PERFORM MOvE-CM-AMTS-OUT VARYING I
FROM 1 BY 1 UNTIL I = 7.
MUVE '*** OLD RECORD ***' TQ COMMENT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PRINT-LINE-OUT.
PERFORM PAGE-OVFLOW.
ADD 1 TO CHANGE-CT.
MOVE MATCH-CODE-IN TO MATCH-CODE.
PERFORM MOVE-AMTS-IN-TO-DISK-AMTS VARYING I
FROM 1 BY 1 UNTIL I = 7.
IF UPDATE-FLAG = 1 THEN
REWRITE CM-REC.
MOVE SPACES TO DATA-LINE.
GO TO READ-INPUT.
ADO-RECORD-
MOVE 'fr** RECORD ADDED ***' TO COMMENT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR 1NT-LINE-OUT.
MOVE ACCT-Ii* TO ACCT-NO.
MOVE CDST-CNTR-IN TO COST-CNTR.
MOVE COST-CAT-IN TO COST-CAT.
MOVE MATCH-COOE-1N TO MATCH-CODE.
PERFORM MOVE-AMTS-IN-TO-DISK-AMTS VARYING I
FROM 1 BY 1 UNTIL I = 7.
MOVE CM-NUMBER TO CM-NOMINAL.
IF UPDATE-FLAG = 1 THEN
WRITE CM-REC.
PERFORM PAGE-OVFLOW.
ADD 1 TO ADD-CT.
MOVE SPACES TO DATA-LINE.
GO TO READ-INPUT.
DELETE-RECORD.
MGVE •**«, RECORD DELETED *' TO COMMENT.
MOVE DATA-LINE TO PRINT-DATA.
PERFORM PRINT-L1NE-QUT.
342
-------
PERFORM MOVE-SPACES THRU PR INT-LINF-OUT.
ADD 1 TO DELETE-CT.
PERFORM PAGE-OVFLDW.
IF UPOATE-FLAG = 0 THEN
GO TO READ-INPUT.
HOVE INPUT-KEY TD CM-NOMINAL.
READ COST-MATRIX-FILE INVALID KEY
GO TO READ-INPUT.
M.UVE ZEROS TO MATCH-CODE, AMOUNTS.
MOVE HIGH-VALUE TO DELETE-POS.
REWRITE CM-REC.
GO TO READ-INPUT.
PAGE-OVFLOW.
IF L1NE-CT NOT < MAX-LINE THEN
PERFORM WRITE-HEADIUGS.
MOVE-SPACES.
MOVE SPACES TO PRINT-LINE.
PRINT-L1NE-GUT.
WRITE PRINT-LINE BEFORE 1.
ADD 1 TO LINE-CT.
MOVE-AMTS-IN-TO-AMT5-OUT.
MOVE AMTS-IN (I) TO AMTS-OUT OF AMOUNTS-OUT
MOVE-CM-AMTS-OUT .
MOVE AMTS (I) TO AMTS-DUT OF AMOUNTS-OUT (I
MOVE-AMTS-IN-TO-D1SK-AMTS.
MOVE AMTS-IN (I) TO AMTS (I).
READ-CARD-IN.
READ CARD-IN AT END
GO TO WRITE-RECORD-COUNTS.
READ-TAPE-IN.
READ TAPE-IN AT END
GO TO WRITE-RECORD-COUNTS.
MOVE TAPE-REC TO INPUT-REC.
OPEN-TAPE-FILE .
OPEN INPUT TAPE-IN.
WRITE-RECORD-COUNTS.
MOVE SPACES TO DATA-LINE.
PERFORM MOVE-SPACES.
WRITE PRINT-LINE BEFORE NEW-PAGE.
(I)
MOVE
MOVE
MOVE
MOVE
MOVE
MOVE
MOVE
MOVE
MOVE
MOVE
MOVE
•I
•A
•C
•D
'E
TO CODE-NAME OF AMOUNTS-OUT (1).
TO CODE-NAME OF AMUUNTS-OUT (2).
TO CODE-NAME OF AMUUNTS-OUT (3).
TO CODE-NAME OF AMOUNTS-OUT (4).
TO CODE-NAME OF AMOUNTS-OUT (5).
INPUT-CT TO AMTS-OUT OF AMOUNTS-OUT
ADD-CT TO AMTS-OUT OF AMOUNTS-OUT
CHANGE-CT TO AMTS-OUT OF AMOUNTS-OUT
DELETE-CT TO AMTS-OUT OF AhOUNTS-DUT
ERROR-CT TO AMT5-OUT OF AMOUNTS-OUT
DATA-LINE TO PRINT-DATA.
(1
(2
(3
K
(5
343
-------
PERFORM PRINT-LINE-OUT.
PERFORM MOVE-SPACES THRU PR 1NT-LINE-OUT.
IF UPDATE-FLA& = 1 THEN
MOVE •*** COST MARTIX FILE UPDATED ***' TO PRINT-DATA
ELSE MOVE '*** COST MATRIX FILE NOT UPDATED ***' TO
PRINT-DATA.
PERFORM PRINT-LINE-OUT.
CLOSE-TAPE-FILE.
IF INPUT-DEVICE = 0 THEN
GO TO CLOSE-FILES.
CLOSE TAPE-IN.
CLOSE-FILES.
CLOSE COST-MATRIX-FILE,
CARD-IN,
PRINT-OUT.
E-O-J.
STOP RUN.
344
-------
TECHNICAL REPORT DATA
(Please read Instructions on the reverse before completing)
REPORT NO.
EPA-60Q/2-80-012b
3. RECIPIENT'S ACCESSION NO.
I. TITLE AND SUBTITLE
DEVELOPMENT AND APPLICATION OF A WATER SUPPLY
COST ANALYSIS SYSTEM
Volume II
5. REPORT DATE
July 1980 (Issuing Date)
6. PERFORMING ORGANIZATION CODE
7. AUTHOR(S)
James I. Gillean, Rex D. Osborn, William L. Britton, Jr
Robert M. Clark
8. PERFORMING ORGANIZATION REPORT NO.
9. PERFORMING ORGANIZATION NAME AND ADDRESS
ACT Systems Inc.
Winter Park, Florida 32789
10. PROGRAM ELEMENT NO.
H61C1C SOS#1, Task 39
11. CONTRACT/GRANT NO.
68-03-2506
12. SPONSORING AGENCY NAME AND ADDRESS
Municipal Environmental Research Laboratory—Cin. ,OH
Office of Research and Development
U.S. Environmental Protection Agency
Cincinnati, Ohio 45268
13. TYPE OF REPORT AND PERIOD COVERED
Final Report 9/78-9/79
14. SPONSORING AGENCY CODE
EPA/600/14
15. SUPPLEMENTARY NOTES
See also Volume I
Project Officer:
(EPA-600/2-80-012a)
Robert M. Clark (513)
684-7488
16. ABSTRACT
A cost analysis for system water supply utility management has been developed and
implemented in Kenton County, Kentucky, Water District No. 1. The system descrip-
tion is contained in Volume I of the two volume report resulting from the study.
This volume (Volume II) contains the program documentation for the cost analysis
system.
17.
KEY WORDS AND DOCUMENT ANALYSIS
DESCRIPTORS
b.IDENTIFIERS/OPEN ENDED TERMS
COSATI Field/Group
Accounting
Computer Program
Cost Analysis
Cost Center
Cost Effectiveness
Cost Engineering
Water Supply
Product Costing
13B
18. DISTRIBUTION STATEMENT
Release to Public
19. SECURITY CLASS (This Report)
unclassified
21. NO. OF PAGES
3 SI
20 SECURITY CLASS (This page)
unclassified
22. PRICE
EPA Form 2220-1 (Rev. 4-77)
34;
<• 7 -1 tj '-> I 00 3 7
------- |