MBS/PROYECTO/tedir/teprmt002.4gl

{
------------------------------------------------------------------
 PROGRAMA          : TEPRMT002
 OBJETIVO          : Capturar, Modificar, Eliminar registros de la
                     Tabla de Procedencias.
 PROGRAMADOR       : Tadeo A. Ferreras
 FECHA REALIZACION : Diciembre 2, 1992. 
------------------------------------------------------------------
}
GLOBALS "teprgb000.4gl" 
DEFINE responde CHAR(200)
    MAIN
  DEFER INTERRUPT
    CALL ARG_VAL(1) RETURNING usuarios
    CALL ARG_VAL(2) RETURNING clave
 
 CALL STARTLOG("teprmt002.txt")
  
  CONNECT to "smarmotech"  USER  usuarios USING clave
  
  
  CALL teprmt002()
END MAIN

FUNCTION teprmt002() 
   CLEAR SCREEN 
   OPTIONS
        FORM LINE 9,
        ERROR LINE 23,
        MESSAGE LINE 24, 
        COMMENT LINE 21

   OPEN FORM tefmmt002 FROM "tefmmt002"
   DISPLAY FORM tefmmt002
  
#  CALL ayuda() 
   DISPLAY "teprmt002" AT 4,3 ATTRIBUTE(RED)
   DISPLAY "Mantenimiento de Procedencia" at 6,26  ATTRIBUTE(BLACK)
   
   MENU "OPCIONES"
       ON ACTION  Adicionar 
           LET INT_FLAG = FALSE
           CLEAR FORM 
           LET INT_FLAG = FALSE
           CALL tepcad002()
       ON ACTION Consultar_modificar
           LET int_flag = FALSE
           CALL tepcmf002()
       ON ACTION Salir
           EXIT MENU
     END MENU
END FUNCTION

FUNCTION tepcad002()
#  WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
 INITIALIZE procedencias.* TO NULL
  LET descrip1 = NULL
    LET descrip2 = NULL
   DIALOG ATTRIBUTES(UNBUFFERED,FIELD ORDER FORM )
    INPUT BY NAME procedencias.*
     BEFORE INPUT
        
          SELECT MAX(a.procedencia) INTO procedencias.procedencia FROM tetb00002 a
            IF procedencias.procedencia IS NULL THEN 
                LET procedencias.procedencia=0
             END IF 
                LET procedencias.procedencia=procedencias.procedencia+1

            DISPLAY BY NAME procedencias.procedencia
         # AFTER FIELD procedencia
            
             
         AFTER FIELD descripcion 
        SELECT UNIQUE descripcion INTO procedencias.descripcion
          FROM tetb00002 WHERE @procedencia = procedencias.procedencia

          IF STATUS != NOTFOUND THEN
           DISPLAY BY NAME procedencias.descripcion
           LET numero_msg = 12
           CALL msg(numero_msg)
           NEXT FIELD procedencia
          END IF
               IF procedencias.descripcion[1] = " " OR 
                  procedencias.descripcion is null THEN 
                  LET numero_msg = 16 
                  CALL msg(numero_msg) 
                  NEXT FIELD descripcion 
               END IF
        ON ACTION guardar
              BEGIN WORK 
               INSERT INTO tetb00002 VALUES (procedencias.procedencia,procedencias.descripcion,procedencias.status_t,usuarios,getdate(),NULL,null)
       
             IF status<0 THEN
                    ROLLBACK WORK
                   CALL fgl_winmessage("error","NO SE PUDO ACTUALIZAR","STOP")  
                   ELSE 
                   COMMIT WORK
                    LET numero_msg = 13 
                   CALL msg(numero_msg) 
                   RETURN 
                END IF 
  ON ACTION  CANCEL 
      LET int_flag= FALSE 
            CLEAR FORM
            EXIT DIALOG  
    END INPUT
END DIALOG 
          
END FUNCTION 

FUNCTION tepcmf002() 
   INITIALIZE b_procedencias to null
    DIALOG ATTRIBUTES(UNBUFFERED,FIELD ORDER FORM )
## Aqui se prepara para la captura del criterio de seleccion

    CONSTRUCT criterio ON a.procedencia,a.descripcion 
                     FROM procedencia1,descripcion1
        BEFORE CONSTRUCT 
        END CONSTRUCT 

ON ACTION buscar
  
    LET SELEC = " SELECT UNIQUE a.procedencia,a.descripcion FROM tetb00002 a ",
                " WHERE a.status_t IS NULL AND ",
                criterio clipped," ORDER BY a.procedencia "

    PREPARE busca FROM selec
     DECLARE datos SCROLL CURSOR WITH HOLD FOR busca
   LET idx=1
   FOREACH datos INTO b_procedencias[idx].procedencia3,b_procedencias[idx].descripcion3
    LET idx=idx+1
   END FOREACH 
     IF  idx=1 THEN
    CALL FGL_winmessage("error","NO HAY REGISTROS CON ESA CONDICION","STOP")
        CALL b_procedencias.clear()
    EXIT DIALOG 
   END IF 

    DISPLAY ARRAY b_procedencias TO tb_pro.*
       
    
    ON ACTION  actualizar 
        DIALOG ATTRIBUTES(UNBUFFERED,FIELD ORDER FORM )
        INPUT BY NAME procedencias.descripcion
            BEFORE INPUT 
                LET procedencias.procedencia=b_procedencias[arr_curr()].procedencia3
                SELECT a.procedencia,a.descripcion,a.us_crea,a.fech_crea,a.us_mod
               ,a.fech_mod INTO procedencias.procedencia,procedencias.descripcion,procedencias.us_crea,
              procedencias.fech_crea,procedencias.us_mod,procedencias.fech_mod FROM tetb00002 a
                    WHERE a.procedencia=b_procedencias[arr_curr()].procedencia3
                DISPLAY BY NAME procedencias.*
    ON ACTION guardar
     BEGIN WORK 
    DISPLAY  procedencias.descripcion
          UPDATE tetb00002 SET descripcion=procedencias.descripcion,us_mod=usuarios,fech_mod=getdate()
          WHERE @procedencia = procedencias.procedencia
            IF status<0 THEN
                    ROLLBACK WORK
                   CALL fgl_winmessage("error","NO SE PUDO ACTUALIZAR","STOP")  
                   ELSE 
                   COMMIT WORK
                    LET numero_msg = 13 
                   CALL msg(numero_msg) 
                   RETURN 
                END IF 
            END INPUT
      
             ON ACTION  CANCEL 
      LET int_flag= FALSE 
            CLEAR FORM
            EXIT DIALOG 
        END DIALOG 
   
     ON ACTION eliminar
            LET responde = fgl_winquestion("INFO","ESTA SEGURO DE ELIMINAR EL REGISTRO","NO","YES|NO","QUESTION",0)
  LET responde = UPSHIFT(responde)
    IF responde = "YES" THEN
     BEGIN WORK
            UPDATE tetb00002 SET status_t="E",us_mod=usuarios,fech_mod=getdate()
        WHERE @procedencia=b_procedencias[arr_curr()].procedencia3
        DISPLAY "aqui",procedencias.procedencia
         IF STATUS < 0 THEN
           ROLLBACK WORK
          CALL fgl_winmessage("ELIMINA", "ERROR ELIMINANDO", "stop")
          ROLLBACK WORK
          RETURN
       ELSE
          COMMIT WORK
          CALL fgl_winmessage("ELIMINA", "ELIMINACION EXITOSA", "stop")  
           RETURN  
       END IF
    END IF 
 END DISPLAY
  
    ON ACTION  CANCEL 
      LET int_flag= FALSE 
        CALL b_procedencias.CLEAR()
            CLEAR FORM
            EXIT DIALOG 
  END DIALOG 
END FUNCTION
FUNCTION msg(numero_msg)
         DEFINE numero_msg SMALLINT
         DEFINE descripcion CHAR (60)
         SELECT desc_msg INTO descripcion FROM msgtable 
                WHERE cod_msg = numero_msg

         IF status = NOTFOUND THEN 
            
            SELECT desc_msg INTO descripcion FROM msgtable 
                   WHERE cod_msg = 22
            LET descripcion = descripcion CLIPPED,numero_msg using "<<<<"
            ERROR descripcion ATTRIBUTE(BOLD) 
         ELSE 
            ERROR descripcion ATTRIBUTE(BOLD) 
            LET numero_msg = 0
         END IF
END FUNCTION