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
| tBudgetCheckInfo | input-output | temp-table | BudgetCheckInfo; 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 |
| ilOnlyHandleActualOnlineBudgets | input | logical | HandleActuals; set to true in case you also want to check against budgets where the property 'Check Actuals Onlin' is true |
| ilOnlyHandleCommitOnlineBudgets | input | logical | HandleCommitments; set to true in case you also want to check against budgets where the property 'Check Commitments Onlin' is true |
| ilAutoAssignTableBudgetWBSID | input | logical | AutoAssignTableBudgetWBSID; 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. |
| oiReturnStatus | output | integer | Return status of the method. |
Internal usage
QadFinancials
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 */