jsoto/MBS
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
79eff57d70a25633aea6f1b524571b87cd697594
MBS/PROYECTO/ipdir/ipprrp007.4gl
T
jpegueroandClaude Sonnet 5 b6085d4140 Mueve ipdir (Productos Terminados) de PROYECTOS a PROYECTO 
Instruccion de Johnny: todos los directorios de fuentes de inventario
deben migrarse de la carpeta temporal PROYECTOS a la carpeta real
PROYECTO, ya que PROYECTOS sera eliminada.

Se elimino tambien un archivo suelto sin relacion llamado "ipdir"
que existia en PROYECTO (del commit inicial) y bloqueaba el nombre
de la carpeta.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-09-04 09:29:01 -04:00

364 lines
12 KiB
Plaintext
Raw Blame History

{
-------------------------------------------------------------------------------
PROGRAMA : IPPRRP007
OBJETIVO : REPORTE DE MOVIMIENTOS POR DOCUMENTOS
PROGRAMADOR : JUAN SOTO
FECHA REALIZACION : Septiembre 1997
DIRECTOR PROYECTO : JOSE ALFREDO PAULINO ALEJO
-------------------------------------------------------------------------------
}
GLOBALS "ipprgb000.4gl"
DEFINE transacc1 RECORD
cod_n LIKE iptb00006.cod_n,
cod_grupo LIKE iptb00006.cod_grupo,
cod_tipo LIKE iptb00006.cod_tipo,
cod_sec LIKE iptb00006.cod_sec,
descrip_esp LIKE iptb00002.descrip_esp,
unidad_med LIKE iptb00002.unidad_med,
num_doc LIKE iptb00006.num_doc,
fecha LIKE iptb00006.fecha,
cantidad_1 LIKE iptb00006.cantidad_1,
cantidad_2 LIKE iptb00006.cantidad_2,
cod_mov LIKE iptb00006.cod_mov,
descrip_mov LIKE iptb00005.descrip_mov,
conduce_no LIKE iptb00006.conduce_no,
fact_no LIKE iptb00006.fact_no,
orden_compra LIKE iptb00006.orden_compra,
cod_sp LIKE iptb00006.cod_sp,
cod_sp_sec LIKE iptb00006.cod_sp_sec,
estado CHAR(1),
us_anula CHAR(9),
fecha_a LIKE iptb00006.fech_crea,
descrip_ing LIKE iptb00002.descrip_ing,
us_crea LIKE iptb00006.us_crea,
fech_crea DATETIME YEAR TO SECOND,
bodega INT
END RECORD
DEFINE nombre_suplidor CHAR(30)
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 ipprrp007()
END MAIN
FUNCTION ipprrp007()
CLEAR SCREEN
LET int_flag = FALSE
# WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 9
OPEN FORM ipfmrp007 FROM "ipfmrp007"
DISPLAY FORM ipfmrp007
# CALL pantalla()
DISPLAY "ipprrp007" AT 4,3
DISPLAY " Documentos " AT 6,36
LET tipo_papel = 1
# CALL msgrp000(tipo_papel)
CALL bodegas(1)
CONSTRUCT criterio ON a.fecha,a.cod_mov,a.num_doc, a.bodega
FROM fecha,cod_mov,num_doc, bodega
IF int_flag THEN
let numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
let selec = "SELECT a.cod_n, a.cod_grupo, a.cod_tipo, a.cod_sec, ",
" b.descrip_esp,b.unidad_med,a.num_doc,a.fecha, ",
" a.cantidad_1,a.cantidad_2,a.cod_mov,c.descrip_mov, ",
" a.conduce_no,a.fact_no,a.orden_compra,a.cod_sp, ",
" a.cod_sp_sec,a.status_t,a.us_mod,a.fech_mod, ",
" b.descrip_ing, RTRIM(a.us_crea), a.fech_crea, a.bodega ",
"FROM iptb00006 a, iptb00002 b, iptb00005 c ",
"WHERE ",criterio clipped," 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 a.cod_mov = c.cod_mov ",
"ORDER BY a.cod_mov, a.num_doc, a.bodega"
DISPLAY "<< Buscando Informacion ... Espere Por Favor. >>" AT 19,14
ATTRIBUTE(REVERSE,BOLD)
PREPARE busca FROM selec
DECLARE accion CURSOR FOR busca
OPEN accion
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
CALL selectOutput() RETURNING r_output
CALL configureOutput(r_output) RETURNING HANDLER
START REPORT reporte8 TO XML HANDLER handler
WHILE STATUS != NOTFOUND
FETCH accion INTO transacc1.*
IF STATUS = NOTFOUND THEN
EXIT WHILE
ELSE
SELECT nom_sp INTO nombre_suplidor FROM cotb00001
WHERE cod_sp = transacc1.cod_sp and cod_sp_sec = transacc1.cod_sp_sec
IF status = notfound THEN
SELECT a.nombre INTO nombre_suplidor FROM vetb00004 a
WHERE a.tipo_cliente = transacc1.cod_sp and a.sec_cliente = transacc1.cod_sp_sec
IF STATUS = NOTFOUND THEN
LET nombre_suplidor = ' '
END IF
LET status = 0
END IF
OUTPUT TO REPORT reporte8(transacc1.*,nombre_suplidor)
END IF
END WHILE
FINISH REPORT reporte8
END FUNCTION
REPORT reporte8(x,nombre_suplidor)
DEFINE x RECORD
cod_n LIKE iptb00006.cod_n,
cod_grupo LIKE iptb00006.cod_grupo,
cod_tipo LIKE iptb00006.cod_tipo,
cod_sec LIKE iptb00006.cod_sec,
descrip_esp LIKE iptb00002.descrip_esp,
unidad_med LIKE iptb00002.unidad_med,
num_doc LIKE iptb00006.num_doc,
fecha LIKE iptb00006.fecha,
cantidad_1 LIKE iptb00006.cantidad_1,
cantidad_2 LIKE iptb00006.cantidad_2,
cod_mov LIKE iptb00006.cod_mov,
descrip_mov LIKE iptb00005.descrip_mov,
conduce_no LIKE iptb00006.conduce_no,
fact_no LIKE iptb00006.fact_no,
orden_compra LIKE iptb00006.orden_compra,
cod_sp LIKE iptb00006.cod_sp,
cod_sp_sec LIKE iptb00006.cod_sp_sec,
estado CHAR(1),
us_anula CHAR(9),
fecha_a LIKE iptb00006.fech_crea,
descrip_ing LIKE iptb00002.descrip_ing,
us_crea LIKE iptb00006.us_crea,
fech_crea DATETIME YEAR TO SECOND,
bodega INT
END RECORD
DEFINE nombre_suplidor CHAR(30)
DEFINE nombre CHAR(8),
und CHAR(3) ,
doble_on CHAR(2),
doble_off CHAR(2),
negrillas_on CHAR(4),
doce, negrillas_off CHAR(4),
comprimido_on CHAR(2),
comprimido_off CHAR(2),
primera CHAR(1),
hora CHAR(5),
l,dia,mes smallint,
nom_dia,nom_mes CHAR(10),
descrip_bodega VARCHAR(100)
OUTPUT
LEFT 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 doce = ASCII 27, ASCII 77
LET comprimido_on = ASCII 15
LET comprimido_off = ASCII 18}
LET hora = time
LET dia = WEEKDAY(x.fecha)
LET mes = MONTH(x.fecha)
LET dia = dia +1
LET primera = "S"
CALL busca_mes()
LET nom_mes = nombre_mes[mes]
CALL busca_dia()
LET nom_dia = nombre_dia[dia]
LET l = (100 - LENGTH(p_companias.nombre CLIPPED))/2
PRINT COLUMN 3, doce,negrillas_on
PRINT COLUMN 1, "ipprrp007",
COLUMN l, p_companias.nombre CLIPPED,
COLUMN 93, "Pag. ",pageno using "###"
PRINT COLUMN 33, "Sistema de Inventario de Productos",
COLUMN 93, today using "dd/mm/yyyy"
PRINT COLUMN 33, " Documentos",
COLUMN 95, hora
SKIP 1 LINE
PRINT COLUMN 3, nom_dia clipped," ",day(x.fecha) using "&&",
" ",nom_mes clipped," ",year(x.fecha)
PRINT negrillas_off
BEFORE GROUP OF x.bodega
SELECT a.descripcion INTO descrip_bodega FROM intb00009 a WHERE a.cod_bodega = x.bodega
PRINT COLUMN 1, negrillas_on, "Bodega: ", descrip_bodega CLIPPED, negrillas_off
SKIP 1 LINE
BEFORE GROUP OF x.cod_mov
IF x.cod_mov != 99 THEN
PRINT COLUMN 1, negrillas_on,
"Movimiento: ",x.cod_mov USING "&&"," ",x.descrip_mov
PRINT COLUMN 20, "Orden",
COLUMN 52, "Codigo"
PRINT COLUMN 1, "Documento",
COLUMN 11 , "Fecha",
COLUMN 20 , "Compras",
COLUMN 28 , "Conduce",
COLUMN 40 , "Factura",
COLUMN 52 , "Suplidor",
COLUMN 64 , "Nombre Suplidor",
COLUMN 95 , "Creador conduce",
COLUMN 116, "Fecha de creacion"
PRINT COLUMN 1 , negrillas_off
END IF
BEFORE GROUP OF X.num_doc
IF x.estado = "E" THEN
PRINT negrillas_on,"ESTE DOCUMENTO FUE ANULADO ",x.fecha_a
PRINT "USUARIO: ",x.us_anula,negrillas_off
END IF
IF x.cod_mov != 99 THEN
IF x.cod_sp is null THEN
LET nombre_suplidor = null
END IF
SKIP 1 LINE
PRINT COLUMN 1, x.num_doc using "&&&&&&",
COLUMN 11 , x.fecha using "dd/mm/yyyy",
COLUMN 20 , x.orden_compra using "<<<<",
COLUMN 28 , x.conduce_no,
COLUMN 40 , x.fact_no,
COLUMN 52 , x.cod_sp using "&&","-",x.cod_sp_sec using "&&&&&&",
COLUMN 64 , nombre_suplidor,
COLUMN 95 , x.us_crea CLIPPED,
COLUMN 116 , x.fech_crea
PRINT COLUMN 1, negrillas_on
PRINT COLUMN 59, "C a n t i d a d"
PRINT COLUMN 72, "Ordenada/",
COLUMN 88, "Entregada/"
PRINT COLUMN 1 , "Codigo",
COLUMN 15, "Descripcion",
COLUMN 45, "Unidad",
COLUMN 72, "Devuelta",
COLUMN 88, "Recibida"
PRINT COLUMN 1, negrillas_off
END IF
ON EVERY ROW
IF x.cod_mov != 99 THEN
LET nombre_m = NULL
LET descripcion = x.descrip_esp CLIPPED
PRINT COLUMN 1, x.cod_n USING "&&&&","-",
x.cod_grupo USING "&&&&","-",
x.cod_tipo USING "&&&&","-",
x.cod_sec USING "&&&&&&",
COLUMN 22, descripcion[1,45],
COLUMN 62, x.unidad_med,
COLUMN 68, x.cantidad_1 USING "##,###,###.###",
COLUMN 83, x.cantidad_2 USING "##,###,###.###"
END IF
AFTER GROUP OF x.num_doc
PRINT COLUMN 1, "-------------------------------------------",
"----------------------------------------------"
SKIP 1 LINE
ON LAST ROW
PRINT COLUMN 3, comprimido_off
END REPORT
FUNCTION busca_dia()
LET nombre_dia[1] = "Domingo"
LET nombre_dia[2] = "Lunes"
LET nombre_dia[3] = "Martes"
LET nombre_dia[4] = "Miercoles"
LET nombre_dia[5] = "Jueves"
LET nombre_dia[6] = "Viernes"
LET nombre_dia[7] = "Sabado"
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
FUNCTION busca_mes()
LET nombre_mes[1] = "Enero"
LET nombre_mes[2] = "Febrero"
LET nombre_mes[3] = "Marzo"
LET nombre_mes[4] = "Abril"
LET nombre_mes[5] = "Mayo"
LET nombre_mes[6] = "Junio"
LET nombre_mes[7] = "Julio"
LET nombre_mes[8] = "Agosto"
LET nombre_mes[9] = "Septiembre"
LET nombre_mes[10] = "Octubre"
LET nombre_mes[11] = "Noviembre"
LET nombre_mes[12] = "Diciembre"
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
FUNCTION integridad()
IF sqlca.sqlcode < 0 THEN
LET numero_msg = sqlca.sqlcode
CALL msg(numero_msg)
DISPLAY numero_msg AT 23,70
LET bandera = 1
SLEEP 2
RETURN
END IF
END FUNCTION
FUNCTION bodegas(cb2)
DEFINE ketiquetas SMALLINT, detiquetas CHAR(30),
cbodegas ui.ComboBox,
cb2 CHAR(2)
LET cbodegas = ui.combobox.forname("formonly.bodega")
DECLARE bbodegas CURSOR FOR
SELECT a.cod_bodega,a.descripcion FROM intb00009 a
ORDER BY a.cod_bodega
CALL cbodegas.clear()
FOREACH bbodegas INTO ketiquetas,detiquetas
CALL cbodegas.additem(ketiquetas,detiquetas)
END FOREACH
IF cb2 ='2' THEN
LET cbodegas = ui.combobox.forname("formonly.bodega_destino")
DECLARE bbodegas2 CURSOR FOR
SELECT a.cod_bodega,a.descripcion FROM intb00009 a
ORDER BY a.descripcion
CALL cbodegas.clear()
FOREACH bbodegas2 INTO ketiquetas,detiquetas
CALL cbodegas.additem(ketiquetas,detiquetas)
END FOREACH
END IF
END FUNCTION
Reference in New Issue View Git Blame Copy Permalink