Separation of data by groups

[Augusto Manzano]

Hello again.

I'm having a problem that I'm not able to solve. I want to separate a data group by category.
Reference: GnuCOBOL 2.0 with OpenCobolIDE 4.7.6.

If the file contains the data:

88 - 150       - TICO
77 - 250       - BUD
99 - 300       - PAUL
88 - 350       - PETERSON
88 - 400       - JOSEPH
99 - 600       - BILL
88 - 650       - PETER
99 - 900       - AUDREY

Should present:

77 - 250       - BUD
88 - 150       - TICO
88 - 350       - PETERSON
88 - 400       - JOSEPH
88 - 650       - PETER
99 - 300       - PAUL
99 - 600       - BILL
99 - 900       - AUDREY

But it presents

88 - 400       - JOSEPH
99 - 300       - PAUL
99 - 600       - BILL
99 - 900       - AUDREY

I have already performed several tests, consulted manuals on COBOL and all the guidelines I found do not lead me to the intended objective. There is someone who can help. Thanks in advance.

Here is the code I am having problems with:

       IDENTIFICATION DIVISION.
       PROGRAM-ID. LARQSQIX.

       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT FD-VIRTUAL ASSIGN TO "FILESEI.DAT"
           ORGANIZATION      IS INDEXED
           ACCESS            IS SEQUENTIAL
           RECORD KEY        IS F001-EMPCOD
           ALTERNATE KEY     IS F003-DEPMT WITH DUPLICATES
           FILE STATUS       IS WS-PICK-ERRO.

       DATA DIVISION.
       FILE SECTION.
       FD  FD-VIRTUAL.
       01  FS-EMPREG.
           05 F001-EMPCOD   PIC X(09).
           05 F002-NAME     PIC X(40).
           05 F003-DEPMT    PIC 99.

       WORKING-STORAGE SECTION.
       77  WS-PICK-ERRO     PIC XX.

       LOCAL-STORAGE SECTION.
       01  TB-VIRTUAL.
           05 TB-EMPREG.
              10 LS-EMPCOD  PIC X(09).
              10 LS-NAME    PIC X(40).
              10 LS-DEPMT   PIC 99.       
       77  LS-ENTER         PIC X.
       77  LS-ANSR          PIC A VALUE "Y".
       77  LS-EOF           PIC X VALUE "F".

       PROCEDURE DIVISION.
      *    Input: data
           OPEN EXTEND FD-VIRTUAL.
           IF WS-PICK-ERRO = "35"
              OPEN OUTPUT FD-VIRTUAL
           END-IF
           DISPLAY "EMPLOYEE REGISTRATION"
           DISPLAY "---------------------"
           IF WS-PICK-ERRO = "00"
              PERFORM FOREVER
                 DISPLAY X"0D"
                 DISPLAY "Code ........: " WITH NO ADVANCING
                 ACCEPT LS-EMPCOD
                 DISPLAY "Name ........: " WITH NO ADVANCING
                 ACCEPT LS-NAME
                 DISPLAY "Department ..: " WITH NO ADVANCING
                 ACCEPT LS-DEPMT
                 WRITE FS-EMPREG FROM TB-EMPREG
                    INVALID KEY 
                       DISPLAY X"0D"
                       DISPLAY "Existing record."
                    NOT INVALID KEY
                       DISPLAY X"0D"
                       DISPLAY "Data registered successfully."
                 END-WRITE
                 DISPLAY X"0D"
                 DISPLAY "More recors (Y) for YES " WITH NO ADVANCING
                 DISPLAY "- any key for NOT: "
                    WITH NO ADVANCING
                 ACCEPT LS-ANSR
                 IF UPPER-CASE(LS-ANSR) NOT = "Y"
                    EXIT PERFORM
                 END-IF
              END-PERFORM
           END-IF.
           CLOSE FD-VIRTUAL.
      *    Outuput: data  
           DISPLAY LOW-VALUES
           OPEN INPUT FD-VIRTUAL.
           PERFORM UNTIL LS-EOF = "T"

              MOVE LS-DEPMT TO F003-DEPMT
              START FD-VIRTUAL
                 INVALID KEY 
                    CLOSE FD-VIRTUAL
                    STOP RUN
              END-START
              READ FD-VIRTUAL 
                 AT END
                    MOVE "T" TO LS-EOF
              END-READ
              MOVE LS-DEPMT TO F003-DEPMT


              START FD-VIRTUAL KEY IS > F003-DEPMT
              END-START
              READ FD-VIRTUAL INTO TB-EMPREG
                 AT END
                    MOVE "T" TO LS-EOF
                 NOT AT END
                    WRITE FS-EMPREG FROM TB-EMPREG
                    DISPLAY LS-DEPMT " - " LS-EMPCOD " - " LS-NAME
              END-READ  
           END-PERFORM
           CLOSE FD-VIRTUAL. 

           DISPLAY X"0D".
           DISPLAY "Press <ENTER> to finish... " WITH NO ADVANCING.
           ACCEPT LS-ENTER.
           STOP RUN.

       900-MENSAGEM                SECTION.
           DISPLAY "New search: (Y) for YES " WITH NO ADVANCING.
           DISPLAY "- any key for NOT: "
              WITH NO ADVANCING.
           ACCEPT LS-ANSR.
           EXIT.

       END PROGRAM LARQSQIX.

[Ralph Linkletter]

Use ACCESS IS DYNAMIC (Not Sequential)
OPEN I-O (not Extend)
Afte each file operation test the status code.
Test Ws-Pick-Errno after each file operation.
Doing so will enable you to ascertain what wrong, when.

I believe you have open input and will execute
WRITE FS-EMPREG FROM TB-EMPREG
That won't work
Test the status code

[Simon Sobisch]

Reference: GnuCOBOL 2.0 with OpenCobolIDE 4.7.6.

I highly suggest to exchange the very outdated GnuCOBOL version from 2016.
To do so:

• exit OCIDE
• download the latest build (3.1-rc1 dated yesterday) from Arnold, extract it to a folder "gnucobol"
• rename OpenCobolIde\gnucobol to OpenCobolIde\gnucobol_2.0
• move the extracted gnucobol folder to OpenCobolIde\gnucobol
• start OCIDE, for validation go to preferences [F2] and then "check compiler"
• enjoy better messages, much less bugs and new features

[Augusto Manzano]

Hello, Simon Sobisch.

Thank you for your collaboration. Yes, I will do the update. At the moment, I still need to keep version 2.0 in use.

[Augusto Manzano]

First of all thank you very much, Ralph Linkletter.

So it is not possible to do this type of operation with SEQUENTIAL? Interesting!!!

I may be mistaken, but this information is not very clear in the manuals.

[Ralph Linkletter]

ISAM sequential writes are certainly ok.
However I think that ISAM sequential writes require an ascending key sequence.
I may be wrong on that, but it sure makes a difference in load time for an ISAM file.

You need to routinely check status codes. That is almost a required practice.
I think you will see status code '02' indicating a duplicate entry in the alternate index.
That is ok. More or less informative. Only germane if duplicates are allowed in the alternate index.

Is your example program recursive ? That is does the program call itself ?
If not why the local storage ?
Ralph

[Augusto Manzano]

Hello Ralph.
Thanks again. The program is not recursive. Local use is just a personal habit.

[Simon Sobisch]

One other reason to consider LOCAL-STORAGE: if the program leaves this memory is always de-allocated - that's quite useful if you don't need to preserve it during runs.

[Augusto Manzano]

Hello, Simon Sobisch.

There is no other reason. It is a personal custom that I have. I prefer to use local variables in any language I use or learn. But if this is not a good habit for COBOL I modify it and start using WORKING-STORAGE. I appreciate the guidance and note. In your experience, as I am new to COBOL, what better attitude?

[Simon Sobisch]

It is completely no bad habbit, just uncommon to many COBOLeros (and not compatible with old compilers).
My personal take: If the program is called very often: keep most in WORKING-STORAGE to prevent regular allocation/deallocation, as a general rule: for big data you don't need most of the time the program runs: use BASED variables with a manual ALLOCATE / FREE (= scope the variable's data allocation); but especially with COBOL you'll find a lot of different "tastes" and when working with COBOL often also have some local rules what do (not) do/use.

[Augusto Manzano]

I will change this habit, even if it is not a bad thing. Thanks for the guidance and time dedicated to me.

As I said, I'm new to COBOL, I'm still a long way from being a COBOLero, but with the help of friendly people to get there.

[Eugenio Di Lorenzo]

Another way to always have the working-storage variables in their initial state with each run is to specify:

PROGRAM-ID program-name IS INITIAL.

This works in other compilers (e.g. Realia COBOL),
I don't know if it has been implemented in GnuCOBOL or not yet.

[Simon Sobisch]

Yes, this is implemented in GnuCOBOL since quite a long time.
Note: this doesn't do anything about the allocation though - you still would to have to do a CANCEL and run with COB_PHYSICAL_CANCEL=1 to free the memory on program exit.

[Augusto Manzano]

Hi, Simon.

Interesting!!!

[Augusto Manzano]

Hello, Eugenio Di Lorenzo.

Thank you for this guidance. I consulted the GnuCOBOL 2.0 manual and the INITIAL clause is included in PROGRAM-ID.