daily pastebin goal
36%
SHARE
TWEET

Untitled

a guest Nov 27th, 2018 96 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.        INPUT-OUTPUT                SECTION.
  8.        FILE-CONTROL.
  9.            SELECT ARQUIVO ASSIGN TO 'C:\Users\dcord\Documents\text.txt'
  10.                FILE STATUS IS WRK-FS-ARQUIVO.
  11.        DATA                        DIVISION.
  12.        FILE                        SECTION.
  13.        FD  ARQUIVO
  14.            RECORDING MODE IS F
  15.            RECORD CONTAINS 23 CHARACTERS.
  16.        01  DADOS-FUNC.
  17.            05 WRK-NOME             PIC X(011).
  18.            05 WRK-DATA-ADM.
  19.               10 WRK-DIA           PIC 9(002).
  20.               10 FILLER            PIC X(001).
  21.               10 WRK-MES           PIC 9(002).
  22.               10 FILLER            PIC X(001).
  23.               10 WRK-ANO           PIC 9(004).
  24.            05 WRK-NL               PIC X(002).
  25.        WORKING-STORAGE             SECTION.
  26.        77  WRK-FS-ARQUIVO          PIC 9(001).
  27.        77  WRK-MASCARA             PIC ZZZ.ZZZ.ZZ9.
  28.        77  WRK-ERRO-DATA           PIC 9(011).
  29.        77  ACU-LIDOS-ECADFUNC      PIC 9(011).
  30.        77  SCADANEW                PIC 9(011).
  31.        77  SCADAOLD                PIC 9(011).
  32.        01  WRK-HORA-SYS.
  33.            05 WRK-HOR-SYS          PIC X(002).
  34.            05 WRK-MIN-SYS          PIC X(002).
  35.            05 WRK-SEG-SYS          PIC X(002).
  36.        01  WRK-HORA-SYSF.
  37.            05 FILLER               PIC X(003)  VALUE SPACES.
  38.            05 WRK-HOR-SYSF         PIC X(002).
  39.            05 FILLER               PIC X(001)  VALUE ':'.
  40.            05 WRK-MIN-SYSF         PIC X(002).
  41.            05 FILLER               PIC X(001)  VALUE ':'.
  42.            05 WRK-SEG-SYSF         PIC X(002).
  43.        01  WRK-DATE-SYS.
  44.            05 WRK-ANO-SYS          PIC X(002).
  45.            05 WRK-MES-SYS          PIC X(002).
  46.            05 WRK-DIA-SYS          PIC X(002).
  47.        01  WRK-DATE-SYSF.
  48.            05 FILLER               PIC X(003)  VALUE SPACES.
  49.            05 WRK-DIA-SYSF         PIC X(002).
  50.            05 FILLER               PIC X(001)  VALUE '/'.
  51.            05 WRK-MES-SYSF         PIC X(002).
  52.            05 FILLER               PIC X(001)  VALUE '/'.
  53.            05 WRK-ANO-SYSF         PIC X(002).
  54.  
  55.        PROCEDURE                   DIVISION.
  56.        0000-PRINCIPAL              SECTION.
  57.            PERFORM 1000-INICIALIZAR.
  58.            PERFORM 2000-PROCESSAR  500 TIMES.
  59.            PERFORM 3000-FINALIZAR.
  60.  
  61.        1000-INICIALIZAR            SECTION.
  62.            OPEN INPUT ARQUIVO.
  63.            
  64.            ACCEPT WRK-DATE-SYS     FROM DATE.
  65.            MOVE WRK-DIA-SYS        TO WRK-DIA-SYSF.
  66.            MOVE WRK-MES-SYS        TO WRK-MES-SYSF.
  67.            MOVE WRK-ANO-SYS        TO WRK-ANO-SYSF.
  68.            
  69.            ACCEPT WRK-HORA-SYS     FROM TIME.
  70.            MOVE WRK-HOR-SYS        TO WRK-HOR-SYSF.
  71.            MOVE WRK-MIN-SYS        TO WRK-MIN-SYSF.
  72.            MOVE WRK-SEG-SYS        TO WRK-SEG-SYSF.
  73.  
  74.        2000-PROCESSAR              SECTION.
  75.            IF WRK-FS-ARQUIVO = 0
  76.                READ ARQUIVO
  77.                PERFORM 2001-VERIFICA-ERROS
  78.                ADD 1               TO ACU-LIDOS-ECADFUNC
  79.            ELSE
  80.                PERFORM 2004-ERRO-VAZIO
  81.            END-IF.
  82.  
  83.        2001-VERIFICA-ERROS         SECTION.
  84.            IF WRK-DIA < 01         OR WRK-DIA > 31
  85.                PERFORM 2003-GUARDA-ERROS
  86.            ELSE
  87.                IF WRK-MES < 01     OR WRK-MES > 12
  88.                    PERFORM 2003-GUARDA-ERROS
  89.                ELSE
  90.                    IF WRK-ANO < 1950
  91.                        PERFORM 2003-GUARDA-ERROS
  92.                    ELSE
  93.                        PERFORM 2002-VERIFICA-DATA
  94.                    END-IF
  95.                END-IF
  96.            END-IF.
  97.  
  98.        2002-VERIFICA-DATA          SECTION.
  99.            IF WRK-ANO >= 2003
  100.                IF WRK-MES >= 09
  101.                    IF WRK-DIA >= 01
  102.                        ADD 1       TO SCADANEW
  103.                        PERFORM 3002-GRAVA-SCADANEW
  104.                    END-IF
  105.                ELSE
  106.                    ADD 1           TO SCADAOLD
  107.                    PERFORM 3001-GRAVA-SCADAOLD
  108.                END-IF
  109.            ELSE
  110.                ADD 1               TO SCADAOLD
  111.                PERFORM 3001-GRAVA-SCADAOLD
  112.            END-IF.
  113.  
  114.        2003-GUARDA-ERROS           SECTION.
  115.            ADD 1 TO WRK-ERRO-DATA.
  116.  
  117.        2004-ERRO-VAZIO             SECTION.
  118.            IF DADOS-FUNC           EQUAL SPACES
  119.                DISPLAY '*************** DCOMTS01 ***************'
  120.                DISPLAY '*                                      *'
  121.                DISPLAY '*        ARQUIVO ECADFUNC VAZIO        *'
  122.                DISPLAY '*                                      *'
  123.                DISPLAY '*       PROCESSAMENTO FINALIZADO       *'
  124.                DISPLAY '*                                      *'
  125.                DISPLAY '*************** DCOMTS01 ***************'
  126.                STOP RUN
  127.            END-IF.
  128.            CLOSE ARQUIVO.
  129.  
  130.        3000-FINALIZAR              SECTION.
  131.            DISPLAY ' '.
  132.            DISPLAY '*************** DCOMTS01 ***************'.
  133.            DISPLAY '*                                      *'.
  134.            DISPLAY '* DATA DO PROCESSAMENTO .: ' WRK-DATE-SYSF
  135.                                                          ' *'.
  136.            DISPLAY '* HORA DA CONSULTA ......: ' WRK-HORA-SYSF
  137.                                                          ' *'.
  138.            MOVE ACU-LIDOS-ECADFUNC TO WRK-MASCARA.
  139.  
  140.            DISPLAY '*                                      *'.
  141.            DISPLAY '* REGISTROS LIDOS .......: ' WRK-MASCARA
  142.                                                          ' *'.
  143.            MOVE SCADANEW           TO WRK-MASCARA
  144.  
  145.            DISPLAY '* SEM DIREITO ...........: ' WRK-MASCARA
  146.                                                          ' *'.
  147.            MOVE SCADAOLD           TO WRK-MASCARA.
  148.  
  149.            DISPLAY '* COM DIREITO ...........: ' WRK-MASCARA
  150.                                                          ' *'.
  151.            MOVE WRK-ERRO-DATA      TO WRK-MASCARA
  152.            DISPLAY '* COM ERROS .............: ' WRK-MASCARA
  153.                                                          ' *'.
  154.            DISPLAY '*                                      *'.
  155.            DISPLAY '*************** DCOMTS01 ***************'.
  156.  
  157.            CLOSE ARQUIVO.
  158.            STOP RUN.
  159.  
  160.        3001-GRAVA-SCADAOLD         SECTION.
  161.       *   DISPLAY 'GRAVADO COM DIREITO'.
  162.  
  163.        3002-GRAVA-SCADANEW         SECTION.
  164.       *   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