COBOL file conversion to readable format



Post anything related to mainframes (IBM & UNISYS) if not fit in any of the above categories

Re: COBOL file conversion to readable format

Postby Aki88 » Fri Apr 21, 2017 3:10 pm

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?
Aki88
 
Posts: 381
Joined: Tue Jan 28, 2014 1:52 pm
Has thanked: 33 times
Been thanked: 36 times

Re: COBOL file conversion to readable format

Postby NicC » Fri Apr 21, 2017 3:41 pm

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'.
The problem I have is that people can explain things quickly but I can only comprehend slowly.
Regards
Nic

These users thanked the author NicC for the post:
rakeshsneha1212 (Fri Apr 21, 2017 4:06 pm)
NicC
Global moderator
 
Posts: 3025
Joined: Sun Jul 04, 2010 12:13 am
Location: Pushing up the daisies (almost)
Has thanked: 4 times
Been thanked: 136 times

Re: COBOL file conversion to readable format

Postby rakeshsneha1212 » Fri Apr 21, 2017 4:46 pm

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.
rakeshsneha1212
 
Posts: 30
Joined: Thu Mar 30, 2017 2:09 pm
Has thanked: 5 times
Been thanked: 0 time

Re: COBOL file conversion to readable format

Postby NicC » Fri Apr 21, 2017 5:31 pm

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)
The problem I have is that people can explain things quickly but I can only comprehend slowly.
Regards
Nic
NicC
Global moderator
 
Posts: 3025
Joined: Sun Jul 04, 2010 12:13 am
Location: Pushing up the daisies (almost)
Has thanked: 4 times
Been thanked: 136 times

Re: COBOL file conversion to readable format

Postby NicC » Fri Apr 21, 2017 5:53 pm

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.
The problem I have is that people can explain things quickly but I can only comprehend slowly.
Regards
Nic

These users thanked the author NicC for the post:
Aki88 (Fri Apr 21, 2017 6:14 pm)
NicC
Global moderator
 
Posts: 3025
Joined: Sun Jul 04, 2010 12:13 am
Location: Pushing up the daisies (almost)
Has thanked: 4 times
Been thanked: 136 times

Re: COBOL file conversion to readable format

Postby rakeshsneha1212 » Sat Apr 22, 2017 12:50 pm

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.
rakeshsneha1212
 
Posts: 30
Joined: Thu Mar 30, 2017 2:09 pm
Has thanked: 5 times
Been thanked: 0 time

Re: COBOL file conversion to readable format

Postby enrico-sorichetti » Sat Apr 22, 2017 2:38 pm

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,
cheers
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
enrico-sorichetti
Global moderator
 
Posts: 3002
Joined: Fri Apr 18, 2008 11:25 pm
Has thanked: 0 time
Been thanked: 164 times

Re: COBOL file conversion to readable format

Postby rakeshsneha1212 » Tue May 09, 2017 9:20 pm

Hi all,
Did any one try tweaking the code. I'm still stuck and not able to correct it. Please help


Regards,
Rakesh
rakeshsneha1212
 
Posts: 30
Joined: Thu Mar 30, 2017 2:09 pm
Has thanked: 5 times
Been thanked: 0 time

Re: COBOL file conversion to readable format

Postby enrico-sorichetti » Tue May 09, 2017 9:53 pm

when a topic goes past a reasonable number of replies, it will lead nowhere.

locked to prevent further waste of time
cheers
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
enrico-sorichetti
Global moderator
 
Posts: 3002
Joined: Fri Apr 18, 2008 11:25 pm
Has thanked: 0 time
Been thanked: 164 times

Previous

Return to All other Mainframe Topics

 


  • Related topics
    Replies
    Views
    Last post