IDENTIFICATION              DIVISION.
       PROGRAM-ID.                 GUILHERME2.
       ENVIRONMENT                 DIVISION.
       CONFIGURATION               SECTION.
       SPECIAL-NAMES.
           DECIMAL-POINT IS COMMA.
       INPUT-OUTPUT                SECTION.
       FILE-CONTROL.
           SELECT ARQUIVO ASSIGN TO 'C:\Users\dcord\Documents\text.txt'
               FILE STATUS IS WRK-FS-ARQUIVO.
       DATA                        DIVISION.
       FILE                        SECTION.
       FD  ARQUIVO
           RECORDING MODE IS F
           RECORD CONTAINS 23 CHARACTERS.
       01  DADOS-FUNC.
           05 WRK-NOME             PIC X(011).
           05 WRK-DATA-ADM.
              10 WRK-DIA           PIC 9(002).
              10 FILLER            PIC X(001).
              10 WRK-MES           PIC 9(002).
              10 FILLER            PIC X(001).
              10 WRK-ANO           PIC 9(004).
           05 WRK-NL               PIC X(002).
       WORKING-STORAGE             SECTION.
       77  WRK-FS-ARQUIVO          PIC 9(001).
       77  WRK-MASCARA             PIC ZZZ.ZZZ.ZZ9.
       77  WRK-ERRO-DATA           PIC 9(011).
       77  ACU-LIDOS-ECADFUNC      PIC 9(011).
       77  SCADANEW                PIC 9(011).
       77  SCADAOLD                PIC 9(011).
       01  WRK-HORA-SYS.
           05 WRK-HOR-SYS          PIC X(002).
           05 WRK-MIN-SYS          PIC X(002).
           05 WRK-SEG-SYS          PIC X(002).
       01  WRK-HORA-SYSF.
           05 FILLER               PIC X(003)  VALUE SPACES.
           05 WRK-HOR-SYSF         PIC X(002).
           05 FILLER               PIC X(001)  VALUE ':'.
           05 WRK-MIN-SYSF         PIC X(002).
           05 FILLER               PIC X(001)  VALUE ':'.
           05 WRK-SEG-SYSF         PIC X(002).
       01  WRK-DATE-SYS.
           05 WRK-ANO-SYS          PIC X(002).
           05 WRK-MES-SYS          PIC X(002).
           05 WRK-DIA-SYS          PIC X(002).
       01  WRK-DATE-SYSF.
           05 FILLER               PIC X(003)  VALUE SPACES.
           05 WRK-DIA-SYSF         PIC X(002).
           05 FILLER               PIC X(001)  VALUE '/'.
           05 WRK-MES-SYSF         PIC X(002).
           05 FILLER               PIC X(001)  VALUE '/'.
           05 WRK-ANO-SYSF         PIC X(002).

       PROCEDURE                   DIVISION.
       0000-PRINCIPAL              SECTION.
           PERFORM 1000-INICIALIZAR.
           PERFORM 2000-PROCESSAR  500 TIMES.
           PERFORM 3000-FINALIZAR.

       1000-INICIALIZAR            SECTION.
           OPEN INPUT ARQUIVO.

           ACCEPT WRK-DATE-SYS     FROM DATE.
           MOVE WRK-DIA-SYS        TO WRK-DIA-SYSF.
           MOVE WRK-MES-SYS        TO WRK-MES-SYSF.
           MOVE WRK-ANO-SYS        TO WRK-ANO-SYSF.

           ACCEPT WRK-HORA-SYS     FROM TIME.
           MOVE WRK-HOR-SYS        TO WRK-HOR-SYSF.
           MOVE WRK-MIN-SYS        TO WRK-MIN-SYSF.
           MOVE WRK-SEG-SYS        TO WRK-SEG-SYSF.

       2000-PROCESSAR              SECTION.
           IF WRK-FS-ARQUIVO = 0
               READ ARQUIVO
               PERFORM 2001-VERIFICA-ERROS
               ADD 1               TO ACU-LIDOS-ECADFUNC
           ELSE
               PERFORM 2004-ERRO-VAZIO
           END-IF.

       2001-VERIFICA-ERROS         SECTION.
           IF WRK-DIA < 01         OR WRK-DIA > 31
               PERFORM 2003-GUARDA-ERROS
           ELSE
               IF WRK-MES < 01     OR WRK-MES > 12
                   PERFORM 2003-GUARDA-ERROS
               ELSE
                   IF WRK-ANO < 1950
                       PERFORM 2003-GUARDA-ERROS
                   ELSE
                       PERFORM 2002-VERIFICA-DATA
                   END-IF
               END-IF
           END-IF.

       2002-VERIFICA-DATA          SECTION.
           IF WRK-ANO >= 2003
               IF WRK-MES >= 09
                   IF WRK-DIA >= 01
                       ADD 1       TO SCADANEW
                       PERFORM 3002-GRAVA-SCADANEW
                   END-IF
               ELSE
                   ADD 1           TO SCADAOLD
                   PERFORM 3001-GRAVA-SCADAOLD
               END-IF
           ELSE
               ADD 1               TO SCADAOLD
               PERFORM 3001-GRAVA-SCADAOLD
           END-IF.

       2003-GUARDA-ERROS           SECTION.
           ADD 1 TO WRK-ERRO-DATA.

       2004-ERRO-VAZIO             SECTION.
           IF DADOS-FUNC           EQUAL SPACES
               DISPLAY '*************** DCOMTS01 ***************'
               DISPLAY '*                                      *'
               DISPLAY '*        ARQUIVO ECADFUNC VAZIO        *'
               DISPLAY '*                                      *'
               DISPLAY '*       PROCESSAMENTO FINALIZADO       *'
               DISPLAY '*                                      *'
               DISPLAY '*************** DCOMTS01 ***************'
               STOP RUN
           END-IF.
           CLOSE ARQUIVO.

       3000-FINALIZAR              SECTION.
           DISPLAY ' '.
           DISPLAY '*************** DCOMTS01 ***************'.
           DISPLAY '*                                      *'.
           DISPLAY '* DATA DO PROCESSAMENTO .: ' WRK-DATE-SYSF
                                                         ' *'.
           DISPLAY '* HORA DA CONSULTA ......: ' WRK-HORA-SYSF
                                                         ' *'.
           MOVE ACU-LIDOS-ECADFUNC TO WRK-MASCARA.

           DISPLAY '*                                      *'.
           DISPLAY '* REGISTROS LIDOS .......: ' WRK-MASCARA
                                                         ' *'.
           MOVE SCADANEW           TO WRK-MASCARA

           DISPLAY '* SEM DIREITO ...........: ' WRK-MASCARA
                                                         ' *'.
           MOVE SCADAOLD           TO WRK-MASCARA.

           DISPLAY '* COM DIREITO ...........: ' WRK-MASCARA
                                                         ' *'.
           MOVE WRK-ERRO-DATA      TO WRK-MASCARA
           DISPLAY '* COM ERROS .............: ' WRK-MASCARA
                                                         ' *'.
           DISPLAY '*                                      *'.
           DISPLAY '*************** DCOMTS01 ***************'.

           CLOSE ARQUIVO.
           STOP RUN.

       3001-GRAVA-SCADAOLD         SECTION.
      *    DISPLAY 'GRAVADO COM DIREITO'.

       3002-GRAVA-SCADANEW         SECTION.
      *    DISPLAY 'GRAVADO SEM DIREITO'.