Files
MBS/PROYECTO/nodir/noprmt023.4gl
T

658 lines
24 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : NOPRMT023
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Departamentos
PROGRAMADOR : Ing. Betania Guerrero Perez
FECHA REALIZACION : Mayo 19, 1993
------------------------------------------------------------------
}
GLOBALS "noprgb000.4gl"
DEFINE
parte SMALLINT,
PDEPNAME VARCHAR(100),
ksupervisor INT,
arr_relacionados DYNAMIC ARRAY OF RECORD
id, departamento_relaciona INT
END RECORD
DEFINE
apicheck BOOLEAN,
answer INT,
query STRING,
estado_m INT
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT TO "marmotech" AS "IFMX" USER usuarios USING clave
CONNECT TO "smarmotech" AS "MSSQL" USER usuarios USING clave
SELECT a.* INTO p_companias.* FROM companias a
CALL noprmt023()
END MAIN
FUNCTION noprmt023()
CLEAR SCREEN
OPTIONS FORM LINE 9, ERROR LINE 23, COMMENT LINE 21
LET selec =
"SELECT a.deptname FROM facial.dbo.departments a
WHERE a.deptid = ?"
PREPARE buscadep FROM selec
OPEN FORM nofmmt023 FROM "nofmmt023"
DISPLAY FORM nofmmt023
MENU "OPCIONES"
ON ACTION nuevo
LET int_flag = FALSE
CLEAR FORM
SET CONNECTION "MSSQL"
CALL nopcad023()
ON ACTION buscar
SET CONNECTION "MSSQL"
LET int_flag = FALSE
CALL nopcmf023()
ON ACTION salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION nopcad023()
#WHENEVER ERROR CONTINUE
DIALOG ATTRIBUTE(UNBUFFERED)
## CAPTURA LOS DATOS QUE VA A CONTENER EL REGISTRO
INPUT BY NAME depto.*, apicheck, estado_m ATTRIBUTES(WITHOUT DEFAULTS)
BEFORE INPUT
CALL csupervisores()
## VERIFICA QUE EL CODIGO NO EXISTA EN EL CATALOGO DE DEPARTAMENTO. SI EXISTE,
## ENTONCES DESPLEGA LOS DATOS DEL REGISTRO EXISTENTE.
AFTER FIELD departamento
IF depto.departamento IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD departamento
ELSE
SELECT *
INTO depto.*
FROM adtb00001
WHERE departamento = depto.departamento
LET query =
"SELECT top 1 estado_m FROM adtb00029
WHERE departamento = ? AND estatus_t IS NULL
AND estado_m is not null"
PREPARE buscaEstadoM FROM query
EXECUTE buscaEstadoM INTO estado_m USING depto.departamento
IF status >= 0 THEN
IF status != NOTFOUND THEN
IF depto.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
DISPLAY BY NAME depto.*
LET numero_msg = 12
CALL msg(numero_msg)
LET depto.nom_dpto = NULL
NEXT FIELD departamento
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
END IF
END IF
AFTER FIELD nom_dpto
IF depto.nom_dpto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nom_dpto
END IF
AFTER FIELD estado_m
IF estado_m IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD estado_m
END IF
{ AFTER FIELD departamento_out
IF depto.departament_out IS NOT NULL THEN
EXECUTE buscadep INTO pdepname USING depto.departament_out
IF STATUS = NOTFOUND THEN
CALL fgl_winmessage("INFO","DEPARTAMENTO NO EXISTE EN SISTEMA SYSTEM ATTENDANCE","info")
NEXT FIELD departamentoid
END IF
DISPLAY BY NAME pdepname
END IF}
AFTER INPUT
IF depto.tipo_departamento IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo_departamento
END IF
IF estado_m IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD estado_m
END IF
END INPUT
INPUT ARRAY arr_relacionados FROM srelacionados.*
BEFORE INPUT
CALL deptorelacionado()
END INPUT
ON ACTION guardar ATTRIBUTE(TEXT = 'Salvar', IMAGE = "save")
## SI NO HAY NINGUN PROBLEMA SE PROCEDE A INSERTAR EL REGISTRO
IF depto.nom_dpto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nom_dpto
ELSE
BEGIN WORK
IF apicheck THEN
CALL ApiMaintainD(
'POST', NULL, depto.*, usuarios)
RETURNING answer
IF answer IS NOT NULL AND answer != 0 THEN
LET depto.id_maintainx = answer
ELSE
ROLLBACK WORK
END IF
END IF
INSERT INTO adtb00001(
departamento,
nom_dpto,
us_crea,
fech_crea,
tipo_departamento,
departamento_out,
app_movil,
num_emp_supervisa,
coordinadora,
id_maintainx)
VALUES(depto.departamento,
depto.nom_dpto,
usuarios,
GETDATE(),
depto.tipo_departamento,
depto.departamento_out,
depto.app_movil,
depto.num_emp_supervisa,
depto.coordinadora,
depto.id_maintainx)
INSERT INTO chequeo(
dpto, departamento, nom_dpto)
VALUES(parte, depto.departamento, depto.nom_dpto)
FOR i = 1 TO arr_relacionados.getLength()
IF arr_relacionados[i]
.departamento_relaciona IS NOT NULL THEN
INSERT INTO adtb00034(
departamento,
departamento_relaciona,
us_crea,
fech_crea)
VALUES(depto.departamento,
arr_relacionados[i].departamento_relaciona,
usuarios,
getdate())
END IF
END FOR
CALL upsert_estado_m()
COMMIT WORK
SET CONNECTION "IFMX"
INSERT INTO adtb00001
VALUES(depto.departamento,
depto.nom_dpto,
NULL,
usuarios,
getdate(),
NULL,
NULL,
depto.tipo_departamento)
INSERT INTO chequeo
VALUES(parte, depto.departamento, depto.nom_dpto)
SET CONNECTION "MSSQL"
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
LET depto.departamento = NULL
LET depto.nom_dpto = NULL
NEXT FIELD departamento
END IF
ON ACTION CANCEL ATTRIBUTE(TEXT = "Cancelar", IMAGE = "quit")
LET int_flag = FALSE
CALL msg(2)
RETURN
END DIALOG
END FUNCTION
FUNCTION nopcmf023()
## AQUI SE PREPARA PARA LA CAPTURA DEL CRITERIO DE SELECCION PARA LA
## MODIFICACION DE REGISTROS
SET CONNECTION "MSSQL"
#WHENEVER ERROR CONTINUE
CONSTRUCT criterio ON a.departamento, a.nom_dpto FROM departamento, nom_dpto
BEFORE CONSTRUCT
CALL csupervisores()
CALL deptorelacionado()
CALL arr_relacionados.clear()
AFTER CONSTRUCT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
EXIT CONSTRUCT
END CONSTRUCT
LET SELEC =
" SELECT UNIQUE a.* FROM adtb00001 a where ",
" a.status_t is null and ",
criterio CLIPPED,
" ORDER BY a.departamento"
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
DECLARE dato SCROLL CURSOR FOR busca
OPEN dato
FETCH FIRST dato INTO depto.*
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
CLEAR SCREEN
RETURN
END IF
END IF
CALL departamentosRelacionados()
CALL cargar_estado_m()
DISPLAY BY NAME depto.*, estado_m
DISPLAY ARRAY arr_relacionados TO srelacionados.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT dato INTO depto.*, xapp_movil
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL departamentosRelacionados()
CALL cargar_estado_m()
DISPLAY BY NAME depto.*, estado_m
DISPLAY ARRAY arr_relacionados TO srelacionados.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS dato INTO depto.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL departamentosRelacionados()
CALL cargar_estado_m()
DISPLAY BY NAME depto.*, estado_m
DISPLAY ARRAY arr_relacionados TO srelacionados.*
COMMAND "Primero" "Presenta en pantalla el primer registro encontrado"
FETCH FIRST dato INTO depto.*
DISPLAY BY NAME depto.*, estado_m
LET numero_msg = 5
CALL msg(numero_msg)
CALL departamentosRelacionados()
CALL cargar_estado_m()
DISPLAY ARRAY arr_relacionados TO srelacionados.*
COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado"
FETCH LAST dato INTO depto.*
DISPLAY BY NAME depto.*, estado_m
LET numero_msg = 4
CALL msg(numero_msg)
CALL departamentosRelacionados()
CALL cargar_estado_m()
DISPLAY ARRAY arr_relacionados TO srelacionados.*
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
DIALOG ATTRIBUTES(UNBUFFERED)
INPUT BY NAME depto.nom_dpto,
depto.tipo_departamento,
depto.app_movil,
depto.departamento_out,
depto.num_emp_supervisa,
depto.coordinadora,
apicheck,
estado_m
ATTRIBUTE(WITHOUT DEFAULTS)
BEFORE INPUT
CALL csupervisores()
IF depto.status_t = "E" THEN
LET numero_msg = 39
CALL msg(numero_msg)
RETURN
END IF
AFTER FIELD departamento_out
IF depto.departamento_out IS NOT NULL THEN
EXECUTE buscadep
INTO pdepname USING depto.departamento_out
IF STATUS = NOTFOUND THEN
CALL fgl_winmessage(
"INFO",
"DEPARTAMENTO NO EXISTE EN SISTEMA SYSTEM ATTENDANCE",
"info")
NEXT FIELD departamento_out
END IF
DISPLAY BY NAME pdepname
END IF
AFTER FIELD nom_dpto
IF depto.nom_dpto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nom_dpto
END IF
AFTER FIELD estado_m
IF estado_m IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD estado_m
END IF
#### Verifica si el usuario presiono la tecla <Ctrl-C>
AFTER INPUT
IF estado_m IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD estado_m
END IF
END INPUT
INPUT ARRAY arr_relacionados
FROM srelacionados.*
ATTRIBUTE(WITHOUT DEFAULTS)
END INPUT
ON ACTION guardar ATTRIBUTE(TEXT = 'Salvar', IMAGE = "quit")
SET CONNECTION 'MSSQL'
BEGIN WORK
## AQUI SE ACTUALIZA EL REGISTRO
IF apicheck THEN
IF depto.id_maintainx IS NOT NULL THEN
CALL ApiMaintainD(
'PATCH', depto.id_maintainx, depto.*, usuarios)
RETURNING answer
ELSE
CALL ApiMaintainD(
'POST', NULL, depto.*, usuarios)
RETURNING answer
END IF
IF answer IS NOT NULL AND answer != 0 THEN
IF depto.id_maintainx IS NULL THEN
LET depto.id_maintainx = answer
END IF
ELSE
ROLLBACK WORK
END IF
END IF
UPDATE adtb00001
SET nom_dpto = depto.nom_dpto,
tipo_departamento = depto.tipo_departamento,
departamento_out = depto.departamento_out,
us_mod = usuarios,
fech_mod = GETDATE(),
num_emp_supervisa = depto.num_emp_supervisa,
coordinadora = depto.coordinadora
WHERE departamento = depto.departamento
UPDATE chequeo
SET nom_dpto = depto.nom_dpto
WHERE departamento = depto.departamento
CALL upsert_estado_m()
SELECT DISTINCT a.departamento
FROM adtb00034 a
WHERE a.departamento = depto.departamento
IF STATUS = NOTFOUND THEN
FOR i = 1 TO arr_relacionados.getLength()
IF arr_relacionados[i]
.departamento_relaciona IS NOT NULL THEN
IF arr_relacionados[i].departamento_relaciona
= depto.departamento THEN
ROLLBACK WORK
CALL msg(32)
NEXT FIELD departamento_relaciona
END IF
INSERT INTO adtb00034(
departamento,
departamento_relaciona,
us_crea,
fech_crea)
VALUES(depto.departamento,
arr_relacionados[i]
.departamento_relaciona,
usuarios,
getdate())
END IF
END FOR
ELSE
FOR i = 1 TO arr_relacionados.getLength()
IF arr_relacionados[i]
.departamento_relaciona IS NOT NULL THEN
IF arr_relacionados[i].departamento_relaciona
= depto.departamento THEN
ROLLBACK WORK
CALL msg(32)
NEXT FIELD departamento_relaciona
END IF
UPDATE adtb00034
SET departamento_relaciona
= arr_relacionados[i]
.departamento_relaciona,
us_mod = usuarios,
fech_mod = getdate()
WHERE id = arr_relacionados[i].id
END IF
END FOR
END IF
COMMIT WORK
SET CONNECTION "IFMX"
SELECT a.departamento
FROM adtb00001 a
WHERE a.departamento = depto.departamento
IF STATUS = NOTFOUND THEN
INSERT INTO adtb00001
VALUES(depto.departamento,
depto.nom_dpto,
NULL,
usuarios,
getdate(),
NULL,
NULL,
depto.tipo_departamento)
ELSE
UPDATE adtb00001
SET nom_dpto = depto.nom_dpto,
tipo_departamento = depto.tipo_departamento,
us_mod = suser_sname(),
fech_mod = GETDATE()
WHERE departamento = depto.departamento
END IF
SELECT a.departamento
FROM chequeo a
WHERE a.departamento = depto.departamento
IF STATUS = NOTFOUND THEN
INSERT INTO chequeo
VALUES(parte, depto.departamento, depto.nom_dpto)
END IF
LET numero_msg = 13
CALL msg(numero_msg)
ON ACTION CANCEL ATTRIBUTE(TEXT = "Cancelar", IMAGE = "quit")
LET int_flag = FALSE
CALL msg(2)
RETURN
END DIALOG
## AQUI SE ELIMINAN LOS REGISTROS
COMMAND KEY("L") "eLiminar"
IF depto.id_maintainx IS NOT NULL THEN
CALL ApiMaintainD(
'DELETE', depto.id_maintainx, depto.*, usuarios)
RETURNING answer
END IF
UPDATE adtb00001
SET status_t = "E", us_mod = suser_sname(), fech_mod = GETDATE()
WHERE departamento = depto.departamento
DELETE FROM chequeo WHERE departamento = depto.departamento
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar" "Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
FUNCTION departamentosRelacionados()
DECLARE busca_depto CURSOR FOR
SELECT a.id, a.departamento_relaciona
FROM adtb00034 a
WHERE a.departamento = depto.departamento
LET i = 1
FOREACH busca_depto INTO arr_relacionados[i].*
LET i = i + 1
END FOREACH
END FUNCTION
FUNCTION cargar_estado_m()
LET estado_m = NULL
LET query =
"SELECT top 1 estado_m FROM adtb00029
WHERE departamento = ? AND estatus_t IS NULL
AND estado_m is not null"
PREPARE buscaEstadoM_2 FROM query
EXECUTE buscaEstadoM_2 INTO estado_m USING depto.departamento
DISPLAY BY NAME estado_m
END FUNCTION
FUNCTION upsert_estado_m()
DEFINE existe INT
SELECT COUNT(*)
INTO existe
FROM adtb00029
WHERE departamento = depto.departamento AND estatus_t IS NULL
IF existe > 0 THEN
UPDATE adtb00029
SET estado_m = estado_m, us_mod = usuarios, fech_mod = GETDATE()
WHERE departamento = depto.departamento AND estatus_t IS NULL
ELSE
INSERT INTO adtb00029(
departamento, estado_m, us_crea, fech_crea)
VALUES(depto.departamento, estado_m, usuarios, GETDATE())
END IF
END FUNCTION
FUNCTION csupervisores()
DEFINE
k1supervisor CHAR(60),
dsupervisor SMALLINT,
k2supervisor ui.combobox,
selec STRING
LET k2supervisor = ui.combobox.forname("formonly.num_emp_supervisa")
LET selec =
"SELECT '('+cast(a.num_emp as varchar(10))+')'+' '+RTRIM(a.nom1_emp)+' '+ISNULL(RTRIM(a.apell1_Emp),' ')+' '+ISNULL(RTRIM(a.apell2_Emp),' '), a.num_emp
FROM adtb00003 a
inner join adtb00004 b on a.cod_puesto = b.cod_puesto and b.supervisor = 'SI'
and a.status_t is null ORDER BY a.nom1_emp"
PREPARE comando FROM selec
DECLARE bsupervisor CURSOR FOR comando
CALL k2supervisor.clear()
FOREACH bsupervisor INTO k1supervisor, dsupervisor
CALL k2supervisor.additem(dsupervisor, k1supervisor)
END FOREACH
END FUNCTION
FUNCTION deptorelacionado()
DEFINE
pdepartamento SMALLINT,
pdescripcion CHAR(30),
kdepto ui.ComboBox
LET kdepto = ui.ComboBox.forName("formonly.departamento_relaciona")
CALL kdepto.clear()
DECLARE busca_dpto CURSOR FOR
SELECT a.departamento, a.nom_dpto
FROM adtb00001 a
WHERE a.status_t IS NULL
ORDER BY a.nom_dpto
FOREACH busca_dpto INTO pdepartamento, pdescripcion
CALL kdepto.additem(pdepartamento, pdescripcion)
END FOREACH
END FUNCTION