{ ------------------------------------------------------------------ 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) MAIN DEFER INTERRUPT CALL ARG_VAL(1) RETURNING usuarios CALL ARG_VAL(2) RETURNING clave CONNECT TO "marmotech" AS "IFMX" 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 ## CAPTURA LOS DATOS QUE VA A CONTENER EL REGISTRO INPUT BY NAME depto.* ## 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 int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF IF depto.tipo_departamento IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD tipo_departamento END IF ## 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 INSERT INTO adtb00001 VALUES (depto.departamento,depto.nom_dpto, null, suser_sname(),GETDATE(), null, null,depto.tipo_departamento,depto.departamento_out) INSERT INTO chequeo VALUES (parte,depto.departamento,depto.nom_dpto) 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 AFTER FIELD fech_mod EXIT INPUT END INPUT END FUNCTION FUNCTION nopcmf023() ## AQUI SE PREPARA PARA LA CAPTURA DEL CRITERIO DE SELECCION PARA LA ## MODIFICACION DE REGISTROS #WHENEVER ERROR CONTINUE CONSTRUCT criterio ON a.departamento,a.nom_dpto FROM departamento,nom_dpto IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF 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 DISPLAY BY NAME depto.* MENU "OPCIONES " COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT dato INTO depto.* IF STATUS = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF DISPLAY BY NAME depto.* 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 DISPLAY BY NAME depto.* 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) 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) COMMAND "Escoger" " Actualiza Registro Cancela Operacion" IF depto.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 depto.nom_dpto, depto.tipo_departamento, depto.departamento_out, depto.us_crea, depto.fech_crea, depto.us_mod, depto.fech_mod WITHOUT DEFAULTS 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 AFTER INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE CLEAR FORM RETURN END IF CALL integridad() IF bandera = 1 THEN CLEAR SCREEN RETURN END IF ## 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 = suser_sname(), fech_mod = GETDATE() WHERE departamento = depto.departamento UPDATE chequeo SET nom_dpto = depto.nom_dpto WHERE departamento = depto.departamento 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) EXIT INPUT END INPUT EXIT MENU ## 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