primer commit subida

PROYECTO/PRDIR/prprmt004.4gl

@@ -0,0 +1,257 @@
+{
+------------------------------------------------------------------
+ PROGRAMA          : PRPRMT004
+ OBJETIVO          : Capturar, Modificar, Eliminar registros de la
+                     Tabla de Operacion.
+ PROGRAMADOR       : Tadeo A. Ferreras F.   
+ FECHA REALIZACION : Junio 14, 1993. 
+------------------------------------------------------------------
+}
+GLOBALS "prprgb000.4gl" 
+
+FUNCTION prprmt004() 
+#   WHENEVER ERROR CONTINUE
+   CLEAR SCREEN 
+   OPTIONS
+        FORM LINE 9,
+        ERROR LINE 23,
+        COMMENT LINE 21
+
+   OPEN FORM ctfmmt005 FROM "prfmmt005"
+   DISPLAY FORM ctfmmt005
+   CALL pantalla() 
+   DISPLAY "prprmt004" AT 4,3 
+   DISPLAY "Catalogo de Operacion" AT 6,29
+   
+   MENU "OPCIONES"
+       COMMAND "Adicionar"   
+               "<Esc> Adiciona Registro    <Supr> Cancela Operacion"
+           LET int_flag = FALSE
+           CLEAR FORM 
+           CALL prpcad004()
+       COMMAND "Consultar-modificar"
+               "<Esc> Realiza Busqueda     <Supr> Cancela Operacion"
+           LET INT_FLAG = FALSE
+           CALL prpcmf004()
+       COMMAND "Salir" "Retorna Menu Anterior"
+           EXIT MENU
+     END MENU
+END FUNCTION
+
+FUNCTION prpcad004()
+ #WHENEVER ERROR CONTINUE
+## Captura los datos que va a contener el registro
+
+     LET int_flag = false
+
+   LABEL vuelve:
+   INPUT BY NAME prtb05.*
+
+         AFTER FIELD codigo
+            IF prtb05.codigo is  null then
+               LET numero_msg = 16
+               CALL msg(numero_msg)
+               NEXT FIELD codigo 
+            END IF
+
+         LET prtb05.descripcion = null
+         LET prtb05.status_t = null
+         LET prtb05.us_crea = null
+         LET prtb05.fech_crea = null
+         LET prtb05.us_mod = null
+         LET prtb05.fech_mod = null
+         DISPLAY BY NAME prtb05.*
+
+         SELECT a.* INTO prtb05.* FROM prtb00005 a
+         WHERE a.codigo = prtb05.codigo    
+
+             IF prtb05.status_t = "E" THEN
+                LET numero_msg = 36
+                CALL msg(numero_msg)
+                DISPLAY BY NAME prtb05.*
+                NEXT FIELD codigo
+             END IF
+
+             IF status != notfound THEN
+                LET numero_msg = 12
+                CALL msg(numero_msg)
+                DISPLAY BY NAME prtb05.*
+                NEXT FIELD codigo
+              END IF
+
+         AFTER FIELD descripcion
+               IF prtb05.descripcion  IS NULL THEN 
+                  LET numero_msg = 16 
+                  CALL msg(numero_msg) 
+                  NEXT FIELD descripcion 
+               END IF
+
+         AFTER INPUT 
+
+         IF int_flag THEN
+            LET numero_msg = 2 
+            CALL msg(numero_msg) 
+            LET int_flag = FALSE
+            RETURN 
+         END IF 
+
+            IF prtb05.codigo is  null then
+               LET numero_msg = 16
+               CALL msg(numero_msg)
+                NEXT FIELD codigo 
+            END IF
+
+         SELECT a.* INTO prtb05.* FROM prtb00005 a
+         WHERE a.codigo = prtb05.codigo    
+
+             IF prtb05.status_t = "E" THEN
+                LET numero_msg = 36
+                CALL msg(numero_msg)
+                DISPLAY BY NAME prtb05.*
+                NEXT FIELD codigo
+             END IF
+             IF status != notfound THEN
+                LET numero_msg = 3
+                CALL msg(numero_msg)
+                DISPLAY BY NAME prtb05.*
+                NEXT FIELD codigo
+              END IF
+
+           EXIT INPUT
+         END INPUT
+       
+         INSERT INTO prtb00005 VALUES
+                (prtb05.codigo,prtb05.descripcion,
+                 null,user,current,null,null)
+
+                  LET numero_msg = 1
+                  CALL msg(numero_msg)
+                  GOTO vuelve
+END FUNCTION 
+
+FUNCTION prpcmf004() 
+#WHENEVER ERROR CONTINUE
+ LET int_flag = false
+## Aqui se prepara para la captura del criterio de seleccion
+ 
+    CONSTRUCT criterio ON prtb00005.*   FROM prtb00005.*
+
+    IF int_flag THEN   
+       LET numero_msg = 2 
+       CALL msg(numero_msg) 
+       LET int_flag = FALSE
+       RETURN
+    END IF
+
+    LET SELEC = " SELECT UNIQUE * FROM prtb00005 ",
+                " WHERE status_t is null and ",
+                  criterio clipped," ORDER BY 1"
+
+    PREPARE busca FROM selec
+    DECLARE datos SCROLL CURSOR  FOR busca
+    OPEN datos 
+
+       FETCH FIRST datos INTO prtb05.*
+                IF STATUS = NOTFOUND THEN
+                   LET numero_msg = 3 
+                   CALL msg(numero_msg) 
+                   RETURN
+                END IF
+
+    DISPLAY BY NAME prtb05.*
+
+    MENU "OPCIONES "
+    COMMAND "Siguiente"
+            "Presenta en pantalla el proximo registro encontrado"
+            FETCH NEXT datos INTO prtb05.*
+            IF STATUS = NOTFOUND THEN
+               LET numero_msg = 4 
+               CALL msg(numero_msg) 
+            END IF
+            DISPLAY BY NAME prtb05.*
+
+    COMMAND "Anterior"
+            "Presenta en pantalla el registro anterior encontrado"
+            FETCH PREVIOUS datos INTO prtb05.*
+            IF STATUS = NOTFOUND THEN
+               LET numero_msg = 5 
+               CALL msg(numero_msg) 
+            END IF
+            DISPLAY BY NAME prtb05.*
+
+    COMMAND "Primero"
+            "Presenta en pantalla el primer registro encontrado"
+            FETCH FIRST datos INTO prtb05.*
+            DISPLAY BY NAME prtb05.*
+            LET numero_msg = 5 
+            CALL msg(numero_msg) 
+     COMMAND "Ultimo"
+            "Presenta en pantalla el ultimo registro encontrado"
+             FETCH LAST datos INTO prtb05.*
+             DISPLAY BY NAME prtb05.*
+             LET numero_msg = 4 
+             CALL msg(numero_msg) 
+     COMMAND "Escoger"
+             "<Esc> Actualiza Registro    <Supr> Cancela Operacion"
+                 IF prtb05.status_t="E" THEN 
+                    LET numero_msg= 36 
+                    CALL msg(numero_msg)
+                  RETURN
+                 END IF 
+             INPUT BY NAME prtb05.descripcion WITHOUT DEFAULTS
+       
+             AFTER FIELD descripcion
+                   IF prtb05.descripcion IS NULL THEN 
+                      LET numero_msg = 16 
+                      CALL msg(numero_msg) 
+                      NEXT FIELD descripcion 
+                   END IF
+
+    AFTER INPUT
+                    IF int_flag THEN
+                     LET numero_msg = 2
+                     CALL msg(numero_msg)
+                     LET int_flag = false
+                     RETURN
+                    END IF
+
+                IF prtb05.descripcion IS NULL THEN 
+                   LET numero_msg = 16 
+                   CALL msg(numero_msg) 
+                   NEXT FIELD descripcion 
+                END IF
+        EXIT INPUT
+     END INPUT
+
+  #### Verifica si el usuario presiono la tecla <Supr>   
+
+      IF int_flag THEN
+         LET numero_msg = 2 
+         CALL msg(numero_msg) 
+         LET int_flag = FALSE
+         RETURN
+      END IF
+
+         UPDATE prtb00005 SET descripcion  = prtb05.descripcion,
+                              us_mod       = USER, 
+                              fech_mod     = CURRENT 
+         WHERE @codigo  = prtb05.codigo  
+
+      LET numero_msg = 13 
+      CALL msg(numero_msg) 
+
+    COMMAND KEY ("L") "eLiminar"
+
+         UPDATE prtb00005 SET status_t ="E" ,
+                              us_mod = user,
+                              fech_mod = current
+         WHERE @codigo = prtb05.codigo 
+
+     LET numero_msg = 39
+     CALL msg(numero_msg)
+    COMMAND "Retornar" 
+            "Retorna al menu anterior" 
+            EXIT MENU
+  END MENU
+END FUNCTION
+