• O fonte de exemplo abaixo está utilizando o conceito de preenchimento da(s) Natureza(s) de Rendimento dos facilitadores abaixo:
  • Documento de Entrada - Preenchimento automático da Natureza de Rendimento
  • Pedido de Vendas - Preenchimento automático da Natureza de Rendimento
  • Títulos do financeiro e demais origens - Preenchimento automático da Natureza de Rendimento
• Portanto, para utilizar esse modelo de preenchimento das Naturezas de Rendimento, revise o cadastro de Produto (para Doc. de Entrada/Saída) e o cadastro de Naturezas Financeiras (para títulos sem vinculo com nota fiscal);
• Para que o processamento não seja muito oneroso, o fonte de exemplo possui um filtro de data de emissão do título a partir de 01/01/2023, mas caso queira modificar a data, basta ajustar a atribuitação da variavel "cDtIni". 
• O fonte de exemplo não terá efeito sobre títulos que já foram totalmente baixados. A proposta do Rdmake é que seja executado antes de realizar as baixas dentro do período de vigência do bloco 40, pois irá gerar dados na tabela FKW, que é pré-condição para gravar os dados na tabela FKY (Baixas x Natureza de Rendimento);
• Recomendamos que seja aplicado o FIX primeiramente em ambiente de homologação antes de efetiva-lo no ambiente produtivo do Protheus;

#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