MBS/PROYECTO/codir/coprcs001.4gl

{
-------------------------------------------------------------------------------
PROGRAMA           :  COPRCS001
OBJETIVO           :  Consulta Relacion Bienes y Servicios - Suplidor
PROGRAMADOR        :  Ing. Juan Fco. Soto         
FECHA REALIZACION  :  Agosto 1997
DIRECTOR PROYECTO  :  JOSE ALFREDO PAULINO
-------------------------------------------------------------------------------
}
GLOBALS "coprgb000.4gl"

  DEFINE base1 DECIMAL(10,2)
  DEFINE primero RECORD
      cod_n       LIKE intb00001.cod_n,
      cod_grupo   LIKE intb00001.cod_grupo,
      cod_tipo    LIKE intb00001.cod_tipo,
      cod_sec     LIKE intb00001.cod_sec,
      descrip_esp LIKE intb00001.descrip_esp,
      unidad_med  LIKE intb00001.unidad_med
  END RECORD

  DEFINE idx_n SMALLINT

FUNCTION coprcs001()
#WHENEVER ERROR CONTINUE
   CLEAR SCREEN
   OPTIONS

        FORM LINE 8,
        ERROR LINE 23,
        COMMENT LINE 21

   OPEN FORM cofmcs001 FROM "cofmcs001"
   DISPLAY FORM cofmcs001
   CALL PANTALLA()
   DISPLAY "<Esc> Consulta de Registro" AT 2,3
   DISPLAY "<Delete> Cancela Operacion" AT 2,50
   DISPLAY "coprcs001" AT 4,3
   DISPLAY "Bienes y Servicios - Suplidor" AT 6,25

 LABEL vuelve:
    CLEAR FORM
   CONSTRUCT criterio ON d.cod_n,d.cod_grupo,d.cod_tipo,d.cod_sec
                      FROM cod_n,cod_grupo,cod_tipo,cod_sec

    IF int_flag THEN
       LET numero_msg = 2
       CALL msg(numero_msg)
       LET int_flag = FALSE
       CLEAR FORM
       RETURN
    END IF

LET SELEC = 
  "SELECT d.cod_n,d.cod_grupo,d.cod_tipo,d.cod_sec,d.descrip_esp,d.unidad_med ",
  "FROM intb00001 d ",
  "WHERE d.status_t is null AND ",criterio clipped," ORDER BY 1,2,3,4 "

   DISPLAY "Buscando Informacion... Espere Por Favor" AT 21,2 
         ATTRIBUTE (YELLOW)

   PREPARE busca FROM selec
   DECLARE accion SCROLL CURSOR FOR busca
   OPEN accion
   DISPLAY "                                         " AT 21,2

   LET idx = 1
   FETCH FIRST accion INTO primero.*
       IF STATUS = NOTFOUND THEN
          LET numero_msg = 3
          CALL msg(numero_msg)
          GOTO vuelve
       END IF
   DISPLAY BY NAME primero.cod_n,primero.cod_grupo,primero.cod_tipo,
                   primero.cod_sec,primero.descrip_esp,primero.unidad_med

   MENU "OPCION"
      COMMAND "Siguiente"
       "Presenta en pantalla el registro Siguiente encontrado"
       LET idx = 1
       FETCH NEXT accion INTO primero.*
             IF STATUS = NOTFOUND THEN
                LET numero_msg = 4
                CALL msg(numero_msg)
             END IF
   DISPLAY BY NAME primero.cod_n,primero.cod_grupo,primero.cod_tipo,
                   primero.cod_sec,primero.descrip_esp,primero.unidad_med

       COMMAND "Anterior"
        "Presenta en pantalla el registro Anterior encontrado"
        LET idx = 1
        FETCH PREVIOUS accion INTO primero.*
              IF STATUS = NOTFOUND THEN
                 LET numero_msg = 5
                 CALL msg(numero_msg)
              END IF
   DISPLAY BY NAME primero.cod_n,primero.cod_grupo,primero.cod_tipo,
                   primero.cod_sec,primero.descrip_esp,primero.unidad_med

        COMMAND "Primero"
         "Presenta en pantalla el Primer registro encontrado"
        LET idx = 1
        FETCH FIRST accion INTO primero.*
              IF STATUS = NOTFOUND THEN
                 LET numero_msg = 5
                 CALL msg(numero_msg)
              END IF
   DISPLAY BY NAME primero.cod_n,primero.cod_grupo,primero.cod_tipo,
                   primero.cod_sec,primero.descrip_esp,primero.unidad_med

        COMMAND "Ultimo"
         "Presenta en pantalla el Ultimo registro encontrado"
        LET idx = 1
        FETCH LAST accion INTO primero.*
              IF STATUS = NOTFOUND THEN
                 LET numero_msg = 4
                 CALL msg(numero_msg)
              END IF
   DISPLAY BY NAME primero.cod_n,primero.cod_grupo,primero.cod_tipo,
                   primero.cod_sec,primero.descrip_esp,primero.unidad_med

        COMMAND "Ver"
                "Para ver los suplidores de este material"
   DISPLAY "Buscando Informacion... Espere Por Favor" AT 21,2 ATTRIBUTE (BOLD)
                 CALL arreglo()

        COMMAND "Retornar"
            EXIT  MENU
        END MENU
        GOTO vuelve
END FUNCTION
         
FUNCTION arreglo()
DECLARE accion1 CURSOR FOR
SELECT a.cod_sp,a.cod_sp_sec,c.descrip_term,MAX(b.precio),
       a.nom_sp,MAX(b.fech_crea)
FROM cotb00001 a,cotb00024 c,cotb00114 e,cotb00015 b
WHERE  e.cod_sp = a.cod_sp and e.cod_sp_sec  = a.cod_sp_sec and
       e.num_oc   = b.num_oc and e.tipo        = b.tipo and
       b.cod_n    = primero.cod_n AND b.cod_grupo = primero.cod_grupo AND
       b.cod_tipo = primero.cod_tipo AND b.cod_sec= primero.cod_sec AND
       a.term_sp  = c.term_sp AND a.status_t is null
       GROUP BY 1,2,3,5 ORDER BY 1,2

   LET idx_n = 1
   FOREACH accion1 INTO mps[idx_n].*
      IF STATUS = NOTFOUND THEN
         LET numero_msg = 3
         CALL msg(numero_msg)
         SLEEP 2
         EXIT FOREACH
      END IF

      CALL integridad()
         IF bandera = 1 THEN
           LET bandera = 0
           RETURN
       END IF 

       SELECT base INTO base1 FROM intb00002
       WHERE cod_n = primero.cod_n and cod_grupo = primero.cod_grupo and
             cod_tipo  = primero.cod_tipo and cod_sec = primero.cod_sec

       IF base1 > 0 THEN
          LET mps[idx_n].precio = mps[idx_n].precio/base1
       END IF

      LET idx_n = idx_n + 1
   END FOREACH

   DISPLAY "                                        " AT 21,2 

   #IF idx_n = 1 and mps[idx - 1].cod_sp is null THEN

    IF idx_n = 1 THEN
      LET numero_msg = 3
      CALL msg(numero_msg)
      RETURN
    END IF


   CALL set_count (idx_n - 1)

   DISPLAY BY NAME primero.cod_n,primero.cod_grupo,primero.cod_tipo,
                   primero.cod_sec,primero.descrip_esp,primero.unidad_med

   DISPLAY ARRAY mps TO consart.*

      IF int_flag THEN
         LET numero_msg = 2
         CALL msg(numero_msg)
         LET int_flag = FALSE
         CLEAR FORM
         RETURN
      END IF

      CLEAR FORM

END FUNCTION