* *================================================================* * FUTURE SCHOOL * *----------------------------------------------------------------* * * * PROGRAMA......: PGEXCL1 - LINGUAGEM ASSEMBLY (ON-LINE) * * MAPA..........: MAP3ASM - LINGUAGEM ASSEMBLY * * TRANSACAO.....: EXC1 * * ARQUIVO...VSAM: CADCONS - COM TAMANHO DE 121 POSICOES * * CHAVE NAS PRIMEIRAS 5 POSICOES * * DATA..........: 05/2023 * * AUTOR.........: LESSA * * * * OBJETIVO...: EXCLUSAO DE CODIGOS CADASTRAIS * * * *----------------------------------------------------------------* * PRINT NOGEN DFHEISTG DSECT * R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 * * AREA DE COMUNICACAO (COMAREA) * COMAREA DS 0CL5 FASE DS CL5 * REGISTRO DS CL121 CODIREG DS CL5 RAZAO DS CL30 ENDER DS CL50 TELEF DS CL16 CONTATO DS CL20 SPACE * * LAYOUT DO CADASTRO COM 121 POSICOES * WKS_CADCONS DS CL121 WKS_CODIGO DS 0CL5 WKS_RAZAO DS CL30 WKS_ENDER DS CL50 WKS_TELEF DS CL16 WKS_CONTATO DS CL20 * * AREAS AUXILIARES * DATASET DS CL8 POSIS DS XL2 AUXTIME DS PL8 QFASES DS CL8 AUXCICS DS CL8 DDMMAAAA DS CL10 AADDD DS CL6 DATAJUL DS PL3 * AUXHORA DS CL8 RESPONSE DS 1F RESP DS XL2 DOUBLE DS D TAMANHO DS H * COPY DFHBMSCA COPY DFHAID COPY MAP3ASM SPACE * *-------------------------------------- * INICIO DO PROGRAMA *-------------------------------------- PGEXCL1 DFHEIENT CODEREG=R3,DATAREG=R13,EIBREG=R11 PGEXCL1 AMODE 31 PGEXCL1 RMODE ANY * INICIO EQU * * EXEC CICS ASSIGN APPLID (AUXCICS) NOHANDLE MVC TPOPERGO(09),=C'EXCLUSAO ' CLC EIBCALEN,=H'0' PRIMEIRA VEZ. BNE RETORNO XC MAP3ASMO(MAP3ASMI-MAP3ASMO),MAP3ASMO CLEAR MAP MVC TPOPERGO(09),=C'EXCLUSAO ' MVI TPOPERGA,X'61' DFHBMPRF MVC TPCICGO(8),AUXCICS MVI TPCICGA,X'61' * BAL R7,PEGDATA MVI DATAGA,X'61' MVI TRANSGA,X'61' MVC TRANSGO(4),=C'EXC1' MVI HORAGA,X'61' MVI TERMGA,X'61' MVI PROGGA,X'61' MVC TERMGO,EIBTRMID MVC PROGGO(8),=C'PGEXCL1 ' MVI CODIGA,X'C1' DFHBMFSE MVC CODIGO(5),X'F0' MVI RAZAOGA,X'61' MVC RAZAOGO(30),=CL30' ' MVI ENDERGA,X'61' MVC ENDERGO(50),=CL50' ' MVC TELEFGO(16),X'F0' MVI TELEFGA,X'61' MVI CONTAGA,X'61' MVC CONTAGO(20),X'40' MVC MENSAGO(60),=CL60' ' MVC POSIS,=H'0585' POSICIONA NO PRIMEIRO BYTE DO CODIGO MVC FASE(5),=C'FASE1' MVC CODIREG(5),CODIGO MVC VERFASEO(5),FASE BAL R7,ENVTELA B RETTRAN * *-------------------------------------- * ROTINA PARA PEGAR DATA E HORA *-------------------------------------- PEGDATA EQU * EXEC CICS ASKTIME ABSTIME(AUXTIME) NOHANDLE * EXEC CICS FORMATTIME X ABSTIME (AUXTIME) X DDMMYYYY (DDMMAAAA) X NOHANDLE * MVI DATAGA,X'61' MVI TRANSGA,X'61' MVI HORAGA,X'61' MVI TERMGA,X'61' MVC TERMGO,EIBTRMID MVC PROGGO(8),=C'PGEXCL1 ' MVC TRANSGO(4),=C'EXC1' MVC TPOPERGA,X'F8' MVC TPCICGO(8),AUXCICS MVC DATAGO(2),DDMMAAAA MVI DATAGO+2,C'/' MVC DATAGO+3(2),DDMMAAAA+2 MVI DATAGO+5,C'/' MVC DATAGO+6(4),DDMMAAAA+4 UNPK DOUBLE,EIBTIME MVC HORAGO(2),DOUBLE+2 MVI HORAGO+2,C':' MVC HORAGO+3(2),DOUBLE+4 MVC TPOPERGO(09),=C'EXCLUSAO ' * BR R7 * *-------------------------------------- * ROTINA PARA ENVIAR TELA *-------------------------------------- ENVTELA EQU * * EXEC CICS SEND X MAPSET ('MAP3ASM') X MAP ('MAP3ASM') NOHANDLE X FROM (MAP3ASMO) X CURSOR(POSIS) X FREEKB X ERASE * BR R7 *-------------------------------------- * ROTINA DE RETORNO *-------------------------------------- RETORNO EQU * * EXEC CICS HANDLE AID X PF3(VOLTMENU) X CLEAR(VOLTMENU) * L R6,DFHEICAP CARREGA COMMAREA MVC COMAREA,0(R6) * BAL R8,RECTELA B TRAFASE * *-------------------------------------- * RECEBE TELA *-------------------------------------- RECTELA EQU * * CLI EIBAID,DFHPF3 BE VOLTMENU CLI EIBAID,DFHCLEAR BE VOLTMENU * EXEC CICS RECEIVE X MAP('MAP3ASM') X MAPSET('MAP3ASM') X INTO (MAP3ASMI) X NOHANDLE * BR R8 * *-------------------------------------- * ROTINA TRATA FASE *-------------------------------------- TRAFASE EQU * * MVC TPOPERGO(09),=C'EXCLUSAO ' MVC VERFASEO(5),FASE * CLC FASE,=C'FASE1' BE VECODIGO CLC FASE,=C'FASE2' BE EXCLUSAO CLC FASE,=C'FASE3' BE CONTPROC B VOLTMENU * *-------------------------------------- * ROTINA QUE VERIFICA SE CODIGO VALIDO *-------------------------------------- VECODIGO EQU * * MVC CODIREG(5),CODIGI CLC CODIREG(5),X'F0' COMPARA COM ZEROS BE CDINVAL CODIGO INVALIDO MVC POSIS,=H'0585' POSICIONA NO PRIMEIRO BYTE DO CODIGO B LEITURA * *-------------------------------------- * ROTINA CODIGO INVALIDO *-------------------------------------- CDINVAL EQU * MVI MENSAGA,X'F8' MVC MENSAGO(60),=CL60' ' BRANCOS MVC MENSAGO(15),=CL15'CODIGO INVALIDO' MVC POSIS,=H'0585' POSICIONA NO PRIMEIRO BYTE DO CODIGO MVC CODIGA,X'C1' DFHBMFSE BAL R7,PEGDATA BAL R7,ENVTELA B RETTRAN RETORNA A TRANSACAO * *-------------------------------------- * ROTINA DE LEITURA *-------------------------------------- LEITURA EQU * MVC WKS_CODIGO(5),CODIGI MVC TAMANHO,=H'121' EXEC CICS READ DATASET ('CADCONS') X RIDFLD(WKS_CODIGO) X INTO(WKS_CADCONS) X LENGTH (TAMANHO) X RESP(RESPONSE) X NOHANDLE * CLC RESPONSE,DFHRESP(NORMAL) BNE INEXISTE BE ACEITA B VAIERRO * *-------------------------------------- * ROTINA DE CODIGO INEXISTENTE *-------------------------------------- INEXISTE EQU * * MVI MENSAGA,X'F8' MVC MENSAGO(60),=CL60' ' PREENCHE COM BRANCOS MVC MENSAGO(31),=C'CODIGO INEXISTENTE, TECLE CLEAR' MVI CODIGA,X'61' DFHBMPRF MVC RAZAOGO(30),X'40' BRANCOS MVI RAZAOGA,X'61' MVC ENDERGO(50),X'40' MVI ENDERGA,X'61' MVC TELEFGO(16),X'40' MVI TELEFGA,X'61' MVC CONTAGO(20),X'40' MVI CONTAGA,X'61' MVI TCONFGA,X'61' MVI TCONFGL,X'61' MVC VERFASEO(5),FASE MVC POSIS,=H'0585' POSICIONA NO PRIMEIRO BYTE DO CODIGO BAL R7,PEGDATA BAL R7,ENVTELA B RETTRAN * *-------------------------------------- * ROTINA CODIGO ACEITO (ENCONTRADO) *-------------------------------------- ACEITA EQU * * MVC MENSAGO(60),=CL60' ' PREENCHE COM BRANCOS MVC MENSAGO(17),=C'CODIGO ENCONTRATO' MVC CODIGO(05),WKS_CADCONS MVC RAZAOGO(30),WKS_CADCONS+5 MVC ENDERGO(50),WKS_CADCONS+35 MVC TELEFGO(16),WKS_CADCONS+85 MVC CONTAGO(20),WKS_CADCONS+101 * MVI CODIGA,X'F9' PROTEGE CAMPO CODIGO MVC RAZAOGA,X'61' MVC ENDERGA,X'61' MVC TELEFGA,X'61' DFHBMPRF MVC CONTAGA,X'61' MVC TCONFGA,X'C1' DFHBMFSE MVC TCONFGL,=C'-1' MVC FASE(5),=C'FASE2' MVC TDCONFGO(14),=C'EXCLUIR (S/N)?' MVC POSIS,=H'1696' POSICIONA NO CONFIRMA MVC VERFASEO(5),FASE * BAL R7,PEGDATA BAL R7,ENVTELA B RETTRAN * *-------------------------------------- * ROTINA CONFIRMA EXCLUSAO *-------------------------------------- EXCLUSAO EQU * * CLI TCONFGI,C'S' CONFIRMA EXCLUSAO BNE VOLTMENU * MVC WKS_CODIGO(5),CODIGI MVC TAMANHO,=H'121' EXEC CICS DELETE X DATASET('CADCONS') X RIDFLD(WKS_CODIGO) X KEYLENGTH(+05) X RESP(RESPONSE) X NOHANDLE * MVC CODIGA,X'61' DFHBMPRF MVC RAZAOGA,X'61' MVC ENDERGA,X'61' MVC TELEFGA,X'61' MVC CONTAGA,X'61' MVC TCONFGA,X'C1' DFHBMFSE MVC TCONFGL,=C'-1' * CLC RESPONSE,DFHRESP(NORMAL) BNE ERROEXCL MVI TCONFGI,C' ' MVC TDCONFGO(14),=C'NOVA EXCLUSAO:' MVC POSIS,=H'1696' POSICIONA EM NOVA EXCLUSAO MVC MENSAGO(60),=CL60' ' PREENCHE COM BRANCOS MVC MENSAGO(20),=C'EXCLUSAO COM SUCESSO' MVC FASE(5),=C'FASE3' BAL R7,PEGDATA BAL R7,ENVTELA B RETTRAN * *-------------------------------------- * ROTINA ERRO DE EXCLUSAO *-------------------------------------- * ERROEXCL EQU * MVI MENSAGA,X'F8' MVC FASE(5),=C' ' BRANCOS EM FASE MVC MENSAGO(60),=CL60' ' PREENCHE COM BRANCOS MVC MENSAGO(16),=C'ERRO NA EXCLUSAO' MVC CODIGO(5),X'F0' MOVE ZEROS BAL R7,PEGDATA BAL R7,ENVTELA B RETTRAN * *-------------------------------------- * ERRO DA ROTINA DE LEITURA *-------------------------------------- * VAIERRO EQU * MVC MENSAGO,=C'ERRO NA LEITURA' MVC FASE(5),X'40' MOVE BRANCOS MVC CODIGO(5),X'F0' MOVE ZEROS * BAL R7,PEGDATA BAL R7,ENVTELA B RETTRAN * *--------------------------------------------- * ROTINA PARA CONTINUA EXCLUSAO *--------------------------------------------- CONTPROC EQU * CLI TCONFGI,C'S' CONFIRMA EXCLUSAO BNE VOLTMENU MVC CODIGO(5),X'F0' ZEROS EM CODIGO EXEC CICS XCTL PROGRAM('PGEXCL1') * *--------------------------------------------- * ROTINA PARA VOLTA AO MENU *--------------------------------------------- VOLTMENU EQU * MVC FASE(5),X'40' BRANCOS EM FASE MVC CODIGO(5),X'F0' ZEROS EM CODIGO EXEC CICS XCTL PROGRAM('PGMENU1') * *-------------------------------------- * ROTINA DE RETORNO TRANSACAO *-------------------------------------- RETTRAN EQU * * EXEC CICS RETURN X TRANSID('EXC1') X LENGTH (L'COMAREA) X COMMAREA(COMAREA) * END PGEXCL1