{
-------------------------------------------------------------------------------
PROGRAMA             :  COPRRP002
OBJETIVO             :  Relacion Suplidor-Materia Prima
PROGRAMADOR          :  Ing. Betania Guerrero Perez
FECHA REALIZACION    :  Octubre 08, 1992
-------------------------------------------------------------------------------
}
GLOBALS "coprgb000.4gl"

FUNCTION coprrp002()

    DEFINE i,idx SMALLINT
    DEFINE salir1,salir,sale CHAR(1),
           p_codigo CHAR(7)

    DEFINE matpri 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,
           base         LIKE intb00002.base,
           gravamen     LIKE intb00002.gravamen,
           cod_embarque LIKE cotb00027.cod_embarque,
           cod_furg     LIKE cotb00004.cod_furg
     END RECORD

     DEFINE price RECORD
           cod_n        LIKE cotb00015.cod_n,
           cod_grupo    LIKE cotb00015.cod_grupo,
           cod_tipo     LIKE cotb00015.cod_tipo,
           cod_sec      LIKE cotb00015.cod_sec,
           num_oc       LIKE cotb00014.num_oc,
           cod_sp       LIKE cotb00001.cod_sp,
           cod_sp_sec   LIKE cotb00001.cod_sp_sec,
           via_t        LIKE cotb00017.via_t,
           descrip_esp  LIKE intb00001.descrip_esp,
           unidad_med   LIKE intb00001.unidad_med,
           base         LIKE intb00002.base,
           gravamen     LIKE intb00002.gravamen,
           cod_embarque LIKE cotb00027.cod_embarque,
           cod_furg     LIKE cotb00004.cod_furg,
           seguro       LIKE cotb00017.seguro,
           nom_sp       LIKE cotb00001.nom_sp
    END RECORD

# WHENEVER ERROR CONTINUE

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

    OPEN FORM cofmrp002 FROM "cofmrp002"
    DISPLAY FORM cofmrp002
    CALL pantalla()
    DISPLAY "coprrp002" AT 4,3 ATTRIBUTE(YELLOW)
    DISPLAY "Relacion Materia Prima - Suplidores" AT 6,23

    LET tipo_papel = 1
    CALL msgrp000(tipo_papel)

    CONSTRUCT criterio ON c.cod_sp,c.cod_sp_sec,a.cod_n,a.cod_grupo, 
                          a.cod_tipo,a.cod_sec
                          FROM cod_sp,cod_sp_sec,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

     DISPLAY "Buscando Informacion ... Espere Por Favor" AT 19,14
     ATTRIBUTE (REVERSE,BOLD)

# Buscando datos generales de los materiales y codigo del embarque

   LET SELEC1 = 
    "SELECT UNIQUE a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp, ",
    "       a.unidad_med,b.base,b.gravamen,f.cod_embarque,f.cod_furg ",
    "FROM intb00001 a,intb00002 b,cotb00004 f ",
    "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 ",
    "      b.cod_n = f.cod_n AND b.cod_grupo = f.cod_grupo AND ",
    "      b.cod_tipo = f.cod_tipo AND b.cod_sec = f.cod_sec AND ",
    "      a.status_t is null ORDER BY 1,2,3,4" 

  PREPARE busca1 FROM selec1
  DECLARE accion1 SCROLL CURSOR FOR busca1
  OPEN accion1

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

# Busqueda de informacion complementaria de precios, codigo de suplidor, etc

   LET SELEC = "SELECT  a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
              "         MAX(c.num_oc),c.cod_sp,c.cod_sp_sec,d.via_t ", 
              "FROM cotb00014 c,cotb00015 a, cotb00017 d ",
              "WHERE ",criterio clipped, " AND a.num_oc = c.num_oc AND ",
              "     a.tipo = c.tipo AND a.cod_n = 1 AND ",
              "     a.tipo between '01' and '02' AND c.via = d.via_t AND ",
              "     a.status_t is null GROUP BY 1,2,3,4,6,7,8 ORDER BY 1,2,3,4"

    PREPARE busca FROM selec  
    DECLARE accion SCROLL CURSOR FOR busca
    OPEN accion

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

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

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

    START REPORT relacion TO "C:\\archivo"

    LET i = 1
    LET salir1 = "N"
    WHILE salir1 != "S"     
          FETCH ABSOLUTE i accion INTO price.*
                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
             RETURN
          END IF

          LET i = i + 1
          LET idx = 1
          LET salir = "N"
         WHILE salir != "S"
                FETCH ABSOLUTE idx accion1 INTO matpri.*
                      IF STATUS = NOTFOUND THEN
                         LET idx = 1
                         LET salir = "S"
                         EXIT WHILE
                      END IF

                      LET idx = idx + 1
                      IF matpri.cod_n   = price.cod_n AND
                         matpri.cod_grupo = price.cod_grupo AND
                         matpri.cod_tipo  = price.cod_tipo AND
                         matpri.cod_sec   = price.cod_sec THEN

                         LET price.descrip_esp = matpri.descrip_esp
                         LET price.unidad_med  = matpri.unidad_med
                         LET price.base = matpri.base
                         LET price.gravamen = matpri.gravamen
                         LET price.cod_embarque = matpri.cod_embarque
                         LET price.cod_furg = matpri.cod_furg

                      LET salir = "S"
                      EXIT WHILE
                      END IF
          END WHILE
IF price.cod_n = 1 THEN
     LET p_codigo = price.cod_n using "&",price.cod_grupo using "&",
                    price.cod_tipo using "&&", price.cod_Sec using "&&&"
     OUTPUT TO REPORT relacion(price.*,p_codigo)
END IF
    END WHILE

    FINISH REPORT relacion

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

    REPORT relacion(x,codigo)
       DEFINE x RECORD
           cod_n        LIKE cotb00015.cod_n,
           cod_grupo    LIKE cotb00015.cod_grupo,
           cod_tipo     LIKE cotb00015.cod_tipo,
           cod_sec      LIKE cotb00015.cod_sec,
           num_oc       LIKE cotb00014.num_oc,
           cod_sp       LIKE cotb00001.cod_sp,
           cod_sp_sec   LIKE cotb00001.cod_sp_sec,
           via_t        LIKE cotb00017.via_t,
           descrip_esp  LIKE intb00001.descrip_esp,
           unidad_med   LIKE intb00001.unidad_med,
           base         LIKE intb00002.base,
           gravamen     LIKE intb00002.gravamen,
           cod_embarque LIKE cotb00027.cod_embarque,
           cod_furg     LIKE cotb00004.cod_furg,
           seguro       LIKE cotb00017.seguro,
           nom_sp       LIKE cotb00001.nom_sp
       END RECORD,
           codigo CHAR(7)


    DEFINE descripcion CHAR(50)
    DEFINE cantidad1,precio_p DECIMAL(11,3)
    DEFINE flete,gastos DECIMAL(12,2)
    DEFINE precios,fob3,P1,fob,precio1,precio_c,valor,total_1,
           canti,fob2,fob1,recargo,total_2,cif DECIMAL(15,3)
    DEFINE gravamen,itbis DECIMAL(15,3)
    DEFINE fact_imp DECIMAL(15,3)
    DEFINE b_oc,bandera CHAR(1)
    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 doce = ASCII 27, ASCII 77  
        LET normal = ASCII 27, ASCII 80
        LET hora = time

        LET l = (161 - LENGTH(p_companias.nombre CLIPPED))/2
           PRINT COLUMN   1, comp_on,negrillas_on
           PRINT COLUMN   1, "coprrp002",
                 COLUMN   l, p_companias.nombre CLIPPED,
                 COLUMN 154, "Pag. ",pageno using "<<<"
           PRINT COLUMN 32, "Sistema de Compras",
                 COLUMN 154, today using "dd/mm/yy"
           PRINT COLUMN 24, "Relacion Materia Prima - Suplidores",
                 COLUMN 157, hora

           SKIP 1 LINE
           PRINT COLUMN 1, "--------------------------------------------------",
                           "--------------------------------------------------",
                           "--------------------------------------------------",
                           "---------------"

           PRINT COLUMN  99, "Precio",
                 COLUMN 114, "Precio",
                 COLUMN 132, "Factor"

           PRINT COLUMN   2, "Codigo",
                 COLUMN  14, "Descripcion",
                 COLUMN  45, "Und",
                 COLUMN  50, "Suplidor",
                 COLUMN 102, "FOB",
                 COLUMN 117, "C&F",
                 COLUMN 132, "Impositivo",
                 COLUMN 145, "Forma de Embarque"

           PRINT COLUMN 1, "--------------------------------------------------",
                           "--------------------------------------------------",
                           "--------------------------------------------------",
                           "----------------"
           PRINT COLUMN 90, negrillas_off

           SKIP 1 LINE
  BEFORE GROUP OF codigo
         PRINT COLUMN  2, x.cod_n  using "&","-",
               COLUMN  4, x.cod_grupo USING "&","-",
               COLUMN  6, x.cod_tipo USING "&&","-",
               COLUMN  9, x.cod_sec USING "&&&",
               COLUMN 14, x.descrip_esp,
               COLUMN 45, x.unidad_med;

  ON EVERY ROW
     SELECT UNIQUE nom_sp  INTO x.nom_sp FROM cotb00001 
     WHERE cod_sp = x.cod_sp and cod_sp_sec = x.cod_sp_sec and status_t is null 

     IF status = notfound THEN
        LET status = 0
     END IF

     SELECT SUM(a.cantidad * a.precio) INTO fob FROM cotb00015 a,cotb00014 b
     WHERE b.num_oc = a.num_oc AND b.tipo      = a.tipo AND
           a.num_oc = x.num_oc AND (a.tipo = 1 or a.tipo = 2) AND
           a.cod_n  = x.cod_n AND a.cod_grupo = x.cod_grupo AND
           a.cod_tipo = x.cod_tipo AND a.cod_sec   = x.cod_sec

     IF status = notfound THEN
        LET status = 0
     END IF

     SELECT a.cantidad,a.precio INTO canti,precios FROM cotb00015 a,cotb00014 b
     WHERE b.num_oc = a.num_oc AND b.tipo      = a.tipo AND
           a.num_oc = x.num_oc AND (a.tipo = 1 or a.tipo = 2) AND
           a.cod_n  = x.cod_n AND a.cod_grupo = x.cod_grupo AND
           a.cod_tipo  = x.cod_tipo AND a.cod_sec   = x.cod_sec

     IF status = notfound THEN
        LET status = 0
     END IF

     SELECT b.c_flete,b.otros_g INTO flete,gastos FROM cotb00015 a,cotb00014 b
     WHERE b.num_oc = a.num_oc AND b.tipo  = a.tipo AND
           (a.tipo = 1 or a.tipo = 2) AND b.num_oc = x.num_oc AND
           a.cod_n = x.cod_n AND a.cod_grupo = x.cod_grupo AND
           a.cod_tipo  = x.cod_tipo AND a.cod_sec   = x.cod_sec

     IF status = notfound THEN
        LET status = 0
     END IF

     SELECT MAX(seguro) INTO x.seguro FROM cotb00017 
     WHERE via_t  = x.via_t and cod_n  = x.cod_n and
           cod_grupo = x.cod_grupo and cod_tipo  = x.cod_tipo and
           cod_sec   = x.cod_sec and status_t is null 

     IF status = notfound THEN
        LET status = 0
        IF x.seguro is null THEN
           LET  x.seguro = 0
        END IF
     END IF

     IF x.base IS NULL THEN
        LET fob = fob
        LET fob1 = fob + flete + gastos
        IF canti != 0 THEN
            LET fob3 = fob1/canti
        ELSE
            LET fob3 = 0
        END IF 
        LET cif = fob1 * x.seguro
     END IF

     IF x.base > 0 THEN
        IF x.base != 0 THEN
           LET fob = fob/x.base
        ELSE
           LET fob = 0
        END IF
        LET fob1 = fob + flete + gastos
        IF canti != 0 THEN
           LET fob3 = (fob1/canti) * x.base
        ELSE
           LET fob3 = 0
        END IF
        LET cif = fob1 * x.seguro
     END IF
    
     LET valor = cif * 12.50
     LET gravamen = (valor * x.gravamen)/100
     LET total_1 = gravamen 
     LET itbis = (valor + total_1) * 0.08
     LET recargo = valor * 0.07

     IF total_1 is null THEN
        LET total_1 = 0
     END IF

     IF itbis is null THEN
        LET itbis = 0
     END IF

     IF recargo is null THEN
        LET recargo = 0
     END IF

     LET total_2 = total_1 + itbis + recargo

     IF valor > 0 THEN
        LET fact_imp = (total_2/valor) * 100
     ELSE
        LET fact_imp = 0
     END IF

     IF x.cod_embarque = 1 THEN
        SELECT UNIQUE descrip_furg INTO descripcion FROM cotb00003
        WHERE cod_furg = x.cod_furg    
        IF status = notfound THEN
           LET status = 0
        END IF
     ELSE
        SELECT descrip_emb INTO descripcion FROM cotb00027
        WHERE cod_embarque = x.cod_embarque
   
        IF status = notfound THEN
           LET status = 0
        END IF
     END IF

     PRINT COLUMN  50, x.cod_sp USING "<<","-",
           COLUMN  53, x.cod_sp_sec USING "<<<<",
           COLUMN  59, x.nom_sp, 
           COLUMN  91, precios USING "##,###,###.###",
           COLUMN 107, fob3 USING "###,###,###.##",
           COLUMN 134, fact_imp USING "###","%",
           COLUMN 145, descripcion
   
 ON LAST ROW
          PRINT ASCII 18
          PRINT ASCII 27, ASCII 80

END REPORT