*============================================================================== * TECLA DE UTILIZADOR: Redução de 50% da retenção de IRS (novembro de 2026) * 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 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 (prprocf), acerta o IRS acumulado e grava tudo numa só transação. * 4. Apresenta no fim a lista de recibos alterados e não alterados. * * Zonas: só funcionários das zonas definidas em lczonas (por defeito C e A). * * 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 * * Alteração a esta versão: nos recibos com IRS Jovem ou Programa Regressar a * taxa gravada na linha de IRS é a taxa efetiva sobre a remuneração bruta (sem * a isenção), e não sobre o valor sujeito a IRS. Nestes recibos, e nas linhas de * horas extra, a taxa nova é metade da taxa atual (coluna "jovem" da consulta). *============================================================================== *------------------------------------------------------------------------------ * Declaração de variáveis *------------------------------------------------------------------------------ local lcsql, lcflds, lctits, lni, lnrec, lnerr, lndif, lntotrec, lcstamp, lnnrec, lcnome, lnno, ldprdata local lcchk, llok, lnlinhas, lneirsantes, lcacum, lnsel, lczonas private bescolheu, fazu_tabupdate * Contadores de recibos alterados (lnrec) e não alterados (lnerr) store 0 to lnrec, lnerr *------------------------------------------------------------------------------ * PARÂMETROS (alterar aqui, se necessário) *------------------------------------------------------------------------------ * Zonas fiscais abrangidas pela redução, segundo o campo PE.czonag: * C = Continente, A = Açores, M = Madeira * Para incluir a Madeira, trocar para: lczonas = "'C','A','M'" lczonas = "'C','A','M'" *------------------------------------------------------------------------------ * 1. Validações iniciais *------------------------------------------------------------------------------ * A tecla só se aplica a Portugal e não pode ser corrida com um recibo em edição if not is_exept() or (type("_screen.activeform.editing") = "L" and (_screen.activeform.adding or _screen.activeform.editing)) msg("Esta tecla é para Portugal e deve ser executada com o recibo gravado (fora de introdução ou alteração).") return endif * Garante que os parâmetros de IRS estão carregados if type("pe_arirs") = "U" do peparas endif * Pede confirmação ao utilizador antes de avançar if not pergunta("Aplicação da redução de IRS em 50% aos recibos de novembro de 2026 conforme Despacho n.º 12523-A/2026." + chr(13) + chr(13) + ; "Pretende continuar", 2, , .t.) return endif *------------------------------------------------------------------------------ * 2. Leitura das linhas de IRS elegíveis *------------------------------------------------------------------------------ * Notas sobre a consulta (não usar comentários dentro do bloco TEXT): * - lim : limite do despacho para o funcionário (deficiência / casado único * titular / restantes casos). * - suj : valor sujeito a IRS da linha, obtido a partir da PRRE. Cada linha de * IRS (PRDE) é associada ao seu tipo (x.tp): 0 normal, 1 natal, * 2 férias, 3 férias+natal. A soma da PRRE desse tipo (s.s0, s.s1, * s.s2) é repartida 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 gravada na linha * (dqtt) não se obtém dividindo pelo valor sujeito (suj): 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 (reparte a PRRE pelas linhas em proporção ao IRS). * - O WHERE exclui: recibos pagos, funcionários fora das zonas definidas em * lczonas (PE.czonag), ajustes de IRS, taxas extraordinárias, residentes no * estrangeiro, taxas de IRS fixas e funcionários marcados como organização. * - O bloco TEXT usa TEXTMERGE para inserir a variável lczonas (<>). text to lcsql textmerge noshow pretext 1+2 SELECT pr.prstamp, pr.recibo, pr.no, pr.nome, pr.data AS prdata, d.prdestamp, d.ede, d.dqtt, d.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 (nolock) INNER JOIN prde d (nolock) ON d.prstamp = pr.prstamp INNER JOIN cm6 c (nolock) ON c.cm = d.cd AND c.codirs = 1 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 (nolock) INNER JOIN cm6 m (nolock) 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 (nolock) INNER JOIN cm6 k (nolock) 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 LEFT JOIN pe (nolock) ON pe.no = pr.no LEFT JOIN pe2 (nolock) ON pe2.pe2stamp = pe.pestamp WHERE pr.data >= '20261101' AND pr.data < '20261201' AND pr.moeda IN ('', 'EURO') AND d.dtref >= '20261101' AND d.dtref < '20261201' AND d.ede <> 0 AND pe.czonag IN (<>) AND pr.txirs = 0 AND pr.resestr = 0 AND ISNULL(pe.txirs, 0) = 0 AND ISNULL(pe2.organizacao, 0) = 0 AND pr.pago = 0 AND d.ajirs = 0 AND d.txextirs = 0 AND d.txextmirs = 0 AND d.ajtxextmirs = 0 endtext if not u_sqlexec(m.lcsql, "c_irs26raw") msg("Não foi possível ler os recibos de novembro de 2026. Verifique a ligação à base de dados e os campos da consulta.") return endif * Cursor da grelha: calcula as taxas e o IRS novo; só mantém as linhas dentro * do limite do funcionário e que ainda não foram tratadas (obs sem "12523-A") * IRS Jovem / Programa Regressar / horas extra: a taxa nova é metade da taxa gravada na linha select .t. as marca, recibo, nome, suj, ; iif(jovem = 1, dqtt, iif(suj > 0, round(ede / suj * 100, 2), dqtt)) as tx_atu, ede, ; iif(jovem = 1, round(dqtt / 2, 2), iif(suj > 0, round(round_value(.t., ede * 0.5) / suj * 100, 2), round(dqtt / 2, 2))) as tx_nova, ; round_value(.t., ede * 0.5) as ede_nova, ; prstamp, prdestamp, no, prdata, obs ; from c_irs26raw ; where suj <= lim and not "12523-A" $ obs ; order by recibo, nome, prdestamp ; into cursor c_irs26 readwrite fecha("c_irs26raw") if reccount("c_irs26") = 0 fecha("c_irs26") msg("Não encontrámos linhas de IRS de novembro de 2026 por tratar: não existem recibos nestas condições ou já foram tratados.") return endif *------------------------------------------------------------------------------ * 3. Grelha de confirmação *------------------------------------------------------------------------------ * Campos e títulos das colunas (a ordem tem de ser a mesma nas duas listas) lcflds = "marca,recibo,nome,suj,tx_atu,ede,tx_nova,ede_nova" lctits = "Processar?|Recibo|Funcionário|Valor Sujeito a IRS|Taxa Efetiva Atual|Valor IRS Atual|Taxa Efetiva Nova|Valor IRS Novo" declare list_tit(8), list_pic(8), list_cam(8), list_tam(8), list_ronly(8) for lni = 1 to 8 list_cam(lni) = "c_irs26." + getwordnum(lcflds, lni, ",") list_tit(lni) = getwordnum(lctits, lni, "|") * coluna 1 é lógica; colunas 4 a 8 são numéricas com 2 casas decimais list_pic(lni) = iif(lni = 1, "LOGIC", iif(lni >= 4, "999,999,999.99", "")) * a coluna do nome é mais larga list_tam(lni) = 8 * iif(lni = 3, 30, 15) next * Todas as colunas só de leitura, exceto a de seleção list_ronly = .t. list_ronly(1) = .f. =cursorsetprop("Buffering", 5, "c_irs26") m.bescolheu = .f. m.fazu_tabupdate = .f. && variável privada do botão OK do form BROWLIST do browlist with "Redução de 50% do IRS de novembro de 2026: assinale as linhas a processar", "c_irs26", "irs1126", .t., .f., .f., .t., .f., "", .t. release list_tit, list_pic, list_cam, list_tam, list_ronly * O utilizador cancelou a grelha if not m.bescolheu fecha("c_irs26") return endif * Lista de recibos com pelo menos uma linha assinalada select distinct prstamp, no, prdata, recibo, nome from c_irs26 where marca into cursor c_irs26rec if reccount("c_irs26rec") = 0 fecha("c_irs26rec:c_irs26") msg("Não assinalou nenhuma linha, pelo que não foi alterado nada.") return endif lntotrec = reccount("c_irs26rec") *------------------------------------------------------------------------------ * 4. Preparação das views do PHC (recibo, rendimentos, descontos, contas-correntes) *------------------------------------------------------------------------------ if not used("pr") do dbfusepr endif if not used("prre") do dbfuseprre endif if not used("prde") do dbfuseprde endif if not used("prcc") do dbfuseprcc endif limpa_views() *------------------------------------------------------------------------------ * 5. Processamento recibo a recibo *------------------------------------------------------------------------------ regua(0, m.lntotrec, "A processar os recibos ...") try select c_irs26rec scan regua(1, lnrec + lnerr + 1, "<§" + alltrim(c_irs26rec.nome) + "§>") * Dados do recibo em tratamento lcstamp = c_irs26rec.prstamp lnnrec = c_irs26rec.recibo lcnome = alltrim(c_irs26rec.nome) lnno = c_irs26rec.no ldprdata = c_irs26rec.prdata * Só trata (e só gera mensagens para) recibos com pelo menos uma linha assinalada select c_irs26 count for marca and prstamp = lcstamp to lnsel if lnsel = 0 select c_irs26rec loop endif * Carrega o recibo nas views do PHC requery_views(lcstamp) * 5.1 Revalida o estado do recibo na base de dados (pode ter mudado entretanto) lcchk = "SELECT COUNT(*) AS n FROM pr (nolock) WHERE prstamp = '" + alltrim(lcstamp) + "'" + ; " AND pago = 0" llok = u_sqlexec(lcchk, "c_chk") and used("c_chk") and c_chk.n > 0 fecha("c_chk") if not llok or not used("pr") or reccount("pr") = 0 lnerr = lnerr + 1 aadderros("Recibo n.º " + astr(lnnrec) + " de " + lcnome + ": não foi alterado (recibo entretanto marcado como pago).") select c_irs26rec loop endif select pr * 5.2 Reduz as linhas de IRS assinaladas nas views lndif = 0 && total de IRS retirado ao recibo lnlinhas = 0 && número de linhas efetivamente alteradas select c_irs26 scan for marca and prstamp = lcstamp select prde locate for prde.prdestamp = c_irs26.prdestamp * só altera se a linha ainda tiver o valor que foi mostrado na grelha if found() and prde.ede = c_irs26.ede lndif = lndif + prde.ede - c_irs26.ede_nova replace prde.ede with c_irs26.ede_nova, ; prde.de with eurotoesc(c_irs26.ede_nova), ; prde.dqtt with min(c_irs26.tx_nova, 99.99), ; prde.obs with left("Desp.12523-A/26 " + alltrim(prde.obs), 50) lnlinhas = lnlinhas + 1 endif select c_irs26 endscan * Nenhuma linha foi alterada: as linhas mudaram desde que a grelha foi aberta if lnlinhas = 0 lnerr = lnerr + 1 aadderros("Recibo n.º " + astr(lnnrec) + " de " + lcnome + ": não foi alterado (as linhas foram alteradas entretanto).") select c_irs26rec loop endif * 5.3 Recalcula os totais do recibo (descontos, líquido, etc.) select pr lneirsantes = pr.eirsacum do prprocf * Se o prprocf não acertou o IRS acumulado do próprio recibo, acerta-se aqui select pr if pr.eirsacum = lneirsantes replace pr.eirsacum with pr.eirsacum - lndif, ; pr.irsacum with pr.irsacum - eurotoesc(lndif) endif * 5.4 Acerta o IRS acumulado dos recibos seguintes do mesmo funcionário lcacum = "UPDATE pr SET eirsacum = eirsacum - " + dec_tr(lndif, 19, 6) + ; ", irsacum = irsacum - " + dec_tr(eurotoesc(lndif), 18, 5) + ; " WHERE no = " + astr(lnno) + " AND ano = 2026 AND prstamp <> '" + alltrim(lcstamp) + "'" + ; " AND (data > '" + dtos(ldprdata) + "' OR (data = '" + dtos(ldprdata) + "' AND recibo > " + astr(lnnrec) + "))" * 5.5 Grava tudo numa só transação (recibo, descontos e acumulados) begin transaction sqlsetprop(m.con_dbhandle, 'Transactions', 2) if u_tabupdate(.t., .t., "PR") and u_tabupdate(.t., .t., "PRDE") and u_sqlexec(lcacum) * Sucesso: confirma a transação sqlcommit(m.con_dbhandle) sqlsetprop(m.con_dbhandle, 'Transactions', 1) end transaction lnrec = lnrec + 1 aadderros("Recibo n.º " + astr(lnnrec) + " de " + lcnome + ": IRS reduzido em " + alltrim(transform(lndif, "999,999,999.99")) + ".") else * Erro: desfaz tudo o que foi feito neste recibo rollback sqlrollback(m.con_dbhandle) sqlsetprop(m.con_dbhandle, 'Transactions', 1) tablerevert(.t., "PR") tablerevert(.t., "PRDE") lnerr = lnerr + 1 aadderros("Recibo n.º " + astr(lnnrec) + " de " + lcnome + ": não foi alterado (erro de gravação). Consulte a análise interna.") endif select c_irs26rec endscan finally * Fecha sempre a régua, mesmo que ocorra um erro a meio do ciclo regua(2) endtry *------------------------------------------------------------------------------ * 6. Resultado final *------------------------------------------------------------------------------ fecha("c_irs26rec:c_irs26") aadderros("Concluído. Recibos alterados: " + astr(lnrec) + ". Recibos não alterados: " + astr(lnerr) + iif(lnerr > 0, ". Pode voltar a executar a tecla para os tratar.", ".")) mostraerros() * Atualiza o ecrã com os valores gravados try u_requery("pr") u_requery("prde") _screen.activeform.refresh() catch endtry return .t. *============================================================================== * Procedures auxiliares *============================================================================== * Esvazia as views do recibo (usa um stamp que não existe) procedure limpa_views v_prstamp = "*-*-*-*" u_requery("PR") v_prreprstamp = "*-*-*-*" u_requery("PRRE") v_prdeprstamp = "*-*-*-*" u_requery("PRDE") v_prccstamp = "*-*-*-*" u_requery("PRCC") endproc * Carrega nas views o recibo com o stamp indicado procedure requery_views lparameters p_qualstamp v_prstamp = p_qualstamp u_requery("PR") v_prreprstamp = p_qualstamp u_requery("PRRE") v_prdeprstamp = p_qualstamp u_requery("PRDE") v_prccstamp = p_qualstamp u_requery("PRCC") endproc