IDENTIFICATION              DIVISION.
       PROGRAM-ID.                 GUILHERME2.
       ENVIRONMENT                 DIVISION.
       CONFIGURATION               SECTION.
       SPECIAL-NAMES.
           DECIMAL-POINT IS COMMA.
       DATA                        DIVISION.
       FILE                        SECTION.
       WORKING-STORAGE             SECTION.
       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-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).
       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).
       77  WRK-ERRO-DATA-DIA       PIC X(030)  VALUE
              'ERRO NO DIA INFORMADO'.
       77  WRK-ERRO-DATA-MES       PIC X(030)  VALUE
              'ERRO NO MES INFORMADO'.
       77  WRK-ERRO-DATA-ANO       PIC X(030)  VALUE
              'ERRO NO ANO INFORMADO'.

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

       1000-INICIALIZAR            SECTION.
           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.

       2000-PROCESSAR              SECTION.
           ACCEPT DADOS-FUNC.
           ADD 1                   TO ACU-LIDOS-ECADFUNC.
           PERFORM 2004-ERRO-VAZIO .
           PERFORM 2001-VERIFICA-ERROS.

       2001-VERIFICA-ERROS         SECTION.
           IF WRK-DIA < 01         OR WRK-DIA > 31
               DISPLAY WRK-ERRO-DATA-DIA
               PERFORM 2003-GUARDA-ERROS
           ELSE
               IF WRK-MES < 01     OR WRK-MES > 12
                   DISPLAY WRK-ERRO-DATA-MES
                   PERFORM 2003-GUARDA-ERROS
               ELSE
                   IF WRK-ANO < 1950
                       DISPLAY WRK-ERRO-DATA-ANO
                       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.

       3000-FINALIZAR              SECTION.
           DISPLAY ' '.
           DISPLAY '*************** DCOMTS01 ***************'.
           DISPLAY '*                                      *'.
           DISPLAY '* DATA DO PROCESSAMENTO .: ' WRK-DATE-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 ***************'.

           STOP RUN.

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

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