Tenho dois arquivos:
ARQ1.DBF (campos preenchidos)
LCTO = 1
VALOR = 500
(Isto é, o programa grava um lançamento (nº 1) no ARQ1.DBF no valor de R$ 500,00).
ARQ2.DBF (campos preenchidos)
LCTO = 1 / PARCE = 1 / VLR = 100 / VCTO: 01/03/08 / PAGO: 100
LCTO = 1 / PARCE = 2 / VLR = 100 / VCTO: 01/04/08 / PAGO: 100
LCTO = 1 / PARCE = 3 / VLR = 100 / VCTO: 01/05/08 / PAGO: 0
LCTO = 1 / PARCE = 4 / VLR = 100 / VCTO: 01/06/08 / PAGO: 0
LCTO = 1 / PARCE = 5 / VLR = 100 / VCTO: 01/07/08 / PAGO: 0
(Isto é, o programa grava o lançamento do ARQ1.DBF (nº 1) no ARQ2.DBF, parcelando em 5x por exemplo, e cada parcela no valor de R$ 100,00), é o que eu uso atualmente. Posteriormente digamos, que paguei as parcelas (PARCE) 1 e 2, assim elas ficam quitadas porque na variavel PAGO tenho o valor da parcela que foi paga).
A questão é a seguinte:
-> Numa rotina de expurgo/exclusão, como proceder para que o programa apague, usando o exemplo de dados acima, no ARQ1.DBF o LCTO = 1 e no ARQ2.DBF as parcelas do LCTO = 1, más com uma condição: se o usuário informar que quer a exclusão até a data de VCTO = 01/05/08 por exemplo, o programa não deverá apagar nada, porque ainda existem parcelas a serem quitadas no LCTO = 1 (são as parcelas 3,4,5).
Sei que é fácil fazer isso quando os lançamentos do ARQ2.DBF estão todos quitados. Fiz uns testes aqui que deram um pouco de dor de cabeça, resolveu em parte, é que a rotina que fiz apaga as parcelas quitadas até a data de vcto informada, lê o numero de lançamento e logo depois apaga esse lçto no ARQ1.DBF, ocasionando um erro de programação.
Resumindo, o programa só deverá apagar os lançamentos do ARQ1.DBF e ARQ2.DBF se todas as parcelas do ARQ2.DBF estiverem quitadas, e somente se for dentro do período de exclusão solicitado.
Fico no aguardo da ajuda dos nossos craques da programação.
Abraços
EANDRIOLI
Segue o codigo utilizado atualmente:
Código: Selecionar todos
FUNCTION BNKEXCPR
SET DELETED OFF // Nao ignora excluidos, vai limpa-los tambem...
VCTO_EXC = CTOD("00/00/0000")
@07,31 SAY "DATA:"
SET COLOR TO ",W/N+*"
@07,37 GET VCTO_EXC
READ
// PRIMEIRO EXCLUI DA PARTE DE CONTAS A PAGAR...
* Indexadores temporarios...
arq_ex1 ="C:\TEMP\BKXDEL01.CDX"
arq_ex2 ="C:\TEMP\BKXDEL02.CDX"
arq_ex3 ="C:\TEMP\BKXDEL03.CDX"
** Arquivos estao sendo abertos em modo EXCLUSIVO para eliminacao...
SELE 11
USE BAXASPAG EXCLUSIVE ALIAS BAIXASP
INDEX ON NUMLCTO TAG 1 TO &arq_ex1 FOR VCTOPARC <= VCTO_EXC
SELE 6
USE FINAPGTO EXCLUSIVE ALIAS PAG
INDEX ON NUMLCTO TAG 1 TO &arq_ex2 FOR DTMVLCTO <= VCTO_EXC
SELE 10
USE PARCEPAG EXCLUSIVE ALIAS PARCEP
INDEX ON NUMLCTO TAG 1 TO &arq_ex3 FOR VCTOPARC <= VCTO_EXC .and. PAGOS >= VALORPARC
// Primeiro verifica arquivo de parcelas se foram todas pagas ate o periodo...
// Seleciona os laçtos ate o per¡odo solicitado acima e tao somente quitados...
SELE PARCEP
DBSEEK(NUMLCTO)
DO WHILE .T.
IF .NOT. FOUND()
MSGBOX1("NAO HA REGISTROS/PAGAMENTOS P/ EXPURGO...","ATENÇAO!",8)
DELETE FILE &arq_ex1
DELETE FILE &arq_ex2
DELETE FILE &arq_ex3
EXIT
ENDIF
// Iniciando as exclusoes...
WIN(9,10,14,43,"EXCLUINDO PAGAMENTOS",'W/R+*','R+*/W')
DO WHILE .NOT. EOF()
IF EOF()
EXIT
ENDIF
NUM_X = NUMLCTO
PAR_X = PARCELA
CTA_X = CONTA_P
VLR_X = VALORPARC
PAG_X = PAGOS
@11,13 SAY "REGISTROS DE PARCEPAG: "+LTRIM(STR(NUMLCTO)) COLOR("R/W+*")
@13,13 SAY VCTOPARC
DBRLOCK()
DELETE
DBUNLOCK()
SELE PAG
DBSEEK(NUM_X)
IF FOUND()
@12,26 SAY "FINAPGTO: "+LTRIM(STR(NUMLCTO)) COLOR("B/W+*")
DBRLOCK()
DELETE
DBUNLOCK()
ENDIF
* Monta o numero de lancamento das baixas...
AXE1 = LTRIM(STR(NUM_X))+LTRIM(STR(PAR_X))
AXE2 = VAL(AXE1)
SELE BAIXASP // Loop para apagar todas as baixas...
DBSEEK(AXE2)
IF FOUND()
@13,26 SAY "BAXASPAG: "+LTRIM(STR(AXE2)) COLOR("RB/W+*")
DBRLOCK()
DO WHILE AXE2 = NUMLCTO
DELETE
DBSKIP()
ENDDO
DBUNLOCK()
ENDIF
@13,36 SAY SPACE(6)
SELE PARCEP
DBSKIP()
ENDDO
EXIT
ENDDO
* Limpando registros de modo permanente...
SELE BAIXASP
PACK
SELE PAG
PACK
SELE PARCEP
PACK
* Apagando temporarios de indexa‡Æo...
DELETE FILE &arq_ex1
DELETE FILE &arq_ex2
DELETE FILE &arq_ex3
// AGORA EXCLUI DA PARTE DE CONTAS A RECEBER...
* Indexadores temporarios...
arq_ex4 ="C:\TEMP\BKXDEL04.CDX"
arq_ex5 ="C:\TEMP\BKXDEL05.CDX"
arq_ex6 ="C:\TEMP\BKXDEL06.CDX"
** Arquivos estao sendo abertos em modo EXCLUSIVO para elimina‡ao...
SELE 13
USE BAXASREC EXCLUSIVE ALIAS BAIXASR
INDEX ON NUMLCTO TAG 1 TO &arq_ex4 FOR VCTOPARC <= VCTO_EXC
SELE 7
USE FINARECE EXCLUSIVE ALIAS REC
INDEX ON NUMLCTO TAG 1 TO &arq_ex5 FOR DTMVLCTO <= VCTO_EXC
SELE 12
USE PARCEREC EXCLUSIVE ALIAS PARCER
INDEX ON NUMLCTO TAG 1 TO &arq_ex6 FOR VCTOPARC <= VCTO_EXC .and. RECEBES >= VALORPARC
// Primeiro verifica arquivo de parcelas se foram todas pagas at‚ o periodo...
// Seleciona os l‡tos at‚ o per¡odo solicitado acima e tao somente quitados...
SELE PARCER
DBSEEK(NUMLCTO)
DO WHILE .T.
IF .NOT. FOUND()
MSGBOX1("NÇO Hµ REGISTROS/RECEBIMENTOS P/ EXPURGO...","ATEN€ÇO!",12)
DELETE FILE &arq_ex4
DELETE FILE &arq_ex5
DELETE FILE &arq_ex6
EXIT
ENDIF
// Iniciando as exclusoes...
WIN(14,14,19,48,"EXCLUINDO RECEBIMENTOS",'N/GR*','GR*/W')
DO WHILE .NOT. EOF()
IF EOF()
EXIT
ENDIF
NUM_X = NUMLCTO
PAR_X = PARCELA
CTA_X = CONTA_R
VLR_X = VALORPARC
PAG_X = RECEBES
@16,18 SAY "REGISTROS DE PARCEREC: "+LTRIM(STR(NUMLCTO)) COLOR("R/W+*")
@18,18 SAY VCTOPARC
DBRLOCK()
DELETE
DBUNLOCK()
SELE REC
DBSEEK(NUM_X)
IF FOUND()
@17,31 SAY "FINARECE: "+LTRIM(STR(NUMLCTO)) COLOR("B/W+*")
DBRLOCK()
DELETE
DBUNLOCK()
ENDIF
* Monta o numero de lancamento das baixas...
AXE1 = LTRIM(STR(NUM_X))+LTRIM(STR(PAR_X))
AXE2 = VAL(AXE1)
SELE BAIXASR // Loop para apagar todas as baixas...
DBSEEK(AXE2)
IF FOUND()
@18,31 SAY "BAXASREC: "+LTRIM(STR(AXE2)) COLOR("N/W+*")
DBRLOCK()
DO WHILE AXE2 = NUMLCTO
DELETE
DBSKIP()
ENDDO
DBUNLOCK()
ENDIF
@18,41 SAY SPACE(6)
SELE PARCER
DBSKIP()
ENDDO
EXIT
ENDDO
* Limpando registros de modo permanente...
SELE BAIXASR
PACK
SELE REC
PACK
SELE PARCER
PACK
* Eliminando temporarios de indexacao...
DELETE FILE &arq_ex4
DELETE FILE &arq_ex5
DELETE FILE &arq_ex6
WIN(3,22,10,58,"FINAL DO PROCESSO:",'N/RB+*','RB+*/W')
SET COLOR TO "N*/W,N/W"
@05,24 SAY "LAN€AMENTOS DO PERÖODO SOLICITADO"
@06,24 SAY " FORAM EXPURGADOS COM SUCESSO!!! "
LINBUTTON1(,2,8)
RSTENV(TELA1)
SET DELETED ON
CLOSE ALL // Fechando por motivo de ter sido aberto como EXCLUSIVO...
RETURN 
