Files
MBS/PROYECTO/indir/inprrp028.4gl
T
jpegueroandClaude Sonnet 5 4532d51e4b Prueba inprrp011 (completo) e inprrp028 (matricial completo, PDF pendiente)
- Corrige selectOutput()/seleccionarSalida()/configureOutput() en
  defecto.4gl para usar la API real fgl_report_* (Report Writer 2.0),
  reemplazando los stubs previos. Reutiliza el formulario Configuration
  ya existente en el proyecto (FUNCIONESREPORT)
- inprrp011: quita el START REPORT forzado a XML roto (media migracion
  abandonada), probado completo: filtros, totales/subtotales vs
  produccion, exportacion PDF/Excel/Pantalla funcionando
- inprrp028: mismo patron, restaura Sietesalida) - No/matricial
  como respaldo. Crea bin/inprrp028.4rp (diseno de reporte, no existia)
  para la salida grafica; carga sin error de formato pero la
  generacion no completa en este entorno - pendiente de revisar
  rendimiento/recursos

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-09-03 16:52:39 -04:00

455 lines
14 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : INPRRP028
OBJETIVO : REPORTE EXISTENCIAS
Con Entradas y Salidas.
PROGRAMADOR : Ing. Juan F. Soto
FECHA REALIZACION : Agosto 17, 1994.
-------------------------------------------------------------------------------
}
GLOBALS "inprgb000.4gl"
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 inprrp028()
END MAIN
FUNCTION inprrp028()
DEFINE mes CHAR(2)
DEFINE idx_ant,idx_cos,idx_act SMALLINT
DEFINE ano_act CHAR(4)
DEFINE salir,primera CHAR(1)
DEFINE balance_in DECIMAL(12,2)
DEFINE existe RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
existe_ant DECIMAL(10,2),
existe_act DECIMAL(10,2),
bodega SMALLINT,
titulo_bodega VARCHAR(100),
costo LIKE intb00013.costo_st
END RECORD
DEFINE costos RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
fecha CHAR(2),
costo_st LIKE intb00013.costo_st
END RECORD
DEFINE actual RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
balance LIKE intb00006.cantidad_2
END RECORD
DEFINE anterior RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
balance LIKE intb00006.cantidad_2
END RECORD
DEFINE select_cost,select_act,select_ant,titulo_bodega STRING
# WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM infmrp028 FROM "infmrp028"
DISPLAY FORM infmrp028
LABEL vuelve:
INPUT BY NAME datos_cons.fech_in,datos_cons.fech_fi,datos_cons.bodega
BEFORE INPUT
CALL bodegas('1')
AFTER FIELD fech_in
IF datos_cons.fech_in IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
GOTO vuelve
END IF
AFTER FIELD fech_fi
IF datos_cons.fech_fi IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
GOTO vuelve
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
EXIT PROGRAM
END IF
IF datos_cons.bodega IS NULL THEN
CALL msg(16)
NEXT FIELD bodega
END IF
LET titulo_bodega = ui.ComboBox.forName('formonly.bodega').getTextOf(datos_cons.bodega)
END INPUT
LET ano_act = year(datos_cons.fech_fi)
CONSTRUCT criterio ON d.cod_n,d.cod_grupo,
d.cod_tipo,d.cod_sec
FROM
cod_n,cod_grupo,
cod_tipo,cod_sec
LET select_cost =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,max(b.mes_fin), ",
"b.costo_st,b.mes_ini ",
"FROM intb00013 b,intb00002 a ",
"WHERE b.ano = ? and ",
"a.cod_n = b.cod_n and ",
"a.cod_grupo = b.cod_grupo and ",
"a.cod_tipo = b.cod_tipo and ",
"a.cod_sec = b.cod_sec and ",
"b.status_t is null ",
"GROUP BY a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
"b.costo_st,b.mes_ini ",
"ORDER BY a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
"b.costo_st,b.mes_ini "
DISPLAY "<< Estoy Buscando Los Costos Actuales >>"
AT 19,14 ATTRIBUTE (REVERSE,BOLD)
DISPLAY " "
AT 19,14
LET select_ant =
"SELECT cod_n,cod_grupo,cod_tipo,cod_sec,sum(cantidad_2) ",
"FROM intb00006 WHERE ",
"status_t is null and ",
"fecha < ? and bodega = ? ",
"GROUP BY cod_n,cod_grupo,cod_tipo,cod_sec ",
"ORDER BY cod_n,cod_grupo,cod_tipo,cod_sec"
DISPLAY "<< Estoy Buscando Los Balances Anteriores >>"
AT 19,14 ATTRIBUTE (REVERSE,BOLD)
DISPLAY " "
AT 19,14
LET SELEC = "SELECT d.cod_n,d.cod_grupo,d.cod_tipo,d.cod_sec, ",
"d.descrip_esp,d.unidad_med ",
" FROM intb00001 d, intb00002 b ",
" WHERE ",
"d.cod_n = b.cod_n AND ",
"d.cod_grupo = b.cod_grupo AND ",
"d.cod_tipo = b.cod_tipo AND ",
"d.cod_sec = b.cod_sec AND ",
"d.status_t is null AND ",
criterio clipped,
" ORDER BY 1,2,3,4"
DISPLAY "<< Estoy Buscando Las Materias Primas >>"
AT 19,14 ATTRIBUTE (REVERSE,BOLD)
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
DISPLAY " "
AT 19,14
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
LET opt1 = fgl_winquestion("Atencion","Desea Reporte Grafico?",
"no","yes|no","question",0)
IF opt1 = "yes" THEN
CALL seleccionarsalida() RETURNING r_output
CALL configureOutputRp028(r_output) RETURNING HANDLER
START REPORT prt_exist 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 prt_exist TO archivo
END IF
LET idx_ant = 1
LET idx_act = 1
LET idx_cos = 1
PREPARE busca_costo FROM select_cost
DECLARE material_costo SCROLL CURSOR FOR busca_costo
OPEN material_costo USING ano_act
PREPARE busca_ant FROM select_ant
DECLARE busca_balan_ant SCROLL CURSOR FOR busca_ant
OPEN busca_balan_ant USING datos_cons.fech_in,datos_cons.bodega
PREPARE busca FROM selec
DECLARE accion CURSOR FOR busca
OPEN accion
WHILE status != notfound
FETCH accion INTO existe.*
IF status = notfound THEN
EXIT WHILE
END IF
# Busqueda de los costos actuales
LET existe.existe_ant = 0
LET existe.existe_act = 0
LET existe.costo = 0
LET salir = "N"
WHILE salir != "S"
FETCH ABSOLUTE idx_cos material_costo INTO costos.*
IF status = notfound THEN
LET idx_cos = 1
LET salir = "S"
EXIT WHILE
END IF
LET idx_cos = idx_cos + 1
IF costos.cod_n = existe.cod_n AND
costos.cod_grupo = existe.cod_grupo AND
costos.cod_tipo = existe.cod_tipo AND
costos.cod_sec = existe.cod_Sec THEN
LET salir = "S"
LET existe.costo = costos.costo_st
END IF
IF salir = "S" THEN
LET idx_cos = 1
EXIT WHILE
END IF
END WHILE
# Busqueda de los balances anteriores
LET salir = "N"
WHILE salir != "S"
FETCH ABSOLUTE idx_ant busca_balan_ant INTO anterior.*
IF status = notfound THEN
LET idx_ant = 1
LET salir = "S"
EXIT WHILE
END IF
LET idx_ant = idx_ant + 1
IF anterior.cod_n = existe.cod_n AND
anterior.cod_grupo = existe.cod_grupo AND
anterior.cod_tipo = existe.cod_tipo AND
anterior.cod_sec = existe.cod_Sec THEN
LET salir = "S"
IF anterior.balance IS NULL THEN
LET anterior.balance = 0
END IF
LET existe.existe_ant = anterior.balance
END IF
IF salir = "S" THEN
LET idx_ant = 1
EXIT WHILE
END IF
END WHILE
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
OUTPUT TO REPORT prt_exist(existe.*)
END WHILE
FINISH REPORT prt_exist
CLEAR SCREEN
IF opt1 <> "yes" THEN
RUN imprime
END IF
END FUNCTION
REPORT prt_exist(x)
DEFINE x RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
existe_ant DECIMAL(10,2),
existe_act DECIMAL(10,2),
bodega SMALLINT,
titulo_bodega VARCHAR(100),
costo LIKE intb00013.costo_st
END RECORD
DEFINE entradas,salidas,total_c,total_p DECIMAL (12,2)
DEFINE doble_on CHAR(2)
DEFINE doble_off CHAR(2)
DEFINE negrillas_on CHAR(2)
DEFINE negrillas_off CHAR(2)
DEFINE comp_on CHAR(3)
DEFINE comp_off CHAR(3)
DEFINE doce CHAR(3)
DEFINE hora CHAR(5)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 0
PAGE LENGTH 100
FORMAT
PAGE HEADER
{ 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 hora = time
LET lj = (100 - LENGTH(p_companias.nombre CLIPPED))/2
PRINT COLUMN 1, comp_off,doce
PRINT COLUMN 1,"inprrp028",
COLUMN lj, p_companias.nombre CLIPPED,
COLUMN 92, "Pag. ",pageno using "###"
PRINT COLUMN 28, " Sistema de Inventario de Materia Prima",
COLUMN 92, today using "dd/mm/yyyy"
PRINT COLUMN 28, " Existencia Con Entrada y Salida",
COLUMN 95, hora
PRINT COLUMN 1,comp_on
PRINT COLUMN 1,"Movimientos Del: ",
datos_cons.fech_in using "dd/mm/yyyy",
" AL ",
datos_cons.fech_fi using "dd/mm/yyyy"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"----------------------------------------------------"
PRINT COLUMN 90, "| MOVIMIENTOS |"
PRINT COLUMN 77, "EXISTENCIA",
COLUMN 90, "|-----------------------|",
COLUMN 121, "EXISTENCIA",
COLUMN 133, "COSTO",
COLUMN 142, "TOTAL"
PRINT COLUMN 1, "CODIGO",
COLUMN 12, "DESCRIPCION",
COLUMN 75, "AL ",datos_cons.fech_in - 1 using "dd/mm/yyyy",
COLUMN 90, "| ENTRADAS",
COLUMN 106, "SALIDAS |",
COLUMN 117, "AL ", datos_cons.fech_fi using "dd/mm/yyyy"{,
COLUMN 133, "STANDARD",
COLUMN 142, "AL ",datos_cons.fech_fi using "dd/mm/yyyy"}
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"----------------------------------------------------"
SKIP 1 LINE
ON EVERY ROW
# Busqueda de las entradas en el rango
SELECT SUM(a.cantidad_2) INTO entradas
FROM intb00006 a
WHERE a.cod_n = x.cod_n and a.cod_grupo = x.cod_grupo and
a.cod_tipo = x.cod_tipo and a.cod_sec = x.cod_sec and
a.fecha between datos_cons.fech_in and datos_cons.fech_fi and
a.cantidad_2 > 0 and a.status_t is null
IF status = notfound THEN
LET entradas = 0
END IF
IF entradas is null THEN
LET entradas = 0
END IF
# Busqueda de las salidas en el rango
SELECT SUM(a.cantidad_2) * -1 INTO salidas
FROM intb00006 a
WHERE a.cod_n = x.cod_n and
a.cod_grupo = x.cod_grupo and
a.cod_tipo = x.cod_tipo and
a.cod_sec = x.cod_sec and
a.fecha between datos_cons.fech_in and
datos_cons.fech_fi and
a.cantidad_2 < 0 and
a.status_t is null
IF salidas is null THEN
LET salidas = 0
END IF
IF total_p is null THEN
LET total_p = 0
END IF
LET x.existe_act = x.existe_ant + entradas - salidas
LET total_c = x.existe_act * x.costo
LET total_p = total_c + total_p
PRINT COLUMN 1, x.cod_n USING "&","-",
COLUMN 3, x.cod_grupo USING "&","-",
COLUMN 5, x.cod_tipo USING "&&","-",
COLUMN 8, x.cod_sec USING "&&&",
COLUMN 12, x.descrip_esp,
COLUMN 42, x.unidad_med,
COLUMN 45, x.existe_ant USING "---,---,---.##",
COLUMN 61, entradas using "##,###,###.##",
COLUMN 75, salidas using "##,###,###.##",
COLUMN 90, x.existe_act USING "---,---,---.##"{,
COLUMN 110, x.costo USING "#,###,###.####",
COLUMN 130, total_c USING "##,###,###.##"}
ON LAST ROW
# PRINT COLUMN 143, "-------------"
# PRINT COLUMN 143, total_p USING "##,###,###.##"
LET total_p = 0
SKIP 2 LINES
PRINT COLUMN 1, "==================================================",
"==================================================",
"======================================================="
PRINT COLUMN 4, "Total Registros Impresos =", count(*) USING "<<<<"
PRINT COLUMN 4, ASCII 27, ASCII 80
END REPORT
FUNCTION configureOutputRp028(tipo_file)
DEFINE tipo_file CHAR(3)
IF NOT fgl_report_loadCurrentSettings("inprrp028.4rp") THEN
RETURN NULL
END IF
CALL fgl_report_setPageMargins("0.5cm", "0.5cm", "0.5cm", "0.5cm")
CALL fgl_report_selectDevice(tipo_file)
CALL fgl_report_configurexlsxdevice(NULL, NULL, NULL, FALSE, FALSE, NULL, 1)
CALL fgl_report_selectPreview(TRUE)
RETURN fgl_report_commitCurrentSettings()
RETURN NULL
END FUNCTION