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

314 lines
8.6 KiB
Plaintext

{
-----------------------------------------------------------------------------
PROGRAMA : CPPRCS004
OBJETIVO : Mantenimiento de Factura Proveedor
REALIZADO POR : Juan F. Soto
FECHA : Enero 17, 1996
-----------------------------------------------------------------------------
}
GLOBALS "cpprgb000.4gl"
DEFINE hoy,fecha1,fecha2 DATE
DEFINE debe_ir CHAR(1)
DEFINE cuenta CHAR(8)
DEFINE total1,valor_cxp,valor,valor_f DECIMAL(12,2)
DEFINE cat,dpto,refe,tiene_cta,chequea,ctrl_cxp CHAR(1)
DEFINE ctrl_reg,orden_ant,aplicar INTEGER
DEFINE niv,cod1_sp,cod1_sp_sec SMALLINT
DEFINE idx2,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,
cod_sp_sec 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,
cod_sp_sec SMALLINT,
nom_sp CHAR(30)
END RECORD
DEFINE cuentas ARRAY[200] OF RECORD
cuenta_no CHAR(8),
departamento SMALLINT,
cod_aux SMALLINT,
sec_aux SMALLINT,
num_doc CHAR(10),
debito DECIMAL(12,2),
credito DECIMAL(12,2)
END RECORD
DEFINE descripcion CHAR(30)
DEFINE arrfac1 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 arrfac 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_fac1 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 j RECORD
cod_sp SMALLINT,
cod_sp_sec SMALLINT,
nom_sup CHAR(30),
num_doc CHAR(10),
valor_fac DECIMAL(12,2),
detalle CHAR(30),
tipo CHAR(1),
aplica_a CHAR(10),
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 ordenes ARRAY[200] OF RECORD
orden_no LIKE cptb00001.orden_no,
tipo LIKE cptb00001.tipo
END RECORD
DEFINE i INTEGER
FUNCTION cpprcs004()
OPTIONS
FORM LINE 8,
ERROR LINE 24,
COMMENT LINE 22,
PROMPT LINE 23
CALL pantalla()
OPEN FORM cpfmmt001 FROM "cpfmmt001"
DISPLAY FORM cpfmmt001
DISPLAY "cpprcs004" AT 4,3
DISPLAY "Consulta de Facturas" AT 6,29
MENU "OPCION"
COMMAND "Consultar"
"<Esc> Busca Registro <Delete> Cancela Operacion"
CALL cppcsd004()
COMMAND "Salir"
EXIT MENU
END MENU
END FUNCTION
####### Proceso para Insertar Una Factura ###########
FUNCTION cppcsd004()
DEFINE porc_p DECIMAL(10,2)
DEFINE emp SMALLINT
LET hoy = null
CONSTRUCT BY NAME criterio ON a.num_doc,cod_sp,cod_sp_sec,a.fecha_orig
##### 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
LET selec =
"SELECT a.cod_sp,a.cod_sp_sec,a.num_doc,a.fecha_orig,a.fecha_proc,",
"a.valor,a.detalle ",
"FROM cptb00001 a WHERE ",criterio clipped," AND a.tipo_doc = 'FT' ",
" AND a.status_t is null"
PREPARE comando FROM selec
DECLARE busca SCROLL CURSOR FOR comando
OPEN busca
FETCH FIRST busca INTO factura.*
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
CALL buscame()
MENU "OPCION"
COMMAND "Siguiente" "Busca El Siguiente Registro"
FETCH NEXT busca INTO factura.*
IF status = notfound THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL buscame()
COMMAND "Anterior" "Busca El Registro Anterior"
FETCH PREVIOUS busca INTO factura.*
IF status = notfound THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL buscame()
COMMAND "Primero" "Busca El Primier Registro "
FETCH FIRST busca INTO factura.*
IF status = notfound THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL buscame()
COMMAND "Ultimo" "Busca El Ultimo Registro "
FETCH LAST busca INTO factura.*
IF status = notfound THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL buscame()
COMMAND "Ver" "Busca Las Cuentas Que Tiene Las Facturas"
CALL contab1()
IF int_flag THEN
LET int_flag = false
RETURN
END IF
DECLARE buscar CURSOR FOR
SELECT UNIQUE "N",a.num_doc,a.tipo_doc,SUM(a.valor *-1)
FROM cptb00001 a
WHERE a.cod_sp = factura.cod_sp AND
a.cod_sp_sec = factura.cod_sp_sec AND
(a.aplica_a is null OR a.aplica_a =a.num_doc) AND
a.tipo_doc IN ("CP","ND") AND
a.status_t IS NULL
GROUP BY 1,2,3
ORDER BY 2
LET idx = 1
LET idx1 = 1
FOREACH buscar INTO arrfac[idx].*
SELECT SUM(a.valor) INTO valor1 FROM cptb00001 a
WHERE a.cod_sp = factura.cod_sp AND a.cod_sp_sec = factura.cod_sp_sec
AND a.aplica_a IS NOT NULL AND a.num_doc = arrfac[idx].aplica_a AND
a.tipo_doc in ("CP","ND") AND a.status_t IS NULL
IF valor1 IS NULL THEN
LET valor1 = 0
END IF
LET arrfac[idx].valor_prep = arrfac[idx].valor_prep + valor1
LET arrfac[idx].valor = arrfac[idx].valor_prep
IF arrfac[idx].valor > 0 THEN
LET arr_fac1[idx1].tipo = "N"
LET arr_fac1[idx1].aplica_a = arrfac[idx].aplica_a
LET arr_fac1[idx1].tipo_doc = arrfac[idx].tipo_doc
LET arr_fac1[idx1].valor_prep = arrfac[idx].valor_prep
LET arr_fac1[idx1].valor = arrfac[idx].valor
LET idx1 = idx1 + 1
END IF
LET idx = idx + 1
END FOREACH
CALL SET_COUNT(idx1 - 1)
DISPLAY ARRAY arr_fac1 TO factura1.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
COMMAND "Retornar" "Vuelve al menu anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION contab1()
LET int_flag = FALSE
OPEN WINDOW cpfmwd007 AT 10,3 WITH FORM "cpfmwd007"
ATTRIBUTE(BORDER,FORM LINE FIRST + 2,COMMENT LINE LAST)
DECLARE busca_ctas CURSOR FOR
SELECT a.cuenta_no,a.departamento,a.cod_aux,a.cod_sec,a.num_doc,
a.debito,a.credito
FROM cptb00003 a
WHERE a.status_t IS NULL AND a.cod_sp = factura.cod_sp AND
a.cod_sp_sec = factura.cod_sp_sec AND a.factura = factura.num_doc AND
a.cuenta_no NOT IN ("2115","2117","2119")
LET idx2 = 1
FOREACH busca_ctas INTO cuentas[idx2].*
LET idx2 = idx2 + 1
END FOREACH
CALL SET_COUNT(idx2 - 1)
LET int_flag = FALSE
DISPLAY ARRAY cuentas TO cuentas1.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
CLOSE WINDOW cpfmwd007
RETURN
END IF
CLOSE WINDOW cpfmwd007
END FUNCTION
FUNCTION buscame()
SELECT a.nom_sp INTO nom_sup
FROM cotb00001 a
WHERE a.cod_sp = factura.cod_sp and
a.cod_sp_sec = factura.cod_sp_Sec
DISPLAY BY NAME factura.*,nom_sup
END FUNCTION