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

JSOTO Alta y compilacion G6 de programas CG, Cheques, Activos, Tesoreria, Repuestos e Informatica

Browse Source 
Merge de main (ipprrp013/014/046/053) con conflictos resueltos:
- mbsERP.4pw: ipprrp014 conserva ambos 4rp y su 4fd.
- bin/ipprrp014.4rp: columnas MARGEN/CLASIF. + titulo IPPRRP014.

Programas agregados a mbsERP.4pw (53 compilan y enlazan con fgl602):
- CONTABILIDAD GENERAL, ACTIVOS FIJOS, REPUESTOS; grupos nuevos TESORERIA,
  CHEQUES e INFORMATICA (segprmt001 = seguridad2.0/segprmt0001.4gl).
- irdir copiado de 3.20 PROYECTOS/irdir a PROYECTO/irdir; helpers de
  PROYECTOS/otrodir en FUNCIONES_IR (departamento -> irdepartamento.4gl).
- Fuentes mas nuevos de 3.20: edprrp118, edprrp080, acprrp010, cgprmt022.
- FUNCIONES: GeneraEntradaDiario.4gl a la version 3.20 + costoLiquidacion.4gl.
- Ajustes G6: existe duplicado en irprgb000, fakeData de 22 campos y
  answer2 en irprmt036/020 (ApiMaintainC), selectOutputSimple en irprcs008,
  schemas de forms a smarmotech, referencia declarada en cgprmt005.
- cgprmt005 sigue sin enlazar: requiere funciones de EXTERIOR.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
jsoto
2026-10-15 16:22:14 -04:00
co-authored by Claude Opus 5.5
parent 659e690af3 3903f11a92
commit d8764b3bda
90 changed files with 16840 additions and 143 deletions
Download Patch File Download Diff File Expand all files Collapse all files
PROYECTO/irdir/irprmt068.4gl
+416
View File
@@ -0,0 +1,416 @@
{
------------------------------------------------------------------
PROGRAMA : IRPRMT068
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Relacion Departamento - Maquinas.
PROGRAMADOR : Ing. JUAN SOTO
FECHA REALIZACION : Julio 14, 1998.
------------------------------------------------------------------
}
GLOBALS "irprgb000.4gl"
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT to "smarmotech" USER usuarios USING clave
SELECT * INTO p_companias.* FROM companias
CALL irprmt068()
END MAIN
FUNCTION irprmt068()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM irfmmt068 FROM "irfmmt068"
DISPLAY FORM irfmmt068
DISPLAY "irprmt068" AT 4,3
DISPLAY "Departamento - Maquina" AT 6,30
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Ctrl-C> Cancela Operacion"
let int_flag = false
CLEAR FORM
INITIALIZE dm_rep.* TO NULL
CALL irpcad068()
COMMAND "Consultar"
"<Esc> Realiza Busqueda <Ctrl-C> Cancela Operacion"
let int_flag = false
CALL irpcmf068()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION irpcad068()
DEFINE total_reg INTEGER
# WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
INPUT BY NAME dm_rep.* WITHOUT DEFAULTS
ON KEY (CONTROL-W)
CASE
WHEN INFIELD (departamento)
CALL busca_dpto()
IF int_flag THEN
LET int_flag = false
LET numero_msg = 2
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
LET dm_rep.departamento = depto.departamento
DISPLAY BY NAME depto.departamento, depto.nom_dpto
LET int_flag = false
WHEN INFIELD (maquina)
CALL busca_maquina()
IF int_flag THEN
LET int_flag = false
LET numero_msg = 2
CALL msg(numero_msg)
NEXT FIELD maquina
END IF
LET dm_rep.maquina = maquinaria.codigo
DISPLAY BY NAME dm_rep.maquina, maquinaria.nombre
LET int_flag = false
END CASE
## Verifica que el cod_maq no exista en el catalogo de maquinas. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD departamento
IF dm_rep.departamento is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD departamento
ELSE
SELECT nom_dpto INTO depto.nom_dpto FROM adtb00001
WHERE departamento = dm_rep.departamento
IF status = NOTFOUND THEN
DISPLAY BY NAME dm_rep.*
LET numero_msg = 134
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
END IF
DISPLAY BY NAME depto.nom_dpto, dm_rep.departamento
AFTER FIELD maquina
IF dm_rep.maquina is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD maquina
ELSE
SELECT nombre INTO maquinaria.nombre FROM irtb00009
WHERE codigo = dm_rep.maquina
IF status = NOTFOUND THEN
DISPLAY BY NAME dm_rep.*
LET numero_msg = 116
CALL msg(numero_msg)
NEXT FIELD maquina
END IF
END IF
DISPLAY BY NAME maquinaria.nombre, dm_rep.maquina
LET total_reg = 0
SELECT COUNT(*) INTO total_reg FROM irtb00029
WHERE departamento = dm_rep.departamento AND
maquina = dm_rep.maquina AND
status_t IS NULL
IF total_reg > 0 THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET total_reg = 0
SELECT COUNT(*) INTO total_reg FROM irtb00029
WHERE departamento = dm_rep.departamento AND
maquina = dm_rep.maquina AND
status_t IS NULL
IF total_reg > 0 THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
INSERT INTO irtb00029
VALUES (dm_rep.departamento,dm_rep.maquina,
null, usuarios, GETDATE(), null, null)
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
LET dm_rep.maquina = NULL
NEXT FIELD departamento
END INPUT
END FUNCTION
FUNCTION irpcmf068()
## Aqui se prepara para la captura del criterio de seleccion
#WHENEVER ERROR CONTINUE
CONSTRUCT BY NAME criterio ON departamento,maquina
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE * FROM irtb00029 WHERE ",
" status_t is null and ",
criterio clipped,
" ORDER BY 1"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO dm_rep.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
SELECT nom_dpto INTO depto.nom_dpto FROM adtb00001
WHERE departamento = dm_rep.departamento
SELECT nombre INTO maquinaria.nombre FROM irtb00009
WHERE codigo = dm_rep.maquina
DISPLAY BY NAME dm_rep.*, depto.nom_dpto, maquinaria.nombre
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO dm_rep.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT nom_dpto INTO depto.nom_dpto FROM adtb00001
WHERE departamento = dm_rep.departamento
SELECT nombre INTO maquinaria.nombre FROM irtb00009
WHERE codigo = dm_rep.maquina
DISPLAY BY NAME dm_rep.*, depto.nom_dpto, maquinaria.nombre
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO dm_rep.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT nom_dpto INTO depto.nom_dpto FROM adtb00001
WHERE departamento = dm_rep.departamento
SELECT nombre INTO maquinaria.nombre FROM irtb00009
WHERE codigo = dm_rep.maquina
DISPLAY BY NAME dm_rep.*, depto.nom_dpto, maquinaria.nombre
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO dm_rep.*
SELECT nom_dpto INTO depto.nom_dpto FROM adtb00001
WHERE departamento = dm_rep.departamento
SELECT nombre INTO maquinaria.nombre FROM irtb00009
WHERE codigo = dm_rep.maquina
DISPLAY BY NAME dm_rep.*, depto.nom_dpto, maquinaria.nombre
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO dm_rep.*
SELECT nom_dpto INTO depto.nom_dpto FROM adtb00001
WHERE departamento = dm_rep.departamento
SELECT nombre INTO maquinaria.nombre FROM irtb00009
WHERE codigo = dm_rep.maquina
DISPLAY BY NAME dm_rep.*, depto.nom_dpto, maquinaria.nombre
CALL msg(numero_msg)
COMMAND KEY ("L") "eLiminar"
UPDATE irtb00029 SET status_t = "E",
us_mod = usuarios,
fech_mod = getdate()
WHERE departamento = dm_rep.departamento AND
maquina = dm_rep.maquina
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
FUNCTION busca_dpto()
OPEN WINDOW busqueda AT 8,8 WITH FORM "cofmwd002"
ATTRIBUTE (BORDER,FORM LINE FIRST + 2,COMMENT LINE LAST)
LET int_flag = false
CONSTRUCT criterio ON adtb00001.nom_dpto FROM adtb00001.nom_dpto
LET selec = "SELECT departamento,nom_dpto FROM adtb00001 ",
" WHERE ",
" status_t is null AND ",
criterio clipped,
"ORDER BY 1 "
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GO TO sale
RETURN
END IF
PREPARE busca1 FROM selec
IF status = notfound THEN
LET numero_msg = 12
CALL msg(numero_msg)
END IF
DECLARE johnn1 CURSOR FOR busca1
LET idx = 1
FOREACH johnn1 INTO busca_wd1[idx].*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GO TO sale1
END IF
IF status = notfound THEN
EXIT FOREACH
END IF
LET idx = idx + 1
LABEL sale1:
END FOREACH
CALL set_count(idx-1)
DISPLAY ARRAY busca_wd1 TO s_desp1.*
LET curr1 = arr_curr()
LET dm_rep.departamento = busca_wd1[curr1].codigo
LET depto.departamento = busca_wd1[curr1].codigo
LET depto.nom_dpto = busca_wd1[curr1].nom_dpto
LABEL sale:
CLOSE WINDOW busqueda
END FUNCTION
FUNCTION busca_maquina()
# LET formulario = fgl_getenv("FORMS") CLIPPED,"/codir/"
# LET formulario = formulario CLIPPED, "cofmwd002"
LET formulario = "irfmwd068"
OPEN WINDOW busqueda AT 8,8 WITH FORM "irfmwd068"
ATTRIBUTE (BORDER,FORM LINE FIRST + 2,COMMENT LINE LAST)
LET int_flag = false
IF consulta = "S" THEN
CONSTRUCT criterio ON irtb00009.nombre FROM irtb00009.nombre
LET selec = "SELECT codigo,nombre FROM irtb00009 ",
" WHERE ",
" status_t is null AND ",
criterio clipped,
"ORDER BY 1 "
ELSE
{
LET selec = "SELECT a.codigo,a.nombre FROM irtb00009 a,irtb00008 b ",
" WHERE ",
" b.cod_n =7 AND ",
" b.cod_grupo = 0 AND ",
" b.cod_tipo = 0 AND ",
" b.cod_sec = 2 AND ",
" a.codigo = b.cod_maq ",
"ORDER BY 1 "
}
LET selec = "SELECT a.codigo,a.nombre FROM irtb00009 a,irtb00008 b ",
" WHERE ",
" b.cod_n = '",movi8[p_act].cod_n,"' AND ",
" b.cod_grupo = '",movi8[p_act].cod_grupo, "' AND ",
" b.cod_tipo = '",movi8[p_act].cod_tipo,"' AND ",
" b.cod_sec = '",movi8[p_act].cod_sec,"' AND ",
" a.codigo = b.cod_maq ",
"ORDER BY 1 "
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GO TO sale2
RETURN
END IF
PREPARE busca2 FROM selec
IF status = notfound THEN
LET numero_msg = 12
CALL msg(numero_msg)
END IF
DECLARE johnn2 CURSOR FOR busca2
LET idx = 1
FOREACH johnn2 INTO busca_wd2[idx].*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GO TO sale3
END IF
IF status = notfound THEN
EXIT FOREACH
END IF
LET idx = idx + 1
LABEL sale3:
END FOREACH
CALL set_count(idx-1)
DISPLAY ARRAY busca_wd2 TO s_desp1.*
LET curr1 = arr_curr()
LET dm_rep.maquina = busca_wd2[curr1].codigo
LET maquinaria.codigo = busca_wd2[curr1].codigo
LET maquinaria.nombre = busca_wd2[curr1].nombre
LABEL sale2:
CLOSE WINDOW busqueda
END FUNCTION