Files
MBS/PROYECTO/addir/adprmt003.4gl
T

344 lines
10 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : ADPRMT003
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Puestos
PROGRAMADOR : Ing. Betania Guerrero Perez
FECHA REALIZACION : Mayo 20, 1993
------------------------------------------------------------------
}
GLOBALS "adprgb000.4gl"
DEFINE nombre_p LIKE adtb00004.nom_puesto,
cod_p LIKE adtb00004.cod_puesto
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 a.* INTO p_companias.* FROM companias a
CALL adprmt003()
END MAIN
FUNCTION adprmt003()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM adfmmt003 FROM "adfmmt003"
DISPLAY FORM adfmmt003
DISPLAY "adprmt003" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Puestos" AT 6,39 ATTRIBUTE(BLACK)
MENU
ON ACTION nuevo
let int_flag = false
INITIALIZE emplea.* TO NULL
CALL adpcad003()
ON ACTION buscar
let int_flag = false
CALL adpcmf003()
ON ACTION Salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION adpcad003()
# WHENEVER ERROR CONTINUE
## Aqui se procede a la captura de los datos que va a contener el registro
INPUT BY NAME puesto.*
## Verifica que el codigo no exista en el catalogo de puestos. Si existe,
## entonces despliega los dato del registro existente.
AFTER FIELD cod_puesto
IF puesto.cod_puesto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_puesto
ELSE
SELECT * INTO puesto.* FROM adtb00004
WHERE cod_puesto = puesto.cod_puesto
IF status >= 0 THEN
IF status != NOTFOUND THEN
IF puesto.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_puesto
END IF
DISPLAY BY NAME puesto.*
LET numero_msg = 12
CALL msg(numero_msg)
LET puesto.nom_puesto = NULL
NEXT FIELD cod_puesto
END IF
LET nombre_p = puesto.nom_puesto
LET cod_p = puesto.cod_puesto
INITIALIZE puesto.* TO NULL
LET puesto.nom_puesto = nombre_p
LET puesto.cod_puesto = cod_p
ELSE
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
END IF
END IF
AFTER FIELD nom_puesto
IF puesto.nom_puesto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nom_puesto
END IF
## CHEQUEA QUE SE DESCRIBAN LAS FUNCIONES DEL PUESTO
{ AFTER FIELD funciones
IF puesto.funciones IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD funciones
END IF}
## CHEQUEA QUE SE DESCRIBAN LAS FUNCIONES DEL PUESTO
{ AFTER FIELD funcion1
IF puesto.funcion1 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD funcion1
END IF
## CHEQUEA QUE SE INDIQUE EL NIVEL SALARIAL CORRESPONDIENTE AL PUESTO
AFTER FIELD nivel_sal
IF puesto.nivel_sal IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nivel_sal
END IF
## CHEQUEA QUE SE INDIQUE EL SALARIO MININO CORRESPONDIENTE AL PUESTO
AFTER FIELD salario_min
IF puesto.salario_min IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD salario_min
END IF
## CHEQUEA QUE SE INDIQUE EL SALARIO MAXIMO CORRESPONDIENTE AL PUESTO
AFTER FIELD salario_max
IF puesto.salario_max IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD salario_max
END IF}
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
## SI NO OCURRE NINGUN ERROR SE PROCEDE A INSERTAR EL REGISTRO
IF puesto.cod_puesto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_puesto
ELSE
INSERT INTO adtb00004 VALUES (puesto.cod_puesto,puesto.nom_puesto,
puesto.otra_descripcion,
puesto.funciones,puesto.funcion1,puesto.nivel_sal,
puesto.salario_min,puesto.salario_max,null,SUSER_SNAME(),
GETDATE(),null,null)
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
LET puesto.cod_puesto = NULL
LET puesto.nom_puesto = NULL
LET puesto.funciones = NULL
LET puesto.funcion1 = NULL
LET puesto.nivel_sal = NULL
LET puesto.salario_min = NULL
LET puesto.salario_max = NULL
NEXT FIELD cod_puesto
END IF
AFTER FIELD fech_mod
EXIT INPUT
END INPUT
END FUNCTION
FUNCTION adpcmf003()
## Aqui se prepara para la captura del criterio de seleccion para
## modificar/actualizar los registros
# WHENEVER ERROR CONTINUE
CONSTRUCT criterio ON adtb00004.cod_puesto,adtb00004.nom_puesto
FROM cod_puesto,nom_puesto
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE * FROM adtb00004 where ",
" status_t is null and ",
criterio clipped,
" ORDER BY 1"
PREPARE busca FROM selec
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
DECLARE dato SCROLL CURSOR FOR busca
OPEN dato
FETCH FIRST dato INTO puesto.*
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
ELSE
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
END IF
DISPLAY BY NAME puesto.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla e proximo registro encontrado"
FETCH NEXT dato INTO puesto.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME puesto.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS dato INTO puesto.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME puesto.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST dato INTO puesto.*
DISPLAY BY NAME puesto.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST dato INTO puesto.*
DISPLAY BY NAME puesto.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
IF puesto.status_t = "E" THEN
LET numero_msg = 39
CALL msg(numero_msg)
RETURN
END IF
## SE SELECCIONAN LOS CAMPOS MODIFICABLES
INPUT BY NAME puesto.nom_puesto,
puesto.funciones,
puesto.funcion1,
puesto.nivel_sal,
puesto.salario_min,
puesto.salario_max,
puesto.us_crea,
puesto.fech_crea,
puesto.us_mod,
puesto.fech_mod WITHOUT DEFAULTS
AFTER FIELD nom_puesto
IF puesto.nom_puesto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nom_puesto
END IF
#### Verifica si el usuario presiono la tecla <Ctrl-C>
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
## Aqui se actualizan los registros
UPDATE adtb00004 SET nom_puesto = puesto.nom_puesto,
otra_descripcion = puesto.otra_descripcion,
funciones = puesto.funciones,
funcion1 = puesto.funcion1,
nivel_sal = puesto.nivel_sal,
salario_min = puesto.salario_min,
salario_max = puesto.salario_max,
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE cod_puesto = puesto.cod_puesto
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
## AQUI SE ELIMINAN LOS REGISTROS
COMMAND KEY ("L") "eLiminar"
UPDATE adtb00004 SET status_t = "E"
WHERE cod_puesto = puesto.cod_puesto
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION