project QadFinancials > class BBudget > method ApiCheckBudget

Description

This instanceless method performs some checks for the active versions of all operational budgets that structuraly fit the input parameters.
It will check the sum of the input values (Amount/Qty) and the already linked postings/commitments, cannot exceed the Budgetted figures.
For or all BudgetWBS records of a budget if there is an overlap of the FDS information between them all.
If the return of this method <> 0 then tFcMessage will contain further information.


Parameters


tBudgetCheckInfoinput-outputtemp-tableBudgetCheckInfo; instanceless temp-table that contains the information that is required to perform a budget-check (for cimmitments and for actuals) and that is also used to state the BudgetWBS topics that need to be update/created concerning the actual/cimmitment amounts
ilOnlyHandleActualOnlineBudgetsinputlogicalHandleActuals; set to true in case you also want to check against budgets where the property 'Check Actuals Onlin' is true
ilOnlyHandleCommitOnlineBudgetsinputlogicalHandleCommitments; set to true in case you also want to check against budgets where the property 'Check Commitments Onlin' is true
ilAutoAssignTableBudgetWBSIDinputlogicalAutoAssignTableBudgetWBSID; set this parameter to true in case you want the field tBudgetCheckInfo.BudgetWBSID to be filled automaticly in case the fields was still empty and there was only a single match for that input record.
oiReturnStatusoutputintegerReturn status of the method.


Internal usage


QadFinancials
method BPosting.AdditionalUpdatesBQBudgetActual


program code (program8/bbudget.p)

/* ======================================== */
/* Set defaukt return status / empty tables */
/* ======================================== */
assign oiReturnStatus = -98.
empty temp-table tBudgetMail.

/* ============================================================================ */
/* Call a method that will return a temp-table that contains all                */
/* matching BudgetWBS's that fit the input table properties                     */
/* No further processing needed in case this method does not return any records */
/* ============================================================================ */
<M-18 run BudgetCheckInfoResolve
          (input  tBudgetCheckInfo (tBudgetCheckInfo), 
           input  ilOnlyHandleCommitOnlineBudgets (ilOnlyHandleCommitOnlineBudgets), 
           input  ilOnlyHandleActualOnlineBudgets (ilOnlyHandleActualOnlineBudgets), 
           input  true (ilCalledFromBudgetCheck), 
           output tBudgetCheckInfoWBS (tBudgetCheckInfoWBS), 
           output viFcReturnSuper (oiReturnStatus)) in BBudget>
if viFcReturnSuper <> 0 and 
   (oiReturnStatus = -98 or oiReturnStatus >= 0)
then do :
    assign oiReturnStatus = viFcReturnSuper.
    if viFcReturnSuper < 0
    then return.
end. /* if viFcReturnSuper <> 0 and */ 
if not can-find (first tBudgetCheckInfoWBS) 
then do :
    assign oiReturnStatus = 0.
    return.
end. /* if not can-find (first tBudgetCheckInfoWBS) */

/* ======================================================== */
/* Convert the UnitCode in tBudgetCheckInfo into the UnitID */
/* ======================================================== */
if can-find (first tBudgetCheckInfo where 
                   tBudgetCheckInfo.tcUnitCode <> "":U and 
                   tBudgetCheckInfo.tcUnitCode <> ?    and 
                   (tBudgetCheckInfo.tiUnitID = 0 or
                    tBudgetCheckInfo.tiUnitID = ?))
then do :   
    <Q-112 run UnitPrim (all) (Read) (Cache)
          (input ?, (UnitID)
           input ?, (UnitCode)
           output dataset tqUnitPrim) in BUnit >
    for each tBudgetCheckInfo where 
             tBudgetCheckInfo.tcUnitCode <> "":U and 
             tBudgetCheckInfo.tcUnitCode <> ?    and 
             (tBudgetCheckInfo.tiUnitID = 0 or
              tBudgetCheckInfo.tiUnitID = ?): 
        find first tqUnitPrim where 
                   tqUnitPrim.tcUnitCode = tBudgetCheckInfo.tcUnitCode
                   no-lock no-error.
        assign tBudgetCheckInfo.tiUnitID = (if available tqUnitPrim
                                            then tqUnitPrim.tiUnit_ID
                                            else 0).
    end. /* for each tBudgetCheckInfo where */
    empty temp-table tqUnitPrim.
end. /* if can-find (first tBudgetCheckInfo where */

/* ========================================================== */
/* Go through tBudgetCheckInfoWBS with a different WBS-ID     */
/* Only type 'Cost' and 'Cost&Revenue' are taken into account */
/* ========================================================== */
for each tBudgetCheckInfoWBS where 
         tBudgetCheckInfoWBS.tcBudgetWBSCostRevenue <> {&BUDGETWBSCOSTREVENUE-REVENUE}
         break by tBudgetCheckInfoWBS.tiBudgetWBSID : 
    
    /* ================================================================================= */
    /* Build a list that contains tBudgetCheckInfoWBS.tiBudgetCheckInfoID for all        */
    /* tBudgetCheckInfoWBS that have the same BudgetWBSID. Reset this field on first-of. */
    /* ================================================================================= */
    if first-of (tBudgetCheckInfoWBS.tiBudgetWBSID) 
    then assign vcListBudgetCheckInfoID = string(tBudgetCheckInfoWBS.tiBudgetCheckInfoID).
    else assign vcListBudgetCheckInfoID = vcListBudgetCheckInfoID + ",":U + string(tBudgetCheckInfoWBS.tiBudgetCheckInfoID).
    
    /* ======================================================================= */
    /* Only 1 looping for each wbs-id // Reset Total-amounts                   */
    /* Skip the WBS's that have no overrun-check and on report-period-check on */
    /* ======================================================================= */
    if not last-of (tBudgetCheckInfoWBS.tiBudgetWBSID) or 
       (tBudgetCheckInfoWBS.tcBudgetWBSOverrunPeriod  = {&BUDGETOVERRUN-NONE} and 
        tBudgetCheckInfoWBS.tcBudgetWBSOverrunTotal   = {&BUDGETOVERRUN-NONE} and 
        tBudgetCheckInfoWBS.tcBudgetWBSOverrunYTD     = {&BUDGETOVERRUN-NONE} and 
        tBudgetCheckInfoWBS.tcBudgetCheckReportPeriod = {&BUDGETOVERRUN-NONE})
    then next.
    assign vdWBSTotalTC              = 0
           vdWBSTotalQTY             = 0
           vcWBSTotalCallerReference = "":U.
    
    /* ================================================================ */
    /* Check if an e-mail record already exists for the current budget. */
    /* If not, create one.                                              */
    /* ================================================================ */
    if tBudgetCheckInfoWBS.tlBudgetIsSendError   = true or 
       tBudgetCheckInfoWBS.tlBudgetIsSendWarning = true 
    then do :
        if not can-find (tBudgetMail where 
                         tBudgetMail.tiBudgetID = tBudgetCheckInfoWBS.tiBudgetID)
        then do:
            find first tqUserByNameID where
                       tqUserByNameID.tiUsr_ID = tBudgetCheckInfoWBS.tiUsrId
                       no-lock no-error.
            if not available tqUserByNameID
            then do :
                <Q-113 run UserByNameID (all) (Read) (NoCache)
          (input tBudgetCheckInfoWBS.tiUsrId, (UsrId)
           input ?, (UsrName)
           input ?, (UsrLogin)
           output dataset tqUserByNameID) in BUser >
                find first tqUserByNameID where
                           tqUserByNameID.tiUsr_ID = tBudgetCheckInfoWBS.tiUsrId
                           no-lock no-error.
            end. /* if not available tqUserByNameID */
            if available tqUserByNameID                and 
               tqUserByNameID.tcUsrMailAddress <> "":U and 
               tqUserByNameID.tcUsrMailAddress <> ?
            then do:
                create tBudgetMail.
                assign tBudgetMail.tiBudgetID              = tBudgetCheckInfoWBS.tiBudgetID
                       tBudgetMail.tcBudgetCode            = tBudgetCheckInfoWBS.tcBudgetCode
                       tBudgetMail.tcBudgetMailToAddress   = tqUserByNameID.tcUsrMailAddress
                       tBudgetMail.tcBudgetMailSubject     = trim(#T-89'Budget Check':25(14439)T-89#) + ' ':U + tBudgetCheckInfoWBS.tcBudgetCode + ' (':U + tqUserByNameID.tcUsrLogin + ')':U.
            end. /* if available tqUserByNameID */
        end. /* if not can-find (tBudgetMail where  */
    end. /* if tBudgetCheckInfoWBS.tlBudgetIsSendError   = true or */
    
    /* ============================================== */
    /* Check for actions on closed reporting periods  */
    /* ============================================== */
    if tBudgetCheckInfoWBS.tlReportPeriodIsReported   = true and 
       tBudgetCheckInfoWBS.tcBudgetCheckReportPeriod <> {&BUDGETOVERRUN-NONE}
    then do :
        if oiReturnStatus = -98 or oiReturnStatus >= 0
        then assign oiReturnStatus = (if tBudgetCheckInfoWBS.tcBudgetCheckReportPeriod  = {&BUDGETOVERRUN-WARNING} then +1 else -1).        
        assign vcMessage = trim(substitute(#T-34'The budget (&1) does not allow any action on closed reporting periods (&3/&4).':255(463)T-34#,trim(tBudgetCheckInfoWBS.tcBudgetCode),trim(string(tBudgetCheckInfoWBS.tiReportPeriodYear)),trim(string(tBudgetCheckInfoWBS.tiReportPeriodPeriod)))) + 
                           trim(substitute(#T-35'Reference of the caller: &1.':255(464)T-35#,tBudgetCheckInfoWBS.tcCallerReference)).
        <M-22 run SetMessage (input  vcMessage (icMessage),
                     input  '':U (icArguments),
                     input  '':U (icFieldName),
                     input  '':U (icFieldValue),
                     input  (if tBudgetCheckInfoWBS.tcBudgetCheckReportPeriod = {&BUDGETOVERRUN-WARNING} then 'W':U else 'E':U) (icType),
                     input  3 (iiSeverity),
                     input  '':U (icRowid),
                     input  'QADFIN-2031':U (icFcMsgNumber),
                     input  '' (icFcExplanation),
                     input  '' (icFcIdentification),
                     input  '' (icFcContext),
                     output viFcReturnSuper (oiReturnStatus)) in BBudget>
        /* update e-mailbody */
        if available tBudgetMail and 
           ((oiReturnStatus < 0 and tBudgetCheckInfoWBS.tlBudgetIsSendError) or
            (oiReturnStatus > 0 and tBudgetCheckInfoWBS.tlBudgetIsSendWarning))
        then assign tBudgetMail.tcBudgetMailBody = tBudgetMail.tcBudgetMailBody + vcMessage.
        next.
    end. /* if tBudgetCheckInfoWBS.tlReportPeriodIsReported   = true and */
    
    /* ============================================== */
    /* Go through the linked tBudgetCheckInfo records */
    /* ============================================== */
    for each tBudgetCheckInfo where 
             lookup(string(tBudgetCheckInfo.tiBudgetCheckInfoID),vcListBudgetCheckInfoID) <> 0 :
        /* ========================================================== */
        /* Raise the total per WBS // convert amount when needed      */
        /* Compose a list with the caller-references                  */
        /* When input-Unit is filled it should match the budget-Unit  */
        /* Errors:                                                    */
        /*  - missing exchange-rate                                   */
        /*  - failure on rounding                                     */
        /*  - invalid input-unit                                      */
        /* ========================================================== */
        assign vcWBSTotalCallerReference = vcWBSTotalCallerReference + (if vcWBSTotalCallerReference = "":U then "":U else ", ":U) + 
                                           (if tBudgetCheckInfo.tcCallerReference = ? then string(tBudgetCheckInfo.tiBudgetCheckInfoID) else tBudgetCheckInfo.tcCallerReference)
               vdExchRate                = 1
               vdExchRateScale           = 1.
        if tBudgetCheckInfo.tcCurrencyCode <> tBudgetCheckInfoWBS.tcCurrencyCode
        then do :
            <M-67 run GetExchangeRate
               (input  tBudgetCheckInfo.tiCompanyId (iiCompanyID), 
                input  tBudgetCheckInfo.tiCurrencyID (iiFromCurrencyID), 
                input  tBudgetCheckInfo.tcCurrencyCode (icFromCurrencyCode), 
                input  tBudgetCheckInfoWBS.tiCurrencyID (iiToCurrencyID), 
                input  tBudgetCheckInfoWBS.tcCurrencyCode (icToCurrencyCode), 
                input  ? (iiExchangeRateTypeID), 
                input  {&EXCHANGERATETYPE-ACCOUNTING} (icExchangeRateTypeCode), 
                input  (if tBudgetCheckInfo.ttDate = ? then today else tBudgetCheckInfo.ttDate) (itValidityDate), 
                output vdExchRate (odExchangeRate), 
                output vdExchRateScale (odExchangeScaleFactor), 
                output viFcReturnSuper (oiReturnStatus)) in BBudget>
            if viFcReturnSuper <> 0 and 
              (oiReturnStatus = -98 or oiReturnStatus >= 0) 
            then do : 
                assign oiReturnStatus = viFcReturnSuper.
                if oiReturnStatus < 0 then next.
            end. /* if viFcReturnSuper <> 0 */ 
        end. /* if tBudgetCheckInfo.tcCurrencyCode <> tBudgetCheckInfoWBS.tcCurrencyCode */
        assign vdWBSTotalTC = vdWBSTotalTC + <M-114 RoundAmount
          (input  tBudgetCheckInfo.tdAmountTC * vdExchRate * vdExchRateScale (idUnroundedAmount), 
           input  '':U (iiCurrencyID), 
           input  tBudgetCheckInfoWBS.tcCurrencyCode (icCurrencyCode)) in business>
                              
            /*round(tBudgetCheckInfo.tdAmountTC * vdExchRate * vdExchRateScale,
                                    integer(entry(lookup(tBudgetCheckInfoWBS.tcCurrencyCode,
                                                         vcCurrencyDecimalsList) 
                                                  + 1,
                                                  vcCurrencyDecimalsList))) */  no-error.
        if error-status:error and 
           (oiReturnStatus = -98 or oiReturnStatus >= 0)
        then do:
            assign oiReturnStatus = -3.
                   vcMessage = trim(substitute(#T-36'An internal error occurred while aggregating the amounts for the budget check.':255(465)t-36#)).
            if ERROR-STATUS:NUM-MESSAGES > 0
            then assign vcMessage = vcMessage + chr(10) + 
                                    trim(substitute(#T-37'Detailed info: &1 (&2).':255(466)T-37#,ERROR-STATUS:GET-MESSAGE(1),string(ERROR-STATUS:GET-NUMBER(1)))).
            <M-24 run SetMessage (input  vcMessage (icMessage),
                     input  '':U (icArguments),
                     input  '':U (icFieldName),
                     input  '':U (icFieldValue),
                     input  'E':U (icType),
                     input  3 (iiSeverity),
                     input  '':U (icRowid),
                     input  'QADFIN-2032':U (icFcMsgNumber),
                     input  '' (icFcExplanation),
                     input  '' (icFcIdentification),
                     input  '' (icFcContext),
                     output viFcReturnSuper (oiReturnStatus)) in BBudget>
            if oiReturnStatus < 0 then next.
        end. /* if error-status:error */
        /* ================================== */
        /* Update TotalQTY if UnitCodes match */
        /* ================================== */
        if tBudgetCheckInfoWBS.tiUnitID <> 0 and 
           tBudgetCheckInfoWBS.tiUnitID <> ? and 
           tBudgetCheckInfo.tiUnitID    <> 0 and 
           tBudgetCheckInfo.tiUnitID    <> ?
        then do :
            if tBudgetCheckInfoWBS.tiUnitID  = tBudgetCheckInfo.tiUnitID
            then assign vdWBSTotalQTY = vdWBSTotalQTY + tBudgetCheckInfo.tdQTY.
            else do :
                assign oiReturnStatus = -3
                       vcMessage = trim(substitute(#T-107'The input unit (&1) differs from the unit of the budget node (&2) of budget (&3).':255(14442)T-107#,(if tBudgetCheckInfo.tcUnitCode <> ? then tBudgetCheckInfo.tcUnitCode else "?":U),tBudgetCheckInfoWBS.tcBudgetWBSCode,tBudgetCheckInfoWBS.tcBudgetCode)) + chr(10) + 
                                   trim(substitute(#T-108'Unit of the budget node: &1.':255(468)T-108#,string(tBudgetCheckInfoWBS.tiUnitID))).
                <M-106 run SetMessage (input  vcMessage (icMessage),
                     input  '':U (icArguments),
                     input  '':U (icFieldName),
                     input  '':U (icFieldValue),
                     input  'E':U (icType),
                     input  3 (iiSeverity),
                     input  '':U (icRowid),
                     input  'QADFIN-3985':U (icFcMsgNumber),
                     input  '' (icFcExplanation),
                     input  '' (icFcIdentification),
                     input  '' (icFcContext),
                     output viFcReturnSuper (oiReturnStatus)) in BBudget>
                next.
            end. /* if tBudgetCheckInfoWBS.tiUnitID <> tBudgetCheckInfo.tiUnitID */
        end. /* if tBudgetCheckInfoWBS.tiUnitID <> 0 and */
    end. /* for each tBudgetCheckInfo where */
    
    /* =============================== */
    /* Get the BudgetPeriods           */
    /* =============================== */
    if not can-find (first tqBudgetPeriodByBudgetIDDate where 
                           tqBudgetPeriodByBudgetIDDate.tiBudget_ID = tBudgetCheckInfoWBS.tiBudgetID)
    then do :
        <Q-26 run BudgetPeriodByBudgetIDDate (all) (Read) (NoCache)
          (input tBudgetCheckInfoWBS.tiBudgetID, (BudgetID)
           input ?, (BudgetPeriodID)
           input ?, (EnclosedDate)
           output dataset tqBudgetPeriodByBudgetIDDate) in BBudget >
    end. /* if not can-find (first tqBudgetPeriodByBudgetIDDate where  */    
    
    /* =============================== */
    /* Get the Actuals and Commitments */
    /* Get the Budget-Figures          */
    /* =============================== */
    <M-27 run ApiCheckBudgetGetFigures (output viFcReturnSuper (oiReturnStatus)) in BBudget>
    if viFcReturnSuper <> 0 and 
       (oiReturnStatus = -98 or oiReturnStatus >= 0)
    then do :
        assign oiReturnStatus = viFcReturnSuper.
        if oiReturnStatus < 0 then next.
    end.
    
    /* ========================================== */                                                        
    /* Raise errors/warnings based on the Figures */
    /* ========================================== */
    <M-97 run ApiCheckBudgetMessages (input  vcWBSTotalCallerReference (icWBSTotalCallerReference), 
                                      input  vdWBSTotalTC (idWBSTotalTC), 
                                      input  vdWBSTotalQTY (idWBSTotalQTY), 
                                      output viFcReturnSuper (oiReturnStatus)) in BBudget>
    if viFcReturnSuper <> 0 and (oiReturnStatus = -98 or oiReturnStatus >= 0)
    then assign oiReturnStatus = viFcReturnSuper.
    
end. /* for each tBudgetCheckInfoWBS */

/* ================================================== */                                                        
/* Get the current User its Email Address when needed */
/* ================================================== */
assign vcUsrMailAddress = "":U.
if can-find (first tBudgetMail)
then do :
    find first tqUserByNameID where
               tqUserByNameID.tiUsr_ID = viUsrId
               no-lock no-error.
    if not available(tqUserByNameID)
    then do :
        <Q-99 run UserByNameID (first) (Read) (NoCache)
          (input viUsrId, (UsrId)
           input ?, (UsrName)
           input ?, (UsrLogin)
           output dataset tqUserByNameID) in BUser >
        find first tqUserByNameID where
                   tqUserByNameID.tiUsr_ID = viUsrId
                   no-lock no-error.
    end. /* if not available(tqUserByNameID) */
    if available(tqUserByNameID)
    then assign vcUsrMailAddress = tqUserByNameID.tcUsrMailAddress.
end. /* if can-find */

/* ============================================================ */
/* - Delete empty mails.                                        */
/* - Delete mails if Budget Responsible has no E-mail Address.  */
/* - Fill in FromAddress                                        */
/* - Send E-mail.                                               */
/* ============================================================ */
for each tBudgetMail:
    /* Skip empty To-addresses / Complete the From-Address */
    if tBudgetMail.tcBudgetMailBody = "":U or 
       tBudgetMail.tcBudgetMailBody = ?    or
       tBudgetMail.tcBudgetMailToAddress = "":U or
       tBudgetMail.tcBudgetMailToAddress = ?
    then next.
    if vcUsrMailAddress <> "":U and 
       vcUsrMailAddress <> ?
    then assign tBudgetMail.tcBudgetMailFromAddress = vcUsrMailAddress.
    else assign tBudgetMail.tcBudgetMailFromAddress = tBudgetMail.tcBudgetMailToAddress.
    if tBudgetMail.tcBudgetMailFromAddress = "":U or 
       tBudgetMail.tcBudgetMailFromAddress = ? 
    then next.
    /* Open-instance / Send E-mail / Close-instance*/
    if (viMailBudgetID = 0 or viMailBudgetID = ?)
    then do:
        <I-101 {bFcStartAndOpenInstance
            &ADD-TO-TRANSACTION = "false"
            &CLASS              = "Mail"}>
    end. /* if viMailBudgetID = 0  */
    else do:
        <I-104 {bFcOpenInstance
            &CLASS           = "Mail"}>
    end. /* if not viMailBudgetID = 0  */
    <M-100 run Send (input  tBudgetMail.tcBudgetMailFromAddress (icFrom), 
                     input  tBudgetMail.tcBudgetMailToAddress (icTo), 
                     input  tBudgetMail.tcBudgetMailSubject (icSubject), 
                     input  tBudgetMail.tcBudgetMailBody (icBody), 
                     output viFcReturnSuper (oiReturnStatus)) in Mail>
    if viFcReturnSuper < 0 or (viFcReturnSuper > 0 and oiReturnStatus = -98)
    then assign oiReturnStatus = viFcReturnSuper.
    <I-105 {bFcCloseInstance
            &CLASS           = "Mail"}>
end. /* for each tBudgetMail: */
empty temp-table tBudgetMail.

/* ================================================================== */
/* If parameter 'AutoAssignTableBudgetWBSID' is true then field       */
/* tBudgetCheckInfo.BudgetWBSID will be assigned automaticly in case: */
/* - the fields was still empty in the input-output tables            */
/* - there was only a single match for that input record              */
/* ================================================================== */
if ilAutoAssignTableBudgetWBSID = true
then do :
    for each tBudgetCheckInfo where 
             tBudgetCheckInfo.tiBudgetWBSID = 0 or 
             tBudgetCheckInfo.tiBudgetWBSID = ? : 
        assign tBudgetCheckInfo.tiNewBudgetWBSID = 0.
        find first tBudgetCheckInfoWBS where 
                   tBudgetCheckInfoWBS.tiBudgetCheckInfoID = tBudgetCheckInfo.tiBudgetCheckInfoID
                   no-error.
        if available tBudgetCheckInfoWBS
        then do :
            assign viNewBudgetWBSID          = tBudgetCheckInfoWBS.tiBudgetWBSID
                   vrRowidBudgetCheckInfoWBS = rowid(tBudgetCheckInfoWBS).
            find first tBudgetCheckInfoWBS where 
                       tBudgetCheckInfoWBS.tiBudgetCheckInfoID  = tBudgetCheckInfo.tiBudgetCheckInfoID and 
                       rowid(tBudgetCheckInfoWBS)              <> vrRowidBudgetCheckInfoWBS
                       no-error.
            if NOT available tBudgetCheckInfoWBS
            then assign tBudgetCheckInfo.tiNewBudgetWBSID = viNewBudgetWBSID.
        end. /* if available tBudgetCheckInfoWBS */
    end. /* for each tBudgetCheckInfo where */
end. /* if ilAutoAssignTableBudgetWBSID = true */

/* ================= */
/* Set Return-status */
/* ================= */                                 
if oiReturnStatus = -98
then assign oiReturnStatus = 0.
if oiReturnStatus < 0 
then do:
    <M-115 run StopExternalInstances
       (output viFcReturnSuper (oiReturnStatus)) in BBudget>
    return.
end. /* if oiReturnStatus < 0 */