CALL for subroutine does not work

[Anonymous]

Hi, sorry for my English.
I've created a menu in COBOL that select subroutines using EVALUATE command.

It works perfectly at the first call, but, when it come back from the subroutine the CALL command does not work any more. It works just for the first time.

I'm using SCREEN SECTION to format the screens on menu and CRUD subroutines.

Any idea?

Thanks in advance.

following the code:

       IDENTIFICATION DIVISION.
       PROGRAM-ID. SCMP0100.
      *
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SPECIAL-NAMES.
           DECIMAL-POINT IS COMMA.
      *
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
      *
       DATA DIVISION.
       FILE SECTION.
       WORKING-STORAGE SECTION.
      *
       01 WS-COM-AREA.
           03 WS-MENSAGEM                      PIC X(20).
      *
       77 WS-OPCAO-MENU                        PIC X(01).
       77 WS-PROMPT                            PIC X(01).
      *
       77 WS-EXIT                              PIC X(01).
           88 EXIT-OK                          VALUE "S" FALSE "N".
      *
       LINKAGE SECTION.
      *
       01 LK-COM-AREA.
           03 LK-MENSAGEM                      PIC X(20).
      *
       SCREEN SECTION.
           01 SS-CLEAR-SCREEN.
           05 BLANK SCREEN.
      *
       01 SS-MENU-SCREEN.
           05 LINE 02 COL 05 VALUE "SISTEMA DE COMPRAS DE MERCADO".
           05 LINE 03 COL 05 VALUE
                   "SMCP0100 - Menu do Cadastro de Tipos de Produtos".
           05 LINE 04 COL 05 VALUE
           "------------------------------------------------------------
      -    "--------------".
           05 LINE 06 COL 05 VALUE
                             "<1> - INCLUSAO DE TIPOS DE PRODUTOS".
           05 LINE 07 COL 05 VALUE
                             "<2> - RELATORIO DE TIPOS DE PRODUTOS".
           05 LINE 08 COL 05 VALUE
                             "<3> - ALTERACAO DE TIPOS DE PRODUTOS".
           05 LINE 09 COL 05 VALUE
                             "<4> - EXCLUSAO DE TIPOS DE PRODUTOS".
           05 LINE 10 COL 05 VALUE
                             "<Q> - RETORNAR MENU PRINCIPAL".
           05 LINE 12 COL 05 VALUE
           "------------------------------------------------------------
      -    "--------------".
           05 LINE 13 COL 05 VALUE
                           "DIGITE A OPCAO DESEJADA: ".
           05 SS-OPCAO-MENU REVERSE-VIDEO PIC X(01)
                           USING WS-OPCAO-MENU.
           05 LINE 14 COL 05 VALUE
           "------------------------------------------------------------
      -    "--------------".
      *
       PROCEDURE DIVISION USING LK-COM-AREA.
      *
       MAIN-PROCEDURE.

           SET EXIT-OK                         TO FALSE.
      *
           PERFORM UNTIL EXIT-OK
               MOVE SPACES                     TO WS-OPCAO-MENU
      *
               DISPLAY SS-CLEAR-SCREEN
               DISPLAY SS-MENU-SCREEN
               ACCEPT  SS-MENU-SCREEN
      *
               EVALUATE WS-OPCAO-MENU
                   WHEN "1"
                       CALL "SCMP0101" USING WS-COM-AREA
                   WHEN "2"
                       CALL "SCMP0102" USING WS-COM-AREA
                   WHEN "3"
                       CALL "SCMP0103" USING WS-COM-AREA
                   WHEN "4"
                       CALL "SCMP0104" USING WS-COM-AREA
                   WHEN "Q"
                       SET EXIT-OK             TO TRUE
                   WHEN "q"
                       SET EXIT-OK             TO TRUE
                   WHEN OTHER
                       SET EXIT-OK             TO FALSE
               END-EVALUATE
           END-PERFORM.

           GOBACK.
       END PROGRAM SCMP0100.

           IDENTIFICATION DIVISION.
       PROGRAM-ID. SCMP0101.
      *
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SPECIAL-NAMES.
           DECIMAL-POINT IS COMMA.
      *
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT TP-PRODUTO ASSIGN TO
               "F:\Meus Docs - Disco Rigido\Desenv\Meus Projetos\COMPRAS
      -        "-MERCADO\Arquivos\TP-PRODUTO.dat"
                ORGANIZATION   IS INDEXED
                ACCESS         IS RANDOM
                RECORD KEY     IS COD-TIPO
                FILE STATUS    IS WS-FS-TP-PRODUTO.
      *
       DATA DIVISION.
       FILE SECTION.
       FD TP-PRODUTO.
           COPY "F:\Meus Docs - Disco Rigido\Desenv\Meus Projetos\COMPRA
      -         "S-MERCADO\Copybooks\TpProduto.cpy".

       WORKING-STORAGE SECTION.
      *
       01 WS-REG-TIPO-PRODUTO.
           05 WS-COD-TIPO                      PIC X(10).
           05 WS-DESC-TIPO                     PIC X(50).
      *
       77 WS-FS-TP-PRODUTO                     PIC X(02).
           88 WS-FS-OK                         VALUE "00".
           88 WS-FS-NAO-EXISTE                 VALUE "35".
      *
       77 WS-RESPOSTA-TELA                     PIC X(01).
           88 FLAG-SAIR                        VALUE "Q".
           88 FLAG-GRAVAR                      VALUE "S".
      *
       77 WS-MENSAGEM                          PIC X(50) VALUE SPACES.
       77 WS-PROMPT                            PIC X(01) VALUE SPACES.
      *
       LINKAGE SECTION.
      *
       01 LK-COM-AREA.
           03 LK-MENSAGEM                      PIC X(20).
      *
       SCREEN SECTION.
      *
       01 SS-CLEAR-SCREEN.
           05 BLANK SCREEN.
      *
       01 SS-INPUT-SCREEN.
           05 LINE 02 COL 05 VALUE "CADASTRO DE TIPOS DE PRODUTOS".
           05 LINE 03 COL 05 VALUE "SMCP0101 - Inclusao".
           05 LINE 04 COL 05 VALUE
           "------------------------------------------------------------
      -    "--------------".
           05 LINE 06 COL 05 VALUE "Tipo Porduto..: ".
           05 SS-COD-TIPO REVERSE-VIDEO PIC X(10)
                           USING WS-COD-TIPO.
           05 LINE 08 COL 05 VALUE "Desc Produto..: ".
           05 SS-DESC-TIPO REVERSE-VIDEO PIC X(50)
                           USING WS-DESC-TIPO.
           05 LINE 10 COL 05 VALUE
           "------------------------------------------------------------
      -    "--------------".
           05 LINE 11 COL 05 VALUE
                           "<S> para confirmar ou <Q> para Sair. ".
           05 SS-RESPOSTA-TELA REVERSE-VIDEO PIC X(01)
                           USING WS-RESPOSTA-TELA.
           05 LINE 12 COL 05 VALUE
           "------------------------------------------------------------
      -    "--------------".
      *
       01  SS-LINHA-DE-MENSAGEM.
           05 SS-MENSAGEM              PIC X(50) USING WS-MENSAGEM
                                               LINE 13 COL 05.
      *
       01  SS-LIMPA-MENSAGEM.
           05 LINE 13 BLANK LINE.
      *
       PROCEDURE DIVISION USING LK-COM-AREA.
      *
       MAIN-PROCEDURE.

           PERFORM P100-INICIALIZA THRU P100-FIM.

           PERFORM P300-CADASTRA THRU P300-FIM UNTIL FLAG-SAIR.

           PERFORM P900-FIM.

       P100-INICIALIZA.

           SET WS-FS-OK           TO  TRUE.

           OPEN I-O TP-PRODUTO

           IF WS-FS-NAO-EXISTE THEN
               OPEN OUTPUT TP-PRODUTO
           END-IF.
      *
           IF NOT WS-FS-OK THEN
               STRING "ERRO NA ABERTURA DO ARQUIVO FS: "
                       WS-FS-TP-PRODUTO    INTO WS-MENSAGEM
               DISPLAY SS-LINHA-DE-MENSAGEM
               ACCEPT WS-PROMPT AT 1301
               DISPLAY SS-LIMPA-MENSAGEM
               PERFORM P900-FIM
           END-IF.
      *
       P100-FIM.
      *
       P300-CADASTRA.
      *
           MOVE SPACES                         TO WS-COD-TIPO.
           MOVE SPACES                         TO WS-DESC-TIPO.
           MOVE SPACES                         TO WS-RESPOSTA-TELA.
      *
           DISPLAY SS-CLEAR-SCREEN.
           DISPLAY SS-INPUT-SCREEN.
           ACCEPT  SS-INPUT-SCREEN.
      *
           IF FLAG-GRAVAR THEN
               IF WS-COD-TIPO  EQUAL   SPACES THEN
                   MOVE "CODIGO DE TIPO INVALIDO." TO WS-MENSAGEM
                   DISPLAY SS-LINHA-DE-MENSAGEM
                   ACCEPT WS-PROMPT AT 1301
                   DISPLAY SS-LIMPA-MENSAGEM
               ELSE
                   MOVE WS-COD-TIPO                    TO COD-TIPO
                   MOVE WS-DESC-TIPO                   TO DESC-TIPO

                   WRITE   REG-TIPO-PRODUTO
                   IF NOT WS-FS-OK
                       IF WS-FS-TP-PRODUTO = "22" THEN
                           MOVE "TIPO DE PRODUTO JÁ CADATRADO"
                                                       TO WS-MENSAGEM
                           DISPLAY SS-LINHA-DE-MENSAGEM
                           ACCEPT WS-PROMPT AT 1301
                           DISPLAY SS-LIMPA-MENSAGEM
                       ELSE
                           MOVE "ERRO NA GRAVACAO DO ARQUIVO"
                                                       TO WS-MENSAGEM
                           DISPLAY SS-LINHA-DE-MENSAGEM
                           ACCEPT WS-PROMPT AT 1301
                           DISPLAY SS-LIMPA-MENSAGEM
                       END-IF
                   END-IF
               END-IF
           END-IF.
      *
       P300-FIM.
      *
       P900-FIM.
           CLOSE TP-PRODUTO.
           GOBACK.
       END PROGRAM SCMP0101.

[Simon Sobisch]

Hi Anonymous (registering/login helps to know how is writing and removes the manual moderation work)!

I don't know what "does not work" actually mean, can you elaborate?

In any case as something seems to be strange for you, I highly suggest to compile all the related sources with --debug which enables full runtime checks, often finding issues when they happen.
You may also want to compile with -W or even -Wextra to find potential coding/portability issues.