SHARE
TWEET

Untitled

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