PC Toledo

Caros Colegas:

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

Erasmo, acho que você poderia usar uma abordagem um pouco diferente:

Código: Selecionar todos

ARQ1.DBF
LCTO / VLR / PREST / PAGAS
1 / 500 / 5 / 2
2 / 100 / 2 / 1

ARQ2.DB
LCTO / PARCE / VLR / VCTO / PAGO
1 / 1 / 100 / 01/03/08 / 01/03/08
1 / 2 / 100 / 01/04/08 / 05/04/08
1 / 3 / 100 / 01/05/08 / 
1 / 4 / 100 / 01/06/08 / 
1 / 5 / 100 / 01/07/08 / 
2 / 1 / 50 / 01/04/08 / 02/04/08
2 / 2 / 50 / 01/05/08 /

Como o que interessa é saber se o contrato X está quitado ou não, independente de datas, bastaria você abrir o ARQ1, o qual teria para cada contrato o número total de prestações e o número de prestações pagas: se PAGAS=PREST, o contrato está quitado, então ele pode ser deletado; se PAGAS<PREST, tem prestação em aberto, então não pode ser deletado. E você nem precisa abrir o ARQ2 para verificar isso.

Imaginando ARQ1 e ARQ2 indexados por LCTO, vamos tentar deletar o contrato número 1:

Código: Selecionar todos

vLCTO=1
use arq1
seek vLCTO
if !found()
  ?"contrato não existe"
else
  if pagas<prest
    ? "prestações em aberto! não pode deletar"
  else
    ? "deletando..."
    use arq2
    do whil .t.
      seek vLCTO
      if !found()
        exit
      endi
      dele
    endd
    use
    sele arq1
    dele
  endi
endi

É uma boa idéia...

vou testar ela aqui pra ver se funciona.... retorno logo mais...

Abraços!

Vamos por partes.

- Não crie os indices temporários.
- Indexe o ARQ1 por Nº do lançamento.
- Indexe o ARQ2 por Nº do lançamento + DTOS(vcto).
- Como vc esta usando CDX, use o setscope para filtrar o arquivo on line.
- Quando o usuário informar qual é o lançamento para baixar, abra um browse para ele selecionar quais deverão ser baixadas/pagas.
- Quando terminar o lançamento e sair do browse, pesquise o lançamento (DBSEEK e WHILE) para verificar se todas as parcelas estão pagas. Se estiverem todas baixadas, exclua o registro do ARQ1.

PC Toledo

Ajuda: Exclusão de registros de 2 arquivos relacionados

Ajuda: Exclusão de registros de 2 arquivos relacionados