jsoto/MBS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
MBS/PROYECTO/cpdir/cpprrp002.4gl
T
Abel LópezandClaude Sonnet 5 fa1b51c33e Añadir cpprrp002, cpprrp003 y cpprrp004; corregir reportes XML y formulario cpfmrp002 
- cpprgb000/msgrp000: restaurar getPreviewDevice con case correcto
  (ui.Interface.frontCall) y dejar configureOutput como stub, ya que la
  API fgl_report_* no existe en este FGL 6.00.01.
- cpprrp002/003/004: sustituir configureoutput()/handler roto por
  om.XmlWriter.createFileWriter escribiendo a FGLSPOOL, usando STRING
  para la ruta (CHAR(80) truncaba la ruta larga del proyecto).
- cpfmrp002.per: agregar campo faltante "Salida" (r_output) que el
  programa ya esperaba.
- mbsERP.4pw: registrar cpprrp002/003/004 con sus dependencias,
  entorno FGLSPOOL y configuracion de prueba.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-08-24 17:04:18 -04:00

403 lines
13 KiB
Plaintext
Raw Permalink Blame History

{
-------------------------------------------------------------------------------
PROGRAMA : CPPRRP002
OBJETIVO : Saldos por Antiguedad
PROGRAMADOR : Tadeo A. Ferreras
FECHA REALIZACION : Junio 16, 1993
-------------------------------------------------------------------------------
}
GLOBALS "cpprgb000.4gl"
DEFINE fecha_corte DATE
DEFINE cod_sp1 SMALLINT
DEFINE idx_1, idx_2 SMALLINT
DEFINE p_reportfile STRING
DEFINE doccli9 RECORD
cod_sp SMALLINT,
cod_sp_sec SMALLINT,
nombre CHAR(30),
tipo_doc CHAR(2),
fecha_doc DATE,
num_doc CHAR(10),
suplidor CHAR(6)
END RECORD
DEFINE tot_gen2 RECORD
total1 DECIMAL(10,2),
total2 DECIMAL(10,2),
total3 DECIMAL(10,2),
total4 DECIMAL(10,2),
total5 DECIMAL(10,2),
total6 DECIMAL(10,2)
END RECORD
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
CONNECT to "smarmotech" user usuarios USING clave
SELECT * INTO p_companias.* FROM companias
CALL cpprrp002()
END MAIN
FUNCTION cpprrp002()
DEFINE valor1,valor2,valor3 DECIMAL(12,2)
# WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM cpfmrp002 FROM "cpfmrp002"
DISPLAY FORM cpfmrp002
# CALL pantalla()
# DISPLAY "cpprrp002" AT 4,3
# DISPLAY "Saldos por Antiguedad" AT 6,29
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
INPUT BY NAME fecha_corte,cod_sp1,r_output
BEFORE FIELD fecha_corte
LET fecha_corte = today
AFTER FIELD fecha_corte
IF fecha_corte is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_corte
END IF
AFTER FIELD cod_sp1
IF cod_sp1 is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_sp1
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
# Busca valor de las facturas cuyas fechas de vencimiento son menores
# a la fecha de corte
DECLARE ft_valor CURSOR FOR
SELECT a.cod_sp,a.cod_sp_sec,b.nom_sp,a.tipo_doc,a.fecha_orig,a.num_doc
FROM cptb00001 a,cotb00001 b
WHERE a.cod_sp = b.cod_sp and a.cod_sp_sec = b.cod_sp_sec and
a.fecha_orig <= fecha_corte and a.cod_sp = cod_sp1 and
a.status_t is null AND (a.aplica_a = a.num_doc OR a.tipo_doc = "CP")
# GROUP BY 1,2,3,4,6
DISPLAY "<< Buscando Informacion ... Espere Por Favor. >>" AT 19,14
ATTRIBUTE (REVERSE,BOLD)
DISPLAY " " AT 19,14
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
LET idx = 1
FOREACH ft_valor INTO doccli9.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
EXIT FOREACH
END IF
IF idx = 1 THEN
IF r_output = 'MA' THEN
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 reporte31 TO archivo
ELSE
-- La API de configuracion de reportes (fgl_report_*) no esta
-- disponible en este FGL; se escribe el XML directo a un archivo
-- en FGLSPOOL en lugar de la vista previa/exportacion nativa.
LET p_reportfile = FGL_GETENV("FGLSPOOL"), "/cpprrp002_saldos.xml"
LET handler = om.XmlWriter.createFileWriter(p_reportfile)
START REPORT reporte31 TO XML HANDLER handler
END IF
END IF
LET doccli9.suplidor = doccli9.cod_sp using "&&",
doccli9.cod_sp_sec using "&&&&"
OUTPUT TO REPORT reporte31(doccli9.*)
LET idx = idx + 1
END FOREACH
IF idx > 1 THEN
FINISH REPORT reporte31
ELSE
CALL fgl_winmessage("INFO","NO EXISTE INFORMACIONES CON ESTA CONDICION","INFO")
END IF
DISPLAY BY NAME tot_gen2.*
LET tot_gen2.total1 = 0
LET tot_gen2.total2 = 0
LET tot_gen2.total3 = 0
LET tot_gen2.total4 = 0
LET tot_gen2.total6 = 0
LET tot_gen2.total5 = 0
IF r_output= 'MA' THEN
PROMPT "Desea Imprimir Reporte [S/N]......?" FOR CHAR opt
LET opt = UPSHIFT(opt)
IF opt = "S" THEN
RUN imprime
END IF
END IF
END FUNCTION
REPORT reporte31(x)
DEFINE x RECORD
cod_sp SMALLINT,
cod_sp_sec SMALLINT,
nombre CHAR(30),
tipo_doc CHAR(2),
fecha_doc DATE,
num_doc CHAR(10),
suplidor CHAR(6)
END RECORD
DEFINE valor1,valor2,valor3,valor4 DECIMAL(12,2)
DEFINE doble_on CHAR(2)
DEFINE doble_off CHAR(2)
DEFINE negrillas_on CHAR(6)
DEFINE negrillas_off CHAR(6)
DEFINE comp_on CHAR(6)
DEFINE comp_off CHAR(6)
DEFINE doce CHAR(2)
DEFINE normall CHAR(3)
DEFINE normal CHAR(2)
DEFINE hora CHAR(5)
DEFINE fecha_factura DATE
DEFINE de1a30, de31a45, de46a60, masde60, total_saldo,
mas120 DECIMAL(12,2)
DEFINE tm120,t30, t45, t60, tm60, tsaldo DECIMAL(12,2)
DEFINE dias INTEGER
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 2
ORDER BY x.suplidor
FORMAT
PAGE HEADER
IF r_output = 'MA' THEN
LET doble_on = ASCII 14
LET doble_off = ASCII 20
LET negrillas_on = ASCII 27, ASCII 69
LET negrillas_off = ASCII 27, ASCII 70
LET comp_on = ASCII 15
LET comp_off = ASCII 18
LET doce = ASCII 27, ASCII 77
LET normal = ASCII 27, ASCII 80
END IF
LET hora = time
LET lj = (123 - LENGTH(p_companias.nombre CLIPPED))/2
PRINT COLUMN 1, comp_on
PRINT COLUMN 1, "cpprrp002",
COLUMN lj, p_companias.nombre CLIPPED,
COLUMN 116, "Pag. ",pageno using "###"
PRINT COLUMN 47, "Sistema de Cuentas por Pagar",
COLUMN 114, today using "dd/mm/yyyy"
PRINT COLUMN 45, "Saldos por Antiguedad al ",
fecha_corte using "dd/mm/yy",
COLUMN 119, hora
PRINT COLUMN 53, "Valores en RD$"
SKIP 1 LINES
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"--------------------------------------"
PRINT COLUMN 2, "S u p l i d o r",
COLUMN 46, "De 1 a 30",
COLUMN 66, "De 31 a 60",
COLUMN 82, "De 61 a 90",
COLUMN 99, "91 a 120",
COLUMN 113, "Mas de 120",
COLUMN 133, "Total"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"--------------------------------------"
BEFORE GROUP OF x.suplidor
LET de1a30 = 0
LET de31a45 = 0
LET de46a60 = 0
LET masde60 = 0
LET mas120 = 0
ON EVERY ROW
LET valor3 = 0
IF x.tipo_doc = "CP" THEN
SELECT SUM(a.valor) INTO valor1 FROM cptb00001 a
WHERE a.cod_sp = x.cod_sp AND a.cod_sp_sec = x.cod_sp_sec AND
a.tipo_doc = "CP" AND a.aplica_a IS NULL AND a.num_doc=x.num_doc
AND a.status_t IS NULL AND a.fecha_orig <= fecha_corte
SELECT SUM(a.valor) INTO valor2 FROM cptb00001 a
WHERE a.cod_sp = x.cod_sp AND a.cod_sp_sec = x.cod_sp_sec AND
a.tipo_doc="CP" AND a.aplica_a IS NOT NULL AND a.num_doc=x.num_doc
AND a.status_t IS NULL AND a.fecha_orig <= fecha_corte
IF valor1 IS NULL THEN
LET valor1 = 0
END IF
IF valor2 IS NULL THEN
LET valor2 = 0
END IF
LET valor3 = valor1 - valor2
ELSE
SELECT SUM(a.valor) INTO valor3 FROM cptb00001 a
WHERE a.cod_sp = x.cod_sp AND a.cod_sp_sec = x.cod_sp_sec AND
a.aplica_a = x.num_doc AND a.status_t IS NULL AND
a.fecha_orig <= fecha_corte
END IF
IF valor3 IS NULL THEN
LET valor3 = 0
END IF
IF x.fecha_doc IS NULL THEN
LET x.fecha_doc = 0
END IF
LET dias = fecha_corte - x.fecha_doc
IF dias < 31 THEN
LET de1a30 = de1a30 + valor3
END IF
IF dias >= 31 AND dias <= 60 THEN
LET de31a45 = de31a45 + valor3
END IF
IF dias >= 61 AND dias <= 90 THEN
LET de46a60 = de46a60 + valor3
END IF
IF dias > 90 AND dias <= 120 THEN
LET masde60 = masde60 + valor3
END IF
IF dias > 120 THEN
LET mas120 = mas120 + valor3
END IF
AFTER GROUP OF x.suplidor
IF tm120 IS NULL THEN
LET tm120 = 0
END IF
IF t30 IS NULL THEN
LET t30 = 0
END IF
IF t45 IS NULL THEN
LET t45 = 0
END IF
IF t60 IS NULL THEN
LET t60 = 0
END IF
IF tm60 IS NULL THEN
LET tm60 = 0
END IF
IF tsaldo IS NULL THEN
LET tsaldo = 0
END IF
LET total_saldo = 0
LET total_saldo = de1a30 + de31a45 + de46a60 + masde60 +
mas120
IF total_saldo <> 0 THEN
LET t30 = t30 + de1a30
LET tm120 = tm120 + mas120
LET t45 = t45 + de31a45
LET t60 = t60 + de46a60
LET tm60 = tm60 + masde60
PRINT COLUMN 1, x.cod_sp using "&&", "-",
x.cod_sp_sec using "&&&&", " ",
x.nombre clipped,
COLUMN 40, de1a30 using "(((,(((,(((.##)",
COLUMN 61, de31a45 using "(((,(((,(((.##)",
COLUMN 77, de46a60 using "(((,(((,(((.##)",
COLUMN 93, masde60 using "(((,(((,(((.##)",
COLUMN 109, mas120 using "(((,(((,(((,(((.##)",
COLUMN 125, total_saldo using "(((,(((,(((,(((.##)"
END IF
LET de1a30 = 0
LET de31a45 = 0
LET de46a60 = 0
LET masde60 = 0
LET mas120 = 0
LET total_saldo = 0
ON LAST ROW
SKIP 1 LINE
LET tsaldo = t30 + t45 + t60 + tm60 + tm120
PRINT COLUMN 23, "Totales -->",
COLUMN 41, t30 using "(((,(((,(((.##)",
COLUMN 61, t45 using "(((,(((,(((.##)",
COLUMN 77, t60 using "(((,(((,(((.##)",
COLUMN 93, tm60 using "(((,(((,(((.##)",
COLUMN 109, tm120 using "(((,(((,(((,(((.##)",
COLUMN 125, tsaldo using "(((,(((,(((,(((.##)"
PRINT COLUMN 23, "Porciento -->",
COLUMN 41, (t30/tsaldo)*100 using "(((,(((,(((.##)",
COLUMN 61, (t45/tsaldo)*100 using "(((,(((,(((.##)",
COLUMN 77, (t60/tsaldo)*100 using "(((,(((,(((.##)",
COLUMN 93, (tm60/tsaldo)*100 using "(((,(((,(((.##)",
COLUMN 109, (tm120/tsaldo)*100 using "(((,(((,(((,(((.##)"
LET tot_gen2.total1 = t30
LET tot_gen2.total2 = t45
LET tot_gen2.total3 = t60
LET tot_gen2.total4 = tm60
LET tot_gen2.total6 = tm120
LET tot_gen2.total5 = tsaldo
LET t30 = 0
LET t45 = 0
LET t60 = 0
LET tm60 = 0
LET tm120 = 0
LET tsaldo = 0
PRINT normal
END REPORT
Reference in New Issue View Git Blame Copy Permalink