{
-------------------------------------------------------------------------------
PROGRAMA             :  COPRRP003
OBJETIVO             :  Relacion Suplidor - Ordenes de Compra
PROGRAMADOR          :  JUAN SOTO                  
FECHA REALIZACION    :  AGOSTO 1997     
DIRECTOR PROYECTO    :  JOSE ALFREDO PAULINO ALEJO
-------------------------------------------------------------------------------
}
GLOBALS "coprgb000.4gl"

FUNCTION coprrp003()

    DEFINE select_fech,select_movi,select_ent CHAR(1000)
    DEFINE idx_o,idx_e,idx_p,idx_m SMALLINT
    DEFINE esta,encontre,salir2,salir1,salir CHAR(1)
    DEFINE recibida,pendiente DECIMAL(12,2)

    DEFINE movi_t RECORD
          num_oc      INTEGER,
          cod_n       SMALLINT,
          cod_grupo   SMALLINT,
          cod_tipo    SMALLINT,
          cod_sec     SMALLINT,
          cantidad    DECIMAL(12,2)
     END RECORD

    DEFINE entregas RECORD
          num_oc      INTEGER,
          tipo        LIKE cotb00014.tipo,
          cod_n       SMALLINT,
          cod_grupo   SMALLINT,
          cod_tipo    SMALLINT,
          cod_sec     SMALLINT,
          cantidad    DECIMAL(12,2),
          precio      LIKE cotb00015.precio,
          fecha       DATE
     END RECORD

    DEFINE supliorden RECORD
           num_oc        LIKE cotb00014.num_oc,
           tipo          LIKE cotb00014.tipo,
           fech_oc       LIKE cotb00014.fech_oc,
           cod_sp        LIKE cotb00001.cod_sp,
           cod_sp_sec    LIKE cotb00001.cod_sp_sec,
           nom_sp        LIKE cotb00001.nom_sp,
           cantidad      LIKE cotb00015.cantidad,
           cantidad_2    LIKE iptb00006.cantidad_2,
           remanente     LIKE iptb00006.cantidad_2,
           precio        LIKE cotb00015.precio,
           c_flete       LIKE cotb00014.c_flete,
           otros_g       LIKE cotb00014.otros_g,
           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 ordenes RECORD
        num_oc      INTEGER,
        tipo        LIKE cotb00014.tipo,
        fech_oc     DATE,
        cod_sp      SMALLINT,
        cod_sp_sec  SMALLINT,
        nom_sp      CHAR(30),
        c_flete     DECIMAL(12,2),
        otros_g     DECIMAL(12,2),
        cierre      CHAR(1)
    END RECORD

    DEFINE materiales RECORD
        cod_n       SMALLINT,
        cod_grupo   SMALLINT,
        cod_tipo    SMALLINT,
        cod_sec     SMALLINT,
        descrip_esp CHAR(30),
        unidad_med  CHAR(3)
    END RECORD

    DEFINE fechas RECORD
           num_oc INTEGER,    
           fecha  DATE
    END RECORD

#   WHENEVER ERROR CONTINUE

    OPTIONS
       FORM LINE 8,
       ERROR LINE 23,
       COMMENT LINE 21

    OPEN FORM cofmrp003 FROM "cofmrp003"
    DISPLAY FORM cofmrp003

    CALL pantalla()
    DISPLAY "coprrp003" AT 4,3 ATTRIBUTE(YELLOW)
    DISPLAY "Ordenes de Compras" AT 6,31

    LET tipo_papel = 1
    CALL msgrp000(tipo_papel)

   INPUT BY NAME clasifica
  
      IF int_flag THEN
        LET numero_msg = 2
        CALL msg(numero_msg)
        LET int_flag = false
        RETURN
       END IF

  INPUT BY NAME rango.*
    BEFORE FIELD fech_fi 
      LET rango.fech_fi = TODAY
      DISPLAY BY NAME rango.fech_fi

    AFTER FIELD fech_in
      IF rango.fech_in is null THEN
         LET numero_msg = 16
         CALL msg(numero_msg)
         NEXT FIELD fech_in
      END IF
    
    AFTER FIELD fech_fi
      IF rango.fech_fi is null THEN
         LET numero_msg = 16
         CALL msg(numero_msg)
         NEXT FIELD fech_fi
      END IF

     AFTER INPUT 
      IF int_flag THEN
        LET numero_msg = 2
        CALL msg(numero_msg)
        LET int_flag = false
        RETURN
       END IF
     EXIT INPUT
   END INPUT

    CONSTRUCT criterio ON a.tipo,a.num_oc,a.cod_n,a.cod_grupo,a.cod_tipo,
                          a.cod_sec
                     FROM tipo,num_oc,cod_n,cod_grupo,cod_tipo,cod_sec

      IF int_flag THEN
        LET numero_msg = 2
        CALL msg(numero_msg)
        LET int_flag = false
        RETURN
       END IF

# Busca Las Ordenes de Compras

  IF clasifica = "P" THEN
  LET select_ent = 
   "SELECT a.num_oc,a.tipo,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
   "       a.cantidad,a.precio ",
   "FROM cotb00015 a,cotb00014 c ",
   "WHERE a.status_t is null and ",
   "      c.num_oc    = a.num_oc and c.fech_oc   between ? and ? and ",
   "      c.cierre = 'N' and ",
   criterio clipped," GROUP BY 1,2,3,4,5,6,7,8 ORDER BY 3,4,5,6,1"
   ELSE
  LET select_ent = 
   "SELECT a.num_oc,a.tipo,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
   "       a.cantidad,a.precio ",
   "FROM cotb00015 a,cotb00014 c ",
   "WHERE a.status_t is null and ",
   "      c.num_oc    = a.num_oc and c.fech_oc   between ? and ?  ",
   " GROUP BY 1,2,3,4,5,6,7,8 ORDER BY 3,4,5,6,1"
   END IF
   DISPLAY "<< Estoy Buscando Las Cantidades Ordenadas         >>"
         AT 19,14 ATTRIBUTE (REVERSE,BOLD)

   PREPARE busca_entrega FROM select_ent
   DECLARE ent_curs SCROLL CURSOR FOR busca_entrega
   OPEN ent_curs USING rango.fech_in,rango.fech_fi

# Busca Los Movimientos de los materiales               

 LET select_movi = 
    "SELECT a.orden_compra,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
    "       sum(a.cantidad_2) ",
    "FROM iptb00006 a ",
    "WHERE a.status_t is null and a.orden_compra is not null and ",
    "      a.cantidad_2 > 0  ",
    "GROUP BY 1,2,3,4,5 ORDER BY 2,3,4,5,1"

   DISPLAY "                                                     "
         AT 19,14
   DISPLAY "<< Estoy Buscando Los movimientos de las Ordenes   >>"
         AT 19,14 ATTRIBUTE(REVERSE,BOLD)

   PREPARE busca_movi    FROM select_movi
   DECLARE movi_curs SCROLL CURSOR FOR busca_movi    
   OPEN movi_curs 

# Busca Las descripcion de los Materiales

    LET SELEC4 = 
    "SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp, ",
    "       a.unidad_med ",
    "FROM intb00001 a, iptb00002 b ",
    "WHERE a.cod_n = b.cod_n AND a.cod_grupo = b.cod_grupo AND ",
    "      a.cod_tipo = b.cod_tipo AND a.cod_sec   = b.cod_sec AND ",
    "      a.status_t is null ORDER BY 1,2,3,4"

   DISPLAY "<< Estoy Buscando Los Materiales Con Su Descripcion >>"
         AT 19,14 ATTRIBUTE (REVERSE,BOLD)

    PREPARE busca3 FROM selec4
    DECLARE accion3 SCROLL CURSOR FOR busca3
    OPEN accion3

    START REPORT ordenar TO "C:\\archivo"

    DISPLAY "                                                " AT 19,14
    DISPLAY "<< Reporte Generandose ...  Por Favor Espere. >>"
            AT 19,14 ATTRIBUTE (REVERSE) 

   LET idx_e = 1
   LET idx_m = 1
   LET idx_p = 1
   LET salir1 = "N"

#  Loop Para los materiales con su descripcion

   WHILE salir1 != "S"      
       FETCH ABSOLUTE idx_p accion3 INTO materiales.* 

           IF STATUS = NOTFOUND THEN
              LET salir1 = "S"
              EXIT WHILE
           END IF

       IF int_flag THEN
          LET numero_msg = 2
          CALL msg(numero_msg)
          LET int_flag = false
          FINISH REPORT ordenar
          RETURN
       END IF

     LET idx_p = idx_p + 1
     LET supliorden.cod_n = materiales.cod_n
     LET supliorden.cod_grupo = materiales.cod_grupo
     LET supliorden.cod_tipo = materiales.cod_tipo
     LET supliorden.cod_sec = materiales.cod_sec
     LET supliorden.descrip_esp = materiales.descrip_esp
     LET supliorden.unidad_med = materiales.unidad_med
     LET supliorden.num_oc = null           
     LET supliorden.tipo   = null
     LET supliorden.cantidad = null
     LET supliorden.cantidad_2 = null
     LET supliorden.remanente = null
     LET recibida = 0

     LET esta = "N"
     LET salir2= "N"

# Loop para cantidades de la orden     

     WHILE salir2 != "S"
         FETCH ABSOLUTE idx_m ent_curs INTO entregas.*  
             IF STATUS = NOTFOUND THEN
                LET idx_m = 1
                EXIT WHILE
             END IF

             LET idx_m = idx_m + 1

             IF materiales.cod_n     = entregas.cod_n AND
                materiales.cod_grupo = entregas.cod_grupo AND
                materiales.cod_tipo  = entregas.cod_tipo AND
                materiales.cod_sec   = entregas.cod_sec  THEN

                        LET pendiente = entregas.cantidad
                        LET supliorden.cantidad = entregas.cantidad
                        LET supliorden.precio = entregas.precio
                        LET recibida = 0
                        LET esta = "S"

                 LET encontre = "N"
                 LET salir = "N"

# Loop para movimientos de ordenes de compras 
                LET supliorden.cantidad_2 = 0
                WHILE salir != "S"
                FETCH ABSOLUTE idx_e movi_curs INTO movi_t.*

                  IF status = notfound THEN
                   LET salir = "S"
                   LET idx_e = 1
                   EXIT WHILE
                 END IF
                LET idx_e = idx_e + 1

             IF movi_t.cod_n     = entregas.cod_n AND
                movi_t.cod_grupo = entregas.cod_grupo AND
                movi_t.cod_tipo  = entregas.cod_tipo AND
                movi_t.cod_sec   = entregas.cod_sec  AND 
                movi_t.num_oc    = entregas.num_oc THEN

                  LET pendiente = pendiente - movi_t.cantidad
                  LET recibida = recibida + movi_t.cantidad
                  LET encontre = "S"
                LET salir = "S"
                #LET idx_e = 1
                     EXIT WHILE     
            END IF
     END WHILE

      IF clasifica = "T" THEN
        LET supliorden.num_oc = entregas.num_oc
        LET supliorden.tipo   = entregas.tipo
        LET supliorden.cantidad_2 = recibida 
        LET supliorden.remanente = recibida - supliorden.cantidad
     END IF

      IF clasifica = "P" THEN
       IF pendiente >  0 THEN
        LET supliorden.num_oc = entregas.num_oc
        LET supliorden.tipo   = entregas.tipo
        LET supliorden.cantidad_2 = recibida 
        LET supliorden.remanente = pendiente
      END IF
     END IF

      SELECT c.num_oc,c.tipo,c.fech_oc, 
                  e.cod_sp,e.cod_sp_sec,e.nom_sp,
                  c.c_flete,c.otros_g,c.cierre
         INTO ordenes.*
           FROM cotb00001 e,cotb00014 c 
                  WHERE c.num_oc = supliorden.num_oc AND
                   c.tipo = supliorden.tipo AND 
                   e.cod_sp     = c.cod_sp AND 
                   e.cod_sp_sec = c.cod_sp_sec AND 
                   c.status_t is null 

         LET supliorden.fech_oc = ordenes.fech_oc
         LET supliorden.cod_sp = ordenes.cod_sp
         LET supliorden.cod_sp_sec = ordenes.cod_sp_sec
         LET supliorden.nom_sp  = ordenes.nom_sp
         LET supliorden.c_flete = ordenes.c_flete
         LET supliorden.otros_g = ordenes.otros_g

     IF clasifica = "C" THEN
         LET supliorden.cantidad = null
      END IF

   IF ordenes.cierre = "S" THEN
      IF clasifica = "C" THEN
        LET supliorden.num_oc = ordenes.num_oc
        LET supliorden.tipo   = ordenes.tipo
        LET supliorden.cantidad = entregas.cantidad
        LET supliorden.cantidad_2 = recibida 
        LET supliorden.remanente = pendiente
     END IF
   END IF

   IF supliorden.cantidad is not null THEN

      OUTPUT TO REPORT ordenar(supliorden.*)
       #display "                                                  " at 24,1
    END IF
   ELSE
  IF esta = "S" THEN
    EXIT WHILE
  END IF
 END IF

     END WHILE
   END WHILE

   FINISH REPORT ordenar
   CLEAR SCREEN
RUN "type C:\\archivo > %USPRINT%" END FUNCTION

    REPORT ordenar(x)
       DEFINE x RECORD
          num_oc        LIKE cotb00014.num_oc,
          tipo          LIKE cotb00014.tipo,
          fech_oc       LIKE cotb00014.fech_oc,
          cod_sp        LIKE cotb00001.cod_sp,
          cod_sp_sec    LIKE cotb00001.cod_sp_sec,
          nom_sp        LIKE cotb00001.nom_sp,
          cantidad      LIKE cotb00015.cantidad,
          cantidad_2    LIKE iptb00006.cantidad_2,
          remanente     LIKE iptb00006.cantidad_2,
          precio        LIKE cotb00015.precio,
          c_flete       LIKE cotb00014.c_flete,
          otros_g       LIKE cotb00014.otros_g,
          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 bandera,bandera1 CHAR(1)
    DEFINE descrip CHAR(10)
    DEFINE moneda CHAR(2)
    DEFINE varia CHAR(12)
    DEFINE cantidad DECIMAL(12,3)
    DEFINE P2 DECIMAL(12,3)
    DEFINE monto2,monto DECIMAL(14,3)
    DEFINE b_oc,b_suplidor,imp CHAR(1)
    DEFINE l SMALLINT
    DEFINE doc_ant INTEGER
    DEFINE doble_on CHAR(2)
    DEFINE doble_off CHAR(2)
    DEFINE negrillas_on CHAR(2)
    DEFINE negrillas_off CHAR(2)
    DEFINE comp_on CHAR(2)
    DEFINE comp_off CHAR(2) 
    DEFINE doce CHAR(2)
    DEFINE normal CHAR(2) 
    DEFINE hora CHAR(5)
    OUTPUT
     TOP MARGIN 0
      LEFT MARGIN 0
      BOTTOM MARGIN 2
    FORMAT
      PAGE HEADER
        LET doble_on =  ASCII 14
        LET doble_off = ASCII 20
        LET negrillas_on = ASCII 27, ASCII 69
        LET negrillas_off = ASCII 27, ASCII 70
        LET comp_on = ASCII 15
        LET comp_off = ASCII 18
        LET imp = "T"
        LET doce = ASCII 27, ASCII 77  
        LET normal = ASCII 27, ASCII 80
        LET hora = time
              IF clasifica = "P" THEN
                  LET varia = "*Pendientes*"
               END IF
            IF clasifica = "C" THEN
                  LET varia = "*Cerradas*"
               END IF
             IF clasifica = "T" THEN
                  LET varia = "*Todas*"
            END IF 

           LET l = (141 - LENGTH(p_companias.nombre CLIPPED))/2
           PRINT COLUMN   3, comp_on,negrillas_on
           PRINT COLUMN   1, "coprrp003",
                 COLUMN   l, p_companias.nombre CLIPPED,
                 COLUMN 134, "Pag. ",pageno using "###"
           PRINT COLUMN  61, "Sistema de Compras",
                 COLUMN 134, today using "dd/mm/yy"
           PRINT COLUMN  61, "Ordenes de Compras",
                 COLUMN 137, hora
           LET l = (141 - LENGTH(varia))/2
           PRINT COLUMN   L, varia

           SKIP 1 LINES

          PRINT COLUMN 1, "Desde ",rango.fech_in using "dd/mm/yy", 
                          "  Hasta ",rango.fech_fi using "dd/mm/yy"

          PRINT COLUMN 1, "--------------------------------------------------",
                          "--------------------------------------------------",
                          "-----------------------------------------"

           PRINT COLUMN   1, "Orden de",       
                 COLUMN  23, "Fecha",
                 COLUMN  32, "Fecha",
                 COLUMN  86, "Cantidad",
                 COLUMN 100, "Cantidad"

           PRINT COLUMN   3, "Compra",
                 COLUMN  12, "Tipo",
                 COLUMN  23, "Pedido",
                 COLUMN  32, "Entrega",
                 COLUMN  42, "Suplidor", 
                 COLUMN  86, "Ordenada",
                 COLUMN 100, "Recibida",
                 COLUMN 112, "Diferencia"

          PRINT COLUMN 1, "--------------------------------------------------",
                          "--------------------------------------------------",
                          "-----------------------------------------"

   SKIP 1 LINE
       BEFORE GROUP OF x.cod_n
              LET bandera = "S"
       BEFORE GROUP OF x.cod_grupo
              LET bandera = "S"
       BEFORE GROUP OF x.cod_tipo
              LET bandera = "S"
       BEFORE GROUP OF x.cod_sec
              LET bandera = "S"
       BEFORE GROUP OF x.cod_sp
              LET b_suplidor = "S"
       BEFORE GROUP OF x.cod_sp_sec
              LET b_suplidor = "S"
       BEFORE GROUP OF x.num_oc
          LET b_oc = "S"

       LET cantidad = x.cantidad

      ON EVERY ROW

       IF x.fech_oc >= rango.fech_in and x.fech_oc <= rango.fech_fi THEN
         IF bandera = "S" AND bandera1 IS NULL THEN
          SKIP 1 LINE

        IF x.cantidad_2 is not null THEN
          PRINT COLUMN  1, negrillas_on,
                COLUMN  2, "Codigo ",x.cod_n USING "&","-",
                           x.cod_grupo USING "&","-",x.cod_tipo USING "&&","-",
                           x.cod_sec USING "&&&","  ", COLUMN 26, "Descripcion",
                           "  ",x.descrip_esp,"  ",x.unidad_med,negrillas_off
            LET bandera = "N"
        END IF
         END IF

           IF x.tipo = "01" THEN
              LET descrip = "GENERAL"
              IF x.c_flete IS NOT NULL THEN
                 LET moneda = "US"
              END IF
              IF x.c_flete IS NULL OR x.c_flete = 0 THEN
                 LET moneda = "RD"
              END IF
           END IF

           IF x.tipo = "02" THEN
              LET descrip = "ROV-LTD"
              IF x.c_flete IS NOT NULL THEN
                 LET moneda = "US"
              END IF
           END IF

           IF x.tipo = "03" THEN
              LET descrip = "LOCAL"
              LET moneda = "RD"
           END IF

           IF x.tipo = "04" THEN
              LET descrip = "MISCELANEA"
              LET moneda = "RD"
           END IF

       IF x.cantidad_2 is not null THEN
       IF b_oc = "S" THEN
           PRINT COLUMN  3, x.num_oc using "<<<<<<",
                 COLUMN 12, descrip,
                 COLUMN 23, x.fech_oc USING "dd/mm/yy";
       END IF

           LET b_oc = "N"

       IF b_suplidor = "S" THEN
          PRINT COLUMN 42, x.cod_sp USING "<<","-",x.cod_sp_sec USING "<<<<",
                           " ",x.nom_sp CLIPPED;
       END IF

       LET b_suplidor = "N"

                 PRINT COLUMN  82, x.cantidad USING "##,###,###.##",
                       COLUMN  96, x.cantidad_2 USING "##,###,###.##",
                       COLUMN 110, x.cantidad - x.cantidad_2
                                   USING "--,---,---.##"
          END IF
       END IF

       AFTER GROUP OF x.cod_n
              LET bandera = "N"
              LET bandera1 = NULL
       AFTER GROUP OF x.cod_grupo
              LET bandera = "N"
              LET bandera1 = NULL
       AFTER GROUP OF x.cod_tipo
              LET bandera = "N"
              LET bandera1 = NULL
       AFTER GROUP OF x.cod_sec
              LET bandera = "N" 
              LET bandera1 = NULL

     ON LAST ROW
        PRINT comp_off
     END REPORT