Aproximadamente dois meses atrás fiz uma mudança em minha rotina de cadastro de pedidos e desde então estou encontrando muitos problemas, alguns já consegui resolver com ajuda de um amigo, porém o mais temível continua acontecendo, corrupção de índice!
Quando desenvolvi este sistema usava Clipper 5.2e + SIX 3.0 e funcionava maravilhosamente bem, nunca tive problemas com índices. Hoje estou usando xHarbour 1.2.1 Simplex (Rev. 9421) + DBFCDX.
Quero relatar o que modifiquei:
- Antes eu estava usando DBSEEK() para localizar os dados do pedido e SET RELATION para "filtrar" os itens do pedido. Tudo acontecia normalmente, sem muito problemas, mais devido ao uso crescente de usuário cadastrando pedido e o volume aumentando, algumas vezes quando se estava cadastrando um pedido, aparecia um item de outro, mais era só sair e não aparecia mais.
- Pensando em melhorar a rotina, passei a usar ORDSCOPE(), confesso que no início não tomei alguns cuidados como limpar o filtro antes, mais após eliminar muitos problemas que tive, continuo tendo problemas com corrupção de índice. Os itens aparecem em outros pedidos. Fiz vários testes com DBSEEK() para me certificar se o índice realmente estava corrompido e após ter certeza criei novamente o índice e tudo volta ao normal, funciona que é uma beleza.
- Antes de criar o índice novamente eu apago o arquivo antigo. Faço uso de TAG´s.
- O sistema é grande e em nenhum outro módulo estou tendo problemas com corrupção, somente nos arquivos de itens desta rotina.
Se alguém puder me ajudar, irei deixar a rotina abaixo.
Sds,
Júlio.
#include "INKEY.CH"
#include "SETCURS.CH"
#include "CLUBE.CH"
#include "MOUSE.CH"
#include "FILEIO.CH"
#include "GETPASS.CH"
FUNCTION CAD_PEDID(n_cod)
LOCAL Atel:=SAVESCREEN(00,00,24,79)
LOCAL Wcadastro:=.F.
LOCAL cArea, oCol, nKey, nReg, nCol, nRow, cCodigo, eEnter
LOCAL cReg, dData, cCorOld, cBox1 := "ÛßÛÛÛÜÛÛ"
LOCAL cCorUso := SETCOLOR(), nPosicao
LOCAL aCab:={"Carga","Pedido","C¢digo","Descri‡Æo","","QTD","Pre‡o Tabela","(%) Desc.","Vlr. Desc.","Pre‡o Unit rio","Pre‡o Total","(%) Comissao","Vlr. Comissao"}, aCamp:={"ncarga","codped","sayite","saydes","condic","quanti","pretab","descon","vlrdes","preuni","pretot","comiss","vlrcom"}
STATIC nMRow, nMCol
PRIVAT aTab,pSenha
pSenha=SPAC(6)
lDelete := .F.
lAdiciona := .F.
lEdita := IF(lEdita == NIL,.F.,.T.)
SET SOFTSEEK OFF
aMensagem := { "<INS>-Inclus„o <ENTER>-Altera <DEL>-Exclus„o <F1>-Ajuda <F2>-Ordem"}
ABREARQ(,{"AL_PEDID","AL_CLIEN","AL_ESTOQ","AL_LINHA","AL_GRUPO","AL_ITPED","AL_ALECF","AL_NCARG","AL_VENDE","AL_EMPRE"})
sele AL_EMPRE; DBSETORDER(1); DBSEEK(aw_emp)
First:=.T.
do whil .t.
wCadastro=.F.
rest screen from aw_tel_master
SETCURSOR(1)
SETCOLOR("w+/b,w+/,,,n/bg")
SETCOLOR("b+/b,w+/,,,n/bg")
@ 00,00 clear to 24,79
SETCURSOR(1)
@ 00,00,07,79 BOX cBox1
*@ 06,01 clea to 06,78
SETCOLOR("w+/b,w+/,,,n/bg")
v_codc=0; v_codp=0
aCoordenadas := { 07,05,16,76 }
if First
v_carg=0
else
v_carg=IIF(TYPE("v_carg")="C",VAL(v_carg),v_carg)
end
@ 01,01 say "Carga =" get v_carg pict"9999999999" VALID( IIF(LASTKEY()==13 .and. v_carg=0,VISUALIZA("AL_NCARG", aCoordenadas, {"v_carg","val(codigo)"} ),L_SEEK(v_carg,10000000000,nil,nil,"AL_NCARG",1,nil) ) ) ;
MSG("<ENTER>=consulta ou entre com o c¢digo da carga !")
read
if (LASTKEY()==27 .OR. LASTKEY()==17)
ABREARQ(,.F.)
RESTSCREEN(00,00,24,79,Atel)
RETU(.T.)
end
v_carg=STRZERO(v_carg,10)
First:=.F.
******
@ 02,01 say "Pedido =" get v_codp pict"999999" VALID( IIF(LASTKEY()==13 .and. v_codp=0,VISUALIZA("AL_PEDID", {07,05,15,50}, {"v_codp","val(codped)"} ),.T.) ) ;
MSG("Entre com o c¢digo do pedido,<ENTER> p/ consulta ou <^R> p/ incluir !")
read
if (LASTKEY()==27 .OR. LASTKEY()==17)
ABREARQ(,.F.)
RESTSCREEN(00,00,24,79,Atel)
RETU(.T.)
end
sele AL_PEDID
if (LASTKEY()==27 .OR. LASTKEY()==17)
ABREARQ(,.F.)
RESTSCREEN(00,00,24,79,Atel)
RETU(.T.)
elseif (LASTKEY()==18)
Wcadastro=.T.
elseif (LASTKEY()!=18 .and. v_codp>0)
v_codp=STRZERO(v_codp,6)
elseif v_codp=0
loop
end
sele AL_PEDID
DBSETORDER(1)
if (!Wcadastro .and. !DBSEEK(v_carg+v_codp))
MENSAGEM("C¢digo do pedido nÆo encontrado, Verifique !!!",5)
loop
elseif (!Wcadastro .and. DBSEEK(v_carg+v_codp))
cadastro=.f.
xPED:=CRIAVAR()
elseif Wcadastro
if AL_NCARG->datlib#CTOD(" / / ")
MENSAGEM("Carga ja acertada, impossivel cadastrar pedidos!",3)
loop
end
IF PERG("Aten‡Æo, deseja incluir novo pedido para este cliente ? ")="N"
loop
end
xPED:=NEWVAR()
xPED[4]:=DATE()
sele AL_NCARG
RECLOCK(10)
repl npedid with npedid+1
DBCOMMIT()
DBUNLOCK()
v_codp=STRZERO(AL_NCARG->NPEDID,6)
sele AL_PEDID
ADDREC()
repl ncarga with v_carg
repl codped with v_codp
DBCOMMIT()
DBUNLOCK()
xPED[1]:=v_carg
xPED[2]:=v_codp
cadastro=.t.
end
SETCOLOR("w+/b,w+/,,,n/bg")
******** -> Atualiza 'zeros' a esquerda
@ 01,01 say "Carga =" get v_carg pict"9999999999"
@ 02,01 say "Pedido =" get v_codp pict"999999"
GetList:={}
****** -> Consulta de OS
@ 03,01 say "Cliente =" get xPED[3] pict"99999" WHEN( IIF(VALTYPE(xPED[3])=="C",IIF(AFILL(xPED,VAL(xPED[3]),3,1)#NIL,.T.,.T.),.T.) ) ;
VALID(IIF(LASTKEY()==13 .and. xPED[3]=0,Visualiza("AL_CLIEN", aCoordenadas, {3,1},"xPED",{"{||CADAS_CLIEN(.T.)}","{||CADAS_CLIEN(codigo)}"} ),;
IIF(L_SEEK(STRZERO(xPED[3],5),nil,nil,{ {03,18,"'= '+nomecl"} },"AL_CLIEN",1,'CPFCLI#" " .or. CPFCGC#" "')==.T.,IIF(AFILL(xPED,STRZERO(xPED[3],5),3,1)#NIL,.T.,.T.),.F.) ) )
* MSG("<ENTER>=consulta ou entre com o c¢digo do cliente !")
@ 04,01 say "Vendedor =" get xPED[5] pict"999" WHEN( IIF(VALTYPE(xPED[5])=="C",IIF(AFILL(xPED,VAL(xPED[5]),5,1)#NIL,.T.,.T.),.T.) ) ;
VALID(IIF(LASTKEY()==13 .and. xPED[5]=0,Visualiza("AL_VENDE", aCoordenadas, {5,1},"xPED",{"{||CADAS_VENDE(.T.)}","{||CADAS_VENDE(codigo)}"} ),;
IIF(L_SEEK(STRZERO(xPED[5],3),nil,nil,{ {04,16,"'= '+nomeve" } },"AL_VENDE",1,'STRZERO(xPED[5],3)=AL_CLIEN->codreg')==.T.,IIF(AFILL(xPED,STRZERO(xPED[5],3),5,1)#NIL,.T.,.T.),.F.) ) )
@ 05,01 say "Cond.Pag.=" get xPED[9] pict"99/99/99/999/999/999" WHEN( IIF(wCadastro,PEGA_CLI(),.T.) )
@ 05,35 say "Tipo Pag.=" get xPED[18] pict"99" WHEN( MOSTRA_SO(1,{06,40,12,58},{"01-Duplicatas ","02-Cheques ","03-Promissoria","04-Bonificacao","05-Trocas"},nil) );
VALID( MOSTRA_SO(2,{06,40,12,58},nil,{"01","02","03","04","05"},xPED[18]) )
@ 05,55 say "Tipo NF =" get xPED[10] pict"99" WHEN( MOSTRA_SO(1,{01,35,24,65},{"01-Vendas ","02- ","03-Dev. Fornecedores/Ind.","04-Dev. Fornecedores/Com.","05-Remessa para Troca","06-Dev. Mat. Uso/Consumo","07-Remessa Comodato",;
"08-Simples Remessa","09-Perdas ","10-Bonificacao","11-Transferˆncia","12-Entrada","13-Devolucao Clientes ","14-Sa¡da p/Industrializa‡Æo","15-Remessa Amostra Gratis","16-Complemento","17-Trocas","18-Remessa Exposicao","19-Retorno Exposicao","20-Dev. Fornecedor Com/ST","21-Perda","22-Saida Reclassificacao","23-Entrada Reclassificacao"},nil ) ) ;
VALID( MOSTRA_SO(2,{01,35,24,65},nil,{"01","03","04","05","06","07","08","09","10","11","12","13","14","15","16","17","18","19","20","21","22","23"},xPED[10]) )
@ 06,01 say "Numero NF= "+numenf
@ 06,22 say "Emissao = "+DTOC(datemi)
if AL_PEDID->situac=" "
read
if (LASTKEY()==27 .OR. LASTKEY()==17)
ABREARQ(,.F.)
RESTSCREEN(00,00,24,79,Atel)
RETU(.T.)
end
else
GetList:={}
sele AL_CLIEN; DBSETORDER(1); DBSEEK(AL_PEDID->codcli)
sele AL_VENDE; DBSETORDER(1); DBSEEK(AL_PEDID->codven)
@ 03,18 say "= "+AL_CLIEN->nomecl
@ 04,16 say "= "+AL_VENDE->nomeve
end
if xPED[10]="10"
if xPED[18]#"04"
MENSAGEM("Tipo de Pagamento esta incorreto para esta BONIFICACAO!",3)
loop
end
end
if xPED[18]="04"
if xPED[10]#"10"
MENSAGEM("Este tipo de pagamento so pode ser usado com tipo NF 10 - Bonificacao!",3)
loop
end
end
SETCOLOR("w+/b,w+/,,,n/bg")
if xPED[10]="10" .and. xPED[18]="04" .and. xPED[27]=" " .and. AL_PEDID->situac=" "
@ 01,35 say "Senha :" get xPED[27] pict"@P" password
read
if xPED[27]="032867"
@ 01,50 say "Liberado por Julio"
vLiberado="Julio"
elseif xPED[27]="037076"
@ 01,50 say "Liberado por Geovane"
else
MENSAGEM("Senha invalida!!!!",3)
loop
end
elseif xPED[10]="10" .and. xPED[18]="04" .and. xPED[27]#" "
if xPED[27]="032867"
@ 01,50 say "Liberado por Julio"
vLiberado="Julio"
elseif xPED[27]="037076"
@ 01,50 say "Liberado por Geovane"
else
MENSAGEM("Senha invalida!!!!",3)
loop
end
end
xPED[3]:=IF(VALTYPE(xPED[3])="N",STRZERO(xPED[3],5),xPED[3])
sele AL_CLIEN; DBSETORDER(1); DBSEEK(xPED[3])
if AL_CLIEN->credit="S"
MENSAGEM("Cliente com pendencia financeira, entre em contato com o contas a receber!",5)
loop
end
****************************************************************************
* Consolida os dados do cliente
****************************************************************************
sele AL_CLIEN
gCnpj=cpfcgc
gInse=insest
gEsta=estado
gCpfc=cpfcli
gTipo=tipocl
gCodc=codcid
*if (gTipo#"J" .and. gTipo#"F")
* MENSAGEM("Tipo do cliente Invalido, informe pessoa juridica ou fisica!",5)
* loop
*elseif gTipo="J"
* if !CGC(gCnpj)
* MENSAGEM("CNPJ do cliente Invalido, favor verificar!",5)
* loop
* end
* if gEsta#"SP"
* if !TESTAIE(gInse,gEsta)
* MENSAGEM("Inscricao Estadual do cliente Invalida, favor verificar!",5)
* loop
* end
* end
*elseif gTipo="F"
* if !VERCPF(gCpfc)
* MENSAGEM("CPF do cliente Invalido, favor verificar!",5)
* loop
* end
*end
****************************************************************************
if xPED[10]="13"
SETCOLOR("w+/b,w+/,,,n/bg")
@ 06,55 say "NF Cancelada= " get xPED[23] pict"999999" VALID(xPED[23]#" ")
if AL_PEDID->situac=" "
read
if (LASTKEY()==27 .OR. LASTKEY()==17)
ABREARQ(,.F.)
RESTSCREEN(00,00,24,79,Atel)
RETU(.T.)
end
else
GetList:={}
end
end
SETCOLOR("w+/b,w+/,,,n/bg")
@ 04,50 say "Preco de Tabela = "+AL_VENDE->tabela
xPED[3]:=IF(VALTYPE(xPED[3])="N",STRZERO(xPED[3],5),xPED[3])
xPED[5]:=IF(VALTYPE(xPED[5])="N",STRZERO(xPED[5],3),xPED[5])
sele AL_PEDID
RECLOCK()
REPLVAR(xPED)
REPL cidade with AL_CLIEN->cidade
DBCOMMIT()
DBUNLOCK()
//// Rela‡äes ////
sele AL_ITPED
DBSETORDER(1)
// Limpa filtro
ORDSCOPE(0,nil); ORDSCOPE(1,nil)
// Realiza o filtro
ORDSCOPE(0,v_carg+v_codp)
ORDSCOPE(1,v_carg+v_codp)
DBGOTOP()
///// FIM //////
SETCURSOR(0)
SETCOLOR("b+/b,w+/,,,n/bg")
aMensagem := { "<INS>-Inclui <ENTER>-Altera <DEL>-Exclui <F2>-Desc. <F5>-Ex.Pedido <F10>-Recal"," 000000"}
aCoordenadas:={08,01,20,78}
@ aCoordenadas[1]-1, aCoordenadas[2]-1, aCoordenadas[3]+2+LEN(aMensagem), aCoordenadas[4]+1 BOX cBox1
@ 22,01 say REPL("Ü",78)
SETCOLOR("w+/b,w+/,,,n/bg")
IF VALTYPE(aMensagem) == "A"
*FOR I := 1 TO LEN(aMensagem)
I:=1
@ aCoordenadas[3]+2+I, aCoordenadas[2] SAY PADC(aMensagem[I],aCoordenadas[4]-aCoordenadas[2]+1) COLOR "W/B"
*NEXT
ENDIF
*oTab := MyBrowser( bWhile,bFor,bFirst,bLast, aCoordenadas[1], aCoordenadas[2], aCoordenadas[3]-2, aCoordenadas[4] )
oTab := TBrowseDB( aCoordenadas[1], aCoordenadas[2], aCoordenadas[3]-2, aCoordenadas[4] )
oTab:colsep := " Û "
oTab:headsep:= "ßÛß"
FOR I = 1 TO LEN( aCamp )
IF VALTYPE(aCamp[I]) == "B"
oCol:=TBcolumnNew( aCab[I], ( aCamp[I] ) )
ELSE
oCol:=TBcolumnNew( aCab[I], FIELDWBLOCK( aCamp[I], SELECT()))
ENDIF
oTab:addColumn( oCol )
NEXT
@ oTab:nTop +2, oTab:nRight+1 SAY chr(30) COLOR Cor(21)
@ oTab:nBottom , oTab:nRight+1 SAY chr(31) COLOR Cor(21)
@ oTab:nBottom+1, oTab:nRight+1 SAY "" COLOR Cor(22)
@ oTab:nBottom+1, oTab:nLeft -1 SAY "" COLOR Cor(22)
SCROLL_UP := { oTab:nTop +2, oTab:nRight+1, oTab:nTop +2, oTab:nRight+1 } ; SCROLL_DOWN := { oTab:nBottom , oTab:nRight+1, oTab:nBottom , oTab:nRight+1 }
SCROLL_LEFT := { oTab:nBottom+1, oTab:nRight+1, oTab:nBottom+1, oTab:nRight+1 } ; SCROLL_RIGHT := { oTab:nBottom+1, oTab:nLeft -1, oTab:nBottom+1, oTab:nLeft -1 }
nCol_Reg := (oTab:nRight-oTab:nLeft+2) / LEN(aCamp)
DO WHILE .T.
aCoordenadas:={08,01,20,78}
aTeclas := { ;
{ K_INS , "P_INSERE(v_carg,v_codp)" } ,;
{ K_DEL , "DELREGISTRO()" } ,;
{ K_ENTER , "ALTERAREG(v_carg,v_codp)" } ,;
{ K_F1 , "HELP()" } ,;
{ K_F2 , "NOTAF()" } ,;
{ K_F3 , "CALEN()" } ,;
{ K_F4 , "CALCU()" } ,;
{ K_F5 , "EXCLUIPED()" } ,;
{ K_F6 , "COMPLEMENTO()" } ,;
{ K_F7 , "PAGTOS()" } ,;
{ K_F8 , "DESPESA()" } ,;
{ K_F9 , "DESCONTO()" } ,;
{ K_F10 , "CALC(v_carg,v_codp)" } ,;
{ K_F11 , "ASTERIS()" } }
SETCOLOR("w+/b,w+/,,,n/bg")
@ 20,01 say "IT->"+TRANS(AL_PEDID->QTDITE,"9999")+" CORT->"+TRANS(AL_PEDID->QTDCAN,"9999")+"-R$ "+TRANS(AL_PEDID->VLRCAN,"9,999,999.99")+;
" DESC. -> "+TRANS((AL_PEDID->DESCON+AL_PEDID->DESCPR),"@E 99,999.99")+" TOTAL-> "+TRANS( (AL_PEDID->VLRTOT-AL_PEDID->DESCON),"99,999,999.99")
@ 21,49 say "VLR COMISSAO -> "+TRANS(AL_PEDID->VLRCOM,"@E 99,999,999.99")
@ oTab:nBottom+1,oTab:nLeft SAY REPLICATE("°",oTab:nRight-oTab:nLeft+1) COLOR Cor(28)
nCol_ := oTab:nLeft+IF(ROUND((nCol_Reg*(oTab:colpos-1)),0)<=0,0,IF(oTab:colpos>=LEN(aCamp),LEN(aCamp)*nCol_Reg,ROUND(nCol_Reg*(oTab:colpos-1),0)))
@ oTab:nBottom+1,IF(nCol_+nCol_Reg>oTab:nRight,nCol_:=oTab:nRight-ROUND(nCol_Reg,0)+1,nCol_) SAY REPLICATE("Û",ROUND(nCol_Reg,0)) COLOR Cor(29)
oTab:refreshAll()
oTab:COLORRECT({oTab:rowpos,1,oTab:rowpos,oTab:COLCOUNT},{1,2})
DO WHILE ! oTab:stabilize()
nKey := inkey()
IF nKey <> 0 .AND. nKey <> K_ENTER
EXIT
ENDIF
ENDDO
IF oTab:stable
nRow := ROW()
nCol := COL()
oTab:COLORRECT({oTab:ROWPOS,1,oTab:ROWPOS,oTab:COLCOUNT}, {5,2})
oTab:hilite()
DO WHILE ! oTab:stabilize() ; ENDDO
IF oTAB:hitbottom ; BEEP() ; Mensagem("Atingiu o final do arquivo",2) ; SETCURSOR(0) ; ELSEIF oTAB:hittop ; BEEP() ; Mensagem("Atingiu o in¡cio do arquivo",2) ; SETCURSOR(0) ; ENDIF
SETPOS( nRow, nCol )
nKey := 0
DO WHIL nKey == 0 ; nKey := Minkey(5, @nMRow, @nMCol, .T.) ; ENDDO
DO WHILE (!oTab:Stabilize()) ; ENDDO
ENDIF
IF nKey == K_UP ; oTab:UP()
ELSEIF nKey == K_DOWN ; oTab:DOWN()
ELSEIF nKey == K_LEFT ; oTab:LEFT()
ELSEIF nKey == K_CTRL_LEFT ; oTab:PANLEFT()
ELSEIF nKey == K_RIGHT ; oTab:RIGHT()
ELSEIF nKey == K_CTRL_RIGHT ; oTab:PANRIGHT()
ELSEIF nKey == K_PGUP ; oTab:PAGEUP()
ELSEIF nKey == K_CTRL_PGUP ; oTab:GOTOP()
ELSEIF nKey == K_PGDN ; oTab:PAGEDOWN()
ELSEIF nKey == K_CTRL_PGDN ; oTab:GOBOTTOM()
ELSEIF nKey == K_HOME ; oTab:HOME()
ELSEIF nKey == K_CTRL_HOME ; oTab:PANHOME()
ELSEIF nKey == K_END ; oTab:END()
ELSEIF nKey == K_CTRL_END ; oTab:PANEND()
ELSEIF nKey == K_ESC ; EXIT
ELSEIF nKey == M_LEFT
IF InRegion(SCROLL_UP) ; oTab:Up()
ELSEIF InRegion(SCROLL_DOWN) ; oTab:Down()
ELSEIF InRegion(SCROLL_LEFT) ; oTab:Right()
ELSEIF InRegion(SCROLL_RIGHT) ; oTab:Left()
ELSEIF InRegion(oTab:nTop, oTab:nLeft, oTab:nBottom, oTab:nRight)
nLeftCol := oTab:leftVisible ; nLeftCol := IF(nLeftCol == 0, 1, nLeftCol) ; nOffset := oTab:nLeft + oTab:colWidth(nLeftCol) + len(oTab:colSep) ; nPlace := 0
WHILE nMCol > nOffset ; nPlace++ ; nOffset += oTab:colWidth(nLeftCol + nPlace) + len(oTab:colSep) ; ENDDO
nRow := 1 + nMRow - oTab:nTop - 2 ; oTab:dehilite() ; oTab:colPos := nLeftCol + nPlace ; oTab:rowPos := nRow
ENDIF
ELSE
IF VALTYPE(aTeclas) == "A"
nPosicao := ASCAN(aTeclas, { | a | nKey == a[1] } )
nRefaz=.F.
IF nPosicao # 0
gTela=SAVESCREEN(00,00,24,79)
if (nPosicao==1 .and. (AL_PEDID->situac=" " .or. AL_PEDID->situac="P"))
P_INSERE(v_carg,v_codp)
nRefaz=.T.
elseif (nPosicao==2 .and. (AL_PEDID->situac=" " .or. AL_PEDID->situac="P"))
if _SENHA()
DELREGISTRO()
nRefaz=.T.
end
elseif (nPosicao==3 .and. (AL_PEDID->situac=" " .or. AL_PEDID->situac="P"))
ALTERAREG(v_carg,v_codp)
nRefaz=.T.
elseif nPosicao==4
HELP()
elseif nPosicao==5 .and. AL_PEDID->vlrtot>0.00
DESCONTO()
elseif (nPosicao==9 .and. AL_PEDID->situac=" ")
COMPLEMENTO()
elseif (nPosicao==10 .and. AL_PEDID->situac=" ")
DESPESA()
elseif nPosicao==13
CALC(v_carg,v_codp)
nRefaz=.T.
elseif nPosicao==6
CALEN()
elseif nPosicao==7
CALCU()
elseif nPosicao==8
if _SENHA()
if EXCLUIPED()
KEYBOARD( CHR(27) )
nRefaz=.T.
end
end
end
RESTSCREEN(00,00,24,79,gTela)
sele AL_ITPED
DBSETORDER(1)
// Limpa filtro
ORDSCOPE(0,nil); ORDSCOPE(1,nil)
// Refaz o filtro novamente
ORDSCOPE(0,v_carg+v_codp)
ORDSCOPE(1,v_carg+v_codp)
DBGOTOP()
Establ()
oTab:GoTop()
oTab:PanHome()
ENDIF
SET CURSOR OFF
ENDIF
ENDIF
ENDDO
RESTSCREEN(00,00,24,79,cArea)
SETCOLOR(cCorUso)
SETCURSOR(1)
ENDDO
RETURN NIL
***************************************************************************
STATIC FUNCTION _SENHA()
LOCAL xTela:=SAVESCREEN(00,00,24,79)
_Senha=SPAC(6)
WIN3D(" Senha ",13,30,15,50,2,"9")
@ 14,31 say "Senha : " get _senha pict"@P" password
read
if _senha="070843" .or. _senha="004461" .or. _senha="016269" //Thais - Fatima - Camilinha
pSenha=_senha
RESTSCREEN(00,00,24,79,xTela)
RETU .T.
end
pSenha=_senha
RESTSCREEN(00,00,24,79,xTela)
RETU .F.
***************************************************************************
STATIC FUNCTION Establ()
SET CURSOR OFF
oTab:refreshAll()
//DO WHILE ( !oTab:stabilize() ); ENDDO
RETURN NIL
***************************************************************************
STATIC FUNCTION P_INSERE(v_carg,v_codp)
LOCAL bINS:=SAVESCREEN(00,00,24,79)
LOCAL xPicture:=ALLTRIM(AL_EMPRE->tamanh)
xvelho=.f.
DO WHILE .T.
vCod=0
vQtd=0
vCon=" "
vTab=0.00
vBai=" "
vOut=" "
vDes=0.00
vCom=0.00
WIN3D(" InclusÆo ",10,03,16,78,2,"5")
@ 14,04 say REPL("Ä",74)
aCoordenadas := { 07,05,16,76 }
@ 11,04 say "C¢digo =" get vCod pict xPicture VALID( IIF(LASTKEY()==13 .and. vCod=0,VISUALIZA("AL_ESTOQ", aCoordenadas, {"vCod","VAL(codigo)"} ), .T. ))
**************************************************L_SEEK(vCod,NIL,nil,nil,"AL_ESTOQ",1,nil) ) )
read
if (LASTKEY()==27)
RESTSCREEN(00,00,24,79,bINS)
sele AL_ITPED
RETURN NIL
end
vCod=STRZERO(vCod,5)
xVelho=.F.
sele AL_ESTOQ
DBSETORDER(1)
if !DBSEEK(vCod)
MENSAGEM("Aten‡Æo, C¢digo procurado nÆo foi encontrado!!!",3)
loop
end
if situac="02"
MENSAGEM("Atencao, PRODUTO EM FALTA, VERIFIQUE COM O SETOR DE COMPRAS !",3)
elseif situac="03"
MENSAGEM("PRODUTO FORA DE LINHA !!!!!",3)
loop
end
sele AL_ITPED
DBSETORDER(1)
// Limpa filtro
ORDSCOPE(0,nil); ORDSCOPE(1,nil)
// Refaz o filtro novamente
ORDSCOPE(0,v_carg+v_codp)
ORDSCOPE(1,v_carg+v_codp)
DBGOTOP()
_Found=.F.
do whil (!EOF() .and. ncarga=v_carg .and. codped=v_codp)
if (codite=vCod)
_Found=.T.
exit
end
skip
end
if _Found
MENSAGEM("Aten‡Æo, Iten j Cadastrado para este pedido !",3)
loop
end
if AL_VENDE->tabela="01"
vTabela=AL_ESTOQ->pretab
vTab=AL_ESTOQ->pretab
else
Vg=RIGHT(AL_VENDE->tabela,1)
vTabela=AL_ESTOQ->preta&Vg
vTab=AL_ESTOQ->preta&Vg
end
vPrecoDesconto=VAL(STR((vTab-(vTab*10)/100),13,2))
vCom=AL_ESTOQ->comiss
@ 12,04 say "Descri‡Æo = "+AL_ESTOQ->DESCRI
@ 13,04 say "P. Tabela = "+TRANS(vTabela,"@E 9,999,999.99")
@ 13,50 say "Menor Preco= "+TRANS(vPrecoDesconto,"@E 9,999,999.99")
@ 15,04 say "Quantidade =" get vQtd pict"99999.99" VALID( vQtd > 0.000 )
@ 15,28 say "Comissao =" get vCom pict"99.99" VALID(IIF(vCom<=AL_ESTOQ->comiss,IIF(vCom#AL_ESTOQ->comiss,IIF(PERG("Confirma mudanca na comissao ?")="S",.T.,.F.),.T.),.F.) )
@ 15,50 say "P. Vendido =" get vTab pict"@E 9,999,999.99" VALID( IIF(vTab=0,.F.,IIF(vTab<vPrecoDesconto,FALSAMEN("Preco digitado menor que valor de tabela com desconto!",3),.T.)) )
*@ 16,27 say "Cortar ? =" get vCon pict"!" MSG("Tecle <ENTER> para continuar ou <*> p/ para cortar esta mercadoria !") VALID( vCon=" " .or. vCon="*")
read
if (LASTKEY()=27)
RESTSCREEN(00,00,24,79,bINS)
RETURN NIL
end
if PERG("Confirma inclusÆo deste iten ? ")="S"
if (AL_PEDID->tiposa#"01" .and. vCom>0)
MENSAGEM("Atencao, pedido nao e uma venda por isso a comissao deve estar zerada!",3)
RESTSCREEN(00,00,24,79,bINS)
RETURN NIL
end
if vCom>AL_ESTOQ->comiss
MENSAGEM("Item nao pode ser cadastrado, erro na comissao "+str(vCom,5,2),5)
RESTSCREEN(00,00,24,79,bINS)
RETURN NIL
end
if AL_CLIEN->descon>0
vLiq=(vTab-((vTab*AL_CLIEN->descon)/100))
else
vLiq=vTab
end
sele AL_ITPED
ADDREC()
repl ncarga with v_carg
repl codped with v_codp
repl codcli with AL_CLIEN->codigo
repl codite with vCod
repl sayite with LEFT(vCod,16)
repl descri with AL_ESTOQ->descri
repl saydes with LEFT(AL_ESTOQ->descri,25)
repl condic with vCon
repl quanti with vQtd
repl preuni with vTab
repl descon with vDes
repl vlrdes with IIF(vTabela>vTab,((vTabela-vTab)*vQtd),0)
repl pretot with (vQtd * vTab)
repl pretab with vTabela
repl preliq with vLiq
repl comiss with vCom
repl vlrcom with ( (vLiq*vQtd) * vCom)/100
repl fabric with AL_ESTOQ->fabric
repl desbol with AL_CLIEN->descon
DBCOMMIT()
DBUNLOCK()
sele AL_PEDID
RECLOCK(10)
if vCon=" "
repl qtdite with (qtdite+1)
repl vlrtot with (vlrtot+(vQtd * vTab) )
repl descpr with (descpr+IIF(vTabela>vTab,((vTabela-vTab)*vQtd),0))
repl vlrcom with (vlrcom+(( (vLiq*vQtd) * vCom)/100))
else
repl qtdcan with (qtdcan+1)
repl vlrcan with (vlrcan+(vQtd * vTab) )
end
DBCOMMIT()
DBUNLOCK()
end
ENDDO
RETURN NIL
***************************************************************************
STATIC FUNCTION CALC_VLR(vDes,vTab,vTabela)
if vDes>0
vTab=(vTabela-((vTabela*vDes)/100))
else
vTab=vTabela
end
retu .T.
***************************************************************************
STATIC FUNCTION DELREGISTRO()
if psenha=" "
MENSAGEM("Algo errado com a senha, verifique!",5)
retu
end
if (ncarga=v_carg .or. codped=v_codp)
// Estou conferindo antes de excluir devido problemas de filtro
end
IF PERGUNTA("Tem certeza que deseja apagar o registro ?") == "S"
sele AL_ITPED
IF RECLOCK()
//
sele AL_ITPED
repl delete with pSenha
DBCOMMIT()
//
DBDELETE()
DBCOMMIT()
DBUNLOCK()
CALC(v_carg,v_codp)
ELSE
BEEP() ; MENSAGEM("Registro sendo utilizado por outra esta‡„o")
ENDIF
ENDIF
RETURN NIL
***************************************************************************
STATIC FUNCTION FALSEMEN(cTexto,cTempo)
MENSAGEM(cTexto,cTempo)
if PERGUNTA("VOCÒ IRµ EMITIR UM NOTA FISCAL DE ENTRADA ?")="S"
SETCURSOR(1)
RETURN(.T.)
else
SETCURSOR(1)
RETURN(.F.)
end
**************************************************************************
STATIC FUNCTION ALTERAREG(v_codp,v_codc)
LOCAL bALT:=SAVESCREEN(00,00,24,79)
LOCAL xPicture:=AL_EMPRE->tamanh
if LEN(ALLTRIM(AL_ITPED->codite))=0
RETURN NIL
end
DO WHILE .T.
sele AL_ESTOQ
DBSETORDER(1)
DBSEEK(AL_ITPED->codite)
sele AL_ITPED
vCod=codite
vQtd=quanti ; xQtd=quanti
vCon=condic ; xCon=condic
vTab=preuni ; xTab=preuni
vTabela=pretab ; xTabela=pretab
vDes=descon ; xDes=descon
vCom=comiss ; xCom=comiss
vVco=vlrcom ; xVco=vlrcom
vPrecoDesconto=(pretab-(pretab*10)/100)
WIN3D(" Altera‡Æo ",10,03,16,77,2,"6")
@ 14,04 say REPL("Ä",74)
@ 12,04 say "Descri‡Æo = "+AL_ESTOQ->DESCRI
@ 13,04 say "P. Tabela = "+TRANS(vTabela,"@E 9,999,999.99")
@ 13,50 say "Menor Preco= "+TRANS(vPrecoDesconto,"@E 9,999,999.99")
@ 15,04 say "Quantidade =" get vQtd pict"99999.99" VALID( vQtd > 0.000 )
@ 15,28 say "Comissao =" get vCom pict"99.99" VALID(IIF(vCom<=AL_ESTOQ->comiss,IIF(vCom#AL_ESTOQ->comiss,IIF(PERG("Confirma mudanca na comissao ?")="S",.T.,.F.),.T.),.F.) )
@ 15,50 say "P. Vendido =" get vTab pict"@E 9,999,999.99" VALID( IIF(vTab=0,.F.,IIF(vTab<vPrecoDesconto,FALSAMEN("Preco digitado menor que valor de tabela com desconto!",3),.T.)) )
*@ 16,27 say "Cortar ? =" get vCon pict"!" MSG("Tecle <ENTER> para continuar ou <*> p/ para cortar esta mercadoria !") VALID( vCon=" " .or. vCon="*")
read
if (LASTKEY()=27)
RESTSCREEN(00,00,24,79,bALT)
RETURN NIL
end
if UPDATED()
if PERG("Confirma altera‡Æo deste iten ? ")="S"
if (AL_PEDID->tiposa#"01" .and. vCom>0)
MENSAGEM("Atencao, pedido nao e uma venda por isso a comissao deve estar zerada!",3)
RESTSCREEN(00,00,24,79,bALT)
RETURN NIL
end
if vCom>AL_ESTOQ->comiss
MENSAGEM("Item nao pode ser cadastrado, erro na comissao "+str(vCom,5,2),5)
RESTSCREEN(00,00,24,79,bALT)
RETURN NIL
end
if AL_CLIEN->descon>0
vLiq=(vTab-((vTab*AL_CLIEN->descon)/100))
else
vLiq=vTab
end
sele AL_PEDID
RECLOCK(10)
if xCon=" "
repl qtdite with (qtdite-1)
repl vlrtot with (vlrtot-(xQtd * xTab) )
repl descpr with (descpr-IIF(xTabela>xTab,((xTabela-xTab)*xQtd),0))
repl vlrcom with (vlrcom-xVco)
else
repl qtdcan with (qtdcan-1)
repl vlrcan with (vlrcan-(xQtd * xTab) )
end
DBCOMMIT()
DBUNLOCK()
// Inclui os novos valores, normalmente !
sele AL_ITPED
RECLOCK(10)
repl condic with vCon
repl quanti with vQtd
repl preuni with vTab
repl descon with vDes
repl vlrdes with ((vTabela-vTab)*vQtd)
repl pretot with (vQtd * vTab)
repl comiss with vCom
repl preliq with vLiq
repl vlrcom with ( (vLiq*vQtd) * vCom)/100
repl fabric with AL_ESTOQ->fabric
DBCOMMIT()
DBUNLOCK()
sele AL_PEDID
RECLOCK(10)
if vCon=" "
repl qtdite with (qtdite+1)
repl vlrtot with (vlrtot+(vQtd * vTab) )
repl descpr with (descpr+IIF(vTabela>vTab,((vTabela-vTab)*vQtd),0))
repl vlrcom with (vlrcom+(( (vLiq*vQtd) * vCom)/100))
else
repl qtdcan with (qtdcan+1)
repl vlrcan with (vlrcan+(vQtd * vTab) )
end
DBCOMMIT()
DBUNLOCK()
end
end
exit
ENDDO
RESTSCREEN(00,00,24,79,bALT)
RETURN NIL
****************************************************************************
STATIC FUNCTION DESCONTO()
LOCAL bDes:=SAVESCREEN(00,00,24,79)
dVal=AL_PEDID->DESCON
WIN3D(" Desconto ",10,03,12,47,2,"6")
@ 11,04 say "Valor Desconto = " get dVal pict"@E 99,999,999.99"
read
if (LASTKEY()=27)
RESTSCREEN(00,00,24,79,bDes)
RETURN NIL
end
if UPDATED()
sele AL_PEDID
RECLOCK(10)
repl descon with dVal
DBCOMMIT()
DBUNLOCK()
end
RESTSCREEN(00,00,24,79,bDes)
RETURN NIL
****************************************************************************
STATIC FUNCTION COMPLEMENTO()
LOCAL bDes:=SAVESCREEN(00,00,24,79)
if AL_PEDID->tiposa#"16"
RETURN NIL
end
dVal1=AL_PEDID->bascom
dVal2=AL_PEDID->icmcom
dVal3=AL_PEDID->bassub
dVal4=AL_PEDID->icmsub
WIN3D(" Complemento ",10,03,15,47,2,"7")
@ 11,04 say "Base de Calculo = " get dVal1 pict"@E 99,999,999.99"
@ 12,04 say "Vlr. ICMS = " get dVal2 pict"@E 99,999,999.99"
@ 13,04 say "Base C. ST = " get dVal3 pict"@E 99,999,999.99"
@ 14,04 say "Vlr. ICMS ST = " get dVal4 pict"@E 99,999,999.99"
read
if (LASTKEY()=27)
RESTSCREEN(00,00,24,79,bDes)
RETURN NIL
end
if UPDATED()
sele AL_PEDID
RECLOCK(10)
repl bascom with dVal1
repl icmcom with dVal2
repl bassub with dVal3
repl icmsub with dVal4
DBCOMMIT()
DBUNLOCK()
end
RESTSCREEN(00,00,24,79,bDes)
RETURN NIL
****************************************************************************
STATIC FUNCTION DESPESA()
LOCAL bDes:=SAVESCREEN(00,00,24,79)
dVal1=AL_PEDID->despes
WIN3D("Despesas Acessorias",10,03,12,47,2,"7")
@ 11,04 say "Despesas Acesso.= " get dVal1 pict"@E 99,999,999.99"
read
if (LASTKEY()=27)
RESTSCREEN(00,00,24,79,bDes)
RETURN NIL
end
if UPDATED()
sele AL_PEDID
RECLOCK(10)
repl despes with dVal1
DBCOMMIT()
DBUNLOCK()
end
RESTSCREEN(00,00,24,79,bDes)
RETURN NIL
****************************************************************************
STATIC FUNCTION CALC(v_carg,v_codp)
ci_itens=0
ci_valor=0.00
ci_valod=0.00
ci_iteco=0
ci_vlrco=0.00
ci_vlcom=0.00
sele AL_ITPED
DBSETORDER(1)
// Limpa filtro
ORDSCOPE(0,nil); ORDSCOPE(1,nil)
// Refaz o filtro novamente
ORDSCOPE(0,v_carg+v_codp)
ORDSCOPE(1,v_carg+v_codp)
DBGOTOP()
do whil (!EOF() .and. ncarga=v_carg .and. codped=v_codp)
if condic=" "
ci_itens++
ci_valor=(ci_valor+pretot)
ci_valod=(ci_valod+vlrdes)
ci_vlcom=(ci_vlcom+vlrcom)
else
ci_iteco++
ci_vlrco=(ci_vlrco+pretot)
end
skip
end
sele AL_PEDID
DBSETORDER(1)
if DBSEEK(v_carg+v_codp)
RECLOCK(10)
repl qtdite with ci_itens
repl vlrtot with ci_valor
repl descpr with ci_valod
repl qtdcan with ci_iteco
repl vlrcan with ci_vlrco
repl vlrcom with ci_vlcom
DBCOMMIT()
DBUNLOCK()
end
RETURN NIL
*************************************************************************
STATIC FUNCTION PEGA_CLI
xPED[9]:=AL_CLIEN->condpa
xPED[18]:=AL_CLIEN->tipopg
RETURN .T.
************************************************************************
STATIC FUNCTION EXCLUIPED()
LOCAL resp:=.f.
if psenha=" "
MENSAGEM("Algo errado com a senha, verifique!",5)
retu
end
IF PERGUNTA("Tem certeza que deseja apagar o pedido ?") == "S"
sele AL_ITPED
DBSETORDER(1)
// Limpa filtro
ORDSCOPE(0,nil); ORDSCOPE(1,nil)
// Refaz o filtro novamente
ORDSCOPE(0,v_carg+v_codp)
ORDSCOPE(1,v_carg+v_codp)
DBGOTOP()
do whil (!EOF() .and. ncarga=v_carg .and. codped=v_codp)
RECLOCK()
repl delete with pSenha
DBCOMMIT()
DBUNLOCK()
//
RECLOCK()
DBDELETE()
DBCOMMIT()
DBUNLOCK()
//
sele AL_ITPED
DBSETORDER(1)
// Limpa filtro
ORDSCOPE(0,nil); ORDSCOPE(1,nil)
// Refaz o filtro novamente
ORDSCOPE(0,v_carg+v_codp)
ORDSCOPE(1,v_carg+v_codp)
DBGOTOP()
end
// Confere de todos os itens foram excluidos!
sele AL_ITPED
DBSETORDER(1)
sele AL_ITPED
DBSETORDER(1)
// Limpa filtro
ORDSCOPE(0,nil); ORDSCOPE(1,nil)
// Refaz o filtro novamente
ORDSCOPE(0,v_carg+v_codp)
ORDSCOPE(1,v_carg+v_codp)
DBGOTOP()
IF !EOF()
MENSAGEM("Atencao, nao foram excluidos todos os itens do pedido!",5)
CALC(v_carg,v_codp)
else
// Se confirmado que todos os itens foram excluidos, apagar o pedido.
sele AL_PEDID
RECLOCK()
DBDELETE()
DBCOMMIT()
DBUNLOCK()
end
resp=.T.
ENDIF
RETURN(resp)
STATIC FUNCTION FALSAMEN(cTexto,cTempo)
if PERGUNTA(cTexto)="S"
RETURN(.T.)
end
RETURN(.F.)
