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

473 lines
15 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : ADPRRP011
OBJETIVO : Listar las informaciones generales de los
Empleados Quincenales y Semanales y Ex-Empleados
PROGRAMADOR : Ing. Betania Guerrero Perez
FECHA REALIZACION : Junio 24, 1993
-------------------------------------------------------------------------------
}
GLOBALS "adprgb000.4gl"
DEFINE tipo_l,imp_form CHAR(1),
cedula_emp CHAR(13),
fecha_i,fecha_f DATE,
archivo1 CHAR(100)
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
CONNECT to "smarmotech" USER usuarios USING clave
SELECT a.* INTO p_companias.* FROM companias a
CALL adprrp011()
END MAIN
FUNCTION adprrp011()
DEFINE handler om.SaxDocumentHandler, -- return value from fgl_report_commitCurrentSettings()
r_filename STRING, -- filename of Report Design Document including .4rp extension
r_output STRING, -- output format option
preview INTEGER -- TRUE/FALSE, to set preview option
## SE DEFINE EL REGISTRO DE BUSQUEDA CON LOS CAMPOS NECESARIOS PARA EL REPORTE
DEFINE list_emp 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,
cedula LIKE adtb00003.cedula,
serie LIKE adtb00003.serie,
telefono LIKE adtb00003.telefono,
fech_nac LIKE adtb00003.fech_nac,
tipo_sangre LIKE adtb00003.tipo_sangre,
licencia LIKE adtb00003.licencia,
fech_efec LIKE adtb00003.fech_efec,
sueldo_ac LIKE adtb00003.sueldo_ac,
nom_dpto LIKE adtb00001.nom_dpto,
nom_puesto LIKE adtb00004.nom_puesto,
calle LIKE adtb00003.calle,
casa_num LIKE adtb00003.casa_num,
barrio LIKE adtb00003.barrio,
urbanizacion LIKE adtb00003.urbanizacion,
sexo LIKE adtb00030.sexo
END RECORD
#WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
CLEAR SCREEN
OPEN FORM adfmrp011 FROM "adfmrp011"
DISPLAY FORM adfmrp011
DISPLAY "adprrp011" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Empleados Activos" AT 6,34 ATTRIBUTE(BLACK)
## INDICA EL PAPEL NECESARIO PARA IMPRIMIR EL REPORTE. 1 - PAPEL 9 1/2 X 11
## 2 - PAPEL 14 7/8 X 11
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
## AQUI SE DIGITA LA VARIABLE QUE INDICA LA CONDICION DEL REPORTE, ES DECIR
## SI SE TRATA DE EMPLEADOS SEMANALES O QUINCENALES
INPUT BY NAME decide,imp_form
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
CONSTRUCT BY NAME criterio ON a.num_emp
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
IF imp_form = "S" THEN
INPUT BY NAME fecha_i,fecha_f
END IF
LABEL pide:
PROMPT "Listado Numerico o Alfabetico (N/A)? " FOR CHAR tipo_l
LET tipo_l = UPSHIFT(tipo_l)
IF tipo_l IS NULL THEN
LET tipo_l = "K"
END IF
IF tipo_l != "N" AND tipo_l != "A" THEN
GOTO pide
END IF
IF decide IS NULL THEN
LET decide = "S"
END IF
## SE SELECCIONAN LOS CAMPOS NECESARIOS PARA EL REPORTE DE LOS QUINCENALES
IF tipo_l = "N" THEN
LET SELEC =
"SELECT UNIQUE a.num_emp,a.departamento,a.nivel_emp,a.cod_puesto, ",
" a.nom1_emp,a.apell1_emp,a.cedula,a.serie,a.telefono,a.fech_nac, ",
" a.tipo_sangre,a.licencia,a.fech_efec,a.sueldo_ac,c.nom_dpto, ",
" b.nom_puesto,a.calle,a.casa_num,a.barrio,a.urbanizacion,d.sexo ",
"FROM adtb00003 a,adtb00004 b,adtb00001 c,adtb00030 d ",
"WHERE (a.cod_puesto=b.cod_puesto) AND (a.departamento=c.departamento) AND ",
" a.nomina=? AND (a.status_t is null OR a.status_t NOT IN('D','E','T')) AND ",
" (a.num_emp = d.num_emp AND ",criterio CLIPPED,
") ORDER BY 1 "
ELSE
LET SELEC =
"SELECT UNIQUE a.num_emp,a.departamento,a.nivel_emp,a.cod_puesto, ",
" a.nom1_emp,a.apell1_emp,a.cedula,a.serie,a.telefono,a.fech_nac, ",
" a.tipo_sangre,a.licencia,a.fech_efec,a.sueldo_ac,c.nom_dpto, ",
" b.nom_puesto,a.calle,a.casa_num,a.barrio,a.urbanizacion ",
"FROM adtb00003 a,adtb00004 b,adtb00001 c ",
"WHERE (a.cod_puesto=b.cod_puesto) AND (a.departamento=c.departamento) AND ",
" a.nomina=? AND (a.status_t is null OR a.status_t NOT IN('D','E','T'))", #AND ",
" ORDER BY 6 "
{
" (a.num_emp = d.num_emp AND ",criterio CLIPPED,
") ORDER BY 6 "
}
END IF
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
OPEN accion USING decide
IF imp_form = "S" THEN
CALL formulario_S()
END IF
-- configure report engine; the functions prefixed fgl that are called here are part of the GRW API
LET r_filename = 'adprrp011.4rp'
IF fgl_report_loadCurrentSettings(r_filename) THEN -- load the .4rp file
LET r_output='SVG'
LET preview=1
CALL fgl_report_selectDevice(r_output) -- changing default
CALL fgl_report_selectPreview(preview) -- changing default
LET handler = fgl_report_commitCurrentSettings() -- commit changes
END IF
--run the report
IF handler IS NOT NULL THEN -- report engine was configured ok
START REPORT emplear TO XML HANDLER handler
## AQUI SE BUSCA LA INFORMACION DE LOS CAMPOS DEL REGISTRO PARA DARLE
## SALIDA AL REPORTE
WHILE STATUS != NOTFOUND
FETCH accion INTO list_emp.*
IF STATUS = NOTFOUND THEN
EXIT WHILE
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
# BUSCA LA CEDULA DEL EMPLEADO
LET cedula_emp = NULL
SELECT a.cedula_n INTO cedula_emp
FROM adtb00038 a
WHERE a.num_emp = list_emp.num_emp
IF STATUS = NOTFOUND THEN
LET STATUS = 0
END IF
OUTPUT TO REPORT emplear(list_emp.*)
END WHILE
FINISH REPORT emplear
RUN imprime
CLEAR SCREEN
END IF
END FUNCTION
## AQUI SE DEFINE EL REGISTRO DE IMPRESION CON LOS CAMPOS NECESARIOS PARA
## EL REPORTE
REPORT emplear(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,
cedula LIKE adtb00003.cedula,
serie LIKE adtb00003.serie,
telefono LIKE adtb00003.telefono,
fech_nac LIKE adtb00003.fech_nac,
tipo_sangre LIKE adtb00003.tipo_sangre,
licencia LIKE adtb00003.licencia,
fech_efec LIKE adtb00003.fech_efec,
sueldo_ac LIKE adtb00003.sueldo_ac,
nom_dpto LIKE adtb00001.nom_dpto,
nom_puesto LIKE adtb00004.nom_puesto,
calle LIKE adtb00003.calle,
casa_num LIKE adtb00003.casa_num,
barrio LIKE adtb00003.barrio,
urbanizacion LIKE adtb00003.urbanizacion,
sexo LIKE adtb00030.sexo
END RECORD
## DEFINICION DE LAS VARIABLES DE IMPRESION
DEFINE hora CHAR(5)
DEFINE l SMALLINT
DEFINE varia CHAR(12)
OUTPUT
## DEFINICION DE LOS MARGENES DE IMPRESION
TOP MARGIN 0
LEFT MARGIN 2
BOTTOM MARGIN 4
FORMAT
PAGE HEADER
{LET hora = time
IF decide = "Q" THEN
LET varia = "QUINCENALES"
END IF
IF decide = "S" THEN
LET varia = "SEMANALES"
END IF
IF decide = "T" THEN
LET varia = "EX-EMPLEADOS"
END IF}
## SE CALCULA LA LONGITUD DE LA VARIABLE -VARIA-
LET l = (135 - LENGTH(varia))/2
{ PRINT column "Fecha de",
COLUMN 86, "Tipo de",
COLUMN 104, "Fecha de"}
## AQUI SE INDICA LA IMPRESION DEL DETALLE
ON EVERY ROW
PRINTX
x.num_emp,
x.departamento,
x.nivel_emp,
x.cod_puesto,
x.apell1_emp,
x.nom1_emp,
cedula_emp,
x.telefono,
x.fech_nac,
x.tipo_sangre,
x.licencia,
x.fech_efec,
x.sueldo_ac
PRINTX
x.nom_dpto,
x.nom_puesto,
x.calle,
x.casa_num,
x.barrio,
x.urbanizacion,
x.sexo
SKIP 1 LINE
ON LAST ROW
SKIP 1 LINE
PRINT COLUMN 2, "Total de Registros Impresos = ", count(*) using "###"
END REPORT
FUNCTION formulario_S()
DEFINE archivo,filename CHAR(100),
cnt SMALLINT,
cels CHAR(30),
cedula_emp CHAR(13),
nombre_mes CHAR(30)
DEFINE list_emp1 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,
cedula LIKE adtb00003.cedula,
serie LIKE adtb00003.serie,
telefono LIKE adtb00003.telefono,
fech_nac LIKE adtb00003.fech_nac,
tipo_sangre LIKE adtb00003.tipo_sangre,
licencia LIKE adtb00003.licencia,
fech_efec LIKE adtb00003.fech_efec,
sueldo_ac LIKE adtb00003.sueldo_ac,
nom_dpto LIKE adtb00001.nom_dpto,
nom_puesto LIKE adtb00004.nom_puesto,
calle LIKE adtb00003.calle,
casa_num LIKE adtb00003.casa_num,
barrio LIKE adtb00003.barrio,
urbanizacion LIKE adtb00003.urbanizacion,
sexo LIKE adtb00030.sexo
END RECORD
--# CALL fgl_init4js()
--# LET archivo1 = NULL
--# LET filename = NULL
--# LET filename = FGL_GETENV("USPROGRAM")
--# LET archivo1 = "H:\\\\FORMULARIOS\\\\adprrp011.XLS"
--# LET filename = filename CLIPPED," H:\\\\FORMULARIOS\\\\adprrp011.XLS"
--# IF winexec(filename) AND imp_form = "S" THEN
--# IF DDEconnect("EXCEL",archivo1) THEN
--# LET fecha_i = fecha_i USING "dd/mm/yyyy"
--# LET fecha_f = fecha_f USING "dd/mm/yyyy"
SELECT a.descrip INTO nombre_mes
FROM mestable a
WHERE a.mes = MONTH(fecha_i)
--# LET cels = "R",5 USING "<<<<","C19"
--# IF DDEpoke("EXCEL",archivo1,cels,nombre_mes) THEN
--# ELSE
--# LET numero_msg =391
--# CALL msg(numero_msg)
--# END IF
--# LET cels = "R",6 USING "<<<<","C19"
--# IF DDEpoke("EXCEL",archivo1,cels,YEAR(fecha_i)) THEN
--# ELSE
--# LET numero_msg =391
--# CALL msg(numero_msg)
--# END IF
LET selec =
"SELECT UNIQUE a.num_emp,a.departamento,a.nivel_emp,a.cod_puesto, ",
" a.nom1_emp,a.apell1_emp,a.cedula,a.serie,a.telefono,a.fech_nac, ",
" a.tipo_sangre,a.licencia,a.fech_efec,a.sueldo_ac,c.nom_dpto, ",
" b.nom_puesto,a.calle,a.casa_num,a.barrio,a.urbanizacion,d.sexo ",
"FROM adtb00003 a,adtb00004 b,adtb00001 c,adtb00030 d ",
"WHERE (a.cod_puesto=b.cod_puesto) AND (a.departamento=c.departamento) AND ",
" a.nomina=? AND (a.status_t is null OR a.status_t NOT IN('D','E','T')) AND ",
" (a.num_emp = d.num_emp AND a.fech_efec BETWEEN ? AND ? and ",criterio CLIPPED,
") ORDER BY 1 "
PREPARE busca1 FROM selec
DECLARE accion1 CURSOR FOR busca1
OPEN accion1 USING decide,fecha_i,fecha_f
LET cnt = 20
FOREACH accion1 INTO list_emp1.*
--# LET cels = "R",cnt USING "<<<<","C3"
--# IF DDEpoke("EXCEL",archivo1,cels,list_emp1.nom1_emp) THEN
--# ELSE
--# LET numero_msg =391
--# CALL msg(numero_msg)
--# END IF
--# LET cels = "R",cnt USING "<<<<","C4"
--# IF DDEpoke("EXCEL",archivo1,cels,list_emp1.apell1_emp) THEN
--# ELSE
--# LET numero_msg =391
--# CALL msg(numero_msg)
--# END IF
# BUSCA LA CEDULA
LET cedula_emp = NULL
SELECT a.cedula_n INTO cedula_emp
FROM adtb00038 a
WHERE a.num_emp = list_emp1.num_emp
--# LET cels = "R",cnt USING "<<<<","C5"
--# IF DDEpoke("EXCEL",archivo1,cels,cedula_emp) THEN
--# ELSE
--# LET numero_msg =391
--# CALL msg(numero_msg)
--# END IF
display list_emp1.sexo
IF list_emp1.sexo = "F" THEN
--# LET cels = "R",cnt USING "<<<<","C8"
--# IF DDEpoke("EXCEL",archivo1,cels,"X") THEN
--# ELSE
--# LET numero_msg =391
--# CALL msg(numero_msg)
--# END IF
ELSE
--# LET cels = "R",cnt USING "<<<<","C9"
--# IF DDEpoke("EXCEL",archivo1,cels,"X") THEN
--# ELSE
--# LET numero_msg =391
--# CALL msg(numero_msg)
--# END IF
END IF
--# LET cels = "R",cnt USING "<<<<","C10"
--# IF DDEpoke("EXCEL",archivo1,cels,"DOMINICANA") THEN
--# ELSE
--# LET numero_msg =391
--# CALL msg(numero_msg)
--# END IF
--# LET cels = "R",cnt USING "<<<<","C13"
--# IF DDEpoke("EXCEL",archivo1,cels,"X") THEN
--# ELSE
--# LET numero_msg =391
--# CALL msg(numero_msg)
--# END IF
--# LET cels = "R",cnt USING "<<<<","C14"
--# IF DDEpoke("EXCEL",archivo1,cels,list_emp1.sueldo_ac) THEN
--# ELSE
--# LET numero_msg =391
--# CALL msg(numero_msg)
--# END IF
--# LET cels = "R",cnt USING "<<<<","C15"
--# IF DDEpoke("EXCEL",archivo1,cels,"X") THEN
--# ELSE
--# LET numero_msg =391
--# CALL msg(numero_msg)
--# END IF
LET cnt = cnt + 1
END FOREACH
--# ELSE
--# CALL fgl_winmessage ("No Pude Conectarme",filename,"stop")
--# END IF
--# ELSE
--# CALL fgl_winmessage ("No Pude Encontrar El Programa",filename,"stop")
--# END IF
END FUNCTION