[Event Requests] Codeunit 426 "Payment Tolerance Management"

[TimBee0706]

Why do you need this change?

Hello,

our customer wants to set up different "payment tolerance warning" (Record "General Ledger Setup" Boolean) values for customers and vendors. Therefore, I need the ability to adjust the value in the PmtTolCust, PmtTolCustLedgerEntry, PmtTolVendLedgEntry, and PmtTolVend functions.
In the section down below, you can find my suggested code.

Describe the request

Changes needed in Codeunit 426 "Payment Tolerance Management"

Here is the code with suggestions (marked with **):

PmtTolCust

    procedure PmtTolCust(var CustLedgEntry: Record "Cust. Ledger Entry"): Boolean
    var
        GLSetup: Record "General Ledger Setup";
        Customer: Record Customer;
        AppliedAmount: Decimal;
        OriginalAppliedAmount: Decimal;
        ApplyingAmount: Decimal;
        AmounttoApply: Decimal;
        PmtDiscAmount: Decimal;
        MaxPmtTolAmount: Decimal;
        CustEntryApplId: Code[50];
        ApplnRoundingPrecision: Decimal;
        PaymentTolWarning: Boolean;
    begin
        MaxPmtTolAmount := 0;
        PmtDiscAmount := 0;
        ApplyingAmount := 0;
        AmounttoApply := 0;
        AppliedAmount := 0;
        if Customer.Get(CustLedgEntry."Customer No.") then begin
            if Customer."Block Payment Tolerance" then
                exit(true);
        end else
            exit(false);
        GLSetup.Get();
        CustEntryApplId := UserId();
        if CustEntryApplId = '' then
            CustEntryApplId := '***';
        OnPmtTolCustOnAfterSetCustEntryApplId(CustLedgEntry, CustEntryApplId);
        DelCustPmtTolAcc(CustLedgEntry, CustEntryApplId);
        CustLedgEntry.CalcFields("Remaining Amount");
        OnPmtTolCustBeforeCalcCustApplnAmount(CustLedgEntry);
        CalcCustApplnAmount(
          CustLedgEntry, GLSetup, AppliedAmount, ApplyingAmount, AmounttoApply, PmtDiscAmount,
          MaxPmtTolAmount, CustEntryApplId, ApplnRoundingPrecision);
        OriginalAppliedAmount := AppliedAmount;
        if GLSetup."Pmt. Disc. Tolerance Warning" then
            if not ManagePaymentDiscToleranceWarningCustomer(CustLedgEntry, CustEntryApplId, AppliedAmount, AmounttoApply, '') then
                exit(false);
        if Abs(AmounttoApply) >= Abs(AppliedAmount - PmtDiscAmount - MaxPmtTolAmount) then begin
            AppliedAmount := AppliedAmount - PmtDiscAmount;

            **PaymentTolWarning := GLSetup."Payment Tolerance Warning";
            OnAfterSetPaymentTolWarning(GLSetup, PaymentTolWarning);**
            if (Abs(AppliedAmount) > Abs(AmounttoApply)) and (AppliedAmount * PmtDiscAmount >= 0) then
                AppliedAmount := AmounttoApply;
            if ((Abs(AppliedAmount + ApplyingAmount) - ApplnRoundingPrecision) <= Abs(MaxPmtTolAmount)) and
               (MaxPmtTolAmount <> 0) and ((Abs(AppliedAmount + ApplyingAmount) - ApplnRoundingPrecision) <> 0)
               and (Abs(AppliedAmount + ApplyingAmount) > ApplnRoundingPrecision)
            then 
                **if PaymentTolWarning then begin**
                    if CallPmtTolWarning(
                         CustLedgEntry."Posting Date", CustLedgEntry."Customer No.", CustLedgEntry."Document No.",
                         CustLedgEntry."Currency Code", ApplyingAmount, OriginalAppliedAmount, "Payment Tolerance Account Type"::Customer)
                    then begin
                        if ApplyingAmount <> 0 then
                            PutCustPmtTolAmount(CustLedgEntry, ApplyingAmount, AppliedAmount, CustEntryApplId)
                        else
                            DelCustPmtTolAcc2(CustLedgEntry, CustEntryApplId);
                    end else
                        exit(false);
                end else
                    PutCustPmtTolAmount(CustLedgEntry, ApplyingAmount, AppliedAmount, CustEntryApplId);
        end;
        exit(true);
    end;

    [IntegrationEvent(false, false)]
    local procedure OnAfterSetPaymentTolWarning(GLSetup: Record "General Ledger Setup"; var PaymentTolWarning: Boolean)
    begin
    end;

PmtTolVend

   procedure PmtTolVend(var VendLedgEntry: Record "Vendor Ledger Entry"): Boolean
    var
        GLSetup: Record "General Ledger Setup";
        Vendor: Record Vendor;
        PaymentTolWarning: Boolean;
        AppliedAmount: Decimal;
        OriginalAppliedAmount: Decimal;
        ApplyingAmount: Decimal;
        AmounttoApply: Decimal;
        PmtDiscAmount: Decimal;
        MaxPmtTolAmount: Decimal;
        VendEntryApplID: Code[50];
        ApplnRoundingPrecision: Decimal;
    begin
        MaxPmtTolAmount := 0;
        PmtDiscAmount := 0;
        ApplyingAmount := 0;
        AmounttoApply := 0;
        AppliedAmount := 0;
        if Vendor.Get(VendLedgEntry."Vendor No.") then begin
            if Vendor."Block Payment Tolerance" then
                exit(true);
        end else
            exit(false);

        GLSetup.Get();
        VendEntryApplID := UserId();
        if VendEntryApplID = '' then
            VendEntryApplID := '***';
        OnPmtTolVendOnAfterSetVendEntryApplId(VendLedgEntry, VendEntryApplID);

        DelVendPmtTolAcc(VendLedgEntry, VendEntryApplID);
        VendLedgEntry.CalcFields("Remaining Amount");
        OnPmtTolVendBeforeCalcVendApplnAmount(VendLedgEntry);
        CalcVendApplnAmount(
          VendLedgEntry, GLSetup, AppliedAmount, ApplyingAmount, AmounttoApply, PmtDiscAmount,
          MaxPmtTolAmount, VendEntryApplID, ApplnRoundingPrecision);

        OriginalAppliedAmount := AppliedAmount;

        if GLSetup."Pmt. Disc. Tolerance Warning" then
            if not ManagePaymentDiscToleranceWarningVendor(VendLedgEntry, VendEntryApplID, AppliedAmount, AmounttoApply, '') then
                exit(false);

        if Abs(AmounttoApply) >= Abs(AppliedAmount - PmtDiscAmount - MaxPmtTolAmount) then begin
            AppliedAmount := AppliedAmount - PmtDiscAmount;
            **PaymentTolWarning := GLSetup."Payment Tolerance Warning";
            OnAfterSetPaymentTolWarning(GLSetup, PaymentTolWarning);**
            if (Abs(AppliedAmount) > Abs(AmounttoApply)) and (AppliedAmount * PmtDiscAmount >= 0) then
                AppliedAmount := AmounttoApply;

            if ((Abs(AppliedAmount + ApplyingAmount) - ApplnRoundingPrecision) <= Abs(MaxPmtTolAmount)) and
               (MaxPmtTolAmount <> 0) and ((Abs(AppliedAmount + ApplyingAmount) - ApplnRoundingPrecision) <> 0) and
               (Abs(AppliedAmount + ApplyingAmount) > ApplnRoundingPrecision)
            then
                **if PaymentTolWarning then begin**
                    if CallPmtTolWarning(
                         VendLedgEntry."Posting Date", VendLedgEntry."Vendor No.", VendLedgEntry."Document No.",
                         VendLedgEntry."Currency Code", ApplyingAmount, OriginalAppliedAmount, "Payment Tolerance Account Type"::Vendor)
                    then begin
                        if ApplyingAmount <> 0 then
                            PutVendPmtTolAmount(VendLedgEntry, ApplyingAmount, AppliedAmount, VendEntryApplID)
                        else
                            DelVendPmtTolAcc2(VendLedgEntry, VendEntryApplID);
                    end else
                        exit(false);
                end else
                    PutVendPmtTolAmount(VendLedgEntry, ApplyingAmount, AppliedAmount, VendEntryApplID);
        end;
        exit(true);
    end;

    [IntegrationEvent(false, false)]
    local procedure OnAfterSetPaymentTolWarning(GLSetup: Record "General Ledger Setup"; var PaymentTolWarning: Boolean)
    begin
    end;

PmtTolCustLedgEntry

    local procedure PmtTolCustLedgEntry(var NewCustLedgEntry: Record "Cust. Ledger Entry"; AccountNo: Code[20]; PostingDate: Date; DocNo: Code[20]; AppliesToID: Code[50]; AppliesToDocNo: Code[20]; CurrencyCode: Code[10]): Boolean
    var
        GLSetup: Record "General Ledger Setup";
        AppliedAmount: Decimal;
        OriginalAppliedAmount: Decimal;
        ApplyingAmount: Decimal;
        AmounttoApply: Decimal;
        PmtDiscAmount: Decimal;
        MaxPmtTolAmount: Decimal;
        ApplnRoundingPrecision: Decimal;
        IsHandled: Boolean;
        Result: Boolean;
        PaymentTolWarning: Boolean;
    begin
        GLSetup.Get();
        CalcCustApplnAmount(
          NewCustLedgEntry, GLSetup, AppliedAmount, ApplyingAmount, AmounttoApply, PmtDiscAmount,
          MaxPmtTolAmount, AppliesToID, ApplnRoundingPrecision);

        IsHandled := false;
        OnPmtTolCustLedgEntryOnBeforeWarning(
         NewCustLedgEntry, GLSetup, AppliedAmount, ApplyingAmount, AmounttoApply, PmtDiscAmount,
         MaxPmtTolAmount, AppliesToID, ApplnRoundingPrecision, IsHandled, Result);
        if IsHandled then
            exit(Result);

        OriginalAppliedAmount := AppliedAmount;

        if GLSetup."Pmt. Disc. Tolerance Warning" then
            if not ManagePaymentDiscToleranceWarningCustomer(NewCustLedgEntry, AppliesToID, AppliedAmount, AmounttoApply, AppliesToDocNo) then
                exit(false);

        if Abs(AmounttoApply) >= Abs(AppliedAmount - PmtDiscAmount - MaxPmtTolAmount) then begin
            AppliedAmount := AppliedAmount - PmtDiscAmount;
            if (Abs(AppliedAmount) > Abs(AmounttoApply)) and (AppliedAmount * PmtDiscAmount > 0) then
                AppliedAmount := AmounttoApply;
            **PaymentTolWarning := GLSetup."Payment Tolerance Warning";
            OnAfterSetPaymentTolWarning(GLSetup, PaymentTolWarning);**
            if ((Abs(AppliedAmount + ApplyingAmount) - ApplnRoundingPrecision) <= Abs(MaxPmtTolAmount)) and
               (MaxPmtTolAmount <> 0) and ((Abs(AppliedAmount + ApplyingAmount) - ApplnRoundingPrecision) <> 0) and
               (Abs(AppliedAmount + ApplyingAmount) > ApplnRoundingPrecision)
            then
                **if PaymentTolWarning then**
                    if CallPmtTolWarning(
                         PostingDate, AccountNo, DocNo,
                         CurrencyCode, ApplyingAmount, OriginalAppliedAmount, "Payment Tolerance Account Type"::Customer)
                    then begin
                        if ApplyingAmount <> 0 then
                            PutCustPmtTolAmount(NewCustLedgEntry, ApplyingAmount, AppliedAmount, AppliesToID)
                        else
                            DelCustPmtTolAcc(NewCustLedgEntry, AppliesToID);
                    end else begin
                        DelCustPmtTolAcc(NewCustLedgEntry, AppliesToID);
                        exit(false);
                    end
                else
                    PutCustPmtTolAmount(NewCustLedgEntry, ApplyingAmount, AppliedAmount, AppliesToID);
        end;
        exit(true);
    end;

    [IntegrationEvent(false, false)]
    local procedure OnAfterSetPaymentTolWarning(GLSetup: Record "General Ledger Setup"; var PaymentTolWarning: Boolean)
    begin
    end;

PmtTolVendLedgEntry

    local procedure PmtTolVendLedgEntry(var NewVendLedgEntry: Record "Vendor Ledger Entry"; AccountNo: Code[20]; PostingDate: Date; DocNo: Code[20]; AppliesToID: Code[50]; AppliesToDocNo: Code[20]; CurrencyCode: Code[10]): Boolean
    var
        GLSetup: Record "General Ledger Setup";
        AppliedAmount: Decimal;
        OriginalAppliedAmount: Decimal;
        ApplyingAmount: Decimal;
        AmounttoApply: Decimal;
        PmtDiscAmount: Decimal;
        MaxPmtTolAmount: Decimal;
        ApplnRoundingPrecision: Decimal;
        IsHandled: Boolean;
        Result: Boolean;
        PaymentTolWarning: Boolean; 
    begin
        GLSetup.Get();
        CalcVendApplnAmount(
          NewVendLedgEntry, GLSetup, AppliedAmount, ApplyingAmount, AmounttoApply, PmtDiscAmount,
          MaxPmtTolAmount, AppliesToID, ApplnRoundingPrecision);

        IsHandled := false;
        OnPmtTolVendLedgEntryOnBeforeWarning(
          NewVendLedgEntry, GLSetup, AppliedAmount, ApplyingAmount, AmounttoApply, PmtDiscAmount,
          MaxPmtTolAmount, AppliesToID, ApplnRoundingPrecision, IsHandled, Result);
        if IsHandled then
            exit(Result);

        OriginalAppliedAmount := AppliedAmount;

        if GLSetup."Pmt. Disc. Tolerance Warning" then
            if not ManagePaymentDiscToleranceWarningVendor(NewVendLedgEntry, AppliesToID, AppliedAmount, AmounttoApply, AppliesToDocNo) then
                exit(false);

        if Abs(AmounttoApply) >= Abs(AppliedAmount - PmtDiscAmount - MaxPmtTolAmount) then begin
            AppliedAmount := AppliedAmount - PmtDiscAmount;
            **PaymentTolWarning := GLSetup."Payment Tolerance Warning";
            OnAfterSetPaymentTolWarning(GLSetup, PaymentTolWarning);**
            if (Abs(AppliedAmount) > Abs(AmounttoApply)) and (AppliedAmount * PmtDiscAmount > 0) then
                AppliedAmount := AmounttoApply;

            if ((Abs(AppliedAmount + ApplyingAmount) - ApplnRoundingPrecision) <= Abs(MaxPmtTolAmount)) and
               (MaxPmtTolAmount <> 0) and ((Abs(AppliedAmount + ApplyingAmount) - ApplnRoundingPrecision) <> 0) and
               (Abs(AppliedAmount + ApplyingAmount) > ApplnRoundingPrecision)
            then
                **if PaymentTolWarning then**
                    if CallPmtTolWarning(
                         PostingDate, AccountNo, DocNo, CurrencyCode, ApplyingAmount, OriginalAppliedAmount, "Payment Tolerance Account Type"::Vendor)
                    then begin
                        if ApplyingAmount <> 0 then
                            PutVendPmtTolAmount(NewVendLedgEntry, ApplyingAmount, AppliedAmount, AppliesToID)
                        else
                            DelVendPmtTolAcc(NewVendLedgEntry, AppliesToID);
                    end else begin
                        DelVendPmtTolAcc(NewVendLedgEntry, AppliesToID);
                        exit(false);
                    end
                else
                    PutVendPmtTolAmount(NewVendLedgEntry, ApplyingAmount, AppliedAmount, AppliesToID);
        end;
        exit(true);
    end;

    [IntegrationEvent(false, false)]
    local procedure OnAfterSetPaymentTolWarning(GLSetup: Record "General Ledger Setup"; var PaymentTolWarning: Boolean)
    begin
    end;

Internal work item: AB#612830

[JesperSchulz]

Thanks for reporting this. We agree, and we’ll publish a fix asap, either in an update for the current version or in the next major release. Please do not reply to this, as we do not monitor closed issues. If you have follow-up questions or requests, please create a new issue where you reference this one.

Build ID: 43942.