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

630 lines
24 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : ADPRMT021
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Amonestacines
PROGRAMADOR : Ing. Betania Guerrero Perez
FECHA REALIZACION : Junio 14, 1993
------------------------------------------------------------------
}
GLOBALS "adprgb000.4gl"
## REGISTRO QUE CONTINENE LOS DATOS A IMPRIMIRSE EN EL REPORTE
DEFINE captura RECORD
amon_num LIKE adtb00026.amon_num,
fecha LIKE adtb00026.fecha,
num_emp LIKE adtb00026.num_emp,
departamento LIKE adtb00026.departamento,
nivel_emp LIKE adtb00026.nivel_emp,
cod_puesto LIKE adtb00026.cod_puesto,
descrip3 CHAR(60),
nom_dpto LIKE adtb00001.nom_dpto,
violacion LIKE adtb00026.violacion,
violacion1 LIKE adtb00026.violacion1,
num1_emp LIKE adtb00026.num1_emp,
departamento1 LIKE adtb00026.departamento1,
nivel1_emp LIKE adtb00026.nivel1_emp,
cod1_puesto LIKE adtb00026.cod1_puesto,
descrip1 CHAR(40),
num2_emp LIKE adtb00026.num2_emp,
departamento2 LIKE adtb00026.departamento2,
nivel2_emp LIKE adtb00026.nivel2_emp,
cod2_puesto LIKE adtb00026.cod2_puesto,
descrip2 CHAR(60)
END RECORD
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 adprmt021()
END MAIN
FUNCTION adprmt021()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 24,
COMMENT LINE 23
OPEN FORM adfmmt021 FROM "adfmmt021"
DISPLAY FORM adfmmt021
DISPLAY "adprmt021" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Amonestaciones" AT 6,36 ATTRIBUTE(BLACK)
MENU
ON ACTION nuevo
let int_flag = false
INITIALIZE emplea.* TO NULL
CALL adpcad021()
ON ACTION buscar
let int_flag = false
CALL adpcmf021()
ON ACTION Salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION adpcad021()
# # WHENEVER ERROR CONTINUE
## CAPTURA LOS DATOS QUE VA A CONTENER EL REGISTRO
INPUT BY NAME amon.*
## VENTANA QUE BUSCA LOS EMPLEADOS
ON KEY (CONTROL-W)
CASE
WHEN INFIELD (num_emp)
CALL busca_empleado()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
NEXT FIELD num_emp
END IF
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num_emp
END IF
LET descrip3 = nombre
LET amon.num_emp = despl_emp[curr1].num_emp
LET amon.departamento = despl_emp[curr1].departamento
IF amon.departamento IS NOT NULL THEN
SELECT nom_dpto INTO depto.nom_dpto FROM adtb00001
WHERE departamento = amon.departamento
END IF
LET amon.nivel_emp = despl_emp[curr1].nivel_emp
LET amon.cod_puesto = despl_emp[curr1].cod_puesto
DISPLAY BY NAME amon.num_emp,amon.departamento,
amon.nivel_emp,amon.cod_puesto,descrip3,
depto.nom_dpto
NEXT FIELD violacion
WHEN INFIELD (num2_emp)
CALL busca_empleado()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
NEXT FIELD num2_emp
END IF
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num2_emp
END IF
LET descrip2 = nombre
LET amon.num2_emp = despl_emp[curr1].num_emp
LET amon.departamento2 = despl_emp[curr1].departamento
LET amon.nivel2_emp = despl_emp[curr1].nivel_emp
LET amon.cod2_puesto = despl_emp[curr1].cod_puesto
DISPLAY BY NAME amon.num2_emp,amon.departamento2,
amon.nivel2_emp,amon.cod2_puesto,descrip2
NEXT FIELD cod2_puesto
END CASE
## SE DESPLEGA AUTOMATICAMENTE EL NUMERO DE LA AMONESTACION
BEFORE FIELD fecha
LET amon.amon_num = indice
DISPLAY BY NAME amon.amon_num
AFTER FIELD fecha
IF amon.fecha IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
AFTER FIELD num_emp
IF amon.num_emp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_emp
END IF
## CHEQUEA QUE EL EMPLEADO EXISTA EN LA TABLA DE EMPLEADOS
SELECT nom1_emp,nom2_emp,apell1_emp,apell2_emp,departamento,
cod_puesto,nivel_emp
INTO nombre1,nombre2,apellido1,apellido2,amon.departamento,
amon.cod_puesto,amon.nivel_emp
FROM adtb00003
WHERE num_emp = amon.num_emp and (status_t is null or
status_t != "E")
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num_emp
END IF
## VERIFICA QUE EL DEPARTAMENTO EXISTA EN EL CATALOGO DE DEPARTAMENTOS
SELECT nom_dpto INTO depto.nom_dpto FROM adtb00001
WHERE departamento = amon.departamento
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
DISPLAY BY NAME depto.nom_dpto,amon.departamento,
amon.cod_puesto,amon.nivel_emp
LET descrip3 = nombre1 clipped," ",nombre2 clipped," ",
apellido1 clipped," ",apellido2 clipped
DISPLAY BY NAME descrip3
AFTER FIELD violacion
IF amon.violacion IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD violacion
END IF
## CHEQUEA QUE EL EMPLEADO EXISTA EN LA TABLA DE EMPLEADOS Y ADEMAS QUE
## EL EMPLEADO QUE FIRMA ES EL MISMO QUE RECIBE LA AMONESTACION
BEFORE FIELD num1_emp
LET amon.num1_emp = amon.num_emp
LET amon.departamento1 = amon.departamento
LET amon.nivel1_emp = amon.nivel_emp
LET amon.cod1_puesto = amon.cod_puesto
DISPLAY BY NAME amon.num1_emp,amon.departamento1,
amon.nivel1_emp,amon.cod1_puesto
SELECT nom1_emp,nom2_emp,apell1_emp,apell2_emp,departamento,
cod_puesto,nivel_emp
INTO nombre1,nombre2,apellido1,apellido2,amon.departamento1,
amon.cod1_puesto,amon.nivel1_emp
FROM adtb00003
WHERE num_emp = amon.num1_emp and status_t is null
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num1_emp
END IF
LET descrip1 = nombre1 clipped," ",nombre2 clipped," ",
apellido1 clipped," ",apellido2 clipped
DISPLAY BY NAME descrip1,amon.departamento1,amon.cod1_puesto,
amon.nivel1_emp
AFTER FIELD num2_emp
IF amon.num2_emp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num2_emp
END IF
## CHEQUEA QUE EL EMPLEADO EXISTA EN LA TABLA DE EMPLEADOS
SELECT nom1_emp,nom2_emp,apell1_emp,apell2_emp,departamento,
cod_puesto,nivel_emp
INTO nombre1,nombre2,apellido1,apellido2,amon.departamento2,
amon.cod2_puesto,amon.nivel2_emp
FROM adtb00003
WHERE num_emp = amon.num2_emp and (status_t is null or
status_t != "E")
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num2_emp
END IF
LET descrip2 = nombre1 clipped," ",nombre2 clipped," ",
apellido1 clipped," ",apellido2 clipped
DISPLAY BY NAME descrip2,amon.departamento2,amon.cod2_puesto,
amon.nivel2_emp
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
EXIT INPUT
END INPUT
## SI NO OCURRE NINGUN ERROR SE PROCEDE A INSERTAR EL REGISTRO
INSERT INTO adtb00026
VALUES (amon.amon_num,amon.fecha,amon.num_emp,amon.departamento,
amon.nivel_emp,amon.cod_puesto,amon.violacion,
amon.violacion1,amon.num1_emp,amon.departamento1,
amon.nivel1_emp,amon.cod1_puesto,amon.num2_emp,
amon.departamento2,amon.nivel2_emp,amon.cod2_puesto,null,
SUSER_SNAME (),GETDATE (),null,null)
## SE ACTUALIZA LA TABLA DE NUMERACION AUTOMATICA DE LA AMONESTACION
UPDATE adtb00028 SET num_trx = amon.amon_num WHERE clave = "AM"
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
## SE PERMITE IMPRIMIR LA AMONESTACION
PROMPT "Desea Imprimir Amonestacion? s/n" FOR CHAR OPT
LET opt = upshift(opt)
IF OPT = "S" THEN
START REPORT formulario TO "c:\\amonestacion"
LET captura.amon_num = amon.amon_num
LET captura.fecha = amon.fecha
LET captura.num_emp = amon.num_emp
LET captura.departamento = amon.departamento
LET captura.nivel_emp = amon.nivel_emp
LET captura.cod_puesto = amon.cod_puesto
LET captura.descrip3 = descrip3
LET captura.nom_dpto = depto.nom_dpto
LET captura.violacion = amon.violacion
LET captura.violacion1 = amon.violacion1
LET captura.num1_emp = amon.num1_emp
LET captura.departamento1 = amon.departamento1
LET captura.nivel1_emp = amon.nivel1_emp
LET captura.cod1_puesto = amon.cod1_puesto
LET captura.descrip1 = descrip1
LET captura.num2_emp = amon.num2_emp
LET captura.departamento2 = amon.departamento2
LET captura.nivel2_emp = amon.nivel2_emp
LET captura.cod2_puesto = amon.cod2_puesto
LET captura.descrip2 = descrip2
OUTPUT TO REPORT formulario(captura.*)
FINISH REPORT formulario
RUN "TYPE C:\\AMONESTACION > %USPRINT%"
END IF
END FUNCTION
FUNCTION adpcmf021()
## AQUI SE PREPARA PARA LA CAPTURA DEL CRITERIO DE SELECCION PARA LA
## MODIFICACION DE REGISTROS
CONSTRUCT criterio ON adtb00026.* FROM adtb00026.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC =
"SELECT UNIQUE amon_num,CONVERT(char(10),fecha,103),num_emp,departamento,nivel_emp, ",
" cod_puesto,violacion,violacion1,num1_emp,departamento1, ",
" nivel1_emp,cod1_puesto,num2_emp,departamento2,nivel2_emp, ",
" cod2_puesto ",
"FROM adtb00026 ",
"WHERE status_t IS NULL AND ",criterio clipped," ORDER BY 1,3,4,5,6"
PREPARE busca FROM selec
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO amon.*
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
CALL desplegando()
MENU "OPCIONES "
COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO amon.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL desplegando()
COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO amon.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL desplegando()
COMMAND "Primero" "Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO amon.*
CALL desplegando()
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO amon.*
CALL desplegando()
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger" "<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
## SE SELECCIONAN LOS CAMPOS MODIFICABLES
INPUT BY NAME amon.violacion,amon.violacion1,amon.us_crea,
amon.fech_crea,amon.us_mod,amon.fech_mod
WITHOUT DEFAULTS
AFTER FIELD violacion
IF amon.violacion IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD violacion
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 ACTUALIZA EL REGISTRO
UPDATE adtb00026 SET violacion = amon.violacion,
violacion1 = amon.violacion1,
us_mod = SUSER_SNAME (),
fech_mod = GETDATE ()
WHERE amon_num = amon.amon_num and
num_emp = amon.num_emp and
departamento = amon.departamento and
nivel_emp = amon.nivel_emp and
cod_puesto = amon.cod_puesto
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
## SE PERMITE IMPRIMIR LA AMONESTACION
PROMPT "Desea Imprimir Amonestacion? s/n" FOR CHAR OPT
LET opt = upshift(opt)
IF OPT = "S" THEN
START REPORT formulario TO "C:\\AMONESTACION"
LET captura.amon_num = amon.amon_num
LET captura.fecha = amon.fecha
LET captura.num_emp = amon.num_emp
LET captura.departamento = amon.departamento
LET captura.nivel_emp = amon.nivel_emp
LET captura.cod_puesto = amon.cod_puesto
LET captura.descrip3 = descrip3
LET captura.nom_dpto = depto.nom_dpto
LET captura.violacion = amon.violacion
LET captura.violacion1 = amon.violacion1
LET captura.num1_emp = amon.num1_emp
LET captura.departamento1 = amon.departamento1
LET captura.nivel1_emp = amon.nivel1_emp
LET captura.cod1_puesto = amon.cod1_puesto
LET captura.descrip1 = descrip1
LET captura.num2_emp = amon.num2_emp
LET captura.departamento2 = amon.departamento2
LET captura.nivel2_emp = amon.nivel2_emp
LET captura.cod2_puesto = amon.cod2_puesto
LET captura.descrip2 = descrip2
OUTPUT TO REPORT formulario(captura.*)
FINISH REPORT formulario
RUN "TYPE C:\\AMONESTACION > %USPRINT%"
END IF
COMMAND KEY ("L") "eLiminar"
UPDATE adtb00026 SET status_t = "E"
WHERE amon_num = amon.amon_num and
num_emp = amon.num_emp and
departamento = amon.departamento and
nivel_emp = amon.nivel_emp and
cod_puesto = amon.cod_puesto
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
## SELECCIONA Y DESPLIEGA LOS DATOS DEL REGISTRO ESCOGIDO
FUNCTION desplegando()
SELECT nom1_emp,nom2_emp,apell1_emp,apell2_emp
INTO nombre1,nombre2,apellido1,apellido2 FROM adtb00003
WHERE num_emp = amon.num_emp and departamento = amon.departamento and
nivel_emp = amon.nivel_emp and cod_puesto = amon.cod_puesto
LET descrip3 = nombre1 clipped," ",nombre2 clipped," ",
apellido1 clipped," ",apellido2 clipped
SELECT nom1_emp,nom2_emp,apell1_emp,apell2_emp
INTO nombre1,nombre2,apellido1,apellido2 FROM adtb00003
WHERE num_emp = amon.num1_emp and departamento = amon.departamento1 and
nivel_emp = amon.nivel1_emp and cod_puesto = amon.cod1_puesto
LET descrip1 = nombre1 clipped," ",nombre2 clipped," ",
apellido1 clipped," ",apellido2 clipped
SELECT nom1_emp,nom2_emp,apell1_emp,apell2_emp
INTO nombre1,nombre2,apellido1,apellido2 FROM adtb00003
WHERE num_emp = amon.num2_emp and departamento = amon.departamento2 and
nivel_emp = amon.nivel2_emp and cod_puesto = amon.cod2_puesto
LET descrip2 = nombre1 clipped," ",nombre2 clipped," ",
apellido1 clipped," ",apellido2 clipped
SELECT nom_dpto INTO depto.nom_dpto FROM adtb00001
WHERE departamento = amon.departamento
DISPLAY BY NAME amon.*,descrip1,descrip2,descrip3,depto.nom_dpto
END FUNCTION
## AQUI SE PREPARA EL REPORTE PARA IMPRIMIR LA AMONESTACION
REPORT formulario(x)
DEFINE x RECORD
amon_num LIKE adtb00026.amon_num,
fecha LIKE adtb00026.fecha,
num_emp LIKE adtb00026.num_emp,
departamento LIKE adtb00026.departamento,
nivel_emp LIKE adtb00026.nivel_emp,
cod_puesto LIKE adtb00026.cod_puesto,
descrip3 CHAR (60),
nom_dpto LIKE adtb00001.nom_dpto,
violacion LIKE adtb00026.violacion,
violacion1 LIKE adtb00026.violacion1,
num1_emp LIKE adtb00026.num1_emp,
departamento1 LIKE adtb00026.departamento1,
nivel1_emp LIKE adtb00026.nivel1_emp,
cod1_puesto LIKE adtb00026.cod1_puesto,
descrip1 CHAR(40),
num2_emp LIKE adtb00026.num2_emp,
departamento2 LIKE adtb00026.departamento2,
nivel2_emp LIKE adtb00026.nivel2_emp,
cod2_puesto LIKE adtb00026.cod2_puesto,
descrip2 CHAR(60)
END RECORD
## DEFINICION DE LAS VARIABLES DE IMPRESION
DEFINE doble_on CHAR(2),
doble_off CHAR(2),
comprimido_on CHAR(2),
comprimido_off CHAR(2),
negrillas_on CHAR(2),
negrillas_off CHAR(2),
normal CHAR(2),
doce CHAR(2),
hora CHAR(5)
OUTPUT
LEFT MARGIN 0
FORMAT
PAGE HEADER
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 comprimido_on = ASCII 15
LET comprimido_off = ASCII 18
LET normal = ASCII 28, ASCII 80
LET doce = ASCII 27, ASCII 77
LET hora = time
PRINT COLUMN 1, negrillas_on
PRINT COLUMN 1, "Amonestacion",
COLUMN 17, "R A Y . O . V A C D O M I N I C A N A, S. A.",
COLUMN 73, "Pag. ",pageno using "<<<"
PRINT COLUMN 17, " Sistema de Administracion de Personal",
COLUMN 73, today using "dd/mm/yyyy"
PRINT COLUMN 28, " Amonestaciones al Personal",
COLUMN 76, hora
SKIP 2 LINES
PRINT COLUMN 1, negrillas_on,
COLUMN 30, "AMONESTACION ESCRITA No.",x.amon_num using "<<<<",
COLUMN 70, negrillas_off
SKIP 2 LINES
PRINT COLUMN 1, doce,
COLUMN 7, "Hoy",
COLUMN 10, negrillas_on,
COLUMN 11, x.fecha using "dd/mm/yyyy",
COLUMN 20, negrillas_off
SKIP 1 LINE
PRINT COLUMN 5, "Se amonesta por escrito al senor(a):",
COLUMN 40, negrillas_on,
COLUMN 45, x.num_emp using "&&&&","-",
COLUMN 50, x.departamento using "&&&&","-",
COLUMN 55, x.nivel_emp using "&&","-",
COLUMN 58, x.cod_puesto using "&&",
COLUMN 62, x.descrip3,
COLUMN 125, negrillas_off
SKIP 1 LINE
PRINT COLUMN 5, "Del departamento:",
COLUMN 21, negrillas_on,
COLUMN 25, x.nom_dpto,
COLUMN 40, negrillas_off
PRINT COLUMN 1, negrillas_on
PRINT COLUMN 5, "Por haber incurrido en la siguiente violacion:"
PRINT COLUMN 5, x.violacion
PRINT COLUMN 5, x.violacion1
PRINT COLUMN 1, negrillas_off
SKIP 2 LINES
PRINT COLUMN 1, negrillas_on,
COLUMN 7, x.num1_emp using "&&&&","-",
x.departamento1 using "&&&&","-",
x.nivel1_emp using "&&","-",
x.cod1_puesto using "&&",
COLUMN 56, x.num2_emp using "&&&&","-",
x.departamento2 using "&&&&","-",
x.nivel2_emp using "&&","-",
x.cod2_puesto using "&&",negrillas_off
PRINT COLUMN 1, negrillas_on,
COLUMN 7, x.descrip1,
COLUMN 56, x.descrip2,negrillas_off
skip 4 lines
PRINT COLUMN 3, "__________________________________________",
COLUMN 52, "__________________________________________"
PRINT COLUMN 13, "Aceptado Conforme",
COLUMN 64, "Gerente/Supervisor"
ON LAST ROW
PRINT ASCII 27, ASCII 80
END REPORT