Page 2 of 3

Re: COBOL file conversion to readable format

PostPosted: Mon Apr 17, 2017 6:43 pm
by Robert Sample
I am writing a tool to convert any raw cobol dataset to a readable form (Meaning upacked to Zoned).
In general, this cannot be done without having the data set layout available. For example, X'0097994D' could be treated as -97994 as a packed decimal number PIC S9(07) COMP-3, or as 9935181 as a binary number PIC S9(09) COMP, or as a LOW-VALUE followed by 'pr(' as a text value PIC X(04). The same 4 bytes but 3 very different interpretations (which depends upon the layout of the record).

Re: COBOL file conversion to readable format

PostPosted: Wed Apr 19, 2017 8:42 pm
by rakeshsneha1212
Hi aki88,

Regarding your questions.
A) every time it's only one single dataset and it's corresponding copybook is used and should be converted so that it will easy for business to understand the data when they look at it.

I got a COBOL program which dynamically convert the any copy book layout to the CSV format and builds a SAS JCL as output which then need to submitted along with input dataset to get the corresponding CSV converted dataset and then put it into a excel which finishes the job of conversion and ready to be read easily on excel. unluckily this SAS not supported in our entity.

Now I'm stuck with SAS JCL which is built from the program.

Re: COBOL file conversion to readable format

PostPosted: Thu Apr 20, 2017 2:27 am
by Aki88
Hello,

rakeshsneha1212 wrote:.... Now I'm stuck with SAS JCL which is built from the program.


I am sorry, the site I've been working with over the years does not have SAS (I know it sounds lame; can't help it), so I won't be of much help here. Though if you post the SAS JCL I am sure the seniors on the forum will definitely be able to guide you; please also refer Mr. Sample's post, it gives some very important insights on data conversion.

Aside, since the SAS is simply being used for conversion, why not use REXX? Since we haven't seen the code, so my statement is pure conjecture; yet REXX is an option you can definitely look for; having said that, please do share the SAS code so that someone can guide you.

Re: COBOL file conversion to readable format

PostPosted: Thu Apr 20, 2017 2:09 pm
by rakeshsneha1212
Hi Aki88,

regarding your questions.
a) during run time it's only single dataset along with the CSV layout is used.

I have a cobol program which does below things :
1) taking COBOL copy book as input
2) build a SAS JCL with converting the COBOL copy book fields to subsequent SAS related fields (it take care of conversion here and all redefines).
3) We now give the COBOL dataset to the SAS JCL as input and submit it to get the CSV converted dataset as output.

But i'm facing problem in redefines as all the copy books here are majorily with redefining and COBOL program which is built (reading a copy book) is not able to recognise it correctly and building a wrong SAS JCL.

i can provide you the COBOL program which guves you better idea on this and also you can help me in analysing what can be changed to handle it correctly. Will send you the Code snippet separately.


regards,
Rakesh MS

Re: COBOL file conversion to readable format

PostPosted: Thu Apr 20, 2017 5:04 pm
by Robert Sample
COB2SAS not handling multiple REDEFINES correctly is a known issue that goes back quite a few years. So I doubt you'll easily get a better solution from SAS. Your choices then become:
1. write your OWN modifications to COB2SAS to properly handle the copy book
2. add by hand the extra SAS variables that COB2SAS couldn't handle correctly
3. accept that what you want is not available and move on to a different project

Re: COBOL file conversion to readable format

PostPosted: Thu Apr 20, 2017 5:10 pm
by Aki88
Hello,

In the PM you sent me, I could not find the attachment; I think the forum doesn't allow attachments in PM, haven't tried it, so am not very sure if they can be sent.

<Personal Opinion On>
Having said that, it is generally considered rude to send unsolicited PMs on a professional forum - unless you know the responder personally (in which case again it unto their discretion to read/respond to the PM).
It would do you tons of good if you pasted the relevant code here as a post, because it'd give others/experts data to understand the issue better and guide you. You can of course mask/edit/remove the site/business/proprietary specific code and share the remaining pieces; and we can definitely guide you.
</Personal Opinion Off>

Re: COBOL file conversion to readable format

PostPosted: Thu Apr 20, 2017 8:58 pm
by rakeshsneha1212
Hi aki88,
Roger that !!

Here's code which converts the COBOL copy book to SAS.

     *
      ******************************************************************
      *     *
      ******************************************************************
      *                     PROGRAM FUNCTION                           *
      *  CONVERT/CREATE ROSCOE OFFSET RPF FOR SAS FIELD POSITIONS      *
      ******************************************************************
      *      INPUT FILES  : COPYBOOKS                         ICOPY    *
      *      OUTPUT FILES : SAS LAYOUT                        SYSOUT   *
      ***                *
      ******************************************************************
      *  VERSION NO       :                                            *
      *  MODIFIED BY      :                                            *
      *  MODIFIED ON      : DD/MM/YYYY                                 *
      *  SHARPOWL NUMBER  :                                            *
      *  SHARPOWL PROJECT :                                            *
      *  MOD NUMBER       :                                            *
      *  COMMENTS         :                                            *
      ******************************************************************
      *
       ENVIRONMENT DIVISION.
      *
       CONFIGURATION SECTION.
      *
       INPUT-OUTPUT SECTION.
      *
       FILE-CONTROL.
      *
      *##############################################################
      *                       FILE-CONTROL
      *##############################################################
      *
           SELECT COPY-FILE
                  ASSIGN TO ICOPY
                  FILE STATUS IS WS-FS-ICOPY.
      *
       DATA DIVISION.
      *
       FILE SECTION.
      *
      *##############################################################
      *                     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.
      *
      *##############################################################
      *                    WORKING STORAGE
      *##############################################################
      *                       FILE STATUS
      *--------------------------------------------------------------
       01  WS-FS-FILE-STATUS-VARS.
           03  WS-FS-ICOPY             PIC X(02).
               88  ICOPY-OK            VALUE '00'.
               88  ICOPY-EOF           VALUE '10'.
      *
      *--------------------------------------------------------------
      *          ARRAY STORAGE FOR DATA LINES FROM COPYBOOK
      *--------------------------------------------------------------
       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).
      *
      *--------------------------------------------------------------
      *               ANALYSING VARIALBES / FLAGS
      *--------------------------------------------------------------
       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.
      *
      *--------------------------------------------------------------
      *                      ABEND PROCESSING
      *--------------------------------------------------------------
       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'.
      *
      *--------------------------------------------------------------
      *                      ERROR MESSAGES
      *--------------------------------------------------------------
       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.
      *
      *--------------------------------------------------------------
      *                 SAS REPORT HEADER LINES
      *--------------------------------------------------------------
       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'.
      *
      *--------------------------------------------------------------
      *                 SAS REPORT MID LINES
      *--------------------------------------------------------------
       01  WS-SAS-MIDDLE-1.
           03 FILLER            PIC X(30)       VALUE '  ;'.
           03 FILLER            PIC X(50)       VALUE
                 '  /* <<   END OF ''INPUT'' STATEMENTS  >> */'.
      *
      *--------------------------------------------------------------
      *                 SAS REPORT FOOTER LINES
      *--------------------------------------------------------------
       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 ;'.
      *
      *--------------------------------------------------------------
      *                 SAS REPORT LINES - 80 BYTES
      *--------------------------------------------------------------
       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.
      *
      *##############################################################
      *                    PROCEDURE DIVISION
      *##############################################################
      *
       A000 SECTION.
      ***************************************************************
      *                PROGRAM CONTROL SECTION
      ***************************************************************
       A000-START.
           PERFORM B000-INITIALISE.
           PERFORM C000-MAIN UNTIL ICOPY-EOF.
           PERFORM D000-TERMINATE.
           STOP RUN.
       A000-EXIT.
           EXIT.
      *
       B000-INITIALISE  SECTION.
      ***************************************************************
      *     OPEN COPYBOOK
      ***************************************************************
       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.
      ***************************************************************
      *                  MAIN PROCESSING 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.
      ***************************************************************
      * RESET ALL FLAG READY FOR THE PROCESSING OF THE NEXT LINE
      ***************************************************************
      *
           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.
      ***************************************************************
      * SCAN LINE OF COPYBOOK FOR CERTAIN KEYS WORDS
      ***************************************************************
      *
           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.
      ***************************************************************
      * FIND OCCURS NUMBER
      ***************************************************************
      *
           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.
      ***************************************************************
      * SCAN AND BREAKDOWN PICTURE CLAUSE
      ***************************************************************
      *
           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.
      ***************************************************************
      * CALCULATES THE NUMERIC WITHIN BRACKETS AND POSITION OF THEM
      ***************************************************************
      *
           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 REDEFINE DATA
      ***************************************************************
      *
      * 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.
      ***************************************************************
      * POPULATE COMPONENTS OF THE DATA LINE
      ***************************************************************
      *
      * INCREASE NUMBER OF ELEMENTS BY 1
           ADD 1 TO ARRAY-ELEMENTS.
           INITIALIZE ARRAY-DATA(ARRAY-ELEMENTS).
      * POPULATE WHOLE DATA LINE
           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 DATA HELD WITHIN ARRAY FOR OCCURS
      ***************************************************************
      *
      * 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.
      ***************************************************************
      * CALCULATE OFFSETS SETS AND CUM LENGTH
      ***************************************************************
      *
           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.
      ***************************************************************
      *
      ***************************************************************
      *
      * PRINT SAS HEADER LINES
           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
      *           REMOVE SPACES AND '-'
                   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.
      ***************************************************************
      *                  TERMINATION SECTION
      ***************************************************************
      *
           PERFORM C500-CALC-OFFSETS.
           PERFORM C600-CREATE-SAS.
      *
KDD   *-------------------------
KDD   * ARRAY DEBUGGING DISPLAYS
KDD   *-------------------------
KDD   *    PERFORM VARYING WS-SUB FROM 1 BY 1
KDD   *                           UNTIL WS-SUB > ARRAY-ELEMENTS
KDD   *        IF ARRAY-DATA-FIELD(WS-SUB) = 'Y' THEN
KDD   *        DISPLAY '-------------' WS-SUB ' --------------------'
KDD   *        DISPLAY              ARRAY-WHOLE-LINE(WS-SUB)
KDD   *        DISPLAY 'LEVEL # ' ARRAY-LEVEL(WS-SUB)
KDD   *               ' DATA Y/N # ' ARRAY-DATA-FIELD(WS-SUB)
KDD   *               ' SAS NO # ' ARRAY-SAS-NO(WS-SUB)
KDD   *        DISPLAY 'FIELD NAME # ' ARRAY-FIELD-NAME(WS-SUB)
KDD   *        DISPLAY 'REDEFINE Y/N # ' ARRAY-REDEFINE(WS-SUB)
KDD   *               ' REDEF NAME # ' ARRAY-REDEFINE-NAME(WS-SUB)
KDD   *        DISPLAY 'FIELD TYPE # ' ARRAY-FIELD-TYPE(WS-SUB)
KDD   *               ' SIGNED # ' ARRAY-SIGNED(WS-SUB)
KDD   *               ' WHOLE # ' ARRAY-WHOLE(WS-SUB)
KDD   *               ' DECIMALS # ' ARRAY-DECIMALS(WS-SUB)
KDD   *               ' LENGTH # ' ARRAY-LENGTH(WS-SUB)
KDD   *        DISPLAY 'START POS # ' ARRAY-START-POS(WS-SUB)
KDD   *               ' CUM POS # ' ARRAY-CUM(WS-SUB)
KDD   *        DISPLAY 'NO OF OCCURS # ' ARRAY-NO-OF-OCCURS(WS-SUB)
KDD   *               ' OCCURS 1 2 3 # ' ARRAY-OCCURS-L1(WS-SUB) ' '
KDD   *                                ARRAY-OCCURS-L2(WS-SUB) ' '
KDD   *                                ARRAY-OCCURS-L3(WS-SUB) ' '
KDD   *        END-IF
KDD   *    END-PERFORM.
      *
       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.
      ***************************************************************
      * READ COPYBOOK
      ***************************************************************
      *
           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.
      ***************************************************************
      *                 THIS IS THE ERROR HANDLER.
      ***************************************************************

           DISPLAY '*************************************************'.
           DISPLAY '*************************************************'.
           DISPLAY '***                                           ***'.
           DISPLAY '***             ABEND IN PARA ' WS-ABEND-SEC
                                                     '            ***'.
           DISPLAY '***                                           ***'.
           DISPLAY '***         PROGRAM ZB**** IS ABENDING        ***'.
           DISPLAY '***                                           ***'.
           DISPLAY   WS-ERROR-TEXT (WS-ERROR-CODE).
           DISPLAY '***                                           ***'.
           IF WS-FILE-STATUS > ZEROES
           DISPLAY '***           FILE STATUS : ' WS-FILE-STATUS
                                                 '                ***'
           END-IF.
           DISPLAY '***                                           ***'.
           DISPLAY '***         PROGRAM ZB**** IS ABENDING        ***'.
           DISPLAY '***                                           ***'.
           DISPLAY '*************************************************'.
           DISPLAY '*************************************************'.

           CALL 'ABEND' USING WS-ABEND-CODE WS-DUMP-FLAG.
       Z099-EXIT.
           EXIT.

Re: COBOL file conversion to readable format

PostPosted: Thu Apr 20, 2017 9:40 pm
by enrico-sorichetti
please certify that the code posted does not infringe/violate any IP rights

Re: COBOL file conversion to readable format

PostPosted: Fri Apr 21, 2017 9:55 am
by rakeshsneha1212
Hi Enrico,

It's all good from the code perspective. I have posted my code yesterday and now i see it as blank post any idea on this ??


Regards,
Rakesh MS

Re: COBOL file conversion to readable format

PostPosted: Fri Apr 21, 2017 11:19 am
by enrico-sorichetti
It's all good from the code perspective.

You mean that the code is in the public domain and freely available ???

I have posted my code yesterday and now i see it as blank post any idea on this ??

I edited the post to use the code tags to make the source readable
but it looks like phpBB does not handle well large amounts of CODEd data
the code should be visible now