Option Explicit

Private Const VALOR_LIMITE_1 = 675
Private Const VALOR_LIMITE_2 = 2000

Private Const TAXA_LIMITE_1 = 0.025
Private Const TAXA_LIMITE_2 = 0.12

Public Function TrataReducaoRemuneratoria2014(oProcessamento As RhpBEProcessamento) As Boolean
Dim dblCoefReducao      As Double
Dim dblCoefReducaoPSFer As Double
Dim dblCoefReducaoPSNat As Double
Dim dblValorSujeito     As Double
Dim dblValorPropSFer    As Double
Dim dblValorPropSNat    As Double
Dim oProcRem            As RhpBEProcRemuneracao
Dim oProcHoraExtra      As RhpBEProcHoraExtra

    On Error GoTo Erro

    If Not FuncionarioSujeito(oProcessamento.funcionario) Then
        TrataReducaoRemuneratoria2014 = True
        Exit Function
    End If
    
    dblValorSujeito = 0
    dblValorPropSFer = 0
    dblValorPropSNat = 0
    
    dblCoefReducao = 0
    dblCoefReducaoPSFer = 0
    dblCoefReducaoPSNat = 0
    
    'Calcula o valor total das remuneraes sujeitas  reduo
    For Each oProcRem In oProcessamento.Remuneracoes
        If RemuneracaoSujeita(oProcRem.Remuneracao) Then
            'Caso seja um processamento com fim de contrato os valores tero de ser calculados separadamente
            If oProcessamento.TipoProcessamento = tpFimContrato Then
                If ((oProcRem.Remuneracao = BSO.RecursosHumanos.Params.CodSubsFerias) Or (oProcRem.Remuneracao = BSO.RecursosHumanos.Params.CodPropSubsFeriasAno)) Then
                    dblValorPropSFer = dblValorPropSFer + oProcRem.Valor
                ElseIf ((oProcRem.Remuneracao = BSO.RecursosHumanos.Params.CodSubsNatal) Or (oProcRem.Remuneracao = BSO.RecursosHumanos.Params.CodPropSubsNatal)) Then
                    dblValorPropSNat = dblValorPropSNat + oProcRem.Valor
                Else
                    dblValorSujeito = dblValorSujeito + oProcRem.Valor
                End If
            ElseIf oProcessamento.TipoProcessamento = tpSubsNatal Then
                dblValorSujeito = dblValorSujeito + oProcRem.ValorUnitario
            Else
                dblValorSujeito = dblValorSujeito + oProcRem.Valor
            End If
        End If
    Next
    Set oProcRem = Nothing
    
    'Calcula o valor total das horas extras sujeitas  reduo
    For Each oProcHoraExtra In oProcessamento.HorasExtra
        If HoraExtraSujeita(oProcHoraExtra.HoraExtra) Then
            dblValorSujeito = dblValorSujeito + oProcHoraExtra.Valor
        End If
    Next
    Set oProcHoraExtra = Nothing
    
    If oProcessamento.TipoProcessamento = tpFimContrato Then
        'Calcula o coeficiente do proporcional do sub. de frias para tratar a reduo
        If dblValorPropSFer > VALOR_LIMITE_1 Then
            dblCoefReducaoPSFer = CalculaCoefReducaoRemuneratoria(dblValorPropSFer)
        End If
        
        'Calcula o coeficiente do proporcional do sub. de natal para tratar a reduo
        If dblValorPropSNat > VALOR_LIMITE_1 Then
            dblCoefReducaoPSNat = CalculaCoefReducaoRemuneratoria(dblValorPropSNat)
        End If
    End If
    
    If dblValorSujeito > VALOR_LIMITE_1 Then
        'Calcula o coeficiente para tratar a reduo
        dblCoefReducao = CalculaCoefReducaoRemuneratoria(dblValorSujeito)
    End If
    
    'Caso o total das remuneraes seja superior a 1.500 aplica a reduo
    If dblCoefReducao <> 0 Or dblCoefReducaoPSFer <> 0 Or dblCoefReducaoPSNat <> 0 Then
        'Aplica a reduo s remuneraes sujeitas
        For Each oProcRem In oProcessamento.Remuneracoes
            If RemuneracaoSujeita(oProcRem.Remuneracao) Then
                'Caso seja um processamento com fim de contrato os valores tero de ser calculados separadamente
                If oProcessamento.TipoProcessamento = tpFimContrato Then
                    If ((oProcRem.Remuneracao = BSO.RecursosHumanos.Params.CodSubsFerias) Or (oProcRem.Remuneracao = BSO.RecursosHumanos.Params.CodPropSubsFeriasAno)) Then
                        oProcRem.ValorIliquido = Round(oProcRem.ValorIliquido - (oProcRem.ValorIliquido * dblCoefReducaoPSFer), BSO.Contexto.MBaseDecArredonda)
                    ElseIf ((oProcRem.Remuneracao = BSO.RecursosHumanos.Params.CodSubsNatal) Or (oProcRem.Remuneracao = BSO.RecursosHumanos.Params.CodPropSubsNatal)) Then
                        oProcRem.ValorIliquido = Round(oProcRem.ValorIliquido - (oProcRem.ValorIliquido * dblCoefReducaoPSNat), BSO.Contexto.MBaseDecArredonda)
                    Else
                        oProcRem.ValorIliquido = Round(oProcRem.ValorIliquido - (oProcRem.ValorIliquido * dblCoefReducao), BSO.Contexto.MBaseDecArredonda)
                    End If
                Else
                    oProcRem.ValorIliquido = Round(oProcRem.ValorIliquido - (oProcRem.ValorIliquido * dblCoefReducao), BSO.Contexto.MBaseDecArredonda)
                End If
                
            End If
        Next
        Set oProcRem = Nothing
        
        'Aplica a reduo s remuneraes sujeitas
        For Each oProcHoraExtra In oProcessamento.HorasExtra
            If HoraExtraSujeita(oProcHoraExtra.HoraExtra) And Not oProcHoraExtra.Percentual Then
                oProcHoraExtra.ValorUnitario = Round(oProcHoraExtra.ValorUnitario - (oProcHoraExtra.ValorUnitario * dblCoefReducao), BSO.Contexto.MBaseDecArredonda)
            End If
        Next
        Set oProcHoraExtra = Nothing
    End If
    
    TrataReducaoRemuneratoria2014 = True
    
    Exit Function
    
Erro:
    TrataReducaoRemuneratoria2014 = False
    MsgBox "Ocorreu um erro ao calcular a reduo remuneratria." & vbCrLf & Err.Number & " - " & Err.Source & vbCrLf & Err.Description, vbInformation, Aplicacao.Nome
End Function


Private Function CalculaCoefReducaoRemuneratoria(dbValorSujeito As Double) As Double
Dim dblCoef      As Double

    On Error GoTo Erro
    
    dblCoef = 0
    
    If dbValorSujeito > VALOR_LIMITE_1 Then 'S calcula o coef. caso o total das remun. seja superior a 675 

        Select Case dbValorSujeito
        
            Case Is < VALOR_LIMITE_2 'Caso o total das remun. seja inferior a 2.000 
                
                dblCoef = TAXA_LIMITE_1 + ((TAXA_LIMITE_2 - TAXA_LIMITE_1) * ((dbValorSujeito - VALOR_LIMITE_1) / (VALOR_LIMITE_2 - VALOR_LIMITE_1)))
                
                'Se o resultado do coeficiente aplicado for inferior a 675  calcula um novo para perfazer os 675
                If Round(dbValorSujeito - (dbValorSujeito * dblCoef), BSO.Contexto.MBaseDecArredonda) < VALOR_LIMITE_1 Then
                    dblCoef = (dbValorSujeito - VALOR_LIMITE_1) / dbValorSujeito
                End If
            
            Case Else 'Caso o total das remun. seja superior a 2000 
                dblCoef = TAXA_LIMITE_2
                
        End Select
    
    End If
    
    CalculaCoefReducaoRemuneratoria = dblCoef
    
    Exit Function
    
Erro:
    Err.Raise Err.Number, Err.Source, Err.Description
End Function

Private Function FuncionarioSujeito(funcionario As String) As Boolean
Dim valorAtributo As Variant

    On Error GoTo Erro
    
    valorAtributo = BSO.RecursosHumanos.Funcionarios.DaValorAtributo(funcionario, "CDU_SujeitoReducao")
    If IsNull(valorAtributo) Then
        FuncionarioSujeito = False
    Else
        FuncionarioSujeito = CBool(valorAtributo)
    End If
    
    Exit Function
    
Erro:
    Err.Raise Err.Number, Err.Source, Err.Description
    
End Function

Private Function RemuneracaoSujeita(Remuneracao As String) As Boolean
Dim valorAtributo As Variant

    On Error GoTo Erro

    valorAtributo = BSO.RecursosHumanos.Remuneracoes.DaValorAtributo(Remuneracao, "CDU_SujeitoReducao")
    If IsNull(valorAtributo) Then
        RemuneracaoSujeita = False
    Else
        RemuneracaoSujeita = CBool(valorAtributo)
    End If
    
    Exit Function
    
Erro:
    Err.Raise Err.Number, Err.Source, Err.Description
    
End Function

Private Function HoraExtraSujeita(HoraExtra As String) As Boolean
Dim valorAtributo As Variant

    On Error GoTo Erro
    
    valorAtributo = BSO.RecursosHumanos.HorasExtra.DaValorAtributo(HoraExtra, "CDU_SujeitoReducao")
    If IsNull(valorAtributo) Then
        HoraExtraSujeita = False
    Else
        HoraExtraSujeita = CBool(valorAtributo)
    End If
    
    Exit Function
    
Erro:
    Err.Raise Err.Number, Err.Source, Err.Description
    
End Function


