NACE/DECOMARMOL
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
DECOMARMOL/PROYECTO/ccdir/ccprmt001bk2.4gl
T
Luis 07649704b1 primer commit subida
2026-09-22 20:38:51 -04:00

3051 lines
104 KiB
Plaintext
Raw Permalink Blame History

{
-----------------------------------------------------------------------------
PROGRAMA : CCPRMT001
OBJETIVO : Mantenimiento de Recibo de Pago y otros Movimientos
REALIZADO POR : JUAN SOTO
FECHA : Enero 1997
MODIFICACION : El campo cod_emp de la tabla cctb00001 se guarda el codigo de la sucursale quien
emite el recibo
En el campo costo de la tabla cctb00001 seguarda 1-Si el documento
debe salir en el reporte de cobros de la encargada y 0- En caso
contrario
-----------------------------------------------------------------------------
}
GLOBALS "ccprgb000.4gl"
DEFINE handler om.SaxDocumentHandler, -- return value from fgl_report_commitCurrentSettings()
r_filename STRING, -- filename of Report Design Document including .4rp extension
r_output STRING, -- output format option
preview INTEGER -- TRUE/FALSE, to set preview option
DEFINE decenas DYNAMIC ARRAY OF CHAR(20)
DEFINE centenas DYNAMIC ARRAY OF CHAR(20)
DEFINE unidades1 DYNAMIC ARRAY OF CHAR(20)
DEFINE valor_cheque1,p_num_doc,xcotizacion,xorden,xfactura_ext,numero_doc INTEGER
DEFINE valor_ctrl1,valor_nc,nc_pend,valor_ctrl,p_total,
valor_orig,remanente,val_pen,valor_aplicado,valor2 DECIMAL(12,2),
psimbolo,pmoneda,valor_letras string
DEFINE fecha1 DATE
DEFINE nombre_cta CHAR(30)
DEFINE tipo_ant,tipo_doc2,tipo_doc1 CHAR(2)
DEFINE opc CHAR(1),
avance BOOLEAN,
navance SMALLINT,
ch_itbis char(2),
afecta_ex varchar(3),
ppaga_itbis,encontre_factura CHAR(1),
avance_e DYNAMIC ARRAY OF INT
MAIN
DEFER INTERRUPT
CALL STARTLOG("ccprmt01.log")
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
CONNECT to "marmotech" AS "IFMX" USER usuarios USING clave
CONNECT to "smarmotech" AS "MSSQL" USER usuarios USING clave
SELECT a.* INTO p_companias.* FROM companias a
SELECT a.sucid,a.sucnombre INTO codigo_sucursal,nombre_sucursal
FROM sucursales a,seg0001 b
WHERE b.usuario = usuarios AND b.sucid = a.sucid
IF STATUS = NOTFOUND THEN
CALL fgl_winmessage("ERROR","USTED NO TIENE LOCALIDAD ASIGNADA, CONTACTE ADMINISTRADOR SISTEMAS","STOP")
EXIT PROGRAM
END IF
CALL ccprmt001()
END MAIN
####### Funcion para agregar un recibo de pago
FUNCTION ccprmt001()
OPTIONS
FORM LINE 8,
ERROR LINE 24,
COMMENT LINE 22,
PROMPT LINE 23
# CALL pantalla()
OPEN FORM ccfmmt001 FROM "ccfmmt001"
DISPLAY FORM ccfmmt001
DISPLAY "ccprmt001" AT 4,3
DISPLAY "Movimientos de CXC" AT 6,31
DISPLAY nombre_sucursal TO localidad
LET fecha1 = today
MENU "OPCION"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Delete> Cancela Operacion"
LET INT_FLAG = FALSE
CALL ccpcad001()
COMMAND "Consultar-modificar"
"<Esc> Busca Registro <Delete> Cancela Operacion"
CALL ccpcmf001()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ccpcad001()
DEFINE emp SMALLINT
DEFINE hoy DATE
LET hoy = null
LABEL volver:
LET recibo.fecha_orig = fecha1
LET valor_ctrl = NULL
LET tipo_ant = "PG"
DISPLAY nombre_sucursal TO localidad
INPUT BY NAME recibo.*,valor_ctrl,ch_itbis,aplicacion_antiguas WITHOUT DEFAULTS
## VENTANAS PARA BUSCAR LOS CLIENTES Y LOS EMPLEADOS
BEFORE INPUT
LET ch_itbis = 'SI'
LET aplicacion_antiguas = 'NO'
DISPLAY BY NAME ch_itbis
BEFORE FIELD num_doc
IF recibo.tipo_doc = 'PG' THEN
NEXT FIELD tipo_cliente
END IF
ON KEY (CONTROL-W)
CASE
WHEN INFIELD(tipo_cliente)
CALL consulta_clientes()
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 AND a.status_t IS NULL
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_clientes()
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
LET nom_cli = nom_cli CLIPPED," ",recibo.tipo_cliente USING "<<","-",recibo.sec_cliente USING "<<<<<<<"
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 consulta_empleados()
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
{
AFTER FIELD deposito
IF recibo.cuenta_no is not null THEN
IF recibo.deposito is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD deposito
END IF
SELECT unique num_doc FROM tetb00001
WHERE cuenta_no = recibo.cuenta_no and num_doc = recibo.deposito
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD deposito
END IF
END IF
}
## AQUI SE PREPARA PARA LA CAPTURA DE INFORMACION
BEFORE FIELD tipo_doc
LET recibo.tipo_doc = tipo_ant
AFTER FIELD tipo_doc
IF recibo.tipo_doc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo_doc
END IF
LET tipo_ant = recibo.tipo_doc
{
IF recibo.tipo_doc = "PG" AND recibo.deposito IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD deposito
ELSE
IF recibo.tipo_doc != "PG" AND recibo.deposito IS NOT NULL THEN
LET numero_msg = 192
CALL msg(numero_msg)
LET recibo.deposito = null
DISPLAY BY NAME recibo.deposito
END IF
END IF
}
CASE
WHEN recibo.tipo_doc = "PG"
LET nombre_tipo = "PAGOS"
EXIT CASE
WHEN recibo.tipo_doc = "OC"
LET nombre_tipo = "OTROS CREDITOS"
EXIT CASE
WHEN recibo.tipo_doc = "NC"
LET nombre_tipo = "NOTA CREDITO"
EXIT CASE
WHEN recibo.tipo_doc = "ND"
LET nombre_tipo = "NOTA DEBITO"
EXIT CASE
WHEN recibo.tipo_doc = "PI"
LET nombre_tipo = "PAGO INTER."
EXIT CASE
WHEN recibo.tipo_doc = "DV"
LET nombre_tipo = "DEVOLUCION DINERO"
EXIT CASE
END CASE
#DISPLAY BY NAME nombre_tipo ATTRIBUTE (BOLD)
LET p_nombre_tipo = nombre_tipo
#IF recibo.tipo_doc <> "RM" AND recibo.tipo_doc <> 'RC' THEN
SELECT a.ult_recibo INTO p_num_doc FROM cctb00003 a
WHERE a.tipo_doc = recibo.tipo_doc
IF STATUS = NOTFOUND THEN
LET p_num_doc = 0
END IF
LET p_num_doc = p_num_doc + 1
LET recibo.num_doc = p_num_doc
#END IF
{
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 or
recibo.num_doc = 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
SELECT UNIQUE a.num_doc FROM cctb00001 a
WHERE a.tipo_doc = recibo.tipo_doc AND
a.num_doc = recibo.num_doc
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
SELECT a.paga_itbis INTO ppaga_itbis
FROM vetb00060 a WHERE a.tipo_cliente = recibo.tipo_cliente
IF ppaga_itbis = 'N' THEN
LET ch_itbis = 'NO'
ELSE
LET ch_itbis = "SI"
END IF
## CHEQUEA QUE EL CLIENTE EXISTA, SI EXISTE DESPLEGA SU NOMBRE
AFTER FIELD tipo_cliente
IF recibo.tipo_cliente IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo_cliente
END IF
# Controla que el TIPO DE MOVIMIENTO FI solo sea a tipo clientes 13
IF recibo.tipo_doc = "FI" AND recibo.tipo_cliente = 12 THEN
LET numero_msg = 240
CALL msg(numero_msg)
NEXT FIELD tipo_cliente
END IF
AFTER FIELD sec_cliente
IF recibo.sec_cliente IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD sec_cliente
END IF
SELECT b.nombre,ISNULL(c.calle,' ')+ISNULL(c.casa_num,' ')+ISNULL(c.urbanizacion,' ')
+ISNULL(c.barrio,' ')
INTO nom_cli,xdireccion FROM vetb00004 b
LEFT OUTER JOIN vetb00005 c ON b.tipo_cliente = c.tipo_cliente AND
b.sec_cliente = c.sec_cliente
WHERE b.tipo_cliente = recibo.tipo_cliente and
b.sec_cliente = recibo.sec_cliente
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD tipo_cliente
END IF
LET nom_cli = nom_cli CLIPPED," ",recibo.tipo_cliente USING "<<","-",recibo.sec_cliente USING "<<<<<<<"
DISPLAY BY NAME nom_cli ATTRIBUTE (BOLD)
# BUSCA EL VENDEDOR PARA ESTE CLIENTE
SELECT a.sec_vend INTO recibo.cod_emp_sec
FROM vetb00028 a
WHERE a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente
DISPLAY BY NAME recibo.cod_emp_sec
IF recibo.cod_emp_sec IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD sec_cliente
END IF
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3 FROM adtb00003
WHERE num_emp = recibo.cod_emp_sec
LET nombre_emp = descrip2 CLIPPED," ",descrip3
DISPLAY BY NAME nombre_emp ATTRIBUTE (BOLD)
NEXT FIELD fecha_orig
AFTER FIELD cod_emp_sec
IF recibo.cod_emp_sec IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_emp_sec
END IF
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3 FROM adtb00003
WHERE num_emp = recibo.cod_emp_sec
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_emp_sec
END IF
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
DISPLAY BY NAME nombre_emp ATTRIBUTE (BOLD)
IF recibo.tipo_doc = "ND" THEN
SELECT sec_vend FROM vetb00028
WHERE tipo_cliente = recibo.tipo_cliente and
sec_cliente = recibo.sec_cliente
IF status != notfound THEN
LET numero_msg = 357
CALL msg(numero_msg)
END IF
END IF
## VERIFICA EL ULTIMO NUMERO DE RECIBO DEL VENDEDOR
{ IF recibo.tipo_doc = "PG" THEN
SELECT ult_recibo INTO p_num_doc FROM cctb00003
WHERE sec_vend = recibo.cod_emp_sec and status_t is null and
tipo_doc = "PG"
IF status = notfound THEN
LET numero_msg = 128
CALL msg(numero_msg)
SLEEP 2
RETURN
END IF
LET p_num_doc = p_num_doc + 1
# Chequea que el recibo del vendedor este fuera de secuencia
IF recibo.num_doc != p_num_doc THEN
LET numero_msg = 155
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
DISPLAY BY NAME recibo.num_doc ATTRIBUTE (BOLD)
# Controlando que el numero del recibo este dentro de la secuencia
# del vendedor
SELECT max(sec_de),max(sec_a),max(fecha)
INTO relacion.sec_de,relacion.sec_a,relacion.fecha
FROM cctb00002
WHERE sec_vend = recibo.cod_emp_sec and status_t is null
IF status = notfound THEN
LET numero_msg = 123
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
IF recibo.num_doc < relacion.sec_de OR
recibo.num_doc > relacion.sec_a THEN
LET numero_msg = 125
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
END IF}
AFTER FIELD fecha_orig
IF recibo.fecha_orig IS NULL OR recibo.fecha_orig > TODAY THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_orig
END IF
LET p_fechas = recibo.fecha_orig
CALL prd(p_fechas,usuarios) RETURNING bandera
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 INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3 FROM adtb00003
WHERE num_emp = recibo.cod_emp_sec
LET nombre_emp = descrip2 CLIPPED," ",descrip3
SELECT a.paga_itbis INTO ppaga_itbis
FROM vetb00060 a WHERE a.tipo_cliente = recibo.tipo_cliente
IF ppaga_itbis = 'N' THEN
LET ch_itbis = 'NO'
ELSE
LET ch_itbis = "SI"
END IF
{
IF recibo.tipo_doc = "PG" THEN
IF recibo.cuenta_no is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
END IF
}
CALL arr_recibo.clear()
IF valor_ctrl IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD valor_ctrl
END IF
DISPLAY "APL ",aplicacion_antiguas
IF aplicacion_antiguas = "SI" THEN
CALL aplica_mas_antiguas()
END IF
EXIT INPUT
END INPUT
LABEL arreglo1:
## AQUI SE INTRODUCEN LOS DATOS DEL ARREGLO
INPUT ARRAY arr_recibo WITHOUT DEFAULTS FROM s_recibo.*
BEFORE INPUT
IF recibo.tipo_doc="PG" THEN
LET curr=arr_curr()
LET scr_l = scr_line()
CALL busca_avance() RETURNING arr_recibo[curr].num_nc,arr_recibo[curr].valor_pen,
arr_recibo[curr].cotizacion_no
LET arr_recibo[curr].valor_pag = arr_recibo[curr].valor_pen
DISPLAY arr_recibo[curr].num_nc to s_recibo[scr_l].num_nc
DISPLAY arr_recibo[curr].valor_pen to s_recibo[scr_l].valor_pen
DISPLAY arr_recibo[curr].valor_pag to s_recibo[scr_l].valor_pag
DISPLAY arr_recibo[curr].aplica_a to s_recibo[scr_l].aplica_a
DISPLAY arr_recibo[curr].cotizacion_no to s_recibo[scr_l].cotizacion_no
END IF
## VENTANA PARA BUSCAR LOS DOCUMENTOS
ON ACTION aplicacion
CASE
WHEN INFIELD (aplica_a)
CALL busca_aplicacion()
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 bandera = 0
CALL repetir()
IF bandera = 1 THEN
NEXT FIELD aplica_a
END IF
NEXT FIELD aplica_a
WHEN INFIELD(num_nc)
LET curr = arr_curr()
LET scr_l = scr_line()
CALL busca_avance() RETURNING arr_recibo[curr].num_nc,arr_recibo[curr].valor_pen,
arr_recibo[curr].cotizacion_no
LET arr_recibo[curr].valor_pag = arr_recibo[curr].valor_pen
DISPLAY arr_recibo[curr].num_nc to s_recibo[scr_l].num_nc
DISPLAY arr_recibo[curr].valor_pen to s_recibo[scr_l].valor_pen
DISPLAY arr_recibo[curr].valor_pag to s_recibo[scr_l].valor_pag
DISPLAY arr_recibo[curr].aplica_a to s_recibo[scr_l].aplica_a
DISPLAY arr_recibo[curr].cotizacion_no to s_recibo[scr_l].cotizacion_no
END CASE
BEFORE ROW
LET curr = arr_curr()
LET scr_l = scr_line()
AFTER FIELD num_nc
LET nc_pend = 0
IF recibo.tipo_doc = "AV" THEN
LET arr_recibo[curr].num_nc = NULL
DISPLAY arr_recibo[curr].num_nc TO s_recibo[scr_l].num_nc
END IF
IF arr_recibo[curr].num_nc IS NOT NULL THEN
SELECT UNIQUE num_doc FROM cctb00001 a
WHERE a.tipo_doc = "AV" AND a.status_t IS NULL AND
a.num_doc = arr_recibo[curr].num_nc AND
a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num_nc
END IF
LET valor_nc = 0
SELECT SUM(a.valor+a.monto_desc) INTO valor_nc FROM cctb00001 a
WHERE a.tipo_doc = "AV" AND a.status_t IS NULL AND
a.num_doc = arr_recibo[curr].num_nc AND
a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente
IF valor_nc IS NULL THEN
LET valor_nc = 0
END IF
LET nc_pend = valor_nc
LET arr_recibo[curr].valor_pen = nc_pend
DISPLAY arr_recibo[curr].valor_pen to s_recibo[scr_l].valor_pen
DISPLAY BY NAME nc_pend
END IF
AFTER FIELD aplica_a
IF arr_recibo[curr].num_nc IS NOT NULL THEN
IF arr_recibo[curr].aplica_a IS NULL THEN
CALL fgl_winmessage("ERROR","DEBE COLOCAR EL DOCUMENTO DE FACTURA APLICAR EL AVANCE","INFO")
NEXT FIELD aplica_a
END IF
END IF
IF arr_recibo[curr].aplica_a IS NOT NULL THEN
LET bandera = 0
CALL repetir()
IF bandera = 1 THEN
NEXT FIELD aplica_a
END IF
# Controla que el documento factura pertenezca al cliente
# IF recibo.tipo_doc = "PG" OR recibo.tipo_doc='ND' THEN
SELECT unique a.tipo_cliente FROM cctb00001 a
WHERE a.num_doc = arr_recibo[curr].aplica_a and
a.tipo_cliente = recibo.tipo_cliente and
a.sec_cliente = recibo.sec_cliente and
(a.tipo_doc = arr_recibo[curr].tipo_doc_aplica) and
a.status_t is null
IF status = notfound THEN
LET numero_msg = 126
CALL msg(numero_msg)
NEXT FIELD aplica_a
END IF
# END IF
# busca cotizacion y orden
LET xcotizacion = NULL
LET xorden = NULL
LET condicionPago = NULL
IF arr_recibo[curr].tipo_doc_aplica = 'FT' OR arr_recibo[curr].tipo_doc_aplica ='FE' THEN
SELECT MAX(a.cotizacion_no),MAX(a.orden),MAX(b.descrip) INTO xcotizacion,xorden,condicionPago
FROM vetb00002 a,vetb00012 b
WHERE (a.factura = arr_recibo[curr].aplica_a) AND a.status_t IS NULL AND
a.tipo_cliente = recibo.tipo_cliente AND a.sec_cliente = recibo.sec_cliente
END IF
# Busca el valor pendiente de la factura
IF arr_recibo[curr].num_nc IS NULL THEN
SELECT sum(a.valor+a.monto_desc) INTO valor_fac FROM cctb00001 a
WHERE (a.aplica_a = arr_recibo[curr].aplica_a) and
(a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente) AND
a.tipo_doc NOT IN ('AV','AP') AND
a.status_t is NULL
IF arr_recibo[curr].valor_pag IS NULL THEN
LET arr_recibo[curr].valor_pag=valor_fac
END IF
IF aplicacion_antiguas = "NO" THEN
LET arr_recibo[curr].valor_pen = valor_fac
END IF
ELSE
SELECT sum(a.valor+a.monto_desc) INTO valor_fac FROM cctb00001 a
WHERE (a.aplica_a = arr_recibo[curr].num_nc) AND
(a.tipo_doc IN ('AV','AP')) AND
(a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente) AND a.status_t is null
LET arr_recibo[curr].valor_pen =valor_fac
END IF
DISPLAY arr_recibo[curr].valor_pen to s_recibo[scr_l].valor_pen
END IF
BEFORE FIELD desc_p
IF arr_recibo[curr].num_nc IS NOT NULL THEN
LET arr_recibo[curr].desc_p = 0
NEXT FIELD valor_pag
ELSE
LET arr_recibo[curr].desc_p = 0
IF aplicacion_antiguas = "NO" THEN
LET arr_recibo[curr].valor_pag = arr_recibo[curr].valor_pen
END IF
DISPLAY arr_recibo[curr].valor_pen to s_recibo[scr_l].valor_pen
DISPLAY arr_recibo[curr].desc_p to s_recibo[scr_l].desc_p
END IF
AFTER FIELD desc_p
IF arr_recibo[curr].num_nc IS NOT NULL THEN
LET arr_recibo[curr].desc_p = 0
ELSE
IF arr_recibo[curr].desc_p is null THEN
LET arr_recibo[curr].desc_p = 0
END IF
LET arr_recibo[curr].valor_pag = arr_recibo[curr].valor_pag -
arr_recibo[curr].desc_p
END IF
DISPLAY arr_recibo[curr].valor_pag to s_recibo[scr_l].valor_pag
AFTER FIELD valor_pag
IF arr_recibo[curr].aplica_a IS NULL AND
arr_recibo[curr].num_nc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD aplica_a
END IF
IF arr_recibo[curr].valor_pag IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD aplica_a
END IF
IF recibo.tipo_doc <> 'ND' THEN
IF recibo.tipo_doc <> 'OD' THEN
IF arr_recibo[curr].valor_pen < 0 THEN
CALL fgl_winmessage("INFO","NO PUEDE APLICAR VALOR A ESTE DOCUMENTO, ESTA EN NEGATIVO","INFO")
LET arr_recibo[curr].valor_pag=0
NEXT FIELD aplica_a
END IF
IF arr_recibo[curr].valor_pen > 0 THEN
IF arr_recibo[curr].valor_pag > arr_recibo[curr].valor_pen THEN
CALL fgl_winmessage("INFO","NO PUEDE APLICAR VALOR MAYOR AL VALOR PENDIENTE","INFO")
NEXT FIELD valor_pag
END IF
END IF
END IF
END IF
LET p_total = 0
LET remanente = valor_ctrl
FOR idx = 1 TO arr_count()
IF arr_recibo[idx].valor_pag is not null THEN
IF arr_recibo[idx].num_nc IS NULL THEN
LET p_total = p_total + arr_recibo[idx].valor_pag
LET remanente = remanente - arr_recibo[idx].valor_pag
END IF
END IF
END FOR
IF p_total < 0 THEN
LET p_total = p_total * -1
END IF
if arr_recibo[curr].num_nc is not null then
IF p_total > valor_ctrl THEN
LET numero_msg = 178
CALL msg(numero_msg)
END IF
end if
DISPLAY BY NAME p_total ATTRIBUTE(BOLD)
DISPLAY BY NAME remanente ATTRIBUTE(blue)
# Controla que el valor aplicado a las facturas no exceda el monto del recibo
AFTER 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 arr_recibo.getLength()
IF arr_recibo[idx].num_nc IS NULL THEN
IF arr_recibo[idx].aplica_a IS NOT NULL THEN
# BUSCA VALOR FACTURA
IF arr_recibo[curr].num_nc IS NULL THEN
SELECT sum(a.valor+a.monto_desc) INTO valor_fac FROM cctb00001 a
WHERE (a.aplica_a = arr_recibo[curr].aplica_a) and
(a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente) AND
a.tipo_doc NOT IN ('AV','AP') AND
a.status_t is NULL
IF arr_recibo[curr].valor_pag IS NULL THEN
LET arr_recibo[curr].valor_pag=valor_fac
END IF
IF aplicacion_antiguas = "NO" THEN
LET arr_recibo[curr].valor_pen = valor_fac
END IF
ELSE
SELECT sum(a.valor+a.monto_desc) INTO valor_fac FROM cctb00001 a
WHERE (a.aplica_a = arr_recibo[curr].num_nc) AND
(a.tipo_doc IN ('AV','AP')) AND
(a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente) AND a.status_t is NULL
LET arr_recibo[curr].valor_pen =valor_fac
END IF
IF recibo.tipo_doc <> 'ND' THEN
IF recibo.tipo_doc <> 'OD' THEN
IF arr_recibo[curr].valor_pen < 0 THEN
CALL fgl_winmessage("INFO","NO PUEDE APLICAR VALOR A ESTE DOCUMENTO, ESTA EN NEGATIVO","INFO")
LET arr_recibo[curr].valor_pag=0
NEXT FIELD aplica_a
END IF
END IF
END IF
# ESTA ENCOMENTARIO PORQUE LOS DEBI
# IF recibo.tipo_doc = 'ND' OR recibo.tipo_doc = 'OD' OR recibo.tipo_doc = 'DV' THEN
# IF arr_recibo[idx].valor_pag > valor_fac THEN
# CALL fgl_winmessage("INFO","CON ESTE VALOR EL VALOR PENDIENTE DE LA FACTURA SOBRE VALORA EL MONTO ORIGINAL DE LA FACTURA","INFO")
# NEXT FIELD aplica_a
# END IF
# END IF
IF arr_recibo[idx].valor_pen > 0 THEN
IF arr_recibo[idx].valor_pag > arr_recibo[idx].valor_pen THEN
CALL fgl_winmessage("INFO","NO PUEDE APLICAR VALOR MAYOR AL VALOR PENDIENTE","INFO")
NEXT FIELD valor_pag
END IF
END IF
END IF
END IF
END FOR
END INPUT
LET p_companias.cod_comp = 1
{
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
LET afecta_ex="YES"
IF recibo.tipo_doc = 'OD' OR recibo.tipo_doc = 'OC' THEN
LET afecta_ex = fgl_winquestion("AFECTA","DESEA AFECTAR CXC FISCAL?","YES","YES|NO","QUESTION",0)
END IF
IF recibo.tipo_doc = "ND" THEN
PROMPT "NOTA DE DEBITO ES DEBIDO A CHEQUE DEVUELTO...[S/N]? " FOR CHAR opc
LET opc = UPSHIFT(opc)
IF opc = "S" THEN
SELECT sec_vend INTO recibo.cod_emp_sec
FROM vetb00028
WHERE tipo_cliente = recibo.tipo_cliente and
sec_cliente = recibo.sec_cliente
DISPLAY BY NAME recibo.cod_emp_sec
LET valor_cheque1 = recibo.num_doc
ELSE
LET valor_cheque1 = NULL
END IF
END IF
{ CALL defecto(usuarios,clave,impresor) RETURNING imprime,negrilla_on,negrillas_of,
doble_on,doble_off,comp_on,comp_off,
doce,normal,archivo,copia
START REPORT cctb01 TO archivo
}
SELECT a.ult_recibo INTO p_num_doc FROM cctb00003 a
WHERE a.tipo_doc = recibo.tipo_doc
IF STATUS = NOTFOUND THEN
LET p_num_doc = 0
END IF
LET p_num_doc = p_num_doc + 1
LET recibo.num_doc = p_num_doc
DISPLAY BY NAME recibo.num_doc
# INSERTA EL COMENTARIO
BEGIN WORK
UPDATE cctb00003 set ult_recibo = recibo.num_doc,
us_crea = SUSER_SNAME(),
fech_crea = GETDATE(),
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE tipo_doc = recibo.tipo_doc
INSERT INTO cctb00011(cod_cia,num_doc,tipo_doc,tipo_cliente,sec_cliente,comentario,us_crea,fech_crea,SucID,chitbis,
cod_emp_sec,valor_recibo)
VALUES (p_companias.cod_comp,recibo.num_doc,recibo.tipo_Doc,recibo.tipo_cliente,recibo.sec_cliente,
recibo.comentario,SUSER_SNAME(),GETDATE(),codigo_sucursal,ch_itbis,recibo.cod_emp_sec,
valor_ctrl)
IF SQLSTATE > 02 THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","NO FUE POSIBLE GUARDAR LA TRANSACCION","STOP")
RETURN
END IF
LET avance = FALSE
LET navance = 1
## SI NO OCURRE NINGUN ERROR SE PROCEDE A INSERTAR EL REGISTRO
FOR idx = 1 to arr_count()
IF arr_recibo[idx].aplica_a is not null THEN
IF recibo.tipo_doc = "PG" THEN
IF recibo.cod_emp_sec IS NULL OR recibo.cod_emp_sec = 0 THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","NO TIENE VENDEDOR","STOP")
GOTO arreglo1
END IF
END IF
IF recibo.tipo_doc != "ND" AND recibo.tipo_doc != "DV" THEN
IF recibo.tipo_doc != "FI" THEN
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pag * -1
LET arr_recibo[idx].desc_p = arr_recibo[idx].desc_p * -1
END IF
END IF
# ESTAS INSTRUCCIONES ES PARA ENTRAR LOS AV-AVANCES POR ESTE PROGRAMA
# SUPONGO QUE ESTAS LINEAS SERAN TEMPORALES HASTA QUE LOS AVANCES SE
# INTRODUZCAN POR OTRO MANTENIMIENTO
IF recibo.tipo_doc = "AV" THEN
IF arr_recibo[idx].num_nc IS NOT NULL THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","El Campo de Numero de Avancve Debe Estar En Nulo","STOP")
RETURN
END IF
IF arr_recibo[idx].aplica_a != recibo.num_doc THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR", "Documento Debe Aplicarse a Si Mismo","STOP")
RETURN
END IF
IF arr_recibo[idx].valor_pag < 0 THEN
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pag * - 1
END IF
END IF
#--------------------------------------------------------------------------
LET navance = 1
LET tipo_doc1 = NULL
IF tipo_doc1 = 'PG' THEN
LET navance = 1
END IF
LET numero_doc =arr_recibo[idx].num_nc
IF arr_recibo[idx].num_nc IS NOT NULL THEN
LET tipo_doc1 = "AV"
LET avance = TRUE
LET navance = 0
SELECT a.num_trans INTO avance_e[idx] FROM cctb00020 a WHERE a.num_oc = arr_recibo[idx].num_nc
ELSE
LET numero_doc = recibo.num_doc
# LET arr_recibo[idx].num_nc = recibo.num_doc ASI ERA QUE ESTABA ANTES DEL 3/6/2019
LET tipo_doc1 = recibo.tipo_doc
LET avance = FALSE
LET navance = 1
END IF
IF recibo.tipo_doc = "DV" OR recibo.tipo_doc='OD' THEN
IF arr_recibo[idx].tipo_doc_aplica = 'AV' THEN
LET valor_aplicado = arr_recibo[idx].valor_pag*-1
IF arr_recibo[idx].valor_pag > 0 THEN
LET valor_aplicado = arr_recibo[idx].valor_pag*-1
END IF
SELECT a.num_trans INTO avance_e[idx] FROM cctb00020 a WHERE a.num_oc = arr_recibo[idx].aplica_a
# PARA REAPLICAR LOS AVANCES CUANDO ES POR DEVOLUCION DE DINERO DEL AVANCE ORIGINAL
INSERT INTO cctb00001 (cod_cia,tipo_doc,num_doc,tipo_cliente,sec_cliente,cod_emp,cod_emp_sec,fecha_orig,
fecha_ven,aplica_a,num_cheque,valor,valor_cheque,costo,monto_desc,us_crea,fech_crea,
banco,tipo_doc_aplica,documento_ref,num_oc)
values (p_companias.cod_comp,'AP',
arr_recibo[idx].aplica_a,recibo.tipo_cliente,recibo.sec_cliente,codigo_sucursal,
recibo.cod_emp_sec,recibo.fecha_orig,"010101",arr_recibo[idx].aplica_a,
recibo.num_doc,valor_aplicado,
valor_cheque1,navance,arr_recibo[idx].desc_p,SUSER_SNAME(),GETDATE(),
arr_recibo[idx].cotizacion_no,arr_recibo[idx].tipo_doc_aplica,xcotizacion,xorden)
END IF
IF arr_recibo[idx].valor_pag < 0 THEN
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pag *-1
END IF
END IF
IF recibo.tipo_doc = "ND" THEN
IF arr_recibo[idx].valor_pag < 0 THEN
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pag *-1
END IF
END IF
LET p_companias.cod_comp = 1
INSERT INTO cctb00001 (cod_cia,tipo_doc,num_doc,tipo_cliente,sec_cliente,cod_emp,cod_emp_sec,fecha_orig,
fecha_ven,aplica_a,num_cheque,valor,valor_cheque,costo,monto_desc,us_crea,fech_crea,
banco,tipo_doc_aplica,documento_ref,num_oc)
values (p_companias.cod_comp,tipo_doc1,
numero_doc,recibo.tipo_cliente,recibo.sec_cliente,codigo_sucursal,
recibo.cod_emp_sec,recibo.fecha_orig,"010101",arr_recibo[idx].aplica_a,
recibo.num_doc,arr_recibo[idx].valor_pag,
valor_cheque1,navance,arr_recibo[idx].desc_p,SUSER_SNAME(),GETDATE(),
arr_recibo[idx].cotizacion_no,arr_recibo[idx].tipo_doc_aplica,xcotizacion,xorden)
IF SQLSTATE > 02 THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","NO FUE POSIBLE GUARDAR LA TRANSACCION","STOP")
RETURN
END IF
INSERT INTO cctb00005 (num_doc,tipo_Doc,aplica_a,valor_pagado)
VALUES (recibo.num_doc,recibo.tipo_doc,arr_recibo[idx].aplica_a,arr_recibo[idx].valor_pag)
IF SQLSTATE > 02 THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","NO FUE POSIBLE GUARDAR LA TRANSACCION","STOP")
RETURN
END IF
{ IF tipo_doc1 = "ND" THEN
UPDATE cctb00001 set valor_cheque = numero_recibo
WHERE num_doc = recibo.num_doc AND
tipo_doc = "ND"
END IF
INSERT INTO cctb00001 values (recibo.cuenta_no,null,tipo_doc1,
arr_recibo[idx].num_nc,recibo.tipo_cliente,recibo.sec_cliente,null,
recibo.cod_emp_sec,recibo.fecha_orig,null,arr_recibo[idx].aplica_a,
recibo.deposito,recibo.num_doc,arr_recibo[idx].valor_pag,null,
valor_cheque1,null,arr_recibo[idx].desc_p,null,SUSER_SNAME(),GETDATE(),null,null)
}
#IF avance = FALSE THEN
#OUTPUT TO REPORT cctb01(recibo.tipo_cliente,
# recibo.sec_cliente,recibo.fecha_orig,recibo.num_doc,
# recibo.cod_emp_sec,tipo_doc1,null,null,
# arr_recibo[idx].aplica_a,arr_recibo[idx].desc_p,arr_recibo[idx].valor_pag,
# nom_cli,nombre_emp,nombre_cta,recibo.comentario)
# END IF
END IF
END FOR
LET r_filename = "ccprmt001a.4rp"
LET r_output = "SVG"
LET preview = 1
-- configure report engine; the functions prefixed fgl that are called here are part of the GRW API
IF fgl_report_loadCurrentSettings(r_filename) THEN -- load the .4rp file
CALL fgl_report_selectDevice(r_output) -- changing default
IF preview = 0 THEN
CALL fgl_report_selectPreview(1) -- changing default
# CALL fgl_report_configureSVGPreview("PrintOnDefaultPrinter")
ELSE
CALL fgl_report_selectPreview(preview)
END if
LET handler = fgl_report_commitCurrentSettings() -- commit changes
ELSE
EXIT PROGRAM
END IF
--run the report
IF handler IS NOT NULL THEN -- report engine was configured ok
START REPORT cctb01b TO XML HANDLER HANDLER
FOR idx = 1 TO arr_recibo.getLength()
IF arr_recibo[idx].num_nc IS NULL THEN
IF arr_recibo[idx].valor_pag IS NOT NULL THEN
OUTPUT TO REPORT cctb01b(recibo.tipo_cliente,
recibo.sec_cliente,recibo.fecha_orig,recibo.num_doc,
recibo.cod_emp_sec,recibo.tipo_doc,null,null,
arr_recibo[idx].aplica_a,arr_recibo[idx].desc_p,arr_recibo[idx].valor_pag,
nom_cli,nombre_emp,nombre_cta,recibo.comentario)
END IF
END IF
END FOR
FINISH REPORT cctb01b
END IF
# FINISH REPORT cctb01
# RUN imprime
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
COMMIT WORK
# ACTUALIZA OTRA DB
IF afecta_ex = "YES" THEN
SET CONNECTION "IFMX"
LET encontre_factura = 'S'
IF recibo.tipo_doc = 'PG' THEN
LET recibo.tipo_doc = 'RC'
END IF
SELECT a.ult_recibo INTO p_num_doc FROM cctb00003 a
WHERE a.tipo_doc = recibo.tipo_doc
IF STATUS = NOTFOUND THEN
LET p_num_doc = 0
END IF
LET p_num_doc = p_num_doc + 1
LET recibo.num_doc = p_num_doc
DISPLAY BY NAME recibo.num_doc
# INSERTA EL COMENTARIO
BEGIN WORK
UPDATE cctb00003 set ult_recibo = recibo.num_doc,
us_crea = SUSER_SNAME(),
fech_crea = GETDATE(),
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE tipo_doc = recibo.tipo_doc
INSERT INTO cctb00011(cod_cia,num_doc,tipo_doc,tipo_cliente,sec_cliente,comentario,us_crea,fech_crea,SucID,
cod_emp_sec,valor_recibo)
VALUES (p_companias.cod_comp,recibo.num_doc,recibo.tipo_Doc,recibo.tipo_cliente,recibo.sec_cliente,
recibo.comentario,SUSER_SNAME(),GETDATE(),codigo_sucursal,recibo.cod_emp_sec,
valor_ctrl)
IF SQLSTATE > 02 THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","NO FUE POSIBLE GUARDAR LA TRANSACCION","STOP")
RETURN
END IF
LET avance = FALSE
LET navance = 1
## SI NO OCURRE NINGUN ERROR SE PROCEDE A INSERTAR EL REGISTRO
FOR idx = 1 to arr_count()
IF arr_recibo[idx].aplica_a is not null THEN
IF recibo.tipo_doc = "RC" THEN
IF recibo.cod_emp_sec IS NULL OR recibo.cod_emp_sec = 0 THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","NO TIENE VENDEDOR","STOP")
GOTO arreglo1
END IF
END IF
IF recibo.tipo_doc != "ND" AND recibo.tipo_doc != "DV" THEN
IF recibo.tipo_doc != "FI" THEN
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pag * -1
LET arr_recibo[idx].desc_p = arr_recibo[idx].desc_p * -1
END IF
END IF
# ESTAS INSTRUCCIONES ES PARA ENTRAR LOS AV-AVANCES POR ESTE PROGRAMA
# SUPONGO QUE ESTAS LINEAS SERAN TEMPORALES HASTA QUE LOS AVANCES SE
# INTRODUZCAN POR OTRO MANTENIMIENTO
IF recibo.tipo_doc = "AV" THEN
IF arr_recibo[idx].num_nc IS NOT NULL THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","El Campo de Numero de Avancve Debe Estar En Nulo","STOP")
RETURN
END IF
IF arr_recibo[idx].aplica_a != recibo.num_doc THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR", "Documento Debe Aplicarse a Si Mismo","STOP")
RETURN
END IF
IF arr_recibo[idx].valor_pag < 0 THEN
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pag * - 1
END IF
END IF
#--------------------------------------------------------------------------
LET navance = 1
LET tipo_doc1 = NULL
IF tipo_doc1 = 'RC' THEN
LET navance = 1
END IF
IF arr_recibo[idx].num_nc IS NOT NULL THEN
LET tipo_doc1 = "AV"
LET avance = TRUE
LET navance = 0
ELSE
LET arr_recibo[idx].num_nc = recibo.num_doc
LET tipo_doc1 = recibo.tipo_doc
LET avance = FALSE
LET navance = 1
END IF
# DEVOLUCION DINERO
IF recibo.tipo_doc = "DV" THEN
IF arr_recibo[idx].tipo_doc_aplica = 'AV' THEN
LET valor_aplicado = arr_recibo[idx].valor_pag*-1
IF arr_recibo[idx].valor_pag > 0 THEN
LET valor_aplicado = arr_recibo[idx].valor_pag*-1
END IF
# PARA REAPLICAR LOS AVANCES CUANDO ES POR DEVOLUCION DE DINERO DEL AVANCE ORIGINAL
INSERT INTO cctb00001 (cod_cia,tipo_doc,num_doc,tipo_cliente,sec_cliente,cod_emp,cod_emp_sec,fecha_orig,
fecha_ven,aplica_a,num_cheque,valor,valor_cheque,costo,monto_desc,us_crea,fech_crea,
banco,tipo_doc_aplica,documento_ref,num_oc)
values (p_companias.cod_comp,'AP',
avance_e[idx],recibo.tipo_cliente,recibo.sec_cliente,codigo_sucursal,
recibo.cod_emp_sec,recibo.fecha_orig,"010101",avance_e[idx],
recibo.num_doc,valor_aplicado,
valor_cheque1,avance_e[idx],arr_recibo[idx].desc_p,SUSER_SNAME(),GETDATE(),
arr_recibo[idx].cotizacion_no,arr_recibo[idx].tipo_doc_aplica,xcotizacion,xorden)
END IF
IF arr_recibo[idx].valor_pag < 0 THEN
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pag *-1
END IF
END IF
IF recibo.tipo_doc = "ND" THEN
IF arr_recibo[idx].valor_pag < 0 THEN
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pag *-1
END IF
END IF
LET p_companias.cod_comp = 1
LET xfactura_ext = NULL
IF arr_recibo[idx].tipo_doc_aplica = 'AV' THEN
SELECT DISTINCT a.num_doc FROM cctb00001 a
WHERE a.tipo_doc = arr_recibo[idx].tipo_doc_aplica AND
a.num_doc = avance_e[idx] AND a.num_doc = a.aplica_a AND a.status_t IS NULL
IF STATUS = NOTFOUND THEN
ROLLBACK WORK
END IF
END IF
IF arr_recibo[idx].tipo_doc_aplica = 'FT' OR arr_recibo[idx].tipo_doc_aplica = 'FE' THEN
SELECT a.factura,a.orden INTO xfactura_ext,xorden FROM vetb00002 a
WHERE a.tipo_cliente = recibo.tipo_cliente AND a.sec_cliente = recibo.sec_cliente AND
a.factura_c = arr_recibo[idx].aplica_a AND a.status_t IS NULL
IF STATUS = NOTFOUND THEN
ROLLBACK WORK
LET encontre_factura = 'N'
EXIT FOR
END IF
LET xcotizacion = NULL
SELECT a.cotizacion_no INTO xcotizacion FROM prtb00012 a WHERE a.num_oc = xorden
END IF
IF tipo_Doc1 = 'RC' AND arr_recibo[idx].valor_pag > 0 THEN
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pag * -1
END IF
IF tipo_Doc1 = 'OC' AND arr_recibo[idx].valor_pag > 0 THEN
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pag * -1
END IF
SELECT a.factura INTO avance_e[idx] FROM vetb00002 a WHERE a.factura_c = arr_recibo[idx].aplica_a AND
a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente AND
a.status_t IS NULL
IF STATUS = NOTFOUND THEN
ROLLBACK WORK
CONTINUE FOR
END IF
INSERT INTO cctb00001 (cod_cia,tipo_doc,num_doc,tipo_cliente,sec_cliente,cod_emp,cod_emp_sec,fecha_orig,
fecha_ven,aplica_a,num_cheque,valor,valor_cheque,costo,monto_desc,us_crea,fech_crea,
banco,tipo_doc_aplica,documento_ref,num_oc)
values (p_companias.cod_comp,tipo_doc1,
arr_recibo[idx].num_nc,recibo.tipo_cliente,recibo.sec_cliente,codigo_sucursal,
recibo.cod_emp_sec,recibo.fecha_orig,"010101",xfactura_ext,
recibo.num_doc,arr_recibo[idx].valor_pag,
valor_cheque1,avance_e[idx],arr_recibo[idx].desc_p,SUSER_SNAME(),GETDATE(),
arr_recibo[idx].cotizacion_no,arr_recibo[idx].tipo_doc_aplica,xcotizacion,xorden)
IF SQLSTATE > 02 THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","NO FUE POSIBLE GUARDAR LA TRANSACCION","STOP")
RETURN
END IF
END IF
END FOR
IF encontre_factura = 'S' THEN
COMMIT WORK
END IF
END if
LET numero_msg = 1
CALL msg(numero_msg)
LET emp = recibo.cod_emp_sec
CLEAR FORM
LET INT_FLAG = FALSE
SET CONNECTION "MSSQL"
GOTO volver
END FUNCTION
## Funcion para consultar/modificar un recibo de pago
FUNCTION ccpcmf001()
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 b.tipo_doc,b.num_doc,b.tipo_cliente,
b.sec_cliente, b.cod_emp_sec,b.fecha_orig
FROM tipo_doc,num_doc,tipo_cliente,sec_cliente,cod_emp_sec,
fecha_orig
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
LET selec =
"SELECT b.tipo_doc,b.num_doc,b.tipo_cliente, ",
" b.sec_cliente,a.cod_emp_sec,a.fecha_orig,b.comentario,b.chitbis,a.cod_emp_sec,b.valor_recibo ",
"FROM cctb00011 b,cctb00001 a ",
"WHERE ",criterio clipped," AND ",
" a.num_cheque = b.num_doc AND ",
" b.tipo_Doc = a.tipo_Doc AND ",
" a.cod_emp = b.sucid AND ",
" a.status_t is null ORDER BY b.tipo_Doc,b.num_doc "
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO recibo.*,ch_itbis,recibo.cod_emp_sec,valor_ctrl
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
CALL datos_doc()
MENU "OPCION"
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO recibo.*,ch_itbis,recibo.cod_emp_sec,valor_ctrl
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL datos_doc()
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO recibo.*,ch_itbis,recibo.cod_emp_sec,valor_ctrl
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL datos_doc()
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO recibo.*,ch_itbis,recibo.cod_emp_sec,valor_ctrl
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL datos_doc()
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO recibo.*,ch_itbis,recibo.cod_emp_sec,valor_ctrl
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL datos_doc()
{ COMMAND KEY("I") "re-Imprimir"
CALL defecto(usuarios,clave,impresor) RETURNING imprime,negrilla_on,negrillas_of,
doble_on,doble_off,comp_on,comp_off,
doce,normal,archivo,copia
START REPORT cctb01 TO archivo
IF recibo.tipo_doc = "PG" THEN
LET selec =
"SELECT a.num_doc,a.aplica_a,a.valor,a.monto_desc,a.valor ",
"FROM cctb00001 a ",
"WHERE ((a.tipo_doc = ? OR a.tipo_doc = 'AV') AND ",
" a.num_cheque = ?) AND (a.tipo_cliente = ? AND ",
" a.sec_cliente = ?) ORDER BY 2,1 "
ELSE
LET selec =
"SELECT num_doc,aplica_a,valor,monto_desc,valor FROM cctb00001 ",
"WHERE (tipo_doc=? AND num_cheque=?)AND (tipo_cliente = ? AND ",
" sec_cliente = ?) ORDER BY 2,1 "
END IF
PREPARE comando1 FROM selec
DECLARE buscar11 CURSOR FOR comando1
OPEN buscar11 USING recibo.tipo_doc,recibo.num_doc,recibo.tipo_cliente,
recibo.sec_cliente
LET idx = 1
WHILE STATUS != NOTFOUND
FETCH buscar11 INTO arr_recibo[idx].*
IF STATUS = NOTFOUND THEN
EXIT WHILE
END IF
IF arr_recibo[idx].num_nc = recibo.num_doc THEN
LET arr_recibo[idx].num_nc = NULL
END IF
IF recibo.tipo_doc != "ND" AND recibo.tipo_doc != "OD" THEN
LET arr_recibo[idx].valor_pen = arr_recibo[idx].valor_pen * -1
ELSE
IF arr_recibo[idx].valor_pen < 0 THEN
LET arr_recibo[idx].valor_pen = arr_recibo[idx].valor_pen *-1
END IF
END IF
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pen
LET arr_recibo[idx].valor_pen = 0
LET arr_recibo[idx].desc_p = arr_recibo[idx].desc_p * -1
OUTPUT TO REPORT cctb01(recibo.tipo_cliente,
recibo.sec_cliente,recibo.fecha_orig,recibo.num_doc,
recibo.cod_emp_sec,recibo.tipo_doc,null,null,
arr_recibo[idx].aplica_a,arr_recibo[idx].desc_p,arr_recibo[idx].valor_pag,
nom_cli,nombre_emp,nombre_cta,recibo.comentario)
LET idx = idx + 1
END WHILE
FINISH REPORT cctb01
RUN imprime
COMMAND "Escoger"
INPUT BY NAME recibo.tipo_cliente,
recibo.sec_cliente,recibo.cod_emp_sec,valor_ctrl,
recibo.comentario,ch_itbis
WITHOUT DEFAULTS
## CHEQUEA QUE EL CLIENTE EXISTA, SI EXISTE DESPLEGA SU NOMBRE
AFTER FIELD tipo_cliente
IF recibo.tipo_cliente IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo_cliente
END IF
# Controla que el TIPO DE MOVIMIENTO FI solo sea a tipo clientes 13
IF recibo.tipo_doc = "FI" AND recibo.tipo_cliente = 12 THEN
LET numero_msg = 240
CALL msg(numero_msg)
NEXT FIELD tipo_cliente
END IF
AFTER FIELD sec_cliente
IF recibo.sec_cliente IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD sec_cliente
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
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD tipo_cliente
END IF
DISPLAY BY NAME nom_cli ATTRIBUTE (BOLD)
AFTER FIELD cod_emp_sec
IF recibo.cod_emp_sec IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_emp_sec
END IF
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3 FROM adtb00003
WHERE num_emp = recibo.cod_emp_sec
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_emp_sec
END IF
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
DISPLAY BY NAME nombre_emp ATTRIBUTE (BOLD)
IF recibo.tipo_doc = "ND" THEN
SELECT sec_vend FROM vetb00028
WHERE tipo_cliente = recibo.tipo_cliente and
sec_cliente = recibo.sec_cliente
IF status != notfound THEN
LET numero_msg = 357
CALL msg(numero_msg)
END IF
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
IF recibo.tipo_doc = "PG" THEN
LET selec =
"SELECT a.num_doc,a.aplica_a,a.valor,a.monto_desc,a.valor ",
"FROM cctb00001 a ",
"WHERE ((a.tipo_doc = ? OR a.tipo_doc = 'AV') AND ",
" a.num_cheque = ?) AND (a.tipo_cliente = ? AND ",
" a.sec_cliente = ?) ORDER BY 2,1 "
ELSE
LET selec =
"SELECT num_doc,aplica_a,valor,monto_desc,valor FROM cctb00001 ",
"WHERE (tipo_doc=? AND num_cheque=?)AND (tipo_cliente = ? AND ",
" sec_cliente = ?) ORDER BY 2,1 "
END IF
PREPARE comando FROM selec
DECLARE buscar1 CURSOR FOR comando
OPEN buscar1 USING recibo.tipo_doc,recibo.num_doc,recibo.tipo_cliente,
recibo.sec_cliente
LET idx = 1
WHILE STATUS != NOTFOUND
FETCH buscar1 INTO arr_recibo[idx].*
IF STATUS = NOTFOUND THEN
EXIT WHILE
END IF
IF arr_recibo[idx].num_nc = recibo.num_doc THEN
LET arr_recibo[idx].num_nc = null
END IF
IF recibo.tipo_doc != "ND" AND recibo.tipo_doc != "OD" THEN
LET arr_recibo[idx].valor_pen = arr_recibo[idx].valor_pen * -1
ELSE
IF arr_recibo[idx].valor_pen < 0 THEN
LET arr_recibo[idx].valor_pen = arr_recibo[idx].valor_pen *-1
END IF
END IF
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pen
LET arr_recibo[idx].valor_pen = 0
LET arr_recibo[idx].desc_p = arr_recibo[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_recibo[idx].aplica_a and
status_t is null AND num_cheque = recibo.num_doc
LET arr_recibo[idx].valor_pen = valor2
LET idx = idx + 1
END WHILE
CALL set_count(idx - 1)
LABEL arreglo2:
## AQUI SE MODIFICAN/ACTUALIZAN LOS CAMPOS DEL ARREGLO
INPUT ARRAY arr_recibo WITHOUT DEFAULTS FROM s_recibo.*
## 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_aplicacion()
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 bandera = 0
CALL repetir()
IF bandera = 1 THEN
NEXT FIELD aplica_a
END IF
NEXT FIELD aplica_a
END CASE
BEFORE ROW
LET curr = arr_curr()
LET scr_l = scr_line()
AFTER FIELD num_nc
LET nc_pend = 0
IF recibo.tipo_doc = "AV" THEN
LET arr_recibo[curr].num_nc = NULL
DISPLAY arr_recibo[curr].num_nc TO s_recibo[scr_l].num_nc
END IF
IF arr_recibo[curr].num_nc IS NOT NULL THEN
SELECT UNIQUE num_doc FROM cctb00001 a
WHERE a.tipo_doc = "AV" AND a.status_t IS NULL AND
a.num_doc = arr_recibo[curr].num_nc AND
a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num_nc
END IF
LET valor_nc = 0
SELECT SUM(a.valor+a.monto_desc) INTO valor_nc FROM cctb00001 a
WHERE a.tipo_doc = "AV" AND a.status_t IS NULL AND
a.num_doc = arr_recibo[curr].num_nc AND
a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente
IF valor_nc IS NULL THEN
LET valor_nc = 0
END IF
END IF
AFTER FIELD aplica_a
IF arr_recibo[curr].aplica_a IS NOT NULL THEN
LET bandera = 0
CALL repetir()
IF bandera = 1 THEN
NEXT FIELD aplica_a
END IF
IF recibo.tipo_doc = "AV" THEN
IF recibo.num_doc != arr_recibo[curr].aplica_a THEN
ERROR "Si Es Un Avance Debe Aplicarse a Si Mismo"
NEXT FIELD aplica_a
END IF
END IF
#IF recibo.tipo_doc != "AV" AND
# arr_recibo[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 recibo.tipo_doc = "PG" THEN
SELECT unique tipo_cliente FROM cctb00001
WHERE num_doc = arr_recibo[curr].aplica_a and
tipo_cliente = recibo.tipo_cliente and
sec_cliente = recibo.sec_cliente and
(tipo_doc IN ("FT","FE","FI","ND")) 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
# Busca el valor pendiente de la factura
IF arr_recibo[curr].num_nc IS NULL THEN
SELECT sum(a.valor+a.monto_desc) INTO valor_fac
FROM cctb00001 a
WHERE a.aplica_a=arr_recibo[curr].aplica_a and
a.status_t is null AND
a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente
LET arr_recibo[curr].valor_pen = valor_fac
ELSE
LET arr_recibo[curr].valor_pen = 0
END IF
DISPLAY arr_recibo[curr].valor_pen to s_recibo[scr_l].valor_pen
DISPLAY arr_recibo[curr].valor_pen to s_recibo[scr_l].valor_pen
END IF
BEFORE FIELD desc_p
IF arr_recibo[curr].num_nc IS NOT NULL THEN
LET arr_recibo[curr].desc_p = 0
NEXT FIELD valor_pag
END IF
IF arr_recibo[curr].desc_p IS NULL THEN
LET arr_recibo[curr].desc_p = 0
END IF
DISPLAY arr_recibo[curr].desc_p to s_recibo[scr_l].desc_p
AFTER FIELD desc_p
IF arr_recibo[curr].num_nc IS NOT NULL THEN
LET arr_recibo[curr].desc_p = 0
ELSE
IF arr_recibo[curr].desc_p is null THEN
LET arr_recibo[curr].desc_p = 0
END IF
END IF
AFTER FIELD valor_pag
IF arr_recibo[curr].aplica_a IS NULL AND
arr_recibo[curr].num_nc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD aplica_a
END IF
IF arr_recibo[curr].valor_pag IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD valor_pag
END IF
LET remanente = valor_ctrl
LET p_total = 0
FOR idx = 1 TO arr_count()
IF arr_recibo[idx].valor_pag is not null THEN
IF arr_recibo[idx].num_nc IS NULL THEN
LET p_total = p_total - arr_recibo[idx].valor_pag
END IF
END IF
END FOR
IF p_total < 0 THEN
LET p_total = p_total * -1
END IF
DISPLAY BY NAME remanente ATTRIBUTE(blue)
IF p_total != valor_ctrl THEN
LET numero_msg = 178
CALL msg(numero_msg)
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
LET opc = NULL
LET valor_cheque1 = NULL
IF recibo.tipo_doc = "ND" THEN
PROMPT "NOTA DE DEBITO ES DEBIDO A CHEQUE DEVUELTO...[S/N]? " FOR CHAR opc
LET opc = UPSHIFT(opc)
IF opc = "S" THEN
LET valor_cheque1 = recibo.num_doc
ELSE
LET valor_cheque1 = NULL
END IF
END IF
## AQUI SE REALIZA LA MODIFICACION DEL REGISTRO
IF recibo.tipo_doc = "PG" THEN
BEGIN WORK
DELETE FROM cctb00001 WHERE num_cheque= recibo.num_doc and
tipo_doc IN ("PG","AV") AND valor < 0 AND fecha_orig = recibo.fecha_orig
IF SQLSTATE > 02 THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","NO FUE POSIBLE GUARDAR LA TRANSACCION","STOP")
RETURN
END IF
ELSE
IF recibo.tipo_doc = "ND" THEN
SELECT unique a.valor_cheque INTO valor_cheque1
FROM cctb00001 a
WHERE a.num_doc = recibo.num_doc AND
a.tipo_doc = "ND"
END IF
BEGIN WORK
UPDATE cctb00011 SET comentario = recibo.comentario,
cod_emp_Sec = recibo.cod_emp_sec,
valor_recibo = valor_ctrl,
fecha_orig = recibo.fecha_orig,
cctb00011.chitis = chitbis,
us_mod = usuarios,
fech_mod = getdate()
WHERE num_doc = recibo.num_doc AND tipo_doc = recibo.tipo_doc
DELETE FROM cctb00005 WHERE num_Doc = recibo.num_doc AND tipo_Doc = recibo.tipo_doc
IF SQLSTATE > 02 THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","NO FUE POSIBLE GUARDAR LA TRANSACCION","STOP")
RETURN
END IF
DELETE FROM cctb00001 WHERE cctb00001.num_doc= recibo.num_doc and
cctb00001.tipo_doc = recibo.tipo_doc and CONVERT (CHAR(10),fech_crea,101) > '01/01/2009'
IF SQLSTATE > 02 THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","NO FUE POSIBLE GUARDAR LA TRANSACCION","STOP")
RETURN
END IF
END IF
CALL defecto(usuarios,clave,impresor) RETURNING imprime,negrilla_on,negrillas_of,
doble_on,doble_off,comp_on,comp_off,
doce,normal,archivo,copia
START REPORT cctb01 TO archivo
LET avance = FALSE
FOR idx = 1 to arr_count()
IF arr_recibo[idx].aplica_a is not null OR
arr_recibo[idx].num_nc is not null THEN
IF recibo.tipo_doc != "ND" AND recibo.tipo_doc != "OD" THEN
IF recibo.tipo_doc != "FI" THEN
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pag * -1
LET arr_recibo[idx].desc_p = arr_recibo[idx].desc_p * -1
END IF
END IF
LET tipo_doc1 = NULL
LET navance = 1
IF arr_recibo[idx].num_nc IS NOT NULL THEN
LET tipo_doc1 = "AV"
LET avance = TRUE
LET navance = 1
ELSE
LET arr_recibo[idx].num_nc = recibo.num_doc
LET tipo_doc1 = recibo.tipo_doc
LET avance = FALSE
LET navance = 0
END IF
IF recibo.tipo_doc = "DV" THEN
IF arr_recibo[idx].valor_pag < 0 THEN
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pag *-1
END IF
END IF
IF recibo.tipo_doc = "ND" THEN
IF arr_recibo[idx].valor_pag < 0 THEN
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pag *-1
END IF
END IF
IF avance = FALSE THEN # CONTROL AVANCE
INSERT INTO cctb00001
VALUES (p_companias.cod_comp,null,tipo_doc1,arr_recibo[idx].num_nc,
recibo.tipo_cliente,recibo.sec_cliente,codigo_sucursal,recibo.cod_emp_sec,
recibo.fecha_orig,"010101",arr_recibo[idx].aplica_a,null,
recibo.num_doc,arr_recibo[idx].valor_pag,null,valor_cheque1,navance,
arr_recibo[idx].desc_p,null,SUSER_SNAME(),GETDATE(),null,null,NULL)
IF SQLSTATE > 02 THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","NO FUE POSIBLE GUARDAR LA TRANSACCION","STOP")
RETURN
END IF
OUTPUT TO REPORT cctb01(recibo.tipo_cliente,
recibo.sec_cliente,recibo.fecha_orig,recibo.num_doc,
recibo.cod_emp_sec,tipo_doc1,null,null,
arr_recibo[idx].aplica_a,arr_recibo[idx].desc_p,arr_recibo[idx].valor_pag,
nom_cli,nombre_emp,nombre_cta,recibo.comentario)
END IF # IF DEL AVANCE
END IF
END FOR
COMMIT WORK
FINISH REPORT cctb01
RUN imprime
COMMIT WORK
LET numero_msg = 13
CALL msg(numero_msg)
}
COMMAND KEY ("N") "aNular"
## AQUI SE REALIZA LA ANULACION DE UN REGISTRO
LET p_fechas = recibo.fecha_orig
CALL prd(p_fechas,usuarios) RETURNING bandera
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET respuesta = fgl_winquestion("INFO","ESTA SEGURO DE QUERER ANULAR ESTE DOCUMENTO?","NO","NO|YES","question",0)
IF UPSHIFT(respuesta) = "YES" THEN
IF recibo.tipo_doc = "PG" THEN
UPDATE cctb00001 set status_t = "E", us_mod = SUSER_SNAME(), fech_mod = GETDATE()
WHERE tipo_doc IN ("AV","PG") and num_cheque = recibo.num_doc AND
tipo_cliente = recibo.tipo_cliente AND sec_cliente = recibo.sec_cliente
ELSE
UPDATE cctb00001 set status_t = "E", us_mod = SUSER_SNAME(), fech_mod = GETDATE()
WHERE tipo_doc = recibo.tipo_doc and num_cheque = recibo.num_doc
END IF
LET numero_msg = 82
CALL msg(numero_msg)
END IF
COMMAND "Retornar"
CLEAR FORM
FOR idx = 1 to 3
LET arr_recibo[idx].aplica_a = null
LET arr_recibo[idx].valor_pen = null
LET arr_recibo[idx].valor_pag = null
DISPLAY arr_recibo[idx].aplica_a to s_recibo[idx].aplica_a
DISPLAY arr_recibo[idx].valor_pen to s_recibo[idx].valor_pen
DISPLAY arr_recibo[idx].valor_pag to s_recibo[idx].valor_pag
END FOR
EXIT MENU
END MENU
END FUNCTION
FUNCTION busca_aplicacion()
OPEN WINDOW busqueda1 AT 10,10 WITH FORM "ccfmwd001"
ATTRIBUTE (BORDER,FORM LINE FIRST + 1, comment line last)
CALL ui.Interface.LoadStyles("mbsStyle")
DECLARE aplicar CURSOR FOR
SELECT a.aplica_a,SUM(a.valor+a.monto_desc),b.fecha_factura,b.cotizacion_no,b.orden
FROM cctb00001 a,vetb00002 b
WHERE (a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente AND
a.tipo_cliente = b.tipo_cliente AND
a.sec_cliente = b.sec_cliente) AND
(a.tipo_doc NOT IN ('AV','AP') AND a.aplica_a=b.factura) AND a.status_t is null
GROUP BY b.fecha_factura,a.aplica_a,b.cotizacion_no,b.orden
HAVING SUM(a.valor+a.monto_desc) > 0
ORDER BY b.fecha_factura
LET existe = "N"
LET idx = 1
FOREACH aplicar INTO aplica_wd[idx].aplica_a,aplica_wd[idx].pendiente,aplica_wd[idx].fecha, aplica_wd[idx].cotizacion_no,
aplica_wd[idx].num_oc
IF status = NOTFOUND THEN
LET existe = "N"
EXIT FOREACH
END IF
CALL integridad()
# Busca el tipo de movimiento
SELECT MAX(a.tipo_doc) INTO tipo_doc2
FROM cctb00001 a
WHERE (a.tipo_cliente = recibo.tipo_cliente and
a.sec_cliente = recibo.sec_cliente and a.tipo_doc NOT IN ("PG","AV") and
a.num_doc = aplica_wd[idx].aplica_a) and a.status_t is null
IF status < 0 THEN
CALL integridad()
LET tipo_doc2 = "SQ"
END IF
LET aplica_wd[idx].tipo_doc = tipo_doc2
# Busca ordes y cotizacion de la factura
IF tipo_Doc2 = 'FT' OR tipo_Doc2 = 'FE' THEN
SELECT a.orden,a.cotizacion_no,a.factura_ext,CONVERT(CHAR(10),a.fecha_factura,103)
INTO aplica_wd[idx].num_oc,aplica_wd[idx].cotizacion_no,aplica_wd[idx].factura_e,
aplica_wd[idx].fecha
FROM vetb00002 a
WHERE a.tipo_cliente = recibo.tipo_cliente AND a.sec_cliente = recibo.sec_cliente AND
a.factura = aplica_wd[idx].aplica_a
END IF
# Busca Nota de credito
LET valor_ctrl1 = 0
IF tipo_doc2 = "AV" THEN
LET aplica_wd[idx].cotizacion_no = null
SELECT MAX(a.banco) INTO aplica_wd[idx].cotizacion_no FROM cctb00001 a
WHERE a.num_doc = aplica_wd[idx].num_oc AND a.num_doc = a.aplica_a
SELECT SUM(a.valor*-1) INTO valor_ctrl1 FROM cctb00001 a
WHERE (a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente AND
a.num_doc = aplica_wd[idx].aplica_a AND a.tipo_doc = "AV" AND
a.num_doc != a.aplica_a) AND a.status_t IS NULL
IF valor_ctrl1 is null THEN
LET valor_ctrl1 = 0
END IF
LET aplica_wd[idx].pendiente = aplica_wd[idx].pendiente - valor_ctrl1
END IF
LET existe = "S"
IF aplica_wd[idx].pendiente != 0 THEN
LET idx = idx + 1
END IF
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 INT_FLAG = false
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 repetir()
DEFINE ant_art RECORD
num_nc INTEGER,
aplica_a INTEGER,
valor_pag DECIMAL(12,2)
END RECORD
LET ant_art.num_nc = arr_recibo[curr].num_nc
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].num_nc = ant_art.num_nc AND
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 bandera = 1
ELSE
IF bandera != 1 THEN
LET bandera = 0
END IF
END IF
END IF
END IF
END FOR
END FUNCTION
{
FUNCTION consulta_clientes()
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
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GO TO salir_consulta_c
END IF
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 "
PREPARE busca_clientes FROM selec2
DECLARE buscar_clientes CURSOR FOR busca_clientes
LET idx = 1
FOREACH buscar_clientes INTO arr_clientes[idx].*
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 anular()
OPEN WINDOW anula AT 7,5 WITH FORM "vefmwd006" ATTRIBUTE (BORDER,
COMMENT LINE LAST - 1,PROMPT LINE LAST,FORM LINE FIRST + 1)
LABEL vuelve:
INPUT BY NAME p_fact_no
AFTER FIELD p_fact_no
SELECT UNIQUE fecha_factura,orden,tipo_cliente,sec_cliente,neto
INTO fact_gral.fecha_factura,fact_gral.orden,fact_gral.tipo_cliente,
fact_gral.sec_cliente,fact_gral.total_fact
FROM vetb00002
WHERE factura = p_fact_no AND status_t IS NULL AND
fech_crea > datetime (1994-03-31 08:00) year to minute
IF STATUS = NOTFOUND THEN
LET numero_msg = 102
CALL msg(numero_msg)
NEXT FIELD p_fact_no
END IF
SELECT a.nombre
INTO fact_gral.nombre
FROM vetb00004 a
WHERE a.tipo_cliente = fact_gral.tipo_cliente AND
a.sec_cliente = fact_gral.sec_cliente
DISPLAY BY NAME fact_gral.tipo_cliente,fact_gral.sec_cliente,
fact_gral.total_fact,fact_gral.nombre ATTRIBUTE(blue)
IF fact_gral.fecha_factura < "310394" THEN
LET numero_msg = 58
CALL msg(numero_msg)
GOTO salir
END IF
LET p_fechas = fact_gral.fecha_factura
IF fact_gral.fecha_factura != TODAY THEN
ERROR "NO PUEDE ANULAR FACTURA QUE NO SEAN DEL DIA DE HOY"
RETURN
END IF
CALL prd()
IF bandera =1 THEN
SLEEP 2
EXIT INPUT
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
EXIT INPUT
END IF
EXIT INPUT
END INPUT
IF bandera = 1 THEN
LET bandera = 0
GOTO salir
END IF
# Este Int_flag es porque tuve que salir del input con el int_flag verdadero
# y asi poder salir del window sin problemas
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
GOTO salir
END IF
LABEL atras:
PROMPT "Esta seguro de Anular Esta Factura? (S/N)" FOR CHAR opt3
LET opt3 = UPSHIFT(opt3)
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
GOTO salir
END IF
IF opt3 != "S" AND opt3 != "N" THEN
LET numero_msg = -1301
CALL msg(numero_msg)
GOTO atras
END IF
IF opt3 = "N" THEN
GOTO salir
END IF
IF opt3 = "S" THEN
UPDATE vetb00002 SET status_t = "E",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE factura = p_fact_no AND fech_crea > datetime (1994-03-31 08:00)
year to minute
UPDATE iptb00006 SET status_t = "E",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE num_doc = p_fact_no AND cod_mov IN (30,31,32) AND
fech_crea > datetime (1994-03-31 08:00) year to minute
UPDATE vetb00003 SET status_t = "E",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE factura = p_fact_no AND fech_crea > datetime (1994-03-31 08:00)
year to minute
UPDATE cctb00001 SET status_t = "E",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE num_doc = p_fact_no AND (tipo_doc = "FT" or tipo_doc = "FE") AND
fech_crea > datetime (1994-03-31 08:00) year to minute
UPDATE cctb00001 SET status_t = "E",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE aplica_a = p_fact_no AND tipo_doc = "PC"
# ANULACION DE LAS SERIES
IF fact_gral.ventas = "1" THEN
LET p_codigo = 30
ELSE
LET p_codigo = 31
END IF
UPDATE vetb00042 set status_t = "E", us_mod = SUSER_SNAME(), fech_mod = GETDATE()
WHERE factura = p_fact_no AND cod_mov = p_codigo
LET numero_msg = 82
CALL msg(numero_msg)
END IF
LABEL salir:
LET fact_gral.fecha_factura = TODAY
#CLOSE FORM vefmwd006
CLOSE WINDOW anula
END FUNCTION
}
REPORT cctb01(p_tipo_cliente,p_sec_cliente,p_fecha_orig,
p_num_doc,p_cod_emp_sec,p_tipo_doc,
p_cuenta_no,p_banco,p_aplica_a,
p_monto_desc,p_valor,p_nombre,
p_nomb_emp,p_nombre_cta,p_comentario)
DEFINE p_tipo_cliente LIKE cctb00001.tipo_cliente,
p_sec_cliente LIKE cctb00001.sec_cliente,
p_fecha_orig LIKE cctb00001.fecha_orig,
p_num_doc LIKE cctb00001.num_doc,
p_cod_emp_sec LIKE cctb00001.cod_emp_sec,
p_tipo_doc LIKE cctb00001.tipo_doc,
p_cuenta_no LIKE cctb00001.cuenta_no,
p_banco LIKE cctb00001.banco,
p_aplica_a LIKE cctb00001.aplica_a,
p_monto_desc LIKE cctb00001.monto_desc,
p_valor LIKE cctb00001.valor,
p_nomb_emp CHAR(40),
p_nombre_cta CHAR(30),
p_cod_cia LIKE cctb00001.cod_cia,
pitbis DEC(12,2)
define
hora char(5),
l smallint,
p_nombre LIKE vetb00004.nombre,
p_comentario,tipo_documento CHAR(120), #LIKE cctb00011.comentario,
ditbis,total_doc,total_desc DEC(12,2)
ORDER BY p_sec_cliente,p_num_doc
format
page header
LET hora = time
IF p_tipo_doc = 'PG' THEN
LET tipo_documento = 'RECIBO INGRESOS'
ELSE
LET tipo_documento = 'DOCUMENTOS'
END IF
PRINTX p_companias.nombre, p_num_doc,p_companias.rnc,p_companias.direccion,p_fecha_orig,hora,
tipo_documento
BEFORE GROUP OF p_sec_cliente
PRINTX nombre_sucursal,p_cuenta_no,p_nombre_cta, p_banco,p_nombre,p_tipo_cliente,
p_sec_cliente,p_cod_emp_sec ,p_nomb_emp,p_tipo_doc ,p_nombre_tipo
on every row
printx p_aplica_a, p_monto_desc,p_valor , p_valor
AFTER GROUP OF p_sec_cliente
LET total_doc =GROUP SUM(p_valor)
LET total_desc = GROUP SUM(p_monto_desc)
on last row
PRINT COLUMN 2, "COMENTARIOS : "
PRINT COLUMN 5, p_comentario[1,60] CLIPPED
PRINT COLUMN 5, p_comentario[61,120] CLIPPED
PAGE TRAILER
SKIP 1 LINE
PRINT COLUMN 10, "____________________________________",
COLUMN 60, "____________________________________"
PRINT COLUMN 10, " Preparado Por ",
COLUMN 60, " Autorizado Por "
print normal
END REPORT
REPORT cctb01b(p_tipo_cliente,p_sec_cliente,p_fecha_orig,
p_num_doc,p_cod_emp_sec,p_tipo_doc,
p_cuenta_no,p_banco,p_aplica_a,
p_monto_desc,p_valor,p_nombre,
p_nomb_emp,p_nombre_cta,p_comentario)
DEFINE p_tipo_cliente LIKE cctb00001.tipo_cliente,
p_sec_cliente LIKE cctb00001.sec_cliente,
p_fecha_orig LIKE cctb00001.fecha_orig,
p_num_doc LIKE cctb00001.num_doc,
p_cod_emp_sec LIKE cctb00001.cod_emp_sec,
p_tipo_doc LIKE cctb00001.tipo_doc,
p_cuenta_no LIKE cctb00001.cuenta_no,
p_banco LIKE cctb00001.banco,
p_aplica_a LIKE cctb00001.aplica_a,
p_monto_desc LIKE cctb00001.monto_desc,
p_valor LIKE cctb00001.valor,
p_nomb_emp CHAR(40),
p_nombre_cta CHAR(30),
pitbis DEC(12,2),
labelcliente STRING
define
hora char(5),
p_nombre LIKE vetb00004.nombre,
p_comentario CHAR(120), #LIKE cctb00011.comentario,
descuento,total_monto,ditbis DEC(12,2),
tipodocumento VARCHAR(50)
ORDER BY p_sec_cliente
format
page header
LET hora = time
IF p_tipo_doc = 'PG' THEN
LET tipodocumento = 'RECIBO DE INGRESOS'
LET labelcliente = "HEMOS RECIBIDO DE "
ELSE
LET tipodocumento = 'DOCUMENTO CUENTAS POR COBRAR'
LET labelcliente = "CLIENTE: "
END IF
BEFORE GROUP OF p_sec_cliente
SELECT a.itbi INTO pitbis FROM vetb00019 a
WHERE a.disponible = "S"
IF pitbis IS NULL THEN
LET pitbis = 0
END IF
PRINTX nombre_sucursal,p_cuenta_no,p_nombre_cta, p_banco,p_nombre,p_tipo_cliente, p_sec_cliente,
p_cod_emp_sec,p_nomb_emp,p_tipo_doc, p_nombre_tipo,tipodocumento,hora,p_companias.nombre,
p_num_doc,p_companias.rnc,p_companias.direccion,p_fecha_orig,p_companias.telefono,
p_companias.fax,fecha_proximo,labelcliente,condicionPago,xdireccion
on every row
printx p_aplica_a, p_monto_desc, p_valor, ditbis , p_valor
AFTER GROUP OF p_sec_cliente
# BUSCA TIPO DE VENTAS
SELECT a.simbolo,a.descripcion_moneda INTO psimbolo,pmoneda FROM vetb00061 a,vetb00060 b
WHERE a.ventas = b.ventas AND
b.tipo_cliente = p_tipo_cliente
LET descuento = GROUP SUM(p_monto_desc)
LET total_monto = GROUP SUM(p_valor)
LET valor_orig = total_monto
LET valor_letras = NULL
CALL convierte()
PRINTX descuento,total_monto,valor_letras,psimbolo
on last row
PRINTX p_comentario
END REPORT
FUNCTION busca_avance()
DEFINE ravances DYNAMIC ARRAY OF RECORD
fecha DATE,
aplica_a INT,
pcotizacion INT,
nombre_proyecto VARCHAR(100),
pendiente DEC(12,2)
END RECORD,
pnombre_proyecto VARCHAR(100)
OPEN WINDOW busqueda1 AT 10,10 WITH FORM "ccfmwd005"
ATTRIBUTE (BORDER,FORM LINE FIRST + 1, comment line last)
CALL ui.Interface.LoadStyles("mbsStyle")
DECLARE avances CURSOR FOR
SELECT a.num_doc,a.banco,SUM(a.valor+a.monto_desc)
FROM cctb00001 a
WHERE a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente AND a.status_t is null AND
a.tipo_Doc IN ('AV','AP')
GROUP BY a.num_doc,a.banco
HAVING SUM(a.valor+a.monto_desc) <> 0
ORDER BY a.num_doc
LET existe = "N"
LET idx = 1
FOREACH avances INTO ravances[idx].aplica_a,ravances[idx].pcotizacion,ravances[idx].pendiente
IF status = NOTFOUND THEN
LET existe = "N"
EXIT FOREACH
END IF
# busca nombre del proyecto
LET pnombre_proyecto = NULL
SELECT a.nombre_proyecto INTO pnombre_proyecto
FROM vetb00050 a
WHERE a.cotizacion_no = ravances[idx].pcotizacion
LET ravances[idx].nombre_proyecto = pnombre_proyecto
LET ravances[idx].nombre_proyecto=pnombre_proyecto
SELECT DISTINCT CONVERT(CHAR(10),a.fecha_orig,103) INTO ravances[idx].fecha
FROM cctb00001 a
WHERE a.tipo_doc ='AV' AND
a.num_doc = ravances[idx].aplica_a AND a.num_doc = a.aplica_a AND
a.tipo_cliente = recibo.tipo_cliente AND a.sec_cliente = recibo.sec_cliente
LET existe = "S"
IF ravances[idx].pendiente != 0 THEN
LET idx = idx + 1
ELSE
CONTINUE FOREACH
END IF
END FOREACH
IF existe="S" THEN
DISPLAY ARRAY ravances TO savance.*
END IF
IF INT_FLAG THEN
LET INT_FLAG = FALSE
END IF
LET curr1= arr_curr()
CLOSE WINDOW busqueda1
RETURN ravances[curr1].aplica_a, ravances[curr1].pendiente,ravances[curr1].pcotizacion
END FUNCTION
FUNCTION datos_doc()
CASE
WHEN recibo.tipo_doc = "PG"
LET nombre_tipo = "PAGOS A FACTURAS"
EXIT CASE
WHEN recibo.tipo_doc = "OC"
LET nombre_tipo = "OTROS CREDITOS"
EXIT CASE
WHEN recibo.tipo_doc = "NC"
LET nombre_tipo = "NOTA CREDITO"
EXIT CASE
WHEN recibo.tipo_doc = "ND"
LET nombre_tipo = "NOTA DEBITO"
EXIT CASE
WHEN recibo.tipo_doc = "PI"
LET nombre_tipo = "PAGO INTER."
EXIT CASE
WHEN recibo.tipo_doc = "DV"
LET nombre_tipo = "DEVOLUCION DINERO"
EXIT CASE
END CASE
LET p_nombre_tipo = nombre_tipo
IF recibo.tipo_doc = "PG" THEN
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 = "PG" AND
a.num_doc = recibo.num_doc AND
a.cod_emp_sec = recibo.cod_emp_sec AND
a.status_t IS NULL
ELSE
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 = recibo.tipo_doc AND
a.num_cheque = recibo.num_doc AND
a.cod_emp_sec = recibo.cod_emp_sec AND
a.status_t IS NULL
END IF
IF valor_ctrl IS NULL THEN
LET valor_ctrl = 0
END IF
IF recibo.tipo_doc = "ND" OR recibo.tipo_doc = "OD" THEN
LET valor_ctrl = valor_ctrl * -1
IF valor_ctrl < 0 THEN
LET valor_ctrl = valor_ctrl * -1
END IF
END IF
SELECT b.nombre,ISNULL(c.calle,' ')+ISNULL(c.casa_num,' ')+ISNULL(c.urbanizacion,' ')
+ISNULL(c.barrio,' ')
INTO nom_cli,xdireccion FROM vetb00004 b
LEFT OUTER JOIN vetb00005 c ON b.tipo_cliente = c.tipo_cliente AND
b.sec_cliente = c.sec_cliente
WHERE b.tipo_cliente = recibo.tipo_cliente and
b.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
IF recibo.tipo_doc = "PG" THEN
LET selec =
"SELECT a.num_doc,a.documento_ref,a.tipo_doc_aplica,a.aplica_a,a.valor,a.monto_desc,a.valor ",
"FROM cctb00001 a ",
"WHERE ((a.tipo_doc = ? OR a.tipo_doc = 'AV') AND ",
" a.num_cheque = ?) AND (a.tipo_cliente = ? AND ",
" a.sec_cliente = ?) ORDER BY 2,1 "
ELSE
LET selec =
"SELECT a.num_doc,a.documento_ref,a.tipo_doc_aplica,aplica_a,valor,monto_desc,valor FROM cctb00001 a ",
"WHERE (a.tipo_doc=? AND a.num_cheque=?)AND (a.tipo_cliente = ? AND ",
" a.sec_cliente = ?) ORDER BY a.banco,a.num_Doc "
END IF
PREPARE comando FROM selec
DECLARE buscar1 CURSOR FOR comando
OPEN buscar1 USING recibo.tipo_doc,recibo.num_doc,recibo.tipo_cliente,
recibo.sec_cliente
LET idx = 1
WHILE STATUS != NOTFOUND
FETCH buscar1 INTO arr_recibo[idx].*
IF STATUS = NOTFOUND THEN
EXIT WHILE
END IF
IF arr_recibo[idx].num_nc = recibo.num_doc THEN
LET arr_recibo[idx].num_nc = null
END IF
IF recibo.tipo_doc != "ND" AND recibo.tipo_doc != "OD" THEN
LET arr_recibo[idx].valor_pen = arr_recibo[idx].valor_pen * -1
ELSE
IF arr_recibo[idx].valor_pen < 0 THEN
LET arr_recibo[idx].valor_pen = arr_recibo[idx].valor_pen *-1
END IF
END IF
LET arr_recibo[idx].valor_pag = arr_recibo[idx].valor_pen
LET arr_recibo[idx].valor_pen = 0
LET arr_recibo[idx].desc_p = arr_recibo[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_recibo[idx].aplica_a and
status_t is null AND num_cheque = recibo.num_doc
LET arr_recibo[idx].valor_pen = valor2
LET idx = idx + 1
END WHILE
DISPLAY ARRAY arr_recibo TO s_recibo.*
ON ACTION imprimir
{
CALL defecto(usuarios,clave,impresor) RETURNING imprime,negrilla_on,negrillas_of,
doble_on,doble_off,comp_on,comp_off,
doce,normal,archivo,copia
START REPORT cctb01 TO archivo
FOR idx = 1 TO arr_recibo.getLength()
IF arr_recibo[idx].num_nc IS NULL THEN
OUTPUT TO REPORT cctb01(recibo.tipo_cliente,
recibo.sec_cliente,recibo.fecha_orig,recibo.num_doc,
recibo.cod_emp_sec,recibo.tipo_doc,null,null,
arr_recibo[idx].aplica_a,arr_recibo[idx].desc_p,arr_recibo[idx].valor_pag,
nom_cli,nombre_emp,nombre_cta,recibo.comentario)
END IF
END FOR
FINISH REPORT cctb01
RUN imprime}
LET r_filename = "ccprmt001a.4rp"
LET r_output = "SVG"
LET preview = 1
-- configure report engine; the functions prefixed fgl that are called here are part of the GRW API
IF fgl_report_loadCurrentSettings(r_filename) THEN -- load the .4rp file
CALL fgl_report_selectDevice(r_output) -- changing default
IF preview = 0 THEN
CALL fgl_report_selectPreview(1) -- changing default
# CALL fgl_report_configureSVGPreview("PrintOnDefaultPrinter")
ELSE
CALL fgl_report_selectPreview(preview)
END if
LET handler = fgl_report_commitCurrentSettings() -- commit changes
ELSE
EXIT PROGRAM
END IF
--run the report
IF handler IS NOT NULL THEN -- report engine was configured ok
START REPORT cctb01b TO XML HANDLER HANDLER
FOR idx = 1 TO arr_recibo.getLength()
IF arr_recibo[idx].num_nc IS NULL THEN
IF arr_recibo[idx].valor_pag IS NOT NULL THEN
OUTPUT TO REPORT cctb01b(recibo.tipo_cliente,
recibo.sec_cliente,recibo.fecha_orig,recibo.num_doc,
recibo.cod_emp_sec,recibo.tipo_doc,null,null,
arr_recibo[idx].aplica_a,arr_recibo[idx].desc_p,arr_recibo[idx].valor_pag,
nom_cli,nombre_emp,nombre_cta,recibo.comentario)
END IF
END IF
END FOR
FINISH REPORT cctb01b
END IF
AFTER DISPLAY
EXIT DISPLAY
END DISPLAY
END FUNCTION
FUNCTION aplica_mas_antiguas()
DEFINE balance,valor_aplicando DEC(12,2),
j int,
pventas char(1)
DECLARE busca_antiguas CURSOR FOR
SELECT a.aplica_a,SUM(a.valor+a.monto_desc),b.ventas,b.fecha_factura
FROM cctb00001 a,vetb00002 b
WHERE (a.tipo_cliente = recibo.tipo_cliente AND
a.sec_cliente = recibo.sec_cliente AND
a.tipo_cliente = b.tipo_cliente AND
a.sec_cliente = b.sec_cliente) AND
(a.tipo_doc NOT IN ('AV','AP') AND a.aplica_a=b.factura) AND a.status_t is null
GROUP BY a.aplica_a,b.fecha_factura,b.ventas
HAVING SUM(a.valor+a.monto_desc) > 0
ORDER BY b.fecha_factura
LET idx = 1
LET j = 1
LET valor_aplicando=0
LET balance=valor_ctrl
FOREACH busca_antiguas INTO aplica_wd[idx].aplica_a,aplica_wd[idx].pendiente,pventas
LET balance = balance -aplica_wd[idx].pendiente
IF balance < 0 THEN
IF valor_aplicando < valor_ctrl THEN
IF pventas = '1' THEN
LET arr_recibo[j].tipo_doc_aplica = 'FT'
ELSE
LET arr_recibo[j].tipo_doc_aplica = 'FE'
END IF
LET arr_recibo[j].aplica_a = aplica_wd[idx].aplica_a
LET arr_recibo[j].valor_pen=aplica_wd[idx].pendiente
LET arr_recibo[j].valor_pag =valor_ctrl-valor_aplicando
DISPLAY "DATA2 ", arr_recibo[j].aplica_a," V ",arr_recibo[j].valor_pag
END IF
EXIT FOREACH
ELSE
IF pventas = '1' THEN
LET arr_recibo[j].tipo_doc_aplica = 'FT'
ELSE
LET arr_recibo[j].tipo_doc_aplica = 'FE'
END IF
LET arr_recibo[j].aplica_a = aplica_wd[idx].aplica_a
LET arr_recibo[j].valor_pen =aplica_wd[idx].pendiente
IF balance > aplica_wd[idx].pendiente THEN
LET valor_aplicando = valor_aplicando + aplica_wd[idx].pendiente
LET arr_recibo[j].valor_pag =aplica_wd[idx].pendiente
END IF
DISPLAY "DATA ", arr_recibo[j].aplica_a," V ",arr_recibo[j].valor_pag
LET j = j +1
END IF
LET idx = idx + 1
END FOREACH
END FUNCTION
FUNCTION convierte()
DEFINE consegui CHAR(1)
DEFINE p,miles,m,k,a,b,d,c,entero,unidades_mi,unidades_m,unidad,mil,millon,
unid_c,u INTEGER
DEFINE cheles DECIMAL (7,2)
CALL letras()
LET valor_letras = null
LET consegui = "N"
LET entero = valor_orig
LET cheles = (valor_orig - entero) * 100
LET unidad = entero / 100
LET unidad = entero - (unidad * 100)
LET a = entero / 1000
LET a = entero - (a * 1000)
LET d = entero - 19
IF d >= 82 THEN
LET c = entero / 100
# Para Controlar los miles y los cientos
IF c <= 9 THEN
LET valor_letras = valor_letras clipped," ",centenas[c] clipped
ELSE
LET c = entero / 1000
LET b = entero / 1000000
END IF
IF d > 19 THEN
LET d = unidad - 19
END IF
IF unidad > 0 and unidad < 20 THEN
LET d = unidad
LET valor_letras = valor_letras clipped," ",unidades1[d] clipped
LET consegui = "S"
END IF
ELSE
IF d > 0 AND d <= 81 THEN
LET valor_letras = valor_letras clipped," ",decenas[d] clipped
LET consegui = "S"
END IF
END IF
# Para controlar los miles
IF entero > 999 THEN
LET unidades_m = a / 100
LET unidades_m = a - (unidades_m * 100)
LET valor_letras = null
IF c = 1 THEN
LET valor_letras = "MIL"
END IF
IF c > 1 and c <= 19 THEN
LET valor_letras = valor_letras clipped," ",unidades1[c] clipped," ","MIL"
END IF
IF c >= 20 and c <= 999 THEN
IF c < 82 THEN
LET c = c - 19
LET valor_letras = valor_letras clipped," ",decenas[c] clipped
ELSE
LET k = c / 100
IF k > 0 AND k < 10 THEN
LET unid_c = c - (k * 100) # AQUI FUE
IF k > 1 THEN
LET valor_letras = valor_letras clipped," ",centenas[k] clipped
ELSE
IF k = 1 then
IF unid_c > 0 THEN
LET valor_letras = valor_letras clipped," ",centenas[k] clipped
ELSE
LET valor_letras = valor_letras clipped," ",decenas[81] clipped
END IF
end if
END IF
END IF
LET unid_c = c - (k * 100)
IF unid_c >0 and unid_c < 20 THEN
LET valor_letras = valor_letras clipped," ",unidades1[unid_c] clipped
ELSE
LET unid_c = unid_c -19
IF unid_c >0 and unid_c <=81 then
LET valor_letras = valor_letras clipped," ",decenas[unid_c] clipped
LET consegui = "S"
end if
END IF
IF c > 82 and c < 100 and consegui <> "S" THEN
LET c = c-19
LET valor_letras = valor_letras CLIPPED," ",decenas[c] CLIPPED
END IF
IF c > 100 AND consegui <> "S" THEN
LET c = c -119
IF c > 0 and c <= 81 THEN
LET valor_letras = valor_letras CLIPPED," ",decenas[c] CLIPPED
LET consegui = "N"
END IF
END IF
END IF
LET valor_letras = valor_letras clipped," ","MIL"
END IF
LET c = a
IF c > 100 THEN
LET c = c / 100
LET valor_letras = valor_letras clipped," ",centenas[c] clipped
END IF
IF c = 100 THEN
LET valor_letras = valor_letras clipped," ",decenas[81] clipped
END IF
IF unidades_m > 0 and unidades_m-19 <= 81 THEN
LET a = unidades_m -19
IF a > 0 and a<= 81 THEN
LET valor_letras = valor_letras clipped, " ",decenas[a] clipped
LET consegui="S"
ELSE
LET valor_letras = valor_letras clipped, " ",unidades1[unidades_m] clipped
END IF
END IF
END IF
#========================================================================================
# Para Controlar cantidades en millones
IF entero > 999999 THEN
LET c = 0
LET miles = entero - 1000000
LET m = miles / 1000
LET p = miles - (m * 1000)
LET u = m / 100
LET u = m - (u * 100)
LET unidades_mi = p
LET unidades_mi = unidades_mi / 100
LET unidades_mi = p - (unidades_mi * 100)
LET valor_letras = null
IF b = 1 THEN
LET valor_letras = "UN MILLON"
END IF
IF b > 1 and b <= 19 THEN
LET valor_letras = valor_letras clipped," ",unidades1[b] clipped," ",
"MILLONES"
END IF
IF b >= 20 and b <= 999999 THEN
IF b < 82 THEN
LET b = b - 19
LET valor_letras = valor_letras clipped," ",decenas[b] clipped," ",
"MILLONES"
ELSE
LET k = b / 100
LET valor_letras = valor_letras clipped," ",centenas[k] clipped," ",
"MILLONES"
END IF
END IF
LET b = m /100
IF b >0 and b <=9 THEN
if b = 1 then
LET valor_letras = valor_letras clipped," CIEN "
else
LET valor_letras = valor_letras clipped," ",centenas[b] clipped
end if
IF u > 0 and u <= 19 THEN
IF u = 1 THEN
LET unidades1[1] = "UN"
END IF
LET valor_letras = valor_letras clipped," ",unidades1[u] clipped
END IF
let u = u - 19
# IF u > 0 and u <= 19 THEN
# IF u = 1 THEN
# LET unidades1[1] = "UN"
# END IF
# LET valor_letras = valor_letras clipped," ",unidades1[u] clipped
# END IF
IF u >=1 and u < 82 THEN
# LET u = u - 19 # adicione este 13/5/2011 La quite el 30/5/2011
LET valor_letras = valor_letras clipped," ",decenas[u] clipped
END IF
LET valor_letras = valor_letras clipped," ","MIL"
END IF
IF p > 100 THEN
LET p = p / 100
LET valor_letras = valor_letras clipped," ",centenas[p] clipped
END IF
LET unidades_mi = unidades_mi-19
IF unidades_mi > 0 and unidades_mi <= 81 THEN
LET m = unidades_mi
LET valor_letras = valor_letras clipped, " ",decenas[m] clipped
END IF
END IF
IF unidad > 0 and unidad < 20 AND consegui = "N" THEN
LET d = unidad
LET valor_letras = valor_letras clipped," ",unidades1[d] clipped
END IF
IF unidad >= 20 AND d <= 81 AND consegui = "N" THEN
LET valor_letras = valor_letras clipped," ",decenas[d] clipped
END IF
LET valor_letras = valor_letras clipped," ",pmoneda CLIPPED," CON"," ",
cheles using "&&", "/100"
END FUNCTION
FUNCTION letras()
LET unidades1[1] = "UNO"
LET unidades1[2] = "DOS"
LET unidades1[3] = "TRES"
LET unidades1[4] = "CUATRO"
LET unidades1[5] = "CINCO"
LET unidades1[6] = "SEIS"
LET unidades1[7] = "SIETE"
LET unidades1[8] = "OCHO"
LET unidades1[9] = "NUEVE"
LET unidades1[10] = "DIEZ"
LET unidades1[11] = "ONCE"
LET unidades1[12] = "DOCE"
LET unidades1[13] = "TRECE"
LET unidades1[14] = "CATORCE"
LET unidades1[15] = "QUINCE"
LET unidades1[16] = "DIECISEIS"
LET unidades1[17] = "DIECISIETE"
LET unidades1[18] = "DIECIOCHO"
LET unidades1[19] = "DIECINUEVE"
LET decenas[1] = "VEINTE"
LET decenas[2] = "VEINTE Y UNO"
LET decenas[3] = "VEINTE Y DOS"
LET decenas[4] = "VEINTE Y TRES"
LET decenas[5] = "VEINTE Y CUATRO"
LET decenas[6] = "VEINTE Y CINCO"
LET decenas[7] = "VEINTE Y SEIS"
LET decenas[8] = "VEINTE Y SIETE"
LET decenas[9] = "VEINTE Y OCHO"
LET decenas[10] = "VEINTE Y NUEVE"
LET decenas[11] = "TREINTA"
LET decenas[12] = "TREINTA Y UNO"
LET decenas[13] = "TREINTA Y DOS"
LET decenas[14] = "TREINTA Y TRES"
LET decenas[15] = "TREINTA Y CUATRO"
LET decenas[16] = "TREINTA Y CINCO"
LET decenas[17] = "TREINTA Y SEIS"
LET decenas[18] = "TREINTA Y SIETE"
LET decenas[19] = "TREINTA Y OCHO"
LET decenas[20] = "TREINTA Y NUEVE"
LET decenas[21] = "CUARENTA"
LET decenas[22] = "CUARENTA Y UNO"
LET decenas[23] = "CUARENTA Y DOS"
LET decenas[24] = "CUARENTA Y TRES"
LET decenas[25] = "CUARENTA Y CUATRO"
LET decenas[26] = "CUARENTA Y CINCO"
LET decenas[27] = "CUARENTA Y SEIS"
LET decenas[28] = "CUARENTA Y SIETE"
LET decenas[29] = "CUARENTA Y OCHO"
LET decenas[30] = "CUARENTA Y NUEVE"
LET decenas[31] = "CINCUENTA"
LET decenas[32] = "CINCUENTA Y UNO"
LET decenas[33] = "CINCUENTA Y DOS"
LET decenas[34] = "CINCUENTA Y TRES"
LET decenas[35] = "CINCUENTA Y CUATRO"
LET decenas[36] = "CINCUENTA Y CINCO"
LET decenas[37] = "CINCUENTA Y SEIS"
LET decenas[38] = "CINCUENTA Y SIETE"
LET decenas[39] = "CINCUENTA Y OCHO"
LET decenas[40] = "CINCUENTA Y NUEVE"
LET decenas[41] = "SESENTA"
LET decenas[42] = "SESENTA Y UNO"
LET decenas[43] = "SESENTA Y DOS"
LET decenas[44] = "SESENTA Y TRES"
LET decenas[45] = "SESENTA Y CUATRO"
LET decenas[46] = "SESENTA Y CINCO"
LET decenas[47] = "SESENTA Y SEIS"
LET decenas[48] = "SESENTA Y SIETE"
LET decenas[49] = "SESENTA Y OCHO"
LET decenas[50] = "SESENTA Y NUEVE"
LET decenas[51] = "SETENTA"
LET decenas[52] = "SETENTA Y UNO"
LET decenas[53] = "SETENTA Y DOS"
LET decenas[54] = "SETENTA Y TRES"
LET decenas[55] = "SETENTA Y CUATRO"
LET decenas[56] = "SETENTA Y CINCO"
LET decenas[57] = "SETENTA Y SEIS"
LET decenas[58] = "SETENTA Y SIETE"
LET decenas[59] = "SETENTA Y OCHO"
LET decenas[60] = "SETENTA Y NUEVE"
LET decenas[61] = "OCHENTA"
LET decenas[62] = "OCHENTA Y UNO"
LET decenas[63] = "OCHENTA Y DOS"
LET decenas[64] = "OCHENTA Y TRES"
LET decenas[65] = "OCHENTA Y CUATRO"
LET decenas[66] = "OCHENTA Y CINCO"
LET decenas[67] = "OCHENTA Y SEIS"
LET decenas[68] = "OCHENTA Y SIETE"
LET decenas[69] = "OCHENTA Y OCHO"
LET decenas[70] = "OCHENTA Y NUEVE"
LET decenas[71] = "NOVENTA"
LET decenas[72] = "NOVENTA Y UNO"
LET decenas[73] = "NOVENTA Y DOS"
LET decenas[74] = "NOVENTA Y TRES"
LET decenas[75] = "NOVENTA Y CUATRO"
LET decenas[76] = "NOVENTA Y CINCO"
LET decenas[77] = "NOVENTA Y SEIS"
LET decenas[78] = "NOVENTA Y SIETE"
LET decenas[79] = "NOVENTA Y OCHO"
LET decenas[80] = "NOVENTA Y NUEVE"
LET decenas[81] = "CIEN"
LET centenas[1] = "CIENTO"
LET centenas[2] = "DOCIENTOS"
LET centenas[3] = "TRESCIENTOS"
LET centenas[4] = "CUATROCIENTOS"
LET centenas[5] = "QUINIENTOS"
LET centenas[6] = "SEISCIENTOS"
LET centenas[7] = "SETECIENTOS"
LET centenas[8] = "OCHOCIENTOS"
LET centenas[9] = "NOVECIENTOS"
END FUNCTION
Reference in New Issue View Git Blame Copy Permalink