Files
MBS/PROYECTO/addir/adprrp014.4gl
T

250 lines
7.8 KiB
Plaintext

{
-------------------------------------------------------------------------------
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