File identification and entry



Support for OS/VS COBOL, VS COBOL II, COBOL for OS/390 & VM and Enterprise COBOL for z/OS

File identification and entry

Postby vitorsadak » Thu Jun 13, 2013 8:50 pm

Hello Good Day I have a problem in the file identification and entry:

01 REG-ENTRY.
     05 Identificaction PIC X (01).
     05 ENTRY PIC X (299).

The following occurs when the file is to map identifying the following positions:

input file: 11248090004172

the file is coming as: 12480900041720

The file is picking up the identification of the next record in the case is the
'Date 04081982'. And so on every record he will taking the front.

_____What That can is occurring ? ________

Thank you!
vitorsadak
 
Posts: 6
Joined: Wed Jun 05, 2013 8:48 pm
Has thanked: 1 time
Been thanked: 0 time

Re: File identification and entry

Postby Robert Sample » Thu Jun 13, 2013 9:15 pm

Since you did not tell us enough information to help you:

1. Is the file variable length?
2. If so, how are you identifying the variable lengths -- OCCURS DEPENDING ON, mutliple 01 in the FD, RECORD VARYING DEPENDING ON clause?
3. Are you referncing the data in the 01 under the FD rather than using READ INTO a WORKING-STORAGE variable?
Robert Sample
Global moderator
 
Posts: 3720
Joined: Sat Dec 19, 2009 8:32 pm
Location: Dubuque, Iowa, USA
Has thanked: 1 time
Been thanked: 279 times

Re: File identification and entry

Postby BillyBoyo » Thu Jun 13, 2013 9:18 pm

Please take care to post your question in the correct part of the forum. Your question looks like it is to do with COBOL, so it has been moved there.

Does your input contain variable-length records? It is likely that you have "looked at" data which is beyond the end of the current record.

You'll have to show the FD and definitions associated with it, and the code which is referencing the data.
BillyBoyo
Global moderator
 
Posts: 3804
Joined: Tue Jan 25, 2011 12:02 am
Has thanked: 22 times
Been thanked: 265 times

Re: File identification and entry

Postby vitorsadak » Thu Jun 13, 2013 9:35 pm

Will improve over the question:
  FILE SECTION.
  FD ARQENTRA
      RECORD 300
      RECORDING MODE IS F
      RECORD LABEL IS OMITTED.
                                                        
  01 A. REG-ENTRAD
     05 IDENTIFY CAO PIC X (01).
     05 ENTRY PIC X (299).


-------------------------------------------------- -------------------
  RTN-0200-REGI SECTION.
* DISPLAY 'RTN-0200-REGI'
* DISPLAY 'INPUT' INPUT
      READ ARQENTRA
        AT END MOVE 1 TO END-REGISTRATION.
      DISPLAY 'IDENTIFICATION' IDENTIFICATION
        EVALUATE IDENTIFICATION
           WHEN 'H'
* DISPLAY 'RTN-0300-HEADER'
        PERFORM RTN-0300-HEADER
           WHEN '1 '
             MOVE TO INPUT REG-ENTER-TR1
      DISPLAY 'PROPOSAL NUMBER' NR-PROP-TR1
             MOVE-NR-PROP TR1 TO PROPOSAL
             MOVE TO CPF CPF-TR1-CONV-WS


Code'd
vitorsadak
 
Posts: 6
Joined: Wed Jun 05, 2013 8:48 pm
Has thanked: 1 time
Been thanked: 0 time

Re: File identification and entry

Postby BillyBoyo » Thu Jun 13, 2013 10:24 pm

You have a READ, you have AT END, and yet you continue processing after end-of-file.

You have no FILE-STATUS checking.

You haven't shown your entire EVALUATE.

Have you checked the content of your input file visually, not just by what you expect it to be?

Are you missing one byte from every record after the first, or is it "cumulative"?

We have Code tags for preserving the formatting with a fixed-pitch font. How did you format yours? Usually, multiple spaces are just sucked-up and ignored if leading/trailing or appear as one space if "significant".
BillyBoyo
Global moderator
 
Posts: 3804
Joined: Tue Jan 25, 2011 12:02 am
Has thanked: 22 times
Been thanked: 265 times

Re: File identification and entry

Postby Robert Sample » Thu Jun 13, 2013 10:32 pm

In addition to Billy's comments, use the Code tag to post a browse of the file, and show us what ISPF indicates the file attributes (LRECL, BLKSIZE, etc) are.

Furthermore, what you DID post is garbage -- it is not COBOL that can be compiled, so there is no way anyone here could possibly determine what mistake(s) you have made based upon that post.
Robert Sample
Global moderator
 
Posts: 3720
Joined: Sat Dec 19, 2009 8:32 pm
Location: Dubuque, Iowa, USA
Has thanked: 1 time
Been thanked: 279 times

Re: File identification and entry

Postby vitorsadak » Thu Jun 13, 2013 10:43 pm

BillyBoyo wrote:You have a READ, you have AT END, and yet you continue processing after end-of-file.

You have no FILE-STATUS checking.

You haven't shown your entire EVALUATE.

Have you checked the content of your input file visually, not just by what you expect it to be?

Are you missing one byte from every record after the first, or is it "cumulative"?

We have Code tags for preserving the formatting with a fixed-pitch font. How did you format yours? Usually, multiple spaces are just sucked-up and ignored if leading/trailing or appear as one space if "significant".


_________________________________________________________________________________________________________

Actually losing a byte of each record after the first, and is "cumulative" in front of record. example:

1: 111089110011912-14 input records is the first identification,

2: 10,891,100,119,120 - the output file is missing the first number after the identification of the record and adding the front that date 04081982
vitorsadak
 
Posts: 6
Joined: Wed Jun 05, 2013 8:48 pm
Has thanked: 1 time
Been thanked: 0 time

Re: File identification and entry

Postby BillyBoyo » Thu Jun 13, 2013 11:17 pm

Since your records are fixed-length, and a COBOL program will fail if reading a file whose fixed LRECL is not the same as the number of bytes defined for the record in the program, the most likely is that your input records are already messed up (you browse/view the dataset to check visually).

If they are not already messed up, then your program is doing it.

So check the file first, and let us know.

Seriously, how did you manage to format your program code originally?

This is how a line normally looks outside the Code tags if it has embedded space.

   This  is     how  a   line    normally looks outside    the Code tags if it has    embedded space.
BillyBoyo
Global moderator
 
Posts: 3804
Joined: Tue Jan 25, 2011 12:02 am
Has thanked: 22 times
Been thanked: 265 times

Re: File identification and entry

Postby dick scherrer » Fri Jun 14, 2013 12:12 am

Hello,

Suggest you post a couple of input records (in HEX).

How was the input data generated?
Hope this helps,
d.sch.
User avatar
dick scherrer
Global moderator
 
Posts: 6268
Joined: Sat Jun 09, 2007 8:58 am
Has thanked: 3 times
Been thanked: 93 times

Re: File identification and entry

Postby vitorsadak » Fri Jun 14, 2013 6:24 pm

IDENTIFICATION DIVISION.
PROGRAM-ID ES0111T.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT ARQENTRA ASSIGN TO RETORNO.
SELECT ARQSAI ASSIGN TO SAIDA.
DATA DIVISION.
FILE SECTION.
FD ARQENTRA
RECORD 300
RECORDING MODE IS F
LABEL RECORD IS OMITTED.

01 REG-ENTRADA.
05 IDENTIFICACAO PIC X(01).
05 ENTRADA PIC X(299).


FD ARQSAI
RECORD 610
RECORDING MODE IS F
LABEL RECORD IS OMITTED.

01 REG-SAIDA PIC X(610).

WORKING-STORAGE SECTION.

EXEC SQL INCLUDE SQLCA END-EXEC.
*----------------------------------------------------------------
* DCLGEN DA TABELA FUNCICEF
*----------------------------------------------------------------
EXEC SQL INCLUDE FUNCICEF END-EXEC.
*----------------------------------------------------------------
* DCLGEN DA TABELA AGENCCEF
*----------------------------------------------------------------
EXEC SQL INCLUDE AGENCCEF END-EXEC.
*----------------------------------------------------------------
* DCLGEN DA TABELA BENEFICIARIOS
*----------------------------------------------------------------
EXEC SQL INCLUDE BENEFICI END-EXEC.
*_______________________________________________________________*
*---------------------------------------------------------------*
* DESCRICãO DO REGISTRO DE CLIENTES (TIPO REGISTRO = 1) *
*_______________________________________________________________*

TIPO 1 01 REG-ENTRA-TR1.
05 TIPO-REG PIC X(01).
05 NR-PROP-TR1 PIC 9(14).
05 CPF-TR1 PIC 9(14).
05 DATA-NASC-TR1 PIC 9(08).
05 NOME-TR1 PIC X(40).
05 TIPO-PESS-TR1 PIC 9(01).
05 IDENTIDADE-TR1 PIC X(15).
05 ORG-EXPEDIDOR-TR1 PIC X(05).
05 UF-DO-ORG-EXPEDIDOR-TR1 PIC X(02).
05 ESTADO-CIVIL-TR1 PIC 9(01).
05 SEXO-TR1 PIC 9(01).
05 PROFISSAO-TR1 PIC 9(03).
05 DDD-RES-TR1 PIC 9(03).
05 TEL-RES-TR1 PIC 9(09).
05 DDD-COMERCIAL-TR1 PIC 9(03).
05 TEL-COMERCIAL-TR1 PIC 9(09).
05 DDD-FAX-TR1 PIC 9(03).
05 TEL-FAX-TR1 PIC 9(09).
05 DATA-EXP-RG-TR1 PIC 9(08).
05 COD-SEG-TR1 PIC X(04).
05 NOME-CONJ-TR1 PIC X(40).
05 DATA-NASC-CONJ-TR1 PIC X(08).
05 PROF-CONJ-TR1 PIC 9(03).
05 EMAIL-TR1 PIC X(50).
05 DESC-PROF-TR1 PIC X(40).
05 RENDA-IND-TR1 PIC 9(01).
05 RENDA-FAM-TR1 PIC 9(01).
05 FILA-VONIX-TR1 PIC 9(03).
*------------------------------------------------------------*
* DESCRICãO DO REGISTRO DE ENDERECO (TIPO REGISTRO = 2) *
*____________________________________________________________*

TIPO2 01 REG-ENT-TR2.
05 TIPO-REG-2 PIC X(01).
05 NR-PROP-TR2 PIC 9(14).
05 TIPO-ENDERECO-TR2 PIC 9(01).
05 ENDERECO-TR2 PIC X(50).
05 BAIRRO-TR2 PIC X(30).
05 CIDADE-TR2 PIC X(35).
05 UF-TR2 PIC X(02).
05 CEP-TR2 PIC 9(08).
05 FILLER PIC X(159).
*------------------------------------------------------------*
* DESCRICãO DO REGISTRO DE PROPOSTA (TIPO REGISTRO = 3) *
*____________________________________________________________*

TIPO3 01 REG-ENT-TR3.
05 TIPO-REG-3 PIC X(01).
05 NR-PROP-TR3 PIC 9(14).
05 NR-PROD-TR3 PIC 9(04).
05 AG-VENDA-TR3 PIC 9(04).
05 DATA-PROP-TR3 PIC 9(08).
05 TIPO-PGM-TR3 PIC 9(01).
05 AG-P-DEB-TR3 PIC 9(04).
05 OPERACAO-TR3 PIC 9(03).
05 NR-CONTA-PDEB-TR3 PIC 9(08).
05 DIGITO-CONTA-PDEB-TR3 PIC 9(01).
05 DECLARACAO-PESS-SAUDE-TIT-TR3 PIC X(07).
05 DECLARACAO-PESS-SAUDE-CONJ-TR3 PIC X(07).
05 MATR-VEND-TR3 PIC 9(08).
05 VLR-PRM-TOT-TR3 PIC 9(16).
05 APOSENTADORIA-INVAL-TR3 PIC X(01).
05 RENOV-AUTO-TR3 PIC X(01).
05 DIA-VENC-TR3 PIC 9(02).
05 PERC-DESC-TR3 PIC 9(05).
05 EMP-CONVENENTE-TR3 PIC X(40).
05 CNPJ-EMP-CONVENENTE-TR3 PIC 9(14).
05 MATRI-CONVENENTE-TR3 PIC 9(08).
05 SITUACAO-PROP-TR3 PIC X(03).
05 SITUACAO-COBRANCA-TR3 PIC X(03).
05 MOTIV-SITUACAO-TR3 PIC 9(03).
05 OPCAO-COB-TR3 PIC X(01).
05 COD-PLANO-TR3 PIC 9(04).
05 DATA-QUIT-TR3 PIC 9(08).
05 VALOR-PAGO-TR3 PIC X(15).
05 AG-PGM-TR3 PIC 9(04).
05 VLR-TARIFA-TR3 PIC X(15).
05 DATA-AG-TR3 PIC 9(08).
05 VLR-COMI-TR3 PIC X(15).
05 PERIODO-PAGAM-TR3 PIC 9(02).
05 OPC-CONJ-TR3 PIC X(01).
05 TIPO-RES-TR3 PIC 9(01).
05 VALOR-IOF-TR3 PIC 9(08).
05 CUSTO-APOLICE-TR3 PIC 9(08).
05 COD-OPR-TR3 PIC 9(03).
05 COD-RET-TR3 PIC 9(02).
05 NR-SICOB-TR3 PIC 9(13).
05 ORIGEM-PROP-TR3 PIC 9(04).
05 NR-SEQ-ARQ-TR3 PIC 9(06).
05 NR-SEQ-LINHA-TR3 PIC 9(06).
05 FILLER PIC X(10).
*------------------------------------------------------------*
* DESCRICãO DOS BENEFICIARIOS TIOPO DE REGISTRO = 4 *
*____________________________________________________________*

TIPO4 01 REG-ENT-TR4.
05 TIPO-REG-4 PIC X(01).
05 NOME-DO-BENEFI PIC X(40).
05 GRAU-PARENTE PIC X(01).
05 NOME-DAMAE PIC X(40).
05 NUMERO-DA-CARTEIRA PIC 9(15).
05 NUM-APOLICE PIC 9(13).
ARTR 01 AREA-TRAB-WS.
05 FIM-REGISTRO PIC 9(01) VALUE 0.
05 CPF-CONV-WS.
10 CPF-CONV-WS1 PIC 9(03).
10 CPF-CONV-WS2 PIC 9(03).
10 CPF-CONV-WS3 PIC 9(03).
10 CPF-CONV-WS4 PIC 9(02).
05 DATA-NASC-CONV-WS.
10 DATA-NASC-CONV-WSDIA PIC 9(02).
10 DATA-NASC-CONV-WSMES PIC 9(02).
10 DATA-NASC-CONV-WSANO PIC 9(04).
05 CEP-CONV-WS.
10 CEP-CONV-WS1 PIC 9(02).
10 CEP-CONV-WS2 PIC 9(03).
10 CEP-CONV-WS3 PIC 9(03).
05 DATA-PROP-CONV-WS.
10 DATA-PROP-CONV-WSDIA PIC 9(02).
10 DATA-PROP-CONV-WSMES PIC 9(02).
10 DATA-PROP-CONV-WSANO PIC 9(04).
05 MATRICULA-VEND-CONV-WS.
10 MATRICULA-VEND-CONV-WS1 PIC 9(03).
10 MATRICULA-VEND-CONV-WS2 PIC 9(03).
10 MATRICULA-VEND-CONV-WS3 PIC 9(01).
05 VALOR-PREMIO-CONV-WS.
10 VALOR-PREMIO-CONV-WS1 PIC 9(05).
10 VALOR-PREMIO-CONV-WS2 PIC 9(09).
10 VALOR-PREMIO-CONV-WS3 PIC 9(02).
01 CABECALHO-WS.
05 NUM-PROPOSTA-CAB PIC X(20) VALUE
'NUM PROP;'.
05 CPF-CAB PIC X(15) VALUE
'CPF;'.
05 DATA-NASCIMENTO-CAB PIC X(20) VALUE
'DATA NASCI;'.
05 NOME-PROPONENTE-CAB PIC X(40) VALUE
'NOME ;'.
05 DATA-PROPOSTA-CAB PIC X(20) VALUE
'DATA PROP;'.
05 IDADE-CAB PIC X(13) VALUE
'IDADE;'.
05 TIPO-PESS-CAB PIC X(13) VALUE
'TIPO PESSOA;'.
05 IDENTIDADE-CAB PIC X(13) VALUE
'IDENTIDADE;'.
05 ORG-EXPEDIDOR-CAB PIC X(13) VALUE
'ORGAO EXPEDI;'.
05 UF-EXPEDIDOR-CAB PIC X(04) VALUE
'UF ;'.
05 ESTADO-CIVIL-CAB PIC X(15) VALUE
'ESTADO CIVIL;'.
05 SEXO-CAB PIC X(07) VALUE
'SEXO;'.
05 PROFISSAO-CAB PIC X(10) VALUE
'PROFISSAO;'.
05 DDD-RESIDENCIAL-CAB PIC X(05) VALUE
'DDD;'.
05 FONE-RESIDENCIAL-CAB PIC X(06) VALUE
'FONE;'.
05 ENDERECO-CAB PIC X(10) VALUE
'ENDEREçO;'.
05 BAIRRO-CAB PIC X(08) VALUE
'BAIRRO;'.
05 CIDADE-CAB PIC X(08) VALUE
'CIDADE;'.
05 UNIDADE-FEDERATIVA-CAB PIC X(05) VALUE
'UF;'.
05 CEP-CAB PIC X(05) VALUE
'CEP;'.
05 AGENCIA-DE-VENDA-CAB PIC X(19) VALUE
'AGEN VENDA;'.
05 NOME-AGENCIA-VENDA-CAB PIC X(25) VALUE
'NOME AGEN VENDA;'.
05 AGENCIA-DEBITO-CAB PIC X(16) VALUE
'AGEN DEB;'.
05 NOME-AGENCIA-DEBITO-CAB PIC X(24) VALUE
'NOME AGEN DEB;'.
05 OP-CONTA-DEBITO-CAB PIC X(25) VALUE
'OP CONTA DEB;'.
05 NUM-CONTA-DEBITO-CAB PIC X(25) VALUE
'NUM CONTA DEB;'.
05 DIGITO-CONTA-DEBITO-CAB PIC X(25) VALUE
'DIG CONTA DEB;'.
05 MATRICULA-VENDEDOR-CAB PIC X(25) VALUE
'MATRI VEND;'.
05 NOME-VENDEDOR-CAB PIC X(17) VALUE
'NOME VEND;'.
05 VALOR-DO-PREMIO-CAB PIC X(18) VALUE
'VALOR DO PREMIO;'.
05 DIA-DO-VENCIMENTO-CAB PIC X(22) VALUE
'DIA VENC;'.
05 OPCAO-COBERTURA-CAB PIC X(17) VALUE
'OPCAO COB;'.
05 PERIODO-PAGAMENTO-CAB PIC X(20) VALUE
'PERIODO PAG;'.
05 NOME-DO-BENEFICIARIO PIC X(25) VALUE
'NOME DO BENEFICI'.
05 GRAU-PARENTESCO PIC X(18) VALUE
'GRAU PARENTE;'.
05 NOME-DA-MAE PIC X(15) VALUE
'NOME MAE;'.
05 NUMERO-DA-CARTEIRINHA PIC X(25) VALUE
'NUM CARTEIRINHA;'.
01 LIN-DETALHE.
05 PROPOSTA PIC 9(14).
05 FILLER PIC X(01) VALUE ';'.
05 CPF.
10 CPF1 PIC 9(03).
10 FILLER PIC X(01) VALUE '.'.
10 CPF2 PIC 9(03).
10 FILLER PIC X(01) VALUE '.'.
10 CPF3 PIC 9(03).
10 FILLER PIC X(01) VALUE '-'.
10 CPF4 PIC 9(04).
05 FILLER PIC X(01) VALUE ';'.
05 DATA-NASC.
10 DATA-NASC-DIA PIC 9(02).
10 FILLER PIC X(01) VALUE '/'.
10 DATA-NASC-MES PIC 9(02).
10 FILLER PIC X(01) VALUE '/'.
10 DATA-NASC-ANO PIC 9(04).
05 FILLER PIC X(10) VALUE ';'.
05 NOME PIC X(40).
05 FILLER PIC X(01) VALUE ';'.
05 DATA-PROP.
40 DATA-PROP-DIA PIC 9(02).
10 FILLER PIC X(01) VALUE '/'.
10 DATA-PROP-MES PIC 9(02).
10 FILLER PIC X(01) VALUE '/'.
10 DATA-PROP-ANO PIC 9(04).
05 FILLER PIC X(01) VALUE ';'.
05 IDADE PIC 9(02).
05 FILLER PIC X(01) VALUE ';'.
05 TIPO-PESSOA PIC X(09).
05 FILLER PIC X(01) VALUE ';'.
05 IDENTIDADE PIC X(15).
05 FILLER PIC X(01) VALUE ';'.
05 ORG-EXPEDIDOR PIC X(02).
05 FILLER PIC X(01) VALUE ';'.
05 UF-EXPEDIDOR PIC X(03).
05 FILLER PIC X(01) VALUE ';'.
05 ESTADO-CIVIL PIC X(11).
05 FILLER PIC X(01) VALUE ';'.
05 SEXO PIC X(10).
05 FILLER PIC X(01) VALUE ';'.
05 PROFISSAO PIC X(55).
05 FILLER PIC X(01) VALUE ';'.
05 DDD-RES PIC 9(02).
05 FILLER PIC X(01) VALUE ';'.
05 FONE-RESI.
10 NR-SP PIC X(01).
10 FONE-RESIDENCIAL PIC 9(09).
05 FILLER PIC X(01) VALUE ';'.
05 ENDERECO PIC X(72).
05 FILLER PIC X(01) VALUE ';'.
05 BAIRRO PIC X(72).
05 FILLER PIC X(01) VALUE ';'.
05 CIDADE PIC X(72).
05 FILLER PIC X(01) VALUE ';'.
05 UF PIC X(02).
05 FILLER PIC X(01) VALUE ';'.
05 CEP.
10 CEP1 PIC 9(02).
10 FILLER PIC X(01) VALUE '.'.
10 CEP2 PIC 9(03).
10 FILLER PIC X(01) VALUE '-'.
10 CEP3 PIC 9(03).
05 FILLER PIC X(01) VALUE ';'.
05 AGENCIA-VENDA PIC 9(04).
05 FILLER PIC X(01) VALUE ';'.
05 NOME-AGENCIA-VENDA PIC X(40).
05 FILLER PIC X(01) VALUE ';'.
05 AGENCIA-DEBITO PIC 9(04).
05 FILLER PIC X(01) VALUE ';'.
05 NOME-AGENCIA-DEBITO PIC X(40).
05 FILLER PIC X(01) VALUE ';'.
05 OPERACAO-CONTA-DEBITO PIC 9(03).
05 FILLER PIC X(01) VALUE ';'.
05 NR-CONTA-DEBITO PIC X(15).
05 FILLER PIC X(01) VALUE ';'.
05 DIGITO-CONTA-DEBITO PIC X(02).
05 FILLER PIC X(01) VALUE ';'.
05 MATRICULA-VENDEDOR.
10 MATRICULA-VENDEDOR1 PIC 9(03).
10 FILLER PIC X(01) VALUE '.'.
10 MATRICULA-VENDEDOR2 PIC 9(03).
10 FILLER PIC X(01) VALUE '-'.
10 MATRICULA-VENDEDOR3 PIC 9(01).
05 FILLER PIC X(01) VALUE ';'.
05 NOME-VENDEDOR PIC X(40).
05 FILLER PIC X(01) VALUE ';'.
05 VALOR-PREMIO.
10 VALOR-PREMIO1 PIC 9(09).
10 FILLER PIC X(01) VALUE ','.
10 VALOR-PREMIO2 PIC 9(02).
05 FILLER PIC X(01) VALUE ';'.
05 DIA-VENCIMENTO PIC 9(02).
05 FILLER PIC X(01) VALUE ';'.
05 OPCAO-COBERTURA PIC X(01).
05 FILLER PIC X(01) VALUE ';'.
05 PERIODO-PAGAMENTO PIC X(15).
05 FILLER PIC X(01) VALUE ';'.
05 NOME-BENEFICIARIO PIC X(40).
05 FILLER PIC X(01) VALUE ';'.
05 GRAU-DO-PARENTESCO PIC X(15).
05 FILLER PIC X(01) VALUE ';'.
05 NOMEDA-MAE PIC X(40).
05 FILLER PIC X(01) VALUE ';'.
05 NUMERODA-CARTEIRINHA PIC 9(15).
05 FILLER PIC X(01) VALUE ';'.
****************************************************************
* *
* COMEÇA A RODAR A PROCEDURE.. *
* *
****************************************************************

PROCEDURE DIVISION.

0100-MODULO-PRINCIPAL SECTION.
PERFORM 0101-INICIALIZAR
PERFORM RTN-0200-REGI UNTIL IDENTIFICACAO EQUAL 'T' OR
* PERFORM RTN-0200-REGI UNTIL ENTRADA EQUAL 'T' OR
FIM-REGISTRO = 1
PERFORM 0500-RTN-FIM.

0100-MODULO-FECHAR SECTION. EXIT.
* -------------------------------------------------------- *

************************************************************
* MODULO DE INICIALIZAÇÃO *
* *
************************************************************

0101-INICIALIZAR SECTION.
* DISPLAY '0101-INICIALIZAR'
OPEN INPUT ARQENTRA
OUTPUT ARQSAI.
0111-FECHAR SECTION.
EXIT.

************************************************************
* ARQUIVO DE FECHAR *
************************************************************

0500-RTN-FIM SECTION.
* DISPLAY '0500-RTN-FIM'
CLOSE ARQENTRA
ARQSAI
STOP RUN.
0501-FECHAR SECTION.
EXIT.

RTN-0200-REGI SECTION.
DISPLAY 'RTN-0200-REGI'
DISPLAY 'ENTRADA ' ENTRADA
READ ARQENTRA
AT END MOVE 1 TO FIM-REGISTRO.
EVALUATE IDENTIFICACAO
WHEN 'H'
DISPLAY 'RTN-0300-CABECALHO'
PERFORM RTN-0300-CABECALHO
TIPO 1 WHEN '1'
MOVE ENTRADA TO REG-ENTRA-TR1
MOVE NR-PROP-TR1 TO PROPOSTA
MOVE CPF-TR1 TO CPF-CONV-WS
MOVE CPF-CONV-WS1 TO CPF1
MOVE CPF-CONV-WS2 TO CPF2
MOVE CPF-CONV-WS3 TO CPF3
MOVE CPF-CONV-WS4 TO CPF4
MOVE DATA-NASC-TR1 TO DATA-NASC-CONV-WS
DISPLAY 'DATA-NASC-CONV-WS'
DIA MOVE DATA-NASC-CONV-WSANO TO DATA-NASC-ANO
MES MOVE DATA-NASC-CONV-WSMES TO DATA-NASC-MES
ANO MOVE DATA-NASC-CONV-WSDIA TO DATA-NASC-DIA
MOVE NOME-TR1 TO NOME
EVALUATE TIPO-PESS-TR1
WHEN 1 MOVE 'FISICA' TO TIPO-PESSOA
WHEN 2 MOVE 'JURIDICO' TO TIPO-PESSOA
END-EVALUATE
MOVE IDENTIDADE-TR1 TO IDENTIDADE
MOVE ORG-EXPEDITOR-TR1 TO ORG-EXPEDIDOR
MOVE UF-DO-ORG-EXPEDITOR-TR1 TO UF-EXPEDIDOR
MOVE PROFISSAO-TR1 TO PROFISSAO
EVALUATE ESTADO-CIVIL-TR1
WHEN 1 MOVE 'SOLTEIRO' TO ESTADO-CIVIL
WHEN 2 MOVE 'CASADO' TO ESTADO-CIVIL
WHEN 3 MOVE 'VIUVO' TO ESTADO-CIVIL
WHEN 4 MOVE 'OUTROS' TO ESTADO-CIVIL
WHEN 5 MOVE 'DIVORCIADO' TO ESTADO-CIVIL
WHEN 6 MOVE 'SEPARADO JUDICIALMENTE' TO ESTADO-CIVIL
END-EVALUATE
EVALUATE SEXO-TR1
WHEN 1 MOVE 'MASCULINO' TO SEXO
WHEN 2 MOVE 'FEMININO' TO SEXO
END-EVALUATE
MOVE DDD-RES-TR1 TO DDD-RES
IF DDD-RES = 21
MOVE 9 TO NR-SP
END-IF
MOVE TEL-RES-TR1 TO FONE-RESIDENCIAL
TIPO 2 WHEN '2'
MOVE ENTRADA TO REG-ENT-TR2
* MOVE ENTRADA TO TIPO-REG-2
IF TIPO-ENDERECO-TR2 = 1
MOVE ENDERECO-TR2 TO ENDERECO
MOVE BAIRRO-TR2 TO BAIRRO
MOVE CIDADE-TR2 TO CIDADE
MOVE UF-TR2 TO UF
MOVE CEP-TR2 TO CEP-CONV-WS
MOVE CEP-CONV-WS1 TO CEP1
MOVE CEP-CONV-WS2 TO CEP2
MOVE CEP-CONV-WS3 TO CEP3
END-IF
TIPO 3 WHEN '3'
MOVE ENTRADA TO REG-ENT-TR3
* MOVE ENTRADA TO TIPO-REG-3
MOVE DATA-PROP-TR3 TO DATA-PROP-CONV-WS
DIA MOVE DATA-PROP-CONV-WSDIA TO DATA-PROP-DIA
MES MOVE DATA-PROP-CONV-WSMES TO DATA-PROP-MES
ANO MOVE DATA-PROP-CONV-WSANO TO DATA-PROP-ANO
MOVE AG-VENDA-TR3 TO AGENCIA-VENDA
* ACESSO A TEBELA DE VENDAS UNSANDO COD AGENCIA INICIO
MOVE AGENCIA-VENDA TO AGENCCEF-COD-AGENCIA
PERFORM RTN-777-ACESSARTABELAS
MOVE AGENCCEF-NOME-AGENCIA TO NOME-AGENCIA-VENDA
*ACESSA TABELA VENDAS USANDO COD AGENCIA VENDA FIM
MOVE AG-P-DEB-TR3 TO AGENCIA-DEBITO
MOVE AGENCIA-DEBITO TO AGENCCEF-COD-AGENCIA
PERFORM RTN-777-ACESSARTABELAS
MOVE AGENCCEF-NOME-AGENCIA TO NOME-AGENCIA-DEBITO
MOVE OPERACAO-TR3 TO OPERACAO-CONTA-DEBITO
MOVE NR-CONTA-PDEB-TR3 TO NR-CONTA-DEBITO
MOVE DIGITO-CONTA-PDEB-TR3 TO DIGITO-CONTA-DEBITO
MOVE MATR-VEND-TR3 TO MATRICULA-VEND-CONV-WS
MOVE MATR-VEND-TR3 TO FUNCICEF-NUM-MATRICULA
DISPLAY 'FUNCICEF-NUM:'
DISPLAY 'FUNCICEF-NUM-MATRICULA'
PERFORM RTN-888-ACESSARTABELAS
MOVE FUNCICEF-NOME-FUNCIONARIO TO NOME-VENDEDOR
DISPLAY 'FUNCICEF-NOME'
DISPLAY 'FUNCICEF-NOME-FUNCIONARIO'
MOVE MATRICULA-VEND-CONV-WS1 TO MATRICULA-VENDEDOR1
MOVE MATRICULA-VEND-CONV-WS2 TO MATRICULA-VENDEDOR2
MOVE MATRICULA-VEND-CONV-WS3 TO MATRICULA-VENDEDOR3
MOVE VLR-PRM-TOT-TR3 TO VALOR-PREMIO-CONV-WS
MOVE VALOR-PREMIO-CONV-WS2 TO VALOR-PREMIO1
MOVE VALOR-PREMIO-CONV-WS3 TO VALOR-PREMIO2
MOVE DIA-VENC-TR3 TO DIA-VENCIMENTO
MOVE OPCAO-COB-TR3 TO OPCAO-COBERTURA
EVALUATE PERIODO-PAGAM-TR3
WHEN 01 MOVE 'MENSAL' TO PERIODO-PAGAMENTO
WHEN 02 MOVE 'BIMESTRAL' TO PERIODO-PAGAMENTO
WHEN 03 MOVE 'TRIMESTRAL' TO PERIODO-PAGAMENTO
WHEN 06 MOVE 'SEMESTRAL' TO PERIODO-PAGAMENTO
WHEN 12 MOVE 'ANUAL' TO PERIODO-PAGAMENTO
WHEN 13 MOVE 'A VISTA' TO PERIODO-PAGAMENTO
WHEN 00 MOVE 'PAGAMENTO UNICO' TO PERIODO-PAGAMENTO
END-EVALUATE
SUBTRACT DATA-NASC-ANO FROM DATA-PROP-ANO
GIVING IDADE
TIPO4 WHEN '4'
MOVE ENTRADA TO REG-ENT-TR4
* MOVE ENTRADA TO TIPO-REG-4
PERFORM RTN-999-ACESSARTABELAS
MOVE BENEFICI-NOME-BENEFICIARIO TO NOME-DO-BENEFI
MOVE NOME-DO-BENEFI TO NOME-BENEFICIARIO
MOVE BENEFICI-GRAU-PARENTESCO TO GRAU-PARENTE
MOVE GRAU-PARENTE TO GRAU-DO-PARENTESCO
MOVE BENEFICI-NOM-MAE TO NOME-DAMAE
MOVE NOME-DAMAE TO NOMEDA-MAE
MOVE BENEFICI-NUM-CARTEIRINHA TO NUMERO-DA-CARTEIRA
MOVE NUMERO-DA-CARTEIRA TO NUMERODA-CARTEIRINHA
* PERFORM RTN-999-ACESSARTABELAS
MOVE NUM-APOLICE TO BENEFICI-NUM-APOLICE
DISPLAY 'LIN-DETALHE ' LIN-DETALHE
WRITE REG-SAIDA FROM LIN-DETALHE
END-EVALUATE.
RTN-0200-REGI-SAIDA. EXIT.

***________________CABECALHO DE ROTINA___________________***

RTN-0300-CABECALHO SECTION.
* DISPLAY 'RTN-0300-CABECALHO'
WRITE REG-SAIDA FROM CABECALHO-WS.
RTN-0300-SAIDA. EXIT.

************ TABELA SEGUROS.AGENCIA.CEF ********************

RTN-777-ACESSARTABELAS SECTION.
* DISPLAY 'RTN-777-ACESSARTABELAS'
EXEC SQL
SELECT NOME_AGENCIA
INTO :AGENCCEF-NOME-AGENCIA
FROM SEGUROS.AGENCIAS_CEF
WHERE COD_AGENCIA = :AGENCCEF-COD-AGENCIA
END-EXEC.

RTN-777-SAIDA. EXIT.



************ TABELA SEGUROS.FUNCIONARIOS CEF.***************
RTN-888-ACESSARTABELAS SECTION.

EXEC SQL
SELECT NOME_FUNCIONARIO
INTO :FUNCICEF-NOME-FUNCIONARIO
FROM SEGUROS.FUNCIONARIOS_CEF
WHERE NUM_MATRICULA = :FUNCICEF-NUM-MATRICULA
END-EXEC.

RTN-888-SAIDA. EXIT.
*********** TABELA SEGUROS.BENEFICIARIO CEF.***************

RTN-999-ACESSARTABELAS SECTION.

EXEC SQL
SELECT NOME_BENEFICIARIO,
GRAU_PARENTESCO,
NOM_MAE,
NUM_CARTEIRINHA
INTO :BENEFICI-NOME-BENEFICIARIO,
:BENEFICI-GRAU-PARENTESCO,
:BENEFICI-NOM-MAE,
:BENEFICI-NUM-CARTEIRINHA
FROM SEGUROS.BENEFICIARIOS
WHERE NUM_APOLICE = :BENEFICI-NUM-APOLICE
END-EXEC.

RTN-999-SAIDA. EXIT.


vitorsadak
 
Posts: 6
Joined: Wed Jun 05, 2013 8:48 pm
Has thanked: 1 time
Been thanked: 0 time

Next

Return to IBM Cobol

 


  • Related topics
    Replies
    Views
    Last post