Files
MBS/PROYECTO/tedir/teprmt021.4gl
T

785 lines
29 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : TEPRMT021
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Comisiones.
PROGRAMADOR : Lic. Abner Montalvo Zapata
FECHA REALIZACION : Diciembre 2, 1992.
------------------------------------------------------------------
}
GLOBALS "teprgb000.4gl"
FUNCTION teprmt021()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
MESSAGE LINE 24,
COMMENT LINE 21
OPEN FORM tefmmt021 FROM "tefmmt003"
DISPLAY FORM tefmmt021
CALL pantalla()
# CALL ayuda()
DISPLAY "teprmt021" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Mantenimiento de Comisiones por Vendedor" at 6,20 ATTRIBUTE(BLACK)
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
HELP 5
LET INT_FLAG = FALSE
CLEAR FORM
LET INT_FLAG = FALSE
CALL tepcad021()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Supr> Cancela Operacion"
HELP 6
CALL tepcmf021()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION tepcad021()
DEFINE fech_ant CHAR(8)
# WHENEVER ERROR CONTINUE
MESSAGE ""
## Captura los datos que va a contener el registro
INPUT BY NAME comisiones.*
{ON KEY (CONTROL-W)
CASE
WHEN INFIELD (cod_vend)
CALL consulta_empleados2()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
NEXT FIELD cod_vend
END IF
IF NOT int_flag THEN
LET comisiones.cod_vend = transportista.cod_transp
LET comisiones.sec_vend = transportista.sec_transp
DISPLAY transportista.cod_transp TO cod_vend
DISPLAY transportista.sec_transp TO sec_vend
DISPLAY descrip6 TO descrip6
NEXT FIELD cod_n
END IF
LET int_flag = FALSE
WHEN INFIELD (sec_vend)
CALL consulta_empleados2()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
NEXT FIELD cod_vend
END IF
IF NOT int_flag THEN
LET comisiones.cod_vend = transportista.cod_transp
LET comisiones.sec_vend = transportista.sec_transp
DISPLAY transportista.cod_transp TO cod_vend
DISPLAY transportista.sec_transp TO sec_vend
DISPLAY descrip6 TO descrip6
NEXT FIELD cod_n
END IF
LET int_flag = FALSE
WHEN INFIELD (cod_n)
CALL busca_pt()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
IF NOT int_flag THEN
LET comisiones.cod_n = pterminado.cod_n
LET comisiones.cod_grupo = pterminado.cod_grupo
LET comisiones.cod_tipo = pterminado.cod_tipo
LET comisiones.cod_sec = pterminado.cod_sec
DISPLAY pterminado.cod_n TO cod_n
DISPLAY pterminado.cod_grupo TO cod_grupo
DISPLAY pterminado.cod_tipo TO cod_tipo
DISPLAY pterminado.cod_sec TO cod_sec
DISPLAY descrip1 TO descrip_esp
NEXT FIELD porc_ventas
END IF
LET int_flag = FALSE
WHEN INFIELD (cod_grupo)
CALL busca_pt()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
NEXT FIELD cod_grupo
END IF
IF NOT int_flag THEN
LET comisiones.cod_n = pterminado.cod_n
LET comisiones.cod_grupo = pterminado.cod_grupo
LET comisiones.cod_tipo = pterminado.cod_tipo
LET comisiones.cod_sec = pterminado.cod_sec
DISPLAY pterminado.cod_n TO cod_n
DISPLAY pterminado.cod_grupo TO cod_grupo
DISPLAY pterminado.cod_tipo TO cod_tipo
DISPLAY pterminado.cod_sec TO cod_sec
DISPLAY descrip1 TO descrip_esp
NEXT FIELD porc_ventas
END IF
LET int_flag = FALSE
WHEN INFIELD (cod_tipo)
CALL busca_pt()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
NEXT FIELD cod_tipo
END IF
IF NOT int_flag THEN
LET comisiones.cod_n = pterminado.cod_n
LET comisiones.cod_grupo = pterminado.cod_grupo
LET comisiones.cod_tipo = pterminado.cod_tipo
LET comisiones.cod_sec = pterminado.cod_sec
DISPLAY pterminado.cod_n TO cod_n
DISPLAY pterminado.cod_grupo TO cod_grupo
DISPLAY pterminado.cod_tipo TO cod_tipo
DISPLAY pterminado.cod_sec TO cod_sec
DISPLAY descrip1 TO descrip_esp
NEXT FIELD porc_ventas
END IF
LET int_flag = FALSE
WHEN INFIELD (cod_sec)
CALL busca_pt()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
NEXT FIELD cod_sec
END IF
IF NOT int_flag THEN
LET comisiones.cod_n = pterminado.cod_n
LET comisiones.cod_grupo = pterminado.cod_grupo
LET comisiones.cod_tipo = pterminado.cod_tipo
LET comisiones.cod_sec = pterminado.cod_sec
DISPLAY pterminado.cod_n TO cod_n
DISPLAY pterminado.cod_grupo TO cod_grupo
DISPLAY pterminado.cod_tipo TO cod_tipo
DISPLAY pterminado.cod_sec TO cod_sec
DISPLAY descrip1 TO descrip_esp
NEXT FIELD porc_ventas
END IF
LET int_flag = FALSE
END CASE
}
AFTER FIELD cod_vend
IF comisiones.cod_vend = 0 or
comisiones.cod_vend is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_vend
END IF
AFTER FIELD sec_vend
IF comisiones.sec_vend = 0 or
comisiones.sec_vend is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD sec_vend
ELSE
SELECT i.nom1_emp, i.apell1_emp INTO descrip1, descrip2
FROM adtb00003 i
WHERE i.num_emp = comisiones.cod_vend AND i.status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 68
CALL msg(numero_msg)
NEXT FIELD cod_vend
END IF
LET descrip6 = descrip1 clipped," ",descrip2 clipped
DISPLAY descrip6 TO descrip6
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
END IF
## Verifica que el codigo no exista en el catalogo de comisiones. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD cod_sec
SELECT i.descrip_esp INTO descrip1
FROM intb00001 i
WHERE i.cod_n = comisiones.cod_n AND
i.cod_grupo = comisiones.cod_grupo AND
i.cod_tipo = comisiones.cod_tipo AND
i.cod_sec = comisiones.cod_sec and
i.status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 26
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY descrip1 TO descrip_esp
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
SELECT * INTO comisiones.* FROM vetb00011 WHERE
cod_vend = comisiones.cod_vend AND
sec_vend = comisiones.sec_vend AND
cod_n = comisiones.cod_n AND
cod_grupo = comisiones.cod_grupo AND
cod_tipo = comisiones.cod_tipo AND
cod_sec = comisiones.cod_sec
IF status >= 0 THEN
IF status != NOTFOUND THEN
IF comisiones.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_vend
END IF
DISPLAY BY NAME comisiones.porc_ventas,
comisiones.porc_cobros,
comisiones.us_crea,
comisiones.fech_crea,
comisiones.us_mod,
comisiones.fech_mod
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_vend
ELSE
INITIALIZE comisiones.porc_ventas,
comisiones.porc_cobros,
comisiones.us_crea,
comisiones.fech_crea,
comisiones.us_mod,
comisiones.fech_mod TO NULL
DISPLAY BY NAME comisiones.porc_ventas,
comisiones.porc_cobros,
comisiones.us_crea,
comisiones.fech_crea,
comisiones.us_mod,
comisiones.fech_mod
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
AFTER FIELD porc_ventas
IF comisiones.porc_ventas IS NULL OR
comisiones.porc_ventas = 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD porc_ventas
END IF
AFTER FIELD porc_cobros
IF comisiones.porc_cobros IS NULL THEN
LET comisiones.porc_cobros = 0
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
IF comisiones.cod_vend = 0 or
comisiones.cod_vend is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_vend
END IF
IF comisiones.sec_vend = 0 or
comisiones.sec_vend is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD sec_vend
ELSE
SELECT i.nom1_emp, i.apell1_emp INTO descrip1, descrip2
FROM adtb00003 i
WHERE i.num_emp = comisiones.cod_vend AND i.status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 68
CALL msg(numero_msg)
NEXT FIELD cod_vend
END IF
LET descrip6 = descrip1 clipped," ",descrip2 clipped
DISPLAY descrip6 TO descrip6
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
END IF
IF comisiones.cod_n IS NULL OR
comisiones.cod_n = 0 THEN
LET numero_msg = 60
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
## Verifica que el codigo no exista en el catalogo de comisiones. Si existe,
## entonces despliega los datos del registro existente.
IF ( comisiones.cod_n = 0 AND comisiones.cod_grupo = 0 AND
comisiones.cod_tipo = 0 AND comisiones.cod_sec = 0 ) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
SELECT i.descrip_esp INTO descrip1
FROM intb00001 i
WHERE i.cod_n = comisiones.cod_n AND
i.cod_grupo = comisiones.cod_grupo AND
i.cod_tipo = comisiones.cod_tipo AND
i.cod_sec = comisiones.cod_sec and
i.status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 26
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY descrip1 TO descrip_esp
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
END IF
SELECT * INTO comisiones.* FROM vetb00011 WHERE
cod_vend = comisiones.cod_vend AND
sec_vend = comisiones.sec_vend AND
cod_n = comisiones.cod_n AND
cod_grupo = comisiones.cod_grupo AND
cod_tipo = comisiones.cod_tipo AND
cod_sec = comisiones.cod_sec
IF status >= 0 THEN
IF status != NOTFOUND THEN
IF comisiones.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_vend
END IF
DISPLAY BY NAME comisiones.porc_ventas,
comisiones.porc_cobros,
comisiones.us_crea,
comisiones.fech_crea,
comisiones.us_mod,
comisiones.fech_mod
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_vend
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
IF comisiones.porc_ventas IS NULL OR
comisiones.porc_ventas = 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD porc_ventas
END IF
IF comisiones.porc_cobros IS NULL THEN
LET comisiones.porc_cobros = 0
END IF
# Valida que el codigo del articulo no sea cero. Si no es cero, adiciona el
# registro en la tabla, de lo contrario, presenta mensaje de error y acepta
# el codigo de nuevo.
{ IF (comisiones.cod_n = 0 AND
comisiones.cod_grupo = 0 AND
comisiones.cod_tipo = 0 AND
comisiones.cod_sec = 0 ) OR
(comisiones.cod_vend = 0 AND
comisiones.sec_vend = 0 ) OR
comisiones.porc_ventas = 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_vend
ELSE
} INSERT INTO vetb00011 VALUES (comisiones.cod_vend,
comisiones.sec_vend,
comisiones.cod_n,
comisiones.cod_grupo,
comisiones.cod_tipo,
comisiones.cod_sec,
comisiones.porc_ventas,
comisiones.porc_cobros,
null, USER, CURRENT, null, null)
# Verifica el Status que retorna luego de insertar el registro en la tabla.
# Si el Status es diferente de cero quiere decir que hubo problemas durante
# la creacion del registro, entonces despliega un mensaje de alerta para que
# el usuario sepa que hubo problemas en la creacion del registro.
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 1
CALL msg(numero_msg)
NEXT FIELD cod_vend
{ END IF
}
EXIT INPUT
END INPUT
END FUNCTION
FUNCTION tepcmf021()
## Aqui se prepara para la captura del criterio de seleccion
MESSAGE ""
CLEAR FORM
CONSTRUCT criterio ON vetb00011.* FROM vetb00011.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE * FROM vetb00011 WHERE ",
" status_t is null AND ",
criterio clipped,
" ORDER BY 1,2,3,4,5,6"
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
DECLARE datos SCROLL CURSOR WITH HOLD FOR busca
OPEN datos
FETCH FIRST datos INTO comisiones.*
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME comisiones.*
CALL busca_vendedor2()
CALL busca_nombre_articulo2()
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO comisiones.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME comisiones.*
CALL busca_vendedor2()
CALL busca_nombre_articulo2()
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO comisiones.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME comisiones.*
CALL busca_vendedor2()
CALL busca_nombre_articulo2()
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO comisiones.*
DISPLAY BY NAME comisiones.*
CALL busca_vendedor2()
CALL busca_nombre_articulo2()
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO comisiones.*
DISPLAY BY NAME comisiones.*
CALL busca_vendedor2()
CALL busca_nombre_articulo2()
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Supr> Cancela Operacion"
INPUT BY NAME comisiones.porc_ventas,
comisiones.porc_cobros WITHOUT DEFAULTS
AFTER FIELD porc_ventas
IF comisiones.porc_ventas IS NULL OR
comisiones.porc_ventas = 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD porc_ventas
END IF
AFTER FIELD porc_cobros
IF (comisiones.porc_ventas IS NULL OR
comisiones.porc_ventas = 0) AND
(comisiones.porc_cobros IS NULL OR
comisiones.porc_cobros = 0) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD porc_ventas
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
IF comisiones.porc_ventas IS NULL OR
comisiones.porc_ventas = 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD porc_ventas
END IF
IF (comisiones.porc_ventas IS NULL OR
comisiones.porc_ventas = 0) AND
(comisiones.porc_cobros IS NULL OR
comisiones.porc_cobros = 0) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD porc_ventas
END IF
UPDATE vetb00011 SET porc_ventas = comisiones.porc_ventas,
porc_cobros = comisiones.porc_cobros,
us_mod = USER,
fech_mod = CURRENT
WHERE
sec_vend = comisiones.sec_vend AND
cod_n = comisiones.cod_n AND
cod_grupo = comisiones.cod_grupo AND
cod_tipo = comisiones.cod_tipo AND
cod_sec = comisiones.cod_sec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "eLiminar"
"Elimina registro que esta en la pantalla"
UPDATE vetb00011 SET status_t = "E"
WHERE cod_vend = comisiones.cod_vend AND
sec_vend = comisiones.sec_vend AND
cod_n = comisiones.cod_n AND
cod_grupo = comisiones.cod_grupo AND
cod_tipo = comisiones.cod_tipo AND
cod_sec = comisiones.cod_sec
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
# CALL ayuda()
EXIT MENU
END MENU
END FUNCTION
FUNCTION busca_vendedor2()
# Esta funcion busca el nombre del vendedor y lo despliega en pantalla
# Esta funcion es valida solamente para la consulta-modificacion.
SELECT i.nom1_emp, i.apell1_emp, i.status_t
INTO descrip1, descrip2, status_reg
FROM adtb00003 i
WHERE i.num_emp = comisiones.sec_vend and i.status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 68
CALL msg(numero_msg)
ELSE
IF status_reg = "E" THEN
LET numero_msg = 67
CALL msg(numero_msg)
END IF
END IF
LET descrip6 = descrip1 clipped," ",descrip2 clipped
DISPLAY descrip6 TO descrip6
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
END FUNCTION
FUNCTION busca_nombre_articulo2()
# Esta funcion busca el nombre del articulo y lo despliega en pantalla
# Esta funcion es valida solamente para la consulta-modificacion.
SELECT i.descrip_esp, i.status_t INTO descrip1, status_reg
FROM intb00001 i
WHERE i.cod_n = comisiones.cod_n AND
i.cod_grupo = comisiones.cod_grupo AND
i.cod_tipo = comisiones.cod_tipo AND
i.cod_sec = comisiones.cod_sec
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 26
CALL msg(numero_msg)
ELSE
IF status_reg = "E" THEN
LET numero_msg = 44
CALL msg(numero_msg)
END IF
END IF
DISPLAY descrip1 TO descrip_esp
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
END FUNCTION
FUNCTION consulta_empleados2()
OPEN WINDOW busqueda AT 7,12 WITH FORM "tefmwd001"
ATTRIBUTE (BORDER,FORM LINE FIRST + 2,COMMENT LINE LAST,MESSAGE LINE LAST)
LET int_flag = false
CONSTRUCT criterio ON a.nom1_emp FROM descrip6
LET selec2 = "SELECT a.num_emp, a.nom1_emp, a.apell1_emp ",
"FROM adtb00003 a ",
"WHERE a.status_t is null AND ",criterio clipped," ORDER BY 1,2 "
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GO TO salir_consulta_e
END IF
PREPARE busca_empleados FROM selec2
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
END IF
END IF
DECLARE buscar_empleados CURSOR FOR busca_empleados
LET idx = 1
FOREACH buscar_empleados INTO arr_empleados[idx].*
IF status = NOTFOUND THEN
EXIT FOREACH
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
EXIT FOREACH
END IF
LET empleados[idx].cod_emp = arr_empleados[idx].cod_emp
LET empleados[idx].descrip6 =
arr_empleados[idx].nom_emp clipped," ",arr_empleados[idx].apell_emp clipped
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
MESSAGE " <Esc> Selecciona Empleado donde esta el cursor"
DISPLAY ARRAY empleados TO s_empleados.*
LET curr1 = arr_curr()
LET transportista.cod_transp = empleados[curr1].cod_emp
LET descrip6 = empleados[curr1].descrip6
LABEL salir_consulta_e:
CLOSE WINDOW busqueda
END FUNCTION