MBS/PROYECTO/vedir/veprcs002.4gl

{
-------------------------------------------------------------------------------
PROGRAMA             :  VEPRCS002
OBJETIVO             :  Cantidad de Cheques Devueltos
PROGRAMADOR          :  Tadeo A. Ferreras F.
FECHA REALIZACION    :  Febrero 21, 1996  
-------------------------------------------------------------------------------
}
GLOBALS "veprgb000.4gl"

    DEFINE cons_2 RECORD
          tipo_cliente     SMALLINT,
          sec_cliente      SMALLINT,
          nombre           CHAR(30)
    END RECORD
    DEFINE x ARRAY[200] OF RECORD
           fecha            DATE,
           num_doc          INTEGER, 
           valor            DECIMAL(12,2)
    END RECORD,
           ma_cli1 ARRAY[1000] OF RECORD
           tipo_cliente     SMALLINT,
           sec_cliente      SMALLINT,
           nombre           CHAR(30)     
    END RECORD,
        idx1,cu_1,fi_1,canti INTEGER,
        monto DECIMAL(12,2)

FUNCTION veprcs002()

#   WHENEVER ERROR CONTINUE

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

    OPEN FORM vefmcs002 FROM "vefmcs002"
    DISPLAY FORM vefmcs002
    CALL pantalla()
    DISPLAY "veprcs002" AT 4,3
    DISPLAY "Cheques Devueltos Al Cliente" AT 6,26 

   LABEL volver:
   CLEAR FORM
   INPUT BY NAME cons_2.tipo_cliente,cons_2.sec_cliente              
     ON KEY (CONTROL-W)
   
     CASE
       WHEN INFIELD(tipo_cliente)
       CALL maestra_cli()
       DISPLAY BY NAME cons_2.*
       IF cons_2.tipo_cliente IS NOT NULL AND cons_2.tipo_cliente > 0 THEN
          NEXT FIELD sec_cliente
       END IF

       WHEN INFIELD(sec_cliente)
       CALL maestra_cli()
       DISPLAY BY NAME cons_2.*
     END CASE

   AFTER FIELD tipo_cliente
     IF cons_2.tipo_cliente IS NULL THEN
        LET numero_msg = 16
        CALL msg(numero_msg)
        NEXT FIELD tipo_cliente
     END IF

   AFTER FIELD sec_cliente
     IF cons_2.sec_cliente IS NULL THEN
        LET numero_msg = 16
        CALL msg(numero_msg)
        NEXT FIELD sec_cliente
     END IF

     SELECT UNIQUE a.nombre INTO cons_2.nombre FROM vetb00004 a,cctb00001 b
     WHERE (a.tipo_cliente=b.tipo_cliente AND a.sec_cliente = b.sec_cliente) AND
           (a.tipo_cliente = cons_2.tipo_cliente AND 
            a.sec_cliente  = cons_2.sec_cliente) AND (b.tipo_doc = "ND") AND 
           (b.valor_cheque IS NOT NULL) AND (b.status_t IS NULL)

     IF STATUS = NOTFOUND THEN
        LET numero_msg = 255
        CALL msg(numero_msg)
        NEXT FIELD sec_cliente
     END IF
     DISPLAY BY NAME cons_2.nombre
   END INPUT

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

# Busca los codigos de los Centes

    DECLARE busca CURSOR FOR
    SELECT MIN(b.fecha_orig),b.num_doc,SUM(b.valor+b.monto_desc) 
    FROM cctb00001 b 
    WHERE b.tipo_cliente = cons_2.tipo_cliente AND 
          b.sec_cliente  = cons_2.sec_cliente AND  b.status_t IS NULL AND 
          b.tipo_doc = 'ND' AND b.valor_cheque IS NOT NULL 
    GROUP BY 2 ORDER BY 1,2

    LET idx = 1 
    LET monto = 0
    LET canti = 0
    FOREACH busca INTO x[idx].*
      IF x[idx].valor IS NULL THEN
         LET x[idx].valor = 0
      END IF
      LET canti = canti + 1
      LET monto = monto + x[idx].valor
      LET idx = idx + 1
    END FOREACH
    CALL SET_COUNT(idx-1)
   
    DISPLAY BY NAME canti,monto
    DISPLAY ARRAY x TO s_cons2.*
    IF int_flag THEN
       LET numero_msg = 2
       CALL msg(numero_msg)
       LET int_flag = FALSE
       GOTO volver
    ELSE
       GOTO volver
    END IF

END FUNCTION

FUNCTION maestra_cli()
 OPEN WINDOW ma_cli AT 8,2 WITH FORM "vefmwd015"
 ATTRIBUTE(BORDER,FORM LINE FIRST + 2,COMMENT LINE LAST,MESSAGE LINE LAST)

 CONSTRUCT criterio ON a.tipo_cliente,a.sec_cliente,a.nombre 
                  FROM tipo_cliente,sec_cliente,nombre

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

 LET selec = "SELECT a.tipo_cliente,a.sec_cliente,a.nombre FROM vetb00004 a ",
              "WHERE a.status_t IS NULL AND ",criterio CLIPPED,"  ORDER BY 1,2"

 PREPARE comando FROM selec
 DECLARE busca1 CURSOR FOR comando

 LET idx1 = 1
 FOREACH busca1 INTO ma_cli1[idx1].*
   LET idx1 = idx1 + 1
 END FOREACH
 CALL SET_COUNT(idx1 - 1)

 DISPLAY ARRAY ma_cli1 TO p_cli1.*
   LET cu_1 = ARR_CURR()
   LET fi_1 = SCR_LINE()

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

   LET cons_2.tipo_cliente = ma_cli1[cu_1].tipo_cliente 
   LET cons_2.sec_cliente  = ma_cli1[cu_1].sec_cliente 
   LET cons_2.nombre       = ma_cli1[cu_1].nombre      

  LABEL salir1:
    CLOSE WINDOW ma_cli
END FUNCTION