identification division.
       program-id.    tabPessoas.
       author.        Alexandre Hogler.
       date-written.  15/10/2009.
       installation.  MHTec Consultoria e Desenvolvimento de Sistemas.
      *>================================================================


      *>     =================================================
      *>                    Cadastro de Pessoas
      *>     =================================================


      *>================================================================
       environment division.
       configuration section.
       special-names. decimal-point is comma.
       file-control.

       *> Define a estrutura do arquivo e as chaves
       select cadpes assign to disk
              organization  is indexed
              access mode   is dynamic
              record  key   is pes-Chave *> Chave primária
              alternate record key is fkNome = pes-Nome *> Chave sec.
                           with duplicates
              lock mode     is automatic
              file status   is fs-cadpes. *> Variável que vai guardar
                                          *> o status

      *>================================================================
       data division.
       file section.

       *> Definição dos campos do arquivo
       fd   cadpes
            label record is standard
            value of file-id is lb-cadpes. *> Vai guardar o caminho
       01   RegPes.
            02 pes-Chave.
               03 pes-Codigo       pic 9(008).
            02 pes-Nome            pic x(050).
            02 pes-Email           pic x(050).
            02 pes-DataNasc        pic 9(008).
            02 filler              pic x(100).

      *>================================================================
       working-storage section.

       01 ws-Trabalho.
          05 wsOpcao               pic 9(001) value zeros.
          05 wsOrdem               pic 9(001) value zeros.
          05 wsData                pic 99/99/9999.
          05 er-cadpes.
              10 fs-cadpes         pic  x(002) value "00".
              10 lb-cadpes         pic  x(050) value "CADPES.dat".

      *>================================================================
       procedure division.
      *>================================================================
       0000-Inicio section.
           *> Primeiro ele é aberto como i-o (Leitura/Gravação)
           *> caso retorne o erro 35 ( arquivo inexistente ) ele abre
           *> o arquivo como "output" para que seja criado um novo

           move "C:\Alex\CADPES.DAT" to lb-cadpes
           open i-o CadPes
           if fs-CadPes = 35
              close CadPes
              open output CadPes
              close CadPes
              Open i-o CadPes
           end-if

           initialize wsOpcao
           perform 1000-Montamenu until wsOpcao = 5
           close CadPes
           stop run.

      *>================================================================
       1000-MontaMenu section.
           display erase

           display "Sistema de cadastro de Pessoas"
           display " "

           display "Menu de opcoes"
           display " "
           display "1. Gravar nova pessoa"
           display "2. Excluir pessoa"
           display "3. Consultar pessoa"
           display "4. Listar pessoas"
           display "5. Sair"
           display " "
           accept wsOpcao

           evaluate wsOpcao
              when 1
                 perform 2000-GravaPessoa
              when 2
                 perform 3000-ExcluiPessoa
              when 3
                 perform 4000-ConsultaPessoa
              when 4
                 perform 5000-ListaPessoa
           end-evaluate

           exit.

      *>================================================================
       2000-GravaPessoa section.
           display Erase
           display "Cadastrar Pessoa"
           display " "

           initialize RegPes
           display "Informe o Codigo"
           accept pes-Codigo
           display "Informe o Nome"
           accept pes-Nome
           display "Informe o E-Mail"
           accept pes-Email
           display "Informe a Data de Nascimento"
           accept wsData
           move wsData to pes-DataNasc

           *> Grava e se já existir, atualiza com rewrite
           write Regpes
           if fs-Cadpes = 22
              rewrite Regpes
           end-if
           exit.

      *>================================================================
       3000-ExcluiPessoa section.
           display Erase
           display "Excluir Pessoa"
           display " "

           initialize RegPes
           display "Informe o codigo da pessoa"
           accept pes-Codigo
           delete cadpes
           if fs-cadpes < 03
              display "Excluido com sucesso"
           else
              display "Erro: Codigo nao encontrado"
           end-if
           accept wsOrdem
           exit.

      *>================================================================
       4000-ConsultaPessoa section.
           display Erase
           display "Consultar Pessoa"
           display " "

           initialize RegPes
           display "Informe o codigo da pessoa"
           accept pes-Codigo
           read cadpes
           if fs-cadpes < 03
              perform 9000-MostraRegistro
           else
              display "Erro: Codigo nao encontrado"
           end-if
           accept wsOrdem

           exit.

      *>================================================================
       5000-ListaPessoa section.
           display Erase
           display "Pessoas cadastradas"
           display " "

           initialize wsOrdem
           display "Ordem da listagem"
           display "1. Por codigo"
           display "2. Por nome"
           accept wsOrdem

           initialize regpes
           evaluate wsOrdem
              when 1
                 start cadpes key is > pes-Chave
              when 2
                 start cadpes key is > fkNome
           end-evaluate
           read cadpes next
           perform until fs-cadpes > 03
              display " "
              perform 9000-MostraRegistro
              read cadpes next
           end-perform

           accept wsOrdem
           exit.

      *>================================================================
       9000-MostraRegistro section.
           display "Nome: ", pes-Nome
           display "E-Mail: ", pes-Email
           move pes-DataNasc to wsData
           display "Data de Nascimento: ", wsData
           exit.

      *>================================================================