'==============================================================================================================================================================
' OPÇÃO DE ECRÃ (etl, ecrã = 'prform'): redução de 50% da retenção de IRS nos recibos de novembro de 2026 conforme Despacho n.º 12523-A/2026
'--------------------------------------------------------------------------------------------------------------------------------------------------------------
' O que faz:
'   1. Lê as linhas de IRS dos recibos de novembro de 2026 que cumprem as condições do despacho (ver getEligibleLines das 2. Leitura das linhas de IRS
'      elegíveis).
'   2. Mostra-as numa grelha para o utilizador confirmar o que quer processar.
'   3. Para cada linha de recibo assinalado: reduz o IRS a metade, recalcula o recibo, acerta o IRS acumulado e grava tudo numa só transação.
'   4. Apresenta no fim uma mensagem para cada linha com o resultado.
'
' Zonas: só funcionários das zonas definidas abaixo em Declaração de variáveis na variável do tipo string "zones".
'
' Limite de rendimento (cláusula 3 do despacho): o valor sujeito de cada linha não pode exceder o limite superior do penúltimo escalão da tabela aplicável:
'   - Com deficiência (tabelas IV a VII) .......................... 20 468,00
'   - Sem deficiência, casado e único titular (tabela III) ........ 20 265,00
'   - Restantes casos (tabelas I e II) ............................ 20 221,00
'
' Fluxo técnico:
'   1. O botão abre um BrowList com uma linha por cada linha de IRS (prde com cm6.codirs = 1).
'   2. Ao confirmar, cada recibo é gravado na sua própria PhcTransaction: linhas do prde, depois os totais do recibo, depois os acumulados de IRS
'      dos recibos seguintes.
'   3. Os callbacks do BrowList correm em pedidos posteriores (o contexto fica na sessão): não podem usar o mPage.
'==============================================================================================================================================================

'--------------------------------------------------------------------------------------------------------------------------------------------------------------
' Declaração de variáveis
'--------------------------------------------------------------------------------------------------------------------------------------------------------------
' Zonas fiscais abrangidas (pe.czonag): C = Continente, A = Açores,
' M = Madeira. Para incluir a Madeira: "'C','A','M'"
Dim zones As String = "'C','A'"

' O limite do n.º 3 (limite superior do penúltimo escalão) vem na consulta, por
' funcionário (coluna "lim"):
' com deficiência 20468; casado e único titular 20265; restantes casos 20221.
' Compara-se com o valor sujeito da linha.
Dim reductionFactor As Decimal = 0.5D     ' n.º 2: 50% do valor das tabelas
Dim marker As String = "Desp.12523-A/26 " ' escrito em prde.obs (C(50)); marca também a linha como já tratada
Dim periodStart As New DateTime(2026, 11, 1)
Dim periodEnd As New DateTime(2026, 12, 1)  ' exclusivo
Dim ptCulture As New System.Globalization.CultureInfo("pt-PT")

'--------------------------------------------------------------------------------------------------------------------------------------------------------------
' 1. Estado guardado para os callbacks (só valores simples, sem referências à página)
'--------------------------------------------------------------------------------------------------------------------------------------------------------------
Dim shownEde As New System.Collections.Generic.Dictionary(Of String, Decimal)   ' prdestamp -> IRS apresentado na lista
Dim receiptLabels As New System.Collections.Generic.Dictionary(Of String, String) ' prdestamp -> "Recibo n.º X de Y"
Dim openReceiptStamp As String = If(mStamp, "").Trim()

'--------------------------------------------------------------------------------------------------------------------------------------------------------------
' 2. Leitura das linhas de IRS elegíveis
'--------------------------------------------------------------------------------------------------------------------------------------------------------------
' Linhas de IRS elegíveis para a redução (uma por linha de prde com cm6.codirs = 1).
'  - lim: limite do despacho para o funcionário.
'  - suj: valor sujeito a IRS da linha, a partir da prre. Cada linha de IRS (prde) tem um tipo (x.tp): 0 normal, 1 natal,
'    2 férias, 3 férias+natal. A soma da prre desse tipo (s0, s1, s2) reparte-se pelas linhas do mesmo tipo em proporção ao IRS.
'  - jovem: 1 se o recibo tem IRS Jovem ou Programa Regressar, ou se a linha é de horas extra (prde.hextra). Nestes casos a taxa da linha (dqtt)
'    não se obtém dividindo pelo valor sujeito: no IRS Jovem é a taxa efetiva sobre o bruto (suj já tem a isenção) e nas horas extra a base da
'    linha é só o valor das horas extra, que o suj não isola.
Dim getEligibleLines = Function() As System.Collections.Generic.List(Of DataRow)
    ' Filtros da consulta
    Dim filters As New PhcTableFilter
    filters.AddFilter("pr.data >= @periodStart AND pr.data < @periodEnd AND d.dtref >= @periodStart AND d.dtref < @periodEnd")
    filters.AddFilter("pr.moeda IN ('', 'EURO') AND d.ede <> 0")
    filters.AddFilter("pe.czonag IN (" & zones & ")")
    filters.AddFilter("pr.txirs = 0 AND pr.resestr = 0 AND ISNULL(pe.txirs, 0) = 0 AND ISNULL(pe2.organizacao, 0) = 0")
    filters.AddFilter("pr.pago = 0 AND pr.plano = 0 AND pr.olcodigo = '' AND pr.evalorjaemtb = 0")
    filters.AddFilter("d.ajirs = 0 AND d.txextirs = 0 AND d.txextmirs = 0 AND d.ajtxextmirs = 0")
    filters.AddFilter("NOT EXISTS (SELECT 1 FROM prde p WHERE p.prstamp = pr.prstamp AND p.penstamp <> '')")
    filters.AddFilter("CHARINDEX('12523-A', ISNULL(d.obs, '')) = 0") ' ainda não tratada

    ' Consulta e filtro final pelo limite do despacho (suj <= lim)
    Return PhcCommandBuilder.CreateSelect("pr.prstamp, pr.recibo, pr.no, pr.nome, pr.data AS prdata, d.prdestamp, d.ede, d.de, d.dqtt, RTRIM(d.obs) AS obs, " &
                                          "CASE WHEN ISNULL(pr.jovemisentoirs, 0) = 1 OR ISNULL(pr.prisentoirs, 0) = 1 OR ISNULL(d.hextra, 0) = 1 THEN 1 ELSE 0 END AS jovem, " &
                                          "CASE WHEN ISNULL(pe.deficiente, 0) = 1 THEN 20468 " &
                                          "WHEN ISNULL(pe2.casado, 0) = 1 AND ISNULL(pe.ntit, 0) = 1 THEN 20265 ELSE 20221 END AS lim, " &
                                          "ISNULL(ROUND(CASE x.tp WHEN 0 THEN s.s0 WHEN 1 THEN s.s1 WHEN 2 THEN s.s2 ELSE s.s1 + s.s2 END * d.ede / NULLIF(t.tede, 0), 2), 0) AS suj").
        From("pr").
        InnerJoin("prde", "d").On("d.prstamp = pr.prstamp").
        InnerJoin("cm6", "c").On("c.cm = d.cd AND c.codirs = 1").
        AppendText(" CROSS APPLY (SELECT CASE WHEN d.nat = 1 AND d.fer = 1 THEN 3 WHEN d.nat = 1 THEN 1 WHEN d.fer = 1 THEN 2 ELSE 0 END AS tp) x " &
                   "LEFT JOIN (SELECT r.prstamp, " &
                   "SUM(CASE WHEN m.natal = 0 AND m.ferias = 0 THEN r.ereirs ELSE 0 END) AS s0, " &
                   "SUM(CASE WHEN m.natal = 1 THEN r.ereirs ELSE 0 END) AS s1, " &
                   "SUM(CASE WHEN m.natal = 0 AND m.ferias = 1 THEN r.ereirs ELSE 0 END) AS s2 " &
                   "FROM prre r INNER JOIN cm6 m ON m.cm = r.cr GROUP BY r.prstamp) s ON s.prstamp = pr.prstamp " &
                   "LEFT JOIN (SELECT p.prstamp, y.tp, SUM(p.ede) AS tede FROM prde p INNER JOIN cm6 k ON k.cm = p.cd AND k.codirs = 1 " &
                   "CROSS APPLY (SELECT CASE WHEN p.nat = 1 AND p.fer = 1 THEN 3 WHEN p.nat = 1 THEN 1 WHEN p.fer = 1 THEN 2 ELSE 0 END AS tp) y " &
                   "GROUP BY p.prstamp, y.tp) t ON t.prstamp = pr.prstamp AND t.tp = x.tp ").
        LeftJoin("pe").On("pe.no = pr.no").
        LeftJoin("pe2").On("pe2.pe2stamp = pe.pestamp").
        Where(filters).
        AddSqlParameter("@periodStart", periodStart).
        AddSqlParameter("@periodEnd", periodEnd).
        OrderBy("pr.recibo, pr.nome, d.prdestamp").
        GetDatatable().Rows.Cast(Of DataRow)().
        Where(Function(r) r.ItemToDecimal("suj") <= r.ItemToDecimal("lim")).ToList()
End Function

' Texto de identificação do recibo, usado nas mensagens
Dim getLabel = Function(r As DataRow) As String
    Return "Recibo n.º " & r.ItemToDecimal("recibo").ToString("0") & " de " & r.ItemToString("nome").Trim()
End Function

' IRS novo: 50% do valor atual, truncado à unidade
Dim reduce = Function(ede As Decimal) As Decimal
    Return Math.Truncate(ede * reductionFactor)
End Function

' Taxa efetiva atual: IRS / valor sujeito. Nas linhas com jovem = 1 (ou sem valor sujeito) é a taxa da linha (dqtt).
Dim currentRateOf = Function(ede As Decimal, taxable As Decimal, currentRate As Decimal, byLineRate As Boolean) As Decimal
    Return If(byLineRate OrElse taxable <= 0D, currentRate, Math.Round(ede / taxable * 100D, 2))
End Function

' Taxa efetiva nova: IRS novo / valor sujeito. Nas linhas com jovem = 1 (ou sem valor sujeito) é metade da taxa da linha (dqtt), como na tecla do desktop.
Dim rateOf = Function(ede As Decimal, taxable As Decimal, currentRate As Decimal, byLineRate As Boolean) As Decimal
    Return Math.Min(If(byLineRate OrElse taxable <= 0D, Math.Round(currentRate / 2D, 2), Math.Round(ede / taxable * 100D, 2)), 99.99D)
End Function

' Grava um recibo (todas as suas linhas de IRS selecionadas) numa só transação; devolve o IRS retirado, em euros.
' Qualquer verificação falhada lança uma exceção e a transação é revertida: o recibo fica totalmente alterado ou intacto.
Dim reducePayslip = Function(payslipStamp As String, lines As System.Collections.Generic.List(Of DataRow)) As Decimal
    Dim first As DataRow = lines.First()
    Dim diffEur As Decimal = 0D
    Dim diffEsc As Decimal = 0D
    For Each r In lines
        If Not shownEde.ContainsKey(r.ItemToString("prdestamp").Trim()) OrElse shownEde(r.ItemToString("prdestamp").Trim()) <> r.ItemToDecimal("ede") Then
            Throw New Exception("a linha foi alterada desde que a lista foi apresentada")
        End If
    Next
    Using tran As New PhcTransaction("irs26")
        Try
            For Each r In lines
                Dim ede As Decimal = r.ItemToDecimal("ede")
                Dim newEde As Decimal = reduce(ede)
                Dim newDe As Decimal = Math.Round(newEde.EuroToEsc(), 5)
                diffEur += ede - newEde
                diffEsc += r.ItemToDecimal("de") - newDe
                ' ede = @ede protege contra uma alteração concorrente da linha
                If PhcCommandBuilder.CreateUpdate("prde").
                        AddUpdateColValue("ede", newEde).
                        AddUpdateColValue("de", newDe).
                        AddUpdateColValue("dqtt", rateOf(newEde, r.ItemToDecimal("suj"), r.ItemToDecimal("dqtt"), r.ItemToDecimal("jovem") = 1D)).
                        AddUpdateColString("obs", marker & r.ItemToString("obs").Trim(), 50).
                        Where("prdestamp = @prdestamp AND ede = @ede").
                        AddSqlStampParameter("@prdestamp", r.ItemToString("prdestamp").Trim()).
                        AddSqlParameter("@ede", ede).
                        ExecuteNonQuery(tran, True) <> 1 Then
                    Throw New Exception("a linha foi alterada entretanto")
                End If
            Next
            ' totais do recibo (as mesmas verificações da consulta de elegíveis)
            If PhcCommandBuilder.CreateUpdate("pr").
                    AddUpdateColExpression("ettdesc = ettdesc - @de").
                    AddUpdateColExpression("ttdesc = ttdesc - @dd").
                    AddUpdateColExpression("eliquido = eliquido + @de").
                    AddUpdateColExpression("liquido = liquido + @dd").
                    AddUpdateColExpression("evalorol = evalorol + @de").
                    AddUpdateColExpression("valorol = valorol + @dd").
                    Where("prstamp = @prstamp AND pago = 0 AND plano = 0 AND olcodigo = '' AND evalorjaemtb = 0").
                    AddSqlParameter("@de", diffEur).
                    AddSqlParameter("@dd", diffEsc).
                    AddSqlStampParameter("@prstamp", payslipStamp).
                    ExecuteNonQuery(tran, True) <> 1 Then
                Throw New Exception("o recibo foi alterado, pago ou contabilizado entretanto")
            End If
            ' acumulados de IRS deste recibo e dos seguintes do mesmo funcionário
            PhcCommandBuilder.CreateUpdate("pr").
                AddUpdateColExpression("eirsacum = eirsacum - @de").
                AddUpdateColExpression("irsacum = irsacum - @dd").
                Where("no = @no AND ano = 2026 AND (prstamp = @prstamp OR data > @data OR (data = @data AND recibo > @recibo))").
                AddSqlParameter("@de", diffEur).
                AddSqlParameter("@dd", diffEsc).
                AddSqlParameter("@no", first.ItemToDecimal("no")).
                AddSqlStampParameter("@prstamp", payslipStamp).
                AddSqlParameter("@data", first.ItemToDate("prdata")).
                AddSqlParameter("@recibo", first.ItemToDecimal("recibo")).
                ExecuteNonQuery(tran, True)
            tran.Commit()
        Catch
            tran.Rollback()
            Throw
        End Try
    End Using
    Return diffEur
End Function

'--------------------------------------------------------------------------------------------------------------------------------------------------------------
' 3. Grelha de confirmação
'--------------------------------------------------------------------------------------------------------------------------------------------------------------
Dim browList As New BrowList(BootstrapModal.ModalSizeEnum.Xl)
browList.Type = BrowListTypeEnum.Grid
browList.ID = "Irs26Browlist"
browList.Title = "Redução de 50% do IRS de novembro de 2026: assinale as linhas a processar"
browList.AddMainformModel = False ' a lista não depende do recibo aberto
browList.Grid.FieldId = "prdestamp"
browList.Grid.ShowColumnToSelect = True
browList.Grid.MultiSelectRows = True
browList.Grid.AddGridNumberColumn("recibo", "Recibo", 0)
browList.Grid.AddGridColumn("nome", "Funcionário")
browList.Grid.AddGridColumn("obs", "Observação")
browList.Grid.AddGridNumberColumn("suj", "Valor Sujeito a IRS", 2, True, True) ' mostra também o zero
browList.Grid.AddGridNumberColumn("tx_atu", "Taxa Efetiva Atual", 2)
browList.Grid.AddGridNumberColumn("ede", "Valor IRS Atual", 2)
browList.Grid.AddGridNumberColumn("tx_nova", "Taxa Efetiva Nova", 2)
browList.Grid.AddGridNumberColumn("ede_nova", "Valor IRS Novo", 2)
browList.GetModelFunction = Function(args)
    Dim table As New DataTable("irs26")
    table.Columns.Add("prdestamp", GetType(String))
    table.Columns.Add("recibo", GetType(Decimal))
    table.Columns.Add("nome", GetType(String))
    table.Columns.Add("obs", GetType(String))
    table.Columns.Add("suj", GetType(Decimal))
    table.Columns.Add("tx_atu", GetType(Decimal))
    table.Columns.Add("ede", GetType(Decimal))
    table.Columns.Add("tx_nova", GetType(Decimal))
    table.Columns.Add("ede_nova", GetType(Decimal))
    shownEde.Clear()
    receiptLabels.Clear()
    For Each r In getEligibleLines()
        Dim id As String = r.ItemToString("prdestamp").Trim()
        Dim ede As Decimal = r.ItemToDecimal("ede")
        Dim suj As Decimal = r.ItemToDecimal("suj")
        Dim dqtt As Decimal = r.ItemToDecimal("dqtt")
        Dim byLineRate As Boolean = r.ItemToDecimal("jovem") = 1D
        Dim newEde As Decimal = reduce(ede)
        shownEde(id) = ede
        receiptLabels(id) = getLabel(r)
        table.Rows.Add(id, r.ItemToDecimal("recibo"), r.ItemToString("nome").Trim(),
                       If(r.ItemToString("obs").Trim() = "", "Remuneração Mensal", r.ItemToString("obs").Trim()),
                       suj, currentRateOf(ede, suj, dqtt, byLineRate), ede, rateOf(newEde, suj, dqtt, byLineRate), newEde)
    Next
    Dim model As New PhcDynamicObject
    model.SetValue("data", table)
    Return model
End Function

browList.ListContext.SetSelectRowsFunction = Function(args)
    Dim selectedIds As New System.Collections.Generic.HashSet(Of String)(args.Ids.Select(Function(x) Convert.ToString(x).Trim()))
    If selectedIds.Count = 0 Then
        Return JsonMessage.GetNewJsonError.AddMessage("Não assinalou nenhuma linha, pelo que não foi alterado nada.")
    End If
    ' voltar a ler as linhas agora: o que foi listado pode ter sido pago, contabilizado ou tratado entretanto
    Dim lines = getEligibleLines().Where(Function(r) selectedIds.Contains(r.ItemToString("prdestamp").Trim())).ToList()
    Dim stillEligible As New System.Collections.Generic.HashSet(Of String)(lines.Select(Function(r) r.ItemToString("prdestamp").Trim()))
    Dim result As JsonMessage = JsonMessage.GetNewJsonSuccess
    Dim changedStamps As New System.Collections.Generic.HashSet(Of String)
    Dim changedCount As Integer = 0
    Dim failedCount As Integer = 0
    Dim totalReduced As Decimal = 0D
    ' linhas selecionadas que já não são elegíveis
    For Each label In selectedIds.Where(Function(id) Not stillEligible.Contains(id)).
            Select(Function(id) If(receiptLabels.ContainsKey(id), receiptLabels(id), id)).Distinct().ToList()
        failedCount += 1
        result.AddWarningAlert(label & ": não foi alterado (a linha já não está elegível: recibo pago, contabilizado, alterado ou já tratado).")
    Next
    For Each payslip In lines.GroupBy(Function(r) r.ItemToString("prstamp").Trim()).ToList()
        Dim label As String = getLabel(payslip.First())
        Try
            Dim reduced As Decimal = reducePayslip(payslip.Key, payslip.ToList())
            changedCount += 1
            changedStamps.Add(payslip.Key)
            totalReduced += reduced
            result.AddMessage(label & ": IRS reduzido em " & reduced.ToString("N2", ptCulture) & ".")
        Catch ex As Exception
            failedCount += 1
            result.AddWarningAlert(label & ": não foi alterado (" & ex.Message & ").")
        End Try
    Next
    result.AddMessage("Concluído. Recibos alterados: " & changedCount.ToString() & ". Recibos não alterados: " & failedCount.ToString() & ". IRS reduzido: " & totalReduced.ToString("N2", ptCulture) & ".")
    PhcCache.ResetTable("PR")
    PhcCache.ResetTable("PRDE")
    ' recarregar o ecrã apaga os avisos: só se faz quando o recibo aberto foi alterado
    If changedStamps.Contains(openReceiptStamp) Then
        Return result.SetToSuccess.SetReloadScreen
    End If
    Return result.SetToSuccess
End Function

browList.AddFormToPageAndShowBrowlist(CType(mPage, Normalform))
Return Nothing
'--------------------------------------------------------------------------------------------------------------------------------------------------------------