Files
MBS/PROYECTO/cpdir/cpprmt003.4gl
T

525 lines
15 KiB
Plaintext

{
-----------------------------------------------------------------------------
PROGRAMA : CPPRMT003
OBJETIVO : Mantenimiento de Cuenta Por Pagar Empleado
REALIZADO POR : Tadeo A. Ferreras
FECHA : Junio 17, 1993
-----------------------------------------------------------------------------
}
GLOBALS "cpprgb000.4gl"
DEFINE cod1_sp,cod1_sp_sec SMALLINT
DEFINE p_orden INTEGER
DEFINE pbase,flete,gasto,pvalor,tvalor DECIMAL(16,2)
DEFINE val_pen,valor_fac1,valor2 DECIMAL(13,2)
DEFINE nom_tipo CHAR(15)
DEFINE idx1 SMALLINT
DEFINE nombre,apellido CHAR(14)
DEFINE tipo_emp CHAR(1)
DEFINE buscar_oc RECORD
orden_no INTEGER,
fecha_orig DATE,
cod_sp SMALLINT,
num_emp SMALLINT,
nom_sup CHAR(30)
END RECORD
DEFINE cod_sp1,cod_sp2 SMALLINT
DEFINE total_v DECIMAL(12,2)
DEFINE valor3 DECIMAL(12,2)
DEFINE datos_usu RECORD
status_t CHAR(1),
us_crea CHAR(9),
fech_crea LIKE cptb00001.fech_crea,
us_mod CHAR(9),
fech_mod LIKE cptb00001.fech_mod
END RECORD
DEFINE supl ARRAY[200] OF RECORD
cod_sp SMALLINT,
num_emp SMALLINT,
nom_sp CHAR(30)
END RECORD
DEFINE factura1 RECORD
num_emp SMALLINT,
departamento SMALLINT,
nivel_emp SMALLINT,
cod_puesto SMALLINT,
nombre CHAR(15),
apellido CHAR(15),
num_doc CHAR(10),
fecha_orig DATE,
valor_fac DECIMAL(12,2)
END RECORD
DEFINE arr_cta1 ARRAY[200] OF RECORD
tipo CHAR(1),
aplica_a CHAR(10),
tipo_doc CHAR(2),
valor_prep DECIMAL(12,2),
valor DECIMAL(12,2)
END RECORD
DEFINE arr_cta ARRAY[200] OF RECORD
cuenta_no CHAR(8),
descripcion CHAR(30),
valor_cta DECIMAL(12,2)
END RECORD
DEFINE compra ARRAY[300] OF RECORD
codigo CHAR(10),
descripcion CHAR(30),
cantidad DECIMAL(12,2),
precio DECIMAL(12,2),
valor DECIMAL(12,2)
END RECORD
DEFINE arr_tipo ARRAY[300] OF RECORD
tipo CHAR(2),
num_oc INTEGER,
fech_oc DATE
END RECORD
DEFINE proceso RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
cantidad DECIMAL(12,2),
precio DECIMAL(12,2)
END RECORD
DEFINE i,j INTEGER
FUNCTION cpprmt003()
OPTIONS
FORM LINE 8,
ERROR LINE 24,
COMMENT LINE 22,
PROMPT LINE 23
CALL pantalla()
OPEN FORM cpfmmt003 FROM "cpfmmt003"
DISPLAY FORM cpfmmt003
DISPLAY "cpprmt003" AT 4,3
DISPLAY "Cuentas Por Pagar Empleados" AT 6,26
MENU "OPCION"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
CALL cppcad003()
COMMAND "Consultar-modificar"
"<Esc> Busca Registro <Supr> Cancela Operacion"
CALL cppcmd003()
COMMAND "Salir"
EXIT MENU
END MENU
END FUNCTION
####### Proceso para Insertar Una Factura ###########
FUNCTION cppcad003()
DEFINE porc_p DECIMAL(10,2)
DEFINE emp SMALLINT
DEFINE hoy,fecha1,fecha2 DATE
LET hoy = null
INPUT BY NAME factura1.* WITHOUT DEFAULTS
AFTER FIELD num_emp
IF factura1.num_emp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_emp
END IF
SELECT a.departamento,a.nivel_emp,a.cod_puesto,a.nom1_emp,a.apell1_emp
INTO factura1.departamento,factura1.nivel_emp,factura1.cod_puesto,
factura1.nombre,factura1.apellido
FROM adtb00003 a
WHERE a.num_emp = factura1.num_emp AND a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
DISPLAY BY NAME factura1.departamento THRU factura1.apellido
AFTER FIELD num_doc #### Numero del documento o factura1
IF factura1.num_doc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
SELECT UNIQUE a.num_nomi
FROM notb00008 a
WHERE a.num_emp = factura1.num_emp AND
a.tipo_emp = "P" AND
a.num_nomi = factura1.num_doc
##### Proceso para evitar se digite el mismo numero de factura1
##### Para el mismo suplidor
IF status != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
AFTER FIELD fecha_orig
IF factura1.fecha_orig IS NULL OR factura1.fecha_orig > TODAY THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_orig
END IF
LET p_fechas = factura1.fecha_orig
CALL prd()
IF bandera = 1 THEN
LET bandera = 0
NEXT FIELD fecha_orig
END IF
AFTER FIELD valor_fac
IF factura1.valor_fac IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD valor_fac
END IF
END INPUT
##### Proceso Para abortar OPERACION ######
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
INPUT ARRAY arr_cta FROM cuentas.*
BEFORE ROW
LET curr = arr_curr()
LET fila = scr_line()
AFTER FIELD cuenta_no
IF arr_cta[curr].cuenta_no IS NOT NULL THEN
SELECT a.descripcion INTO arr_cta[curr].descripcion
FROM cgtb00001 a
WHERE a.cuenta_no = arr_cta[curr].cuenta_no AND a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
END IF
DISPLAY arr_cta[curr].descripcion TO cuentas[fila].descripcion
AFTER FIELD valor_cta ##### Valor del documento o factura1
IF arr_cta[curr].valor_cta IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD valor_cta
END IF
LET valor1 = 0
FOR i = 1 TO ARR_CURR()
LET valor1 = valor1 + arr_cta[i].valor_cta
END FOR
DISPLAY BY NAME valor1
IF valor1 > factura1.valor_fac THEN
LET numero_msg = 204
CALL msg(numero_msg)
NEXT FIELD valor_cta
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
###### Insertando registros en la Maestra de cuentas por Pagar ####
{INSERT INTO notb00008 values (factura1.num_doc,"P",factura1.num_emp,
factura1.departamento,factura1.nivel_emp,factura.cod_puesto,
factura1.fecha_orig,93,null,factura1.valor_fac,"D",null,user,current,
null,null)
INSERT INTO notb00008 values (factura1.num_emp,factura1.departamento,
factura1.nivel_emp,factura.cod_puesto,factura1.num_doc,
93,factura1.fecha_orig,factura1.valor_fac,null,null,user,current,
null,null)
}
FOR idx = 1 to ARR_COUNT()
IF arr_cta[idx].cuenta_no IS NOT NULL AND arr_cta[idx].valor_cta > 0 THEN
INSERT INTO cptb00002 values (11,factura1.num_emp,arr_cta[idx].cuenta_no,
factura1.num_doc,factura1.fecha_orig,
arr_cta[idx].valor_cta,null,user,current,
null,null)
END IF
END FOR
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
END FUNCTION
###### Proceso de Modificacion de registros
FUNCTION cppcmd003()
##### Criterio de Busqueda de informacion a consultar y/o modificar
CONSTRUCT CRITERIO ON b.cod_sp_sec,b.num_doc,b.fecha
FROM num_emp,num_doc,fecha_orig
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
##### Busquedas de los datos generales
LET selec =
"SELECT UNIQUE b.cod_sp_sec,a.departamento,a.nivel_emp,a.cod_puesto, ",
" a.nom1_emp,a.apell1_emp,b.num_doc,b.fecha,SUM(b.valor) ",
"FROM cptb00002 b,adtb00003 a ",
"WHERE b.status_t is null AND b.cod_sp_sec = a.num_emp AND ",
" b.cod_sp = 11 AND ",criterio clipped,
" GROUP BY 1,2,3,4,5,6,7,8 ORDER BY 1,7"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
#### Buscando el primer registro
FETCH FIRST datos INTO factura1.*
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
DISPLAY BY NAME factura1.*
MENU "OPCION"
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO factura1.*,datos_usu.*
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME factura1.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO factura1.*,datos_usu.*
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME factura1.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO factura1.*,datos_usu.*
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME factura1.*
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO factura1.*,datos_usu.*
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME factura1.*
###### Escoger registro para modificar
COMMAND "Escoger"
"<Esc> Actualiza Registro <Supr> Cancela Operacion"
LET p_fechas = factura1.fecha_orig
CALL prd()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
INPUT BY NAME factura1.fecha_orig,factura1.valor_fac WITHOUT DEFAULTS
AFTER FIELD fecha_orig
IF factura1.fecha_orig IS NULL OR factura1.fecha_orig > TODAY THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_orig
END IF
LET p_fechas = factura1.fecha_orig
CALL prd()
IF bandera = 1 THEN
LET bandera = 0
NEXT FIELD fecha_orig
END IF
AFTER FIELD valor_fac
IF factura1.valor_fac IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD valor_fac
END IF
END INPUT
##### Proceso Para abortar OPERACION ######
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
DECLARE buscar1 CURSOR FOR
SELECT a.cuenta_no,b.descripcion,a.valor FROM cptb00002 a,cgtb00001 b
WHERE a.cuenta_no = b.cuenta_no AND b.status_t IS NULL AND
a.status_t IS NULL AND a.num_doc = factura1.num_doc AND
a.cod_sp_sec = factura1.num_emp AND a.cod_sp = 11
LET idx = 1
LET valor1 = 0
FOREACH buscar1 INTO arr_cta[idx].*
LET valor1 = valor1 + arr_cta[idx].valor_cta
LET idx = idx + 1
END FOREACH
CALL set_count(idx - 1)
INPUT ARRAY arr_cta WITHOUT DEFAULTS FROM cuentas.*
BEFORE ROW
LET curr = arr_curr()
LET fila = scr_line()
AFTER FIELD cuenta_no
IF arr_cta[curr].cuenta_no IS NOT NULL THEN
SELECT a.descripcion INTO arr_cta[curr].descripcion
FROM cgtb00001 a
WHERE a.cuenta_no = arr_cta[curr].cuenta_no AND
a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
END IF
DISPLAY arr_cta[curr].descripcion TO cuentas[fila].descripcion
AFTER FIELD valor_cta ##### Valor del documento o factura1
IF arr_cta[curr].valor_cta IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD valor_cta
END IF
LET valor1 = 0
FOR i = 1 TO arr_count()
LET valor1 = valor1 + arr_cta[i].valor_cta
END FOR
DISPLAY BY NAME valor1
IF valor1 > factura1.valor_fac THEN
LET numero_msg = 204
CALL msg(numero_msg)
NEXT FIELD valor_cta
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
###### Insertando registros en la Maestra de cuentas por Pagar ####
DELETE FROM cptb00002
WHERE @num_doc = factura1.num_doc AND
@cod_sp = 11 AND
@cod_sp_sec = factura1.num_emp
{UPDATE notb00008 set (fecha,valor,us_mod,fech_mod) =
(factura1.fecha_orig,factura1.valor_fac,
USER,CURRENT)
WHERE @num_nomi = factura1.num_doc AND
@num_emp = factura1.num_emp AND
@tipo_emp = "P"
UPDATE notb00011 set (fecha,monto,us_mod,fech_mod) =
(factura1.fecha_orig,factura1.valor_fac,
USER,CURRENT)
WHERE @num_doc = factura1.num_doc AND
@num_emp = factura1.num_emp}
FOR idx = 1 to ARR_COUNT()
IF arr_cta[idx].cuenta_no IS NOT NULL AND
arr_cta[idx].valor_cta > 0 THEN
INSERT INTO cptb00002 values (11,factura1.num_emp,arr_cta[idx].cuenta_no,
factura1.num_doc,factura1.fecha_orig,arr_cta[idx].valor_cta,null,
user,current,null,null)
END IF
END FOR
LET numero_msg = 13
CALL msg(numero_msg)
##### Proceso Para Anular una Factura
COMMAND KEY ("L") "eLiminar"
DELETE FROM cptb00002
WHERE cod_sp = 11 AND
cod_sp_sec = factura1.num_emp AND
num_doc = factura1.num_doc
LET numero_msg = 82
CALL msg(numero_msg)
COMMAND "Retornar"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION