Histórico da Página
...
Visando facilitar esse procedimento, a seguir passaremos um exemplo de RdMake, cujo intuito é fazer o vinculo automático das Naturezas de Rendimento com os títulos a pagar/receber que devem ser considerados no EFD-Reinf Bloco 40.
EXEMPLO DE UTILIZAÇÃO
| Aviso | ||
|---|---|---|
| ||
|
EXEMPLO DE UTILIZAÇÃO
| Bloco de código | ||||||||
|---|---|---|---|---|---|---|---|---|
| ||||||||
#include "rwmake.ch"
#include 'tbiconn.ch'
#INCLUDE "PROTHEUS.CH"
Static __lTemDic As Logical
Static __oTitPaga As Object
Static __oTitRece As Object
User Function FinFixB40(aFiliais As Array)
Local lRetorno As Logical
Local cMAEmpSED As Char
Local cMAUniSED As Char
Local cMAFilSED As Char
Local cMAEmpSA1 As Char
Local cMAUniSA1 As Char
Local cMAFilSA1 As Char
Local cMAEmpSA2 As Char
Local cMAUniSA2 As Char
Local cMAFilSA2 As Char
Local cMAEmpSE1 As Char
Local cMAUniSE1 As Char
Local cMAFilSE1 As Char
Local cMAEmpSE2 As Char
Local cMAUniSE2 As Char
Local cMAFilSE2 As Char
Local nTamFilSED As Numeric
Local nTamFilSA1 As Numeric
Local nTamFilSA2 As Numeric
Local nTamFilSE1 As Numeric
Local nTamFilSE2 As Numeric
Local nTamEmp As Numeric
Local nTamUni As Numeric
Local nTamFil As Numeric
PREPARE ENVIRONMENT EMPRESA "T1" FILIAL "D MG 01 " MODULO "FIN" TABLES "SE2", "SE5", "SA6", "SED", "SE1", "SEV", "F71", "SE2"
//Parâmetros de entrada.
Default aFiliais := {cFilAnt}
If __lTemDic == Nil
__lTemDic := cPaisLoc == "BRA" .And. SED->(ColumnPos("ED_NATREN")) > 0
EndIf
If (lRetorno := __lTemDic)
//Inicializa variáveis
lRetorno := .T.
cMAEmpSED := AllTrim(FWModeAccess("SED",1))
cMAUniSED := AllTrim(FWModeAccess("SED",2))
cMAFilSED := AllTrim(FWModeAccess("SED",3))
cMAEmpSA1 := AllTrim(FWModeAccess("SA1",1))
cMAUniSA1 := AllTrim(FWModeAccess("SA1",2))
cMAFilSA1 := AllTrim(FWModeAccess("SA1",3))
cMAEmpSA2 := AllTrim(FWModeAccess("SA2",1))
cMAUniSA2 := AllTrim(FWModeAccess("SA2",2))
cMAFilSA2 := AllTrim(FWModeAccess("SA2",3))
cMAEmpSE1 := AllTrim(FWModeAccess("SE1",1))
cMAUniSE1 := AllTrim(FWModeAccess("SE1",2))
cMAFilSE1 := AllTrim(FWModeAccess("SE1",3))
cMAEmpSE2 := AllTrim(FWModeAccess("SE2",1))
cMAUniSE2 := AllTrim(FWModeAccess("SE2",2))
cMAFilSE2 := AllTrim(FWModeAccess("SE2",3))
nTamFilSED := 0
nTamFilSA1 := 0
nTamFilSA2 := 0
nTamFilSE1 := 0
nTamFilSE2 := 0
nTamEmp := Len(FwSM0Layout(,1))
nTamUni := Len(FwSM0Layout(,2))
nTamFil := Len(FwSM0Layout(,3))
If (nTamEmp+nTamUni) == 0
cMAEmpSED := cMAUniSED := cMAFilSED
cMAEmpSA1 := cMAUniSA1 := cMAFilSA1
cMAEmpSA2 := cMAUniSA2 := cMAFilSA2
cMAEmpSE1 := cMAUniSE1 := cMAFilSE1
cMAEmpSE2 := cMAUniSE2 := cMAFilSE2
Else
If nTamEmp == 0
cMAEmpSED := cMAUniSED
cMAEmpSA1 := cMAUniSA1
cMAEmpSA2 := cMAUniSA2
cMAEmpSE1 := cMAUniSE1
cMAEmpSE2 := cMAUniSE2
ElseIf nTamUni == 0
cMAUniSED := cMAFilSED
cMAUniSA1 := cMAFilSA1
cMAUniSA2 := cMAFilSA2
cMAUniSE1 := cMAFilSE1
cMAUniSE2 := cMAFilSE2
EndIf
EndIf
nTamFilSED := (IIf(cMAEmpSED == "C", 0, nTamEmp) + IIf(cMAUniSED == "C", 0, nTamUni) + IIf(cMAFilSED == "C", 0, nTamFil))
nTamFilSA1 := (IIf(cMAEmpSA1 == "C", 0, nTamEmp) + IIf(cMAUniSA1 == "C", 0, nTamUni) + IIf(cMAFilSA1 == "C", 0, nTamFil))
nTamFilSA2 := (IIf(cMAEmpSA2 == "C", 0, nTamEmp) + IIf(cMAUniSA2 == "C", 0, nTamUni) + IIf(cMAFilSA2 == "C", 0, nTamFil))
nTamFilSE1 := (IIf(cMAEmpSE1 == "C", 0, nTamEmp) + IIf(cMAUniSE1 == "C", 0, nTamUni) + IIf(cMAFilSE1 == "C", 0, nTamFil))
nTamFilSE2 := (IIf(cMAEmpSE2 == "C", 0, nTamEmp) + IIf(cMAUniSE2 == "C", 0, nTamUni) + IIf(cMAFilSE2 == "C", 0, nTamFil))
//Atualiza a natureza de rendimentos do contas a pagar
FinCPag(aFiliais, nTamFilSED, nTamFilSA2, nTamFilSE2)
//Atualiza a natureza de rendimentos do contas a receber
FinCRec(aFiliais, nTamFilSED, nTamFilSA1, nTamFilSE1)
Else
Help(" ", 1, "ATUAMBREINF", Nil, "Ambiente desatualizado", 2, 0, Nil, Nil, Nil, Nil, Nil, {"Para realizar o ajuste da base, é necessário atualizar o ambiente"})
EndIf
Return lRetorno
/*/{Protheus.doc} FinCPag
@type User Function
@author Sivaldo Oliveira
@since 28/08/2023
@param aFiliais, array unidimensional, lista de filais que serão processadas
@return Logical, lRetorno, Logico que indica se ocorreu o processamento de atualização
da natureza de rendimento do títulos a pagar
/*/
Static Function FinCPag(aFiliais As Array, nTamFilSED As Numeric, nTamFilSA2 As Numeric, nTamFilSE2 As Numeric) As Logical
Local lRetorno As Logical
Local lAchouFKF As Logical
Local cTblPagar As Char
Local cQuery As Char
Local cIdDocFK7 As Char
Local cTpImpos As Char
Local nMenorFil As Numeric
Local nTpImpos As Numeric
Local nVlrImpos As Numeric
Local nBaseImpos As Numeric
Local aDados As Array
//Parâmetros de entrada.
Default aFiliais := {cFilAnt}
Default nTamFilSED := 0
Default nTamFilSA2 := 0
Default nTamFilSE2 := 0
//Inicializa variáveis.
Retorno := .T.
lAchouFKF := .T.
cTblPagar := ""
cQuery := ""
cIdDocFK7 := ""
cTpImpos := "SEMIMP"
nMenorFil := 0
nTpImpos := 0
nVlrImpos := 0
nBaseImpos := 0
aDados := {}
If __oTitPaga == Nil
cQuery := "SELECT SE2.E2_FILIAL, SE2.E2_PREFIXO, SE2.E2_NUM, SE2.E2_PARCELA, SE2.E2_TIPO, SE2.E2_FORNECE, SE2.E2_LOJA, SE2.E2_FILORIG, "
cQuery += "SE2.E2_PIS, SE2.E2_COFINS, SE2.E2_CSLL, SE2.E2_IRRF, SE2.E2_VALOR, SE2.E2_SALDO, SE2.E2_BASEIRF, SE2.E2_BASEPIS, SE2.E2_BASECOF, "
cQuery += "SE2.E2_BASECSL, SE2.R_E_C_N_O_, SED.ED_NATREN, SED.ED_CALCIRF, SED.ED_CALCPIS, SED.ED_CALCCOF, SED.ED_CALCCSL, SED.ED_PERCIRF, "
cQuery += "SED.ED_PERCPIS, SED.ED_PERCCOF, SED.ED_PERCCSL, SA2.A2_RECPIS, SA2.A2_RECCOFI, SA2.A2_RECCSLL, SA2.A2_CALCIRF "
cQuery += "FROM ? SE2 "
//Relacionamento: SE2 vs SED
nMenorFil := IIf(nTamFilSED > nTamFilSE2, nTamFilSE2, nTamFilSED)
cQuery += "INNER JOIN ? SED ON "
cQuery += "(SUBSTRING(SE2.E2_FILIAL, 1, " + cValToChar(nMenorFil) + ") = SUBSTRING(SED.ED_FILIAL, 1, " + cValToChar(nMenorFil) + ") "
cQuery += "AND SE2.E2_NATUREZ = SED.ED_CODIGO "
cQuery += "AND SE2.D_E_L_E_T_ = SED.D_E_L_E_T_) "
//Relacionamento: SE2 vs SA2
nMenorFil := IIf(nTamFilSA2 > nTamFilSE2, nTamFilSE2, nTamFilSA2)
cQuery += "INNER JOIN ? SA2 ON "
cQuery += "(SUBSTRING(SE2.E2_FILIAL, 1, " + cValToChar(nMenorFil) + ") = SUBSTRING(SA2.A2_FILIAL, 1, " + cValToChar(nMenorFil) + ") "
cQuery += "AND SE2.E2_FORNECE = SA2.A2_COD "
cQuery += "AND SE2.E2_LOJA = SA2.A2_LOJA "
cQuery += "AND SE2.D_E_L_E_T_ = SA2.D_E_L_E_T_) "
cQuery += "WHERE "
cQuery += "SE2.E2_FILIAL IN (?) "
cQuery += "AND SE2.E2_SALDO > 0 "
cQuery += "AND SE2.E2_TIPO NOT IN ('PR', 'INS', 'TX', 'AB-', 'ISS', 'SES', 'CH') "
cQuery += "AND SE2.E2_ORIGEM NOT IN ('MATA100', 'MATA103') "
cQuery += "AND SE2.D_E_L_E_T_ = ' ' "
cQuery += "AND SED.ED_NATREN IS NOT NULL AND SED.ED_NATREN <> ' ' "
// cQuery += "AND ((SED.ED_CALCIRF = 'S') OR (SED.ED_CALCPIS = 'S') OR (SED.ED_CALCCOF = 'S') OR (SED.ED_CALCCSL = 'S')) "
// cQuery += "AND ((A2_RECPIS = '2') OR (A2_RECCOFI = '2') OR (A2_RECCSLL = '2') OR (A2_CALCIRF <> '2')) "
cQuery := ChangeQuery(cQuery)
__oTitPaga := FwPreparedStatement():New(cQuery)
EndIf
__oTitPaga:SetNumeric(1, RetSqlName("SE2"))
__oTitPaga:SetNumeric(2, RetSqlName("SED"))
__oTitPaga:SetNumeric(3, RetSqlName("SA2"))
__oTitPaga:SetIn(4, aFiliais)
cQuery := __oTitPaga:GetFixQuery()
cTblPagar := MpSysOpenQuery(cQuery)
DbSelectArea("FKF")
FKF->(DbSetOrder(1))
While (cTblPagar)->(!Eof())
cIdDocFK7 := FINBuscaFK7((cTblPagar)->(E2_FILIAL+"|"+E2_PREFIXO+"|"+E2_NUM+"|"+E2_PARCELA+"|"+E2_TIPO+"|"+E2_FORNECE+"|"+E2_LOJA), "SE2", (cTblPagar)->E2_FILORIG)
If Empty(cIdDocFK7)
(cTblPagar)->(DbSkip())
Loop
EndIf
lAchouFKF := FKF->(MsSeek(xFilial("FKF", (cTblPagar)->E2_FILORIG)+cIdDocFK7))
If (!lAchouFKF .Or. (lAchouFKF .And. !Empty(FKF->FKF_NATREN)))
(cTblPagar)->(DbSkip())
Loop
EndIf
//Atualiza FKF
RecLock("FKF", .F.)
FKF->FKF_NATREN := (cTblPagar)->ED_NATREN
FKF->(MsUnLock())
For nTpImpos := 1 To 5
Do Case
Case nTpImpos == 1 //IRRF
If (AllTrim((cTblPagar)->ED_CALCIRF) != "S" .Or. (cTblPagar)->ED_PERCIRF <= 0 .Or. AllTrim((cTblPagar)->A2_CALCIRF) != "1")
Loop
EndIf
cTpImpos := "IRF"
nVlrImpos := (cTblPagar)->E2_IRRF
nBaseImpos := (cTblPagar)->E2_BASEIRF
Case nTpImpos == 2 //PIS
If (AllTrim((cTblPagar)->ED_CALCPIS) != "S" .Or. (cTblPagar)->ED_PERCPIS <= 0 .Or. AllTrim((cTblPagar)->A2_RECPIS) != "2")
Loop
EndIf
cTpImpos := "PIS"
nVlrImpos := (cTblPagar)->E2_PIS
nBaseImpos := (cTblPagar)->E2_BASEPIS
Case nTpImpos == 3 //COFINS
If (AllTrim((cTblPagar)->ED_CALCCOF) != "S" .Or. (cTblPagar)->ED_PERCCOF <= 0 .Or. AllTrim((cTblPagar)->A2_RECCOFI) != "2")
Loop
EndIf
cTpImpos := "COF"
nVlrImpos := (cTblPagar)->E2_COFINS
nBaseImpos := (cTblPagar)->E2_BASECOF
Case nTpImpos == 4 //CSLL
If (AllTrim((cTblPagar)->ED_CALCCSL) != "S" .Or. (cTblPagar)->ED_PERCCSL <= 0 .Or. AllTrim((cTblPagar)->A2_RECCSLL) != "2")
Loop
EndIf
cTpImpos := "CSL"
nVlrImpos := (cTblPagar)->E2_CSLL
nBaseImpos := (cTblPagar)->E2_BASECSL
OtherWise // Títulos sem impostos
If Len(aDados) == 0
cTpImpos := "SEMIMP"
nVlrImpos := 0
nBaseImpos := (cTblPagar)->E2_VALOR
EndIf
EndCase
AAdd(aDados, {;
(cTblPagar)->E2_FILIAL,;
cIdDocFK7,;
cTpImpos,;
(cTblPagar)->ED_NATREN,;
100,;
nBaseImpos,;
0,; //valor do impos retido 7
0,; //Base imposto nao retido 8
0,; //Valor do impoto nao retido 9
"",; //Numero Processo Judicial 10
"",; //Tipo Processo 11
"",; //Cod. Indicativo suspensao 12
0})
Next nTpImpos
(cTblPagar)->(DbSkip())
EndDo
(cTblPagar)->(DbCloseArea())
//Gravação do FKW
If Len(aDados) > 0
F070Grv(aDados, 4, "1")
EndIf
Return lRetorno
/*/{Protheus.doc} FinCRec
@type User Function
@author Sivaldo Oliveira
@since 28/08/2023
@param aFiliais, array unidimensional, lista de filais que serão processadas
@return Logical, lRetorno, Logico que indica se ocorreu o processamento de atualização
da natureza de rendimento do títulos a receber
/*/
Static Function FinCRec(aFiliais As Array, nTamFilSED As Numeric, nTamFilSA1 As Numeric, nTamFilSE1 As Numeric) As Logical
Local lRetorno As Logical
Local lAchouFKF As Logical
Local cTblTmp As Char
Local cQuery As Char
Local cIdDocFK7 As Char
Local cTpImpos As Char
Local nMenorFil As Numeric
Local aDados As Array
//Parâmetros de entrada.
Default aFiliais := {cFilAnt}
Default nTamFilSED := 0
Default nTamFilSA1 := 0
Default nTamFilSE1 := 0
//Inicializa variáveis.
Retorno := .T.
lAchouFKF := .T.
cTblTmp := ""
cQuery := ""
cIdDocFK7 := ""
nMenorFil := 0
aDados := {}
If __oTitRece == Nil
cQuery := "SELECT SE1.E1_FILIAL, SE1.E1_PREFIXO, SE1.E1_NUM, SE1.E1_PARCELA, SE1.E1_TIPO, SE1.E1_CLIENTE, SE1.E1_LOJA, SE1.E1_FILORIG, SE1.E1_PIS, "
cQuery += "SE1.E1_COFINS, SE1.E1_CSLL, SE1.E1_IRRF, SE1.E1_VALOR, SE1.E1_SALDO, SE1.E1_BASEIRF, SE1.E1_BASEPIS, SE1.E1_BASECOF, SE1.E1_BASECSL, "
cQuery += "SE1.R_E_C_N_O_, SED.ED_NATREN, SED.ED_CALCIRF, SED.ED_CALCPIS, SED.ED_CALCCOF, SED.ED_CALCCSL, SED.ED_PERCIRF, SED.ED_PERCPIS, "
cQuery += "SED.ED_PERCCOF,SED.ED_PERCCSL FROM ? SE1 "
//Relacionamento: SE1 vs SED
nMenorFil := IIf(nTamFilSED > nTamFilSE1, nTamFilSE1, nTamFilSED)
cQuery += "INNER JOIN ? SED ON "
cQuery += "(SUBSTRING(SE1.E1_FILIAL , 1 , " + cValToChar(nMenorFil) + ") = SUBSTRING(SED.ED_FILIAL , 1 , " + cValToChar(nMenorFil) + ") "
cQuery += "AND SE1.E1_NATUREZ = SED.ED_CODIGO "
cQuery += "AND SE1.D_E_L_E_T_ = SED.D_E_L_E_T_) "
//Relacionamento: SE1 vs SA1
nMenorFil := IIf(nTamFilSA1 > nTamFilSE1, nTamFilSE1, nTamFilSA1)
cQuery += "INNER JOIN ? SA1 ON "
cQuery += "(SUBSTRING(SE1.E1_FILIAL , 1 , " + cValToChar(nMenorFil) + ") = SUBSTRING(SA1.A1_FILIAL , 1 , " + cValToChar(nMenorFil) + ") "
cQuery += "AND SE1.E1_CLIENTE = SA1.A1_COD "
cQuery += "AND SE1.E1_LOJA = SA1.A1_LOJA "
cQuery += "AND SE1.D_E_L_E_T_ = SA1.D_E_L_E_T_)"
//Filtro de linhas
cQuery += "WHERE "
cQuery += "SE1.E1_FILIAL IN (?) AND SE1.E1_SALDO > 0 "
cQuery += "AND SE1.E1_TIPO NOT IN ('PR', 'INS', 'TX', 'AB-', 'ISS', 'SES', 'CH') "
cQuery += "AND SE1.E1_ORIGEM NOT IN ('MATA460', 'MATA461') "
cQuery += "AND SED.ED_NATREN IS NOT NULL AND SED.ED_NATREN <> ' ' AND SED.ED_CALCIRF = 'S' "
cQuery += "AND SA1.A1_RECIRRF = '2' AND SE1.D_E_L_E_T_ = ' ' "
cQuery := ChangeQuery(cQuery)
__oTitRece := FwPreparedStatement():New(cQuery)
EndIf
__oTitRece:SetNumeric(1, RetSqlName("SE1"))
__oTitRece:SetNumeric(2, RetSqlName("SED"))
__oTitRece:SetNumeric(3, RetSqlName("SA1"))
__oTitRece:SetIn(4, aFiliais)
cQuery := __oTitRece:GetFixQuery()
cTblTmp := MpSysOpenQuery(cQuery)
DbSelectArea("FKF")
FKF->(DbSetOrder(1))
While (cTblTmp)->(!Eof())
cIdDocFK7 := FINBuscaFK7((cTblTmp)->(E1_FILIAL+"|"+E1_PREFIXO+"|"+E1_NUM+"|"+E1_PARCELA+"|"+E1_TIPO+"|"+E1_CLIENTE+"|"+E1_LOJA), "SE1", (cTblTmp)->E1_FILORIG)
If Empty(cIdDocFK7)
(cTblTmp)->(DbSkip())
Loop
EndIf
lAchouFKF := FKF->(MsSeek(xFilial("FKF", (cTblTmp)->E1_FILORIG)+cIdDocFK7))
If (!lAchouFKF .Or. (lAchouFKF .And. !Empty(FKF->FKF_NATREN)))
(cTblTmp)->(DbSkip())
Loop
EndIf
//Atualiza FKF
RecLock("FKF", .F.)
FKF->FKF_NATREN := (cTblTmp)->ED_NATREN
FKF->(MsUnLock())
AAdd(aDados, {;
(cTblTmp)->E1_FILIAL,;
cIdDocFK7,;
"IRF",;
(cTblTmp)->ED_NATREN,;
100,;
(cTblTmp)->E1_BASEIRF,;
(cTblTmp)->E1_IRRF,;
0,; //Base imposto nao retido 8
0,; //Valor do impoto nao retido 9
"",; //Numero Processo Judicial 10
"",; //Tipo Processo 11
"",; //Cod. Indicativo suspensao 12
0})
(cTblTmp)->(DbSkip())
EndDo
(cTblTmp)->(DbCloseArea())
//Gravação do FKW
If Len(aDados) > 0
F070Grv(aDados, 4, "2")
EndIf
Return lRetorno
|
...
Visão Geral
Import HTML Content
Conteúdo das Ferramentas
Tarefas