Page 3 of 3
Re: COBOL file conversion to readable format
Posted:
Fri Apr 21, 2017 3:10 pm
by Aki88
Hello,
I have not gone into the depth of the program, but from what I understood by quick read-through:
• You’re trying to create an interpreted COBOL copybook layout using the program you’ve shared - a layout that removes the gory details such as COMP, COMP-3, OCCURS etc.
• You’re doing this by reading an input dataset which contains some (and not all) elements of a native COBOL copybook
• There are checks built for these elements in the programs; the checks are not extensive
• All of this is being done by individually parsing each byte of text from the input dataset
• The way the data is being converted, it appears that the requirement is to get this entire level segregated copybook into a single row, which can later be converted to CSV
And the requirement now is to handle REDEFINES clause in this code.
To put across a point - for the heck of it - this is a very different requirement compared to the first post of this topic.
Having said that, all that you really need to handle a REDEF clause is understanding that the level redefining a certain field will ALWAYS be preceded by that field. Also when you do encounter the REDEF, why not continue processing the elements as-is like other earlier levels? How do you want to represent it?
Another question, why do all of this at all; what are we going to achieve by this exercise?
Why not use the predefined interpreters tools provided by File-Manager/File-Aid?
Re: COBOL file conversion to readable format
Posted:
Fri Apr 21, 2017 3:41 pm
by NicC
I had the same problem I saved the code just in case but Enrico had obviously done the same thing. It may be possible to get the code tags to work by removingf all the comment lines and the ID and Environment Divisions - I will have a little play later.
What I did notice though were these lines
03 WS-REDEFINES-SET PIC X.
88 REDEFINES-SET VALUE 'Y'.
88 REDEFINES-NOT-SET VALUE 'Y'.
for which the second value shoukd surely be 'N'.
Re: COBOL file conversion to readable format
Posted:
Fri Apr 21, 2017 4:46 pm
by rakeshsneha1212
Hello Aki88,
Please find my response below for your concern.
To put across a point - for the heck of it - this is a very different requirement compared to the first post of this topic.
---> It's the same requirement what i posted initially "conversion of mainframe raw dataset to readable format". But just that i found this program which helps getting to it.
Why not use the predefined interpreters tools provided by File-Manager/File-Aid?
---> i am writing this tool so that business get's the data analysis ease and minimize our manual efforts.
Re: COBOL file conversion to readable format
Posted:
Fri Apr 21, 2017 5:31 pm
by NicC
Actually, if the sole purposre of this copybook is to provide a csv record from a record that was created using the input copybook and there is no further processing of that output record (apart from sending it to a spreadsheet somewhere) then you do not need the redefines. And all you want for all numbers is for them to have USAGE DISPLAY and an explicit decimal point. In fact, you could, possibly, ignore the redefines - they will just be verbage - and have a simple edit macro that will edit the current copy book as follows:
change all COMP-x to ''
change all 9V9 to 9.9 (and ...9V(,,)9 etc)
save the copybook with a new name
cancel the edit (to preserve the input copybook)
Re: COBOL file conversion to readable format
Posted:
Fri Apr 21, 2017 5:53 pm
by NicC
I think the problem is with the colouriser - the code below would not preview if code=mainframe was used but does with code=old. This post has 991 lines, when reduced to 949 lines it would work with the colouriser.
<lines deleted>
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT COPY-FILE
ASSIGN TO ICOPY
FILE STATUS IS WS-FS-ICOPY.
DATA DIVISION.
FILE SECTION.
FD COPY-FILE
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS STANDARD
RECORDING MODE IS F.
01 ICOPY-REC PIC X(80).
WORKING-STORAGE SECTION.
01 WS-FS-FILE-STATUS-VARS.
03 WS-FS-ICOPY PIC X(02).
88 ICOPY-OK VALUE '00'.
88 ICOPY-EOF VALUE '10'.
01 ARRAY-ELEMENTS PIC 9999 VALUE ZERO.
01 ARRAY-ELEMENTS-D PIC 9999 VALUE ZERO.
01 WS-ARRAY.
02 ARRAY-DATA OCCURS 9999.
03 ARRAY-WHOLE-LINE PIC X(132).
03 ARRAY-LEVEL PIC 99.
03 ARRAY-DATA-FIELD PIC X.
03 ARRAY-SAS-NO PIC 9999.
03 ARRAY-FIELD-NAME PIC X(35).
03 ARRAY-REDEFINE-NAME PIC X(35).
03 ARRAY-REDEFINE PIC X.
03 ARRAY-FIELD-TYPE PIC X.
03 ARRAY-SIGNED PIC X.
03 ARRAY-WHOLE PIC 9999.
03 ARRAY-DECIMALS PIC 9999.
03 ARRAY-LENGTH PIC 9999.
03 ARRAY-START-POS PIC 9(5).
03 ARRAY-CUM PIC 9(5).
03 ARRAY-NO-OF-OCCURS PIC 9.
03 ARRAY-OCCURS-L1 PIC 999.
03 ARRAY-OCCURS-L2 PIC 999.
03 ARRAY-OCCURS-L3 PIC 999.
03 ARRAY-SAS-DATA PIC X(80).
01 WS-ANALYSING-VARIABLES.
03 DATA-LENGTH PIC 999.
03 TEMP-SAS-NAME PIC X(35).
03 COPY-REC PIC X(132).
03 TEMP-COPY-REC PIC X(66).
03 WS-DONE PIC X.
88 DONE VALUE 'Y'.
03 WS-TEMP-START PIC 9.
03 WS-START PIC 99999.
03 WS-END PIC 99999.
03 WS-LENGTH PIC 99999.
03 WS-TEMP.
05 WS-TEMP-NUMERIC PIC 9999.
03 WS-FIELD-NAME-POS-START PIC 999.
03 WS-FIELD-NAME-POS-END PIC 999.
03 WS-FIELD-NAME-FOUND PIC X.
88 FIELD-NAME-NOT-FOUND VALUE 'N'.
88 FIELD-NAME-FOUND VALUE 'Y'.
03 WS-LEVEL-POS PIC 999.
03 WS-LEVEL PIC 99.
03 WS-LEVEL-FOUND PIC X.
88 LEVEL-NOT-FOUND VALUE 'N'.
88 LEVEL-FOUND VALUE 'Y'.
03 WS-COMP-FOUND PIC X.
88 COMP-FOUND VALUE 'Y'.
88 COMP-NOT-FOUND VALUE 'N'.
03 WS-COMP-1-FOUND PIC X.
88 COMP-1-FOUND VALUE 'Y'.
88 COMP-1-NOT-FOUND VALUE 'N'.
03 WS-COMP-2-FOUND PIC X.
88 COMP-2-FOUND VALUE 'Y'.
88 COMP-2-NOT-FOUND VALUE 'N'.
03 WS-COMP-3-FOUND PIC X.
88 COMP-3-FOUND VALUE 'Y'.
88 COMP-3-NOT-FOUND VALUE 'N'.
03 WS-OCCURS-POS PIC 999.
03 WS-OCCURS-FOUND PIC X.
88 OCCURS-FOUND VALUE 'Y'.
03 WS-DISPLAY-FOUND PIC X.
88 DISPLAY-FOUND VALUE 'Y'.
03 WS-PLUS-FOUND PIC X.
88 PLUS-FOUND VALUE 'Y'.
03 WS-REDEFINES-NAME PIC X(35).
03 WS-REDEFINES-POS PIC 999.
03 WS-REDEFINES-LEVEL PIC 99 VALUE 99.
03 WS-REDEFINES-FOUND PIC X.
88 REDEFINES-FOUND VALUE 'Y'.
03 WS-REDEFINES-SET-START PIC 999999.
03 WS-REDEFINES-SET PIC X.
88 REDEFINES-SET VALUE 'Y'.
88 REDEFINES-NOT-SET VALUE 'Y'.
03 WS-FULLSTOP-FOUND PIC X.
88 FULLSTOP-FOUND VALUE 'Y'.
88 FULLSTOP-NOT-FOUND VALUE 'N'.
03 WS-DATA-FOUND PIC X.
88 DATA-FOUND VALUE 'Y'.
03 WS-FLAG-SET PIC X.
88 FLAG-SET VALUE 'Y'.
03 WS-PIC-POS PIC 999.
03 WS-PIC-FOUND PIC X VALUE 'N'.
88 PIC-NOT-FOUND VALUE 'N'.
88 PIC-FOUND VALUE 'Y'.
03 WS-SIGN-FOUND PIC X.
88 SIGN-FOUND VALUE 'Y'.
88 SIGN-NOT-FOUND VALUE 'N'.
03 WS-DECIMAL-POS PIC 9999.
03 WS-DECIMAL-PLACES PIC 9999.
03 WS-DECIMAL-FOUND PIC X.
88 DECIMAL-FOUND VALUE 'Y'.
88 DECIMAL-NOT-FOUND VALUE 'N'.
03 WS-NEGATIVE-FOUND PIC X.
88 NEGATIVE-FOUND VALUE 'Y'.
88 NEGATIVE-NOT-FOUND VALUE 'N'.
03 WS-CHARS PIC 9999.
03 WS-CHAR-POS PIC 999.
03 WS-CHAR-FOUND PIC X.
88 CHAR-FOUND VALUE 'Y'.
88 CHAR-NOT-FOUND VALUE 'N'.
03 WS-WHOLE PIC 9999.
03 WS-WHOLE-POS PIC 999.
03 WS-WHOLE-FOUND PIC X.
88 WHOLE-FOUND VALUE 'Y'.
88 WHOLE-NOT-FOUND VALUE 'N'.
03 WS-SUB PIC 9999.
03 WS-SUB2 PIC 9999.
03 WS-SUB3 PIC 9999.
03 WS-PROCESS PIC X.
88 PROCESS-COMPLETE VALUE 'Y'.
03 WS-OCCURS-VARS.
05 NO-OCCURS PIC 9.
05 O-TABLE OCCURS 3.
07 O-ARRAY-POS PIC 9999.
07 O-LEVEL PIC 999.
07 O-MAX PIC 999.
07 O-START PIC 9999.
07 O-END PIC 9999.
01 WS-MISCELLANEOUS.
03 WS-ABEND-CODE PIC 9(03) VALUE ZERO.
03 WS-ABEND-SEC PIC X(04) VALUE SPACES.
03 WS-DUMP-FLAG PIC X VALUE 'Y'.
01 WS-ERROR-FIELDS.
03 WS-FILE-STATUS PIC 9(02) VALUE ZERO.
03 WS-ERROR-CODE PIC 9(02) VALUE ZERO.
03 WS-ERROR-TEXTS.
05 FILLER PIC X(50) VALUE
01 '*** OPEN ERROR - INPUT COPYBOOK ***'.
05 FILLER PIC X(50) VALUE
02 '*** READ ERROR - EMPTY INPUT COPYBOOK ***'.
05 FILLER PIC X(50) VALUE
03 '*** READ ERROR - INPUT COPYBOOK ***'.
05 FILLER PIC X(50) VALUE
04 '*** CLOSE ERROR - INPUT COPYBOOK ***'.
03 FILLER REDEFINES WS-ERROR-TEXTS.
05 WS-ERROR-TEXT PIC X(50) OCCURS 4.
01 WS-SAS-HEADER-LINES.
02 WS-SAS-HEADER-1.
03 FILLER PIC X(80) VALUE
'//AH05T87* JOB (ZZZZ),''LM - K DESAI'','.
02 WS-SAS-HEADER-2.
03 FILLER PIC X(80) VALUE
'// CLASS=C,MSGCLASS=R,PRTY=00,REGION=4M'.
02 WS-SAS-HEADER-3.
03 FILLER PIC X(80) VALUE
'//*'.
02 WS-SAS-HEADER-3A.
03 FILLER PIC X(80) VALUE
'//**************************************************'.
02 WS-SAS-HEADER-3B.
03 FILLER PIC X(80) VALUE
'//******************* S A S ************************'.
02 WS-SAS-HEADER-3C.
03 FILLER PIC X(80) VALUE
'//* DATE :'.
02 WS-SAS-HEADER-3D.
03 FILLER PIC X(80) VALUE
'//* CR/QUERY CODE :'.
02 WS-SAS-HEADER-3E.
03 FILLER PIC X(80) VALUE
'//* DESCRIPTION :'.
02 WS-SAS-HEADER-3F.
03 FILLER PIC X(80) VALUE
'//**************************************************'.
02 WS-SAS-HEADER-3G.
03 FILLER PIC X(80) VALUE
'//*'.
02 WS-SAS-HEADER-4.
03 FILLER PIC X(80) VALUE
'//*MAIN CLASS=SAS'.
02 WS-SAS-HEADER-5.
03 FILLER PIC X(80) VALUE
'//*'.
02 WS-SAS-HEADER-6.
03 FILLER PIC X(80) VALUE
'//SASSTEP EXEC SAS,REGION=4096K'.
02 WS-SAS-HEADER-7.
03 FILLER PIC X(80) VALUE
'//WORK DD UNIT=SORT,SPACE=(CYL,(250,250))'.
02 WS-SAS-HEADER-8.
03 FILLER PIC X(80) VALUE
'//SASIN DD DSN=ENTER-INPUT-FILE-HERE,DISP=SHR'.
02 WS-SAS-HEADER-8A.
03 FILLER PIC X(80) VALUE
'//FT12F001 DD DSN=ENTER-OUT-FILE-HERE,'.
02 WS-SAS-HEADER-8B.
03 FILLER PIC X(80) VALUE
'// DISP=(NEW,CATLG,DELETE),'.
02 WS-SAS-HEADER-8C.
03 FILLER PIC X(80) VALUE
'// UNIT=3390,SPACE=(TRK,(1,1)),'.
02 WS-SAS-HEADER-8D.
03 FILLER PIC X(80) VALUE
'// DCB=(DSCB,RECFM=FB,LRECL=133)'.
02 WS-SAS-HEADER-8E.
03 FILLER PIC X(80) VALUE
'//*'.
02 WS-SAS-HEADER-9.
03 FILLER PIC X(80) VALUE
'//SYSIN DD *'.
02 WS-SAS-HEADER-10.
03 FILLER PIC X(80) VALUE
' OPTIONS DATE ;'.
02 WS-SAS-HEADER-11.
03 FILLER PIC X(80) VALUE
'DATA ;'.
02 WS-SAS-HEADER-12.
03 FILLER PIC X(80) VALUE
'INFILE SASIN END=_END MISSOVER ;'.
02 WS-SAS-HEADER-13.
03 FILLER PIC X(80) VALUE
' INPUT'.
01 WS-SAS-MIDDLE-1.
03 FILLER PIC X(30) VALUE ' ;'.
03 FILLER PIC X(50) VALUE
' /* << END OF ''INPUT'' STATEMENTS >> */'.
01 WS-SAS-FOOTER-1.
03 FILLER PIC X(20) VALUE SPACES.
03 FILLER PIC X(60) VALUE
'/* << END OF ''LABEL'' STATEMENTS >> */'.
01 WS-SAS-FOOTER-2.
03 FILLER PIC X(80) VALUE ' _ERROR_=0;'.
01 WS-SAS-FOOTER-3.
03 FILLER PIC X(80) VALUE
' TITLE "SAS PRINT OF XXXXX " ;'.
01 WS-SAS-FOOTER-4.
03 FILLER PIC X(80) VALUE
'PROC PRINT LABEL ;'.
01 WS-SAS-DATA-LINES.
03 FILLER PIC X(3) VALUE ' @'.
03 SAS-START PIC 9(5).
03 FILLER PIC X(3) VALUE ' A'.
03 SAS-NUMBER PIC 9(4).
03 FILLER PIC X(3) VALUE SPACES.
03 SAS-TYPE PIC X(5).
03 SAS-LENGTH PIC 9(4).
03 FILLER PIC X(1) VALUE '.'.
03 SAS-DECIMALS.
05 SAS-DECIMALS-N PIC 9(2).
03 FILLER PIC X(5) VALUE ' /* '.
03 SAS-NAME.
05 FILLER PIC X(20).
05 SAS-OCCURS-1.
07 FILLER PIC X.
07 SAS-O1 PIC 999.
07 FILLER PIC X.
05 SAS-OCCURS-2.
07 FILLER PIC X.
07 SAS-O2 PIC 999.
07 FILLER PIC X.
05 SAS-OCCURS-3.
07 FILLER PIC X.
07 SAS-O3 PIC 999.
07 FILLER PIC X.
03 FILLER PIC X(5) VALUE '*/ '.
03 FILLER PIC X(5) VALUE SPACES.
01 WS-SAS-LABEL-LINES.
03 FILLER PIC X(12) VALUE ' LABEL A'.
03 LABEL-NUMBER PIC 9(4).
03 FILLER PIC X(8) VALUE ' = "'.
03 LABEL-NAME PIC X(35) VALUE SPACES.
03 FILLER PIC X(4) VALUE '" ;'.
03 FILLER PIC X(17) VALUE SPACES.
PROCEDURE DIVISION.
A000 SECTION.
A000-START.
PERFORM B000-INITIALISE.
PERFORM C000-MAIN UNTIL ICOPY-EOF.
PERFORM D000-TERMINATE.
STOP RUN.
A000-EXIT.
EXIT.
B000-INITIALISE SECTION.
B005-OPEN-COPYBOOK-FILE.
OPEN INPUT COPY-FILE.
IF NOT ICOPY-OK
MOVE WS-FS-ICOPY TO WS-FILE-STATUS
MOVE 1 TO WS-ERROR-CODE
MOVE 'B005' TO WS-ABEND-SEC
MOVE 001 TO WS-ABEND-CODE
PERFORM Z000-ABEND
END-IF.
B035-CHECK-COPYBOOK-FILE-EMPTY.
PERFORM R000-READ-COPYBOOK.
IF ICOPY-EOF
MOVE WS-FS-ICOPY TO WS-FILE-STATUS
MOVE 2 TO WS-ERROR-CODE
MOVE 'B035' TO WS-ABEND-SEC
MOVE 2 TO WS-ABEND-CODE
PERFORM Z000-ABEND
END-IF.
MOVE 'N' TO WS-PROCESS.
MOVE 0 TO NO-OCCURS.
B999-EXIT.
EXIT.
C000-MAIN SECTION.
C000-PROCESS-EXIT.
PERFORM UNTIL 'Y' = WS-PROCESS
* CHECK IF OCCURS BLOCK HAS COME TO AN END
IF NO-OCCURS > 0 THEN
IF O-LEVEL(NO-OCCURS) > WS-LEVEL
MOVE ARRAY-ELEMENTS TO O-END(NO-OCCURS)
PERFORM C400-POPULATE-ARRAY-OCCURS
GO TO C000-PROCESS-EXIT
END-IF
END-IF
* NEW OCCURS FOUND, ADD INFO ABOUT IT TO STORAGE ARRAY
IF OCCURS-FOUND AND PIC-NOT-FOUND THEN
IF NOT O-LEVEL(NO-OCCURS) = WS-LEVEL THEN
PERFORM C210-PROCESS-OCCURS
PERFORM C300-POPULATE-ARRAY
PERFORM R000-READ-COPYBOOK
GO TO C000-PROCESS-EXIT
END-IF
END-IF
* CHECK IF OCCURS & PIC CLAUSE ON SAME LINE = SINGLE DATA REPEATED
IF OCCURS-FOUND AND PIC-FOUND THEN
PERFORM C210-PROCESS-OCCURS
PERFORM C250-SCAN-PICTURE
PERFORM C300-POPULATE-ARRAY
ADD -1 TO O-START(NO-OCCURS)
MOVE O-START(NO-OCCURS) TO O-END(NO-OCCURS)
PERFORM C400-POPULATE-ARRAY-OCCURS
PERFORM R000-READ-COPYBOOK
GO TO C000-PROCESS-EXIT
END-IF
* CHECK IF REDEFINES AND PIC CLAUSE ON SAME LINE
IF REDEFINES-FOUND AND PIC-FOUND THEN
PERFORM C250-SCAN-PICTURE
PERFORM C270-PROCESS-REDEFINE
PERFORM C300-POPULATE-ARRAY
PERFORM R000-READ-COPYBOOK
GO TO C000-PROCESS-EXIT
END-IF
* PROCESS REDEFINE BLOCK
IF REDEFINES-FOUND AND PIC-NOT-FOUND THEN
PERFORM C270-PROCESS-REDEFINE
PERFORM C300-POPULATE-ARRAY
PERFORM R000-READ-COPYBOOK
GO TO C000-PROCESS-EXIT
END-IF
* PROCESS DATA LINE DEPENDANT ON WHEATHER INSIDE OCCURS BLOCK
EVALUATE NO-OCCURS
WHEN 0
PERFORM C250-SCAN-PICTURE
PERFORM C300-POPULATE-ARRAY
PERFORM R000-READ-COPYBOOK
WHEN OTHER
* STILL SCANING DOWN COPYBOOK WITHIN THIS BLOCK OCCURS
IF O-LEVEL(NO-OCCURS) < WS-LEVEL AND
WS-FS-ICOPY = '00' THEN
PERFORM C250-SCAN-PICTURE
PERFORM C300-POPULATE-ARRAY
PERFORM R000-READ-COPYBOOK
ELSE
* PROCESS 2+ OCCURS USING DATA IN TEMP ARRAY
MOVE ARRAY-ELEMENTS TO O-END(NO-OCCURS)
PERFORM C400-POPULATE-ARRAY-OCCURS
END-IF
END-EVALUATE
*
* CHECK IF EOF REACHED AND ALL OCCUR BLOCKS HAVE BEEN PROCESSED
IF NOT WS-FS-ICOPY = '00' AND NO-OCCURS = 0 THEN
MOVE 'Y' TO WS-PROCESS
END-IF
END-PERFORM.
C999-EXIT.
EXIT.
C010-INITIALISE-FLAGS SECTION.
MOVE 'N' TO WS-LEVEL-FOUND
WS-FIELD-NAME-FOUND
WS-LEVEL-FOUND
WS-COMP-FOUND
WS-COMP-1-FOUND
WS-COMP-2-FOUND
WS-COMP-3-FOUND
WS-OCCURS-FOUND
WS-REDEFINES-FOUND
WS-NEGATIVE-FOUND
WS-FULLSTOP-FOUND
WS-SIGN-FOUND
WS-PLUS-FOUND
WS-DISPLAY-FOUND
WS-DECIMAL-FOUND
WS-WHOLE-FOUND
WS-CHAR-FOUND
WS-PIC-FOUND.
MOVE ZEROS TO WS-DECIMAL-PLACES.
C019-EXIT.
EXIT.
C200-SCAN-FOR-KEYS SECTION.
MOVE 66 TO DATA-LENGTH.
C200-BEGIN.
PERFORM VARYING WS-SUB FROM 1 BY 1 UNTIL WS-SUB > DATA-LENGTH
* CHECK FOR FULLSTOP
IF COPY-REC(WS-SUB:1) = '.' THEN
MOVE 'Y' TO WS-FULLSTOP-FOUND
END-IF
* CALCULATE FIELD NAME START POSITION
IF LEVEL-FOUND AND COPY-REC(WS-SUB:1) NOT = ' ' AND
WS-SUB > WS-FIELD-NAME-POS-START AND
FIELD-NAME-NOT-FOUND THEN
MOVE WS-SUB TO WS-FIELD-NAME-POS-START
MOVE 'Y' TO WS-FIELD-NAME-FOUND
END-IF
* CHECK FOR COPYBOOK LEVEL POSITION
IF COPY-REC(WS-SUB:1) IS NUMERIC AND LEVEL-NOT-FOUND THEN
MOVE WS-SUB TO WS-LEVEL-POS WS-FIELD-NAME-POS-START
MOVE COPY-REC(WS-LEVEL-POS:2) TO WS-LEVEL
ADD 2 TO WS-FIELD-NAME-POS-START
MOVE 'Y' TO WS-LEVEL-FOUND
END-IF
* CHECK FOR COPYBOOK OCCURS POSITION
IF COPY-REC(WS-SUB:6) = 'OCCURS' THEN
MOVE 'Y' TO WS-OCCURS-FOUND
MOVE WS-SUB TO WS-OCCURS-POS
ADD 7 TO WS-OCCURS-POS
END-IF
* CHECK FOR COPYBOOK PIC POSITION
IF COPY-REC(WS-SUB:3) = 'PIC' THEN
MOVE 'Y' TO WS-PIC-FOUND
MOVE WS-SUB TO WS-PIC-POS
ADD 4 TO WS-PIC-POS
END-IF
* CHECK FOR COPYBOOK REDEFINES POSITION
IF COPY-REC(WS-SUB:9) = 'REDEFINES' THEN
MOVE 'Y' TO WS-REDEFINES-FOUND
MOVE WS-SUB TO WS-REDEFINES-POS
ADD 10 TO WS-REDEFINES-POS
END-IF
END-PERFORM.
* HANDLING FOR DATA ON 2 LINES
IF FULLSTOP-NOT-FOUND THEN
MOVE COPY-REC(1:66) TO TEMP-COPY-REC
PERFORM R100-READ
MOVE COPY-REC(7:66) TO COPY-REC(67:66)
MOVE TEMP-COPY-REC TO COPY-REC(1:66)
MOVE 132 TO DATA-LENGTH
GO TO C200-BEGIN
END-IF.
C209-EXIT.
EXIT.
C210-PROCESS-OCCURS SECTION.
ADD 1 TO NO-OCCURS.
MOVE ARRAY-ELEMENTS TO O-START(NO-OCCURS)
ADD 2 TO O-START(NO-OCCURS)
MOVE 'N' TO WS-FULLSTOP-FOUND.
MOVE WS-OCCURS-POS TO WS-START.
ADD -1 TO WS-START.
PERFORM VARYING WS-SUB FROM WS-OCCURS-POS BY 1
UNTIL FULLSTOP-FOUND
IF COPY-REC(WS-SUB:1) = '.' OR
COPY-REC(WS-SUB:1) = ' ' THEN
MOVE 'Y' TO WS-FULLSTOP-FOUND
MOVE WS-SUB TO WS-END
END-IF
END-PERFORM.
PERFORM C260-CALC-NUMERIC.
MOVE COPY-REC(WS-LEVEL-POS:2) TO O-LEVEL(NO-OCCURS).
MOVE WS-TEMP-NUMERIC TO O-MAX(NO-OCCURS).
C219-EXIT.
EXIT.
C250-SCAN-PICTURE SECTION.
PERFORM VARYING WS-SUB FROM WS-PIC-POS BY 1 UNTIL
WS-SUB > DATA-LENGTH
EVALUATE TRUE
WHEN COPY-REC(WS-SUB:1) = 'S'
MOVE 'Y' TO WS-SIGN-FOUND
WHEN COPY-REC(WS-SUB:1) = '-' OR
COPY-REC(WS-SUB:1) = '+'
MOVE 'Y' TO WS-PLUS-FOUND
WHEN COPY-REC(WS-SUB:1) = '9' AND WHOLE-NOT-FOUND
MOVE 'Y' TO WS-WHOLE-FOUND
MOVE WS-SUB TO WS-WHOLE-POS
WHEN COPY-REC(WS-SUB:1) = 'X' AND CHAR-NOT-FOUND
MOVE 'Y' TO WS-CHAR-FOUND
MOVE WS-SUB TO WS-CHAR-POS
WHEN COPY-REC(WS-SUB:1) = 'V' AND DECIMAL-NOT-FOUND
MOVE 'Y' TO WS-DECIMAL-FOUND
MOVE WS-SUB TO WS-DECIMAL-POS
WHEN COPY-REC(WS-SUB:2) = '.9'
MOVE 'Y' TO WS-DECIMAL-FOUND
MOVE 'Y' TO WS-DISPLAY-FOUND
MOVE WS-SUB TO WS-DECIMAL-POS
WHEN COPY-REC(WS-SUB:1) = '-'
MOVE 'Y' TO WS-NEGATIVE-FOUND
WHEN COPY-REC(WS-SUB:4) = 'COMP'
IF COPY-REC(WS-SUB:5) = 'COMP ' OR
COPY-REC(WS-SUB:5) = 'COMP.' THEN
MOVE 'Y' TO WS-COMP-FOUND
END-IF
IF COPY-REC(WS-SUB:6) = 'COMP-1' THEN
MOVE 'Y' TO WS-COMP-1-FOUND
END-IF
IF COPY-REC(WS-SUB:6) = 'COMP-2' THEN
MOVE 'Y' TO WS-COMP-2-FOUND
END-IF
IF COPY-REC(WS-SUB:6) = 'COMP-3' THEN
MOVE 'Y' TO WS-COMP-3-FOUND
END-IF
END-EVALUATE
END-PERFORM.
* CALCULATE NUMBER OF DECIMAL PLACES
IF DECIMAL-FOUND THEN
MOVE ZERO TO WS-DECIMAL-PLACES WS-START WS-END
PERFORM VARYING WS-SUB FROM WS-DECIMAL-POS BY 1
UNTIL COPY-REC(WS-SUB:1) = ' '
IF COPY-REC(WS-SUB:1) = '9' AND WS-START = 0 THEN
ADD 1 TO WS-DECIMAL-PLACES
END-IF
IF COPY-REC(WS-SUB:1) = '(' THEN
MOVE WS-SUB TO WS-START
END-IF
IF COPY-REC(WS-SUB:1) = ')' THEN
MOVE WS-SUB TO WS-END
END-IF
END-PERFORM
IF WS-START > 0 AND WS-END > 0 THEN
PERFORM C260-CALC-NUMERIC
COMPUTE WS-DECIMAL-PLACES =
WS-TEMP-NUMERIC + WS-DECIMAL-PLACES - 1
END-IF
END-IF.
* CALCULATE NUMBER OF CHARACTERS
IF CHAR-FOUND THEN
MOVE ZERO TO WS-CHARS WS-START WS-END
PERFORM VARYING WS-SUB FROM WS-CHAR-POS BY 1
UNTIL COPY-REC(WS-SUB:1) = ' '
IF COPY-REC(WS-SUB:1) = 'X' AND WS-START = 0 THEN
ADD 1 TO WS-CHARS
END-IF
IF COPY-REC(WS-SUB:1) = '(' THEN
MOVE WS-SUB TO WS-START
END-IF
IF COPY-REC(WS-SUB:1) = ')' THEN
MOVE WS-SUB TO WS-END
END-IF
END-PERFORM
IF WS-START > 0 AND WS-END > 0 THEN
PERFORM C260-CALC-NUMERIC
COMPUTE WS-CHARS = WS-TEMP-NUMERIC + WS-CHARS - 1
END-IF
END-IF.
* CALCULATE NUMBER WHOLE DIGITS FOR NUMERICS
IF WHOLE-FOUND THEN
MOVE ZERO TO WS-WHOLE WS-START WS-END
PERFORM VARYING WS-SUB FROM WS-WHOLE-POS BY 1
UNTIL COPY-REC(WS-SUB:1) = ' '
OR COPY-REC(WS-SUB:1) = '.'
OR COPY-REC(WS-SUB:1) = 'V'
IF COPY-REC(WS-SUB:1) = '9' AND WS-START = 0 THEN
ADD 1 TO WS-WHOLE
END-IF
IF COPY-REC(WS-SUB:1) = '(' THEN
MOVE WS-SUB TO WS-START
END-IF
IF COPY-REC(WS-SUB:1) = ')' THEN
MOVE WS-SUB TO WS-END
END-IF
END-PERFORM
IF WS-START > 0 AND WS-END > 0 THEN
PERFORM C260-CALC-NUMERIC
COMPUTE WS-WHOLE = WS-TEMP-NUMERIC + WS-WHOLE - 1
END-IF
END-IF.
C259-EXIT.
EXIT.
C260-CALC-NUMERIC SECTION.
ADD 1 TO WS-START.
MOVE ZERO TO WS-TEMP-NUMERIC.
COMPUTE WS-LENGTH = WS-END - WS-START.
COMPUTE WS-TEMP-START = 4 - WS-LENGTH + 1.
MOVE COPY-REC(WS-START:WS-LENGTH) TO
WS-TEMP(WS-TEMP-START:WS-LENGTH).
COMPUTE WS-TEMP-START = 4 - WS-LENGTH
PERFORM VARYING WS-SUB FROM 1 BY 1
UNTIL WS-SUB > WS-TEMP-START
MOVE '0' TO WS-TEMP-START(WS-SUB:1)
END-PERFORM.
C269-EXIT.
EXIT.
C270-PROCESS-REDEFINE SECTION.
* FIND START OF REDEFINE FIELD NAME
MOVE 'N' TO WS-FULLSTOP-FOUND.
PERFORM VARYING WS-SUB FROM WS-REDEFINES-POS BY 1
UNTIL FULLSTOP-FOUND
IF NOT COPY-REC(WS-SUB:1) = ' ' THEN
MOVE 'Y' TO WS-FULLSTOP-FOUND
MOVE WS-SUB TO WS-START
END-IF
END-PERFORM.
MOVE 'N' TO WS-FULLSTOP-FOUND.
PERFORM VARYING WS-SUB FROM WS-START BY 1
UNTIL FULLSTOP-FOUND
IF COPY-REC(WS-SUB:1) = '.' OR
COPY-REC(WS-SUB:1) = ' ' THEN
MOVE 'Y' TO WS-FULLSTOP-FOUND
MOVE WS-SUB TO WS-END
END-IF
END-PERFORM.
COMPUTE WS-LENGTH = WS-END - WS-START.
MOVE COPY-REC(WS-START:WS-LENGTH) TO WS-REDEFINES-NAME.
C279-EXIT.
EXIT.
C300-POPULATE-ARRAY SECTION.
ADD 1 TO ARRAY-ELEMENTS.
INITIALIZE ARRAY-DATA(ARRAY-ELEMENTS).
MOVE COPY-REC TO ARRAY-WHOLE-LINE(ARRAY-ELEMENTS)
* POPULATE LEVEL OF COPYBOOK DATA ITEM
MOVE COPY-REC(WS-LEVEL-POS:2) TO
ARRAY-LEVEL(ARRAY-ELEMENTS).
* POPULATE NUMBER WHOLE DIGITS FOR NUMERICS
MOVE WS-WHOLE TO ARRAY-WHOLE(ARRAY-ELEMENTS).
* POPULATE NUMBER OF DECIMAL PLACES
MOVE WS-DECIMAL-PLACES TO ARRAY-DECIMALS(ARRAY-ELEMENTS).
* POPULATE NUMBER CHARACTERS
IF CHAR-FOUND THEN
MOVE WS-CHARS TO ARRAY-LENGTH(ARRAY-ELEMENTS)
END-IF.
* POPULATE ZONED DECIMAL
IF CHAR-NOT-FOUND AND COMP-NOT-FOUND AND COMP-1-NOT-FOUND AND
COMP-2-NOT-FOUND AND COMP-3-NOT-FOUND THEN
COMPUTE ARRAY-LENGTH(ARRAY-ELEMENTS) =
WS-WHOLE + WS-DECIMAL-PLACES
END-IF.
* POPULATE DISPLAY NUMERIC LENGTH
IF DISPLAY-FOUND THEN
COMPUTE ARRAY-LENGTH(ARRAY-ELEMENTS) =
WS-WHOLE + WS-DECIMAL-PLACES + 1
END-IF.
IF PLUS-FOUND THEN
ADD 1 TO ARRAY-LENGTH(ARRAY-ELEMENTS)
END-IF.
* POPULATE LENGTH OF BYTES REQUIRED OF PACKED NUMERIC COMP
IF COMP-FOUND THEN
MOVE WS-DECIMAL-PLACES TO WS-TEMP-NUMERIC
ADD WS-WHOLE TO WS-TEMP-NUMERIC
COMPUTE WS-TEMP-NUMERIC = (WS-TEMP-NUMERIC / 2)
MOVE WS-TEMP-NUMERIC TO ARRAY-LENGTH(ARRAY-ELEMENTS)
END-IF.
* POPULATE LENGTH OF BYTES REQUIRED OF PACKED NUMERIC COMP-3
IF COMP-3-FOUND THEN
MOVE WS-DECIMAL-PLACES TO WS-TEMP-NUMERIC
ADD WS-WHOLE TO WS-TEMP-NUMERIC
COMPUTE WS-TEMP-NUMERIC = WS-TEMP-NUMERIC / 2
ADD 1 TO WS-TEMP-NUMERIC
MOVE WS-TEMP-NUMERIC TO ARRAY-LENGTH(ARRAY-ELEMENTS)
END-IF.
* POPULATE TYPE OF DATA
EVALUATE TRUE
WHEN COMP-FOUND
MOVE 'A' TO ARRAY-FIELD-TYPE(ARRAY-ELEMENTS)
WHEN COMP-1-FOUND
MOVE 'B' TO ARRAY-FIELD-TYPE(ARRAY-ELEMENTS)
WHEN COMP-2-FOUND
MOVE 'C' TO ARRAY-FIELD-TYPE(ARRAY-ELEMENTS)
WHEN COMP-3-FOUND
MOVE 'D' TO ARRAY-FIELD-TYPE(ARRAY-ELEMENTS)
WHEN DISPLAY-FOUND
MOVE 'E' TO ARRAY-FIELD-TYPE(ARRAY-ELEMENTS)
WHEN CHAR-FOUND
MOVE 'X' TO ARRAY-FIELD-TYPE(ARRAY-ELEMENTS)
WHEN OTHER
MOVE 'Y' TO ARRAY-FIELD-TYPE(ARRAY-ELEMENTS)
END-EVALUATE.
* POPULATE FLAG TO SHOW IF COPYBOOK LINE CONTAINS A PIC CLAUSE
IF PIC-FOUND THEN
MOVE 'Y' TO ARRAY-DATA-FIELD(ARRAY-ELEMENTS)
ADD 1 TO ARRAY-ELEMENTS-D
MOVE ARRAY-ELEMENTS-D TO ARRAY-SAS-NO(ARRAY-ELEMENTS)
ELSE
MOVE 'N' TO ARRAY-DATA-FIELD(ARRAY-ELEMENTS)
END-IF.
* POPULATE FLAG TO SHOW IF NUMERIC IS SIGNED
IF SIGN-FOUND THEN
MOVE 'Y' TO ARRAY-SIGNED(ARRAY-ELEMENTS)
ELSE
MOVE 'N' TO ARRAY-SIGNED(ARRAY-ELEMENTS)
END-IF.
* POPULATE FLAG TO SHOW REDEFINE FOUND
IF REDEFINES-FOUND THEN
MOVE 'Y' TO ARRAY-REDEFINE(ARRAY-ELEMENTS)
MOVE WS-REDEFINES-NAME TO
ARRAY-REDEFINE-NAME(ARRAY-ELEMENTS)
MOVE WS-LEVEL TO WS-REDEFINES-LEVEL
ELSE
MOVE 'N' TO ARRAY-REDEFINE(ARRAY-ELEMENTS)
MOVE 99 TO WS-REDEFINES-LEVEL
END-IF.
* POPULATE FIELD NAME OF COPYBOOK
MOVE 'N' TO WS-DONE.
PERFORM VARYING WS-SUB FROM WS-FIELD-NAME-POS-START BY 1
UNTIL DONE
IF COPY-REC(WS-SUB:1) = SPACE OR
COPY-REC(WS-SUB:1) = '.' THEN
MOVE WS-SUB TO WS-FIELD-NAME-POS-END
MOVE 'Y' TO WS-DONE
END-IF
END-PERFORM.
COMPUTE WS-FIELD-NAME-POS-END =
WS-FIELD-NAME-POS-END - WS-FIELD-NAME-POS-START.
MOVE COPY-REC(WS-FIELD-NAME-POS-START:WS-FIELD-NAME-POS-END)
TO ARRAY-FIELD-NAME(ARRAY-ELEMENTS).
* POPULATE OCCURS FIELDS
MOVE NO-OCCURS TO
ARRAY-NO-OF-OCCURS(ARRAY-ELEMENTS).
EVALUATE NO-OCCURS
WHEN 1
MOVE 1 TO ARRAY-OCCURS-L1(ARRAY-ELEMENTS)
MOVE ZERO TO ARRAY-OCCURS-L2(ARRAY-ELEMENTS)
ARRAY-OCCURS-L3(ARRAY-ELEMENTS)
WHEN 2
MOVE 1 TO ARRAY-OCCURS-L1(ARRAY-ELEMENTS)
ARRAY-OCCURS-L2(ARRAY-ELEMENTS)
MOVE ZERO TO ARRAY-OCCURS-L3(ARRAY-ELEMENTS)
WHEN 3
MOVE 1 TO ARRAY-OCCURS-L1(ARRAY-ELEMENTS)
ARRAY-OCCURS-L2(ARRAY-ELEMENTS)
ARRAY-OCCURS-L3(ARRAY-ELEMENTS)
END-EVALUATE.
* CORRECT IF DISPLAY SIGN FOUND
IF NEGATIVE-FOUND THEN
ADD 1 TO ARRAY-LENGTH(ARRAY-ELEMENTS)
END-IF.
C399-EXIT.
EXIT.
C400-POPULATE-ARRAY-OCCURS SECTION.
* PROCESS 2ND+ OCCURS
PERFORM VARYING WS-SUB FROM 2
BY 1 UNTIL WS-SUB > O-MAX(NO-OCCURS)
* PROCESS ITEMS WITHIN OCCURS
PERFORM VARYING WS-SUB2 FROM O-START(NO-OCCURS)
BY 1 UNTIL WS-SUB2 > O-END(NO-OCCURS)
ADD 1 TO ARRAY-ELEMENTS
MOVE ARRAY-DATA(WS-SUB2) TO
ARRAY-DATA(ARRAY-ELEMENTS)
KDD IF ARRAY-DATA-FIELD(WS-SUB2) = 'Y' THEN
ADD 1 TO ARRAY-ELEMENTS-D
MOVE ARRAY-ELEMENTS-D TO
ARRAY-SAS-NO(ARRAY-ELEMENTS)
END-IF
EVALUATE NO-OCCURS
WHEN 1 MOVE WS-SUB TO
ARRAY-OCCURS-L1(ARRAY-ELEMENTS)
WHEN 2 MOVE WS-SUB TO
ARRAY-OCCURS-L2(ARRAY-ELEMENTS)
WHEN 3 MOVE WS-SUB TO
ARRAY-OCCURS-L3(ARRAY-ELEMENTS)
WHEN OTHER
EXIT
END-EVALUATE
END-PERFORM
END-PERFORM.
ADD -1 TO NO-OCCURS.
C499-EXIT.
EXIT.
C500-CALC-OFFSETS SECTION.
MOVE ZERO TO WS-LENGTH.
MOVE 'N' TO WS-REDEFINES-SET.
MOVE 1 TO WS-START.
PERFORM VARYING WS-SUB FROM 1 BY 1
UNTIL WS-SUB > ARRAY-ELEMENTS
IF ARRAY-REDEFINE(WS-SUB) = 'Y' THEN
MOVE 'N' TO WS-DATA-FOUND WS-FLAG-SET
WS-REDEFINES-SET
*---------- FIND ARRAY POSITION WHERE REDEFINE FIELD SITS -----
PERFORM VARYING WS-SUB2 FROM 1 BY 1
UNTIL WS-SUB2 > ARRAY-ELEMENTS OR DATA-FOUND
IF ARRAY-FIELD-NAME(WS-SUB2) =
ARRAY-REDEFINE-NAME(WS-SUB) AND
ARRAY-LEVEL(WS-SUB) =
ARRAY-LEVEL(WS-SUB2) THEN
*----------------- FIND START OF 1ST REDEFINE DATA LINE
PERFORM VARYING WS-SUB3 FROM WS-SUB2 BY 1
UNTIL FLAG-SET AND
ARRAY-DATA-FIELD(WS-SUB3) = 'Y'
IF ARRAY-DATA-FIELD(WS-SUB3) = 'Y' AND
ARRAY-OCCURS-L1(WS-SUB3) =
ARRAY-OCCURS-L1(WS-SUB) AND
ARRAY-OCCURS-L2(WS-SUB3) =
ARRAY-OCCURS-L2(WS-SUB) AND
ARRAY-OCCURS-L3(WS-SUB3) =
ARRAY-OCCURS-L3(WS-SUB) THEN
MOVE 'Y' TO WS-FLAG-SET
WS-DATA-FOUND
WS-REDEFINES-SET
IF WS-SUB2 = WS-SUB3 THEN
MOVE 'N' TO WS-REDEFINES-SET
END-IF
COMPUTE WS-REDEFINES-SET-START =
ARRAY-CUM(WS-SUB3) + 1 -
ARRAY-LENGTH(WS-SUB3)
MOVE ARRAY-START-POS(WS-SUB3) TO
ARRAY-START-POS(WS-SUB)
END-IF
END-PERFORM
*-----------------------------------------------------
END-IF
END-PERFORM
*--------------------------------------------------------------
ELSE
IF ARRAY-DATA-FIELD(WS-SUB) = 'Y' AND
REDEFINES-SET THEN
MOVE 'N' TO WS-REDEFINES-SET
MOVE WS-REDEFINES-SET-START TO
ARRAY-START-POS(WS-SUB)
WS-LENGTH
ADD ARRAY-LENGTH(WS-SUB) TO WS-LENGTH
ADD -1 TO WS-LENGTH
MOVE WS-LENGTH TO ARRAY-CUM(WS-SUB)
COMPUTE WS-START = WS-REDEFINES-SET-START +
ARRAY-LENGTH(WS-SUB)
ELSE
IF ARRAY-LEVEL(WS-SUB) = '01' THEN
MOVE 1 TO WS-START
MOVE ZERO TO WS-LENGTH
END-IF
IF ARRAY-DATA-FIELD(WS-SUB) = 'Y' THEN
ADD ARRAY-LENGTH(WS-SUB) TO WS-LENGTH
MOVE WS-LENGTH TO ARRAY-CUM(WS-SUB)
MOVE WS-START TO ARRAY-START-POS(WS-SUB)
ADD ARRAY-LENGTH(WS-SUB) TO WS-START
END-IF
END-IF
END-IF
END-PERFORM.
C599-EXIT.
EXIT.
C600-CREATE-SAS SECTION.
DISPLAY WS-SAS-HEADER-1.
DISPLAY WS-SAS-HEADER-2.
DISPLAY WS-SAS-HEADER-3.
DISPLAY WS-SAS-HEADER-3A.
DISPLAY WS-SAS-HEADER-3B.
DISPLAY WS-SAS-HEADER-3C.
DISPLAY WS-SAS-HEADER-3D.
DISPLAY WS-SAS-HEADER-3E.
DISPLAY WS-SAS-HEADER-3F.
DISPLAY WS-SAS-HEADER-3G.
DISPLAY WS-SAS-HEADER-4.
DISPLAY WS-SAS-HEADER-5.
DISPLAY WS-SAS-HEADER-6.
DISPLAY WS-SAS-HEADER-7.
DISPLAY WS-SAS-HEADER-8.
DISPLAY WS-SAS-HEADER-8A.
DISPLAY WS-SAS-HEADER-8B.
DISPLAY WS-SAS-HEADER-8C.
DISPLAY WS-SAS-HEADER-8D.
DISPLAY WS-SAS-HEADER-8E.
DISPLAY WS-SAS-HEADER-9.
DISPLAY WS-SAS-HEADER-10.
DISPLAY WS-SAS-HEADER-11.
DISPLAY WS-SAS-HEADER-12.
DISPLAY WS-SAS-HEADER-13.
* PRINT SAS DATA LINES
PERFORM VARYING WS-SUB FROM 1 BY 1
UNTIL WS-SUB > ARRAY-ELEMENTS
IF ARRAY-DATA-FIELD(WS-SUB) = 'Y' THEN
INITIALIZE WS-SAS-DATA-LINES
MOVE ARRAY-START-POS(WS-SUB) TO SAS-START
MOVE ARRAY-SAS-NO(WS-SUB) TO SAS-NUMBER
IF ARRAY-DECIMALS(WS-SUB) > 0 AND
NOT ARRAY-FIELD-TYPE(WS-SUB) = 'E' THEN
MOVE ARRAY-DECIMALS(WS-SUB) TO SAS-DECIMALS-N
ELSE
MOVE SPACES TO SAS-DECIMALS
END-IF
MOVE ARRAY-LENGTH(WS-SUB) TO SAS-LENGTH
EVALUATE ARRAY-FIELD-TYPE(WS-SUB)
WHEN 'E'
MOVE '£CHAR' TO SAS-TYPE
WHEN 'X'
MOVE '£CHAR' TO SAS-TYPE
WHEN 'Y'
MOVE ' ZD' TO SAS-TYPE
WHEN OTHER
MOVE ' PD' TO SAS-TYPE
END-EVALUATE
MOVE ARRAY-FIELD-NAME(WS-SUB) TO SAS-NAME
* MOVING OCCUR NUMBERS
EVALUATE ARRAY-NO-OF-OCCURS(WS-SUB)
WHEN 1
MOVE '( )' TO SAS-OCCURS-3
MOVE ARRAY-OCCURS-L1(WS-SUB) TO SAS-O3
WHEN 2
MOVE '( )' TO SAS-OCCURS-2
SAS-OCCURS-3
MOVE ARRAY-OCCURS-L1(WS-SUB) TO SAS-O2
MOVE ARRAY-OCCURS-L2(WS-SUB) TO SAS-O3
WHEN 3
MOVE '( )' TO SAS-OCCURS-1
SAS-OCCURS-2
SAS-OCCURS-3
MOVE ARRAY-OCCURS-L1(WS-SUB) TO SAS-O1
MOVE ARRAY-OCCURS-L2(WS-SUB) TO SAS-O2
MOVE ARRAY-OCCURS-L3(WS-SUB) TO SAS-O3
WHEN OTHER
EXIT
END-EVALUATE
MOVE SAS-NAME TO ARRAY-SAS-DATA(WS-SUB)
DISPLAY WS-SAS-DATA-LINES
END-IF
END-PERFORM.
* PRINT SAS MIDDLE LINES
DISPLAY WS-SAS-MIDDLE-1.
* PRINT SAS LABEL LINES
PERFORM VARYING WS-SUB FROM 1 BY 1
UNTIL WS-SUB > ARRAY-ELEMENTS
IF ARRAY-DATA-FIELD(WS-SUB) = 'Y' THEN
INITIALIZE WS-SAS-LABEL-LINES
MOVE ARRAY-SAS-DATA(WS-SUB) TO TEMP-SAS-NAME
PERFORM VARYING WS-SUB2 FROM 1 BY 1
UNTIL WS-SUB2 > 35
IF TEMP-SAS-NAME(WS-SUB2:1) = '-' THEN
MOVE ' ' TO LABEL-NAME(WS-SUB2:1)
ELSE
MOVE TEMP-SAS-NAME(WS-SUB2:1) TO
LABEL-NAME(WS-SUB2:1)
END-IF
END-PERFORM
MOVE ARRAY-SAS-NO(WS-SUB) TO LABEL-NUMBER
DISPLAY WS-SAS-LABEL-LINES
END-IF
END-PERFORM.
* PRINT SAS FOOTER LINES
DISPLAY WS-SAS-FOOTER-1.
DISPLAY WS-SAS-FOOTER-2.
DISPLAY WS-SAS-FOOTER-3.
DISPLAY WS-SAS-FOOTER-4.
C699-EXIT.
EXIT.
D000-TERMINATE SECTION.
PERFORM C500-CALC-OFFSETS.
PERFORM C600-CREATE-SAS.
D005-CLOSE-COPYBOOK-FILE.
CLOSE COPY-FILE.
IF NOT ICOPY-OK
MOVE WS-FS-ICOPY TO WS-FILE-STATUS
MOVE 06 TO WS-ERROR-CODE
MOVE 'D005' TO WS-ABEND-SEC
MOVE 006 TO WS-ABEND-CODE
PERFORM Z000-ABEND
END-IF.
D999-EXIT.
EXIT.
R000-READ-COPYBOOK SECTION.
MOVE 'N' TO WS-DATA-FOUND.
PERFORM UNTIL NOT WS-FS-ICOPY = '00' OR WS-DATA-FOUND = 'Y'
IF WS-FS-ICOPY = '00' THEN
PERFORM R100-READ
IF WS-FS-ICOPY = '00' THEN
IF COPY-REC(1:1) NOT = '*' AND
COPY-REC NOT = SPACES THEN
PERFORM C010-INITIALISE-FLAGS
PERFORM C200-SCAN-FOR-KEYS
MOVE 'Y' TO WS-DATA-FOUND
END-IF
END-IF
END-IF
END-PERFORM.
R999-EXIT.
EXIT.
R100-READ SECTION.
READ COPY-FILE.
MOVE SPACES TO COPY-REC.
MOVE ICOPY-REC(7:66) TO COPY-REC(1:66).
EXIT.
Z000-ABEND SECTION.
< code removed>
Z099-EXIT.
EXIT.
I have now gone and changed the original post with the full program.
Re: COBOL file conversion to readable format
Posted:
Sat Apr 22, 2017 12:50 pm
by rakeshsneha1212
Hi Nicc,
Thanks for looking into this.
Regarding you edit macro suggestion, I would say this won't help when occurs clause, redefines come in to effect.
I really did not understand on the colouriser. Can you please explain me on this. I tried changing the redefined not found to 'N' but didn't give me the result.
My views after looking at the output I see the array element which is getting added for every redefines clause is going wrong.
Re: COBOL file conversion to readable format
Posted:
Sat Apr 22, 2017 2:38 pm
by enrico-sorichetti
the topic was started in the REXX section ...
now it is going into a completely different direction
moved it to the "OTHER MAINFRAME TOPICS" section until a clear direction is established or the topic is locked
the issue of analyzing a COBOL copybook has been discussed too many times with less than satisfying results,
Re: COBOL file conversion to readable format
Posted:
Tue May 09, 2017 9:20 pm
by rakeshsneha1212
Hi all,
Did any one try tweaking the code. I'm still stuck and not able to correct it. Please help
Regards,
Rakesh
Re: COBOL file conversion to readable format
Posted:
Tue May 09, 2017 9:53 pm
by enrico-sorichetti
when a topic goes past a reasonable number of replies, it will lead nowhere.
locked to prevent further waste of time