IBM Mainframe Forum Index
 
Register
 
IBM Mainframe Forum Index Mainframe: Search Log in to check your private messages Log in
 

sample report program


 
IBM Mainframe Forums -> COBOL Programming
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
kiran_65

New User


Joined: 01 Apr 2005
Posts: 46

PostPosted: Sat Jun 06, 2015 4:19 pm
Reply with quote

Hi,
I have the sample program. could you please let me know if there are any errors. Also can you please let me know if the statement

"WRITE DETAIL-LINE FROM COLUMN-1" as COLUMN1 variable is used to write heading and DETAIL-LINE is for date.

IDENTIFICATION DIVISION.
PROGRAM-ID. FRUITCNT.
AUTHOR. -------.
*****************************************************************
* PROGRAM TO PRINT THE NUMBER OF APPLES, BANANAS AND ORANGES
* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
*
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.

SELECT IN-FILE
ASSIGN TO INFILE
ORGANIZATION IS INDEXED
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS IN-KEY
FILE STATUS IS IN-FILE-STATUS.

SELECT REPORT-FILE
ASSIGN TO RPTPRINT.

*****************************************************************
DATA DIVISION.
FILE SECTION.

FD IN-FILE
LABEL RECORDS ARE STANDARD
RECORD CONTAINS 125 CHARACTERS.
01 INPUT-RECORD.
05 IN-TYPE PIC X(04).
05 FILLER PIC X(121).

FD REPORT-FILE
LABEL RECORDS ARE STANDARD
BLOCK CONTAINS 0 RECORDS.
01 REPORT-LINE.
05 REPORT-DATA PIC X(132).

*****************************************************************
WORKING-STORAGE SECTION.

* Remember INPUT-AREA is used in other programs
* This can be replaced with Copybook.
COPY WS-INPUT
* 01 INPUT-AREA.
* 05 INPUT-TYPE PIC XXXX VALUE SPACES.
* 05 INPUT-COUNT PIC 999999 VALUE ZEROS.
* 05 INPUT-FILLER PIC X(115) VALUE SPACES.

01 EOF-INDICATOR PIC X(01) VALUE 'N'.
88 EOF-REACHED VALUE 'Y'.

01 IN-FILE-STATUS PIC X(02) VALUE SPACES. V

01 A-COUNT PIC 9(05).
01 B-COUNT PIC 9(05).
01 O-COUNT PIC 9(05).
01 OTH-COUNT PIC 9(02).

01 HEADER-LINE-1.
05 FILLER PIC X(02) VALUE SPACES.
05 PROGRAM-NAME PIC X(07) VALUE 'FRUITCNT'.
05 FILLER PIC X(42) VALUE SPACES.
05 FILLER PIC X(28) VALUE
'ACME FRUIT COMPANY '.
05 FILLER PIC X(22) VALUE SPACES.
05 REPORT-DATE PIC X(10) VALUE SPACES.
05 FILLER PIC XXXXX VALUE SPACES.
05 FILLER PIC XXXX VALUE 'PAGE'.
05 FILLER PIC XX VALUE SPACES.
05 HEADER-PAGE-COUNT PIC ZZZ9 VALUE ZEROS.
05 FILLER PIC XXXXX VALUE SPACES.

01 HEADER-LINE-2.
05 FILLER PIC X(58).
05 HEADER-DISCRIPTION PIC X(16).
05 FILLER PIC X(58).

01 COLUMN-1.
05 FILLER PIC X(04) VALUE SPACES.
05 FILLER PIC X(04) VALUE 'TYPE'.
05 FILLER PIC X(06) VALUE SPACES.
05 FILLER PIC X(04) VALUE 'QUANTITY'
05 FILLER PIC X(08) VALUE SPACES.

01 DETAIL-LINE.
05 FILLER PIC X(02) VALUE SPACES.
05 DETAIL-F-TYPE PIC X(10) VALUE SPACES.
05 FILLER PIC X(04) VALUE SPACES.
05 DETAIL-F-AMT PIC X(04) VALUE SPACES.
05 FILLER PIC X(04) VALUE SPACES.

01 BLANK-LINE PIC X(132) VALUE SPACES.

*****************************************************************
PROCEDURE DIVISION.

OPEN INPUT IN-FILE.

PERFORM A000-GET-DATA THRU A000-EXIT UNTIL EOF-REACHED.

WRITE REPORT-LINE FROM HEADER-LINE-1
AFTER ADVANCING PAGE.
WRITE REPORT-LINE FROM HEADER-LINE-2
AFTER ADVANCING 1 LINE.
WRITE REPORT-LINE FROM COLUMN-1
AFTER ADVANCING 1 LINE.
MOVE 'APPLE' TO DETAIL-F-TYPE
MOVE A-COUNT TO DETAIL-F-AMT
WRITE DETAIL-LINE FROM COLUMN-1
AFTER ADVANCING 1 LINE.
MOVE 'BANANA' TO DETAIL-F-TYPE
MOVE B-COUNT TO DETAIL-F-AMT
WRITE DETAIL-LINE FROM COLUMN-1
AFTER ADVANCING 1 LINE.
MOVE 'ORANGE' TO DETAIL-F-TYPE
MOVE O-COUNT TO DETAIL-F-AMT
WRITE DETAIL-LINE FROM COLUMN-1
AFTER ADVANCING 1 LINE.

CLOSE IN-FILE.

STOP RUN.

*****************************************************************
A000-GET-DATA.

READ IN-FILE AT END
MOVE 'Y' TO EOF-INDICATOR.

IF EOF-REACHED
GO TO A000-EXIT
ELSE
MOVE INPUT-RECORD TO INPUT-AREA
EVALUATE INPUT-TYPE
WHEN 'APPL'
ADD INPUT-COUNT TO A-COUNT
WHEN 'BANA'
ADD INPUT-COUNT TO B-COUNT
WHEN 'ORAN'
ADD INPUT-COUNT TO O-COUNT
WHEN OTHER
ADD INPUT-COUNT TO OTH-COUNT
END-EVALUATE
END-IF.

A000-EXIT.
EXIT.
Back to top
View user's profile Send private message
Akatsukami

Global Moderator


Joined: 03 Oct 2009
Posts: 1789
Location: Bloomington, IL

PostPosted: Sat Jun 06, 2015 4:34 pm
Reply with quote

What happens when you compile it?
Back to top
View user's profile Send private message
kiran_65

New User


Joined: 01 Apr 2005
Posts: 46

PostPosted: Sat Jun 06, 2015 4:42 pm
Reply with quote

I didn't compile as I am not having mainframe in my personal laptop. I have written the program in notepad.

one of my question along with errors is the statement which I have asked would work or not.
Back to top
View user's profile Send private message
Nic Clouston

Global Moderator


Joined: 10 May 2007
Posts: 2429
Location: Hampshire, UK

PostPosted: Sat Jun 06, 2015 6:36 pm
Reply with quote

It is not for us to verify your work. You can get COBOL compilers for your PC - some are free and some are better than others.

Also, after so many years on the board you should know to use the code tags when posting code and data.
Back to top
View user's profile Send private message
Robert Sample

Global Moderator


Joined: 06 Jun 2008
Posts: 8568
Location: Dubuque, Iowa, USA

PostPosted: Sat Jun 06, 2015 8:52 pm
Reply with quote

I don't know where you got that sample program from, but it is rife with errors. A WRITE statement, for example, must use an 01 within an FD so none of the WRITE DETAIL-LINE will work. I don't see an OPEN for the report file, either.

If you are attempting to learn COBOL from this sample program, I strongly recommend you find a better source for your learning. You can also install a free COBOL for your PC as suggested elsewhere.
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic All times are GMT + 6 Hours
Forum Index -> COBOL Programming
Page 1 of 1

 

Search our Forum:

Similar Topics
Topic Forum Replies
This topic is locked: you cannot edit posts or make replies. Sample CICS Webservices Program CICS 1
No new posts Calling Rexx program from Cobol CLIST & REXX 12
No new posts How to define transaction that trigge... CICS 2
No new posts SARBCH REPORT DD writing error CA Products 1
No new posts Call Natural program with rexx CLIST & REXX 2

Back to Top