Files
2026-09-22 20:38:51 -04:00

419 lines
15 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
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 "decomarmol" 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.*
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
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 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
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
INSERT INTO adtb00001
(departamento
,nom_dpto
,us_crea
,fech_crea
,tipo_departamento
,departamento_out
,app_movil
,num_emp_supervisa
,coordinadora)
VALUES (depto.departamento,depto.nom_dpto,
usuarios,GETDATE(), depto.tipo_departamento,
depto.departamento_out,depto.app_movil,depto.num_emp_supervisa, depto.coordinadora)
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
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()
DISPLAY BY NAME depto.*
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()
DISPLAY BY NAME depto.*
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()
DISPLAY BY NAME depto.*
DISPLAY ARRAY arr_relacionados TO srelacionados.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST dato INTO depto.*
DISPLAY BY NAME depto.*
LET numero_msg = 5
CALL msg(numero_msg)
CALL departamentosRelacionados()
DISPLAY ARRAY arr_relacionados TO srelacionados.*
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST dato INTO depto.*
DISPLAY BY NAME depto.*
LET numero_msg = 4
CALL msg(numero_msg)
CALL departamentosRelacionados()
DISPLAY ARRAY arr_relacionados TO srelacionados.*
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
## SE SELECCIONAN LOS CAMPOS QUE SON MODIFICABLES
DIALOG ATTRIBUTES(UNBUFFERED)
INPUT BY NAME depto.nom_dpto,
depto.tipo_departamento,
depto.app_movil,
depto.departamento_out,
depto.num_emp_supervisa,
depto.coordinadora 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
#### Verifica si el usuario presiono la tecla <Ctrl-C>
AFTER INPUT
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
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
# DEPARTAMENTOS RELACIONADOS
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"
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