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

566 lines
17 KiB
Plaintext
Raw Blame History

{
-------------------------------------------------------------------------------
caPROGRAMA : CCPRRP005
OBJETIVO : Relacion de Recibos de Pagos
PROGRAMADOR : Juan F. Soto
FECHA REALIZACION : Abril 1, 1993
-------------------------------------------------------------------------------
}
GLOBALS "ccprgb000.4gl"
DEFINE
r_output STRING, -- output format option
r_action STRING, -- used to set preview option
r_filename STRING, -- filename of Report Design document (the .4rp filename)
preview INTEGER -- preview option T
DEFINE tipo,tipo_doc CHAR(2),
opt5 CHAR(3)
DEFINE fecha_inicial, fecha_final DATE
DEFINE salir CHAR(1)
DEFINE cobros RECORD
cuenta_no CHAR(8),
recibo INTEGER,
fecha_recibo DATE,
factura INTEGER,
tipo_cliente SMALLINT,
sec_cliente SMALLINT,
monto_recibo DECIMAL(12,2),
descuento DECIMAL(12,2),
status_t CHAR(1),
nom_cli CHAR(30),
descripcion CHAR(30),
documento INT,
cod_cia SMALLINT,
localidad CHAR(40),
chitbis CHAR(2)
END RECORD
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
CALL startlog("CCRP05.TXT")
CONNECT to "decomarmol" AS "MSSQL" USER usuarios USING clave
{ CALL defecto(usuarios,clave,impresor) RETURNING imprime,negrilla_on,negrillas_of,
doble_on,doble_off,comp_on,comp_off,
doce,normal,archivo,copia
}
CALL ccprrp005()
END MAIN
FUNCTION ccprrp005()
# WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM ccfmrp005 FROM "ccfmrp005"
DISPLAY FORM ccfmrp005
DISPLAY "ccprrp005" AT 4,3
DISPLAY "Documentos" AT 6,35
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
CONSTRUCT criterio ON a.cod_emp,a.tipo_cliente,a.sec_cliente,a.num_doc,a.tipo_doc
FROM localidad,tipo_cliente,sec_cliente,num_doc,tipo
AFTER CONSTRUCT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
END CONSTRUCT
INPUT BY NAME fecha_inicial,fecha_final,grafico
{ AFTER FIELD tipo
IF tipo is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
SELECT UNIQUE tipo_doc FROM cctb00001 WHERE tipo_doc = tipo
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
}
AFTER FIELD fecha_inicial
IF fecha_inicial is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_inicial
END IF
BEFORE FIELD fecha_final
LET fecha_final = today
DISPLAY BY NAME fecha_final
AFTER FIELD fecha_final
IF fecha_final is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_final
END IF
IF fecha_final < fecha_inicial THEN
LET numero_msg = 86
CALL msg(numero_msg)
NEXT FIELD fecha_final
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
SELECT a.* INTO p_companias.* FROM companias a
LET selec3 =
"SELECT a.cuenta_no,a.num_doc, a.fecha_orig, a.aplica_a, a.tipo_cliente, ",
"a.sec_cliente,a.valor,a.monto_desc,a.status_t,b.nombre,' ', a.num_cheque,a.cod_emp, ",
"c.sucnombre,d.chitbis,a.tipo_doc ",
"FROM cctb00001 a LEFT OUTER JOIN sucursales c on a.cod_emp=c.sucid LEFT OUTER JOIN ",
"cctb00011 d ",
"ON a.num_doc = d.num_doc and a.tipo_doc = d.tipo_Doc ,vetb00004 b ",
"WHERE a.fecha_orig between ? and ? ",
"and ",
" a.tipo_cliente=b.tipo_cliente AND a.sec_cliente=b.sec_cliente AND ",
CRITERIO clipped,
" ORDER BY a.num_doc "
DISPLAY "<< Estoy Buscando los Documentos. >>" AT 19,14
ATTRIBUTE (REVERSE,BOLD)
DISPLAY " " AT 19,14
DISPLAY " " AT 19,14
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
LET progreso = 20
DISPLAY progreso TO progreso
CALL ui.Interface.refresh()
PREPARE cobros_locales FROM selec3
DECLARE lrecibos CURSOR FOR cobros_locales
OPEN lrecibos USING fecha_inicial, fecha_final
LET idx = 1
LET salir = "N"
WHILE salir = "N"
FETCH lrecibos INTO cobros.*,tipo
IF status = NOTFOUND THEN
LET salir = "S"
EXIT WHILE
END IF
IF idx = 1 THEN
IF grafico = "SI" THEN
LET r_filename='ccprrp005.4rp'
IF fgl_report_loadCurrentSettings(r_filename) THEN -- load the .4rp file
LET preview=1
CALL seleccionarsalida() RETURNING r_output
CALL fgl_report_selectDevice(r_output) -- changing default
CALL fgl_report_selectPreview(preview) -- changing default
LET handler = fgl_report_commitCurrentSettings() -- commit changes
END IF
START REPORT cobros_ft TO XML HANDLER HANDLER
ELSE
{ 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 cobros_ft TO archivo
END IF
END IF
IF cobros.monto_recibo IS NULL THEN
LET cobros.monto_recibo = 0
END IF
IF cobros.descuento IS NULL THEN
LET cobros.descuento = 0
END IF
IF cobros.monto_recibo < 0 THEN
LET cobros.monto_recibo = cobros.monto_recibo * -1
END IF
IF cobros.DESCUENTO < 0 THEN
LET cobros.descuento = cobros.descuento * -1
END IF
LET idx = idx +1
IF tipo = "AV" AND cobros.factura != cobros.recibo THEN
LET cobros.descuento = 0
LET cobros.monto_recibo = 0
CONTINUE WHILE
END IF
IF cobros.status_t = "E" THEN
LET cobros.nom_cli = "NULO"
LET cobros.descuento = 0
LET cobros.monto_recibo = 0
END IF
DISPLAY tipo_doc
OUTPUT TO REPORT cobros_ft(cobros.*,tipo)
LET progreso = progreso + 1
IF progreso > 80 THEN
LET progreso = 80
END IF
DISPLAY progreso TO progreso
CALL ui.Interface.refresh()
LET idx = idx +1
END WHILE
LET progreso = 100
DISPLAY progreso TO progreso
CALL ui.Interface.refresh()
IF idx = 1 THEN
CALL fgl_winmessage("ERROR","NO EXISTEN DATOS CON ESAS CONDICIONES","INFO")
ELSE
FINISH REPORT cobros_ft
END IF
IF grafico <> "SI" THEN
RUN imprime
END IF
END FUNCTION
{REPORT cobros_ft(x)
DEFINE x RECORD
cuenta_no CHAR(8),
recibo INTEGER,
fecha_recibo DATE,
factura INTEGER,
tipo_cliente SMALLINT,
sec_cliente SMALLINT,
monto_recibo DECIMAL(12,2),
descuento DECIMAL(12,2),
status_t CHAR(1),
nom_cli CHAR(30),
descripcion CHAR(30),
documento INT,
cod_cia SMALLINT,
localidad CHAR(40),
chitbis CHAR(2)
END RECORD
DEFINE total4,total5,total6 DECIMAL(12,2)
DEFINE nombre_rp CHAR(20)
DEFINE hora CHAR(5),
otro_num INT
OUTPUT
LEFT MARGIN 0
RIGHT MARGIN 86
TOP MARGIN 0
BOTTOM MARGIN 0
PAGE LENGTH 66
ORDER BY x.recibo,x.factura
FORMAT
PAGE HEADER
IF grafico <> "SI" THEN
LET doble_on = ASCII 14
LET doble_off = ASCII 20
LET comp_on = ASCII 15
LET comp_off = ASCII 18
LET doce = ASCII 27, ASCII 77
LET normal = ASCII 27, ASCII 80
ELSE
LET doble_on = NULL
LET doble_off = NULL
LET comp_on = NULL
LET comp_off = NULL
LET doce = NULL
LET normal = NULL
LET negrilla_on =NULL
END IF
LET hora = time
LET lj = (110 - LENGTH(p_companias.nombre CLIPPED))/2
PRINT COLUMN 1, comp_on, negrilla_on
PRINT COLUMN 1, "ccprrp005",
COLUMN lj, p_companias.nombre CLIPPED,
COLUMN 103, "Pag. ",pageno using "###"
PRINT COLUMN 39, "Sistema de Cuentas por Cobrar",
COLUMN 101, today using "dd/mm/yyyy"
IF tipo = "AV" THEN
LET nombre_rp = "AVANCE ORDEN "
END IF
IF tipo = "FE" THEN
LET nombre_rp = "Factura Export."
END IF
IF tipo = "FT" THEN
LET nombre_rp = "Factura Local "
END IF
IF tipo = "PC" THEN
LET nombre_rp = "Pago de Contado"
END IF
IF tipo = "PG" THEN
LET nombre_rp = "Recibos de pago"
END IF
IF tipo = "NC" THEN
LET nombre_rp = "Notas de Creditos"
END IF
IF tipo = "OC" THEN
LET nombre_rp = "Otros Creditos"
END IF
IF tipo = "OD" THEN
LET nombre_rp = "Otros Debitos"
END IF
IF tipo = "ND" THEN
LET nombre_rp = "Notas de Debito"
END IF
PRINT COLUMN 46, nombre_rp,
COLUMN 106, hora
PRINT COLUMN 42, "Del ", fecha_inicial using "dd/mm/yyyy",
" Al ", fecha_final using "dd/mm/yyyy"
SKIP 1 LINES
PRINT COLUMN 1,
"--------------------------------------------------",
"--------------------------------------------------",
"--------------------------"
PRINT COLUMN 2, "Recibo",
COLUMN 10, "Fecha",
COLUMN 18, "Afecta",
COLUMN 26, "C l i e n t e",
COLUMN 74, "Monto",
COLUMN 86, "Descuento",
COLUMN 107, "Neto" ,
COLUMN 118, "LOCALIDAD",
2 spaces, x.chitbis
PRINT COLUMN 1,
"--------------------------------------------------",
"--------------------------------------------------" ,
"--------------------------"
# , negrillas_off
ON EVERY ROW
WHENEVER ERROR CONTINUE
#BUSCA RELACION DE NUMEROS
LET otro_num = NULL
SELECT a.num_trans INTO otro_num FROM cctb00020 a
WHERE a.num_oc = x.recibo and a.tipo_doc =tipo
IF tipo = "FE" OR tipo = "FT" THEN
LET x.documento=NULL
SELECT a.conduce INTO x.factura FROM vetb00002 a WHERE a.factura = x.recibo
END IF
PRINT COLUMN 2, x.recibo using "######",
COLUMN 9, x.fecha_recibo using "dd/mm/yyyy";
IF tipo <> 'AV' THEN
PRINT COLUMN 20, x.factura using "######";
ELSE
PRINT COLUMN 20, x.documento using "&&&&&&";
END IF
PRINT COLUMN 27, x.tipo_cliente using "&&","-",
x.sec_cliente using "&&&&&&"," ", x.nom_cli clipped,
COLUMN 67, x.monto_recibo using "---,---,---.##",
COLUMN 82, x.descuento using "---,---,---.##",
COLUMN 98, x.monto_recibo - x.descuento using "---,---,---.##"," ",
otro_num USING "&&&&&&",
COLUMN 115,x.localidad
AFTER GROUP OF x.recibo
IF GROUP COUNT(*) > 1 THEN
PRINT COLUMN 64, "--------------",
COLUMN 80, "--------------",
COLUMN 96, "--------------"
PRINT COLUMN 67, GROUP SUM(x.monto_recibo) using "---,---,---.##",
COLUMN 82, GROUP SUM(x.descuento) using "---,---,---.##",
COLUMN 99, GROUP SUM(x.monto_recibo-x.descuento)
using "---,---,---.##"
END IF
SKIP 1 LINE
ON LAST ROW
SKIP 1 LINE
PRINT
COLUMN 35, "Totales --> ",
COLUMN 67, SUM(x.monto_recibo) using "--,---,---,---.##",
COLUMN 85, SUM(x.descuento) using "--,---,---,---.##",
COLUMN 103, SUM(x.monto_recibo-x.descuento)
using "--,---,---,---.##"
PRINT normal
LET total4 = 0
LET total5 = 0
LET total6 = 0
END REPORT
}
REPORT cobros_ft(x,tipo)
DEFINE x RECORD
cuenta_no CHAR(8),
recibo INTEGER,
fecha_recibo DATE,
factura INTEGER,
tipo_cliente SMALLINT,
sec_cliente SMALLINT,
monto_recibo DECIMAL(12,2),
descuento DECIMAL(12,2),
status_t CHAR(1),
nom_cli CHAR(30),
descripcion CHAR(30),
documento INT,
cod_cia SMALLINT,
localidad CHAR(40),
chitbis CHAR(2)
END RECORD,
tipo CHAR(3)
DEFINE total4,total5,total6,neto,total7,total8,total9 DECIMAL(12,2)
DEFINE nombre_rp CHAR(20)
DEFINE hora CHAR(5),
otro_num INT,fecha DATE,documento int
ORDER BY tipo,x.recibo,x.factura
FORMAT
FIRST PAGE HEADER
LET fecha = today
LET hora = time
{ SELECT distinct a.tipo_doc INTO tipo FROM cctb00001 a
WHERE a.num_doc=x.recibo
}
# Se movio a ON EVERY ROW para que "Afecta" se calcule por cada fila.
# Aqui (FIRST PAGE HEADER) corria una sola vez y repetia la misma
# factura para todo el grupo (ej. las notas de credito).
#IF tipo <> 'AV' THEN
# LET documento=x.factura
#ELSE
# LET documento=x.documento
#END IF
{ BEFORE GROUP OF tipo
IF tipo = "AV" THEN
LET nombre_rp = "AVANCE ORDEN "
END IF
IF tipo = "FE" THEN
LET nombre_rp = "Factura Export."
END IF
IF tipo = "FT" THEN
LET nombre_rp = "Factura Local "
END IF
IF tipo = "PC" THEN
LET nombre_rp = "Pago de Contado"
END IF
IF tipo = "PG" THEN
LET nombre_rp = "Recibos de pago"
END IF
IF tipo = "NC" THEN
LET nombre_rp = "Notas de Creditos"
END IF
IF tipo = "OC" THEN
LET nombre_rp = "Otros Creditos"
END IF
IF tipo = "OD" THEN
LET nombre_rp = "Otros Debitos"
END IF
IF tipo = "ND" THEN
LET nombre_rp = "Notas de Debito"
END IF}
BEFORE GROUP OF tipo
LET total7=0
LET total8=0
LET total9=0
after GROUP OF tipo
LET total7=GROUP sum(x.monto_recibo)
LET total8=GROUP sum(x.descuento)
LET total9=total7-total8
PRINTX total7,total8,total9
ON EVERY ROW
LET neto=x.monto_recibo-x.descuento
# WHENEVER ERROR CONTINUE
#BUSCA RELACION DE NUMEROS
LET otro_num = NULL
SELECT a.num_trans INTO otro_num FROM cctb00020 a
WHERE a.num_oc = x.recibo and a.tipo_doc =tipo
IF tipo = "FE" OR tipo = "FT" THEN
LET x.documento=NULL
SELECT a.conduce INTO x.factura FROM vetb00002 a WHERE a.factura = x.recibo
END IF
# "Afecta" se debe calcular por cada fila. Antes se asignaba una sola vez
# en FIRST PAGE HEADER, por lo que todas las filas (ej. un grupo de NC)
# salian con la misma factura.
IF tipo <> 'AV' THEN
LET documento = x.factura
ELSE
LET documento = x.documento
END IF
printx x.*,otro_num,fecha_inicial,fecha_final,p_companias.*,fecha,
documento,neto,tipo,nombre_rp
# AFTER GROUP OF x.recibo
ON LAST ROW
LET total4 = 0
LET total5 = 0
LET total6 = 0
LET total4=SUM(x.monto_recibo)
LET total5=SUM(x.descuento)
LET total6=total4-total5
PRINTX total4,total5,total6
END REPORT
Reference in New Issue View Git Blame Copy Permalink