jsoto/MBS
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Commit inicial: fuentes MBS ERP (Genero 6) + .gitignore + docs/SETUP_PC_MBS.md

Browse Source
This commit is contained in:
jsoto
2026-08-18 20:59:52 -04:00
commit 454973e269
5978 changed files with 2664094 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
PROYECTO/codir/coprrp020.4gl
+432
View File
@@ -0,0 +1,432 @@
{
-------------------------------------------------------------------------------
PROGRAMA : COPRRP020
OBJETIVO : Ordenes de compras pendientes con las llegadas del
material a planta por suplidor.
PROGRAMADOR : Ing. Juan F. Soto
FECHA REALIZACION : Noviembre 12, 1996.
-------------------------------------------------------------------------------
}
GLOBALS "coprgb000.4gl"
FUNCTION coprrp020()
DEFINE p_ordenes RECORD LIKE cotb00014.*,
entregas RECORD LIKE cotb00025.*,
movimientos RECORD LIKE iptb00006.*,
k_ordenes RECORD LIKE cotb00015.*,
orden SMALLINT
DEFINE p_num_oc INTEGER,
codigo CHAR(7),
salir CHAR(1)
DEFINE registros RECORD
cod_n LIKE cotb00025.cod_n,
cod_grupo LIKE cotb00025.cod_grupo,
cod_tipo LIKE cotb00025.cod_grupo,
cod_sec LIKE cotb00025.cod_grupo,
fecha_entrega DATE,
fecha_embarque DATE,
fecha DATE,
cantidad_o LIKE cotb00025.cantidad,
cantidad_r LIKE iptb00006.cantidad_2,
cod_sp LIKE cotb00014.cod_sp,
cod_sp_sec LIKE cotb00014.cod_sp,
tipo LIKE cotb00014.tipo,
fecha_p DATE,
suplidor CHAR(6)
END RECORD
#WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM cofmrp020 FROM "cofmrp020"
DISPLAY FORM cofmrp020
CALL pantalla()
DISPLAY "coprrp020" AT 4,3
DISPLAY "Ordenes de Compras Pendientes Por Suplidor" AT 6,20
# Desplega en la pantalla el tipo de papel que se debe utilizar para el reporte
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
# Captura del rango de fecha para la impresion del reporte
INPUT BY NAME rango.*
BEFORE FIELD fech_fi
LET rango.fech_fi = TODAY
DISPLAY BY NAME rango.fech_fi
AFTER FIELD fech_in
IF rango.fech_in is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_in
END IF
AFTER FIELD fech_fi
IF rango.fech_fi is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_fi
END IF
AFTER INPUT
# Control interrupcion del programa
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
EXIT INPUT
END INPUT
# Hace un criterio de seleccion de las informaciones que el usuario
# quiera, los campos que se pueden listar son :
# tipo de la orden, numero de la orden, codigo del material
CONSTRUCT criterio ON b.cod_sp,b.cod_sp_sec,a.num_oc,a.tipo,
a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec
FROM cod_sp,cod_sp_sec,num_oc,tipo,
cod_n,cod_grupo,cod_tipo,cod_sec
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
START REPORT ordenar2 TO "C:\\archivo"
START REPORT resumen TO "C:\\archivo"
# Busca Las Ordenes de Compras
LET selec =
"SELECT b.*,a.* FROM cotb00014 b,cotb00015 a ",
"WHERE b.status_t is null AND ",
"b.cierre = 'N' AND ",
"(b.fech_oc BETWEEN ? AND ? ) AND ",
"(b.num_oc = a.num_oc AND ",
"b.tipo = a.tipo) AND (",
criterio clipped,")"
DISPLAY "<< Buscando Ordenes De Compras... Espere Por Favor >> " AT 17,14
PREPARE comando FROM selec
DECLARE busca SCROLL CURSOR FOR comando
OPEN busca USING rango.fech_in,rango.fech_fi
DISPLAY " " AT 17,14
LET salir = "S"
WHILE salir != "N"
FETCH busca INTO p_ordenes.*,k_ordenes.*
IF STATUS = NOTFOUND THEN
LET salir = "S"
EXIT WHILE
END IF
LET registros.cod_sp = p_ordenes.cod_sp
LET registros.cod_sp_sec = p_ordenes.cod_sp_sec
LET registros.fecha_p = p_ordenes.fech_oc
LET registros.suplidor = p_ordenes.cod_sp using "##",
p_ordenes.cod_sp_sec using "####"
DISPLAY "<< Buscando Parcialidades... Espere Por Favor >> " AT 17,14
DECLARE busca1 CURSOR FOR
SELECT a.* FROM cotb00025 a
WHERE a.num_oc = p_ordenes.num_oc AND
a.tipo = p_ordenes.tipo AND
a.cod_n = k_ordenes.cod_n AND
a.cod_grupo = k_ordenes.cod_grupo AND
a.cod_tipo = k_ordenes.cod_tipo AND
a.cod_sec = k_ordenes.cod_sec
FOREACH busca1 INTO entregas.*
LET p_num_oc = entregas.num_oc
LET codigo = entregas.cod_n using "&",
entregas.cod_grupo using "&",
entregas.cod_tipo using "&&",
entregas.cod_sec using "&&&"
LET registros.cod_n = entregas.cod_n
LET registros.cod_grupo = entregas.cod_grupo
LET registros.cod_tipo = entregas.cod_tipo
LET registros.cod_sec = entregas.cod_sec
LET registros.fecha_entrega = entregas.fech_ent
LET registros.fecha_embarque = entregas.fech_emb
LET registros.cantidad_o = entregas.cantidad
LET registros.tipo = entregas.tipo
LET orden = 1
IF registros.cantidad_o IS NOT NULL THEN
OUTPUT TO REPORT ordenar2(orden,p_num_oc,codigo,registros.*)
OUTPUT TO REPORT resumen(p_num_oc,registros.*)
END IF
END FOREACH
IF STATUS = NOTFOUND THEN
LET STATUS = 0
END IF
DISPLAY "<< Buscando Reportes De Entrada.. Espere Por Favor >> " AT 17,14
DECLARE busca2 CURSOR FOR
SELECT a.* FROM iptb00006 a
WHERE a.orden_compra = p_ordenes.num_oc AND
a.tipo = p_ordenes.tipo AND
(a.cod_n = k_ordenes.cod_n AND
a.cod_grupo = k_ordenes.cod_grupo AND
a.cod_tipo = k_ordenes.cod_tipo AND
a.cod_sec = k_ordenes.cod_sec) AND
a.status_t is null
FOREACH busca2 INTO movimientos.*
LET p_num_oc = entregas.num_oc
LET codigo = k_ordenes.cod_n using "&",
k_ordenes.cod_grupo using "&",
k_ordenes.cod_tipo using "&&",
k_ordenes.cod_sec using "&&&"
LET registros.cod_n = k_ordenes.cod_n
LET registros.cod_grupo = k_ordenes.cod_grupo
LET registros.cod_tipo = k_ordenes.cod_tipo
LET registros.cod_sec = k_ordenes.cod_sec
LET registros.fecha = movimientos.fecha
LET registros.cantidad_r = movimientos.cantidad_2
LET registros.tipo = movimientos.tipo
LET registros.cantidad_o = 0
LET orden = 2
IF registros.cantidad_r IS NOT NULL THEN
OUTPUT TO REPORT ordenar2(orden,p_num_oc,codigo,registros.*)
END IF
END FOREACH
END WHILE
FINISH REPORT ordenar2
FINISH REPORT resumen
CLEAR SCREEN
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
# Rutina para la impresion de las ordenes
REPORT ordenar2(x_ord,x_num_oc,x_codigo,x)
DEFINE x RECORD
cod_n LIKE cotb00025.cod_n,
cod_grupo LIKE cotb00025.cod_grupo,
cod_tipo LIKE cotb00025.cod_grupo,
cod_sec LIKE cotb00025.cod_grupo,
fecha_entrega DATE,
fecha_embarque DATE,
fecha DATE,
cantidad_o LIKE cotb00025.cantidad,
cantidad_r LIKE iptb00006.cantidad_2,
cod_sp LIKE cotb00014.cod_sp,
cod_sp_sec LIKE cotb00014.cod_sp,
tipo LIKE cotb00014.tipo,
fecha_p DATE,
suplidor CHAR(6)
END RECORD
DEFINE x_num_oc INTEGER,
x_codigo CHAR(7),
x_ord SMALLINT,
z_ordenes RECORD LIKE cotb00015.*,
x_ordenes RECORD LIKE cotb00014.*
# Bandera para la impresion del codigo una sola vez
DEFINE bandera CHAR(1)
DEFINE descrip CHAR(10)
DEFINE varia CHAR(12)
DEFINE total_rec,total_ord DECIMAL(14,3)
DEFINE doble_on CHAR(2)
DEFINE doble_off CHAR(2)
DEFINE negrillas_on CHAR(2)
DEFINE negrillas_off CHAR(2)
DEFINE comp_on CHAR(2)
DEFINE comp_off CHAR(2)
DEFINE doce CHAR(2)
DEFINE normal CHAR(2)
DEFINE hora CHAR(5),
descripcion,nom_supli CHAR(30),
unidad CHAR(4)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 2
ORDER BY x.suplidor,x_num_oc,x_codigo,x_ord
FORMAT
PAGE HEADER
# Asignacion de los caracters ASCII para imprimir en las diferentes
# opciones
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
LET hora = time
LET l = (143 - LENGTH(p_companias.nombre CLIPPED))/2
# Encabezados del reporte con nombre de compania
PRINT COLUMN 1, comp_on,negrillas_on
PRINT COLUMN 1, "coprrp020",
COLUMN l, p_companias.nombre CLIPPED,
COLUMN 136, "Pag. ",pageno using "###"
PRINT COLUMN 49, " Sistema de Compras",
COLUMN 136, today using "dd/mm/yy"
PRINT COLUMN 49, " Ordenes De Compras Pendientes Por Suplidor",
COLUMN 139, hora
PRINT COLUMN 1, "Desde ",rango.fech_in using "dd/mm/yy",
" Hasta ",rango.fech_fi using "dd/mm/yy"
PRINT negrillas_off
BEFORE GROUP OF x.suplidor
# Busqueda del nombre del suplidor e impresion del suplidor
SELECT a.nom_sp INTO nom_supli FROM cotb00001 a
WHERE a.cod_sp = x.cod_sp and
a.cod_sp_sec = x.cod_sp_sec
PRINT
"------------------------------------------------------------------------------",
"--------------------------------------------------"
PRINT COLUMN 1, negrillas_on,
COLUMN 3, "Suplidor: ",x.cod_sp USING "<<","-"," ",
COLUMN 17, x.cod_sp_sec USING "<<<<"," ",
COLUMN 22, nom_supli ,negrillas_off
BEFORE GROUP OF x_num_oc
# Validacion de la variable DESCRIP para imprimir la etiqueta que clasifica
# las ordenes
IF x.tipo = "01" THEN
LET descrip = "GENERAL"
END IF
IF x.tipo = "02" THEN
LET descrip = "ROV-LTD"
END IF
IF x.tipo = "03" THEN
LET descrip = "LOCAL"
END IF
IF x.tipo = "04" THEN
LET descrip = "MISCELANEA"
END IF
PRINT COLUMN 3, negrillas_on,"Orden No.: ",x_num_oc using "######",
COLUMN 22, " Tipo: ",descrip,
COLUMN 66, "Fecha Pedido: ",x.fecha_p USING "dd/mm/yy",
negrillas_off
#-----------------------------------------------------------------------
# Aqui se controla por medio a una bandera si el codigo va a imprimirse una
# sola vez o varias veces
BEFORE GROUP OF x_codigo
LET total_ord = 0
LET total_rec = 0
SKIP 1 LINE
SELECT a.descrip_esp,a.unidad_med INTO descripcion,unidad
FROM intb00001 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
PRINT COLUMN 1, negrillas_off,
COLUMN 8, "Codigo",
COLUMN 20, "Descripcion",
COLUMN 57, "F.Emb",
COLUMN 73, "Fecha",
COLUMN 87, "Ordenada",
COLUMN 104, "Recibida",
COLUMN 116, "Diferencia"
PRINT COLUMN 6, x.cod_n USING "&","-",
x.cod_grupo USING "&","-",
x.cod_tipo USING "&&","-",
x.cod_sec USING "&&&",
" ",descripcion," ",unidad;
ON EVERY ROW
IF x_ord = 1 THEN
IF total_ord IS NULL THEN
LET total_ord = 0
END IF
PRINT COLUMN 55, x.fecha_embarque using "dd/mm/yy",
COLUMN 71, x.fecha_entrega using "dd/mm/yy",
COLUMN 79, x.cantidad_o USING "###,###,###.##"
LET total_ord = total_ord + x.cantidad_o
END IF
IF x_ord = 2 THEN
IF total_rec IS NULL THEN
LET total_rec = 0
END IF
PRINT COLUMN 73, x.fecha using "dd/mm/yy",
COLUMN 98, x.cantidad_r using "###,###,###.##"
LET total_rec = total_rec + x.cantidad_r
END IF
# Totaliza la cantidad pendiente de la orden
AFTER GROUP OF x_codigo
PRINT COLUMN 81,"--------------",
COLUMN 98,"--------------"
PRINT COLUMN 81,total_ord using "###,###,###.##",
COLUMN 98, total_rec using "###,###,###.##",
COLUMN 103, negrillas_on, total_ord - total_rec
USING "((((,(((,(((.##)",negrillas_off
SKIP 1 LINE
ON LAST ROW
PRINT comp_off
END REPORT
REPORT resumen(x_num_oc,x)
DEFINE x RECORD
cod_n LIKE cotb00025.cod_n,
cod_grupo LIKE cotb00025.cod_grupo,
cod_tipo LIKE cotb00025.cod_grupo,
cod_sec LIKE cotb00025.cod_grupo,
fecha_entrega DATE,
fecha_embarque DATE,
fecha DATE,
cantidad_o LIKE cotb00025.cantidad,
cantidad_r LIKE iptb00006.cantidad_2,
cod_sp LIKE cotb00014.cod_sp,
cod_sp_sec LIKE cotb00014.cod_sp,
tipo LIKE cotb00014.tipo,
fecha_p DATE,
suplidor CHAR(6)
END RECORD,
nom_supli CHAR(30),
x_num_oc LIKE cotb00014.num_oc,
l SMALLINT
OUTPUT
LEFT MARGIN 0
ORDER BY x.suplidor,x_num_oc
FORMAT
PAGE HEADER
PRINT
"------------------------------------------------------------------------------|"
PRINT
"| R E S U M E N |"
PRINT
"| - - - - - - - |"
PRINT
"|_____________________________________________________________________________|"
PRINT
"| SUPLIDOR ORDEN PENDIENTES |"
PRINT
"|_____________________________________________________________________________|"
BEFORE GROUP OF x.suplidor
# Busqueda del nombre del suplidor e impresion del suplidor
SELECT a.nom_sp INTO nom_supli FROM cotb00001 a
WHERE a.cod_sp = x.cod_sp and
a.cod_sp_sec = x.cod_sp_sec
SKIP 1 LINE
PRINT COLUMN 1, x.cod_sp using "##","-",x.cod_sp_sec using "####",
" ",nom_supli;
LET l = 40
AFTER GROUP OF x_num_oc
PRINT COLUMN l, x_num_oc using "######",", ";
LET l = l + 8
IF l > 72 THEN
PRINT " "
LET l = 40
END IF
AFTER GROUP OF x.suplidor
PRINT " "
END REPORT