Misturei com XML, até que tá interessante, pelo menos não enche de arquivos.
Código: Selecionar todos
[ze_bancariocalcula]
CREATE PROCEDURE ze_bancarioCalcula()
BEGIN
DECLARE nCursorEOF INT(11) DEFAULT 0;
DECLARE cConta VARCHAR(20) DEFAULT 'X';
DECLARE SP_CURSOR CURSOR FOR
SELECT DISTINCT BACONTA
FROM JPBANCARIO
ORDER BY BACONTA;
DECLARE CONTINUE HANDLER FOR NOT FOUND SET nCursorEOF = 1;
OPEN SP_CURSOR;
THIS:WHILE nCursorEOF <> 1 DO
FETCH SP_CURSOR INTO cConta;
IF nCursorEOF = 1 THEN
LEAVE THIS;
END IF;
CALL ze_bancarioCalculaConta( cConta );
END WHILE;
END
[/ze_bancariocalcula]
[ze_bancariocalculaconta]
CREATE PROCEDURE ze_bancariocalculaConta( cConta VARCHAR(20) )
BEGIN
DECLARE nCursorEOF, nIDBANCARIO, nId, nOrdem INT(11) DEFAULT 0;
DECLARE cBAAPLIC, cBAIMPSLD, cAplic, cImpSld VARCHAR(20) DEFAULT 'X';
DECLARE dBADATBAN, dBADATEMI, dDatBan, dDatEmi DATE;
DECLARE nBAVALOR, nBASALDO, nSaldo DECIMAL(16,2);
DECLARE SP_CURSOR CURSOR FOR
SELECT IDBANCARIO, BAAPLIC, BADATBAN, BADATEMI, BAVALOR, BASALDO, BAIMPSLD, IF( BAVALOR > 0, 1, 2 ) AS ORDEM
FROM JPBANCARIO
WHERE BACONTA = cConta
ORDER BY BAAPLIC, BADATBAN, BADATEMI, ORDEM, IDBANCARIO;
DECLARE CONTINUE HANDLER FOR NOT FOUND SET nCursorEOF = 1;
OPEN SP_CURSOR;
THIS:WHILE nCursorEOF <> 1 DO
FETCH SP_CURSOR INTO nIDBANCARIO, cBAAPLIC, dBADATBAN, dBADATEMI, nBAVALOR, nBASALDO, cBAIMPSLD, nOrdem;
IF nCursorEOF = 1 THEN
LEAVE THIS;
END IF;
IF cBAAPLIC <> cAplic THEN
SET nSaldo = 0;
UPDATE JPBANCARIO SET BAIMPSLD = 'S' WHERE IDBANCARIO = nId;
END IF;
SET nSaldo = nSaldo + nBAVALOR;
IF nBASALDO <> nSaldo OR cBAIMPSLD <> 'N' THEN
UPDATE JPBANCARIO SET BASALDO = nSaldo, BAIMPSLD = 'N' WHERE IDBANCARIO = nIDBANCARIO;
END IF;
IF dDatBan <> dBADATBAN OR ( dBADATBAN = '2999-12-31' AND dDatEmi <> dBADATEMI ) THEN
UPDATE JPBANCARIO SET BAIMPSLD = 'S' WHERE IDBANCARIO = nId;
END IF;
SET nID = nIDBANCARIO;
SET cAplic = cBAAPLIC;
SET dDatBan = dBADATBAN;
SET dDatEmi = dBADATEMI;
END WHILE;
END
[/ze_bancariocalculaconta]
[ze_bancorecalcula]
FUNCTION BARecalcula( mbaConta, lRecalculoGeral )
LOCAL aContaList := {}, oConta, cSQLA, cSQLB, cSQLC, cSQLD
LOCAL cnSQL := ADOClass():New( AppConexao() )
hb_Default( @lRecalculoGeral, .F. )
IF ! lRecalculoAuto .AND. ! lRecalculoGeral
RETURN NIL
ENDIF
WITH OBJECT cnSQL
:cSQL := "SELECT DISTINCT BACONTA, BAAPLIC" + ;
" FROM JPBANCARIO" + ;
iif( mbaConta == NIL, "", " WHERE BACONTA = " + StringSQL( mbaConta ) )
:Execute()
DO WHILE ! :Eof()
AAdd( aContaList, { :String( "BACONTA" ), :String( "BAAPLIC" ) } )
:MoveNext()
ENDDO
FOR EACH oConta IN aContaList
:ExecuteCmd( "SET @SOMA = 0" )
:ExecuteCmd( "UPDATE JPBANCARIO" + ;
" INNER JOIN" + ;
"( SELECT IDBANCARIO, BADATBAN, BADATEMI, BAVALOR," + ;
" BASALDO, IF( BAVALOR < 0, 2, 1 ) AS ORDEM, @SOMA := @SOMA + BAVALOR AS SALDO" + ;
" FROM JPBANCARIO" + ;
" WHERE BACONTA = " + StringSQL( oConta[ 1 ] ) + ;
" AND BAAPLIC = " + StringSQL( oConta[2 ] ) + ;
" ORDER BY BACONTA, BAAPLIC, BADATBAN, BADATEMI, ORDEM, IDBANCARIO ) AS A" + ;
" ON JPBANCARIO.IDBANCARIO = A.IDBANCARIO" + ;
" SET JPBANCARIO.BASALDO = A.SALDO" + ;
" WHERE JPBANCARIO.BACONTA = " + StringSQL( oConta[ 1 ] ) + " AND JPBANCARIO.BASALDO <> A.SALDO" )
NEXT
:ExecuteCmd( "SET @SOMA = NULL" )
:ExecuteCmd( "SET @A = 0" )
:ExecuteCmd( "SET @B = 0" )
cSQLA := " SELECT BACONTA, BAAPLIC, IDBANCARIO, BADATBAN, BADATEMI," + ;
" IF( BAVALOR < 0, 2, 1 ) AS ENTSAI, @A := @A + 1 AS ORDEM" + ;
" FROM JPBANCARIO" + ;
" ORDER BY BACONTA, BAAPLIC, BADATBAN, ENTSAI, BADATEMI, IDBANCARIO"
cSQLB := " SELECT BACONTA, BAAPLIC, IDBANCARIO, BADATBAN, BADATEMI," + ;
" IF( BAVALOR < 0, 2, 1 ) AS ENTSAI, @B := @B + 1 AS ORDEM" + ;
" FROM JPBANCARIO" + ;
" ORDER BY BACONTA, BAAPLIC, BADATBAN, ENTSAI, BADATEMI, IDBANCARIO"
cSQLC := " SELECT BACONTA, BAAPLIC, BADATBAN, MAX( ORDEM ) AS MAXIMO" + ;
" FROM ( " + cSQLB + " ) AS B" + ;
" GROUP BY BACONTA, BAAPLIC, BADATBAN"
cSQLD := " SELECT IDBANCARIO FROM" + ;
" ( " + cSQLA + " ) AS A" + ;
" INNER JOIN" + ;
" ( " + cSQLC + " ) AS C" + ;
" ON A.ORDEM = C.MAXIMO"
:ExecuteCmd( " UPDATE JPBANCARIO" + ;
" LEFT JOIN ( " + cSQLD + " ) AS D" + ;
" ON JPBANCARIO.IDBANCARIO = D.IDBANCARIO" + ;
" SET BAIMPSLD = IF( JPBANCARIO.IDBANCARIO = D.IDBANCARIO, 'S', 'N' )" + ;
" WHERE BAIMPSLD <> IF( JPBANCARIO.IDBANCARIO = D.IDBANCARIO, 'S', 'N' )" )
:ExecuteCmd( "SET @A = NULL" )
:ExecuteCmd( "SET @B = NULL" )
:CloseRecordset()
ENDWITH
RETURN .T.
[/ze_bancorecalcula]
Nota2: Com certeza o último ainda é PRG, mas no XML tanto faz.
