Files

222 lines
6.4 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : ADPRRP028
OBJETIVO : LISTAR LAS ETIQUETAS DE LOS HIJOS DE LOS EMPLEADOS
PROGRAMADOR : Ing. Juan F. Soto
FECHA REALIZACION : Diciembre 28, 1993
-------------------------------------------------------------------------------
}
GLOBALS "adprgb000.4gl"
FUNCTION adprrp028()
## DEFINICION DEL REGISTRO DE BUSQUEDA CON LOS CAMPOS NECESARIOS PARA
## EL REPORTE
DEFINE hijos RECORD
num_emp LIKE adtb00003.num_emp,
departamento LIKE adtb00003.departamento,
nivel_emp LIKE adtb00003.nivel_emp,
cod_puesto LIKE adtb00003.cod_puesto,
nom1_emp LIKE adtb00003.nom1_emp,
apell1_emp LIKE adtb00003.apell1_emp,
cod_par INTEGER,
sec_par INTEGER,
nombre LIKE adtb00021.nombre,
sexo LIKE adtb00021.sexo,
fecha_nac LIKE adtb00021.fecha_nac,
edad INTEGER,
descripcion CHAR(20)
END RECORD,
edad1 INTEGER,
edad_h SMALLINT
# WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
CLEAR SCREEN
OPEN FORM adfmrp028 FROM "adfmrp028"
DISPLAY FORM adfmrp028
CALL pantalla()
DISPLAY "adprrp028" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Etiquetas Para Hijos" AT 6,30 ATTRIBUTE(BLACK)
## INDICA EL TIPO DE PAPEL NECESARIO PARA EL REPORTE. 1 - PAPEL 9 1/2 X 11
## 2 - PAPEL 14 7/8 X 11
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
CALL defecto(impresor) RETURNING imprime, letras.*, archivo
## SE INDICA EL CRITERIO DE BUSQUEDA PARA LA IMPRESION DEL REPORTE
INPUT BY NAME edad_h
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime,letras.*, archivo
AFTER INPUT
EXIT INPUT
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
CONSTRUCT criterio ON a.num_emp,b.sexo
FROM num_emp,sexo
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
## SE SELECCIONAN LOS CAMPOS NECESARIOS PARA EL REPORTE
LET SELEC =
"SELECT a.num_emp,a.departamento,a.nivel_emp,a.cod_puesto,a.nom1_emp, ",
" a.apell1_emp,b.cod_par,b.sec_par,b.nombre,b.sexo,b.fecha_nac ",
"FROM adtb00003 a,adtb00021 b ",
"WHERE a.num_emp = b.num_emp AND b.cod_par = 4 AND ",
" (a.status_t is null OR a.status_t NOT IN ('D','T','E')) AND ",
" b.status_t IS NULL AND ",criterio clipped," ORDER BY 1,7,11"
DISPLAY "<< Buscando Informacion ... Espere Por Favor. >>" AT 19,14
ATTRIBUTE (REVERSE,BOLD)
## AQUI SE PREPARA LA INFORMACION SELECCIONADA
PREPARE busca FROM selec
DECLARE accion CURSOR FOR busca
DISPLAY " " AT 19,14
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
START REPORT etiquetas TO archivo
## SE BUSCA LA INFORMACION DE LOS CAMPOS DEL REGISTRO PARA DARLE SALIDA
## AL REPORTE
FOREACH accion INTO hijos.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET edad1 = TODAY - hijos.fecha_nac
IF edad1 < 30 THEN
LET hijos.descripcion = "Dia(s)"
LET hijos.edad = edad1
ELSE
IF edad1 > 29 AND edad1 < 365 THEN
LET hijos.descripcion = "Mes(es)"
LET hijos.edad = edad1/30
ELSE
LET hijos.descripcion = "Ano(s)"
LET hijos.edad = edad1/365
END IF
END IF
IF hijos.edad <= edad_h AND
hijos.descripcion = "Ano(s)" THEN
OUTPUT TO REPORT etiquetas(hijos.*)
END IF
IF hijos.descripcion = "Mes(es)" THEN
OUTPUT TO REPORT etiquetas(hijos.*)
END IF
END FOREACH
FINISH REPORT etiquetas
RUN imprime
END FUNCTION
## DEFINICION DEL REGISTRO DE IMPRESION CON LOS CAMPOS NECESARIOS PARA
## EL REPORTE
REPORT etiquetas(x)
DEFINE x RECORD
num_emp LIKE adtb00003.num_emp,
departamento LIKE adtb00003.departamento,
nivel_emp LIKE adtb00003.nivel_emp,
cod_puesto LIKE adtb00003.cod_puesto,
nom1_emp LIKE adtb00003.nom1_emp,
apell1_emp LIKE adtb00003.apell1_emp,
cod_par INTEGER,
sec_par INTEGER,
nombre LIKE adtb00021.nombre,
sexo LIKE adtb00021.sexo,
fecha_nac LIKE adtb00021.fecha_nac,
edad INTEGER,
descripcion CHAR(30)
END RECORD
## DEFINICION DE LAS VARIABLES DE IMPRESION
DEFINE c,i,l1,l SMALLINT
DEFINE hora CHAR(5)
DEFINE bandera CHAR(1)
OUTPUT
## DEFINICION DE LOS MARGENES DE IMPRESION
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 3
# ORDER BY x.descripcion DESC,x.edad,x.sexo_hijo DESC,x.num_emp
FORMAT
PAGE HEADER
LET hora = time
BEFORE GROUP OF x.num_emp
IF c is null THEN
LET c = 1
END IF
LET l = 2
PRINT COLUMN 1, letras.negrillas_on,letras.doble_on,
COLUMN 3, x.num_emp using "&&&&","-",
x.departamento using "&&&&","-",
x.nivel_emp using "&&","-",
x.cod_puesto using "&&",
" ",x.nom1_emp clipped," ",x.apell1_emp clipped,
letras.negrillas_off,letras.doble_off
PRINT COLUMN 1, letras.negrillas_on
PRINT COLUMN 11, "Edad",
COLUMN 25, "Nombre"
SKIP 1 LINE
ON EVERY ROW
## CALCULANDO LA EDAD ACTUAL DE LOS HIJOS DE LOS EMPLEADOS.
PRINT COLUMN 11, x.edad using "<<<"," ",x.descripcion clipped,
COLUMN 25, x.cod_par USING "&&","-",x.sec_par USING "&&",
" ",x.nombre CLIPPED
LET l = l + 1
AFTER GROUP OF x.num_emp
LET l = l + 1
LET c = c + 1
SKIP 1 LINE
IF l < 9 THEN
LET l1 = 8 - l
FOR i = 1 TO l1
PRINT
END FOR
END IF
PRINT COLUMN 1,
"------------------------------------------------------------------------------"
IF c = 6 THEN
LET c = 1
SKIP TO TOP OF PAGE
END IF
END REPORT