No artigo de hoje, vou mostrar como deixar informações pré salvas antes de efetivar um cadastro.
Em um cliente, tem um usuário que fazia pedidos de compras, e digitava cerca de 300 a 400 itens, e as vezes ele precisava ter que resolver alguma coisa em outro setor, e o timeout da rede da empresa às vezes encerrava a conexão dele.
Cogitamos em aumentar o timeout, mas como na parte da rede eles não podiam mexer, então solicitaram para que a alternativa fosse feita no ERP.
Para isso, foi criado a seguinte lógica:
- Criar uma ação no Outras Ações do Pedidos de Compras
- Essa função irá abrir uma tela com uma grid, e aqui começa nossa mágica
- Se existir um arquivo texto na temporária do Windows, irá carregar as informações desse arquivo para a grid, se não existir, irá criar o arquivo em branco
- Na alteração entre as linhas para cima ou para baixo, será feito um laço de repetição, copiando todas as informações e jogando para esse arquivo texto
Dessa forma, se cair a conexão do usuário, ou até mesmo ele fechar propositalmente o Protheus, ao abrir novamente, o arquivo texto será lido, processado e a grid será atualizada com as informações.
Abaixo o exemplo do código fonte desenvolvido:
//Bibliotecas
#Include "TOTVS.ch"
/*/{Protheus.doc} User Function MT121BRW
Ponto de entrada para adicionar outras ações no Pedido de Compras
@type Function
@author Atilio
@since 10/03/2018
@version version
/*/
User Function MT121BRW()
Local aArea := GetArea()
aAdd(aRotina,{"* Incluir Pedido" ,"U_ACOMM01" , 0, 2, 0, Nil })
RestArea(aArea)
Return
/*/{Protheus.doc} User Function ACOMM01
Facilitador para inclusão de pedidos de compras que ficam sempre na memória os itens
@type Function
@author Atilio
@since 10/03/2018
@version version
/*/
User Function ACOMM01()
Local aArea := GetArea()
Local oDlgPed
Local cMaskQtd := PesqPict('SC7', 'C7_QUANT')
//Fontes
Local cFontPad := "Tahoma"
Local oFontMod := TFont():New(cFontPad, , -38)
Local oFontSub := TFont():New(cFontPad, , -20)
Local oFontSubN := TFont():New(cFontPad, , -20, , .T.)
//Tamanho de componentes
Local aTamanho := MsAdvSize()
Local nJanLarg := aTamanho[5] - 100
Local nJanAltu := aTamanho[6] - 200
Local nLargBtn := 50
//Fornecedor e loja
Private cFornPad := "F00001"
Private cLojaPad := "01"
Private cTabePad := "001"
//Variaveis privadas da tela
Private oSayModulo, cSayModulo := 'COM'
Private oSayTitulo, cSayTitulo := 'Inclusão de'
Private oSaySubTit, cSaySubTit := 'Pedidos de Compras'
Private oMsGetCom
Private aHeaderCom := {}
Private aColsCom := {}
Private aColsEdit := {"XX_PRODUTO", "XX_PRAZO", "XX_QTDE", "XX_OBSERV"}
//Posições das colunas
Private nPosProd := 1
Private nPosDesc := 2
Private nPosQtde := 3
Private nPosObse := 4
Private nPosBlan := 5
Private nPosDele := 6
//Diretório e arquivos temporários
Private cPastaTmp := GetTempPath()
Private cArquiTmp := "pedido_compra_ACOMM01.txt"
//Monta o aHeader das Interações
// Titulo Campo Picture Tamanho Dec Valid Usado Tipo F3
aAdd(aHeaderCom,{ "Produto", "XX_PRODUTO", "", TamSX3('C7_PRODUTO')[01], 0, "u_zVldCo01(1)", ".T.", "C", "SB1", ""} )
aAdd(aHeaderCom,{ "Descricao", "XX_DESCRIC", "", 30, 0, ".F.", ".F.", "C", "", ""} )
aAdd(aHeaderCom,{ "Quantidade", "XX_QTDE", cMaskQtd, TamSX3('C7_QUANT')[01], TamSX3('C7_QUANT')[02], "Positivo()", ".T.", "N", "", ""} )
aAdd(aHeaderCom,{ "Observação", "XX_OBSERV", "", TamSX3('C7_OBS')[01], 0, ".T.", ".T.", "C", "", ""} )
aAdd(aHeaderCom,{ " ", "XX_BLANK", "", 1, 0, ".F.", ".F.", "C", "", ""} )
If File(cPastaTmp + cArquiTmp)
Processa( {|| fBuscaDad()}, "Buscando informações...")
EndIf
oDlgPed := TDialog():New(0, 0, nJanAltu, nJanLarg, "Novo Pedido de Compra", , , , , CLR_BLACK, RGB(250, 250, 250), , , .T.)
//Títulos e SubTítulos
oSayModulo := TSay():New(004, 003, {|| cSayModulo}, oDlgPed, "", oFontMod, , , , .T., RGB(149, 179, 215), , 200, 30, , , , , , .F., , )
oSayTitulo := TSay():New(004, 045, {|| cSayTitulo}, oDlgPed, "", oFontSub, , , , .T., RGB(031, 073, 125), , 200, 30, , , , , , .F., , )
oSaySubTit := TSay():New(014, 045, {|| cSaySubTit}, oDlgPed, "", oFontSubN, , , , .T., RGB(031, 073, 125), , 300, 30, , , , , , .F., , )
//Botões
oBtnFech := TButton():New(006, (nJanLarg/2-001)-((nLargBtn+2)*01), "Fechar", oDlgPed, {|| oDlgPed:End()}, nLargBtn, 018, , , , .T., , , , , , )
oBtnConf := TButton():New(006, (nJanLarg/2-001)-((nLargBtn+2)*02), "Confirmar", oDlgPed, {|| fConfirmar()}, nLargBtn, 018, , , , .T., , , , , , )
oBtnFech := TButton():New(006, (nJanLarg/2-001)-((nLargBtn+2)*03), "Limpar", oDlgPed, {|| fLimpar()}, nLargBtn, 018, , , , .T., , , , , , )
//Grid dos produtos
oMsGetCom := MsNewGetDados():New(;
027,; //nTop
003,; //nLeft
(nJanAltu/2) - 3,; //nBottom
(nJanLarg/2) - 3,; //nRight
GD_INSERT + GD_UPDATE + GD_DELETE,; //nStyle
"AllwaysTrue()",; //cLinhaOk
,; //cTudoOk
"",; //cIniCpos
aColsEdit,; //aAlter
,; //nFreeze
99999999,; //nMax
,; //cFieldOK
,; //cSuperDel
,; //cDelOk
oDlgPed,; //oWnd
aHeaderCom,; //aHeader
aColsCom) //aCols
oMsGetCom:bChange := {|| fGravaTemp() }
oDlgPed:Activate(, , , .T., {|| .T.}, , {|| } )
RestArea(aArea)
Return
/*/{Protheus.doc} User Function zVldCo01
Função para validar as colunas da grid
@type Function
@author Atilio
@since 31/03/2021
@version version
/*/
User Function zVldCo01(nTipo)
Local aArea := GetArea()
Local lRet := .T.
Local nLinha := oMsGetCom:nAt
Local aColsAux := oMsGetCom:aCols
Local cCodProd := ""
Default nTipo := 1
//Se for o código do produto
If nTipo == 1
cCodProd := Alltrim(&(ReadVar()))
DbSelectArea('SB1')
SB1->(DbSetOrder(1)) // B1_FILIAL + B1_COD
//Valida se o produto existe
If SB1->(DbSeek(FWxFilial('SB1') + cCodProd))
DbSelectArea('AIB')
AIB->(DbSetOrder(2)) // AIB_FILIAL + AIB_CODFOR + AIB_LOJFOR + AIB_CODTAB + AIB_CODPRO
//Se existir na tabela do fornecedor
If AIB->(DbSeek(FWxFilial('AIB') + cFornPad + cLojaPad + cTabePad + SB1->B1_COD))
aColsAux[nLinha][nPosProd] := SB1->B1_COD
aColsAux[nLinha][nPosDesc] := SubStr(SB1->B1_DESC, 1, 30)
Else
lRet := .F.
MsgStop("Produto não encontrado na tabela de preço - " + cFornPad + "!", "Atenção")
EndIf
Else
lRet := .F.
MsgStop("Produto não encontrado!", "Atenção")
EndIf
EndIf
RestArea(aArea)
Return lRet
Static Function fGravaTemp()
Local cTexto := ""
Local nAtual := 0
Local aColsAux := oMsGetCom:aCols
//Percorre as linhas, e se não tiver excluida, grava na variável
For nAtual := 1 To Len(aColsAux)
If ! aColsAux[nAtual][nPosDele]
cTexto += aColsAux[nAtual][nPosProd]+";"
cTexto += aColsAux[nAtual][nPosDesc]+";"
cTexto += cValToChar(aColsAux[nAtual][nPosQtde])+";"
cTexto += aColsAux[nAtual][nPosObse]+";"
cTexto += CRLF
EndIf
Next
//Gera o arquivo texto
MemoWrite(cPastaTmp + cArquiTmp, cTexto)
Return
Static Function fBuscaDad()
Local nAtual := 0
Local cArquivo := cPastaTmp + cArquiTmp
oFile := FWFileReader():New(cArquivo)
//Se o arquivo pode ser aberto
If (oFile:Open())
//Se não for fim do arquivo
If ! (oFile:EoF())
//Definindo o tamanho da régua
aLinhas := oFile:GetAllLines()
ProcRegua(Len(aLinhas))
//Método GoTop não funciona, deve fechar e abrir novamente o arquivo
oFile:Close()
oFile := FWFileReader():New(cArquivo)
oFile:Open()
While (oFile:HasLine())
//Incrementando a régua
nAtual++
IncProc("Analisando linha " + cValToChar(nAtual) + " de " + cValToChar(Len(aLinhas)) + "...")
//Buscando o texto da linha atual
cLinAtu := oFile:GetLine()
//Se tiver conteúdo na linha atual
If ! Empty(cLinAtu)
aDadosAux := StrTokArr(cLinAtu, ";")
If ! Empty(aDadosAux[nPosProd])
aAdd(aColsCom, {;
aDadosAux[nPosProd],;
aDadosAux[nPosDesc],;
Val(aDadosAux[nPosQtde]),;
aDadosAux[nPosObse],;
"",;
.F.;
})
EndIf
EndIf
EndDo
EndIf
//Fecha o arquivo e finaliza o processamento
oFile:Close()
EndIf
Return
Static Function fLimpar()
//Zera o array e apaga o arquivo temporário
If MsgYesNo("Tem certeza que deseja limpar os itens?", "Atenção")
aColsCom := {}
aAdd(aColsCom, {;
Space(TamSX3('C7_PRODUTO')[01]),;
Space(30),;
0,;
Space(TamSX3('C7_OBS')[01]),;
"",;
.F.;
})
oMsGetCom:SetArray(aColsCom)
FErase(cPastaTmp + cArquiTmp)
EndIf
Return
Static Function fConfirmar()
Local aColsAux := oMsGetCom:aCols
Local nTotalItens := Len(aColsAux)
Local nMinutos := Round(nTotalItens/15, 0) //média de 15 itens por minuto
If MsgYesNo("Esse procedimento, levará em média " + cValToChar(nMinutos) + " minutos. Deseja continuar?", "Atenção")
Processa( {|| fInclui()}, "Incluindo pedido...")
EndIf
Return
Static Function fInclui()
Local aCabC7 := {}
Local aItensC7 := {}
Local aColsAux := oMsGetCom:aCols
Local nAtual
Local aLinAux
Local lAborta := .F.
Local cProdutos := ""
Private lMSErroAuto := .F.
ProcRegua(0)
IncProc("Adicionando o cabeçalho")
//Monta o cabeçalho
aCabC7 := {;
{'C7_FILIAL', cFilAnt, Nil},;
{'C7_FORNECE', cFornPad, Nil},;
{'C7_LOJA', cLojaPad, Nil},;
{'C7_COND', "026", Nil},;
{'C7_EMISSAO', Date(), Nil},;
{'C7_MOEDA', 1, Nil},;
{'C7_CONTATO', "Teste", Nil},;
{'C7_FILENT', cFilAnt, Nil},;
{'C7_TXMOEDA', 1, Nil};
}
//Insere os itens
ProcRegua(Len(aColsAux))
For nAtual := 1 To Len(aColsAux)
IncProc("Adicionando produto " + cValToChar(nAtual) + " de " + cValToChar(Len(aColsAux)) + "...")
aLinAux := {}
//Se a linha não estiver excluída
If ! aColsAux[nAtual][nPosDele]
//Faz a validação para ver se o produto tem preço
If fVldPreco(aColsAux[nAtual][nPosProd], nAtual)
aAdd(aLinAux, {"C7_ITEM", StrZero(nAtual, 4), Nil} )
aAdd(aLinAux, {"C7_PRODUTO", aColsAux[nAtual][nPosProd], Nil} )
aAdd(aLinAux, {"C7_QUANT", aColsAux[nAtual][nPosQtde], Nil} )
aAdd(aLinAux, {"C7_CODTAB", cTabePad, Nil} )
aAdd(aLinAux, {"C7_OBS", aColsAux[nAtual][nPosObse], Nil} )
aAdd(aItensC7, aClone(aLinAux))
Else
cProdutos += "<li>" + Alltrim(aColsAux[nAtual][nPosProd]) + "</li>"
lAborta := .T.
EndIf
EndIf
Next
//Se for abortar, irá mostrar a mensagem
If lAborta
MsgStop("Os seguintes produtos estão com o preço zerado na tabela de preço '" + cTabePad + "' do fornecedor '" + cFornPad + "': <br><ul>" + cProdutos + "</ul>", "Atenção")
//Se não tiver sido abortado
Else
//Inicia a transação e chama a inclusão do pedido
Begin Transaction
ProcRegua(2)
IncProc("Efetivando a gravação...")
MSExecAuto({|v, x, y, z, w| MATA120(v, x, y, z, w) }, 1, aCabC7, aItensC7, 3, .F.)
If lMsErroAuto
MostraErro()
Else
MsgInfo("Pedido de compras gerado, código: " + SC7->C7_NUM, "Atenção")
EndIf
//DisarmTransaction()
End Transaction
EndIf
Return
Static Function fVldPreco(cCodProd, nLinAtu)
Local aArea := GetArea()
Local lRet := .F.
Local cQuery := ""
//Monta a consulta buscando o preço na tabela de preço do fornecedor
cQuery += " SELECT " + CRLF
cQuery += " AIB_PRCCOM " + CRLF
cQuery += " FROM " + CRLF
cQuery += " " + RetSQLName("AIB") + " AIB " + CRLF
cQuery += " WHERE " + CRLF
cQuery += " AIB_CODFOR = '" + cFornPad + "' " + CRLF
cQuery += " AND AIB_LOJFOR = '" + cLojaPad + "' " + CRLF
cQuery += " AND AIB_CODTAB = '" + cTabePad + "' " + CRLF
cQuery += " AND AIB_CODPRO = '" + cCodProd + "' " + CRLF
cQuery += " AND AIB.D_E_L_E_T_ = ' ' " + CRLF
TCQuery cQuery New Alias "QRY_AIB"
//Se não tiver no fim do arquivo
If ! QRY_AIB->(EoF())
//Se tiver preço
If QRY_AIB->AIB_PRCCOM > 0
lRet := .T.
Else
lRet := .F.
//MsgStop("Produto '" + Alltrim(cCodProd) + "' na linha '" + cValToChar(nLinAtu) + "' está com o preço zerado na tabela de preço '" + cTabePad + "' do fornecedor '" + cFornPad + "'!", "Atenção")
EndIf
//Senão, não foi encontrado registro
Else
lRet := .F.
//MsgStop("Produto '" + Alltrim(cCodProd) + "' na linha '" + cValToChar(nLinAtu) + "' não encontrado na tabela de preço '" + cTabePad + "' do fornecedor '" + cFornPad + "'!", "Atenção")
EndIf
QRY_AIB->(DbCloseArea())
RestArea(aArea)
Return lRet
Obs.: A classe MsNewGetDados foi descontinuada, não recomendo criar rotinas do zero com ela, para isso tente usar por exemplo a FwBrowse e/ou MVC, nesse link tem exemplos – Migrando do MSNewGetDados para FWBrowse e MVC.
Bom pessoal, por hoje é só.
Abraços e até a próxima.
