Files
2026-09-22 20:38:51 -04:00

551 lines
18 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : NOPRRP035
OBJETIVO : PLANILLA VACACIONES DGT3 y DGT4
PROGRAMADOR : Ing. JUAN F. SOTO
FECHA REALIZACION : ENERO 18, 1999
MODIFICADO POR : Ing. Juan Soto
DETALLE MODIFICACION : Genera la planilla de la TSS DGT3 Y DGT4 a excel
FECHA MODIFIA
-------------------------------------------------------------------------------
}
GLOBALS "noprgb000.4gl"
DEFINE selec,rcol,arch_pc,fila_excel,prog,res STRING,
p_res INT,cuenta,xi,progreso SMALLINT,
ciarnc CHAR(11),
idioma_office VARCHAR,
tipo_Reporte VARCHAR(10)
DEFINE fecha_formulario DATE,
registro_no,formulario_no INTEGER,
tmpfecha CHAR(12),
cnt SMALLINT
DEFINE m_cedula CHAR(12),
fecha_c,fecha_entrada DATE
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
CALL startlog("NORP35,txt")
CONNECT to "smarmotech" USER usuarios USING clave
SELECT a.* INTO p_companias.* FROM companias a
CALL noprrp035()
END MAIN
FUNCTION noprrp035()
DEFINE registro RECORD
nomina LIKE adtb00003.nomina,
num_emp LIKE adtb00003.num_emp,
departamento LIKE adtb00003.departamento,
nivel_emp LIKE adtb00003.nivel_emp,
cod_puesto LIKE adtb00003.cod_puesto,
nom1_emp CHAR(20),
nom2_emp CHAR(20),
apell1_emp CHAR(20),
apell2_emp CHAR(20),
cedula LIKE adtb00003.cedula,
serie LIKE adtb00003.serie,
fech_nac DATE,
fech_efec DATE,
sexo LIKE adtb00021.sexo,
nacionalidad CHAR(10),
nom_puesto LIKE adtb00004.otra_descripcion,
sueldo_ac LIKE adtb00003.sueldo_ac,
numero_tss LIKE adtb00003.cod_seg1,
turno LIKE adtb00003.licencia,
sucid LIKE adtb00003.sucid,
puesto_real LIKE adtb00004.nom_puesto,
novedad VARCHAR(20),
fecha_sal DATE,
desc_puesto VARCHAR(150),
educacion VARCHAR(100),
fecha_cambio DATE
END RECORD
DEFINE fecha1,fecha2 DATE
DEFINE l_fech_ini,l_fech_fin DATE,
l_f_ini,l_f_fin CHAR(10),
periodo CHAR(6)
## DEFINICION DEL REGISTRO DE BUSQUEDA CON LOS CAMPOS NECESARIOS PARA
## EL REPORTE
DEFINE extras RECORD
num_emp LIKE adtb00003.num_emp,
departamento LIKE adtb00003.departamento,
nivel LIKE adtb00003.nivel_emp,
cod_puesto LIKE adtb00003.cod_puesto,
nom1_emp CHAR(20),
nom2_emp CHAR(20),
apell1_emp CHAR(20),
apell2_emp CHAR(20),
cedula LIKE adtb00003.cedula,
serie LIKE adtb00003.serie,
cod_mov LIKE notb00008.cod_mov,
cantidad LIKE notb00008.cantidad,
valor LIKE notb00008.valor
END RECORD
# WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
CLEAR SCREEN
#LET formulario = formulario CLIPPED,"nofmrp035"
OPEN FORM nofmrp035 FROM "nofmrp035"
DISPLAY FORM nofmrp035
#CALL pantalla()
DISPLAY "noprnorp035" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Horas Extras Empleados" AT 6,32 ATTRIBUTE(BLACK)
CONSTRUCT BY NAME criterio ON b.num_emp,b.departamento
## AQUI SE INDICA EL CRITERIO DE BUSQUEDA DEL REPORTE
INPUT BY NAME registro_no,formulario_no,tipo_Reporte,fecha_formulario,fecha2,idioma_office
AFTER FIELD tipo_reporte
IF tipo_reporte = 'DGT3' THEN
NEXT FIELD idioma_office
ELSE
NEXT FIELD fecha_formulario
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
EXIT INPUT
END INPUT
## SE SELECCIONAN LOS CAMPOS NECESARIOS PARA EL REPORTE
LET prog = "EXCEL"
IF idioma_office = "E" THEN
LET fila_excel = "F"
ELSE
LET fila_excel = "R"
END IF
CALL ui.Interface.frontCall("WINDDE","DDEFinishAll", [], [res] );
CALL ui.Interface.frontCall("standard","getenv", ["USDGT3Y4"], [file] )
# LET arch_pc='"',FILE CLIPPED,'"' -- le agrega las comillas por si hay blancos (solo se necesita para shellexec)
LET arch_pc = FILE CLIPPED
CALL ui.Interface.frontCall("standard","shellexec", [arch_pc], [p_res] )
CALL chqDdeError(p_res,"shellexec "||arch_pc)
CALL ui.Interface.frontCall("WINDDE","DDEConnect", [prog,arch_pc], [p_res] )
CALL chqDdeError(p_res,"DDEConnect "||arch_pc)
START REPORT planilla TO "dummy"
#REPLACE(CONVERT (VARCHAR,b.fech_nac,101),'/',''),REPLACE(CONVERT(VARCHAR,b.fech_efec,101),'/',''), ",
IF tipo_reporte = 'DGT3' THEN
LET selec =
"SELECT distinct b.nomina,b.num_emp,b.departamento,b.nivel_emp,b.cod_puesto, ",
"b.nom1_emp, b.nom2_emp,",
"b.apell1_emp,b.apell2_emp,b.cedula,b.serie,
b.fech_nac,b.fech_efec, ",
"c.sexo,f.nom_nac,d.otra_descripcion,b.sueldo_ac,b.cod_seg1,'001',b.sucid, ",
" d.nom_puesto ",
"FROM adtb00003 b inner join notb00008 h ON (h.num_emp = b.num_emp ) and h.departamento = b.departamento
right outer join adtb00021 c on (b.num_emp = c.num_emp)
right outer join adtb00004 d on b.cod_puesto = d.cod_puesto
right outer join adtb00007 f ON f.cod_nac = b.cod_nac ",
" left outer join adtb00055 k ON (k.num_emp = b.num_emp) ",
"WHERE ",
criterio CLIPPED,
" and b.status_t is null and h.fecha between '",fecha_formulario USING 'mm/dd/yyyy', "' and '",fecha2 USING 'mm/dd/yyyy',"'",
" ORDER BY b.departamento,b.cod_puesto "
ELSE
LET selec =
"SELECT b.nomina,b.num_emp,b.departamento,b.nivel_emp,b.cod_puesto, ",
"b.nom1_emp, b.nom2_emp,",
"b.apell1_emp,b.apell2_emp,b.cedula,b.serie,CONVERT (CHAR(10),b.fech_nac,103),CONVERT(CHAR(10),b.fech_efec,103), ",
"c.sexo,f.nom_nac,d.otra_descripcion,b.sueldo_ac,b.cod_seg1,k.id_horario,b.sucid, ",
" d.nom_puesto,'Ingreso',b.fecha_salida,RTRIM(d.funciones)+' '+ISNULL(d.funcion1,' '), ",
" e.nom_educa,b.fecha_ultimo_aumento ",
"FROM adtb00003 b left outer join adtb00021 c on c.num_emp=b.num_emp left outer join
adtb00004 d on b.cod_puesto = d.cod_puesto left outer join adtb00005 e on e.cod_educa = b.nivel_emp ",
" left outer join adtb00007 f ON f.cod_nac = b.cod_nac ",
" left outer join adtb00055 k ON k.num_emp = b.num_emp ",
"WHERE ",
" b.status_t IS NULL and ",criterio CLIPPED,
" and b.fech_efec between '",fecha_formulario USING "mm/dd/yyyy","' and '",fecha2 USING "mm/dd/yyyy" ,"' ",
" UNION ",
"SELECT b.nomina,b.num_emp,b.departamento,b.nivel_emp,b.cod_puesto, ",
"b.nom1_emp, b.nom2_emp,",
"b.apell1_emp,b.apell2_emp,b.cedula,b.serie,CONVERT (CHAR(10),b.fech_nac,103),CONVERT(CHAR(10),b.fech_efec,103), ",
"c.sexo,f.nom_nac,d.otra_descripcion,b.sueldo_ac,b.cod_seg1,k.id_horario,b.sucid, ",
" d.nom_puesto,'Salida',b.fecha_salida,RTRIM(d.funciones)+' '+ISNULL(d.funcion1,' '), ",
" e.nom_educa,b.fecha_ultimo_aumento ",
"FROM adtb00003 b left outer join adtb00021 c on c.num_emp=b.num_emp left outer join
adtb00004 d on b.cod_puesto = d.cod_puesto left outer join adtb00005 e on e.cod_educa = b.nivel_emp ",
" left outer join adtb00007 f ON f.cod_nac = b.cod_nac ",
" left outer join adtb00055 k ON k.num_emp = b.num_emp ",
"WHERE ",
" b.status_t IS NOT NULL and ",criterio CLIPPED,
" and b.fecha_salida between '",fecha_formulario USING "mm/dd/yyyy","' and '",fecha2 USING "mm/dd/yyyy" ,"' ",
" UNION ",
"SELECT b.nomina,b.num_emp,b.departamento,b.nivel_emp,b.cod_puesto, ",
"b.nom1_emp, b.nom2_emp,",
"b.apell1_emp,b.apell2_emp,b.cedula,b.serie,CONVERT (CHAR(10),b.fech_nac,103),CONVERT(CHAR(10),b.fech_efec,103), ",
"c.sexo,f.nom_nac,d.otra_descripcion,b.sueldo_ac,b.cod_seg1,k.id_horario,b.sucid, ",
" d.nom_puesto,'Cambio',b.fecha_salida,RTRIM(d.funciones)+' '+ISNULL(d.funcion1,' '), ",
" e.nom_educa,b.fecha_ultimo_aumento ",
"FROM adtb00003 b left outer join adtb00021 c on c.num_emp=b.num_emp left outer join
adtb00004 d on b.cod_puesto = d.cod_puesto left outer join adtb00005 e on e.cod_educa = b.nivel_emp ",
" left outer join adtb00007 f ON f.cod_nac = b.cod_nac ",
" left outer join adtb00055 k ON k.num_emp = b.num_emp ",
"WHERE ",
" b.status_t IS NULL and ",criterio CLIPPED,
" and b.fecha_ultimo_aumento between '",fecha_formulario USING "mm/dd/yyyy","' and '",fecha2 USING "mm/dd/yyyy" ,"' ",
" ORDER BY b.departamento,b.cod_puesto "
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
DISPLAY "Buscando Informacion ... Espere Por Favor" AT 19,14
ATTRIBUTE (REVERSE,BOLD)
PREPARE comando FROM selec
DECLARE buscar CURSOR FOR comando
LET rcol ="C4"
LET xi = 7
CALL pru_new_dde(p_companias.rnc clipped,rcol,xi)
## SE BUSCA LA INFORMACION DE LOS CAMPOS DEL REGISTRO PARA DARLE
## SALIDA AL REPORTE
LET periodo = MONTH(fecha_formulario) USING "&&",YEAR(fecha_formulario)
LET rcol ="C4"
LET xi = 8
CALL pru_new_dde(periodo,rcol,xi)
LET rcol = "C4"
LET xi = 9
CALL pru_new_dde(tipo_reporte,rcol,xi)
DISPLAY "EN PROCESO"
LET cnt = 14
FOREACH buscar INTO registro.*
IF tipo_Reporte = 'DGT3' THEN
LET registro.novedad = 'Ingreso'
END IF
LET fecha_entrada = registro.fech_efec # ES PARA TENER LA FECHA EN UNA VRIABLE UNICA,
# ESTO VA A SERVIR PARA CALCULAR LOS ANOS DEL
# EMPLEADO.
LET tmpfecha = registro.fech_efec
LET tmpfecha[7,10] = year (fecha_formulario) using "&&&&"
LET fecha_c = tmpfecha
# IF tipo_reporte = 'DGT3' THEN
CALL fechaV()
LET l_f_ini = tmpfecha
LET l_f_fin = fecha_c
# IF year(l_f_ini) = year(fecha2) THEN
DISPLAY "DATA: ",registro.nom1_emp
OUTPUT TO REPORT planilla(registro.*,l_f_ini,l_f_fin,m_cedula)
# END IF
# END IF
END FOREACH
FINISH REPORT planilla
CALL ui.Interface.frontCall("WINDDE","DDEFinishAll", [], [res] );
END FUNCTION
## DEFINICION DEL REGISTRO DE IMPRESION CON LOS CAMPOS NECESARIOS PARA
## EL REPORTE
# REPORT planilla(x,p_fech_ini,p_fech_fin,p_cedula)
REPORT planilla(x,fecha_ini_v,fecha_fin_v,p_cedula)
DEFINE x RECORD
nomina LIKE adtb00003.nomina,
num_emp LIKE adtb00003.num_emp,
departamento LIKE adtb00003.departamento,
nivel_emp LIKE adtb00003.nivel_emp,
cod_puesto LIKE adtb00003.cod_puesto,
nom1_emp CHAR(20),
nom2_emp CHAR(20),
apell1_emp CHAR(20),
apell2_emp CHAR(20),
cedula LIKE adtb00003.cedula,
serie LIKE adtb00003.serie,
fech_nac LIKE adtb00003.fech_nac,
fech_efec LIKE adtb00003.fech_efec,
sexo LIKE adtb00021.sexo,
nacionalidad CHAR(10),
nom_puesto LIKE adtb00004.otra_descripcion,
sueldo_ac LIKE adtb00003.sueldo_ac,
numero_tss LIKE adtb00003.cod_seg1,
turno LIKE adtb00003.licencia,
sucid LIKE adtb00003.sucid,
puesto_real LIKE adtb00004.nom_puesto,
novedad VARCHAR(20),
fecha_salida DATE,
desc_puesto VARCHAR(150),
educacion VARCHAR(100),
fecha_cambio DATE
END RECORD,
fecha_1 CHAR(8),
fecha_ini_vac,fecha_fin_vac,fecha_sal,fecha_c CHAR(8)
DEFINE p_fech_ini,p_fech_fin CHAR(8),
p_f_ini,p_f_fin CHAR(8),
p_cedula CHAR(12),
xnumero_tss CHAR(25),
fecha_ini_v,fecha_fin_v DATE,
xsucid VARCHAR(3)
## DEFINICION DE LAS VARIABLES DE IMPRESION
DEFINE nombre_mes CHAR(15)
DEFINE l smallint
DEFINE normal CHAR(2),
nombres CHAR(60)
OUTPUT
## DEFINICION DE LOS MARGENES DE IMPRESION
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 3
FORMAT
ON EVERY ROW
LET fecha_ini_vac = fecha_ini_v USING "DDMMYYYY"
LET fecha_fin_vac = fecha_fin_v USING "DDMMYYYY"
LET fecha_1 = x.fech_efec USING "ddmmyyyy"
LET p_f_ini = x.fech_nac USING "ddmmyyyy"
LET fecha_sal = x.fecha_salida USING "ddmmyyyy"
LET fecha_c = x.fecha_cambio USING "ddmmyyyy"
LET xsucid = x.sucid USING "&&&"
LET rcol = "C2"
LET xi = cnt
CALL pru_new_dde(x.novedad,rcol,xi)
LET rcol = "C4"
LET xi = cnt
CALL pru_new_dde("C",rcol,xi)
LET rcol = "C5"
LET xi = cnt
CALL pru_new_dde(x.cedula,rcol,xi)
LET nombres = x.nom1_emp CLIPPED," ",x.nom2_emp CLIPPED
LET rcol = "C6"
LET xi = cnt
CALL pru_new_dde(nombres,rcol,xi)
LET rcol = "C7"
LET xi = cnt
CALL pru_new_dde(x.apell1_emp,rcol,xi)
LET rcol = "C8"
LET xi = cnt
CALL pru_new_dde(x.apell2_emp,rcol,xi)
LET rcol = "C9"
LET xi = cnt
CALL pru_new_dde(x.sexo,rcol,xi)
LET rcol = "C10"
LET xi = cnt
CALL pru_new_dde(x.nacionalidad,rcol,xi)
LET rcol = "C11"
LET xi = cnt
CALL pru_new_dde(p_f_ini,rcol,xi)
LET rcol = "C12"
LET xi = cnt
CALL pru_new_dde(x.sueldo_ac,rcol,xi)
IF x.novedad <> 'Salida' THEN
LET rcol = "C13"
LET xi = cnt
CALL pru_new_dde(fecha_1,rcol,xi)
END IF
IF x.novedad = 'Salida' THEN
LET rcol = "C14"
LET xi = cnt
CALL pru_new_dde(fecha_sal,rcol,xi)
END IF
LET rcol = "C15"
LET xi = cnt
CALL pru_new_dde(x.nom_puesto,rcol,xi)
LET rcol = "C16"
LET xi = cnt
CALL pru_new_dde(x.puesto_real,rcol,xi)
LET rcol = "C17"
LET xi = cnt
CALL pru_new_dde(fecha_ini_vac,rcol,xi)
LET rcol = "C18"
LET xi = cnt
CALL pru_new_dde(fecha_fin_vac,rcol,xi)
# AQUI SOLO SE ACTUALIZA SI EL FORMULARIO ES DGT-4
LET rcol = "C19"
LET xi = cnt
CALL pru_new_dde(x.turno,rcol,xi)
LET rcol = "C20"
LET xi = cnt
CALL pru_new_dde(xsucid,rcol,xi)
IF tipo_reporte = 'DGT4' THEN
LET rcol = "C21"
LET xi = cnt
CALL pru_new_dde(fecha_c,rcol,xi)
END IF
LET rcol = "C32"
LET xi = cnt
CALL pru_new_dde(x.educacion,rcol,xi)
LET rcol = "C33"
LET xi = cnt
CALL pru_new_dde('Ninguna-4714',rcol,xi)
LET cnt = cnt + 1
END REPORT
FUNCTION fechaV()
DEFINE dias_lab SMALLINT
LET dias_lab = 0
WHILE dias_lab < 15
SELECT a.dias FROM notb00012 a
WHERE a.dias = day(fecha_c) AND a.cod_mes = MONTH(fecha_c)
IF STATUS = NOTFOUND THEN
IF WEEKDAY(fecha_c) <> 0 THEN
LET dias_lab = dias_lab + 1
END IF
END IF
LET fecha_c = fecha_c + 1
IF dias_lab > 13 THEN
EXIT WHILE
END IF
END WHILE
END FUNCTION
FUNCTION pru_new_dde(xval,xcol,i)
DEFINE celda,rval,xval,xcol STRING
DEFINE i INTEGER
LET celda = fila_excel,i USING "<<<<&",xcol CLIPPED
LET rval = xval
#CALL fgl_winmessage("PROGRAMA",prog,"stop")
#CALL fgl_winmessage("FILE",arch_pc,"stop")
# CALL fgl_winmessage("CELDA",celda,"stop")
# CALL fgl_winmessage("rVAL",rval,"stop")
CALL ui.Interface.frontCall("WINDDE","DDEPoke", [prog,arch_pc,celda,rval], [p_res] )
#CALL fgl_winmessage("P_RES",p_res,"stop")
CALL chqDdeError(p_res,"DDEPoke "||celda)
{
MESSAGE "Salvando la planilla ",file CLIPPED," !"
CALL ui.Interface.refresh()
LET p_cmd="[save()]"
CALL ui.Interface.frontCall("WINDDE","DDEExecute", [prog,file,p_cmd], [p_res] )
IF p_res THEN
CALL fgl_winmessage("Planilla salvada", "Nombre = "||file, "information")
ELSE
CALL chqDdeError(p_res,"DDEExecute save")
END IF
CAL ui.Interface.frontCall("WINDDE","DDEFinish", [prog,file], [p_res] )
CALL chqDdeError(p_res,"DDEFinish")
CALL ui.Interface.frontCall("WINDDE","DDEFinishAll", [], [p_res] )
CALL chqDdeError(p_res,"DDEFinishAll")
}
END FUNCTION
FUNCTION chqDdeError(p_res,p_msg)
DEFINE p_res INTEGER,
p_msg STRING,
m_err STRING,
m_log STRING
IF p_res THEN
RETURN
END IF
CALL ui.Interface.frontCall("WINDDE","DDEError",[],[m_err])
CALL ui.Interface.frontCall("WINDDE","DDEFinishAll", [], [p_res] )
LET m_log="DDE Error: ",m_err CLIPPED," (",p_msg,")"
#CALL errorlog(m_log)
LET m_log="Se ha producido un Error en '",p_msg CLIPPED,"'. Para mas detalle revise el LOG de errores."
CALL fgl_winmessage("DDE Error", m_log, "stop")
EXIT PROGRAM
END FUNCTION