1 2 3 4 5 6 7 8
12345678901234567890123456789012345678901234567890123456789012345678901234567890
*---------------------------------------------------------------
IDENTIFICATION DIVISION.
*---------------------------------------------------------------
PROGRAM-ID. PROGRATS.
AUTHOR. DORNELLES CARLOS ALBERTO.
*---------------------------------------------------------------
* SISTEMA : SICAD
* PROGRAMA : PROGRATS
* OBJETIVO : TESTE COM ALOCAÇÃO DE TS
* ANALISTA : DORNELLES CARLOS ALBERTO
* PROGRAMADOR: DORNELLES CARLOS ALBERTO
* DATA : OUTUBRO/2004
* LINGUAGEM : COBOL / DB2 / CICS
*
* MANUTENCOES/VERSOES:
* VERSAO PROGRAMADOR RESPONSAVEL DATA DESCRICAO
*
* XXX XXXXXXXXXXX XXXXXXXXXXX XXXXXXXX XXXXXXXXXXXXXXXXXX
*---------------------------------------------------------------
*---------------------------------------------------------------
ENVIRONMENT DIVISION.
*---------------------------------------------------------------
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
*---------------------------------------------------------------
DATA DIVISION.
*---------------------------------------------------------------
*---------------------------------------------------------------
WORKING-STORAGE SECTION.
*---------------------------------------------------------------
01 WS-AUXILIARES.
05 WS-IND PIC 9(003) VALUE 0.
05 WS-ITEM PIC S9(004) COMP VALUE +0.
05 WS-POS-INI PIC 9(003) VALUE 1.
05 WS-TAM-TS PIC S9(004) COMP VALUE +107.
01 WS-AREA-ENTRADA-SAIDA.
03 WS-QTD-ITENS-INF PIC 9(005).
03 WS-QTD-ITENS-TOT PIC 9(005).
03 WS-NOME-TS PIC X(008).
03 WS-FIM-TS PIC X(003).
01 TS-CADTB323.
03 323-NU-PLANO-DETALHADO PIC 9(010).
03 323-CO-TIPO-PLANO PIC X(001).
03 323-CO-USUARIO PIC X(008).
03 323-CO-SITUACAO-PO PIC X(003).
03 323-NU-UNE-GSA-INA-018 PIC 9(004).
03 323-NU-NTL-GSA-INA-018 PIC 9(009).
03 323-NU-UNIDADE-018 PIC 9(004).
03 323-NU-NATURAL-018 PIC 9(009).
03 323-AA-PLANO-325 PIC 9(004).
03 323-NU-ACAO-325 PIC 9(004).
03 323-NU-CONTROLE-325 PIC 9(004).
03 323-NU-UNIDADE-325 PIC 9(004).
03 323-NU-NATURAL-325 PIC 9(009).
03 323-AA-PLANO-324 PIC 9(004).
03 323-NU-CONTROLE-324 PIC 9(004).
03 323-NU-INA-324 PIC 9(004).
03 323-NU-ACAO-324 PIC 9(004).
03 323-NU-GRUPO-322 PIC 9(004).
03 323-NU-SUBGRUPO-322 PIC 9(004).
03 323-NU-ITEM-322 PIC 9(004).
03 323-NU-RUBRICA-322 PIC 9(004).
03 323-CO-PROJETO-322 PIC X(002).
01 WS-TMP-NOME.
03 WS-TMP-TERMID PIC X(002).
03 WS-TMP-MM PIC 9(006).
01 IND-FIM-CURSOR PIC 9(001) VALUE 0.
88 CND-FIM-CURSOR VALUE 1.
*---------------------------------------------------------------
LOCAL-STORAGE SECTION.
*---------------------------------------------------------------
*---------------------------------------------------------------
* DEFINICAO DE TABELAS E AREAS NA DCLGEN
*---------------------------------------------------------------
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL INCLUDE CADTB323 END-EXEC.
*---------------------------------------------------------------
* DEFINICAO DE CURSORES
*---------------------------------------------------------------
EXEC SQL
DECLARE C-PLANO-DTO CURSOR FOR
SELECT NU_PLANO_DETALHADO
VALUE(CO_TIPO_PLANO , ' ')
, VALUE(CO_USUARIO , ' ')
, VALUE(CO_SITUACAO_PO , ' ')
, VALUE(NU_UNE_GSA_INA_018 , 0 )
, VALUE(NU_NTL_GSA_INA_018 , 0 )
, VALUE(NU_UNIDADE_018 , 0 )
, VALUE(NU_NATURAL_018 , 0 )
, VALUE(AA_PLANO_325 , 0 )
, VALUE(NU_ACAO_325 , 0 )
, VALUE(NU_CONTROLE_325 , 0 )
, VALUE(NU_UNIDADE_325 , 0 )
, VALUE(NU_NATURAL_325 , 0 )
, VALUE(AA_PLANO_324 , 0 )
, VALUE(NU_CONTROLE_324 , 0 )
, VALUE(NU_INA_324 , 0 )
, VALUE(NU_ACAO_324 , 0 )
, VALUE(NU_GRUPO_322 , 0 )
, VALUE(NU_SUBGRUPO_322 , 0 )
, VALUE(NU_ITEM_322 , 0 )
, VALUE(NU_RUBRICA_322 , 0 )
, VALUE(CO_PROJETO_322 , ' ')
FROM CAD.CADTB323_PLANO_DTO TB323
ORDER BY NU_PLANO_DETALHADO
END-EXEC.
*---------------------------------------------------------------
LINKAGE SECTION.
*---------------------------------------------------------------
01 DFHCOMMAREA.
03 LK-GR-PARAMETRO.
05 LK-GR-EXCESSAO.
07 LK-NU-ERRO-CICS PIC 9(003).
07 LK-NU-MENSAGEM PIC 9(004).
07 LK-DE-MENSAGEM PIC X(078).
07 LK-NU-SQLCODE PIC -9(03).
05 LK-GR-IDENTIFICACAO.
07 LK-NO-PROGRAMA PIC X(008).
07 LK-CO-USUARIO PIC X(008).
07 LK-CO-FUNCAO PIC X(002).
05 LK-VR-TAMANHO PIC 9(005).
05 LK-GR-DADOS.
07 LK-VR-CONTEUDO PIC X(001)
OCCURS 0 TO 22000 DEPENDING ON LK-VR-TAMANHO.
*---------------------------------------------------------------
PROCEDURE DIVISION USING DFHCOMMAREA.
*---------------------------------------------------------------
PERFORM P0100-PROCEDIMENTOS-INICIAIS
PERFORM P0200-PROCEDIMENTOS-PRINCIPAIS
PERFORM P0900-PROCEDIMENTOS-FINAIS.
*---------------------------------------------------------------
P0100-PROCEDIMENTOS-INICIAIS.
*---------------------------------------------------------------
EXEC CICS
HANDLE CONDITION
ITEMERR(P0300-FIM-TS)
END-EXEC
INITIALIZE LK-GR-EXCESSAO
LK-GR-IDENTIFICACAO
MOVE LENGTH OF WS-AREA-ENTRADA-SAIDA TO LK-VR-TAMANHO
MOVE LK-GR-DADOS(1:LK-VR-TAMANHO) TO WS-AREA-ENTRADA-SAIDA.
P0100-FIM.
EXIT.
*---------------------------------------------------------------
P0200-PROCEDIMENTOS-PRINCIPAIS.
*---------------------------------------------------------------
IF WS-QTD-ITENS-INF EQUAL ZEROS
MOVE 'TS' TO WS-TMP-TERMID
MOVE EIBTASKN TO WS-TMP-MM
MOVE WS-TMP-NOME TO WS-NOME-TS
PERFORM P0201-TRATA-CURSOR
ELSE
PERFORM P0300-TRATA-TS
END-IF.
P0200-FIM.
EXIT.
*---------------------------------------------------------------
P0201-TRATA-CURSOR.
*---------------------------------------------------------------
EXEC SQL
OPEN C-PLANO-DTO
END-EXEC
PERFORM P0201A-LER-CURSOR
PERFORM UNTIL CND-FIM-CURSOR
PERFORM P0201B-MONTA-TS
PERFORM P0201A-LER-CURSOR
END-PERFORM
PERFORM P0300-TRATA-TS
EXEC SQL
CLOSE C-PLANO-DTO
END-EXEC.
P0201-FIM.
EXIT.
*---------------------------------------------------------------
P0201A-LER-CURSOR.
*---------------------------------------------------------------
EXEC SQL
FETCH C-PLANO-DTO
INTO :NU-PLANO-DETALHADO
, :CO-TIPO-PLANO
, :CO-USUARIO
, :CO-SITUACAO-PO
, :NU-UNE-GSA-INA-018
, :NU-NTL-GSA-INA-018
, :NU-UNIDADE-018
, :NU-NATURAL-018
, :AA-PLANO-325
, :NU-ACAO-325
, :NU-CONTROLE-325
, :NU-UNIDADE-325
, :NU-NATURAL-325
, :AA-PLANO-324
, :NU-CONTROLE-324
, :NU-INA-324
, :NU-ACAO-324
, :NU-GRUPO-322
, :NU-SUBGRUPO-322
, :NU-ITEM-322
, :NU-RUBRICA-322
, :CO-PROJETO-322
END-EXEC
IF SQLCODE NOT EQUAL +0
IF SQLCODE EQUAL +100
MOVE 1 TO IND-FIM-CURSOR
ELSE
MOVE 'HAHAHAHAHAHAHAH ERRO DE DB2' TO LK-DE-MENSAGEM
MOVE 216 TO LK-NU-MENSAGEM
PERFORM P0900-PROCEDIMENTOS-FINAIS
END-IF
END-IF.
P0201A-FIM.
EXIT.
*---------------------------------------------------------------
P0201B-MONTA-TS.
*---------------------------------------------------------------
ADD 1 TO WS-QTD-ITENS-TOT
MOVE CADTB323 TO TS-CADTB323
MOVE NU-PLANO-DETALHADO TO 323-NU-PLANO-DETALHADO
MOVE CO-TIPO-PLANO TO 323-CO-TIPO-PLANO
MOVE CO-USUARIO TO 323-CO-USUARIO
MOVE CO-SITUACAO-PO TO 323-CO-SITUACAO-PO
MOVE NU-UNE-GSA-INA-018 TO 323-NU-UNE-GSA-INA-018
MOVE NU-NTL-GSA-INA-018 TO 323-NU-NTL-GSA-INA-018
MOVE NU-UNIDADE-018 TO 323-NU-UNIDADE-018
MOVE NU-NATURAL-018 TO 323-NU-NATURAL-018
MOVE AA-PLANO-325 TO 323-AA-PLANO-325
MOVE NU-ACAO-325 TO 323-NU-ACAO-325
MOVE NU-CONTROLE-325 TO 323-NU-CONTROLE-325
MOVE NU-UNIDADE-325 TO 323-NU-UNIDADE-325
MOVE NU-NATURAL-325 TO 323-NU-NATURAL-325
MOVE AA-PLANO-324 TO 323-AA-PLANO-324
MOVE NU-CONTROLE-324 TO 323-NU-CONTROLE-324
MOVE NU-INA-324 TO 323-NU-INA-324
MOVE NU-ACAO-324 TO 323-NU-ACAO-324
MOVE NU-GRUPO-322 TO 323-NU-GRUPO-322
MOVE NU-SUBGRUPO-322 TO 323-NU-SUBGRUPO-322
MOVE NU-ITEM-322 TO 323-NU-ITEM-322
MOVE NU-RUBRICA-322 TO 323-NU-RUBRICA-322
MOVE CO-PROJETO-322 TO 323-CO-PROJETO-322
EXEC CICS
WRITEQ QUEUE(WS-TMP-NOME)
FROM(TS-CADTB323)
LENGTH(WS-TAM-TS)
END-EXEC.
P0201B-FIM.
EXIT.
*---------------------------------------------------------------
P0300-TRATA-TS.
*---------------------------------------------------------------
MOVE WS-NOME-TS TO WS-TMP-NOME
COMPUTE WS-ITEM = WS-QTD-ITENS-INF + 1
INITIALIZE TS-CADTB323
EXEC CICS
READQ QUEUE(WS-TMP-NOME)
INTO(TS-CADTB323)
LENGTH(WS-TAM-TS)
ITEM(WS-ITEM)
END-EXEC
MOVE 22 TO WS-POS-INI
*--- Bytes para retorno da área de entrada/saida
MOVE TS-CADTB323 TO LK-GR-DADOS(WS-POS-INI:WS-TAM-TS)
ADD WS-TAM-TS TO WS-POS-INI
PERFORM VARYING WS-IND FROM 1 BY 1
UNTIL WS-IND EQUAL 5
ADD 1 TO WS-ITEM
INITIALIZE TS-CADTB323
EXEC CICS
READQ QUEUE(WS-TMP-NOME)
INTO(TS-CADTB323)
LENGTH(WS-TAM-TS)
ITEM(WS-ITEM)
END-EXEC
MOVE TS-CADTB323 TO LK-GR-DADOS(WS-POS-INI:WS-TAM-TS)
ADD WS-TAM-TS TO WS-POS-INI
END-PERFORM.
*---------------------------------------------------------------
P0300-FIM-TS.
*---------------------------------------------------------------
COMPUTE WS-QTD-ITENS-INF = WS-QTD-ITENS-INF + WS-IND
MOVE WS-POS-INI TO LK-VR-TAMANHO
IF WS-ITEM NOT LESS WS-QTD-ITENS-TOT
MOVE 'SIM' TO WS-FIM-TS
EXEC CICS
DELETEQ QUEUE(WS-TMP-NOME)
END-EXEC
ELSE
MOVE 'NAO' TO WS-FIM-TS
END-IF
MOVE WS-AREA-ENTRADA-SAIDA TO LK-GR-DADOS(1:21).
P0300-FIM.
EXIT.
*---------------------------------------------------------------
P0900-PROCEDIMENTOS-FINAIS.
*---------------------------------------------------------------
IF LK-NU-MENSAGEM NOT EQUAL ZEROS
MOVE 100 TO LK-NU-SQLCODE
END-IF
EXEC CICS RETURN END-EXEC.
P0900-FIM.
EXIT.
|
