Identification Division.
       Program-Id.   DEPARTAMENTO.

       Environment Division.
      *special-names.   decimal-point is comma.
       input-output section.
       file-control.
           select DEPTO 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  DEPTO label record standard
           value of file-id is "DEPTOS.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(01).

       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(01).

       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(30) 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 BLANK SCREEN.
          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. Alteracao departamento".
          02 line 10 col 29 value "3. Exclusao departamento".
          02 line 12 col 29 value "4. Consulta departamento".
          02 line 14 col 29 value "5. Retorno".
          02 line 20 col 25 value "Escolha uma Op‡ao:".

       01 tela2.
           02 BLANK SCREEN.
           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 "DEPARTAMENTO" highlight.
           02 line 10 col 19 value "Codigo: ".
           02 line 12 col 19 value "Nome: ".
           02 line 14 col 19 value "responsavel: ".
           02 line 16 col 19 value "divisao-depto: ".

       01 codDepto.
           02 line 07 col 25 value "divisao-depto codigo".
           02 line 08 col 10 value "1- Presidencia 2- Diretoria 3- Comercial 4- Operacional 5- Producao".
       Procedure Division.
       Inicio.

           Perform abre-arq.
           Perform abertura until op = "5".

           STOP run.

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

       abertura.

           display tela1.
           Perform mostra-data.
           accept op at 2045 WITH PROMPT AUTO.
           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"
           end-evaluate.


       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 codDepto.
           display "Cadastro de Departamento" at 0530 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-nome  until nome-depto-e not = spaces.
           perform testa-responsavel  until responsavel-e not = spaces.
           perform testa-divisao-depto until divisao-depto-e not = zeros AND < 6 AND > 0.


       testa-codicli.
           move 1 to wigual.
           move zeros to codigo-depto-e.
           accept codigo-depto-e at 1032 with prompt auto.
           if codigo-depto-e = spaces or "0000" then
                display "Digite um codigo diferente de zero." at 2321
                set wigual to 0
           else
                move codigo-depto-e to codigo-depto
                read DEPTO not invalid key perform ja-cadastrado.

       ja-cadastrado.
           display "Codigo ja cadastrado" at 2321
           set wigual to 0.


       testa-nome.
           accept nome-depto-e at 1232.
           if nome-depto-e = spaces then
                display "Digite o nome do departamento" at 2321
       else
                display espaco at 2321.


       testa-responsavel.
           accept responsavel-e at 1432.
           if responsavel-e = spaces then
                display "Digite o nome responsavel." at 2321
       else
                display espaco at 2321.


       testa-divisao-depto.
           accept divisao-depto-e at 1633.
           display divisao-depto-e at 1639.
           display irado-t(divisao-depto-e) at 1642.
           if divisao-depto-e = zeros then
                display "Digite a divisao do departamento" 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
                IF ARQST <> "00"
                   display arqst at 2221
                   STOP " ".

       continua.
           display espaco at 2315.
           display "Continua <S/N> [ ]" at 2321.
           accept op-continua at 2337 with prompt auto.

       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 irado-t(divisao-depto-e) at 1642
               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 DEPTO.
           stop " ".
           display espaco at 2315.
           perform continua.

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

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

       le-dados.
           perform inicializar.
           perform mostra-data.
           accept codigo-depto-e at  1032.
           move codigo-depto-e to codigo-depto.
           read DEPTO key is codigo-depto invalid key
                display "Departamento naum 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 codigo-depto-e  at 1032.
           display nome-depto-e    at 1232.
           display responsavel-e   at 1432.
           display divisao-depto-e at 1632.
           display irado-t(divisao-depto-e) at 1642.

       altera-dados.
           accept codigo-depto-e   at 1032.
           accept nome-depto-e     at 1232.
           accept responsavel-e    at 1432.
           accept divisao-depto-e  at 1632.


       alteracao.
           perform inicializar.
           display tela2.
           display "Altera�ao de Registro" at 0625 with highlight.
           perform le-dados.
           if wigual <> 1
              display irado-t(divisao-depto-e) at 1642
              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.