000100 IDENTIFICATION DIVISION.
000110 PROGRAM-ID. PRAC12.
000120 AUTHOR. LUIS CECILIANO.
000130 DATE-WRITTEN. DECEMBER 18, 2019.
000140*ESTE PROGRAMA CREA UN REPORTE A PARTIR DE UNA LISTA
000150 SECURITY. FOREVER.
000200 ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT LISTA   ASSIGN TO DISK.
           SELECT REPORTE ASSIGN TO PRINTER.
000300 DATA DIVISION.
       FILE SECTION.
           FD LISTA
             VALUE OF DEPENDENTSPECS IS TRUE.
               01 REG-LISTA.
                   02 REG-NUMLISTA  PIC 9(04).
                   02 REG-NOMBRE    PIC X(18).
                   02 REG-APELLIDOS PIC X(20).
                   02 REG-NUMGPO    PIC 9(02).
           FD REPORTE
             REPORT IS LISTADO.
       WORKING-STORAGE SECTION.
           01 WKS-EOF-LISTA PIC 9(06).
           01 WS-CUANTOS    PIC 9(03).
           01 WS-HORAS      PIC 9(10).
       REPORT SECTION.
           RD LISTADO
               PAGE LIMIT   058
               HEADING      001
               FIRST DETAIL 009
               LAST DETAIL  052
               CONTROL IS   REG-NUMGPO.
       01 RD-IMPRE-TITULOS TYPE IS PH.
           10 RD-IMPRE-TITULO-01 LINE 001.
               15 COLUMN 001 PIC X(13) VALUE "S999/P600-001".
               15 COLUMN 047 PIC X(42) VALUE 
                 "GRUPO CAPACITACIÓN STEFANINI - COBOL74".
           10 RD-IMPRE-TITULO-02 LINE 003.
               15 COLUMN 001 PIC X(14) VALUE "FECHA PROCESO:".
               15 COLUMN 016 PIC 99/99/99 SOURCE TODAYS-DATE.
               15 COLUMN 060 PIC X(25) VALUE 
                 "SISTEMA DE CAPACITACIONES".
               15 COLUMN 120 PIC X(07) VALUE "HOJA:".
               15 COLUMN 127 PIC Z,ZZZ SOURCE PAGE-COUNTER.
           10 RD-IMPRE-TITULO-03 LINE 004.
               15 COLUMN 001 PIC X(006) VALUE "HORA: ".
               15 COLUMN 016 PIC 9(010) SOURCE WS-HORAS.
               15 COLUMN 047 PIC X(040) VALUE 
                 "L I S T A   D E   A S I S T E N C I A".
           10 RD-IMPRE-TITULO-04 LINE 006.
               15 COLUMN 002 PIC X(003) VALUE "GPO".
               15 COLUMN 006 PIC X(004) VALUE "NUM.".
               15 COLUMN 015 PIC X(006) VALUE "NOMBRE".
               15 COLUMN 040 PIC X(009) VALUE "APELLIDOS".
       01 RD-IMPRE-DETALLE TYPE DETAIL.
           10 RD-IMPRE-DET01 LINE PLUS 001.
               15 COLUMN 002 GROUP INDICATE PIC Z(002) SOURCE
                   REG-NUMGPO.
               15 COLUMN 006 PIC Z(004) SOURCE REG-NUMLISTA.
               15 COLUMN 015 PIC X(020) SOURCE REG-NOMBRE.
               15 COLUMN 040 PIC X(025) SOURCE REG-APELLIDOS.
       01 RD-IMPRE-CORTE TYPE DETAIL.
           10 RD-IMPRE-PIE-01 LINE PLUS 002.
               15 COLUMN 006 PIC X(027) VALUE
                 "--------------------------".
           10 RD-IMPRE-PIE-02 LINE PLUS 002.
               15 COLUMN 001 PIC X(10) VALUE SPACES.
       01 TYPE PAGE FOOTING.
           10 COLUMN 10 PIC X(42) VALUE
             "*REPORTE DE ASISTENCIA CAPACITACION COBOL.".
000400 PROCEDURE DIVISION.
000500 0000-CONTROL.
000600     PERFORM 1000-INICIO
           PERFORM 2000-PROCESO
           PERFORM 3000-TERMINA
           STOP RUN.
       1000-INICIO.
           CHANGE ATTRIBUTE TITLE OF LISTA TO 
             "LAHC/FILE/INTE/99902E02/01/191211/LST/TXT".
           IF ATTRUBUTE RESIDENT OF LISTA = VALUE TRUE
               OPEN INPUT LISTA
           ELSE 
               DISPLAY "NO EXISTE EL ARCHIVO LISTA: "
               MOVE 1 TO WKS-EOF-LISTA.
           CHANGE ATTRUBUTE TITLE OF REPORTE TO 
             "LAHC/LIST/P126/191218."
           CHANGE ATTRUBUTE USERBACKUPNAME OF REPORTE TO 1
           ACCEPT WS-HORAS FROM TIME
           OPEN OUTPUT REPORTE
           INITIATE LISTADO.
       2000-PROCESO.
           PERFORM 2500-GENERA-REPORTE UNTIL WKS-EOF-LISTA = 1
           TERMINATE LISTADO.
       2500-GENERA-REPORTE.
           GENERATE RD-IMPRE-DETALLE
           PERFORM 9999-LEE-LISTA.
       3000-TERMINA.
           CLOSE LISTA.
           CLOSE REPORTE.
       9999-LEE-LISTA.
           READ LISTA AT END MOVE 1 TO WKS-EOF-LISTA.