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

1326 lines
41 KiB
Plaintext

{
-----------------------------------------------------------------------------
PROGRAMA : CGPRMT005
OBJETIVO : Mantenimiento de Cheques de pago en RD$
REALIZADO POR : Ing. Juan F. Soto
FECHA : Octubre 18, 1993.
-----------------------------------------------------------------------------
}
GLOBALS "cgprgb000.4gl"
DEFINE pcod,pcodsec INT
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(4) RETURNING impresor
CONNECT to "decomarmol" USER usuarios USING clave
SELECT a.* INTO p_compania.* FROM companias a
CALL cgprmt005()
END MAIN
###### Funcion que adiciona informacion referente a la aplicacion de un pago
FUNCTION cgprmt005()
OPTIONS
FORM LINE 8,
COMMENT LINE 22,
PROMPT LINE 23
# CALL pantalla()
OPEN FORM cgfmmt005 FROM "cgfmmt005"
DISPLAY FORM cgfmmt005
DISPLAY "cgprmt005" AT 4,3 ATTRIBUTE(blue)
DISPLAY "Registro De Cheques en RD$" AT 6,27 ATTRIBUTE(blue)
MENU "Mant."
ON ACTION Adicionar
LET int_flag = FALSE
CALL cgprad005()
ON ACTION Salir
LET int_flag = FALSE
EXIT MENU
END MENU
END FUNCTION
FUNCTION cgprad005()
DEFINE ktipo SMALLINT
LET hoy = TODAY
LABEL volver1:
INITIALIZE recibo.* TO NULL
CLEAR FORM
LABEL volver:
IF opc = "S" OR opc IS NULL THEN
LET recibo.nom_sup = NULL
LET recibo.monto = NULL
LET opc = NULL
END IF
#### Aceptando los valores a insertar referentes al pago
INPUT BY NAME recibo.* WITHOUT DEFAULTS
ON ACTION cuenta
LET curr = arr_curr()
LET scr_l = scr_line()
CALL busca_cuenta()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
NEXT FIELD cuenta
END IF
IF existe = "N" THEN
LET existe = "S"
NEXT FIELD cuenta
END IF
LET recibo.cuenta_p = cuentas1[curr1].cuenta_no
DISPLAY BY NAME recibo.cuenta_p
AFTER FIELD codigo
LET p_descrip = NULL
IF recibo.codigo IS not NULL THEN
SELECT a.descripcion INTO p_descrip
FROM tetb00003 a
WHERE a.codigo = recibo.codigo
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD codigo
END IF
DISPLAY BY NAME p_descrip
END IF
AFTER FIELD cuenta_p
IF recibo.cuenta_p IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cuenta_p
END IF
SELECT cheque_no INTO numero FROM cgtb00012
WHERE cuenta_no = recibo.cuenta_p AND tipo_doc="CK"
IF STATUS = notfound THEN
LET numero_msg = 205
CALL msg(numero_msg)
NEXT FIELD cuenta_p
END IF
LET numero = numero + 1
LET recibo.numero = numero
DISPLAY BY NAME recibo.numero
SELECT *INTO datos_ck.* FROM cgtb00012
WHERE cuenta_no = recibo.cuenta_p AND tipo_doc="CK"
AFTER FIELD cod_sp_sec
##### Selecionando datos referentes al suplidor
IF recibo.cod_sp_sec IS not NULL THEN
IF recibo.cod_sp != 1 THEN
SELECT a.nom_sp INTO recibo.nom_sup FROM cotb00001 a
WHERE a.cod_sp = recibo.cod_sp AND
a.cod_sp_sec = recibo.cod_sp_sec
IF STATUS = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
DISPLAY BY NAME recibo.cod_sp,recibo.cod_sp_sec,recibo.nom_sup
NEXT FIELD nom_sup
END IF
END IF
IF recibo.cod_sp = 1 THEN
SELECT nom1_emp,apell1_emp,departamento,nomina
INTO nombre_emp,apellido_emp,depto,tipo_d FROM adtb00003
WHERE num_emp = recibo.cod_sp_sec
IF STATUS = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_sp_sec
END IF
LET recibo.nom_sup = nombre_emp clipped," ",apellido_emp clipped
DISPLAY BY NAME recibo.nom_sup
END IF
BEFORE FIELD tipo_doc
LET recibo.tipo_doc = "CK"
BEFORE FIELD fecha
LET recibo.fecha = hoy using "dd/mm/yyyy"
DISPLAY BY NAME recibo.fecha
AFTER FIELD fecha
LET hoy = recibo.fecha
IF recibo.fecha IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
LET p_fechas = recibo.fecha
CALL prd(p_fechas,usuarios) RETURNING bandera
IF bandera = 1 THEN
LET bandera = 0
NEXT FIELD fecha
END IF
AFTER INPUT
####### Creando la facilidad para cancelar proceso mediante CTRL-C
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
IF recibo.fecha IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
IF recibo.cuenta_p IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cuenta_p
END IF
IF recibo.monto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD monto
END IF
SELECT UNIQUE cheque_no FROM cgtb00005
WHERE cheque_no = recibo.numero and
cuenta_no = recibo.cuenta_p AND tipo_doc="CK"
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD tipo_doc
END IF
EXIT INPUT
END INPUT
# Funcion que captura 5 lineas de detalles
CALL detallado()
IF opc = "S" OR opc IS NULL THEN
FOR idx = 1 to 30
LET arr_recibo[idx].aplica_a = NULL
LET arr_recibo[idx].valor_pen = NULL
LET arr_recibo[idx].valor_pag = NULL
END FOR
END IF
IF recibo.cod_sp = 1 THEN
GOTO vuelve
END IF
IF recibo.cod_sp_sec IS not NULL THEN
# Entrada de documentos que se pagaran con este cheque si el usuario
LABEL vuelta:
PROMPT "Afecta Cuentas Por Pagar?(S/N) " FOR CHAR opcion
LET opcion = UPSHIFT(opcion)
IF opcion != "S" AND
opcion != "N" THEN
LET numero_msg = -1301
CALL msg(numero_msg)
GOTO vuelta
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
# Validar Cuando No Afecta Cuentas Por Pagar
IF opcion = "N" THEN
FOR idx = 1 to 30
LET arr_recibo[idx].aplica_a = NULL
LET arr_recibo[idx].valor_pen = NULL
LET arr_recibo[idx].valor_pag = NULL
END FOR
END IF
#----------------------------------------------------------
# Captura de las facturas y/o documentos de cuentas por pagar
IF opcion = "S" THEN
LET remanente = 0
LABEL arr2:
LET sale_arr = "N"
INPUT ARRAY arr_recibo WITHOUT DEFAULTS FROM s_recibo.*
ON KEY (CONTROL-F)
LET sale_arr = "S"
EXIT INPUT
ON KEY (CONTROL-W)
LET curr = arr_curr()
LET scr_l = scr_line()
###### Proceso para abrir window en caso de desconocer el numero de orden
###### perteneciente a la factura que se aplicara el pago.
CASE
WHEN INFIELD (aplica_a)
CALL busca_aplicacion(recibo.cod_sp,recibo.cod_sp_sec) RETURNING arr_recibo[curr].aplica_a,arr_recibo[curr].valor_pen
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_recibo[curr].aplica_a to
s_recibo[scr_l].aplica_a
DISPLAY arr_recibo[curr].valor_pen to
s_recibo[scr_l].valor_pen
LET arr_recibo[curr].valor_pag =
arr_recibo[curr].valor_pen
DISPLAY arr_recibo[curr].valor_pag to
s_recibo[scr_l].valor_pag
NEXT FIELD valor_pag
LET verdad = "N"
CALL repetir1()
IF verdad = "S" THEN
NEXT FIELD aplica_a
END IF
END CASE
BEFORE ROW
LET curr = arr_curr()
LET scr_l = scr_line()
AFTER FIELD orden_no
IF arr_recibo[curr].orden_no != 999999 THEN #IS NOT NULL THEN
IF recibo.cod_sp IS NULL THEN
##### Chequeando que el numero de orden a digitar exista en la maestra de pago[
SELECT UNIQUE a.tipo,a.orden_no,a.cod_sp,a.cod_sp_sec
INTO p_tipo,p_orden,recibo.cod_sp,recibo.cod_sp_sec
FROM cptb00001 a
WHERE a.tipo = arr_recibo[curr].tipo AND
a.orden_no = arr_recibo[curr].orden_no
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
ELSE
###### Chequeando que el numero de orden exista en la maestra de orden
SELECT b.num_oc
FROM cotb00014 b
WHERE b.tipo = arr_recibo[curr].tipo AND
b.num_oc = arr_recibo[curr].orden_no AND
b.cod_sp = recibo.cod_sp AND
b.cod_sp_sec = recibo.cod_sp_sec
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
END IF
ELSE
IF recibo.tipo_doc = "CP" THEN
LET arr_recibo[curr].tipo = "99"
NEXT FIELD valor_pag
END IF
END IF
AFTER FIELD aplica_a
LET tipo_doc1 = recibo.tipo_doc
IF arr_recibo[curr].orden_no IS not NULL AND
arr_recibo[curr].aplica_a IS NULL THEN
LET tipo_doc1= "CP"
END IF
IF arr_recibo[curr].orden_no IS not NULL and
arr_recibo[curr].aplica_a IS not NULL THEN
LET numero_msg = 212
CALL msg(numero_msg)
NEXT FIELD aplica_a
END IF
IF arr_recibo[curr].aplica_a IS NOT NULL THEN
IF recibo.cod_sp != 1 THEN
IF recibo.tipo_doc = "CP" THEN
IF arr_recibo[curr].orden_no IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD orden_no
ELSE
NEXT FIELD valor_pag
END IF
END IF
IF arr_recibo[curr].aplica_a IS NOT NULL THEN
LET verdad = "N"
CALL repetir1()
IF verdad = "S" THEN
NEXT FIELD aplica_a
END IF
IF arr_recibo[curr].aplica_a IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD aplica_a
END IF
# Controla que la factura pertenezca al suplidor
SELECT a.tipo,a.orden_no,a.valor
INTO arr_recibo[curr].tipo,arr_recibo[curr].orden_no,
valor_fac
FROM cptb00001 a
WHERE (a.cod_sp=recibo.cod_sp AND a.cod_sp_sec=recibo.cod_sp_sec
AND a.tipo_doc = "FT" AND a.num_doc = arr_recibo[curr].aplica_a)
AND a.status_t IS NULL
IF STATUS = notfound THEN
LET numero_msg = 126
CALL msg(numero_msg)
NEXT FIELD aplica_a
END IF
# Busca el valor pendiente de la factura
SELECT sum(a.valor*-1) INTO valor_fac1 FROM cptb00001 a
WHERE a.cod_sp = recibo.cod_sp
AND a.cod_sp_sec = recibo.cod_sp_sec
AND a.aplica_a = arr_recibo[curr].aplica_a
AND a.tipo_doc not matches "*FT*"
AND a.status_t IS NULL
IF valor_fac1 IS NULL THEN
LET valor_fac1 = 0
END IF
IF valor_fac IS NULL THEN
LET valor_fac = 0
END IF
####### Controla que el documento que digite el usuario no exista como
####### otro documento que no sea una factura
SELECT unique a.num_doc
FROM cptb00001 a
WHERE (a.cod_sp = recibo.cod_sp and
a.cod_sp_sec = recibo.cod_sp_sec and
a.tipo_doc not in ("FT","CP","CK") and
a.num_doc = arr_recibo[curr].aplica_a) and
a.status_t IS NULL
IF STATUS != notfound THEN
LET numero_msg = 234
CALL msg(numero_msg)
#NEXT FIELD aplica_a
END IF
####### Calculando el valor pendiente de la factura
LET arr_recibo[curr].valor_pen = valor_fac - valor_fac1
LET arr_recibo[curr].valor_pag = arr_recibo[curr].valor_pen
DISPLAY arr_recibo[curr].valor_pag to
s_recibo[scr_l].valor_pag
DISPLAY arr_recibo[curr].valor_pen to
s_recibo[scr_l].valor_pen
END IF
END IF
END IF
AFTER FIELD valor_pag
IF recibo.tipo_doc = "CP" THEN
IF arr_recibo[curr].orden_no IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD orden_no
END IF
END IF
IF arr_recibo[curr].aplica_a IS NOT NULL AND
arr_recibo[curr].valor_pen IS NOT NULL THEN
LET verdad = "N"
CALL repetir1()
IF verdad = "S" THEN
NEXT FIELD aplica_a
END IF
END IF
IF arr_recibo[curr].valor_pag IS NULL THEN
LET arr_recibo[curr].valor_pag = 0
END IF
IF arr_recibo[curr].aplica_a IS not NULL THEN
IF arr_recibo[curr].valor_pag = 0 THEN
LET numero_msg = 207
CALL msg(numero_msg)
NEXT FIELD valor_pag
END IF
END IF
LET valor = 0
FOR idx = 1 TO arr_count()
IF arr_recibo[idx].valor_pag IS NULL THEN
LET arr_recibo[idx].valor_pag = 0
END IF
LET valor = arr_recibo[idx].valor_pag + valor
LET remanente = recibo.monto - valor
DISPLAY BY NAME remanente attribute (bold)
END FOR
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
IF sale_arr = "S" THEN
LET opc = "N"
GOTO volver
END IF
# Sumariza el valor de las facturas para que sean iguales
LET valor_f = 0
LET ins_cp = arr_count()
FOR idx= 1 to arr_count()
IF arr_recibo[idx].aplica_a IS NULL and
arr_recibo[idx].orden_no IS NULL THEN
LET arr_recibo[idx].valor_pag = 0
END IF
IF arr_recibo[idx].valor_pag IS NULL THEN
LET arr_recibo[idx].valor_pag = 0
END IF
LET valor_f = arr_recibo[idx].valor_pag + valor_f
END FOR
#------------------------------------------------------------------------
END IF
END IF
IF opc = "N" THEN
GOTO vuelve
END IF
FOR idx = 1 TO 50
LET arr_cuenta1[idx].cuenta_no = NULL
LET arr_cuenta1[idx].num_doc = NULL
LET arr_cuenta1[idx].cod_aux = NULL
LET arr_cuenta1[idx].cod_sec = NULL
LET arr_cuenta1[idx].num_doc = NULL
LET arr_cuenta1[idx].nom_cuenta = NULL
LET arr_cuenta1[idx].departamento = NULL
LET arr_cuenta1[idx].debito = NULL
LET arr_cuenta1[idx].credito = NULL
END FOR
LET arr_cuenta1[1].cod_aux = recibo.cod_sp
LET arr_cuenta1[1].cod_sec = recibo.cod_sp_sec
LABEL vuelve:
# Captura de la codificacion del cheque para contabilidad
LABEL arr3:
LET sale_arr = "N"
#CALL arr_cuenta1.clear()
INPUT ARRAY arr_cuenta1 WITHOUT DEFAULTS FROM s_cuenta.*
ON ACTION bcuenta
LET curr = arr_curr()
LET scr_l = scr_line()
CALL busca_cuenta()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
NEXT FIELD cuenta
END IF
IF existe = "N" THEN
LET existe = "S"
NEXT FIELD cuenta
END IF
LET arr_cuenta1[curr].nom_cuenta = cuentas1[curr1].descripcion
LET arr_cuenta1[curr].cuenta_no = cuentas1[curr1].cuenta_no
DISPLAY arr_cuenta1[curr].cuenta_no
DISPLAY BY NAME arr_cuenta1[curr].nom_cuenta
ON KEY (CONTROL-F)
LET opc = "N"
LET sale_arr = "S"
EXIT INPUT
ON KEY (CONTROL-P)
NEXT FIELD cuenta_no
BEFORE ROW
LET curr = arr_curr()
LET scr_l = scr_line()
AFTER FIELD cuenta_no
IF arr_cuenta1[curr].cuenta_no IS not NULL THEN
SELECT a.descripcion,a.origen,a.depto,a.nivel,a.ref,a.cata
INTO p_descripcion,p_origen,acept_dpto,p_nivel,p_ref,p_cata
FROM cgtb00001 a
WHERE a.cuenta_no = arr_cuenta1[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
LET arr_cuenta1[curr].nom_cuenta = p_descripcion
DISPLAY arr_cuenta1[curr].nom_cuenta TO
s_cuenta[scr_l].nom_cuenta
# Controla que si digitan las cuentas 2113,2117,2114 el programa controle
# que digiten el suplidor
IF arr_cuenta1[curr].cuenta_no = "2113" or
arr_cuenta1[curr].cuenta_no = "2117" or
arr_cuenta1[curr].cuenta_no = "2114" THEN
IF recibo.cod_sp_sec IS NULL THEN
LET numero_msg = 217
CALL msg(numero_msg)
LET arr_cuenta1[curr].cuenta_no = NULL
DISPLAY arr_cuenta1[curr].cuenta_no TO
s_cuenta[scr_l].cuenta_no
NEXT FIELD cuenta_no
END IF
END IF
# Controla que la cuenta del banco no sea igual a una cuenta digitada
# en el arreglo
LET cuenta_a = arr_cuenta1[curr].cuenta_no clipped
LET cuenta_b = recibo.cuenta_p clipped
IF cuenta_a = cuenta_b THEN
LET numero_msg = 192
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
#-----------------------------------------------------------------------------
IF arr_cuenta1[curr].cuenta_no = "2113" or
arr_cuenta1[curr].cuenta_no = "2117" or
arr_cuenta1[curr].cuenta_no = "2114" THEN
FOR idx = 1 TO arr_count()
CASE
WHEN arr_cuenta1[curr].cuenta_no = "2113"
IF arr_cuenta1[idx].cuenta_no = "2117" or
arr_cuenta1[idx].cuenta_no = "2114" THEN
LET numero_msg = 208
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
EXIT CASE
WHEN arr_cuenta1[curr].cuenta_no = "2117"
IF arr_cuenta1[idx].cuenta_no = "2113" or
arr_cuenta1[idx].cuenta_no = "2114" THEN
LET numero_msg = 208
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
EXIT CASE
WHEN arr_cuenta1[curr].cuenta_no = "2113"
IF arr_cuenta1[idx].cuenta_no = "2117" or
arr_cuenta1[idx].cuenta_no = "2114" THEN
LET numero_msg = 208
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
EXIT CASE
END CASE
END FOR
END IF
IF p_nivel < 3 THEN
LET numero_msg = 175
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
IF acept_dpto = "S" THEN
NEXT FIELD departamento
ELSE
LET arr_cuenta1[curr].departamento = NULL
DISPLAY arr_cuenta1[curr].departamento TO
s_cuenta[scr_l].departamento
END IF
IF p_cata = "S" THEN
NEXT FIELD cod_aux
ELSE
LET arr_cuenta1[curr].cod_aux = NULL
LET arr_cuenta1[curr].cod_sec = NULL
DISPLAY arr_cuenta1[curr].cod_aux TO s_cuenta[scr_l].cod_aux
DISPLAY arr_cuenta1[curr].cod_sec TO s_cuenta[scr_l].cod_sec
IF p_ref = "S" THEN
NEXT FIELD num_doc
ELSE
LET arr_cuenta1[curr].num_doc = NULL
DISPLAY arr_cuenta1[curr].num_doc TO s_cuenta[scr_l].num_doc
END IF
NEXT FIELD debito
END IF
END IF
AFTER FIELD departamento
IF arr_cuenta1[curr].cuenta_no IS not NULL THEN
IF acept_dpto = "S" THEN
IF arr_cuenta1[curr].departamento IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
SELECT a.nom_dpto INTO nombre_dpto FROM adtb00001 a
WHERE a.departamento = arr_cuenta1[curr].departamento and
a.status_t IS NULL
IF STATUS = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
DISPLAY BY NAME nombre_dpto ATTRIBUTE(blue)
ELSE
LET arr_cuenta1[curr].departamento = NULL
DISPLAY arr_cuenta1[curr].departamento TO
s_cuenta[scr_l].departamento
IF p_cata = "S" THEN
NEXT FIELD cod_aux
ELSE
IF p_ref = "S" THEN
NEXT FIELD num_doc
END IF
END IF
END IF
END IF
NEXT FIELD debito
BEFORE FIELD cod_aux
IF p_cata != "S" THEN
LET arr_cuenta1[curr].cod_aux = NULL
LET arr_cuenta1[curr].cod_sec = NULL
DISPLAY arr_cuenta1[curr].cod_aux TO s_cuenta[scr_l].cod_aux
DISPLAY arr_cuenta1[curr].cod_sec TO s_cuenta[scr_l].cod_sec
NEXT FIELD num_doc
END IF
AFTER FIELD cod_aux
IF arr_cuenta1[curr].cuenta_no IS not NULL THEN
IF p_cata = "S" THEN
IF arr_cuenta1[curr].cod_aux IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_aux
END IF
ELSE
LET arr_cuenta1[curr].cod_aux = NULL
LET arr_cuenta1[curr].cod_sec = NULL
DISPLAY arr_cuenta1[curr].cod_aux TO s_cuenta[scr_l].cod_aux
DISPLAY arr_cuenta1[curr].cod_sec TO s_cuenta[scr_l].cod_sec
NEXT FIELD num_doc
END IF
END IF
AFTER FIELD cod_sec
IF arr_cuenta1[curr].cuenta_no IS not NULL THEN
IF p_cata = "S" THEN
IF arr_cuenta1[curr].cod_sec IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_aux
END IF
IF arr_cuenta1[curr].cod_aux != 1 THEN
SELECT a.nom_sp INTO nombre_cata FROM cotb00001 a
WHERE a.cod_sp = arr_cuenta1[curr].cod_aux AND
a.cod_sp_sec = arr_cuenta1[curr].cod_sec
IF STATUS = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_aux
END IF
DISPLAY BY NAME nombre_cata ATTRIBUTE(blue)
END IF
IF arr_cuenta1[curr].cod_aux = 1 THEN
SELECT nom1_emp,apell1_emp,departamento,nomina
INTO nombre_cata
FROM adtb00003
WHERE num_emp = arr_cuenta1[curr].cod_sec
IF STATUS = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_aux
END IF
DISPLAY BY NAME nombre_cata
IF p_ref = "S" THEN
NEXT FIELD num_doc
ELSE
LET arr_cuenta1[curr].num_doc = NULL
DISPLAY arr_cuenta1[curr].num_doc TO
s_cuenta[scr_l].num_doc
NEXT FIELD debito
END IF
END IF
END IF
END IF
BEFORE FIELD num_doc
IF p_ref != "S" THEN
NEXT FIELD debito
END IF
AFTER FIELD num_doc
IF arr_cuenta1[curr].cuenta_no IS not NULL THEN
IF p_ref = "S" THEN
IF arr_cuenta1[curr].num_doc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
ELSE
LET arr_cuenta1[curr].num_doc = NULL
DISPLAY arr_cuenta1[curr].num_doc TO
s_cuenta[scr_l].num_doc
END IF
END IF
AFTER FIELD debito
IF arr_cuenta1[curr].debito IS not NULL or
arr_cuenta1[curr].debito != 0 THEN
IF arr_cuenta1[curr].debito != 0 THEN
IF arr_cuenta1[curr].cuenta_no IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
END IF
END IF
AFTER ROW
IF arr_cuenta1[curr].cuenta_no IS not NULL THEN
IF arr_cuenta1[curr].debito = 0 and
arr_cuenta1[curr].credito = 0 THEN
LET numero_msg = 207
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
IF valor_f IS NULL THEN
LET valor_f = 0
END IF
IF arr_cuenta1[curr].debito IS not NULL THEN
IF arr_cuenta1[curr].cuenta_no IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
END IF
IF arr_cuenta1[curr].credito IS not NULL THEN
IF arr_cuenta1[curr].cuenta_no IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
END IF
# Controla que las facturas digitadas en el arreglo de cuentas por pagar
# sumen el mismo monto que las cuentas digitadas en contabilidad
IF recibo.cod_sp_sec IS not NULL THEN
IF opcion = "S" THEN
LET valor_cxp = 0
LET chequea = "N"
FOR idx = 1 TO arr_count()
IF arr_cuenta1[idx].cuenta_no IS not NULL THEN
IF arr_cuenta1[idx].cuenta_no = "2114" or
arr_cuenta1[idx].cuenta_no = "2117" or
arr_cuenta1[idx].cuenta_no = "2113" THEN
LET chequea = "S"
LET valor_cxp = valor_cxp + arr_cuenta1[idx].debito
END IF
END IF
END FOR
IF chequea = "S" THEN
IF valor_f != valor_cxp THEN
LET numero_msg = 206
CALL msg(numero_msg)
NEXT FIELD debito
END IF
END IF
{
# Controla las cuentas por pagar si se digito una cuenta perteneciente
# a las cuentas por pagar y no se le dice al programa que no afecta
# las cuentas por pagar
LET ctrl_cxp = "N"
FOR idx = 1 TO arr_count()
IF arr_cuenta1[idx].cuenta_no IS not NULL THEN
IF opcion = "S" THEN
IF arr_cuenta1[idx].cuenta_no = "2113" THEN
LET ctrl_cxp = "S"
END IF
IF arr_cuenta1[idx].cuenta_no = "2117" THEN
LET ctrl_cxp = "S"
END IF
IF arr_cuenta1[idx].cuenta_no = "2114" THEN
LET ctrl_cxp = "S"
END IF
END IF
END IF
END FOR
IF ctrl_cxp = "N" THEN
LET numero_msg = 210
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
}
END IF
# Controla las cuentas por cobrar si se digito una cuenta perteneciente
# a las cuentas por cobrar y no se le dice al programa que no afecta
# las cuentas por cobrar
LET ctrl_cxp = "N"
FOR idx = 1 TO arr_count()
IF arr_cuenta1[idx].cuenta_no IS not NULL THEN
IF opcion IS NULL OR opcion = "N" THEN
IF arr_cuenta1[idx].cuenta_no = "2113" or
arr_cuenta1[idx].cuenta_no = "2117" or
arr_cuenta1[idx].cuenta_no = "2114" THEN
LET ctrl_cxp = "S"
END IF
END IF
END IF
END FOR
IF ctrl_cxp = "S" THEN
LET numero_msg = 209
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
END IF
LET tiene_cta = "N"
FOR idx = 1 TO arr_count()
IF arr_cuenta1[idx].cuenta_no IS not NULL THEN
LET tiene_cta = "S"
END IF
END FOR
IF tiene_cta = "N" THEN
LET numero_msg = 84
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
EXIT INPUT
END INPUT
IF sale_arr = "S" THEN
GOTO arr2
END IF
LET monto = 0
LET valor = 0
FOR idx = 1 TO arr_count()
IF arr_cuenta1[idx].debito IS NULL THEN
LET arr_cuenta1[idx].debito = 0
END IF
IF arr_cuenta1[idx].credito IS NULL THEN
LET arr_cuenta1[idx].credito = 0
END IF
LET valor = valor + arr_cuenta1[idx].debito
LET monto = arr_cuenta1[idx].credito + monto
END FOR
LET monto = valor - monto
IF monto != recibo.monto THEN
LET numero_msg = 178
CALL msg(numero_msg)
GOTO vuelve
END IF
PROMPT "Toda la Informacion Esta Correcta (S/N) ?" FOR char opc
LET opc = UPSHIFT(opc)
LET limpia = "N"
LET opc1 = "N"
IF opc = "S" THEN
LET limpia = "S"
# chequea que el archivo de impresion del cheque este creado
#PROMPT "Desea Imprimir el Cheque Ahora (S/N) ?" FOR char opc1
#LET opc1 = UPSHIFT(opc1)
LET opc1 = "S"
CALL defecto(usuarios,clave,impresor) RETURNING imprime,negrilla_on,negrillas_of,
doble_on,doble_off,comp_on,comp_off,
doce,normal,archivo,copia
CALL seleccionarsalida() RETURNING r_output
CALL configureoutput(r_output) RETURNING handler
START REPORT cheque TO XML HANDLER HANDLER
{ IF recibo.tipo_doc='TR' THEN
SELECT a.cheque_no INTO numero FROM cgtb00023 a
WHERE a.cuenta_no = recibo.cuenta_p and
a.tipo_Doc = 'TR'
IF STATUS = NOTFOUND THEN
INSERT INTO cgtb00023 (tipo_Doc,cheque_no,cuenta_no)
VALUES (recibo.tipo_doc,'0',recibo.cuenta_p)
ELSE
IF numero IS NULL THEN
LET numero = 0
END IF
LET numero = numero + 1
LET recibo.numero = numero
DISPLAY BY NAME recibo.numero
UPDATE cgtb00023 set cheque_no = numero WHERE cuenta_no = recibo.cuenta_p and
tipo_Doc = recibo.tipo_doc
END IF
END IF}
LET tipo_doc1 = recibo.tipo_doc
# Actualizacion de las tablas de cuentas por pagar y contabilidad general
IF recibo.cod_sp > 1 THEN
IF opcion = "S" THEN
LET opcion = NULL
LET numero1 = recibo.numero
FOR idx = 1 to ins_cp
IF arr_recibo[idx].valor_pag <> 0 and
arr_recibo[idx].valor_pag IS not NULL THEN
##### Proceso para insertar valores en cuentas por pagar
IF arr_recibo[idx].valor_pag > 0 THEN
LET arr_recibo[idx].valor_pag =
arr_recibo[idx].valor_pag * -1
END IF
IF arr_recibo[idx].orden_no IS NOT NULL OR
arr_recibo[idx].aplica_a IS NOT NULL THEN
INSERT INTO cptb00001
(tipo_doc, num_doc, cod_sp, cod_sp_sec, fecha_orig, fecha_proc, orden_no, tipo,
aplica_a, cta_ctble, valor, detalle, status_t, us_crea, fech_crea, us_mod, fech_mod)
VALUES (tipo_doc1,recibo.numero,recibo.cod_sp,
recibo.cod_sp_sec,recibo.fecha,recibo.fecha,
arr_recibo[idx].orden_no,arr_recibo[idx].tipo,
arr_recibo[idx].aplica_a,recibo.cuenta_p,
arr_recibo[idx].valor_pag,detalle_1,NULL,SUSER_SNAME(),
GETDATE(),NULL,NULL)
IF STATUS < 0 THEN
ERROR "NO FUE POSIBLE INSERTAR EN LA TABLA CPTB00001"
#ROLLBACK WORK
END IF
END IF
END IF
END FOR
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
END IF
# Actualizacion de la tabla datos generales del cheque
INSERT INTO cgtb00005 values
(recibo.cuenta_p,recibo.numero,NULL,recibo.fecha ,
recibo.nom_sup,recibo.tasa,recibo.monto,recibo.cod_sp,
recibo.cod_sp_sec,opc1,NULL,
SUSER_SNAME(),GETDATE(),NULL,NULL,"CK",null)
IF STATUS < 0 THEN
ERROR "NO FUE POSIBLE INSERTAR EN LA TABLA CGTB00005"
#ROLLBACK WORK
END IF
#Actualizacion de la tabla control de los cheques
IF recibo.tipo_doc = 'CK' OR recibo.tipo_doc = 'CP' THEN
UPDATE cgtb00012 set cheque_no = recibo.numero
WHERE cuenta_no = recibo.cuenta_p AND tipo_doc="CK"
END IF
# Actualizacion de la tabla transacciones de contabildad general
IF recibo.tipo_doc="CK" OR recibo.tipo_doc='CP' THEN
LET ktipo = 2
ELSE
LET ktipo = 3
END IF
LET referencia = recibo.tipo_doc,".",recibo.numero using "&&&&&&"
FOR idx = 1 TO arr_count()
IF arr_cuenta1[idx].cuenta_no IS not NULL THEN
IF arr_recibo[idx].orden_no IS not NULL THEN
LET refe[idx] = arr_recibo[idx].orden_no
END IF
IF arr_recibo[idx].orden_no IS not NULL THEN
LET refe[idx] = arr_recibo[idx].tipo using "&&","-",
arr_recibo[idx].aplica_a using "&&&&&&"
END IF
IF arr_recibo[idx].aplica_a IS not NULL THEN
LET refe[idx] = arr_recibo[idx].aplica_a
END IF
INSERT INTO cgtb00004
(fecha, tipo, ref, cuenta_no, departamento, num_doc, cod_aux, cod_sec, detalles, detalle_1,
detalle_2, debito, credito, status_t, us_crea, fech_crea, us_mod, fech_mod)
values (recibo.fecha,ktipo,referencia,
arr_cuenta1[idx].cuenta_no,
arr_cuenta1[idx].departamento,
arr_cuenta1[idx].num_doc,
arr_cuenta1[idx].cod_aux,
arr_cuenta1[idx].cod_sec,recibo.cuenta_p
,detalle_1,detalle_2,
arr_cuenta1[idx].debito,
arr_cuenta1[idx].credito,
NULL,SUSER_SNAME(),GETDATE(),NULL,NULL)
IF STATUS < 0 THEN
ERROR "NO FUE POSIBLE INSERTAR EN LA TABLA CGTB00004"
#ROLLBACK WORK
END IF
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
# Impresion del cheque de pago
OUTPUT TO REPORT cheque(recibo.*,arr_cuenta1[idx].*)
END IF
END FOR
IF recibo.tipo_doc = 'CK' OR recibo.tipo_doc = 'CP' THEN
# Inserta los registros necesarios para la tabla de tesoreria
INSERT INTO tetb00006 values (recibo.numero,recibo.cuenta_p,
recibo.codigo,NULL,SUSER_SNAME(),GETDATE(),NULL,NULL)
END IF
#-----------------------------------------------------------------------------
INSERT INTO cgtb00004
(fecha, tipo, ref, cuenta_no, departamento, num_doc, cod_aux, cod_sec, detalles,
detalle_1, detalle_2, debito, credito, status_t, us_crea, fech_crea, us_mod, fech_mod)
values (recibo.fecha,ktipo,referencia,
recibo.cuenta_p,NULL,
NULL,NULL,NULL,recibo.cuenta_p,
detalle_1,detalle_2,0,recibo.monto,
NULL,SUSER_SNAME(),GETDATE(),NULL,NULL)
IF STATUS < 0 THEN
ERROR "NO FUE POSIBLE INSERTAR EL BANCO EN LA TABLA CGTB00004"
#ROLLBACK WORK
END IF
#COMMIT WORK
SELECT descripcion INTO p_descripcion FROM cgtb00001
WHERE cuenta_no = recibo.cuenta_p
LET arr_cuenta1[1].cuenta_no = recibo.cuenta_p
LET arr_cuenta1[1].nom_cuenta = p_descripcion
LET arr_cuenta1[1].debito = 0
LET arr_cuenta1[1].num_doc = NULL
LET arr_cuenta1[1].departamento = NULL
LET arr_cuenta1[1].cod_aux = NULL
LET arr_cuenta1[1].cod_sec = NULL
LET arr_cuenta1[1].credito = recibo.monto
OUTPUT TO REPORT cheque(recibo.*,arr_cuenta1[1].*)
DISPLAY " " AT 1,1
FINISH REPORT cheque
{IF recibo.cuenta_p <> "1104" THEN
RUN imprime
END IF}
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
FOR idx = 1 TO 10
LET arr_cuenta1[idx].cuenta_no = NULL
LET arr_cuenta1[idx].num_doc = NULL
LET arr_cuenta1[idx].cod_aux = NULL
LET arr_cuenta1[idx].cod_sec = NULL
LET arr_cuenta1[idx].nom_cuenta = NULL
LET arr_cuenta1[idx].departamento = NULL
LET arr_cuenta1[idx].debito = NULL
LET arr_cuenta1[idx].credito = NULL
END FOR
END IF
IF opc = "N" THEN
GOTO volver
END IF
END FUNCTION
{FUNCTION busca_aplicacion()
OPEN WINDOW busqueda1 AT 10,10 WITH FORM "cgfmwd006"
ATTRIBUTE (BORDER,FORM LINE FIRST + 1, comment line last)
LET selec = "SELECT a.aplica_a,SUM(a.valor) FROM cptb00001 a ",
"WHERE a.cod_sp = ? AND a.cod_sp_sec = ? AND ",
" a.status_t IS NULL AND a.aplica_a IS NOT NULL ",
"GROUP BY a.aplica_a HAVING SUM(a.valor) != 0 ORDER BY 1"
PREPARE comando1 FROM selec
DECLARE aplicar CURSOR FOR comando1
OPEN aplicar USING recibo.cod_sp,recibo.cod_sp_sec
LET existe = "N"
LET idx = 1
WHILE STATUS != NOTFOUND
FETCH aplicar INTO aplica_wd[idx].*
IF STATUS = NOTFOUND THEN
EXIT WHILE
END IF
LET aplica_wd[idx].pendiente = aplica_wd[idx].pendiente #* -1
LET existe = "S"
LET idx = idx + 1
END WHILE
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_recibo[curr].aplica_a = aplica_wd[curr1].aplica_a
LET arr_recibo[curr].valor_pen = aplica_wd[curr1].pendiente
LABEL salir:
CLOSE WINDOW busqueda1
END FUNCTION
FUNCTION repetir1()
DEFINE ant_art RECORD
orden_no INTEGER,
aplica_a CHAR(10),
valor_pag INTEGER
END RECORD
LET ant_art.orden_no = arr_recibo[curr].orden_no
LET ant_art.aplica_a = arr_recibo[curr].aplica_a
LET ant_art.valor_pag = arr_recibo[curr].valor_pag
FOR idx = 1 to arr_count()
IF idx != curr THEN
IF arr_recibo[idx].aplica_a IS NOT NULL AND
arr_recibo[idx].valor_pag IS NOT NULL THEN
IF arr_recibo[idx].aplica_a = ant_art.aplica_a AND
arr_recibo[idx].valor_pag = ant_art.valor_pag THEN
LET numero_msg = 21
CALL msg(numero_msg)
LET verdad = "S"
ELSE
IF verdad != "S" THEN
LET verdad = "N"
END IF
END IF
END IF
END IF
END FOR
END FUNCTION
}
FUNCTION detallado()
OPEN WINDOW wind10 AT 13,5 WITH FORM "cgfmwd007" ATTRIBUTE (BORDER,
FORM LINE FIRST + 1,COMMENT LINE LAST)
IF limpia = "S" THEN
LET detalle_1 = NULL
LET detalle_2 = NULL
LET detalle_3 = NULL
LET detalle_4 = NULL
LET detalle_5 = NULL
LET valor_1 = NULL
LET valor_2 = NULL
LET valor_3 = NULL
LET valor_4 = NULL
LET valor_5 = NULL
END IF
INPUT BY NAME detalle_1,valor_1,detalle_2,valor_2,detalle_3,valor_3,
detalle_4,valor_4,detalle_5,valor_5 WITHOUT DEFAULTS
AFTER INPUT
LET detalle_1 = UPSHIFT(detalle_1)
LET detalle_2 = UPSHIFT(detalle_2)
LET detalle_3 = UPSHIFT(detalle_3)
LET detalle_4 = UPSHIFT(detalle_4)
LET detalle_5 = UPSHIFT(detalle_5)
EXIT INPUT
END INPUT
IF int_flag THEN
LET detalle_1 = NULL
LET detalle_2 = NULL
LET detalle_3 = NULL
LET detalle_4 = NULL
LET detalle_5 = NULL
LET int_flag = FALSE
LET numero_msg = 2
CALL msg(numero_msg)
END IF
CLOSE WINDOW wind10
END FUNCTION