API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Dec 1st, 2017
122
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
COBOL 11.59 KB | None | 0 0
raw download clone embed print report
  1.     Identification Division.
  2.        Program-Id.   LOCAL-DAT.
  3.  
  4.        Environment Division.
  5.        special-names.   decimal-point is comma.
  6.        input-output section.
  7.        file-control.
  8.            select LOCAL assign to disk
  9.            organization indexed
  10.            access mode dynamic
  11.            record key codigo-local
  12.            alternate record key desc-local
  13.            file status arqst-LO.
  14.            
  15.            select DEPTOS assign to disk
  16.            organization indexed
  17.            access mode dynamic
  18.            record key codigo-depto
  19.            alternate record key nome-depto
  20.            file status arqst-DP.
  21.  
  22.        data division.
  23.        file section.
  24.        fd  LOCAL label record standard
  25.            value of file-id is "LOCAL.dat".
  26.        01 reg-local.
  27.            02 codigo-local  pic 9(04).
  28.            02 desc-local    pic x(30).
  29.            02 area-local    pic 9(05).
  30.            02 codigo-dep    pic 9(04).
  31.            
  32.        fd  DEPTOS label record standard
  33.            value of file-id is "DEPTOS.dat".
  34.        01 reg-depto.
  35.            02 codigo-depto  pic 9(04).
  36.            02 nome-depto    pic x(30).
  37.            02 responsavel   pic x(30).
  38.            02 divisao-depto pic 9(02).
  39.  
  40.        working-storage section.
  41.        01 reg-local-e.
  42.            02 codigo-local-e  pic 9(04).
  43.            02 desc-local-e    pic x(30).
  44.            02 area-local-e    pic 9(05).
  45.            02 codigo-dep-e    pic 9(04).
  46.  
  47.        01 reg-depto-e.
  48.            02 codigo-depto-e  pic 9(04).
  49.            02 nome-depto-e    pic x(30).
  50.            02 responsavel-e   pic x(30).
  51.            02 divisao-depto-e pic 9(02).
  52.  
  53.        01 data-sis.
  54.            02 ano   pic 9999.
  55.            02 mes   pic 99.
  56.            02 dia   pic 99.
  57.      
  58.        01 desmes.
  59.           02 filler pic x(10) value "Janeiro".
  60.           02 filler pic x(10) value "Fevereiro".
  61.           02 filler pic x(10) value "Mar‡o".
  62.           02 filler pic x(10) value "Abril".
  63.           02 filler pic x(10) value "Maio".
  64.           02 filler pic x(10) value "Junho".
  65.           02 filler pic x(10) value "Julho".
  66.           02 filler pic x(10) value "Agosto".
  67.           02 filler pic x(10) value "Setembro".
  68.           02 filler pic x(10) value "Outubro".
  69.           02 filler pic x(10) value "Novembro".
  70.           02 filler pic x(10) value "Dezembro".
  71.        
  72.  
  73.        01 tabela-meses redefines desmes.
  74.            02 mes-t    pic x(10) occurs 12 times.
  75.        
  76.        01 arqst-LO     pic x(2).
  77.        01 arqst-DP     pic x(2).
  78.        01 op           pic x(1) value spaces.
  79.        01 salva        pic x(1) value spaces.
  80.        01 wigual       pic 9 value zeros.
  81.        01 espaco       pic x(60) value spaces.
  82.        01 op-continua  pic x(1)  value spaces. 
  83.  
  84.        screen section.
  85.        01 tela1.
  86.           02 BLANK SCREEN.
  87.           02 line 02 col 5 value "Santos,    de            de     .".
  88.           02 line 02 col 55 value "Nome da Empresa qota".
  89.           02 line 04 col 29 value "Controle de Patrimonio" highlight.
  90.           02 line 06 col 29 value "1. Inclusao de novos Locais".
  91.           02 line 08 col 29 value "2. Alteracao de Locais Cadastrados".
  92.           02 line 10 col 29 value "3. Exclusao de Locais Cadastrados".
  93.           02 line 12 col 29 value "4. Consulta por Codigo".
  94.           02 line 16 col 29 value "5. Retorno".
  95.           02 line 20 col 25 value "Escolha uma Opcao:".
  96.  
  97.        01 tela2.
  98.            02 BLANK SCREEN.
  99.            02 line 02 col 05 value "Santos,    de           de     .".
  100.            02 line 06 col 19 value "Codigo Local: ".
  101.            02 line 08 col 19 value "Nome Local: ".
  102.            02 line 10 col 19 value "Area local: ".
  103.            02 line 12 col 19 value "Codigo departamento: ".
  104.            02 line 14 col 19 value "Divisao departamento: ".
  105.  
  106.        Procedure Division.
  107.        Inicio.
  108.        
  109.            Perform abre-arq-LO.
  110.            perform abre-arq-dp.
  111.            Perform abertura until op = "5".
  112.            CLOSE DEPTOS.
  113.            CLOSE LOCAL.
  114.            STOP run.
  115.        
  116.        
  117.        abre-arq-dp.
  118.            open i-o DEPTOS.
  119.            if arqst-dp not = "00"
  120.                display "erro de abertura Departamento" at 2155
  121.                stop " "
  122.                close DEPTOS
  123.                STOP RUN.
  124.  
  125.        abre-arq-LO.
  126.            open i-o LOCAL.
  127.            if arqst-LO not = "00"
  128.                display "erro de abertura Local" at 2155
  129.                close LOCAL
  130.                open output LOCAL
  131.                STOP RUN.
  132.  
  133.        abertura.
  134.            
  135.            display tela1.
  136.            Perform mostra-data.
  137.            accept op at 2045 WITH PROMPT AUTO.
  138.            move spaces to op-continua
  139.            evaluate op
  140.            when "1"
  141.                perform inclusao until op-continua = "n" or "N"
  142.                
  143.            when "2"
  144.                perform alteracao until op-continua = "n" or "N"
  145.                
  146.            when "3"
  147.                perform exclusao until op-continua = "n" or "N"
  148.            when "4"
  149.                perform consulta until op-continua = "n" or "N".
  150.  
  151.        mostra-data.
  152.            move function current-date to data-sis.
  153.            display dia at 0213.
  154.            display mes-t(mes) at 0219.
  155.            display ano at 0233.
  156.  
  157.        inclusao.
  158.            perform tela-inclusao.
  159.            move zeros to wigual.
  160.            perform inicializar.
  161.            perform testa-cod-local until wigual = 1.
  162.            perform recebe-dados.
  163.            move zeros to wigual.
  164.            perform testa-cod-depto until wigual = 1.
  165.            move divisao-depto to divisao-depto-e.
  166.            display divisao-depto-e at 1442.
  167.            perform grava.
  168.            perform continua.
  169.  
  170.  
  171.  
  172.        tela-inclusao.
  173.            display tela2.
  174.            display "Cadastro de Locais" at 0430 with highlight.
  175.            perform mostra-data.
  176.  
  177.        inicializar.
  178.            move spaces to op op-continua salva.
  179.            move spaces to nome-depto-e desc-local-e.
  180.            move zeros  to codigo-depto-e divisao-depto-e area-local-e codigo-local-e codigo-dep-e.
  181.            move zeros  to wigual.
  182.            display espaco at 2315.
  183.  
  184.        recebe-dados.
  185.            perform testa-desc-local    until desc-local-e    not = spaces.
  186.            perform testa-area-local    until area-local-e    not = zeros.
  187.            
  188.        testa-area-local.
  189.            accept area-local-e at 1032.
  190.            if area-local-e = spaces then
  191.                 display "Digite a area do local." at 2321
  192.           else
  193.                 display espaco at 2321.
  194.       *   fazer mostra tipo depto
  195.        testa-cod-depto.
  196.            move 1 to wigual.
  197.            move zeros to codigo-depto-e.
  198.            accept codigo-depto-e at 1242 with prompt auto.
  199.            if codigo-depto-e = zeros or spaces then
  200.                 display "Digite um codigo diferente de zero." at 2321
  201.                 set wigual to 0
  202.            else
  203.                move spaces to espaco.
  204.                 move codigo-depto-e to codigo-depto
  205.                 read DEPTOS not invalid key move reg-depto to reg-depto-e
  206.                 move codigo-depto-e to codigo-dep-e
  207.                 read DEPTOS invalid key perform nao-cadastrado.
  208.                
  209.        nao-cadastrado.
  210.            display "Departamento nao cadastrado" at 2321
  211.            set wigual to 0.
  212.        
  213.        
  214.        testa-cod-local.
  215.            move 1 to wigual.
  216.            move zeros to codigo-local-e.
  217.            accept codigo-local-e at 0632 with prompt auto.
  218.            if codigo-local-e = zeros or spaces then
  219.                 display "Digite um codigo diferente de zero." at 2321
  220.                 set wigual to 0
  221.            else
  222.                 move spaces to espaco.
  223.                 move codigo-local-e to codigo-local
  224.                 read LOCAL not invalid key perform ja-cadastrado.
  225.            
  226.        ja-cadastrado.
  227.            display "Codigo ja cadastrado" at 2321
  228.            set wigual to 0.
  229.  
  230.  
  231.  
  232.  
  233.        testa-desc-local.
  234.            accept desc-local-e at 0832.
  235.            if desc-local-e = spaces then
  236.                 display "Digite o nome do local." at 2321
  237.           else
  238.                 display espaco at 2321.
  239.  
  240.        
  241.        grava.
  242.            display "Salvar <S/N> [ ]" at 2321.
  243.            accept salva at 2335 with prompt auto.
  244.            if salva = "S" or "s" then
  245.                 move reg-local-e to reg-local
  246.                 write reg-local
  247.                 if arqst-LO <> "00"                                
  248.                    display arqst-DP at 2221
  249.                    display arqst-LO at 2321
  250.                    STOP " ".
  251.  
  252.        continua.
  253.            display espaco at 2315.
  254.            display "Continua <S/N> [ ]" at 2321.
  255.            accept op-continua at 2337 with prompt auto.
  256.        
  257.  
  258.        exclusao.
  259.            perform inicializar.
  260.            display erase at 0101.
  261.            display tela2.
  262.            display "Exclusao de Local" at 0430 with highlight.
  263.            perform inicializar.
  264.            perform le-dados.
  265.            if arqst-LO = "00" then
  266.                display "Deseja excluir o registro<S/N> [ ]" at 2319
  267.                accept salva at 2351 with prompt auto
  268.            else
  269.                perform inicializar
  270.                display espaco at 2319
  271.                display "Registro nao encontrado." at 2321.
  272.            if salva = "S" or "s" then
  273.                display espaco at 2319
  274.                Display "Registro apagado." at 2321
  275.                delete LOCAL.
  276.            stop " ".
  277.            display espaco at 2315.
  278.            perform continua.
  279.  
  280.        estuda-erro.
  281.            display "Codigo nao encontrado." at 2321.
  282.            stop " ".
  283.  
  284.        consulta.
  285.            display erase at 0101.
  286.            display tela2.
  287.            display "Consulta de Registro" at 0430 with highlight.
  288.            perform le-dados.
  289.            perform continua.
  290.  
  291.        le-dados.
  292.            perform inicializar.
  293.            perform mostra-data.
  294.            accept codigo-local-e at  0633.
  295.            move codigo-local-e to codigo-local.
  296.            read LOCAL key is codigo-local invalid key
  297.                display "Local não encontrado" at 2320
  298.                move 1 to wigual
  299.                stop " ".
  300.            if arqst-LO = "00" then
  301.                display espaco at 2319
  302.                perform mostra-tela.
  303.  
  304.  
  305.        mostra-tela.
  306.            move reg-local to reg-local-e.
  307.            move codigo-dep-e to codigo-depto.
  308.            read DEPTOS key is codigo-depto not invalid key move reg-depto to reg-depto-e.
  309.            display codigo-local-e  at 0633.
  310.            display desc-local-e    at 0833.
  311.            display area-local-e    at 1033.
  312.            display codigo-dep-e  at 1242.
  313.            display divisao-depto-e at 1442.
  314.  
  315.        altera-dados.
  316.            accept codigo-local-e  at 0633 with prompt auto.
  317.            accept desc-local-e    at 0833.
  318.            accept area-local-e    at 1033.
  319.            perform testa-cod-depto until wigual = 1.
  320.            move divisao-depto to divisao-depto-e.
  321.            display espaco at 1442.
  322.            display divisao-depto-e at 1442.
  323.            
  324.        alteracao.
  325.            perform inicializar.
  326.            display erase at 0101.
  327.            display tela2.
  328.            display "Alteracao de Registro" at 0425 with highlight.
  329.            perform le-dados.
  330.  
  331.            if wigual <> 1
  332.               perform altera-dados
  333.               display "Deseja salvar alteracao <S/N> [ ]" at 2319
  334.               accept salva at 2350 with prompt auto
  335.               if salva = "S" or "s" then
  336.                  move reg-local-e to reg-local
  337.                  rewrite reg-local invalid key perform estuda-erro
  338.                  display espaco at 2315.
  339.  
  340.            perform continua.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!