{ ------------------------------------------------------------------------------- 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