Identification Division.
       Program-Id.   TIPOS.

       Environment Division.
       special-names.   decimal-point is comma.
       input-output section.
       file-control.
           select tipos assign to disk
           organization indexed
           access mode dynamic
           record key codigo-depto
           alternate record key nome-depto
           file status arqst.

       data division.
       file section.
       fd  tipos label record standard
           value of file-id is "DEPTO.dat".
       01 reg-cli.
           02 codigo-depto  pic 9(04).
           02 nome-depto    pic x(30).
           02 responsavel   pic x(30).
           02 divisao-depto pic 9(02).

       working-storage section.
       01 reg-cli-e.
           02 codigo-depto-e  pic 9(04).
           02 nome-depto-e    pic x(30).
           02 responsavel-e   pic x(30).
           02 divisao-depto-e pic 9(02).


       01 data-sis.
           02 ano   pic 9999.
           02 mes   pic 99.
           02 dia   pic 99.
       01 destipo.
          02 filler pic x(30) value "Presidencia".
          02 filler pic x(30) value "Diretoria".
          02 filler pic x(30) value "Comercial".
          02 filler pic x(30) value "Operacional".
          02 filler pic x(30) value "Producao".
       01 irado redefines destipo.
          02 irado-t pic x(10) occurs 5 times.

       01 desmes.
          02 filler pic x(10) value "Janeiro".
          02 filler pic x(10) value "Fevereiro".
          02 filler pic x(10) value "Mar‡o".
          02 filler pic x(10) value "Abril".
          02 filler pic x(10) value "Maio".
          02 filler pic x(10) value "Junho".
          02 filler pic x(10) value "Julho".
          02 filler pic x(10) value "Agosto".
          02 filler pic x(10) value "Setembro".
          02 filler pic x(10) value "Outubro".
          02 filler pic x(10) value "Novembro".
          02 filler pic x(10) value "Dezembro".


       01 tabela-meses redefines desmes.
           02 mes-t pic x(10) occurs 12 times.
       01 arqst        pic x(2).
       01 op           pic x(1) value spaces.
       01 salva        pic x(1) value spaces.
       01 wigual       pic 9 value zeros.
       01 espaco       pic x(60) value spaces.
       01 op-continua  pic x(1)  value spaces.

       screen section.
       01 tela1.
          02 line 2 col 5 value "Santos,    de            de     .".
          02 line 2 col 55 value "Nome da Empresa qota".
          02 line 4 col 29 value "Controle de Patrimonio" highlight.
          02 line 6 col 29 value "1. Inclusao departamento".
          02 line 8 col 29 value "2. Altera‡ao departamento".
          02 line 10 col 29 value "3. ExclusÆo departamento".
          02 line 12 col 29 value "4. Consulta departamento".
          02 line 14 col 29 value "4. Consulta departamento".
          02 line 16 col 29 value "5. Retorno".
          02 line 20 col 25 value "Escolha uma Op‡ao:".

       01 tela2.
           02 line 02 col 05 value "Santos,    de           de     .".
           02 line 02 col 55 value "CONTROLE PATRIMÔNIO" highlight.
           02 line 04 col 29 value "ALTERAÇÃO DE DEPARTAMENTO" highlight.
           02 line 08 col 19 value "C¢digo: ".
           02 line 09 col 19 value "Nome: ".
           02 line 10 col 19 value "responsavel: ".
           02 line 11 col 19 value "divisao-depto: ".


       Procedure Division.
       Inicio.
           Perform abre-arq.
           Perform abertura until op = "5".
           exit program.

       abre-arq.
           open i-o tipos.
           if arqst not = "00"
               display "erro de abertura" at 2155
               close tipos
               open output tipos.

       abertura.
           display erase at 0101.
           display tela1.
           Perform mostra-data.
           accept op at 1845.
           perform trata-opcao.

       trata-opcao.
           move spaces to op-continua
           evaluate op
           when "1"
               perform inclusao until op-continua = "n" or "N"
           when "2"
               perform alteracao until op-continua = "n" or "N"
           when "3"
               perform exclusao until op-continua = "n" or "N"
           when "4"
               perform consulta until op-continua = "n" or "N".

       mostra-data.
           move function current-date to data-sis.
           display dia at 0213.
           display mes-t(mes) at 0219.
           display ano at 0233.

       inclusao.
           perform tela-inclusao.
           move zeros to wigual.
           perform inicializar.
           perform testa-codicli until wigual = 1.
           perform recebe-dados.
           perform grava.
           perform continua.


       tela-inclusao.
       display erase at 0101.
       display tela2.
           display "Cadastro de Clientes" at 0730 with highlight.
           perform mostra-data.

       inicializar.
       move spaces to op op-continua salva.
           move spaces to nome-depto-e responsavel-e
           move zeros to codigo-depto-e divisao-depto-e
           move zeros to wigual.
           display espaco at 2315.

       recebe-dados.
           perform testa-endcli  until descricao-tipo-e not = spaces.
           perform testa-cidade  until cidade-e not = spaces.
           perform testa-telefone until telefone-e not = spaces.
           perform testa-documento until documento-e not = spaces.


       testa-codicli.
           move 1 to wigual.
           move spaces to classe-tipo-e.
           accept classe-tipo-e at 0832 with prompt auto.
           if classe-tipo-e = spaces or "00" then
                display "Digite um c¢digo diferente de zero." at 2321
                set wigual to 0
           else
                move classe-tipo-e to classe-tipo
                read tipos not invalid key perform ja-cadastrado.

       ja-cadastrado.
           display "C¢digo ja cadastrado" at 2321
           set wigual to 0.


       testa-endcli.
           accept descricao-tipo-e at 1032.
           if descricao-tipo-e = spaces then
                display "Digite o endere‡o do cliente." at 2321
       else
                display espaco at 2321.


       testa-cidade.
           accept cidade-e at 1132.
           if cidade-e = spaces then
                display "Digite o nome da cidade." at 2321
       else
                display espaco at 2321.


       testa-telefone.
           accept telefone-e at 1232.
           if telefone-e = spaces then
                display "Digite o telefone do cliente." at 2321
       else
                display espaco at 2321.

       testa-documento.
          accept documento-e at 1332.
          if documento-e = spaces then
                display "Digite o documento do cliente." at 2321
       else
                display espaco at 2321.


       grava.
           display "Salvar <S/N> [ ]" at 2321.
           accept salva at 2335 with prompt auto.
           if salva = "S" or "s" then
                move reg-cli-e to reg-cli
                write reg-cli invalid key perform estuda-erro
                display arqst at 2221.

       continua.
           display espaco at 2315.
           display "Continua <S/N> [ ]" at 2321.
           accept op-continua at 2337 with prompt auto.
           if op-continua = "S" or "s" then
                perform inicializar
                display espaco at 2315.

       exclusao.
           perform inicializar.
           display erase at 0101.
           display tela2.
           display "Exclusao de Registro" at 0730 with highlight.
           perform inicializar.
           perform le-dados.
           if arqst = "00" then
               display "Deseja excluir o registro<S/N> [ ]" at 2319
               accept salva at 2351 with prompt auto
           else
               perform inicializar
               display espaco at 2319
               display "Registro nao encontrado." at 2321.
           if salva = "S" or "s" then
               display espaco at 2319
               Display "Registro apagado." at 2321
               delete tipos.
           stop " ".
           display espaco at 2315.
           perform continua.

       estuda-erro.
           display "C¢digo nao encontrado." at 2321.
       stop " ".

       consulta.
           display erase at 0101.
           display tela2.
           display "Consulta de Registro" at 0730 with highlight.
           perform le-dados.
           perform continua.

       le-dados.
           perform inicializar.
           perform mostra-data.
           accept classe-tipo-e at 0932.
           move classe-tipo-e to classe-tipo.
           read tipos key is classe-tipo invalid key
                display "Registro nao encontrado" at 2320
                move 1 to wigual
                stop " ".
           if arqst = "00" then
              display espaco at 2319
              perform mostra-tela.


       mostra-tela.
           move reg-cli to reg-cli-e.
           display classe-tipo-e at 0832.
           display descricao-tipo-e at 1032.
           display cidade-e at 1132.
           display telefone-e at 1232.
           display documento-e at 1332.

       altera-dados.
           accept classe-tipo-e at 0932.
           accept descricao-tipo-e at 1032.
           accept cidade-e at 1132.
           accept telefone-e at 1232.
           accept documento-e at 1332.

       alteracao.
           perform inicializar.
           display erase at 0101.
           display tela2.
           display "Altera‡ao de Registro" at 0625 with highlight.
           perform le-dados.
           if wigual <> 1
              perform altera-dados
              perform recebe-dados
              display "Deseja salvar altera‡ao <S/N> [ ]" at 2319
              accept salva at 2350 with prompt auto
              if salva = "S" or "s" then
                 move reg-cli-e to reg-cli
                 rewrite reg-cli invalid key perform estuda-erro
                 display espaco at 2315.

           perform continua.