MBS/PROYECTOS/irdir/irprrp006.4gl

{
-------------------------------------------------------------------------------
PROGRAMA             :  IRPRRP006
OBJETIVO             :  CATALOGO DE REPUESTOS CON EXISTENCIAS      
PROGRAMADOR          :  Ing. Juan Fco. Soto.       
FECHA REALIZACION    :  Mayo 18, 1993.   
-------------------------------------------------------------------------------
}
GLOBALS "irprgb000.4gl"
  DEFINE existencia VARCHAR(2)
MAIN                
  DEFER INTERRUPT
   CALL arg_val(1) RETURNING usuarios
   CALL arg_val(2) RETURNING clave
   CALL arg_val(3) RETURNING impresor
   CONNECT TO "smarmotech" USER usuarios USING clave
   SELECT * INTO p_companias.* FROM companias
    CALL irprrp006()
END MAIN

FUNCTION irprrp006()
    DEFINE idx SMALLINT 

    DEFINE materia RECORD
      cod_n        LIKE intb00002.cod_n,
      cod_grupo    LIKE intb00002.cod_grupo,
      cod_tipo     LIKE intb00002.cod_tipo,
      cod_sec      LIKE intb00002.cod_sec,
      descrip_esp  LIKE irtb00002.descrip_esp,
      descrip_ing  LIKE irtb00002.descrip_ing,
      unidad_med   LIKE irtb00002.unidad_med,
      exist_min    FLOAT,
      existencia   LIKE irtb00002.existencia
    END RECORD,
        cod smallint

 #WHENEVER ERROR CONTINUE

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

    CLEAR SCREEN

    OPEN FORM irfmrp006 FROM "irfmrp006"
    DISPLAY FORM irfmrp006
   
    LET tipo_papel = 1
    CALL msgrp000(tipo_papel)

     INPUT BY NAME decide,existencia  

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


    CONSTRUCT criterio ON b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec
                     FROM cod_n,cod_grupo,cod_tipo,cod_sec 

 IF decide = "A" THEN 
    LET SELEC = 
      "SELECT  b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec,b.descrip_esp, ",
      "       b.descrip_ing,b.unidad_med,b.exist_min,ISNULL(sum(c.cantidad_2),0) ",
      "FROM irtb00002 b,irtb00006 c ",
      "WHERE ",criterio CLIPPED,
      " AND (c.cod_n = c.cod_n AND b.cod_Grupo = c.cod_Grupo AND b.cod_tipo = c.cod_tipo AND b.cod_sec = c.cod_sec) ",
      " AND c.status_t IS NULL " ,
      " AND b.status_t IS NULL ",
      "GROUP  BY b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec,b.exist_min,b.descrip_esp,b.descrip_ing,b.unidad_med ",
      "ORDER BY b.descrip_esp"
 ELSE 
    LET SELEC = 
      "SELECT  b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec,b.descrip_esp, ",
      "       b.descrip_ing,b.unidad_med,b.exist_min,ISNULL(sum(c.cantidad_2),0) ",
      "FROM irtb00002 b,irtb00006 c ",
      "WHERE ",criterio CLIPPED,
      " AND (c.cod_n = c.cod_n AND b.cod_Grupo = c.cod_Grupo AND b.cod_tipo = c.cod_tipo AND b.cod_sec = c.cod_sec) ",
      " AND c.status_t IS NULL " ,
      " AND b.status_t IS NULL ",
      "GROUP  BY b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec,b.exist_min,b.descrip_esp,b.descrip_ing,b.unidad_med ",
      "ORDER BY b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec "
END IF

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

    
    PREPARE busca FROM selec

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

    DECLARE accion SCROLL CURSOR FOR busca
    OPEN accion 

   LET idx = 1
   LET p_param = "S"
 WHILE status != notfound 
    FETCH ABSOLUTE idx  accion INTO materia.* 
       IF status = NOTFOUND THEN
         EXIT WHILE  
       END IF
       
       IF idx = 1 THEN
         LET r_filename = 'irprrp006.4rp' 
         IF fgl_report_loadCurrentSettings(r_filename) THEN                          
            LET preview=1                           
            CALL seleccionarsalida() RETURNING r_output      -- load the .4rp file
            CALL fgl_report_selectDevice(r_output)           -- changing default
            CALL fgl_report_selectPreview(preview)           -- changing default
            CALL fgl_report_configurexlsxdevice(null,null,null,false,false,null,1)
            LET handler = fgl_report_commitCurrentSettings() -- commit changes

                    END IF
          START REPORT p_cero TO XML HANDLER handler

       END IF
    LET idx = idx  + 1

        IF int_flag THEN
         LET numero_msg = 2
         CALL msg(numero_msg)
         LET int_flag = false
         RETURN
        END IF
        
        LET p_param = "N"
         IF existencia = 'SI' THEN
            IF materia.existencia =0 OR materia.existencia IS NULL THEN
               CONTINUE WHILE
            END IF   
         END IF
         OUTPUT TO REPORT p_cero(materia.*)
    END WHILE
    IF idx > 1 THEN  
       FINISH REPORT p_cero
    ELSE
       CALL fgl_winmessage("INFO","NO EXISTEN INFORMACIONES CON ESTOS PARAMETROS","INFO")   
    END IF
 END FUNCTION

    REPORT p_cero(x)
       DEFINE x RECORD
          cod_n       LIKE intb00002.cod_n,
          cod_grupo   LIKE intb00002.cod_grupo,
          cod_tipo    LIKE intb00002.cod_tipo,
          cod_sec     LIKE intb00002.cod_sec,
          descrip_esp LIKE irtb00002.descrip_esp,
          descrip_ing  LIKE irtb00002.descrip_ing,
          unidad_med  LIKE irtb00002.unidad_med,
          exist_min    FLOAT,
          existencia  LIKE irtb00002.existencia
       END RECORD

    DEFINE dia_l,l smallint
    DEFINE varia CHAR(20)
    DEFINE descripcion CHAR(60)
    DEFINE primera CHAR(1)
    DEFINE hora CHAR(5),
           codigo VARCHAR(25),
           cantidad_registros INT
    OUTPUT
     TOP MARGIN 0
      LEFT MARGIN 0
      BOTTOM MARGIN 2
    FORMAT
      PAGE HEADER
        LET hora = TIME
             IF decide = "N" THEN
                 LET varia = "N u m e r i c o"
             ELSE 
                 LET varia = "A l f a b e t i c o"
             END IF
         PRINTX hora,p_companias.nombre,varia
            
         

     
      ON EVERY ROW
        LET codigo = x.cod_n USING "&","-",x.cod_grupo USING "&&","-",x.cod_tipo USING "&&&","-",
                     x.cod_sec USING "&&&&"          
      
         PRINTX  x.*,p_companias.nombre,codigo


     ON LAST ROW
      LET cantidad_registros= count(*) 
      PRINTX cantidad_registros
    
     END REPORT