File Creation with RMCobol

Don Johnston · 11-14-2012, 07:50 AM

I am having a problem creating files in RMCobol. I am trying to create line sequential TXT files for transfer to a dos server. The progtram bombs with an unexpected character that can not be accepted in a Line Sequential file. Is there any way around this?

sundialsvcs · 11-14-2012, 08:25 AM

Code:

Identification Division.
Program-id. Show-me.
Environment division.
Data division.
Procedure division.
        Display "show us the code and the exact error-message" upon console.
        Stop run.

Don Johnston · 11-15-2012, 09:38 AM

Here is the Software both File Layout and Source code

******************** GRAVESITE FILE DESCRIPTION (CGRAVESITE)***********
*
FD TGRAVESITE
RECORD CONTAINS 534 CHARACTERS
LABEL RECORD IS STANDARD.
01 TGRAVESITE-REC.
05 TRVS-COMPANY-CODE PIC X(8).
05 TRVS-CEMETERY PIC X.
05 TRVS-UNIT PIC XXX.
05 TRVS-FLOOR PIC XXX.
05 TRVS-SECTION PIC X(7).
05 TRVS-ROW-RANGE PIC X(6).
05 TRVS-PLOT PIC X(18).
05 TRVS-GRAVES-FROM PIC X(5).
05 TRVS-GRAVES-TO PIC X(5).
05 TRVS-WIDTH PIC 99.
05 TRVS-UNIFORM-WIDTH PIC X.
05 TRVS-AN-ACCOUNT PIC X(10).
05 TRVS-AR-ACCOUNT PIC X(10).
05 TRVS-CONTRACT-DATE PIC 9(8).
05 TRVS-ORIGINAL-NO-GRAVES PIC 999.
05 TRVS-ORIGINAL-SIZE PIC 99.
05 TRVS-REVISED-NO-GRAVES PIC 999.
05 TRVS-REVISED-SIZE PIC 99.
05 TRVS-PRE-NEED PIC X.
05 TRVS-ENDOWED-CARE-PAID-DATE PIC 9(8).
05 TRVS-TYPE PIC X.
05 TRVS-ENDOWED-CARE-AMT PIC 9(7)V99.
05 TRVS-COST-OF-GRAVE PIC 9(7)V99.
05 TRVS-PURCHASE-RECEIPT-NO PIC X(10).
05 TRVS-CRYPT-TYPE PIC X(8).
05 TRVS-RT-OF-BURIAL-DATE PIC 9(8).
05 TRVS-AFFIDAVIT-FLAG PIC X.
05 TRVS-EC-RECEIPT-NUMBER PIC X(10).
05 TRVS-FLAT-MARKER-ONLY PIC X.
05 TRVS-DO-NOT-SELL PIC X.
05 TRVS-NO-OF-INTERMENTS PIC 99.
05 TRVS-FOUNDATION-INCLUDED PIC X.
05 TRVS-LENGTH PIC 9(3).
05 TRVS-B-TYPE-CARE PIC X.
05 TRVS-LAST-NAME PIC X(30).
05 TRVS-FIRST-NAME PIC X(35).
05 TRVS-LAST-NAME-2 PIC X(30).
05 TRVS-FIRST-NAME-2 PIC X(35).
05 TRVS-VALID-FILLER PIC X(64).
05 TRVS-CONTRACT-FLAG PIC X.
05 TRVS-NAME-2-FLAG PIC X.
05 TRV-FILLER PIC X(165).
05 TRVS-DELETE-CODE PIC X.
************** END OF TGRAVESITE FD *******************************
IDENTIFICATION DIVISION.
PROGRAM-ID. XGRAVESITE.
* 10/24/94 JSS COMMENTS FILE MAINTENANCE FOR ab" GRAVESITE
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
COPY CCOMPUTR.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*
SELECT GRAVESITE
ASSIGN TO RANDOM "GRAVESITE"
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS GRVS-KEY
FILE STATUS IS FILESTATUS.
SELECT OPTIONAL TGRAVESITE
ASSIGN TO OUTPUT "/u/cc/tfr/TGRAVESITE"
ORGANIZATION IS LINE SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS FILESTATUS.
DATA DIVISION.
FILE SECTION.
*
COPY CGRAVESITE.
/
COPY CTGRAVESITE.
*
WORKING-STORAGE SECTION.
01 ADDED-FIELDS.
05 CANCEL-INQUIRY PIC X.
05 E-PAUSE PIC X.
05 EOF-SW PIC X.
05 CALL-ERROR-KEY PIC X(15).
05 CALL-ERROR-KEY-R REDEFINES CALL-ERROR-KEY.
10 CALL-ERROR-FD PIC X(10).
10 CALL-ERROR-PID PIC X(4).
10 CALL-ERROR-CONT PIC X.
05 FILESTATUS PIC XX.
05 FILESTATUS2 PIC XX.
05 SAVE-COMPANY-CODE PIC X(8).
05 SAVE-FUNCTION PIC X.
05 SUB PIC 99.
05 SUB1 PIC 99.
05 TMP-SUB PIC 99.
05 VALID-CODE PIC X.
05 VALID-DATA PIC X.
05 VALID-START PIC X.
05 WS-AFFD-KEY PIC X(56).
05 CALL-GRAVESITE-KEY-R REDEFINES WS-AFFD-KEY.
10 CALL-COMPANY-CODE PIC 9(8).
10 CALL-REST PIC X(48).
/
PROCEDURE DIVISION.
002900* DECLARATIVES.
003000* POHDR-ERROR-0 SECTION.
003100* USE AFTER STANDARD EXCEPTION PROCEDURE ON I-O.
003200* I-O-ERROR-ROUTINE.
003300* DISPLAY GRVS-GRAVESITE.
003900*
004000* CLOSE GRAVESITE TGRAVESITE.
* ERROR-EXIT.
004100* STOP RUN.
004200*
004400* END DECLARATIVES.
002900
******************************************************************
MAIN SECTION.
M100.
OPEN INPUT GRAVESITE.
OPEN EXTEND TGRAVESITE.
CLOSE TGRAVESITE.
OPEN OUTPUT TGRAVESITE.
M200.
*
PERFORM DRIVING.
M300.
CLOSE GRAVESITE.
CLOSE TGRAVESITE.
M-EXIT.
EXIT.
*-----------------------------------------------------------------
DRIVING SECTION.
D100.
MOVE "N" TO EOF-SW.
MOVE "N" TO CANCEL-INQUIRY.
MOVE "N" TO VALID-CODE.
PERFORM START-FILE.
IF VALID-START = 'N'
GO TO D-EXIT.
PERFORM READ-GRAVESITE-RECORD.
STOP RUN.
*
D-EXIT.
EXIT.
*----------------------------------------------------------------
READ-GRAVESITE-RECORD SECTION.
GAD100.
MOVE "Y" TO VALID-DATA.
READ GRAVESITE NEXT
AT END GO TO GAD-EXIT.
IF FILESTATUS = "99"
MOVE "N" TO VALID-DATA
GO TO GAD-EXIT.
IF FILESTATUS = "23"
MOVE "N" TO VALID-DATA
GO TO GAD-EXIT.
IF FILESTATUS NOT = '00'
GO TO GAD100.
IF GRVS-CONTRACT-DATE LESS THAN 0 OR GREATER THAN 99999999
GO TO GAD100.
IF GRVS-COMPANY-CODE NOT = '1 '
GO TO GAD100.
IF GRVS-CEMETERY = '1' AND GRVS-CEMETERY NOT = '2'
AND GRVS-CEMETERY NOT = '3' AND GRVS-CEMETERY NOT = '4'
AND GRVS-CEMETERY NOT = '5'
GO TO GAD100.
MOVE GRVS-COMPANY-CODE TO TRVS-COMPANY-CODE.
MOVE GRVS-CEMETERY TO TRVS-CEMETERY.
MOVE GRVS-UNIT TO TRVS-UNIT.
MOVE GRVS-FLOOR TO TRVS-FLOOR.
MOVE GRVS-SECTION TO TRVS-SECTION.
MOVE GRVS-ROW-RANGE TO TRVS-ROW-RANGE.
MOVE GRVS-PLOT TO TRVS-PLOT.
MOVE GRVS-GRAVES-FROM TO TRVS-GRAVES-FROM.
MOVE GRVS-GRAVES-TO TO TRVS-GRAVES-TO.
MOVE GRVS-WIDTH TO TRVS-WIDTH.
MOVE GRVS-UNIFORM-WIDTH TO TRVS-UNIFORM-WIDTH.
MOVE GRVS-AN-ACCOUNT TO TRVS-AN-ACCOUNT.
MOVE GRVS-AR-ACCOUNT TO TRVS-AR-ACCOUNT.
MOVE GRVS-CONTRACT-DATE TO TRVS-CONTRACT-DATE.
MOVE GRVS-ORIGINAL-NO-GRAVES TO TRVS-ORIGINAL-NO-GRAVES.
MOVE GRVS-ORIGINAL-SIZE TO TRVS-ORIGINAL-SIZE.
MOVE GRVS-REVISED-NO-GRAVES TO TRVS-REVISED-NO-GRAVES.
MOVE GRVS-REVISED-SIZE TO TRVS-REVISED-SIZE.
MOVE GRVS-PRE-NEED TO TRVS-PRE-NEED.
MOVE GRVS-ENDOWED-CARE-PAID-DATE TO
TRVS-ENDOWED-CARE-PAID-DATE.
MOVE GRVS-TYPE TO TRVS-TYPE.
MOVE GRVS-ENDOWED-CARE-AMT TO TRVS-ENDOWED-CARE-AMT.
MOVE GRVS-COST-OF-GRAVE TO TRVS-COST-OF-GRAVE.
MOVE GRVS-PURCHASE-RECEIPT-NO TO TRVS-PURCHASE-RECEIPT-NO.
MOVE GRVS-CRYPT-TYPE TO TRVS-CRYPT-TYPE.
MOVE GRVS-RT-OF-BURIAL-DATE TO TRVS-RT-OF-BURIAL-DATE.
MOVE GRVS-AFFIDAVIT-FLAG TO TRVS-AFFIDAVIT-FLAG.
MOVE GRVS-EC-RECEIPT-NUMBER TO TRVS-EC-RECEIPT-NUMBER.
MOVE GRVS-FLAT-MARKER-ONLY TO TRVS-FLAT-MARKER-ONLY.
MOVE GRVS-DO-NOT-SELL TO TRVS-DO-NOT-SELL.
MOVE GRVS-NO-OF-INTERMENTS TO TRVS-NO-OF-INTERMENTS.
MOVE GRVS-FOUNDATION-INCLUDED TO TRVS-FOUNDATION-INCLUDED.
MOVE GRVS-LENGTH TO TRVS-LENGTH.
MOVE GRVS-B-TYPE-CARE TO TRVS-B-TYPE-CARE.
MOVE GRVS-LAST-NAME TO TRVS-LAST-NAME.
MOVE GRVS-FIRST-NAME TO TRVS-FIRST-NAME.
MOVE GRVS-LAST-NAME-2 TO TRVS-LAST-NAME-2.
MOVE GRVS-FIRST-NAME-2 TO TRVS-FIRST-NAME-2.
MOVE GRVS-VALID-FILLER TO TRVS-VALID-FILLER.
MOVE GRVS-CONTRACT-FLAG TO TRVS-CONTRACT-FLAG.
MOVE GRVS-NAME-2-FLAG TO TRVS-NAME-2-FLAG.
MOVE SPACES TO TRV-FILLER.
if GRVS-DELETE-CODE not = ' '
GO TO GAD100
ELSE
MOVE 'A' to TRVS-DELETE-CODE.
WRITE TGRAVESITE-REC.
IF FILESTATUS = '97'
GO TO GAD100
ELSE
GO TO GAD100.
GAD-EXIT.
EXIT.
*-----------------------------------------------------------------
START-FILE SECTION.
SF100.
MOVE "Y" TO VALID-START.
INITIALIZE GRAVESITE-REC.
MOVE SPACES TO CALL-REST.
MOVE 1 TO CALL-COMPANY-CODE.
MOVE WS-AFFD-KEY TO GRVS-KEY.
START GRAVESITE
KEY NOT < GRVS-KEY.
IF FILESTATUS = "99"
GO TO SF100.
IF FILESTATUS = "23"
MOVE "N" TO VALID-START.
IF VALID-START = "Y"
GO TO SF-EXIT.
123456 SF-EXIT.
EXIT.
*- - - - - - - - - - - END OF XGRAVESITE - - - - - - - - - - - - -

Don Johnston · 11-15-2012, 12:18 PM

How can I check for invalid data outside the normal ascii range in COBOL?

colucix · 11-15-2012, 01:42 PM

Moved: This thread is more suitable in Programming and has been moved accordingly to help your thread/question get the exposure it deserves.

sundialsvcs · 11-16-2012, 07:01 AM

The real question should be .. where is that data coming from? What is it, and why is it there?

No, I'm serious.

Don Johnston · 11-16-2012, 09:39 AM

The files are on a Red Hat Linux system and they are TRUE TYPE data files. The true type format is Black Serif 9 Point. The data is a carry over from an old NCR system. It was moved to Linux box in 2001 and the file type was never changed. Is there any way I can scn the records for bad data prior to copying the records out. When i load the records as a straight sequential file I get a record length of 3,192 bytes. There are 6 records on each line with not ending CR or LF. Any help will be greatly appreciated.

sundialsvcs · 11-16-2012, 05:51 PM

The absence of CR/LF on each and every record is, of course, what's clobbering the software's expectations, and therefore, unfortunately, the software.

If possible, try to trace the problem up-stream to its root cause: there must be an explanation somewhere as to why those records are "different." The main reason why I say this is that, well, a digital computer executing (bug free(!)) software really doesn't know the word, "different." (There is no if..then..else..but_every_so_often statement that I know of, or want to.)

You could, of course, "fix" the file, although I wouldn't spend too much time in COBOL doing what presumably could be done with a script in another language. But, y'know, in order to "fix it," you'd have to have a bright-line rule, such as all computer-software requires. And this file, "inexplicably" ... well, it really just comes down to "inexplicably."

You've got an inconsistent input-file. That means that somewhere out there you've got an inconsistent (i.e. "buggy") program that's producing it. Unfortunately, that's inexcusable. Your program, presumably, is working correctly, and is sounding an alarm that just can't wisely be ignored by the business.

Don Johnston · 11-20-2012, 08:23 AM

The problem is definitely the missing end of record characters. I am now creating the file as strictly sequential and I insert @@ characters at the end. I then use sed --e 's/@@/\xOA/g' file1 file2 to replace the @@ with hex OA which is LF in Linux. I seems to work. On the last go around though it is displaying all the records. Why I don't know! Can you help.

Don Johnston · 11-29-2012, 08:00 AM

The answer to the problem lies in the creation of the file. Depending on the type of data stored, be it packed or nonpacked, the created file will either be sequential or line sequential. The former type will have two disrincty characters added to it which are to be replaced by a hex 0A using sed. The latter will have a 'CR LF' inserted using unix2dos -c ascii File1. These can then be FTPd to an i series or windows system.