I have PS flat file with 14 records. I want to read from
4th to 9th record and want to write those 6 records (4th
record to 9th record) to another PS file (output file).
there is no key defined in the input file. I just want read
a certain Consecutive records. can any one please give me
the procedure division Coding for this. I have coded the
below coding but the READ-PARA is performing only 1 time
even though I have 14 records in my input file (i.e FILE-1):

PROCEDURE DIVISION.
A000-SECTION.
MOVE 0 TO I.
OPEN INPUT FILE-1.
IF CHECK-KEY1 > 0
DISPLAY "OPEN ERROR FOR FILE-1, CODE IS:" CHECK-KEY1
END-IF.
OPEN EXTEND NEWFILE-1
IF CHECK-KEY3 > 0
DISPLAY "OPEN ERROR FOR NEWFILE-1 COD IS" CHECK-KEY3
END-IF.
PERFORM READ-PARA THRU EXIT-PARA UNTIL EOF-REC = 'YES'.
DISPLAY " FINALLY OUT OF LOOP"
CLOSE FILE-1
CLOSE NEWFILE-1
STOP RUN.
READ-PARA.
ADD 1 TO I
READ FILE-1
AT END MOVE 'YES' TO EOF-REC
IF I > 3 AND < 10
PERFORM WRITE-PARA
ELSE
DISPLAY "NOT IN RANGE"
END-IF.
EXIT-PARA.
EXIT.
WRITE-PARA.
WRITE NEW-REC FROM FILE1-REC.


Answers were Sorted based on User's Feedback



I have PS flat file with 14 records. I want to read from 4th to 9th record and want to write those..

Answer / vinayagamoorthy

Hi ,

You don't need a oobol Program itself for this instead you
could use IDCAMS PROGRAM and REPRO Coomand with the control
parameters like SKIP and COUNT to achieve the above task.

//J1 JOB NOTFIFY=TCHN003
//S1 EXEC PGM=IDCAMS
//F1 DD DSN=FILE1,DISP=SHR ---> INP FILE
//F2 DD DSN=FILE2,DISP=SHR ---> OUT FILE
//SYSIN DD *
REPRO INFILE(F1) OUTFILE(F2) -
SKIP(3) -
COUNT(6)
/*
//

Is This Answer Correct ?    23 Yes 2 No

I have PS flat file with 14 records. I want to read from 4th to 9th record and want to write those..

Answer / swetha

could nt we use just a sort step?

//SPLITFLS EXEC PGM=SORT
//SYSPRINT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//SYSUDUMP DD SYSOUT=*
//SORTIN DD DSN=FILE1...,DISP=SHR
//SORTOF02 DD DSN=OUTPUTFILE2..............,
// DISP=(NEW,CATLG,DELETE),UNIT=SYSDA,
// SPACE=(CYL,(1,1),RLSE),
// RECFM=FB,LRECL=20
//SYSIN DD *
sort fields=copy
outfil files=file2,startrec=4,endrec=9
/*

please correct me if i missed a point.

Is This Answer Correct ?    13 Yes 1 No

I have PS flat file with 14 records. I want to read from 4th to 9th record and want to write those..

Answer / vikas

Hi ,,,, i think here you need to include one more line i.e.
NOT AT END in READ statement.
Beacuse it is taking all loops under READ as part of AT END
condition.

like...

READ FILE-1
AT END
MOVE 'YES' TO EOF-REC
NOT AT END
IF I > 3 AND < 10
PERFORM WRITE-PARA
ELSE
DISPLAY "NOT IN RANGE"
END-IF
END-READ.


try this ....

Is This Answer Correct ?    5 Yes 1 No

I have PS flat file with 14 records. I want to read from 4th to 9th record and want to write those..

Answer / praveen bejjanki

In order to achieve this, simply we can use sort utility as
shown below.
//stepname exec pgm=sort
//sortin dd dsn=inputfile,disp=-do-
//sortout dd dsn=outputfile,disp=-do-
//sysprint dd sysout=*
//sysin dd *
sort fields=copy
skiprec=3
stopaft=6
/*
I hope this will answer your question, if it is related to
JCL

Is This Answer Correct ?    4 Yes 1 No

I have PS flat file with 14 records. I want to read from 4th to 9th record and want to write those..

Answer / mike

you are missing a period after AT END MOVE 'YES' TO EOF-REC

The if statement IF I > 3 and < 10 is considered part of
the AT END condition.

Is This Answer Correct ?    4 Yes 4 No

I have PS flat file with 14 records. I want to read from 4th to 9th record and want to write those..

Answer / satishk

HI FRIENDS,
AS U MENTIONED THAT, IT WAS A PS-FILE,SO IN UR COBOL
PROGRAM, U HAVE DECLARED AN KEY-VARIABLE IN INPUT-PS-FILE.
WELL, SO, YOUR WAY OF APPROACH WAS WRONG.
HERE IS THE RIGHT CONCEPT:
In a PS-FILE, you cannot use any key-variable. only record-
number if you have defined for a particular record can be
moved, so that,a particular record can be moved with its
record-number.
In order to move your choice of records to be moved to any
other file, try to make use of VSAM-Files, which enables
you to define your own set of records to be moved from one
dataset to other, by using either IDCAMS utility, SKIP AND
COUNT in your JCL, (OR) making your cobol code using the
key-variables set to your fixed number of choice of record-
index between the range of your choice of records.

well, these are the only possibilities to move records from
one file to other file.

Is This Answer Correct ?    1 Yes 2 No

I have PS flat file with 14 records. I want to read from 4th to 9th record and want to write those..

Answer / guest

at the end of the Read stmt u need to put end-if or period.
juz try it after mentioning any one of the above.

Is This Answer Correct ?    0 Yes 1 No

I have PS flat file with 14 records. I want to read from 4th to 9th record and want to write those..

Answer / gowd

AS YOU ARE USING NORMAL PS FILE U CANT ACCESS THE RECORD
FROM THE MIDDLE. THE SEQUENTIAL FILE PROCESS IN SEQUENCE
ORDER FROM FIRST RECORD ONWARDS. U MENTIONED A KEY IN THE
PROGRAM IT DOES NOT ALLOW ANY KEY IN THE SEQUENTIAL FILE.
THROUGH COBOL U CANT ACCESS THIS. FROM JCL U CAN GET IT AS
ONE OF OUR FRIEND CODED THROUGH THE "REPRO".

Is This Answer Correct ?    0 Yes 1 No

Post New Answer

More COBOL Interview Questions

How to declare if emp-name = AAAAA""BBB in working-storage section. After display emp-name should print like AAAAA""BB

6 Answers   Polaris,


Can we move X(7) to S9(7) COMP?

1 Answers  


Using string statement.Is coding three destination string from one source string possible in one code?or three codes for every destination string of one source string.?thank you

1 Answers   BPL,


What is the difference between performing a SECTION and a PARAGRAPH?

5 Answers   Accenture, Patni,


What are declaratives and what are their uses in cobol?

0 Answers  






If there are two copybooks which have same variables and we are using both the copybooks in our program. will there be an error and if i move values to the variable which copybook varibales gets the values i move in.

3 Answers   CTS,


can you declare redefine in level 01?

8 Answers   Patni,


Will the variable POS in the following code have a value of 2 or not? 01 POS PIC S9(4) COMP VALUE 2. 01 FIRST-NAME PIC X(10) VALUE 'ABC'. 01 LAST-NAME PIC X(10) VALUE 'XYZ'. 01 NAME PIC X(20) VALUE SPACES. STRING FIRST-NAME DELIMITED BY SPACES ' ' DELIMITED BY SIZE LAST-NAME DELIMITED BY SPACES INTO NAME WITH POINTER POS

2 Answers  


How do you reference the following file formats from cobol programs?

0 Answers  


I want ALL ERROR codes in VSAM

3 Answers   American Express, TCS,


what is ASRA, AEY9?

2 Answers   IBM,


how do you reference the variable block file formats from cobol programs

0 Answers  


Categories