Files
MBS/PROYECTO/ccdir/ccprmt004.4gl
T

1022 lines
32 KiB
Plaintext

{
-----------------------------------------------------------------------------
PROGRAMA : CCPRMT004
OBJETIVO : Aplicacion de Notas de Creditos (DE).
REALIZADO POR : Tadeo A. Ferreras
FECHA : Enero 26, 1993
-----------------------------------------------------------------------------
}
GLOBALS "ccprgb000.4gl"
DEFINE valor_cheque1,p_num_doc,aplicar INTEGER
DEFINE valor_nc,nc_pend,valor_ctrl,p_total,val_pen,valor2 DECIMAL(12,2)
DEFINE fecha1 DATE
DEFINE nombre_cta CHAR(30)
DEFINE tipo_doc1 CHAR(2)
DEFINE opc CHAR(1)
####### Funcion para agregar un recibo de pago
FUNCTION ccprmt004()
OPTIONS
FORM LINE 8,
ERROR LINE 24,
COMMENT LINE 22,
PROMPT LINE 23
CALL pantalla()
OPEN FORM ccfmmt004 FROM "ccfmmt004"
DISPLAY FORM ccfmmt004
DISPLAY "ccprmt004" AT 4,3
DISPLAY "Aplicacion de Nota de Credito (DE)" AT 6,23
MENU "OPCION"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Delete> Cancela Operacion"
CALL ccpcad004()
COMMAND "Consultar-modificar"
"<Esc> Busca Registro <Delete> Cancela Operacion"
CALL ccpcmf004()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ccpcad004()
DEFINE porc_p DECIMAL(10,2)
DEFINE emp SMALLINT
DEFINE hoy DATE
LET hoy = null
LABEL volver:
LET recibo.fecha_orig = fecha1
LET valor_ctrl = NULL
INPUT BY NAME recibo.*,valor_ctrl WITHOUT DEFAULTS
## VENTANAS PARA BUSCAR LOS CLIENTES Y LOS EMPLEADOS
ON KEY (CONTROL-W)
CASE
WHEN INFIELD(tipo_cliente)
CALL consulta_cliente4s()
LET recibo.tipo_cliente = cliente_dir.tipo_cliente
LET recibo.sec_cliente = cliente_dir.sec_cliente
SELECT a.nombre INTO nom_cli FROM vetb00004 a
WHERE a.tipo_cliente = recibo.tipo_cliente and
a.sec_cliente = recibo.sec_cliente
DISPLAY BY NAME recibo.tipo_cliente ATTRIBUTE (BOLD)
DISPLAY BY NAME recibo.sec_cliente ATTRIBUTE(BOLD)
DISPLAY BY NAME nom_cli ATTRIBUTE (BOLD)
NEXT FIELD cod_emp_sec
WHEN INFIELD(sec_cliente)
CALL consulta_cliente4s()
LET recibo.tipo_cliente = cliente_dir.tipo_cliente
LET recibo.sec_cliente = cliente_dir.sec_cliente
SELECT nombre INTO nom_cli FROM vetb00004
WHERE tipo_cliente=recibo.tipo_cliente and sec_cliente=recibo.sec_cliente
DISPLAY BY NAME recibo.tipo_cliente ATTRIBUTE (BOLD)
DISPLAY BY NAME recibo.sec_cliente ATTRIBUTE(BOLD)
DISPLAY BY NAME nom_cli ATTRIBUTE (BOLD)
NEXT FIELD cod_emp_sec
WHEN INFIELD(cod_emp_sec)
CALL cons_emp4()
LET recibo.cod_emp_sec = transportista.sec_transp
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3 FROM adtb00003
WHERE num_emp = recibo.cod_emp_sec
DISPLAY BY NAME recibo.cod_emp_sec ATTRIBUTE (BOLD)
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
DISPLAY BY NAME nombre_emp ATTRIBUTE (BOLD)
NEXT FIELD fecha_orig
END CASE
## AQUI SE PREPARA PARA LA CAPTURA DE INFORMACION
BEFORE FIELD tipo_doc
LET recibo.tipo_doc = "AV"
AFTER FIELD tipo_doc
IF recibo.tipo_doc IS NULL OR recibo.tipo_doc != "AV" THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo_doc
END IF
CASE
WHEN recibo.tipo_doc = "AV"
LET nombre_tipo = "NOTA DE CREDITO"
EXIT CASE
END CASE
DISPLAY BY NAME nombre_tipo ATTRIBUTE (BOLD)
AFTER FIELD cuenta_no
IF recibo.cuenta_no is not null THEN
SELECT descripcion INTO nombre_cta FROM cgtb00001
WHERE cuenta_no = recibo.cuenta_no and status_t is null
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
DISPLAY BY NAME nombre_cta ATTRIBUTE (blue)
END IF
## CHEQUEA QUE EL REGISTRO NO SE REPITA
AFTER FIELD num_doc
IF recibo.num_doc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
SELECT UNIQUE a.tipo_cliente,a.sec_cliente,a.cod_emp_sec
INTO recibo.tipo_cliente,recibo.sec_cliente,recibo.cod_emp_sec
FROM cctb00001 a
WHERE a.tipo_doc = "AV" and a.num_doc = recibo.num_doc
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD tipo_doc
END IF
SELECT b.nombre INTO nom_cli FROM vetb00004 b
WHERE b.tipo_cliente = recibo.tipo_cliente and
b.sec_cliente = recibo.sec_cliente and b.status_t is null
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3 FROM adtb00003
WHERE num_emp = recibo.cod_emp_sec
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
DISPLAY BY NAME recibo.tipo_cliente,recibo.sec_cliente,recibo.cod_emp_sec,
nom_cli,nombre_emp
## CHEQUE QUE EL EMPLEADO EXISTA, SI EXISTE DESPLEGA SU NOMBRE
AFTER FIELD fecha_orig
IF recibo.fecha_orig IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_orig
END IF
LET p_fechas = recibo.fecha_orig
CALL prd()
IF bandera = 1 THEN
LET bandera = 0
NEXT FIELD fecha_orig
END IF
LET fecha1 = recibo.fecha_orig
BEFORE FIELD valor_ctrl
LET valor_ctrl = null
DISPLAY BY NAME valor_ctrl
AFTER FIELD valor_ctrl
IF valor_ctrl IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD valor_ctrl
END IF
EXIT INPUT
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
FOR idx = 1 TO 20
LET arr_recibo4[idx].aplica_a = NULL
LET arr_recibo4[idx].valor_pen = NULL
LET arr_recibo4[idx].desc_p = NULL
LET arr_recibo4[idx].valor_pag = NULL
END FOR
LABEL arreglo1:
## AQUI SE INTRODUCEN LOS DATOS DEL ARREGLO
INPUT ARRAY arr_recibo4 WITHOUT DEFAULTS FROM s_recibo4.*
## VENTANA PARA BUSCAR LOS DOCUMENTOS
ON KEY (CONTROL-W)
CASE
WHEN INFIELD (aplica_a)
CALL busca_apl4()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
NEXT FIELD aplica_a
END IF
IF existe = "N" THEN
LET existe = "S"
NEXT FIELD aplica_a
END IF
DISPLAY arr_recibo4[curr].aplica_a to s_recibo4[scr_l].aplica_a
DISPLAY arr_recibo4[curr].valor_pen to s_recibo4[scr_l].valor_pen
LET bandera = 0
CALL repetir4()
IF bandera = 1 THEN
NEXT FIELD aplica_a
END IF
NEXT FIELD desc_p
END CASE
BEFORE ROW
LET curr = arr_curr()
LET scr_l = scr_line()
AFTER FIELD aplica_a
IF arr_recibo4[curr].aplica_a IS NOT NULL THEN
LET bandera = 0
CALL repetir4()
IF bandera = 1 THEN
NEXT FIELD aplica_a
END IF
IF arr_recibo4[curr].aplica_a = recibo.num_doc THEN
LET numero_msg = 131
CALL msg(numero_msg)
# NEXT FIELD aplica_a
END IF
# Controla que la factura pertenezca al cliente
# IF arr_recibo4[curr].aplica_a != 999999 THEN
SELECT unique tipo_cliente FROM cctb00001
WHERE num_doc = arr_recibo4[curr].aplica_a and
tipo_cliente = recibo.tipo_cliente and
sec_cliente = recibo.sec_cliente and
num_doc = aplica_a and status_t is null
IF status = notfound THEN
LET numero_msg = 126
CALL msg(numero_msg)
NEXT FIELD aplica_a
END IF
# END IF
END IF
# Busca el valor pendiente de la factura
BEFORE FIELD desc_p
LET arr_recibo4[curr].desc_p = 0
LET arr_recibo4[curr].valor_pag = arr_recibo4[curr].valor_pen
DISPLAY arr_recibo4[curr].valor_pen to s_recibo4[scr_l].valor_pen
DISPLAY arr_recibo4[curr].desc_p to s_recibo4[scr_l].desc_p
AFTER FIELD desc_p
IF arr_recibo4[curr].desc_p is null THEN
LET arr_recibo4[curr].desc_p = 0
END IF
LET arr_recibo4[curr].valor_pag = arr_recibo4[curr].valor_pag -
arr_recibo4[curr].desc_p
DISPLAY arr_recibo4[curr].valor_pag to s_recibo4[scr_l].valor_pag
AFTER FIELD valor_pag
IF arr_recibo4[curr].aplica_a IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD aplica_a
END IF
IF arr_recibo4[curr].valor_pag IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD aplica_a
END IF
LET p_total = 0
FOR idx = 1 TO arr_count()
IF arr_recibo4[idx].valor_pag is not null THEN
LET p_total = p_total + arr_recibo4[idx].valor_pag
END IF
END FOR
IF p_total < 0 THEN
LET p_total = p_total * -1
END IF
DISPLAY BY NAME p_total ATTRIBUTE(BOLD)
IF p_total > valor_ctrl THEN
LET numero_msg = 178
CALL msg(numero_msg)
NEXT FIELD valor_pag
END IF
# Controla que el valor aplicado a las facturas no exceda el monto del recibo
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
IF p_total != valor_ctrl THEN
LET numero_msg = 178
CALL msg(numero_msg)
LET curr = 0
LET scr_l = 0
GOTO arreglo1
END IF
LET opc = NULL
LET valor_cheque1 = NULL
## SI NO OCURRE NINGUN ERROR SE PROCEDE A INSERTAR EL REGISTRO
FOR idx = 1 to arr_count()
IF arr_recibo4[idx].aplica_a is not null THEN
LET arr_recibo4[idx].valor_pag = arr_recibo4[idx].valor_pag * -1
LET arr_recibo4[idx].desc_p = arr_recibo4[idx].desc_p * -1
LET tipo_doc1 = "AV"
INSERT INTO cctb00001
VALUES (recibo.cuenta_no,null,tipo_doc1,recibo.num_doc,
recibo.tipo_cliente,recibo.sec_cliente,null,recibo.cod_emp_sec,
recibo.fecha_orig,null,arr_recibo4[idx].aplica_a,
recibo.deposito,recibo.num_doc,arr_recibo4[idx].valor_pag,null,
valor_cheque1,null,arr_recibo4[idx].desc_p,null,USER,CURRENT,
null,null)
END IF
END FOR
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 1
CALL msg(numero_msg)
LET emp = recibo.cod_emp_sec
CLEAR FORM
GOTO volver
END FUNCTION
## Funcion para consultar/modificar un recibo de pago
FUNCTION ccpcmf004()
DEFINE usuario RECORD
us_crea CHAR(9),
fech_crea LIKE cctb00001.fech_crea
END RECORD
## SE PREPARA EL CRITERIO PARA CONSULTAR/MODIFICAR UN REGISTRO
CONSTRUCT CRITERIO ON a.num_doc,a.tipo_cliente,a.sec_cliente,a.cod_emp_sec
FROM num_doc,tipo_cliente,sec_cliente,cod_emp_sec
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
LET selec =
"SELECT UNIQUE a.cuenta_no,a.banco,a.tipo_doc,a.num_doc,a.tipo_cliente, ",
" a.sec_cliente,a.cod_emp_sec,a.fecha_orig ",
"FROM cctb00001 a ",
"WHERE ",criterio clipped," AND a.valor < 0 AND a.num_doc != a.aplica_a AND",
" a.num_doc=a.num_cheque AND a.tipo_doc='DE' AND a.status_t is null ",
"ORDER BY 4"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO recibo.*
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
SELECT SUM(a.valor)*-1 INTO valor_ctrl FROM cctb00001 a
WHERE a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente AND
a.tipo_doc = "AV" AND a.num_doc != a.aplica_a AND
a.num_doc = a.num_cheque AND a.num_doc = recibo.num_doc AND
a.cod_emp_sec = recibo.cod_emp_sec AND a.status_t IS NULL
IF valor_ctrl IS NULL THEN
LET valor_ctrl = 0
END IF
SELECT nombre INTO nom_cli FROM vetb00004
WHERE tipo_cliente=recibo.tipo_cliente and sec_cliente=recibo.sec_cliente
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3 FROM adtb00003
WHERE num_emp = recibo.cod_emp_sec
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
SELECT descripcion INTO nombre_cta FROM cgtb00001
WHERE cuenta_no = recibo.cuenta_no
DISPLAY BY NAME recibo.*,nom_cli,nombre_emp,valor_ctrl,nombre_cta
LABEL vuelve:
MENU "OPCION"
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO recibo.*
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT SUM(a.valor)*-1 INTO valor_ctrl FROM cctb00001 a
WHERE a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente AND
a.tipo_doc = "AV" AND a.num_doc != a.aplica_a AND
a.num_doc = a.num_cheque AND a.num_doc = recibo.num_doc AND
a.cod_emp_sec = recibo.cod_emp_sec AND a.status_t IS NULL
IF valor_ctrl IS NULL THEN
LET valor_ctrl = 0
END IF
SELECT nombre INTO nom_cli FROM vetb00004
WHERE tipo_cliente = recibo.tipo_cliente and
sec_cliente = recibo.sec_cliente
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3 FROM adtb00003
WHERE num_emp = recibo.cod_emp_sec
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
DISPLAY BY NAME recibo.*,nom_cli,nombre_emp,valor_ctrl
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO recibo.*
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT SUM(a.valor)*-1 INTO valor_ctrl FROM cctb00001 a
WHERE a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente AND
a.tipo_doc = "AV" AND a.num_doc != a.aplica_a AND
a.num_doc = a.num_cheque AND a.num_doc = recibo.num_doc AND
a.cod_emp_sec = recibo.cod_emp_sec AND a.status_t IS NULL
IF valor_ctrl IS NULL THEN
LET valor_ctrl = 0
END IF
SELECT nombre INTO nom_cli FROM vetb00004
WHERE tipo_cliente = recibo.tipo_cliente and
sec_cliente = recibo.sec_cliente
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3 FROM adtb00003
WHERE num_emp = recibo.cod_emp_sec
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
DISPLAY BY NAME recibo.*,nom_cli,nombre_emp,valor_ctrl
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO recibo.*
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT SUM(a.valor)*-1 INTO valor_ctrl FROM cctb00001 a
WHERE a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente AND
a.tipo_doc = "AV" AND a.num_doc != a.aplica_a AND
a.num_doc = a.num_cheque AND a.num_doc = recibo.num_doc AND
a.cod_emp_sec = recibo.cod_emp_sec AND a.status_t IS NULL
IF valor_ctrl IS NULL THEN
LET valor_ctrl = 0
END IF
SELECT nombre INTO nom_cli FROM vetb00004
WHERE tipo_cliente = recibo.tipo_cliente and
sec_cliente = recibo.sec_cliente
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3 FROM adtb00003
WHERE num_emp = recibo.cod_emp_sec
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
DISPLAY BY NAME recibo.*,nom_cli,nombre_emp,valor_ctrl
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO recibo.*
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT SUM(a.valor)*-1 INTO valor_ctrl FROM cctb00001 a
WHERE a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente AND
a.tipo_doc = "AV" AND a.num_doc != a.aplica_a AND
a.num_doc = a.num_cheque AND a.num_doc = recibo.num_doc AND
a.cod_emp_sec = recibo.cod_emp_sec AND a.status_t IS NULL
IF valor_ctrl IS NULL THEN
LET valor_ctrl = 0
END IF
SELECT nombre INTO nom_cli FROM vetb00004
WHERE tipo_cliente = recibo.tipo_cliente and
sec_cliente = recibo.sec_cliente
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3 FROM adtb00003
WHERE num_emp = recibo.cod_emp_sec
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
DISPLAY BY NAME recibo.*,nom_cli,nombre_emp,valor_ctrl
COMMAND "Escoger"
"<Esc> Actualiza Registro <Delete> Cancela Operacion"
## AQUI SE MODIFICAN/ACTUALIZAN LOS DATOS DEL REGISTRO
LET p_fechas = recibo.fecha_orig
CALL prd()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
INPUT BY NAME recibo.cuenta_no,recibo.deposito,recibo.fecha_orig,valor_ctrl
WITHOUT DEFAULTS
## VENTANAS PARA DESPLEGAR LOS CLIENTES Y LOS EMPLEADOS
AFTER FIELD fecha_orig
IF recibo.tipo_doc != "AV" OR recibo.tipo_doc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
LET recibo.deposito = null
DISPLAY BY NAME recibo.deposito
END IF
IF recibo.fecha_orig IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_orig
END IF
LET p_fechas = recibo.fecha_orig
CALL prd()
IF bandera = 1 THEN
LET bandera = 0
NEXT FIELD fecha_orig
END IF
AFTER FIELD valor_ctrl
IF valor_ctrl IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD valor_ctrl
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
GO TO vuelve
END IF
EXIT INPUT
END INPUT
DECLARE buscar1 CURSOR FOR
SELECT a.aplica_a,a.valor,a.monto_desc,a.valor FROM cctb00001 a
WHERE a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente AND
a.tipo_doc = "AV" AND a.num_doc != a.aplica_a AND
a.num_doc = a.num_cheque AND a.num_doc = recibo.num_doc AND
a.cod_emp_sec = recibo.cod_emp_sec AND a.status_t IS NULL
LET idx = 1
FOREACH buscar1 INTO arr_recibo4[idx].*
IF arr_recibo4[idx].valor_pen < 0 THEN
LET arr_recibo4[idx].valor_pen = arr_recibo4[idx].valor_pen *-1
LET arr_recibo4[idx].valor_pag = arr_recibo4[idx].valor_pen
LET arr_recibo4[idx].valor_pen = 0
LET arr_recibo4[idx].desc_p = arr_recibo4[idx].desc_p * -1
SELECT sum(valor) INTO valor2 FROM cctb00001
WHERE tipo_cliente = recibo.tipo_cliente and
sec_cliente = recibo.sec_cliente and
aplica_a = arr_recibo4[idx].aplica_a and
status_t is null AND num_cheque = recibo.num_doc
END IF
LET arr_recibo4[idx].valor_pen = valor2
LET idx = idx + 1
END FOREACH
CALL set_count(idx - 1)
LABEL arreglo2:
## AQUI SE MODIFICAN/ACTUALIZAN LOS CAMPOS DEL ARREGLO
INPUT ARRAY arr_recibo4 WITHOUT DEFAULTS FROM s_recibo4.*
## VENTANA PARA BUSCAR LOS DOCUMENTOS
ON KEY (CONTROL-W)
LET curr = arr_curr()
LET scr_l = scr_line()
CASE
WHEN INFIELD (aplica_a)
CALL busca_apl4()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
NEXT FIELD aplica_a
END IF
IF existe = "N" THEN
LET existe = "S"
NEXT FIELD aplica_a
END IF
DISPLAY arr_recibo4[curr].aplica_a to s_recibo4[scr_l].aplica_a
DISPLAY arr_recibo4[curr].valor_pen to s_recibo4[scr_l].valor_pen
LET bandera = 0
CALL repetir4()
IF bandera = 1 THEN
NEXT FIELD aplica_a
END IF
NEXT FIELD desc_p
END CASE
BEFORE ROW
LET curr = arr_curr()
LET scr_l = scr_line()
AFTER FIELD aplica_a
IF arr_recibo4[curr].aplica_a IS NOT NULL THEN
LET bandera = 0
CALL repetir4()
IF bandera = 1 THEN
NEXT FIELD aplica_a
END IF
IF arr_recibo4[curr].aplica_a = recibo.num_doc THEN
LET numero_msg = 131
CALL msg(numero_msg)
# NEXT FIELD aplica_a
END IF
ELSE
# Controla que la factura pertenezca al cliente
IF arr_recibo4[curr].aplica_a != 999999 THEN
SELECT unique tipo_cliente FROM cctb00001
WHERE num_doc = arr_recibo4[curr].aplica_a and
tipo_cliente = recibo.tipo_cliente and
sec_cliente = recibo.sec_cliente and
(tipo_doc = "FT" or tipo_doc = "FE") and
status_t is null
IF status = notfound THEN
LET numero_msg = 126
CALL msg(numero_msg)
NEXT FIELD aplica_a
END IF
END IF
END IF
# Busca el valor pendiente de la factura
DISPLAY arr_recibo4[curr].valor_pen to s_recibo4[scr_l].valor_pen
AFTER FIELD desc_p
IF arr_recibo4[curr].desc_p is null THEN
LET arr_recibo4[curr].desc_p = 0
END IF
AFTER FIELD valor_pag
IF arr_recibo4[curr].aplica_a IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD aplica_a
END IF
IF arr_recibo4[curr].valor_pag IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD valor_pag
END IF
LET p_total = 0
FOR idx = 1 TO arr_count()
IF arr_recibo4[idx].valor_pag is not null THEN
LET p_total = p_total - arr_recibo4[idx].valor_pag
END IF
END FOR
IF p_total < 0 THEN
LET p_total = p_total * -1
END IF
DISPLAY BY NAME p_total ATTRIBUTE(BOLD)
# Controla que el valor aplicado a las facturas no exceda el monto del recibo
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
IF p_total != valor_ctrl THEN
LET numero_msg = 178
CALL msg(numero_msg)
GOTO arreglo2
END IF
## AQUI SE REALIZA LA MODIFICACION DEL REGISTRO
DELETE FROM cctb00001
WHERE tipo_cliente = recibo.tipo_cliente AND
sec_cliente = recibo.sec_cliente AND
tipo_doc = "AV" AND num_doc != aplica_a AND
num_doc = num_cheque AND num_doc = recibo.num_doc AND
cod_emp_sec = recibo.cod_emp_sec
FOR idx = 1 to arr_count()
IF arr_recibo4[idx].aplica_a is not null THEN
LET arr_recibo4[idx].valor_pag = arr_recibo4[idx].valor_pag * -1
LET arr_recibo4[idx].desc_p = arr_recibo4[idx].desc_p * -1
LET tipo_doc1 = NULL
LET tipo_doc1 = "AV"
IF arr_recibo4[idx].valor_pag < 0 THEN
INSERT INTO cctb00001 values (recibo.cuenta_no,null,tipo_doc1,
recibo.num_doc,recibo.tipo_cliente,recibo.sec_cliente,null,
recibo.cod_emp_sec,recibo.fecha_orig,null,arr_recibo4[idx].aplica_a,
recibo.deposito,recibo.num_doc,arr_recibo4[idx].valor_pag,null,
valor_cheque1,null,arr_recibo4[idx].desc_p,null,USER,CURRENT,null,null)
END IF
END IF
END FOR
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY ("N") "aNular"
## AQUI SE REALIZA LA ANULACION DE UN REGISTRO
UPDATE cctb00001 set status_t = "E", us_mod = USER, fech_mod = CURRENT
WHERE tipo_doc ="AV" and num_cheque = recibo.num_doc
LET numero_msg = 82
CALL msg(numero_msg)
COMMAND "Retornar"
CLEAR FORM
FOR idx = 1 to 3
LET arr_recibo4[idx].aplica_a = null
LET arr_recibo4[idx].valor_pen = null
LET arr_recibo4[idx].valor_pag = null
DISPLAY arr_recibo4[idx].aplica_a to s_recibo4[idx].aplica_a
DISPLAY arr_recibo4[idx].valor_pen to s_recibo4[idx].valor_pen
DISPLAY arr_recibo4[idx].valor_pag to s_recibo4[idx].valor_pag
END FOR
EXIT MENU
END MENU
END FUNCTION
FUNCTION busca_apl4()
OPEN WINDOW busqueda1 AT 10,10 WITH FORM "ccfmwd001"
ATTRIBUTE (BORDER,FORM LINE FIRST + 1, comment line last)
DECLARE aplicar CURSOR FOR
SELECT aplica_a,SUM(valor) FROM cctb00001
WHERE tipo_cliente = recibo.tipo_cliente AND
sec_cliente = recibo.sec_cliente AND
status_t is null
GROUP BY 1
HAVING SUM(valor) > 0
ORDER BY 1
LET existe = "N"
LET idx = 1
FOREACH aplicar INTO aplica_wd[idx].*
IF status = NOTFOUND THEN
LET existe = "N"
EXIT FOREACH
END IF
LET existe = "S"
LET idx = idx + 1
END FOREACH
IF existe = "N" and idx = 1 THEN
LET numero_msg = 127
CALL msg(numero_msg)
GOTO salir
END IF
CALL set_count(idx-1)
DISPLAY ARRAY aplica_wd TO consart.*
LET curr1 = arr_curr()
LET arr_recibo4[curr].aplica_a = aplica_wd[curr1].aplica_a
LET arr_recibo4[curr].valor_pen = aplica_wd[curr1].pendiente
LABEL salir:
CLOSE WINDOW busqueda1
END FUNCTION
FUNCTION repetir4()
DEFINE ant_art RECORD
aplica_a INTEGER,
valor_pag DECIMAL(12,2)
END RECORD
LET ant_art.aplica_a = arr_recibo4[curr].aplica_a
LET ant_art.valor_pag = arr_recibo4[curr].valor_pag
FOR idx = 1 to arr_count()
IF idx != curr THEN
IF arr_recibo4[idx].aplica_a IS NOT NULL AND
arr_recibo4[idx].valor_pag IS NOT NULL THEN
IF arr_recibo4[idx].aplica_a = ant_art.aplica_a AND
arr_recibo4[idx].valor_pag = ant_art.valor_pag THEN
LET numero_msg = 21
CALL msg(numero_msg)
LET bandera = 1
ELSE
IF bandera != 1 THEN
LET bandera = 0
END IF
END IF
END IF
END IF
END FOR
END FUNCTION
FUNCTION consulta_cliente4s()
OPEN WINDOW busqueda AT 7,12 WITH FORM "vefmwd002"
ATTRIBUTE (BORDER,FORM LINE FIRST + 2,COMMENT LINE LAST,MESSAGE LINE LAST)
LET int_flag = false
CONSTRUCT criterio ON a.nombre FROM nombre
LET selec2 = "SELECT a.tipo_cliente, a.sec_cliente, a.nombre ",
" FROM vetb00004 a",
" WHERE ",
"a.status_t is null AND ",
criterio clipped,
"ORDER BY 1,2 "
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GO TO salir_consulta_c
END IF
PREPARE busca_clientes FROM selec2
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
END IF
END IF
DECLARE buscar_clientes CURSOR FOR busca_clientes
LET idx = 1
FOREACH buscar_clientes INTO arr_clientes[idx].*
IF status = NOTFOUND THEN
EXIT FOREACH
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
EXIT FOREACH
END IF
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
MESSAGE " <Esc> Selecciona Cliente donde esta el cursor"
DISPLAY ARRAY arr_clientes TO s_clientes.*
LET curr1 = arr_curr()
LET cliente_dir.tipo_cliente = arr_clientes[curr1].tipo_cliente
LET cliente_dir.sec_cliente = arr_clientes[curr1].sec_cliente
LET descrip1 = arr_clientes[curr1].nombre
LABEL salir_consulta_c:
CLOSE WINDOW busqueda
END FUNCTION
FUNCTION cons_emp4()
OPEN WINDOW busqueda2 AT 7,12 WITH FORM "vefmwd001"
ATTRIBUTE (BORDER,FORM LINE FIRST + 2,COMMENT LINE LAST,MESSAGE LINE LAST)
LET int_flag = false
CONSTRUCT criterio ON a.nom1_emp FROM descrip6
LET selec2 = "SELECT num_emp,a.nom1_emp,a.apell1_emp ",
" FROM adtb00003 a",
" WHERE ",
"a.status_t is null AND ",
criterio clipped,
"ORDER BY 1 "
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GO TO salir_consulta_e
END IF
PREPARE busca_empleados FROM selec2
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
END IF
END IF
DECLARE buscar_empleados CURSOR FOR busca_empleados
LET idx = 1
FOREACH buscar_empleados INTO arr_empleados[idx].*
IF status = NOTFOUND THEN
EXIT FOREACH
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
EXIT FOREACH
END IF
LET empleados[idx].num_emp = arr_empleados[idx].num_emp
LET empleados[idx].descrip6 =
arr_empleados[idx].nom1_emp clipped," ",arr_empleados[idx].apell1_emp clipped
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
MESSAGE " <Esc> Selecciona Empleado donde esta el cursor"
DISPLAY ARRAY empleados TO s_empleados.*
LET curr1 = arr_curr()
LET transportista.sec_transp = empleados[curr1].num_emp
LET descrip6 = empleados[curr1].descrip6
LABEL salir_consulta_e:
CLOSE WINDOW busqueda2
END FUNCTION