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

236 lines
6.8 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : ADPRMT025
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Empleados Temporeros
PROGRAMADOR : Tadeo A. Ferreras F.
FECHA REALIZACION : Febrero 01, 1996
------------------------------------------------------------------
}
GLOBALS "adprgb000.4gl"
DEFINE adtb36 RECORD LIKE adtb00036.*
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
let usuarios = "kpolanco"
let clave = "RevolutionX3"
CONNECT to "smarmotech" USER usuarios USING clave
SELECT a.* INTO p_companias.* FROM companias a
CALL adprmt025()
END MAIN
FUNCTION adprmt025()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM adfmmt025 FROM "adfmmt025"
DISPLAY FORM adfmmt025
DISPLAY "adprmt025" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Empleados Temporeros" AT 6,30 ATTRIBUTE(BLACK)
MENU
ON ACTION nuevo
let int_flag = false
INITIALIZE emplea.* TO NULL
CALL adpcad025()
ON ACTION buscar
let int_flag = false
CALL adpcmf025()
ON ACTION Salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION adpcad025()
## CAPTURA LOS DATOS QUE VA A CONTENER EL REGISTRO
INPUT BY NAME adtb36.*
## VERIFICA QUE EL CODIGO NO EXISTA EN EL CATALOGO DE DEPARTAMENTO. SI EXISTE,
## ENTONCES DESPLEGA LOS DATOS DEL REGISTRO EXISTENTE.
AFTER FIELD num_emp
IF adtb36.num_emp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_emp
END IF
SELECT * INTO adtb36.* FROM adtb00036
WHERE num_emp = adtb36.num_emp
IF status != NOTFOUND THEN
IF adtb36.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD num_emp
END IF
DISPLAY BY NAME adtb36.*
LET numero_msg = 12
CALL msg(numero_msg)
LET adtb36.nom1_emp = NULL
LET adtb36.nom2_emp = NULL
LET adtb36.apell1_emp = NULL
LET adtb36.apell2_emp = NULL
NEXT FIELD num_emp
END IF
AFTER FIELD nom1_emp
IF adtb36.nom1_emp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nom1_emp
END IF
AFTER FIELD apell1_emp
IF adtb36.apell1_emp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD apell1_emp
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
END INPUT
INSERT INTO adtb00036 VALUES (adtb36.*)
UPDATE adtb00036 SET (us_crea,fech_crea) = (SUSER_SNAME (),GETDATE ())
WHERE num_emp = adtb36.num_emp
LET numero_msg = 1
CALL msg(numero_msg)
END FUNCTION
FUNCTION adpcmf025()
## AQUI SE PREPARA PARA LA CAPTURA DEL CRITERIO DE SELECCION PARA LA
## MODIFICACION DE REGISTROS
CONSTRUCT criterio ON adtb00036.* FROM adtb00036.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = "SELECT UNIQUE * FROM adtb00036 WHERE status_t IS NULL AND ",
criterio clipped," ORDER BY 1"
PREPARE busca FROM selec
DECLARE dato SCROLL CURSOR FOR busca
OPEN dato
FETCH FIRST dato INTO adtb36.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
DISPLAY BY NAME adtb36.*
MENU "OPCIONES "
COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado"
FETCH NEXT dato INTO adtb36.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME adtb36.*
COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS dato INTO adtb36.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME adtb36.*
COMMAND "Primero" "Presenta en pantalla el primer registro encontrado"
FETCH FIRST dato INTO adtb36.*
DISPLAY BY NAME adtb36.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado"
FETCH LAST dato INTO adtb36.*
DISPLAY BY NAME adtb36.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger" "<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
IF adtb36.status_t = "E" THEN
LET numero_msg = 39
CALL msg(numero_msg)
RETURN
END IF
## SE SELECCIONAN LOS CAMPOS QUE SON MODIFICABLES
INPUT BY NAME adtb36.nom1_emp THRU adtb36.fech_mod WITHOUT DEFAULTS
AFTER FIELD nom1_emp
IF adtb36.nom1_emp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nom1_emp
END IF
AFTER FIELD apell1_emp
IF adtb36.apell1_emp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD apell1_emp
END IF
#### Verifica si el usuario presiono la tecla <Ctrl-C>
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
## AQUI SE ACTUALIZA EL REGISTRO
UPDATE adtb00036 SET (nom1_emp,nom2_emp,apell1_emp,apell2_emp,
us_mod,fech_mod) =
(adtb36.nom1_emp,adtb36.nom2_emp,adtb36.apell1_emp,
adtb36.apell2_emp,SUSER_SNAME (),GETDATE ())
WHERE @num_emp = adtb36.num_emp
LET numero_msg = 13
CALL msg(numero_msg)
## AQUI SE ELIMINAN LOS REGISTROS
COMMAND KEY ("L") "eLiminar"
UPDATE adtb00036 SET (status_t,us_mod,fech_mod) = ("E",SUSER_SNAME (),GETDATE ())
WHERE @num_emp = adtb36.num_emp
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar" "Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION