IDENTIFICATION          DIVISION.
       PROGRAM-ID.             GUILHERME2.
      *******************************************************
      * LE UM ARQUIVO DE ENTRADA ECADFUNC E GERA RELATORIO  *
      *******************************************************
       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                PIC 9(011).
       77  ACU-LIDOS-ECADFUNC      PIC 9(011).
       77  SEM-DIREITO             PIC 9(011).
       77  COM-DIREITO             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-DIA            PIC X(030)  VALUE
              'ERRO NO DIA INFORMADO'.
       77  WRK-ERRO-MES            PIC X(030)  VALUE
              'ERRO NO MES INFORMADO'.
       77  WRK-ERRO-ANO            PIC X(030)  VALUE
              'ERRO NO ANO INFORMADO'.
       PROCEDURE                   DIVISION.
       0000-PRINCIPAL              SECTION.
           PERFORM 1000-INICIALIZAR.
           PERFORM 2000-PROCESSAR 8 TIMES.
           PERFORM 3000-APRESENTAR.
       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 5551-VERIFICA1.

       5551-VERIFICA1              SECTION.
           IF WRK-DIA < 01         OR WRK-DIA > 31
               DISPLAY WRK-ERRO-DIA
               PERFORM 9999-ERROS
           ELSE
               IF WRK-MES < 01     OR WRK-MES > 12
                   DISPLAY WRK-ERRO-MES
                   PERFORM 9999-ERROS
               ELSE
                   IF WRK-ANO < 1950
                       DISPLAY WRK-ERRO-ANO
                       PERFORM 9999-ERROS
                   ELSE
                       PERFORM 5552-VERIFICA2
                   END-IF
               END-IF
           END-IF.

       5552-VERIFICA2              SECTION.
           IF WRK-ANO >= 2003
               IF WRK-MES >= 09
                   IF WRK-DIA >= 01
                       ADD 1       TO SEM-DIREITO
                       PERFORM 0000-GRAVA-SEM-DIREITO
                   END-IF
               ELSE
                   ADD 1           TO COM-DIREITO
                   PERFORM 8888-GRAVA-COM-DIREITO
               END-IF
           ELSE
               ADD 1               TO COM-DIREITO
               PERFORM 8888-GRAVA-COM-DIREITO
           END-IF.

       3000-APRESENTAR             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 SEM-DIREITO       TO WRK-MASCARA

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

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

           PERFORM 4000-FINALIZAR.

       9999-ERROS                  SECTION.
           ADD 1 TO WRK-ERRO.

       4000-FINALIZAR              SECTION.
           STOP RUN.

       8888-GRAVA-COM-DIREITO      SECTION.
           DISPLAY 'GRAVADO COM DIREITO'.

       0000-GRAVA-SEM-DIREITO      SECTION.
           DISPLAY 'GRAVADO SEM DIREITO'.