{ ------------------------------------------------------------------ PROGRAMA : ADPRMT005 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla de Pericias PROGRAMADOR : Ing. Betania Guerrero Perez FECHA REALIZACION : Mayo 20, 1993 ------------------------------------------------------------------ } GLOBALS "adprgb000.4gl" MAIN DEFER INTERRUPT CALL ARG_VAL(1) RETURNING usuarios CALL ARG_VAL(2) RETURNING clave CALL ARG_VAL(3) RETURNING impresor CONNECT to "smarmotech" USER usuarios USING clave SELECT a.* INTO p_companias.* FROM companias a CALL adprmt005() END MAIN FUNCTION adprmt005() CLEAR SCREEN OPTIONS FORM LINE 9, ERROR LINE 23, COMMENT LINE 21 OPEN FORM adfmmt005 FROM "adfmmt005" DISPLAY FORM adfmmt005 DISPLAY "adprmt005" AT 4,3 ATTRIBUTE(RED) DISPLAY "Pericias" AT 6,39 ATTRIBUTE(BLACK) MENU ON ACTION nuevo let int_flag = false INITIALIZE emplea.* TO NULL CALL adpcad005() ON ACTION buscar let int_flag = false CALL adpcmf005() ON ACTION Salir EXIT MENU END MENU END FUNCTION FUNCTION adpcad005() {WHENEVER ERROR CONTINUE} ## CAPTURA LOS DATOS QUE VA A CONTENER EL REGISTRO INPUT BY NAME pericia.* ## VERIFICA QUE EL CODIGO NO EXISTA EN EL CATALOGO DE PERICIAS. SI EXISTE, ## ENTONCES DESPLIEGA LOS DATOS DEL REGISTRO EXISTENTE. BEFORE FIELD cod_pericia NEXT FIELD nom_pericia AFTER FIELD nom_pericia IF pericia.nom_pericia IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD nom_pericia END IF AFTER INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF ## SI NO OCURRER NINGUN ERROR SE PROCEDE A INSERTAR EL REGISTRO IF pericia.nom_pericia IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD nom_pericia ELSE SELECT MAX(a.cod_pericia) INTO pericia.cod_pericia FROM adtb00006 a IF pericia.cod_pericia IS NULL THEN LET pericia.cod_pericia=0 END IF LET pericia.cod_pericia=pericia.cod_pericia+1 INSERT INTO adtb00006 VALUES (pericia.cod_pericia,pericia.nom_pericia, null, SUSER_SNAME (), GETDATE(), null, null) LET numero_msg = 1 CALL msg(numero_msg) CLEAR FORM LET pericia.cod_pericia = NULL LET pericia.nom_pericia = NULL NEXT FIELD cod_pericia END IF AFTER FIELD fech_mod EXIT INPUT END INPUT END FUNCTION FUNCTION adpcmf005() ## AQUI SE PREPARA PARA LA CAPTURA DEL CRITERIO DE SELECCION PARA LA ## MODIFICACION DE REGISTROS. {WHENEVER ERROR CONTINUE} CONSTRUCT criterio ON adtb00006.* FROM adtb00006.* IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF LET SELEC = " SELECT UNIQUE * FROM adtb00006 where ", " status_t is null and ", criterio clipped, " ORDER BY 1" PREPARE busca FROM selec IF bandera = 1 THEN CLEAR SCREEN RETURN END IF DECLARE dato SCROLL CURSOR FOR busca OPEN dato FETCH FIRST dato INTO pericia.* 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 DISPLAY BY NAME pericia.* MENU "OPCIONES " COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT dato INTO pericia.* IF STATUS = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF DISPLAY BY NAME pericia.* COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado" FETCH PREVIOUS dato INTO pericia.* IF STATUS = NOTFOUND THEN LET numero_msg = 5 CALL msg(numero_msg) END IF DISPLAY BY NAME pericia.* COMMAND "Primero" "Presenta en pantalla el primer registro encontrado" FETCH FIRST dato INTO pericia.* DISPLAY BY NAME pericia.* LET numero_msg = 5 CALL msg(numero_msg) COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado" FETCH LAST dato INTO pericia.* DISPLAY BY NAME pericia.* LET numero_msg = 4 CALL msg(numero_msg) COMMAND "Escoger" " Actualiza Registro Cancela Operacion" IF pericia.status_t = "E" THEN LET numero_msg = 39 CALL msg(numero_msg) RETURN END IF ## SE SELECCIONAN LOS CAMPOS MODIFICABLES INPUT BY NAME pericia.nom_pericia, pericia.us_crea, pericia.fech_crea, pericia.us_mod, pericia.fech_mod WITHOUT DEFAULTS AFTER FIELD nom_pericia IF pericia.nom_pericia IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD nom_pericia 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 IF bandera = 1 THEN CLEAR SCREEN RETURN END IF ## AQUI SE ACTUALIZAN LOS REGISTROS UPDATE adtb00006 SET nom_pericia = pericia.nom_pericia, us_mod = SUSER_SNAME (), fech_mod = GETDATE() WHERE cod_pericia = pericia.cod_pericia LET numero_msg = 13 CALL msg(numero_msg) EXIT INPUT END INPUT ## AQUI SE ELIMINAN LOS REGISTROS COMMAND KEY ("L") "eLiminar" UPDATE adtb00006 SET status_t = "E" WHERE cod_pericia = pericia.cod_pericia LET numero_msg = 39 CALL msg(numero_msg) COMMAND "Retornar" "Retorna al menu anterior" CLEAR FORM EXIT MENU END MENU END FUNCTION