{ ------------------------------------------------------------------------------- PROGRAMA : ADPRRP014 OBJETIVO : LISTAR LOS HIJOS DE EMPLEADOS ORDENADOS POR EDAD PROGRAMADOR : Ing. Betania Guerrero Perez FECHA REALIZACION : Junio 25, 1993 ------------------------------------------------------------------------------- } GLOBALS "adprgb000.4gl" FUNCTION adprrp014() ## 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 SMALLINT, sec_par SMALLINT, 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 9, ERROR LINE 23, COMMENT LINE 21 CLEAR SCREEN OPEN FORM adfmrp004 FROM "adfmrp004" DISPLAY FORM adfmrp004 CALL pantalla() DISPLAY "adprrp014" AT 4,3 ATTRIBUTE(RED) DISPLAY "Hijos de Empleados" AT 6,29 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 ON KEY(CONTROL-P) CALL busca_printer() RETURNING imprime,letras.*, archivo AFTER CONSTRUCT EXIT CONSTRUCT END CONSTRUCT 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 UNIQUE 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 ", " b.status_t is null AND (a.status_t is null OR ", " a.status_t NOT IN('D','T','E')) AND ",criterio clipped, " ORDER BY 1,7,8" 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 list_hijo 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 = 0 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 != "Mes(es)" THEN OUTPUT TO REPORT list_hijo(hijos.*) END IF IF hijos.descripcion = "Mes(es)" THEN OUTPUT TO REPORT list_hijo(hijos.*) END IF END FOREACH FINISH REPORT list_hijo RUN imprime END FUNCTION ## DEFINICION DEL REGISTRO DE IMPRESION CON LOS CAMPOS NECESARIOS PARA ## EL REPORTE REPORT list_hijo(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 SMALLINT, sec_par SMALLINT, nombre LIKE adtb00021.nombre, sexo LIKE adtb00021.sexo, fecha_nac LIKE adtb00021.fecha_nac, edad INTEGER, descripcion CHAR(20) END RECORD ## DEFINICION DE LAS VARIABLES DE IMPRESION 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 ## AQUI SE INDICA LA IMPRESION DE LOS ENCABEZADOS PRINT COLUMN 1, letras.normal,letras.negrillas_on PRINT COLUMN 2, "adprrp014", COLUMN 17, "R A Y . O . V A C D O M I N I C A N A, S. A.", COLUMN 73, "Pag. ",pageno using "###" PRINT COLUMN 17, " Sistema de Administracion de Personal", COLUMN 73, today using "dd/mm/yyyy" PRINT COLUMN 17, " Hijos de Empleados", COLUMN 76, hora PRINT COLUMN 2, "---------------------------------------------------", "-------------------------------" PRINT COLUMN 50, "Fecha de" PRINT COLUMN 2, "Ficha No.", COLUMN 19, "Nombre Empleado", COLUMN 44, "Sexo", COLUMN 50, "Nacimiento", COLUMN 62, "Edad" PRINT COLUMN 2, "---------------------------------------------------", "-------------------------------" skip 1 line ## AQUI SE INDICA LA IMPRESION DEL DETALLE BEFORE GROUP OF x.num_emp PRINT COLUMN 1, letras.negrillas_on PRINT COLUMN 2, x.num_emp using "&&&&","-", x.departamento using "&&&&","-", x.nivel_emp using "&&","-", x.cod_puesto using "&&", " ",x.nom1_emp clipped," ",x.apell1_emp clipped PRINT COLUMN 56, letras.negrillas_off ON EVERY ROW ## CALCULANDO LA EDAD ACTUAL DE LOS HIJOS DE LOS EMPLEADOS. {IF x.fech_nac_h IS NOT NULL THEN LET x.edad = today - x.fech_nac_h IF x.edad < 365 THEN LET x.edad = x.edad/30 LET x.descripcion = "meses" ELSE LET x.edad = x.edad/365 LET x.descripcion = "anos" END IF UPDATE adtb00021 set (edad,descripcion) = (x.edad,x.descripcion) WHERE @num_emp = x.num_emp and @nom_hijo = x.nom_hijo and @sexo_hijo = x.sexo_hijo and @fech_nac_h = x.fech_nac_h } PRINT COLUMN 11, x.cod_par USING "&&","-",x.sec_par USING "&&"," ", x.nombre clipped, COLUMN 45, x.sexo, COLUMN 50, x.fecha_nac using "dd/mm/yyyy", COLUMN 63, x.edad using "<<<"," ",x.descripcion ON LAST ROW SKIP 1 LINE PRINT COLUMN 2, "Total de Registros Impresos = ", count(*) using "###" END REPORT