Files
MBS/PROYECTO/cgdir/cgprmt005bk.4gl
T

1952 lines
60 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 formato CHAR(18)
DEFINE numdoc INT,
autorizar,usada CHAR(2),xcomentario CHAR(100)
###### Funcion que adiciona informacion referente a la aplicacion de un pago
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(5) RETURNING impresor
CALL STARTLOG("cgprmt5.txt")
CONNECT to "sistemas" AS "MSSQL" USER usuarios USING clave
SELECT a.* INTO p_compania.* FROM companias a
CALL defecto(usuarios,clave,impresor) RETURNING imprime,negrilla_on,negrillas_of,
doble_on,doble_off,comp_on,comp_off,
doce,normal,archivo,copia
#DISPLAY "USUARIOS ",usuarios,"IMPRESOR ",impresor,"archivo ",archivo," imprime ",imprime
CALL cgprmt005()
END MAIN
FUNCTION cgprmt005()
OPTIONS
FORM LINE 8,
COMMENT LINE 22,
PROMPT LINE 23
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."
COMMAND "Adicionar"
"Presione ESC Para Grabar Ctrl-C Para Cancelar Ctrl-F Moverse en Pantalla"
LET int_flag = FALSE
CALL cgprad005()
COMMAND "Salir"
LET int_flag = FALSE
EXIT MENU
END MENU
END FUNCTION
FUNCTION cgprad005()
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 numdoc,recibo.*,valor_letras WITHOUT DEFAULTS
AFTER FIELD numdoc
CALL busca_solicitud(numdoc) RETURNING recibo.cuenta_p,recibo.fecha,recibo.monto,recibo.cod_sp,
recibo.cod_sp_sec,recibo.nom_sup,xcomentario,autorizar,usada
IF autorizar IS NULL OR autorizar ="NO" THEN
CALL fgl_winmessage("ERROR","SOLICITUD NO ESTA AUTORIZADA","STOP")
NEXT FIELD numdoc
END IF
IF usada IS NULL OR usada ="S" THEN
CALL fgl_winmessage("ERROR","SOLICITUD YA HA SIDO PAGADA","STOP")
NEXT FIELD numdoc
END IF
DISPLAY BY NAME recibo.*
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 monto
IF recibo.monto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD monto
END IF
CALL convierte()
DISPLAY BY NAME valor_letras
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 a.cheque_no,a.formato INTO numero,formato FROM cgtb00012 a
WHERE a.cuenta_no = recibo.cuenta_p AND a.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 a.* INTO datos_ck.* FROM cgtb00012 a
WHERE a.cuenta_no = recibo.cuenta_p AND a.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"
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
##### Igualando la descripcion de la operacion dependiendo de la clave
##### digitada en el proceso.
LET tipo_doc1 = recibo.tipo_doc
CASE
WHEN recibo.tipo_doc = "CK"
LET nom_tipo = "CHEQUE"
EXIT CASE
WHEN recibo.tipo_doc = "CP"
LET nom_tipo = "PAGO ADELANTADO"
EXIT CASE
END CASE
DISPLAY BY NAME nom_tipo ATTRIBUTE (BOLD)
BEFORE FIELD fecha
LET recibo.fecha = hoy
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.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
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
CALL arr_recibo.clear()
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
CALL arr_recibo.clear()
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"
LET selec1=" SELECT a.tipo,a.num_oc,a.num_doc,a.valor_pagado ",
"FROM cgtb00039 a ",
"WHERE a.numdoc=",numdoc," and status_t is null "
PREPARE comand4 FROM selec1
DECLARE busca1 CURSOR FOR comand4
LET idx=1
FOREACH busca1 INTO arr_recibo[idx].tipo,arr_recibo[idx].orden_no,arr_recibo[idx].aplica_a,
arr_recibo[idx].valor_pag
LET idx=idx=1
END FOREACH
{ DISPLAY arr_recibo[curr1].aplica_a TO s_recibo[scr_l].aplica_a
DISPLAY arr_recibo[curr1].orden_no TO s_recibo[scr_l].orden_no
DISPLAY arr_recibo[curr1].tipo TO s_recibo[scr_l].tipo
DISPLAY arr_recibo[curr1].valor_pag TO s_recibo[scr_l].valor_pag}
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)
LET curr = arr_curr()
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
IF numdoc IS NULL THEN
LET arr_recibo[curr].valor_pag = arr_recibo[curr].valor_pen
END if
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_recibo.getLength()
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
CALL arr_cuenta1.clear()
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"
LET selec1 =
" SELECT a.cuenta_no,a.departamento,a.id_auxiliar,a.cod_sec,a.nom_cuenta,a.debito,a.credito ",
"FROM cgtb00041 a ",
"WHERE a.numdoc=",numdoc," and status_t is null "
PREPARE comand5 FROM selec1
DECLARE busca3 CURSOR FOR comand5
LET idx=1
FOREACH busca3 INTO arr_cuenta1[idx].cuenta_no,arr_cuenta1[idx].departamento,arr_cuenta1[idx].cod_aux,
arr_cuenta1[idx].cod_sec,arr_cuenta1[idx].nom_cuenta,arr_cuenta1[idx].debito,arr_cuenta1[idx].credito
LET idx=idx+1
END FOREACH
{ DISPLAY arr_cuenta1[arr_curr()].cod_aux TO s_cuenta[scr_line()].cod_aux
DISPLAY arr_cuenta1[arr_curr()].cod_sec TO s_cuenta[scr_line()].cod_sec
DISPLAY arr_cuenta1[arr_curr()].credito TO s_cuenta[scr_line()].credito
DISPLAY arr_cuenta1[arr_curr()].debito TO s_cuenta[scr_line()].debito
DISPLAY arr_cuenta1[arr_curr()].cuenta_no TO s_cuenta[scr_line()].cuenta_no
DISPLAY arr_cuenta1[arr_curr()].departamento TO s_cuenta[scr_line()].departamento
DISPLAY arr_cuenta1[arr_curr()].nom_cuenta TO s_cuenta[scr_line()].nom_cuenta}
INPUT ARRAY arr_cuenta1 WITHOUT DEFAULTS FROM s_cuenta.*
ON KEY (CONTROL-F)
LET opc = "N"
LET sale_arr = "S"
EXIT INPUT
ON KEY (CONTROL-P)
NEXT FIELD cuenta_no
BEFORE INPUT
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-01" 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-01" 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-01"
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-01" 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-01"
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)
IF p_cata = "S" THEN
LET arr_cuenta1[curr].cod_aux=recibo.cod_sp
LET arr_cuenta1[curr].cod_sec=recibo.cod_sp_sec
LET nombre_cata=recibo.nom_sup
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
DISPLAY BY NAME nombre_cata
NEXT FIELD cod_aux
ELSE
IF p_ref = "S" THEN
NEXT FIELD num_doc
END IF
END IF
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-01" THEN
LET chequea = "S"
LET valor_cxp = valor_cxp + arr_cuenta1[idx].debito
END IF
END IF
END FOR
DISPLAY "valor f",valor_f
DISPLAY "valor csp",valor_cxp
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-01" 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-01" 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_cuenta1.getLength()
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
LET monto = 0
LET valor = 0
FOR idx = 1 TO arr_cuenta1.getLength()
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
DISPLAY "valor",valor
DISPLAY "monto",monto
LET monto = valor - monto
LET monto=monto*(-1)
DISPLAY "monto",monto
DISPLAY "monto1",recibo.monto
IF monto != recibo.monto THEN
LET numero_msg = 178
CALL msg(numero_msg)
NEXT FIELD debito
END IF
EXIT INPUT
END INPUT
IF sale_arr = "S" THEN
GOTO arr2
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"
SELECT a.cheque_no,a.formato INTO numero,formato FROM cgtb00012 a
WHERE a.cuenta_no = recibo.cuenta_p AND a.tipo_doc = 'CK'
LET numero = numero + 1
LET recibo.numero = numero
DISPLAY BY NAME recibo.numero
IF formato = "FORMATO1" THEN
START REPORT cheque TO archivo
END IF
IF formato = "FORMATO2" THEN
START REPORT cheque2 TO archivo
END IF
#WHENEVER ERROR CONTINUE
BEGIN WORK
# 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].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,us_crea,fech_crea,bienes,servicios)
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,usuarios,
getdate(),0,0)
IF STATUS < 0 THEN
ERROR "NO FUE POSIBLE INSERTAR EN LA TABLA CPTB00001"
EXIT FOR
ROLLBACK WORK
END IF
END IF
END IF
END FOR
END IF
END IF
# Actualizacion de la tabla datos generales del cheque
INSERT INTO cgtb00005(cuenta_no,cheque_no,fecha,portador,tasa,monto,status_impresion,us_crea,fech_crea,tipo_Doc,solicitud) values
(recibo.cuenta_p,recibo.numero,recibo.fecha,
recibo.nom_sup,recibo.tasa,recibo.monto,opc1,
usuarios,getdate(),recibo.tipo_doc,numdoc)
UPDATE cgtb00040
SET usada="S"
WHERE @numdoc=numdoc
IF STATUS < 0 THEN
ERROR "NO FUE POSIBLE INSERTAR EN LA TABLA CGTB00005"
ROLLBACK WORK
EXIT PROGRAM
END IF
# Actualizacion de la tabla control de los cheques
UPDATE cgtb00012 set cheque_no = recibo.numero
WHERE cuenta_no = recibo.cuenta_p AND tipo_Doc = recibo.tipo_doc
IF STATUS < 0 THEN
ERROR "NO FUE POSIBLE INSERTAR EN LA TABLA CGTB00012"
ROLLBACK WORK
END IF
# Actualizacion de la tabla transacciones de contabildad general
LET referencia = "CK.",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,us_crea,fech_crea)
values (recibo.fecha,2,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,
usuarios,getdate())
IF STATUS < 0 THEN
ERROR "NO FUE POSIBLE INSERTAR EN LA TABLA CGTB00004"
ROLLBACK WORK
EXIT PROGRAM
END IF
# Impresion del cheque de pago
IF formato = "FORMATO1" THEN
OUTPUT TO REPORT cheque(recibo.*,arr_cuenta1[idx].*)
END IF
IF formato = "FORMATO2" THEN
OUTPUT TO REPORT cheque2(recibo.*,arr_cuenta1[idx].*)
END IF
END IF
END FOR
# Inserta los registros necesarios para la tabla de tesoreria
INSERT INTO tetb00006 values (recibo.numero,recibo.cuenta_p,
recibo.codigo,NULL,usuarios,getdate(),NULL,NULL)
IF STATUS < 0 THEN
ERROR "NO FUE POSIBLE INSERTAR EN LA TABLA TETB00006"
ROLLBACK WORK
EXIT PROGRAM
END IF
#-----------------------------------------------------------------------------
INSERT INTO cgtb00004
(fecha,tipo,ref,cuenta_no,detalles,detalle_1,
detalle_2,debito,credito,us_crea,fech_crea)
values (recibo.fecha,2,referencia,
recibo.cuenta_p,recibo.cuenta_p,
detalle_1,detalle_2,0,recibo.monto,
usuarios,getdate())
IF STATUS < 0 THEN
ERROR "NO FUE POSIBLE INSERTAR EL BANCO EN LA TABLA CGTB00004"
ROLLBACK WORK
EXIT PROGRAM
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
IF formato = "FORMATO1" THEN
OUTPUT TO REPORT cheque(recibo.*,arr_cuenta1[1].*)
FINISH REPORT cheque
END IF
IF formato = "FORMATO2" THEN
OUTPUT TO REPORT cheque2(recibo.*,arr_cuenta1[1].*)
FINISH REPORT cheque2
END IF
RUN imprime
LET numero_msg = 1
CALL msg(numero_msg)
CALL arr_cuenta1.clear()
END IF
IF opc = "N" THEN
GOTO volver
END IF
END FUNCTION
REPORT cheque(x,z)
DEFINE z RECORD
cuenta_no LIKE cgtb00004.cuenta_no,
departamento LIKE cgtb00004.departamento,
cod_aux LIKE cgtb00004.cod_aux,
cod_sec LIKE cgtb00004.cod_sec,
num_doc LIKE cgtb00004.num_doc,
nom_cuenta CHAR(30),
debito LIKE cgtb00004.debito,
credito LIKE cgtb00004.credito
END RECORD
DEFINE x RECORD
tipo_doc LIKE cptb00001.tipo_doc,
cuenta_p LIKE cgtb00004.cuenta_no,
numero INTEGER,
cod_sp LIKE cptb00001.cod_sp,
cod_sp_sec LIKE cptb00001.cod_sp_sec,
nom_sup CHAR(60),
fecha LIKE cgtb00004.fecha,
tasa LIKE cgtb00005.tasa,
monto DECIMAL(12,2),
codigo LIKE tetb00003.codigo
END RECORD,
ano CHAR(4)
DEFINE nombre_mes CHAR(10)
DEFINE orden,fact CHAR(30)
DEFINE doble_on,negrillas_on,negrillas_off,italica,italica_of,doce_on,doble_of,
doce_of,normal,un_octavo CHAR(2)
DEFINE in_mes INTEGER
DEFINE comprime_on,comprime_of CHAR(1)
DEFINE
lineas CHAR(5)
DEFINE valor_mask CHAR(13),
l SMALLINT
OUTPUT
TOP MARGIN 0
LEFT MARGIN 4
PAGE LENGTH 51
BOTTOM MARGIN 0
ORDER BY x.numero
FORMAT
BEFORE GROUP OF x.numero
LET un_octavo = ASCII 27, ASCII 48
LET doble_on = ASCII 14
LET doble_of = ASCII 20
LET doce_on = ASCII 27, ASCII 77
LET doce_of = ASCII 27, ASCII 80
LET italica = ASCII 27, ASCII 52
LET italica_of = ASCII 27, ASCII 53
LET negrillas_on = ASCII 27, ASCII 69
LET negrillas_off = ASCII 27, ASCII 70
LET comprime_on = ASCII 15
LET comprime_of = ASCII 18
LET normal = ASCII 27, ASCII 80
LET in_mes = month(recibo.fecha)
CALL busca_mes()
LET nombre_mes = meses[in_mes]
SKIP 4 LINE
LET ano = year(recibo.fecha)
PRINT COLUMN 61, day(recibo.fecha) using "&&",
COLUMN 65, MONTH(recibo.fecha) using "&&",
COLUMN 69, ano
SKIP 2 LINE
# PRINT un_octavo
PRINT COLUMN 17, recibo.nom_sup clipped,
COLUMN 60, recibo.monto using "***,***,***.##"
#CALL convierte()
LET l = (80 - LENGTH(valor_letras CLIPPED)) / 2
PRINT comprime_on
PRINT COLUMN l, "*",valor_letras clipped
PRINT comprime_of
LET valor_mask = recibo.monto using "<<,<<<,<<<.##" clipped
SKIP 4 LINE
#PRINT COLUMN 3, negrillas_on,comprime_on,
# " Mmotech",doble_on,comprime_of,"RD$",
# valor_mask clipped,
# " Ctvos",negrillas_off
PRINT doce_on
#PRINT COLUMN 8 , datos_ck.nombre_bco,doce_of,negrillas_off,comprime_on
#PRINT COLUMN 11, datos_ck.direccion
#PRINT COLUMN 11, "Cuenta No. ",datos_ck.cuenta_bank
PRINT comprime_of
SKIP 9 LINES
PRINT COLUMN 6, detalle_1," ",valor_1 using "(((,(((,((#.##)"
PRINT COLUMN 6, detalle_2," ",valor_2 using "(((,(((,((#.##)"
PRINT COLUMN 6, detalle_3," ",valor_3 using "(((,(((,((#.##)"
# PRINT COLUMN 6, detalle_4," ",valor_4 using "(((,(((,((#.##)"
PRINT COLUMN 6, detalle_5," ",valor_5,
COLUMN 77, recibo.monto using "#,###,###.##"
SKIP 3 LINES
PRINT comprime_on
ON EVERY ROW
PRINT COLUMN 6, z.cuenta_no,
COLUMN 18, z.departamento using "####",
COLUMN 27, z.cod_aux using "##","-",z.cod_sec using "####",
COLUMN 37, z.num_doc ,
COLUMN 50, z.nom_cuenta,
COLUMN 119, z.debito using "##,###,###.##",
COLUMN 142, z.credito using "##,###,###.##"
PAGE TRAILER
PRINT COLUMN 10, x.codigo using "&&&&"," ",p_descrip
PRINT COLUMN 1,comprime_of,doble_on,
COLUMN 1, x.numero USING "&&&&&&"
PRINT doble_of,normal
SKIP 8 LINES
END REPORT
REPORT cheque2(x,z)
DEFINE z RECORD
cuenta_no LIKE cgtb00004.cuenta_no,
departamento LIKE cgtb00004.departamento,
cod_aux LIKE cgtb00004.cod_aux,
cod_sec LIKE cgtb00004.cod_sec,
num_doc LIKE cgtb00004.num_doc,
nom_cuenta CHAR(30),
debito LIKE cgtb00004.debito,
credito LIKE cgtb00004.credito
END RECORD
DEFINE x RECORD
tipo_doc LIKE cptb00001.tipo_doc,
cuenta_p LIKE cgtb00004.cuenta_no,
numero INTEGER,
cod_sp LIKE cptb00001.cod_sp,
cod_sp_sec LIKE cptb00001.cod_sp_sec,
nom_sup CHAR(60),
fecha LIKE cgtb00004.fecha,
tasa LIKE cgtb00005.tasa,
monto DECIMAL(12,2),
codigo LIKE tetb00003.codigo
END RECORD,
ano CHAR(4)
DEFINE nombre_mes CHAR(10)
DEFINE orden,fact CHAR(30)
DEFINE doble_on,negrillas_on,negrillas_off,italica,italica_of,doce_on,doble_of,
doce_of,normal,un_octavo CHAR(2)
DEFINE in_mes INTEGER
DEFINE comprime_on,comprime_of CHAR(1)
DEFINE
lineas CHAR(5)
DEFINE valor_mask CHAR(13)
OUTPUT
TOP MARGIN 3
LEFT MARGIN 4
PAGE LENGTH 43
BOTTOM MARGIN 0
ORDER BY x.numero
FORMAT
BEFORE GROUP OF x.numero
LET un_octavo = ASCII 27, ASCII 48
LET doble_on = ASCII 14
LET doble_of = ASCII 20
LET doce_on = ASCII 27, ASCII 77
LET doce_of = ASCII 27, ASCII 80
LET italica = ASCII 27, ASCII 52
LET italica_of = ASCII 27, ASCII 53
LET negrillas_on = ASCII 27, ASCII 69
LET negrillas_off = ASCII 27, ASCII 70
LET comprime_on = ASCII 15
LET comprime_of = ASCII 18
LET normal = ASCII 27, ASCII 80
LET in_mes = month(recibo.fecha)
# CALL busca_mes()
# LET nombre_mes = meses[in_mes]
SKIP 1 LINE
LET ano = year(recibo.fecha)
PRINT COLUMN 63, day(recibo.fecha) using "&&",
COLUMN 66, MONTH(recibo.fecha) using "&&",
COLUMN 70, ano
SKIP 2 LINE
# PRINT un_octavo
PRINT COLUMN 17, recibo.nom_sup clipped,
COLUMN 60, recibo.monto using "***,***,***.##"
# CALL convierte()
LET l = (80 - LENGTH(valor_letras CLIPPED)) / 2
PRINT comprime_on
PRINT COLUMN l, "*",valor_letras clipped
PRINT comprime_of
LET valor_mask = recibo.monto using "<<,<<<,<<<.##" clipped
SKIP 2 LINE
# PRINT COLUMN 3, negrillas_on,comprime_on,
# " Mmotech",doble_on,comprime_of,"RD$",
# valor_mask clipped,
# " Ctvos",negrillas_off
PRINT doce_on
#PRINT COLUMN 8 , datos_ck.nombre_bco,doce_of,negrillas_off,comprime_on
#PRINT COLUMN 11, datos_ck.direccion
#PRINT COLUMN 11, "Cuenta No. ",datos_ck.cuenta_bank
PRINT comprime_of
SKIP 9 LINES
PRINT COLUMN 6, detalle_1," ",valor_1 using "(((,(((,((#.##)"
PRINT COLUMN 6, detalle_2," ",valor_2 using "(((,(((,((#.##)"
PRINT COLUMN 6, detalle_3," ",valor_3 using "(((,(((,((#.##)"
# PRINT COLUMN 6, detalle_4," ",valor_4 using "(((,(((,((#.##)"
PRINT COLUMN 6, detalle_5," ",valor_5,
COLUMN 77, recibo.monto using "#,###,###.##"
SKIP 3 LINES
PRINT comprime_on
ON EVERY ROW
PRINT COLUMN 6, z.cuenta_no,
COLUMN 18, z.departamento using "####",
COLUMN 27, z.cod_aux using "##","-",z.cod_sec using "####",
COLUMN 37, z.num_doc ,
COLUMN 50, z.nom_cuenta,
COLUMN 119, z.debito using "##,###,###.##",
COLUMN 142, z.credito using "##,###,###.##"
ON LAST ROW
PRINT COLUMN 10, x.codigo using "&&&&"," ",p_descrip
PRINT COLUMN 1,comprime_of,doble_on,
COLUMN 1, x.numero USING "&&&&&&"
PRINT doble_of,normal
END REPORT
{
FUNCTION busca_mes()
LET meses[1] = "ENERO"
LET meses[2] = "FEBRERO"
LET meses[3] = "MARZO"
LET meses[4] = "ABRIL"
LET meses[5] = "MAYO"
LET meses[6] = "JUNIO"
LET meses[7] = "JULIO"
LET meses[8] = "AGOSTO"
LET meses[9] = "SEPTIEMBRE"
LET meses[10] = "OCTUBRE"
LET meses[11] = "NOVIEMBRE"
LET meses[12] = "DICIEMBRE"
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 = recibo.monto
LET cheles = (recibo.monto - 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," PESOS ","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
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