Pedr026

PROG003

May 27th, 2018
540
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.       *"IMPORTANTE!! É PRECISO CRIAR O ARQUIVO cadcli.txt VAZIO ANTES"
  2.        IDENTIFICATION DIVISION.
  3.        PROGRAM-ID. PROG003.
  4.        AUTHOR.    PEDRO.
  5.       *"IMPORTANTE!! É PRECISO CRIAR O ARQUIVO cadcli.txt VAZIO ANTES"
  6.        ENVIRONMENT DIVISION.
  7.        CONFIGURATION SECTION.
  8.        SPECIAL-NAMES.
  9.            DECIMAL-POINT IS COMMA.
  10.        INPUT-OUTPUT SECTION.
  11.        FILE-CONTROL.
  12.            SELECT CADCLI ASSIGN TO DISK.
  13.       *"IMPORTANTE!! É PRECISO CRIAR O ARQUIVO cadcli.txt VAZIO ANTES"
  14.        DATA DIVISION.
  15.        FILE SECTION.
  16.        FD CADCLI
  17.           LABEL RECORD IS STANDARD
  18.           RECORD CONTAINS 92 CHARACTERS
  19.           DATA RECORD IS WS-REG-CADCLI
  20.           VALUE OF FILE-ID "C:\IDECobol\cadcli.txt".
  21.        01 WS-REG-CADCLI.
  22.         05 WS-CADCLI-AGENCIA PIC 9(05).
  23.         05 WS-CADCLI-NUMERO-CONTA PIC 9(10).
  24.         05 WS-CADCLI-NOME-CLIENTE PIC X(40).
  25.         05 WS-CADCLI-TELEFONE PIC 9(08).
  26.         05 WS-CADCLI-SALDO-ATUAL PIC S9(11)V99.
  27.         05 WS-DATA-GRAVACAO.
  28.          10 WS-CADCLI-ANO-GRAVACAO PIC 9(04).
  29.          10 WS-CADCLI-MES-GRAVACAO PIC 9(02).
  30.          10 WS-CADCLI-DIA-GRAVACAO PIC 9(02).
  31.         05 WS-CADCLI-HORA-GRAVACAO PIC 9(08).
  32.        WORKING-STORAGE SECTION.
  33.        77 CONTINUA PIC X(01).
  34.        SCREEN SECTION.
  35.        01 TELA.
  36.         05 LINE 01 COLUMN 29 VALUE "Unimonte - Santos".
  37.         05 LINE 02 COLUMN 27 VALUE "Cadastro de clientes".
  38.         05 LINE 06 COLUMN 18 VALUE "Codigo da agencia..:".
  39.         05 LINE 08 COLUMN 18 VALUE "Numero da conta....:".
  40.         05 LINE 10 COLUMN 18 VALUE "Nome do cliente....:".
  41.         05 LINE 12 COLUMN 18 VALUE "Telefone...........:".
  42.         05 LINE 14 COLUMN 18 VALUE "Saldo Atual........:".
  43.         05 LINE 17 COLUMN 18 VALUE "Continua...........:".
  44.         05 LINE 17 COLUMN 43 VALUE "S/N".
  45.         05 LINE 21 COLUMN 18 VALUE "Mensagem...........:".
  46.        02 LIMPATELA.
  47.         05 LINE 06 COLUMN 39 VALUE "                    ".
  48.         05 LINE 08 COLUMN 39 VALUE "                    ".
  49.         05 LINE 10 COLUMN 39 VALUE "                    ".
  50.         05 LINE 12 COLUMN 39 VALUE "                    ".
  51.         05 LINE 14 COLUMN 39 VALUE "                    ".
  52.         05 LINE 17 COLUMN 39 VALUE "   ".
  53.         05 LINE 21 COLUMN 39 VALUE "                    ".
  54.       *"IMPORTANTE!! É PRECISO CRIAR O ARQUIVO cadcli.txt VAZIO ANTES"
  55.        PROCEDURE DIVISION.
  56.        010-INICIO.
  57.            OPEN EXTEND CADCLI.
  58.        020-RECEBER.
  59.            DISPLAY TELA.
  60.            ACCEPT (06, 39) WS-CADCLI-AGENCIA WITH PROMPT.
  61.            ACCEPT (08, 39) WS-CADCLI-NUMERO-CONTA WITH PROMPT.
  62.            ACCEPT (10, 39) WS-CADCLI-NOME-CLIENTE WITH PROMPT.
  63.            ACCEPT (12, 39) WS-CADCLI-TELEFONE WITH PROMPT.
  64.            ACCEPT (14, 39) WS-CADCLI-SALDO-ATUAL WITH PROMPT.
  65.            IF WS-CADCLI-AGENCIA = ZEROS
  66.               DISPLAY (21, 39) "ERRO!!!"
  67.               GO TO 040-CONTINUA.
  68.            IF WS-CADCLI-NUMERO-CONTA = ZEROS
  69.               DISPLAY (21, 39) "ERRO!!!"
  70.               GO TO 040-CONTINUA.
  71.            IF WS-CADCLI-NOME-CLIENTE = SPACES
  72.               DISPLAY (21, 39) "ERRO!!!"
  73.               GO TO 040-CONTINUA.
  74.            IF WS-CADCLI-TELEFONE = ZEROS
  75.               DISPLAY (21, 39) "ERRO!!!"
  76.               GO TO 040-CONTINUA.
  77.            IF WS-CADCLI-SALDO-ATUAL = ZEROS
  78.               DISPLAY (21, 39) "ERRO!!!"
  79.               GO TO 040-CONTINUA.
  80.        030-GRAVA.
  81.            WRITE WS-REG-CADCLI.
  82.        040-CONTINUA.
  83.            ACCEPT (17, 39) CONTINUA.
  84.            IF CONTINUA = 'S' OR 's'
  85.               DISPLAY LIMPATELA
  86.               GO TO 020-RECEBER.
  87.        090-FIM.
  88.            CLOSE CADCLI.
  89.        STOPRUN.
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×