Jump to content
Fivewin Brasil

wagner1361303176

Membros
  • Posts

    26
  • Joined

  • Last visited

wagner1361303176's Achievements

Newbie

Newbie (1/14)

0

Reputation

  1. Olá Márcio, Não tenho o layout, e nem o pessoal responsável pelo desenvolvimento na SEFIN-RS, passa. Detectei essa mudança na realidade no Validador 2008, meu sistema gera todos os registros 60, não so o 60M. Quando validei no 2008 deu um monte de erro dizendo que faltava o 60M. Entrei em contato com a SEFIN-RO e eles também nà o sabiam que o validador nà o passava, entrei em contato diretamente com o pessoal do RS e me informaram que lá não era obrigatório o 60I, portanto tiraram isso do validador e que iriam colocar no 2009, fizerm so que não seguindo pelo manual. Pois no manual deveríamos seguir gravando 10,11,50,54,60M,60A,60I.... Todos os outros registros permanecem assim menos o grupo do 60. Você tem que gravar o Mestre (60M) e todos os registros ligados a ele do dia/eqpto. Vou te mandar um arquivo TXT validado.... t+ Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5
  2. Olá Yury, Essa declaração de MEMO é nova pra mim, mais veja bem eu abro os arquivos DBF e os MEMOS abrem junto sem essa declaração, o que acontece é que os dados gravados nesses memos simplesmente somem, truncam, e em alguns registros, pelo que sei o MEMO tem um certo tamanho de bloco em bytes, aí é a pargunta esse tamanho é diferente de Clipper para xHarbour, o que daria o problema nos dados ? Valeu ... Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5
  3. Olá para todos, Migrei os sistemas para xHarbour e to tendo problemas com perda de dados e o Hasse já me deu uma dica do que pode ser, mais agora surgiu outro, uso muito campo MEMO, e criei uma programa para migrar minha base em clipper para realmente o xHarbour (copy structure e depois append from nos dados) para ficar com os dados nativos do xHarbour (DBFCDX) , o problema que quando vou fazer esse procedimento, quando chega em arquivos com memo (FPT) trava e não passa se elimino o campo MEMO, o arquivo processa normalmente, alguém conhece algum utilitário para converter a minha base sem perder os dados no MEMO, pois vou precisar para usar também em clientes. valeu t+ Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5
  4. Olá para todos, Migrei os sistemas para xHarbour e to tendo problemas com perda de dados e o Hasse já me deu uma dica do que pode ser, mais agora surgiu outro, uso muito campo MEMO, e criei uma programa para migrar minha base em clipper para realmente o xHarbour (copy structure e depois append from nos dados) para ficar com os dados nativos do xHarbour (DBFCDX) , o problema que quando vou fazer esse procedimento, quando chega em arquivos com memo (FPT) trava e não passa se elimino o campo MEMO, o arquivo processa normalmente, alguém conhece algum utilitário para converter a minha base sem perder os dados no MEMO, pois vou precisar para usar também em clientes. valeu t+ Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5
  5. Ola, Sim houve mudança no layout 2009, antes voce gravava todos registros 60M, 60A, 60I, 60R...., agora você tem que gravar na sequencia: 60M, o 60A dele, o 60I dele, o 60R e assim sucessivamente,para cada dia, finalizou todos os 60 do dia/eqpto você volta e pega o proximo 60M e começa tudo de novo.... t+ Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5
  6. Olá, Para a leitura e a gravação de dados em arquivos criei funções para automatizar esse processo para não ter que informar os campos que darei o replace ou mesmo criar as variáveis de memória. Será que o problema que estou tendo pode ser pela maneira que faço isso. Uso as mesmas funções em clipper e nunca deram problema, mais o problema n"ao está so na gravação dos dados, mais também na hora de mostrar os dados na tela (say, get) após ler a tabela. As funções que uso são : ************************************************ * Funcoes de Usuario p/Operacoes com Variaveis * ************************************************ function CRIA_VAR() *************************************** * Cria Variaveis baseado no arquivo da área atual, verifico * quantos campos tem, e faço laço jogando cada campo para a * memoria com contéudo correspondente vazio com prefixo "V" * Ex: CLIENTE -> vCLIENTE = space(40) * DT_NASC -> vDT_NASC = ctod(""") *************************************** A=fcount() for X=1 to A if type(field(X))<>"M" NOMECAMPO=field(X) NOMEVAR="v"+NOMECAMPO publi &NOMEVAR do case case type(field(X))="C" &NOMEVAR=spac(len(&NOMECAMPO)) case type(field(X))="N" &NOMEVAR=0 case type(field(X))="D" &NOMEVAR=ctod("") case type(field(X))="L" &NOMEVAR=.F. endcase endif next return(.t.) function IGUAL_VAR() *************************** * Iguala Variaveis baseado no arquivo da área atual, * verifico quantos campos tem, e faço laço jogando cada * campo para a memoria com contéudo correspondente do campo * com prefixo "V" * Ex: CLIENTE -> vCLIENTE = CLIENTE * DT_NASC -> vDT_NASC = DT_NASC *************************** A=fcount() for X=1 to A if type(field(X))<>"M" NOMECAMPO=fieldname(X) NOMEVAR="v"+NOMECAMPO public &NOMEVAR &NOMEVAR=&NOMECAMPO endif next return(.t.) function REPL_VAR() **************************** * Grava no arquivo as variaveis que estão na memória com o * mesmo nome do campo com o prefixo "V" **************************** A=fcount() for X=1 to A if type(field(X))<>"M" NOMECAMPO=field(X) NOMEVAR ="v"+NOMECAMPO if type("&NOMEVAR")<>"U".and.&NOMEVAR<>&NOMECAMPO repl &NOMECAMPO with &NOMEVAR endif endif next return(.t.) id=code>id=code>Será que existe alguma incompatibilidade com xHarbour ??? Valeu T+ Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5
  7. Olá, Criei um programa para pegar cada arquivo do meu sistema e executar um COPY STRUCTURE e depois nele executar um APPEND FROM para recriar as tabelas dentro do xHARBOUR e se tiver problema de cabecalho ou coisa parecida recuperar. Se alguem tiver outra idéia por favor podem dizer, vou tentar tudo. AT+ Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5
  8. Ola, É meu jovem estou batendo cabeça nesse problema e a única coisa que concluo é que pode ser o programa que uso para manutenção da base, e a transferência das bases de uma versão em clipper para xHabour. Já to pensando em migrar para SQL usando a SQLLib parece uma ótima solução. t+ Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5
  9. Olá, Acho que o que está acontecendo, é o seguinte, hoje uso o programa BroPlus 2.51 do Peter Volz para manutenção das bases de dados, so que é DOS, e manipula os arquivos CDX do fox. Na versà o clipper uso o SIXCDX e a versão que tenho do Bro, tem esse drive na tela mais não esta disponível, e continuo usando o mesmo programa para Clipper, e xHarbour que volto a usar as mesmas bases com DBFCDX e que não são as mesmas do fox. Gostaria de saber que ferramenta posso usar fácil como o Bro para manter a base de dados nessas plataformas, pois acho que estou tendo problema no cabecalho dos arquivos, ou mesmo nos arquivos de MEMO. t+ Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5
  10. Olá Tião, Nesse trecho do código, ele busca o último código do arquivo em uso, nesse ponto a busca sempre retorna .T. por isso não testo. Hoje tenho as duas versões em clipper e xHarbour se preciso alterar a estrutura das tabelas altero na versão clipper e depois copio essas tabelas para a pasta do xHarbour, só que em clipper uso o SIXCDX e no xHARBOUR uso o DBFCDX (nativo) será que não gera incompatibilidade na gravação dos dados ??? Principalmente nas tabelas com MEMO (FPT)?. Estou tendo problema também na perda de dados na gravação de clientes (são 147 campos no arquivo). To frito, preciso colocar o sistema em produção confiável para eu parar de mexer com clipper. T+ Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5
  11. Olá Tião, Essa funçà o reglock() com o parâmetro .f., não deixa o usuário abandonar o registro enquanto não estiver travado, internamente ela mostra a mensagem de que o usuario X, a maquina Y está travando aquele registro, então não seria ali o problema. Outra coisa você coloca o dbcommit() DEPOIS do unlock ??? Sempre coloco antes será que faz diferença ? Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5
  12. Olá Tião, Nesse trecho bloqueio o registro e atualizo o valor do lançamento do novo com o valor que foi recebido. O problema não esta so no valor recebido que fica ZERO. Tenhos outros campos que sinalizam o recebimento. Para considerar uma conta recebida, preciso que os campos BANCO, CHEQUE, VALOR_REC, DATA_REC, COD_REC1, VLR_REC1 estejam preenchidos e nesse caso TODOS ficam em zerados, so que no mesmo registro tenho dados da gravacao do registro que gravo com a função AuditAlt(procname()) nela gravo Data, Maquina, Hora, Usuario e rotina que alterou o registro e os dados são atualizados normalmente. Vou testar o que o amigo falou sobre o CdxLock. t+ Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5
  13. Olá Tião, Na realidade trabalho com 3 versões do mesmo programa, a que está em produção em clipper, a Beta em xHarbour 1.0.0 simplex e a que estou brincando com FWH 9.4 usando a 1.2.1 A que está apresentando problema é com 1.0.0, e os indices foram recriados sim, será que muda alguma coisa na estutura dos DBFs ??? Pois qualquer alteração que faço na versão clipper copio os DBF para a versão xHarbour e indexo novamente. Outra coisa uso indices com TAG. t+ Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04
  14. Olá, Tenho programa em produção em Clipper 5.2e e migrei para xHarbour 1.0.0 Simplex e agora to com 1.2.1 Simplex, as mesmas rotinas estão rodando em clipper e em xHarbour, ou seja os dois programas estão em produção em versões diferentes, o problema esta na versão xHarbour a mesma rotina de gravação de dados que funciona sem problemas a 12 anos, de vez em quando simplesmente não funciona. O problema acontece na baixa de contas a receber (rotina besta) que simplesmente não baixa 1 conta entre 50 em um dia por exemplo, e a mesma rotina funciona sem problema em outros cliente com clipper. Na clipper uso DBFSIX e na xHARBOUR DBFCDX alguém sabe de algum problema na atualizaçà o no xHarbour, ja coloquei inclusive o dbcommit() apos cada grupo de replace e não no final do processo, mais não resolveu. A rotina que uso está abaixo : T+ funct BAIXA_CR ************************************** * PROGRAMA : BAIXA_CR.PRG * FINALIDADE : Baixar CONTAS a RECEBER ************************************** private CUR_ANT := setcolor(),; RecFiscal := ResultAlert:= Autentica := 0,; vLANCA_CX :=vLANCA_MB:=' ',; RespBaixa := RespBX:= 0 if !p_ImpFiscal(.t.) return(.f.) endif do while .t. set key -11 to VEXTCLI() LigaF9() vJUROS=0 set colo to sele RECEBER cria_var() ARQUIVO=dbf() PRG='Recbto Credito' scroll(03,00,22,79,00) menus('06','00','19','79','') informa('Contas Receber','PRG',06,19) @ 19,30 say ' =Consulta ' set inte on limpa(24) *** Ativa a busca de CR *** if !BuscaCR() exit endif *** verifica se o cliente esta bloqueado *** CUR_ANT=setcolor() if cadcli->BLOQ .and. !'CICO'$upper(FUNDO) .and. !'IVEL'$upper(FUNDO) save scree to TBL mensagem('Cliente com restricoes, COMUNIQUE A GERENCIA...') CMEMO = cadcli->MEMO menus('08','05','20','75',' Informacoes Bloqueio ') @ 22,04 say 'Ã=FIM Þ' memoedit(CMEMO,09,06,19,74,.f.,'FUNCMEMO',100) resto scree from TBL setcolor(CUR_ANT) endif sele RECEBER igual_var() vVLR_ARCo := VALOR_ARC vVLR_RECo := VALOR_REC mCOD_VEND := COD_VEND mCOD_CONTA:= COD_CONTA mCUSTEIO := CUSTEIO mD := D mDATA_CAD := DATA_CAD *** Calcula Juros + Multa se esta vencida e estourou o prazo de carencia *** vTOT_JUR := vTOT_DESC := 0 DIAS := date() - DATA_VENC COR_JUROS := setcolor() vCUSTEIO := vCUSTEIO+vD @ 12,02 say ' Data Cadastro Äþ' get vDATA_CAD @ 13,02 say 'Data Vencimento Äþ' get vDATA_VENC @ 14,02 say ' Vlr Receber R$ Äþ' get vVALOR_ARC pict '@E 9,999,999.99' @ 15,02 say ' Historico Äþ' get vHIST @ 15,60 say 'Origem Äþ' get vNROVENDA @ 16,02 say ' Local Cobranca Äþ' get vLOCAL @ 17,02 say 'Centro de Custo Äþ' get vCUSTEIO p_cencusto(vCUSTEIO,.t.) if mCOD_VEND>0 @ 18,02 say ' Vendedor Äþ' get mCOD_VEND pict '9999' p_vendedor(mCOD_VEND,.t.) endif clea gets limpa(24) ALTERA=.F. F10=.T. ResultAlert=0 *** Grava tela para reapresentar *** MudaTela=savescreen(06,00,19,79) if VALOR_REC>0 *** Mostra Dados do Recebimento *** *** Restaura tela subindo linhas *** restscreen(03,00,16,79,MudaTela) quadro('16','00','23','79',' Baixa Contas a Receber ' + iif( !empty(receber->DT_E_SPC) ,'(no SPC desde '+dtoc(DT_E_SPC)+')',''), VerdeAzulVerm ) DadosRec() clear gets limpa(24) centra_msg(24,'Tecle p/continuar') inkey(0) ResultAlert = MsgAlert('Conta JA foi recebida... p/retornar','Atencao',{'Retornar','Imprimir Recibo','Ver Auditoria'}) if ResultAlert=1 loop endif *** Emite Recibo de Quitacao em Impressora NAO fiscal *** if ResultAlert=2 if VALOR_REC>VALOR_ARC vTXTREC='D E B I T O J' else vTXTREC='D E B I T O ' endif do R_RECIBO with vTXTREC,'R' loop endif if ResultAlert=3 quadro('08','50','14','78',' Auditoria ', BcoAzulVerm ) limpa(24) centra_msg(24,'Tecle p/Retornar') @ 09,52 say 'Quem Baixou Äþ ' + trim(receber->QUEMBLOQ) @ 10,52 say ' Data Äþ ' + dtoc(receber->DT_BLOQ) @ 11,52 say ' Hora Äþ ' + receber->HORA_BLOQ @ 12,52 say ' Maquina Äþ ' + receber->MAQ_BLOQ @ 13,52 say ' Rotina Äþ ' + receber->ROTINA inkey(0) loop endif sele RECEBER ALTERA := .T. else centra_msg(24,'RECEBER ESTA CONTA ?') if SimNao(24)<>1 loop endif vDATA_REC := date() vVALOR_REC := vVALOR_ARC endif RespBaixa=0 if vDATA_RECVALOR_REC=0 RespBaixa=MsgAlert('Este titulo ainda NAO venceu. Considerar a baixa como pagamento antecipado do cliente ? ','Atencao',{'SIM=Recebimento Cliente','NAO=Antecipacao Titulo'}) endif if vANTEC mensagem('Este titulo teve seu recebimento antecipado no dia '+dtoc(vDATA_REC)+'...') endif vLANCA_CX:=vLANCA_MB:=' ' *** ver se lanca automatico recebimento no caixa *** if vBX_CR_CX vLANCA_CX='X' endif *** Restaura tela subindo linhas *** restscreen(03,00,16,79,MudaTela) quadro('16','00','23','79',' Baixa Contas a Receber ' + iif( !empty(receber->DT_E_SPC) ,'(no SPC desde '+dtoc(DT_E_SPC)+')',''), VerdeAzulVerm ) limpa(24) centra_msg(24,'Informe os Dados da Baixa ou p/retornar') @ 17,02 say 'TOTAL A RECEBERÄþ '+ transf(vVLR_REC1,'@E 999,999.99') *** Mostra dados do recebimento *** DadosRec() read *** Verifica se foi fornecido a forma de recebimento *** if vCOD_REC1 + vCOD_REC2 + vCOD_REC3 = 0 mensagem('Nao foi informado a Forma de Recebimento...Corrija') loop endif *** verifica N§ de Dias de Baixa Retroativa *** if (date() - vDATA_REC) > vMAX_DIAS mensagem('Atencao !!! A baixa com data retroativa esta limitada a '+str(vMAX_DIAS,2)+' dias...') loop endif *** Renomeio as variaveis para garantir gravacao *** mDATA_REC :=vDATA_REC mVALOR_REC:=vVALOR_REC mBANCO :=vBANCO mCHEQUE :=vCHEQUE mCOD_COB :=vCOD_COB mCOD_REC1 :=vCOD_REC1 mCOD_REC2 :=vCOD_REC2 mCOD_REC3 :=vCOD_REC3 mVLR_REC1 :=vVLR_REC1 mVLR_REC2 :=vVLR_REC2 mVLR_REC3 :=vVLR_REC3 confirma() if CONF<>'S' .or.lastkey()=27 loop endif sele RECEBER DbSetOrder(2) seek mCOD_CONTA if vCHEQUE=0 .and. !ALTERA mensagem('NAO posso realizar baixa, numero CHEQUE=ZERO...') loop endif *** verifica se foi solicitado para baixar no caixa e se caixa esta fechado *** if vLANCA_CX='X' .and. CloseCX(vDATA_REC,vCUSTEIO,vD) .or. ; setup->BX_CR_CX .and. CloseCX(vDATA_REC,vCUSTEIO,vD) loop endif if vLANCA_MB='X' do while .t. limpa(24) centra_msg(24,'DIGITE OS DADOS DA CONTA A SER FEITO O CREDITO') setcolor('B/W+') @ 17,12 to 22,69 double @ 22,12 say 'Ê' @ 22,69 say 'Ê' scroll(18,13,21,68,00) setcolor('N/BG') centra_msg(17,' DADOS DO LANCAMENTO BANCARIO ') @ 19,15 say 'Dt Lancto Banco Agencia Conta Valor Lancto' set colo to vAGENCIA :=vCONTABCO:=0 vDATA_MOV:=date() vVALOR :=vVALOR_REC @ 20,14 get vDATA_MOV @ 20,col()+3 get vBANCO pict '999' valid(vBANCO>0) @ 20,col()+5 get vAGENCIA pict '99999' valid(vAGENCIA>0) @ 20,col()+3 get vCONTABCO pict '999999999-9' valid(vCONTABCO>0) @ 20,col()+1 get vVALOR pict '99999999.99' valid(vVALOR>0) read sele CADBANCO loca for vBANCO=BANCO.and.vAGENCIA=AGENCIA.and.vCONTABCO=CONTA if eof() mensagem('Banco NAO cadastrado...') LANCAR='N' else confirma() if CONF<>'S'.or.lastkey()=27 loop endif reglock(.f.) repla SALDO with SALDO + vVALOR *** Auditoria de alteracao *** AuditAlt(procname()) DbCommit() DbUnlock() exit endif enddo *** verifica se foi solicitado para baixar no banco e se caixa movimento esta fechado *** if vLANCA_MB='X' .and. !CloseCB(vDATA_MOV,vBANCO,vAGENCIA,vCONTABCO) loop endif endif CAD_DIF:=' ' CAD_JUR:='N' do case case vVALOR_REC < vVALOR_ARC + vTOT_JUR - vTOT_DESC .and. vVALOR_REC > 0 .and. vCJUR_DIF *** Cadastramento da Diferenca caso o recebimento esteja menor que o valor *** *** a receber + juros ou ainda se o valor principal nao foi recebido RespBX = MsgAlert('ATENCAO !!! O Valor Recebido esta Menor que o Valor a Receber+Juros...','Atencao',{'Retornar','Cadastrar Diferenca ','Baixar com Desconto'}) do case case RespBX = 1 loop case RespBX = 2 *** Cadastra a Diferenca da Conta *** RespRec = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '}) CAD_DIF='S' if RespRec = 2 do R_RECIBO with 'P A R C I A L ','R' endif case RespBX = 3 if !'CARTAO ' $ upper(cadcli->CLIENTE) *** Atualiza a auditoria de baixas com diferenca *** vDIFERENCA = (vVALOR_ARC + vTOT_JUR - vTOT_DESC) - vVALOR_REC *** Grava LOG de auditoria *** vHISTORICO = 'DESC.CR-' + vCOD_CONTA+'-'+str(vCOD_CLI,5)+'-'+left(cadcli->CLIENTE,30)+'-'+vTIPO_DOC+' '+str(vNUM_DOC,7)+'-'+transf(vDIFERENCA,'@E 99,999.99')+vD auditoria(vHISTORICO) RespRec = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '}) if RespRec = 2 do R_RECIBO with 'D E B I T O D','R' endif endif endcase case vVALOR_REC < vVALOR_ARC - vTOT_DESC .and. vVALOR_REC > 0 .and. !vCJUR_DIF *** Cadastramento da Diferenca SEM considerar os juros *** RespBX = MsgAlert('ATENCAO !!! O Valor Recebido esta Menor que o Valor a Receber...','Atencao',{'Retornar','Cadastrar Diferenca ','Baixar com Desconto'}) do case case RespBX = 1 loop case RespBX = 2 *** Cadastra a Diferenca da Conta *** RespRec = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '}) CAD_DIF='S' if RespRec = 2 do R_RECIBO with 'P A R C I A L ','R' endif case RespBX = 3 *** Atualiza a auditoria de baixas com diferenca *** vDIFERENCA = (vVALOR_ARC + vTOT_JUR - vTOT_DESC) - vVALOR_REC *** Grava LOG de auditoria *** vHISTORICO = 'DESC.CR-' + vCOD_CONTA+'-'+str(vCOD_CLI,5)+'-'+left(cadcli->CLIENTE,30)+'-'+vTIPO_DOC+' '+str(vNUM_DOC,7)+'-'+transf(vDIFERENCA,'@E 99,999.99')+vD auditoria(vHISTORICO) RespRec = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '}) if RespRec = 2 do R_RECIBO with 'D E B I T O D','R' endif endcase case vVALOR_REC>vVALOR_ARC .and. vCONTABIL .and. !setup->JUROS_SEP *** Lancamento de Juros em Conta Separada *** CAD_JUR=' ' if empty(setup->CONTAJURR) mensagem('ATENCAO !!! Valor Recebido MAIOR que o Valor a Receber...') limpa(24) @ 24,15 say 'Cadastrar Juros em Conta Separada ? (S/N) ' get CAD_JUR pict '!' valid(CAD_JUR$'SN') read vCONTA_JUR=vCONTA if CAD_JUR='S' menus('11','10','13','70',' Lancto de Juros ') @ 12,12 say 'Conta Äþ' get vCONTA_JUR pict (vMASC_CONT) valid(p_plano(vCONTA_JUR,.t.,'C')) read vJUROS = vVALOR_REC - vVLR_ARCo vVALOR_REC = vVLR_ARCo endif else *** Se realmente for uma conta *** if left(setup->CONTAJURR,3)<>'999' CAD_JUR = 'S' vCONTA_JUR = setup->CONTAJURR vJUROS = vVALOR_REC - vVLR_ARCo vVALOR_REC = vVLR_ARCo endif endif RespRec = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '}) if RespRec = 2 do R_RECIBO with 'C/ J U R O S J','R' endif other *** Conta Baixada normalmente pode emitir recibo de quitacao *** RespRec = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '}) if RespRec = 2 do R_RECIBO with 'D E B I T O ','R' endif endcase *** se tiver impressora autenticadora configurada *** if 'AUTENTIC' $ upper(fiscal->IDESTOT1) Autenticou=.f. CONT=1 do while .t. *** permite a autenticacao do Documento *** Autentica := MsgAlert('Autenticar este Recebimento ? ','Atencao',{' Sim Autenticar DP ',' Sair e Autenticar Fita '}) if Autentica =1 .and. lastkey()<>27 Autenticou=.t. set devi to print set print on ?? chr(15) @ prow(),00 say 'D:'+dtoc(date())+':'+left(time(),5)+':'+receber->COD_CONTA+':'+transf(vVALOR_REC,'@E ***,***.**')+':'+strzero(CONT,2) @ prow(),00 say '' set print to xPrinter set print off set devi to scree CONT++ loop endif exit enddo if Autenticou set devi to print set print on ?? chr(15) @ prow()+1,00 say 'F:'+dtoc(date())+':'+left(time(),5)+':'+receber->COD_CONTA+':'+transf(vVALOR_REC,'@E ***,***.**') @ prow() ,00 say '' set print to xPrinter set print off set devi to scree endif endif if empty(vBANCO).and.empty(vCHEQUE) vDATA_REC :=ctod('') vVALOR_REC:=vCOD_COB:=0 vCOD_REC1 :=vCOD_REC2:=vCOD_REC3:=0 vVLR_REC1 :=vVLR_REC2:=vVLR_REC3:=0 endif *** Baixa Lancamento *** sele RECEBER DbSetOrder(2) seek mCOD_CONTA reglock(.f.) if RespBaixa=2 vANTEC=.T. endif *** Grava data do recebimento p/retirada do SPC if !empty(receber->DT_E_SPC) vDT_R_SPC = vDATA_REC endif *** devido a conta do banco *** vENVIADO := .f. vDATA_CAD := mDATA_CAD vCUSTEIO := mCUSTEIO vD := mD vDATA_REC := mDATA_REC vVALOR_REC:= mVALOR_REC vBANCO := mBANCO vCHEQUE := mCHEQUE vCOD_COB := mCOD_COB vCOD_REC1 := mCOD_REC1 vCOD_REC2 := mCOD_REC2 vCOD_REC3 := mCOD_REC3 vVLR_REC1 := mVLR_REC1 vVLR_REC2 := mVLR_REC2 vVLR_REC3 := mVLR_REC3 if 'MINERACAO' $ upper(NEMPRESA) vDATA_CONT = vDATA_REC endif repl_var() *** Auditoria de alteracao *** AuditAlt(procname()) DbCommit() DbUnlock() *** Lanca credito no movimento bancario *** if vLANCA_MB='X' sele MOVBANCO DbSetOrder(0) adireg(.f.) vHIST = 'Rec '+left(cadcli->CLIENTE,14)+'-'+vCOD_CONTA+'-'+receber->TIPO_DOC+' '+transf(receber->NUM_DOC,'9999999')+'-P:'+receber->PARC+'-Vcto '+dtoc(receber->DATA_VENC) *** Verifica se sistema esta configurado para baixar conta em outro caixa *** vCCDestBX = vCUSTEIO+vD if !empty(setup->CCBXCR) .and. setup->CCBXCR>'00' .and. setup->CCBXCR<'99' vCCDestBX = setup->CCBXCR endif repl movbanco->BANCO with vBANCO , movbanco->AGENCIA with vAGENCIA ,; movbanco->CONTA with vCONTABCO, movbanco->NUM_DOC with vCHEQUE ,; movbanco->CUSTEIO with vCCDestBX, movbanco->HIST with vHIST ,; movbanco->DATA_MOV with vDATA_MOV, movbanco->VALOR with vVALOR ,; movbanco->DEB_CRED with 'C' , movbanco->COD_CONTA with vCOD_CONTA,; movbanco->NROVENDA with 'R'+vCOD_CONTA *** Auditoria de alteracao *** AuditAlt(procname()) DbCommit() DbUnlock() endif *** verifica em quantos pagamentos *** RECEBTOS:=CONTADOR:=1 do case case vVLR_REC1>0.and.vVLR_REC2>0.and.vVLR_REC3>0 RECEBTOS=3 case vVLR_REC1>0.and.vVLR_REC2>0 RECEBTOS=2 case vVLR_REC1>0 RECEBTOS=1 endcase *** ver se lanca automatico recebimento no caixa *** if vBX_CR_CX vLANCA_CX='X' if 'NAOBXCX' $ vSACCESS if MsgAlert('Atencao !!! '+alltrim(vUSUARIO)+' o sistema esta configurado '+; 'para Lancamento Automatico de Recebimento no caixa, e seu nivel '+; 'de acesso permite NAO lancar o recebimento desta conta. '+; 'Lancar no caixa ? ',' Recebimento de Conta ',{' Sim ',' Nao '})=2 vLANCA_CX=' ' endif endif endif *** Lanca no Movimento de Caixa as Parcelas *** if vLANCA_CX='X' do while CONTADOR <= RECEBTOS sele MOVCX ARQCX=dbf() sele ARQUIVOS seek ARQCX reglock(.f.) repla ULT_COD with ULT_COD+1 dbcommit() vREG_CX=ULT_COD dbunlock() VALOR_REC = 'vVLR_REC'-ltrim(str(CONTADOR)) FORMA_REC = 'vCOD_REC'-ltrim(str(CONTADOR)) sele MOVCX set orde to 0 adireg(.f.) vHISTORICO ='Rec '+left(cadcli->CLIENTE,14)+'-'+vCOD_CONTA+'-'+vTIPO_DOC+'-'+str(vNUM_DOC,7)+'-Vc '+dtoc(vDATA_VENC) if vJUROS>0 vHISTORICO='Cred.Conta+Juros '+vCOD_CONTA+'-'+vTIPO_DOC+'-'+str(vNUM_DOC,7)+'-'+left(cadcli->CLIENTE,14) endif *** Verifica se sistema esta configurado para baixar conta em outro caixa *** vCCDestBX = vCUSTEIO+vD if !empty(setup->CCBXCR) .and. setup->CCBXCR>'00' .and. setup->CCBXCR<'99' vCCDestBX = setup->CCBXCR endif if vDATA_REC>date() vDATA_REC=date() endif repla movcx->REGISTRO with vREG_CX , movcx->DATA with vDATA_REC,; movcx->HISTORICO with vHISTORICO, movcx->DEB_CRED with 'C' ,; movcx->VALOR with &VALOR_REC, movcx->CUSTEIO with vCCDestBX,; movcx->D with vD , movcx->DT_BLOQ with date() ,; movcx->COD_PAG with &FORMA_REC, movcx->NROVENDA with 'R'+vCOD_CONTA,; movcx->HORA with time() , movcx->USER with vUSUARIO *** Auditoria de alteracao *** AuditAlt(procname()) CONTADOR++ dbcommit() dbunlock() enddo endif sele RECEBER vCONTA_ANT := COD_CONTA if CAD_DIF='S' .and. vVALOR_REC < vVALOR_ARC + vTOT_JUR - vTOT_DESC .and. vVALOR_REC > 0 vVALOR_ANT := vVALOR_ARC *** calculo o valor dos juros sobre o valor total se tiver vencida *** if vDATA_REC > vDATA_VENC .and. vCJUR_DIF vJUR_PARC := DIAS * ((JUR_DIA/100) * vVALOR_ARC ) vMULTA_PARC:= vVALOR_ARC * (MULTA/100) vVALOR_ARC := vVALOR_ARC + vJUR_PARC + vMULTA_PARC if !'TOURIS' $ upper(NEMPRESA) vDATA_VENC := vDATA_REC endif endif vVALOR_ARC := vVALOR_ARC - vVALOR_REC reglock(.f.) repla VALOR_ARC with vVALOR_REC *** Auditoria de alteracao *** AuditAlt(procname()) DbCommit() DbUnlock() sele ARQUIVOS seek ARQUIVO reglock(.f.) repl ULT_COD with ULT_COD+1 dbcommit() dbunlock() vCOD_CONTA = strzero(ULT_COD,6) sele RECEBER set orde to 0 adireg(.f.) if vTOT_JUR > 0 .and. vCJUR_DIF *** caso o sistema calcule os juros dos valores pagos, para que NAO recalcule *** sobre o saldo que ficou JA com juros, troca-se a data de vencimento *** original pela data do pagamento e passa-se a corrigir novamente set centu off vHIST := 'Sld+'+str(DIAS,3)+' DD Juros ' + vCONTA_ANT+'-Vc'+dtoc(vDATA_VENC) set centu on else vHIST := 'Diferenca Conta ' + vCONTA_ANT endif vCOD_VEND := mCOD_VEND *** Registro da diferenca *** vMULTA := 0 // Zero a multa pois ja foi cobrada na diferenca vVALOR_REC := vBANCO := vCHEQUE := 0 vCOD_COB := vCOD_REC1 := vCOD_REC2 := vCOD_REC3 := 0 vVLR_REC1 := vVLR_REC2 := vVLR_REC3 := 0 vANTEC :=.f. vDATA_REC := ctod('') vCUSTEIO := mCUSTEIO vD := mD vDATA_CAD := date() repl_var() *** Auditoria de alteracao *** AuditAlt(procname()) dbcommit() unlock endif *** Lancamento de JUROS em CONTA especifica *** if CAD_JUR='S' .and. vJUROS>0 .and. vCONTABIL sele ARQUIVOS seek ARQUIVO reglock(.f.) repl ULT_COD with ULT_COD+1 dbcommit() dbunlock() vCOD_CONTA = strzero(ULT_COD,6) sele RECEBER DbSEtOrder(0) adireg(.f.) vHIST = 'Juros Conta '+vCONTA_ANT vDATA_CAD = date() vVALOR_ARC = vJUROS vVALOR_REC = vJUROS vVLR_REC1 = vJUROS vVLR_REC2 = 0 vVLR_REC3 = 0 vCOD_VEND = mCOD_VEND vCONTA = vCONTA_JUR vCUSTEIO = mCUSTEIO vD = mD repl_var() *** Alteracao de Auditoria *** AuditAlt(procname()) dbcommit() dbunlock() endif *** Marca como lancamento de rateio *** vVLR_ORI=vVALOR_ARC vORIGEM ='R'+vCOD_CONTA sele RATEIO set orde to 1 seek vORIGEM do while !eof() .and. vORIGEM=ORIGEM reglock(.t.) repla DATA_BX with vDATA_REC, ENVIADO with .f. dbcommit() unlock skip enddo enddo *** auditoria de alteracao *** set key -40 to Return(nil) funct BuscaCR() ********************************************************* * Realiza a busca de CR pelo Codigo,Boleto,Cliente,etc... * Usada para CANC_CR e BAIXA_CR ********************************************************* do while .t. set key -39 to VerBloqueio && Alt+F10 centra_msg(24,'DIGITE O CODIGO DA CONTA ou P/RETORNAR') vCOD_CONTA=0 @ 07,02 say 'Codigo da Conta Äþ' get vCOD_CONTA pict '999999' @ 07,40 say 'Nosso Numero Boleto Äþ' get vNROBANCO when(empty(vCOD_CONTA)) @ 08,02 say ' Codigo Cliente Äþ' get vCOD_CLI pict '99999' when(empty(vCOD_CONTA).and.empty(vNROBANCO)) valid(iif(!empty(vCOD_CLI), p_cliente(vCOD_CLI,.t.),.t.)) @ 09,02 say ' Tipo do Docto Äþ' get vTIPO_DOC pict '!!' when(empty(vCOD_CONTA).and.empty(vNROBANCO)) @ 10,02 say ' N§ Documento Äþ' get vNUM_DOC pict '9999999' when(empty(vCOD_CONTA).and.empty(vNROBANCO)) @ 11,02 say ' Parcela Äþ' get vPARC pict '99/99' when(empty(vCOD_CONTA).and.empty(vNROBANCO)) read if lastkey()=27 return(.f.) endif set key -39 to && Alt+F10 mCOD_CONTA=vCOD_CONTA set key -11 to Desl_efes() sele RECEBER do case case !empty(mCOD_CONTA) mCOD_CONTA=strzero(mCOD_CONTA,6) @ 07,21 say mCOD_CONTA DbSetOrder(2) seek mCOD_CONTA case !empty(vNROBANCO) DbSetOrder(8) seek vNROBANCO other DbSetOrder(6) seek str(vCOD_CLI,5)+vTIPO_DOC+str(vNUM_DOC,7)+vPARC endcase if eof() mensagem('Conta NAO cadastrada...') loop endif igual_var() @ 07,02 say 'Codigo da Conta Äþ' get vCOD_CONTA pict '999999' @ 07,40 say 'Nosso Numero Boleto Äþ' get vNROBANCO @ 08,02 say ' Codigo Cliente Äþ' get vCOD_CLI pict '99999' p_cliente(vCOD_CLI,.t.) @ 09,02 say ' Tipo do Docto Äþ' get vTIPO_DOC pict '!!' @ 10,02 say ' N§ Documento Äþ' get vNUM_DOC pict '9999999' @ 11,02 say ' Parcela Äþ' get vPARC pict '99/99' exit enddo return(.t.) funct DadosRec() ***************************************** * Apresenta dados do recebimento da conta ***************************************** @ 18,02 say ' Dt Recbto Äþ' get vDATA_REC valid(Juros_fut()) when(Juros_fut()) @ 18,col()+10 say 'N§ Banco Äþ' get vBANCO pict '999' when(mens_campo('1=dinheiro ou o numero do banco')) @ 18,col()+6 say 'N§ Docto Äþ' get vCHEQUE pict '9999999' when(mens_campo('1=dinheiro ou o numero do documento')) @ 19,02 say 'Vlr Recbdo Äþ' get vVLR_REC1 pict '99999999.99' valid(calcula_rec(vVLR_REC1,vVLR_REC2,vVLR_REC3,17,40)) when(mens_campo('o valor recebido')) @ 19,col()+5 say 'Forma Recbto Äþ' get vCOD_REC1 pict '99' valid(p_formapag(vCOD_REC1,.T.) .and. RecTEF(vVLR_REC1)) when(mens_campo('a forma de recebimento')) @ 20,02 say 'Vlr Recbdo Äþ' get vVLR_REC2 pict '99999999.99' valid(calcula_rec(vVLR_REC1,vVLR_REC2,vVLR_REC3,17,40)) when(vVLR_REC1>0 .and. mens_campo('o valor recebido')) @ 20,col()+5 say 'Forma Recbto Äþ' get vCOD_REC2 pict '99' valid(p_formapag(vCOD_REC2,.T.) .and. RecTEF(vVLR_REC2)) when(vVLR_REC2>0 .and. mens_campo('a forma de recebimento')) @ 21,02 say 'Vlr Recbdo Äþ' get vVLR_REC3 pict '99999999.99' valid(calcula_rec(vVLR_REC1,vVLR_REC2,vVLR_REC3,17,40)) when(vVLR_REC2>0 .and. mens_campo('o valor recebido')) @ 21,col()+5 say 'Forma Recbto Äþ' get vCOD_REC3 pict '99' valid(p_formapag(vCOD_REC3,.T.) .and. RecTEF(vVLR_REC3)) when(vVLR_REC3>0 .and. mens_campo('a forma de recebimento')) @ 22,02 say ' Cobrador Äþ' get vCOD_COB pict '99' valid(iif(vCOD_COB>0,p_cobrador(vCOD_COB,.t.),.t.)) when(mens_campo('o codigo do cobrador ou p/nhenhum')) @ 22,col()+16 say ' Lancar CX Äþ' get vLANCA_CX pict '!' valid(vLANCA_CX$' X') when(mens_campo('X se for para lancar para o CAIXA ou p/NAO lancar')) @ 22,col()+4 say ' Lancar MB Äþ' get vLANCA_MB pict '!' valid(vLANCA_MB$' X') when(mens_campo('X se for para lancar para o MOVIMENTO BANCARIO ou p/NAO lancar')) @ 23,02 say 'Observacao Äþ' get vOBS return(.t.) func CALCULA_REC(vVLR_REC1,vVLR_REC2,vVLR_REC3,LL,CC) ***************************************************************** * Funcao para somar as parcelas e atualiza o valor recebido do CR ***************************************************************** vVALOR_REC = vVLR_REC1 + vVLR_REC2 + vVLR_REC3 @ LL,CC say 'VALOR RECEBIDO Äþ' +transf(vVALOR_REC,'@E 9,999,999.99') return(.t.) func JUROS_FUT ************************************** * Calcular Juros para pagamento futuro ************************************** vTOT_JUR := vTOT_DESC := 0 if vDATA_REC>=vDATA_VENC DIAS = vDATA_REC - vDATA_VENC COR_FUT = setcolor() vTOT_JUR = DIAS * ((JUR_DIA/100) * vVALOR_ARC) && Multiplica n§ dias com a taxa vezes o valor VLR_MULTA = (MULTA/100) * vVALOR_ARC if TJ='V' vTOT_JUR = DIAS * JUR_DIA && Se os Juros da Conta for VALOR, Multiplica pelos n§ dias endif if (vDATA_REC - vDATA_VENC) > vCARENCIA vTOT_JUR = vTOT_JUR + VLR_MULTA else vTOT_JUR = 0 endif setcolor(COR_JUROS) @ 12,40 say ' Juros+Multa R$ Äþ ' + transf( vTOT_JUR , '@E 9,999,999.99') else DIAS = vDATA_VENC - vDATA_REC COR_FUT = setcolor() vTOT_DESC := DIAS * ((vP_DESC/100) * vVALOR_ARC) setcolor(COR_JUROS) @ 12,40 say ' Desconto R$ Äþ ' + transf( vTOT_DESC, '@E 9,999,999.99') endif vVLR_REC1 := vVALOR_ARC + vTOT_JUR - vTOT_DESC setcolor(COR_FUT) @ 17,02 say 'TOTAL A RECEBERÄþ ' + transf(vVALOR_ARC + vTOT_JUR - vTOT_DESC,'@E 999,999.99') return(.t.)
  15. Olá, Tenho programa em produção em Clipper 5.2e e migrei para xHarbour 1.0.0 Simplex e agora to com 1.2.1 Simplex, as mesmas rotinas estão rodando em clipper e em xHarbour, ou seja os dois programas estão em produção em versões diferentes, o problema esta na versão xHarbour a mesma rotina de gravação de dados que funciona sem problemas a 12 anos, de vez em quando simplesmente não funciona. O problema acontece na baixa de contas a receber (rotina besta) que simplesmente não baixa 1 conta entre 50 em um dia por exemplo, e a mesma rotina funciona sem problema em outros cliente com clipper. Na clipper uso DBFSIX e na xHARBOUR DBFCDX alguém sabe de algum problema na atualizaçà o no xHarbour, ja coloquei inclusive o dbcommit() apos cada grupo de replace e não no final do processo, mais não resolveu. A rotina que uso está abaixo : T+ funct BAIXA_CR ************************************** * PROGRAMA : BAIXA_CR.PRG * FINALIDADE : Baixar CONTAS a RECEBER ************************************** private CUR_ANT := setcolor(),; RecFiscal := ResultAlert:= Autentica := 0,; vLANCA_CX :=vLANCA_MB:=' ',; RespBaixa := RespBX:= 0 if !p_ImpFiscal(.t.) return(.f.) endif do while .t. set key -11 to VEXTCLI() LigaF9() vJUROS=0 set colo to sele RECEBER cria_var() ARQUIVO=dbf() PRG='Recbto Credito' scroll(03,00,22,79,00) menus('06','00','19','79','') informa('Contas Receber','PRG',06,19) @ 19,30 say ' =Consulta ' set inte on limpa(24) *** Ativa a busca de CR *** if !BuscaCR() exit endif *** verifica se o cliente esta bloqueado *** CUR_ANT=setcolor() if cadcli->BLOQ .and. !'CICO'$upper(FUNDO) .and. !'IVEL'$upper(FUNDO) save scree to TBL mensagem('Cliente com restricoes, COMUNIQUE A GERENCIA...') CMEMO = cadcli->MEMO menus('08','05','20','75',' Informacoes Bloqueio ') @ 22,04 say 'Ã=FIM Þ' memoedit(CMEMO,09,06,19,74,.f.,'FUNCMEMO',100) resto scree from TBL setcolor(CUR_ANT) endif sele RECEBER igual_var() vVLR_ARCo := VALOR_ARC vVLR_RECo := VALOR_REC mCOD_VEND := COD_VEND mCOD_CONTA:= COD_CONTA mCUSTEIO := CUSTEIO mD := D mDATA_CAD := DATA_CAD *** Calcula Juros + Multa se esta vencida e estourou o prazo de carencia *** vTOT_JUR := vTOT_DESC := 0 DIAS := date() - DATA_VENC COR_JUROS := setcolor() vCUSTEIO := vCUSTEIO+vD @ 12,02 say ' Data Cadastro Äþ' get vDATA_CAD @ 13,02 say 'Data Vencimento Äþ' get vDATA_VENC @ 14,02 say ' Vlr Receber R$ Äþ' get vVALOR_ARC pict '@E 9,999,999.99' @ 15,02 say ' Historico Äþ' get vHIST @ 15,60 say 'Origem Äþ' get vNROVENDA @ 16,02 say ' Local Cobranca Äþ' get vLOCAL @ 17,02 say 'Centro de Custo Äþ' get vCUSTEIO p_cencusto(vCUSTEIO,.t.) if mCOD_VEND>0 @ 18,02 say ' Vendedor Äþ' get mCOD_VEND pict '9999' p_vendedor(mCOD_VEND,.t.) endif clea gets limpa(24) ALTERA=.F. F10=.T. ResultAlert=0 *** Grava tela para reapresentar *** MudaTela=savescreen(06,00,19,79) if VALOR_REC>0 *** Mostra Dados do Recebimento *** *** Restaura tela subindo linhas *** restscreen(03,00,16,79,MudaTela) quadro('16','00','23','79',' Baixa Contas a Receber ' + iif( !empty(receber->DT_E_SPC) ,'(no SPC desde '+dtoc(DT_E_SPC)+')',''), VerdeAzulVerm ) DadosRec() clear gets limpa(24) centra_msg(24,'Tecle p/continuar') inkey(0) ResultAlert = MsgAlert('Conta JA foi recebida... p/retornar','Atencao',{'Retornar','Imprimir Recibo','Ver Auditoria'}) if ResultAlert=1 loop endif *** Emite Recibo de Quitacao em Impressora NAO fiscal *** if ResultAlert=2 if VALOR_REC>VALOR_ARC vTXTREC='D E B I T O J' else vTXTREC='D E B I T O ' endif do R_RECIBO with vTXTREC,'R' loop endif if ResultAlert=3 quadro('08','50','14','78',' Auditoria ', BcoAzulVerm ) limpa(24) centra_msg(24,'Tecle p/Retornar') @ 09,52 say 'Quem Baixou Äþ ' + trim(receber->QUEMBLOQ) @ 10,52 say ' Data Äþ ' + dtoc(receber->DT_BLOQ) @ 11,52 say ' Hora Äþ ' + receber->HORA_BLOQ @ 12,52 say ' Maquina Äþ ' + receber->MAQ_BLOQ @ 13,52 say ' Rotina Äþ ' + receber->ROTINA inkey(0) loop endif sele RECEBER ALTERA := .T. else centra_msg(24,'RECEBER ESTA CONTA ?') if SimNao(24)<>1 loop endif vDATA_REC := date() vVALOR_REC := vVALOR_ARC endif RespBaixa=0 if vDATA_RECVALOR_REC=0 RespBaixa=MsgAlert('Este titulo ainda NAO venceu. Considerar a baixa como pagamento antecipado do cliente ? ','Atencao',{'SIM=Recebimento Cliente','NAO=Antecipacao Titulo'}) endif if vANTEC mensagem('Este titulo teve seu recebimento antecipado no dia '+dtoc(vDATA_REC)+'...') endif vLANCA_CX:=vLANCA_MB:=' ' *** ver se lanca automatico recebimento no caixa *** if vBX_CR_CX vLANCA_CX='X' endif *** Restaura tela subindo linhas *** restscreen(03,00,16,79,MudaTela) quadro('16','00','23','79',' Baixa Contas a Receber ' + iif( !empty(receber->DT_E_SPC) ,'(no SPC desde '+dtoc(DT_E_SPC)+')',''), VerdeAzulVerm ) limpa(24) centra_msg(24,'Informe os Dados da Baixa ou p/retornar') @ 17,02 say 'TOTAL A RECEBERÄþ '+ transf(vVLR_REC1,'@E 999,999.99') *** Mostra dados do recebimento *** DadosRec() read *** Verifica se foi fornecido a forma de recebimento *** if vCOD_REC1 + vCOD_REC2 + vCOD_REC3 = 0 mensagem('Nao foi informado a Forma de Recebimento...Corrija') loop endif *** verifica N§ de Dias de Baixa Retroativa *** if (date() - vDATA_REC) > vMAX_DIAS mensagem('Atencao !!! A baixa com data retroativa esta limitada a '+str(vMAX_DIAS,2)+' dias...') loop endif *** Renomeio as variaveis para garantir gravacao *** mDATA_REC :=vDATA_REC mVALOR_REC:=vVALOR_REC mBANCO :=vBANCO mCHEQUE :=vCHEQUE mCOD_COB :=vCOD_COB mCOD_REC1 :=vCOD_REC1 mCOD_REC2 :=vCOD_REC2 mCOD_REC3 :=vCOD_REC3 mVLR_REC1 :=vVLR_REC1 mVLR_REC2 :=vVLR_REC2 mVLR_REC3 :=vVLR_REC3 confirma() if CONF<>'S' .or.lastkey()=27 loop endif sele RECEBER DbSetOrder(2) seek mCOD_CONTA if vCHEQUE=0 .and. !ALTERA mensagem('NAO posso realizar baixa, numero CHEQUE=ZERO...') loop endif *** verifica se foi solicitado para baixar no caixa e se caixa esta fechado *** if vLANCA_CX='X' .and. CloseCX(vDATA_REC,vCUSTEIO,vD) .or. ; setup->BX_CR_CX .and. CloseCX(vDATA_REC,vCUSTEIO,vD) loop endif if vLANCA_MB='X' do while .t. limpa(24) centra_msg(24,'DIGITE OS DADOS DA CONTA A SER FEITO O CREDITO') setcolor('B/W+') @ 17,12 to 22,69 double @ 22,12 say 'Ê' @ 22,69 say 'Ê' scroll(18,13,21,68,00) setcolor('N/BG') centra_msg(17,' DADOS DO LANCAMENTO BANCARIO ') @ 19,15 say 'Dt Lancto Banco Agencia Conta Valor Lancto' set colo to vAGENCIA :=vCONTABCO:=0 vDATA_MOV:=date() vVALOR :=vVALOR_REC @ 20,14 get vDATA_MOV @ 20,col()+3 get vBANCO pict '999' valid(vBANCO>0) @ 20,col()+5 get vAGENCIA pict '99999' valid(vAGENCIA>0) @ 20,col()+3 get vCONTABCO pict '999999999-9' valid(vCONTABCO>0) @ 20,col()+1 get vVALOR pict '99999999.99' valid(vVALOR>0) read sele CADBANCO loca for vBANCO=BANCO.and.vAGENCIA=AGENCIA.and.vCONTABCO=CONTA if eof() mensagem('Banco NAO cadastrado...') LANCAR='N' else confirma() if CONF<>'S'.or.lastkey()=27 loop endif reglock(.f.) repla SALDO with SALDO + vVALOR *** Auditoria de alteracao *** AuditAlt(procname()) DbCommit() DbUnlock() exit endif enddo *** verifica se foi solicitado para baixar no banco e se caixa movimento esta fechado *** if vLANCA_MB='X' .and. !CloseCB(vDATA_MOV,vBANCO,vAGENCIA,vCONTABCO) loop endif endif CAD_DIF:=' ' CAD_JUR:='N' do case case vVALOR_REC < vVALOR_ARC + vTOT_JUR - vTOT_DESC .and. vVALOR_REC > 0 .and. vCJUR_DIF *** Cadastramento da Diferenca caso o recebimento esteja menor que o valor *** *** a receber + juros ou ainda se o valor principal nao foi recebido RespBX = MsgAlert('ATENCAO !!! O Valor Recebido esta Menor que o Valor a Receber+Juros...','Atencao',{'Retornar','Cadastrar Diferenca ','Baixar com Desconto'}) do case case RespBX = 1 loop case RespBX = 2 *** Cadastra a Diferenca da Conta *** RespRec = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '}) CAD_DIF='S' if RespRec = 2 do R_RECIBO with 'P A R C I A L ','R' endif case RespBX = 3 if !'CARTAO ' $ upper(cadcli->CLIENTE) *** Atualiza a auditoria de baixas com diferenca *** vDIFERENCA = (vVALOR_ARC + vTOT_JUR - vTOT_DESC) - vVALOR_REC *** Grava LOG de auditoria *** vHISTORICO = 'DESC.CR-' + vCOD_CONTA+'-'+str(vCOD_CLI,5)+'-'+left(cadcli->CLIENTE,30)+'-'+vTIPO_DOC+' '+str(vNUM_DOC,7)+'-'+transf(vDIFERENCA,'@E 99,999.99')+vD auditoria(vHISTORICO) RespRec = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '}) if RespRec = 2 do R_RECIBO with 'D E B I T O D','R' endif endif endcase case vVALOR_REC < vVALOR_ARC - vTOT_DESC .and. vVALOR_REC > 0 .and. !vCJUR_DIF *** Cadastramento da Diferenca SEM considerar os juros *** RespBX = MsgAlert('ATENCAO !!! O Valor Recebido esta Menor que o Valor a Receber...','Atencao',{'Retornar','Cadastrar Diferenca ','Baixar com Desconto'}) do case case RespBX = 1 loop case RespBX = 2 *** Cadastra a Diferenca da Conta *** RespRec = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '}) CAD_DIF='S' if RespRec = 2 do R_RECIBO with 'P A R C I A L ','R' endif case RespBX = 3 *** Atualiza a auditoria de baixas com diferenca *** vDIFERENCA = (vVALOR_ARC + vTOT_JUR - vTOT_DESC) - vVALOR_REC *** Grava LOG de auditoria *** vHISTORICO = 'DESC.CR-' + vCOD_CONTA+'-'+str(vCOD_CLI,5)+'-'+left(cadcli->CLIENTE,30)+'-'+vTIPO_DOC+' '+str(vNUM_DOC,7)+'-'+transf(vDIFERENCA,'@E 99,999.99')+vD auditoria(vHISTORICO) RespRec = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '}) if RespRec = 2 do R_RECIBO with 'D E B I T O D','R' endif endcase case vVALOR_REC>vVALOR_ARC .and. vCONTABIL .and. !setup->JUROS_SEP *** Lancamento de Juros em Conta Separada *** CAD_JUR=' ' if empty(setup->CONTAJURR) mensagem('ATENCAO !!! Valor Recebido MAIOR que o Valor a Receber...') limpa(24) @ 24,15 say 'Cadastrar Juros em Conta Separada ? (S/N) ' get CAD_JUR pict '!' valid(CAD_JUR$'SN') read vCONTA_JUR=vCONTA if CAD_JUR='S' menus('11','10','13','70',' Lancto de Juros ') @ 12,12 say 'Conta Äþ' get vCONTA_JUR pict (vMASC_CONT) valid(p_plano(vCONTA_JUR,.t.,'C')) read vJUROS = vVALOR_REC - vVLR_ARCo vVALOR_REC = vVLR_ARCo endif else *** Se realmente for uma conta *** if left(setup->CONTAJURR,3)<>'999' CAD_JUR = 'S' vCONTA_JUR = setup->CONTAJURR vJUROS = vVALOR_REC - vVLR_ARCo vVALOR_REC = vVLR_ARCo endif endif RespRec = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '}) if RespRec = 2 do R_RECIBO with 'C/ J U R O S J','R' endif other *** Conta Baixada normalmente pode emitir recibo de quitacao *** RespRec = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '}) if RespRec = 2 do R_RECIBO with 'D E B I T O ','R' endif endcase *** se tiver impressora autenticadora configurada *** if 'AUTENTIC' $ upper(fiscal->IDESTOT1) Autenticou=.f. CONT=1 do while .t. *** permite a autenticacao do Documento *** Autentica := MsgAlert('Autenticar este Recebimento ? ','Atencao',{' Sim Autenticar DP ',' Sair e Autenticar Fita '}) if Autentica =1 .and. lastkey()<>27 Autenticou=.t. set devi to print set print on ?? chr(15) @ prow(),00 say 'D:'+dtoc(date())+':'+left(time(),5)+':'+receber->COD_CONTA+':'+transf(vVALOR_REC,'@E ***,***.**')+':'+strzero(CONT,2) @ prow(),00 say '' set print to xPrinter set print off set devi to scree CONT++ loop endif exit enddo if Autenticou set devi to print set print on ?? chr(15) @ prow()+1,00 say 'F:'+dtoc(date())+':'+left(time(),5)+':'+receber->COD_CONTA+':'+transf(vVALOR_REC,'@E ***,***.**') @ prow() ,00 say '' set print to xPrinter set print off set devi to scree endif endif if empty(vBANCO).and.empty(vCHEQUE) vDATA_REC :=ctod('') vVALOR_REC:=vCOD_COB:=0 vCOD_REC1 :=vCOD_REC2:=vCOD_REC3:=0 vVLR_REC1 :=vVLR_REC2:=vVLR_REC3:=0 endif *** Baixa Lancamento *** sele RECEBER DbSetOrder(2) seek mCOD_CONTA reglock(.f.) if RespBaixa=2 vANTEC=.T. endif *** Grava data do recebimento p/retirada do SPC if !empty(receber->DT_E_SPC) vDT_R_SPC = vDATA_REC endif *** devido a conta do banco *** vENVIADO := .f. vDATA_CAD := mDATA_CAD vCUSTEIO := mCUSTEIO vD := mD vDATA_REC := mDATA_REC vVALOR_REC:= mVALOR_REC vBANCO := mBANCO vCHEQUE := mCHEQUE vCOD_COB := mCOD_COB vCOD_REC1 := mCOD_REC1 vCOD_REC2 := mCOD_REC2 vCOD_REC3 := mCOD_REC3 vVLR_REC1 := mVLR_REC1 vVLR_REC2 := mVLR_REC2 vVLR_REC3 := mVLR_REC3 if 'MINERACAO' $ upper(NEMPRESA) vDATA_CONT = vDATA_REC endif repl_var() *** Auditoria de alteracao *** AuditAlt(procname()) DbCommit() DbUnlock() *** Lanca credito no movimento bancario *** if vLANCA_MB='X' sele MOVBANCO DbSetOrder(0) adireg(.f.) vHIST = 'Rec '+left(cadcli->CLIENTE,14)+'-'+vCOD_CONTA+'-'+receber->TIPO_DOC+' '+transf(receber->NUM_DOC,'9999999')+'-P:'+receber->PARC+'-Vcto '+dtoc(receber->DATA_VENC) *** Verifica se sistema esta configurado para baixar conta em outro caixa *** vCCDestBX = vCUSTEIO+vD if !empty(setup->CCBXCR) .and. setup->CCBXCR>'00' .and. setup->CCBXCR<'99' vCCDestBX = setup->CCBXCR endif repl movbanco->BANCO with vBANCO , movbanco->AGENCIA with vAGENCIA ,; movbanco->CONTA with vCONTABCO, movbanco->NUM_DOC with vCHEQUE ,; movbanco->CUSTEIO with vCCDestBX, movbanco->HIST with vHIST ,; movbanco->DATA_MOV with vDATA_MOV, movbanco->VALOR with vVALOR ,; movbanco->DEB_CRED with 'C' , movbanco->COD_CONTA with vCOD_CONTA,; movbanco->NROVENDA with 'R'+vCOD_CONTA *** Auditoria de alteracao *** AuditAlt(procname()) DbCommit() DbUnlock() endif *** verifica em quantos pagamentos *** RECEBTOS:=CONTADOR:=1 do case case vVLR_REC1>0.and.vVLR_REC2>0.and.vVLR_REC3>0 RECEBTOS=3 case vVLR_REC1>0.and.vVLR_REC2>0 RECEBTOS=2 case vVLR_REC1>0 RECEBTOS=1 endcase *** ver se lanca automatico recebimento no caixa *** if vBX_CR_CX vLANCA_CX='X' if 'NAOBXCX' $ vSACCESS if MsgAlert('Atencao !!! '+alltrim(vUSUARIO)+' o sistema esta configurado '+; 'para Lancamento Automatico de Recebimento no caixa, e seu nivel '+; 'de acesso permite NAO lancar o recebimento desta conta. '+; 'Lancar no caixa ? ',' Recebimento de Conta ',{' Sim ',' Nao '})=2 vLANCA_CX=' ' endif endif endif *** Lanca no Movimento de Caixa as Parcelas *** if vLANCA_CX='X' do while CONTADOR <= RECEBTOS sele MOVCX ARQCX=dbf() sele ARQUIVOS seek ARQCX reglock(.f.) repla ULT_COD with ULT_COD+1 dbcommit() vREG_CX=ULT_COD dbunlock() VALOR_REC = 'vVLR_REC'-ltrim(str(CONTADOR)) FORMA_REC = 'vCOD_REC'-ltrim(str(CONTADOR)) sele MOVCX set orde to 0 adireg(.f.) vHISTORICO ='Rec '+left(cadcli->CLIENTE,14)+'-'+vCOD_CONTA+'-'+vTIPO_DOC+'-'+str(vNUM_DOC,7)+'-Vc '+dtoc(vDATA_VENC) if vJUROS>0 vHISTORICO='Cred.Conta+Juros '+vCOD_CONTA+'-'+vTIPO_DOC+'-'+str(vNUM_DOC,7)+'-'+left(cadcli->CLIENTE,14) endif *** Verifica se sistema esta configurado para baixar conta em outro caixa *** vCCDestBX = vCUSTEIO+vD if !empty(setup->CCBXCR) .and. setup->CCBXCR>'00' .and. setup->CCBXCR<'99' vCCDestBX = setup->CCBXCR endif if vDATA_REC>date() vDATA_REC=date() endif repla movcx->REGISTRO with vREG_CX , movcx->DATA with vDATA_REC,; movcx->HISTORICO with vHISTORICO, movcx->DEB_CRED with 'C' ,; movcx->VALOR with &VALOR_REC, movcx->CUSTEIO with vCCDestBX,; movcx->D with vD , movcx->DT_BLOQ with date() ,; movcx->COD_PAG with &FORMA_REC, movcx->NROVENDA with 'R'+vCOD_CONTA,; movcx->HORA with time() , movcx->USER with vUSUARIO *** Auditoria de alteracao *** AuditAlt(procname()) CONTADOR++ dbcommit() dbunlock() enddo endif sele RECEBER vCONTA_ANT := COD_CONTA if CAD_DIF='S' .and. vVALOR_REC < vVALOR_ARC + vTOT_JUR - vTOT_DESC .and. vVALOR_REC > 0 vVALOR_ANT := vVALOR_ARC *** calculo o valor dos juros sobre o valor total se tiver vencida *** if vDATA_REC > vDATA_VENC .and. vCJUR_DIF vJUR_PARC := DIAS * ((JUR_DIA/100) * vVALOR_ARC ) vMULTA_PARC:= vVALOR_ARC * (MULTA/100) vVALOR_ARC := vVALOR_ARC + vJUR_PARC + vMULTA_PARC if !'TOURIS' $ upper(NEMPRESA) vDATA_VENC := vDATA_REC endif endif vVALOR_ARC := vVALOR_ARC - vVALOR_REC reglock(.f.) repla VALOR_ARC with vVALOR_REC *** Auditoria de alteracao *** AuditAlt(procname()) DbCommit() DbUnlock() sele ARQUIVOS seek ARQUIVO reglock(.f.) repl ULT_COD with ULT_COD+1 dbcommit() dbunlock() vCOD_CONTA = strzero(ULT_COD,6) sele RECEBER set orde to 0 adireg(.f.) if vTOT_JUR > 0 .and. vCJUR_DIF *** caso o sistema calcule os juros dos valores pagos, para que NAO recalcule *** sobre o saldo que ficou JA com juros, troca-se a data de vencimento *** original pela data do pagamento e passa-se a corrigir novamente set centu off vHIST := 'Sld+'+str(DIAS,3)+' DD Juros ' + vCONTA_ANT+'-Vc'+dtoc(vDATA_VENC) set centu on else vHIST := 'Diferenca Conta ' + vCONTA_ANT endif vCOD_VEND := mCOD_VEND *** Registro da diferenca *** vMULTA := 0 // Zero a multa pois ja foi cobrada na diferenca vVALOR_REC := vBANCO := vCHEQUE := 0 vCOD_COB := vCOD_REC1 := vCOD_REC2 := vCOD_REC3 := 0 vVLR_REC1 := vVLR_REC2 := vVLR_REC3 := 0 vANTEC :=.f. vDATA_REC := ctod('') vCUSTEIO := mCUSTEIO vD := mD vDATA_CAD := date() repl_var() *** Auditoria de alteracao *** AuditAlt(procname()) dbcommit() unlock endif *** Lancamento de JUROS em CONTA especifica *** if CAD_JUR='S' .and. vJUROS>0 .and. vCONTABIL sele ARQUIVOS seek ARQUIVO reglock(.f.) repl ULT_COD with ULT_COD+1 dbcommit() dbunlock() vCOD_CONTA = strzero(ULT_COD,6) sele RECEBER DbSEtOrder(0) adireg(.f.) vHIST = 'Juros Conta '+vCONTA_ANT vDATA_CAD = date() vVALOR_ARC = vJUROS vVALOR_REC = vJUROS vVLR_REC1 = vJUROS vVLR_REC2 = 0 vVLR_REC3 = 0 vCOD_VEND = mCOD_VEND vCONTA = vCONTA_JUR vCUSTEIO = mCUSTEIO vD = mD repl_var() *** Alteracao de Auditoria *** AuditAlt(procname()) dbcommit() dbunlock() endif *** Marca como lancamento de rateio *** vVLR_ORI=vVALOR_ARC vORIGEM ='R'+vCOD_CONTA sele RATEIO set orde to 1 seek vORIGEM do while !eof() .and. vORIGEM=ORIGEM reglock(.t.) repla DATA_BX with vDATA_REC, ENVIADO with .f. dbcommit() unlock skip enddo enddo *** auditoria de alteracao *** set key -40 to Return(nil) funct BuscaCR() ********************************************************* * Realiza a busca de CR pelo Codigo,Boleto,Cliente,etc... * Usada para CANC_CR e BAIXA_CR ********************************************************* do while .t. set key -39 to VerBloqueio && Alt+F10 centra_msg(24,'DIGITE O CODIGO DA CONTA ou P/RETORNAR') vCOD_CONTA=0 @ 07,02 say 'Codigo da Conta Äþ' get vCOD_CONTA pict '999999' @ 07,40 say 'Nosso Numero Boleto Äþ' get vNROBANCO when(empty(vCOD_CONTA)) @ 08,02 say ' Codigo Cliente Äþ' get vCOD_CLI pict '99999' when(empty(vCOD_CONTA).and.empty(vNROBANCO)) valid(iif(!empty(vCOD_CLI), p_cliente(vCOD_CLI,.t.),.t.)) @ 09,02 say ' Tipo do Docto Äþ' get vTIPO_DOC pict '!!' when(empty(vCOD_CONTA).and.empty(vNROBANCO)) @ 10,02 say ' N§ Documento Äþ' get vNUM_DOC pict '9999999' when(empty(vCOD_CONTA).and.empty(vNROBANCO)) @ 11,02 say ' Parcela Äþ' get vPARC pict '99/99' when(empty(vCOD_CONTA).and.empty(vNROBANCO)) read if lastkey()=27 return(.f.) endif set key -39 to && Alt+F10 mCOD_CONTA=vCOD_CONTA set key -11 to Desl_efes() sele RECEBER do case case !empty(mCOD_CONTA) mCOD_CONTA=strzero(mCOD_CONTA,6) @ 07,21 say mCOD_CONTA DbSetOrder(2) seek mCOD_CONTA case !empty(vNROBANCO) DbSetOrder(8) seek vNROBANCO other DbSetOrder(6) seek str(vCOD_CLI,5)+vTIPO_DOC+str(vNUM_DOC,7)+vPARC endcase if eof() mensagem('Conta NAO cadastrada...') loop endif igual_var() @ 07,02 say 'Codigo da Conta Äþ' get vCOD_CONTA pict '999999' @ 07,40 say 'Nosso Numero Boleto Äþ' get vNROBANCO @ 08,02 say ' Codigo Cliente Äþ' get vCOD_CLI pict '99999' p_cliente(vCOD_CLI,.t.) @ 09,02 say ' Tipo do Docto Äþ' get vTIPO_DOC pict '!!' @ 10,02 say ' N§ Documento Äþ' get vNUM_DOC pict '9999999' @ 11,02 say ' Parcela Äþ' get vPARC pict '99/99' exit enddo return(.t.) funct DadosRec() ***************************************** * Apresenta dados do recebimento da conta ***************************************** @ 18,02 say ' Dt Recbto Äþ' get vDATA_REC valid(Juros_fut()) when(Juros_fut()) @ 18,col()+10 say 'N§ Banco Äþ' get vBANCO pict '999' when(mens_campo('1=dinheiro ou o numero do banco')) @ 18,col()+6 say 'N§ Docto Äþ' get vCHEQUE pict '9999999' when(mens_campo('1=dinheiro ou o numero do documento')) @ 19,02 say 'Vlr Recbdo Äþ' get vVLR_REC1 pict '99999999.99' valid(calcula_rec(vVLR_REC1,vVLR_REC2,vVLR_REC3,17,40)) when(mens_campo('o valor recebido')) @ 19,col()+5 say 'Forma Recbto Äþ' get vCOD_REC1 pict '99' valid(p_formapag(vCOD_REC1,.T.) .and. RecTEF(vVLR_REC1)) when(mens_campo('a forma de recebimento')) @ 20,02 say 'Vlr Recbdo Äþ' get vVLR_REC2 pict '99999999.99' valid(calcula_rec(vVLR_REC1,vVLR_REC2,vVLR_REC3,17,40)) when(vVLR_REC1>0 .and. mens_campo('o valor recebido')) @ 20,col()+5 say 'Forma Recbto Äþ' get vCOD_REC2 pict '99' valid(p_formapag(vCOD_REC2,.T.) .and. RecTEF(vVLR_REC2)) when(vVLR_REC2>0 .and. mens_campo('a forma de recebimento')) @ 21,02 say 'Vlr Recbdo Äþ' get vVLR_REC3 pict '99999999.99' valid(calcula_rec(vVLR_REC1,vVLR_REC2,vVLR_REC3,17,40)) when(vVLR_REC2>0 .and. mens_campo('o valor recebido')) @ 21,col()+5 say 'Forma Recbto Äþ' get vCOD_REC3 pict '99' valid(p_formapag(vCOD_REC3,.T.) .and. RecTEF(vVLR_REC3)) when(vVLR_REC3>0 .and. mens_campo('a forma de recebimento')) @ 22,02 say ' Cobrador Äþ' get vCOD_COB pict '99' valid(iif(vCOD_COB>0,p_cobrador(vCOD_COB,.t.),.t.)) when(mens_campo('o codigo do cobrador ou p/nhenhum')) @ 22,col()+16 say ' Lancar CX Äþ' get vLANCA_CX pict '!' valid(vLANCA_CX$' X') when(mens_campo('X se for para lancar para o CAIXA ou p/NAO lancar')) @ 22,col()+4 say ' Lancar MB Äþ' get vLANCA_MB pict '!' valid(vLANCA_MB$' X') when(mens_campo('X se for para lancar para o MOVIMENTO BANCARIO ou p/NAO lancar')) @ 23,02 say 'Observacao Äþ' get vOBS return(.t.) func CALCULA_REC(vVLR_REC1,vVLR_REC2,vVLR_REC3,LL,CC) ***************************************************************** * Funcao para somar as parcelas e atualiza o valor recebido do CR ***************************************************************** vVALOR_REC = vVLR_REC1 + vVLR_REC2 + vVLR_REC3 @ LL,CC say 'VALOR RECEBIDO Äþ' +transf(vVALOR_REC,'@E 9,999,999.99') return(.t.) func JUROS_FUT ************************************** * Calcular Juros para pagamento futuro ************************************** vTOT_JUR := vTOT_DESC := 0 if vDATA_REC>=vDATA_VENC DIAS = vDATA_REC - vDATA_VENC COR_FUT = setcolor() vTOT_JUR = DIAS * ((JUR_DIA/100) * vVALOR_ARC) && Multiplica n§ dias com a taxa vezes o valor VLR_MULTA = (MULTA/100) * vVALOR_ARC if TJ='V' vTOT_JUR = DIAS * JUR_DIA && Se os Juros da Conta for VALOR, Multiplica pelos n§ dias endif if (vDATA_REC - vDATA_VENC) > vCARENCIA vTOT_JUR = vTOT_JUR + VLR_MULTA else vTOT_JUR = 0 endif setcolor(COR_JUROS) @ 12,40 say ' Juros+Multa R$ Äþ ' + transf( vTOT_JUR , '@E 9,999,999.99') else DIAS = vDATA_VENC - vDATA_REC COR_FUT = setcolor() vTOT_DESC := DIAS * ((vP_DESC/100) * vVALOR_ARC) setcolor(COR_JUROS) @ 12,40 say ' Desconto R$ Äþ ' + transf( vTOT_DESC, '@E 9,999,999.99') endif vVLR_REC1 := vVALOR_ARC + vTOT_JUR - vTOT_DESC setcolor(COR_FUT) @ 17,02 say 'TOTAL A RECEBERÄþ ' + transf(vVALOR_ARC + vTOT_JUR - vTOT_DESC,'@E 999,999.99') return(.t.)
×
×
  • Create New...