|
midrange.com
Here is a piece of the Cobol/400 code. It was originally in MicroFocus Cobol
on an RS/6000.
I have changed it to access an (live, working) RPG DDS file on the 400.
When the program runs, I am getting an error 39 on the TFACR file (invalid key).
Please see my notes in RED.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
select tfacr
assign to database-tfacr
organization indexed
access dynamic
record key externally-described-key
file status tfacr-fs.
SELECT PrintFile
assign to disk-prtfil
access sequential
file status printfile-fs.
DATA DIVISION.
FILE SECTION.
fd tfacr
label records are standard.
01 tfacr-record.
COPY DDSR-TFACR00 OF UAVBASEF-TFACR.
* I-O FORMAT:TFACR00 FROM FILE TFACR OF LIBRARY UAVBASEF
* Account Criteria File
*THE KEY DEFINITIONS FOR RECORD FORMAT TFACR00
* NUMBER NAME RETRIEVAL ALTSEQ
* 0001 ATORG ASCENDING NO
* 0002 ATSHAC ASCENDING NO
05 TFACR00.
06 ATORG PIC X(3).
* Origin
06 ATSHAC PIC X(12).
* Ship Account
06 ATCAD1 PIC X(35).
* Customer Address 1
06 ATCAD2 PIC X(35). (remainder of file
omitted for brevity)
PROCEDURE DIVISION.
Begin.
OPEN INPUT tfacr.
if tfacr-fs not = "00"
display "tfacr open error" Error 39
display tfacr-fs.
OPEN OUTPUT PrintFile.
if printfile-fs not = "00"
display "printfile open error" Error 90 (How do I name this
file?)
display printfile-fs. I actually want a flatfile
here, not an actual "printer file"
accept tfacr-fs with update
accept printfile-fs with update
if tfacr-fs = "00" and
printfile-fs = "00"
Mor
display "go "
accept printfile-fs with update
INITIALIZE tfacr-RECORD
MOVE "FM" to atorg
START tfacr KEY NOT < atorg
READ tfacr NEXT RECORD
move headerline to detailline
write detailline
move spaces to detailline
PERFORM PrintReport
UNTIL tfacr-FS = "10".
CLOSE tfacr,
PrintFile.
STOP RUN.
PrintReport.
move atshac to prt-atshac.
move atcad1 to prt-atcad1.
move atcty to prt-atcty.
move atste to prt-atste.
move atzip to prt-atzip.
write detailline.
READ tfacr NEXT RECORD.
* * * * * E N D O F S O U R C E * * *
10 MSGID: LNC0037 SEVERITY: 10 SEQNBR: 001200
Message . . . . : Presence or absence of 'DUPLICATES' phrase for fi
'TFACR' does not match attributes of copied file.
18 MSGID: LNC0848 SEVERITY: 0 SEQNBR: 002400
Message . . . . : The LABEL clause is syntax checked and ignored.
19 MSGID: LNC0929 SEVERITY: 0 SEQNBR: 002600
Message . . . . : The COPY statement used format 2 (DDS translate).
86 MSGID: LNC0848 SEVERITY: 0 SEQNBR: 002900
Message . . . . : The LABEL clause is syntax checked and ignored.
121 MSGID: LNC0412 SEVERITY: 20 SEQNBR: 007400
Message . . . . : INVALID KEY phrase not found in START statement.
Accepted.
122 MSGID: LNC0407 SEVERITY: 20 SEQNBR: 007500
Message . . . . : AT END phrase missing from sequential READ.
Accepted.
135 MSGID: LNC0407 SEVERITY: 20 SEQNBR: 009500
Message . . . . : AT END phrase missing from sequential READ.
Accepted.
135 MSGID: LNC0650 SEVERITY: 0 SEQNBR: 009500
Message . . . . : Blocking/Deblocking for file 'PRINTFILE' will be
performed by compiler-generated code.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
