daily pastebin goal
13%
SHARE
TWEET

Untitled

a guest Nov 26th, 2018 98 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.        IDENTIFICATION          DIVISION.
  2.        PROGRAM-ID.             GUILHERME2.
  3.       *******************************************************
  4.       * LE UM ARQUIVO DE ENTRADA ECADFUNC E GERA RELATORIO  *
  5.       *******************************************************
  6.        ENVIRONMENT                 DIVISION.
  7.        CONFIGURATION               SECTION.
  8.        SPECIAL-NAMES.
  9.            DECIMAL-POINT IS COMMA.
  10.        DATA                        DIVISION.
  11.        FILE                        SECTION.
  12.        WORKING-STORAGE             SECTION.
  13.        77  WRK-MASCARA             PIC ZZZ.ZZZ.ZZ9.
  14.        77  WRK-ERRO                PIC 9(011).
  15.        77  ACU-LIDOS-ECADFUNC      PIC 9(011).
  16.        77  SEM-DIREITO             PIC 9(011).
  17.        77  COM-DIREITO             PIC 9(011).
  18.        01  WRK-DATE-SYS.
  19.            05 WRK-ANO-SYS          PIC X(002).
  20.            05 WRK-MES-SYS          PIC X(002).
  21.            05 WRK-DIA-SYS          PIC X(002).
  22.        01  WRK-DATE-SYSF.
  23.            05 FILLER               PIC X(003)  VALUE SPACES.
  24.            05 WRK-DIA-SYSF         PIC X(002).
  25.            05 FILLER               PIC X(001)  VALUE '/'.
  26.            05 WRK-MES-SYSF         PIC X(002).
  27.            05 FILLER               PIC X(001)  VALUE '/'.
  28.            05 WRK-ANO-SYSF         PIC X(002).
  29.        01  DADOS-FUNC.
  30.            05 WRK-NOME             PIC X(011).
  31.            05 WRK-DATA-ADM.
  32.               10 WRK-DIA           PIC 9(002).
  33.               10 FILLER            PIC X(001).
  34.               10 WRK-MES           PIC 9(002).
  35.               10 FILLER            PIC X(001).
  36.               10 WRK-ANO           PIC 9(004).
  37.        77  WRK-ERRO-DIA            PIC X(030)  VALUE
  38.               'ERRO NO DIA INFORMADO'.
  39.        77  WRK-ERRO-MES            PIC X(030)  VALUE
  40.               'ERRO NO MES INFORMADO'.
  41.        77  WRK-ERRO-ANO            PIC X(030)  VALUE
  42.               'ERRO NO ANO INFORMADO'.
  43.        PROCEDURE                   DIVISION.
  44.        0000-PRINCIPAL              SECTION.
  45.            PERFORM 1000-INICIALIZAR.
  46.            PERFORM 2000-PROCESSAR 8 TIMES.
  47.            PERFORM 3000-APRESENTAR.
  48.        1000-INICIALIZAR            SECTION.      
  49.            ACCEPT WRK-DATE-SYS     FROM DATE.
  50.            MOVE WRK-DIA-SYS        TO WRK-DIA-SYSF.
  51.            MOVE WRK-MES-SYS        TO WRK-MES-SYSF.
  52.            MOVE WRK-ANO-SYS        TO WRK-ANO-SYSF.
  53.        2000-PROCESSAR              SECTION.
  54.            ACCEPT DADOS-FUNC.
  55.  
  56.            ADD 1                   TO ACU-LIDOS-ECADFUNC.
  57.            
  58.            PERFORM 5551-VERIFICA1.
  59.        
  60.        5551-VERIFICA1              SECTION.
  61.            IF WRK-DIA < 01         OR WRK-DIA > 31
  62.                DISPLAY WRK-ERRO-DIA
  63.                PERFORM 9999-ERROS
  64.            ELSE
  65.                IF WRK-MES < 01     OR WRK-MES > 12
  66.                    DISPLAY WRK-ERRO-MES
  67.                    PERFORM 9999-ERROS
  68.                ELSE
  69.                    IF WRK-ANO < 1950
  70.                        DISPLAY WRK-ERRO-ANO
  71.                        PERFORM 9999-ERROS
  72.                    ELSE
  73.                        PERFORM 5552-VERIFICA2
  74.                    END-IF
  75.                END-IF
  76.            END-IF.
  77.        
  78.        5552-VERIFICA2              SECTION.
  79.            IF WRK-ANO >= 2003
  80.                IF WRK-MES >= 09
  81.                    IF WRK-DIA >= 01
  82.                        ADD 1       TO SEM-DIREITO
  83.                        PERFORM 0000-GRAVA-SEM-DIREITO
  84.                    END-IF
  85.                ELSE
  86.                    ADD 1           TO COM-DIREITO
  87.                    PERFORM 8888-GRAVA-COM-DIREITO
  88.                END-IF
  89.            ELSE
  90.                ADD 1               TO COM-DIREITO
  91.                PERFORM 8888-GRAVA-COM-DIREITO
  92.            END-IF.
  93.  
  94.        3000-APRESENTAR             SECTION.
  95.            
  96.            DISPLAY ' '.
  97.            DISPLAY '*************** DCOMTS01 ***************'.
  98.            DISPLAY '*                                      *'.
  99.            DISPLAY '* DATA DO PROCESSAMENTO .: ' WRK-DATE-SYSF
  100.                                                          ' *'.
  101.            MOVE ACU-LIDOS-ECADFUNC TO WRK-MASCARA.
  102.  
  103.            DISPLAY '*                                      *'.
  104.            DISPLAY '* REGISTROS LIDOS .......: ' WRK-MASCARA
  105.                                                          ' *'.
  106.            MOVE SEM-DIREITO       TO WRK-MASCARA
  107.  
  108.            DISPLAY '* SEM DIREITO ...........: ' WRK-MASCARA
  109.                                                          ' *'.
  110.            MOVE COM-DIREITO       TO WRK-MASCARA.
  111.  
  112.            DISPLAY '* COM DIREITO ...........: ' WRK-MASCARA
  113.                                                          ' *'.          
  114.            MOVE WRK-ERRO          TO WRK-MASCARA
  115.            DISPLAY '* COM ERROS .............: ' WRK-MASCARA
  116.                                                          ' *'.
  117.            DISPLAY '*                                      *'.
  118.            DISPLAY '*************** DCOMTS01 ***************'.
  119.  
  120.            PERFORM 4000-FINALIZAR.
  121.  
  122.        9999-ERROS                  SECTION.
  123.            ADD 1 TO WRK-ERRO.
  124.  
  125.        4000-FINALIZAR              SECTION.
  126.            STOP RUN.
  127.  
  128.        8888-GRAVA-COM-DIREITO      SECTION.
  129.            DISPLAY 'GRAVADO COM DIREITO'.
  130.  
  131.        0000-GRAVA-SEM-DIREITO      SECTION.
  132.            DISPLAY 'GRAVADO SEM DIREITO'.
RAW Paste Data
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
 
Top