project QadFinancials > class BBudget > method BudgetCheckFDSOverlap
Description
This method check for 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
| iiBudgetID | input | integer | ID of Budget; idintifies the budget-record the check is needed for |
| icBudgetCode | input | character | BudgetCode; identifies the budget wherefor the check is needed (not used when BudgetID is passed) |
| oiReturnStatus | output | integer | Return status of the method. |
Internal usage
QadFinancials
program code (program7/bbudget.p)
/* ========================= */
/* Set default return status */
/* ========================= */
assign oiReturnStatus = -98.
/* ====================================================================================== */
/* Define a buffer on a query-temp-table; it is not possible to do this using a data-item */
/* ====================================================================================== */
define buffer btqBudgetWBSByBudgetID for tqBudgetWBSByBudgetID.
/* ========================================== */
/* Validations */
/* State the ID if only the Code was provided */
/* ========================================== */
if iiBudgetID = ? then assign iiBudgetID = 0.
if icBudgetCode = ? then assign icBudgetCode = "":U.
if iiBudgetID = 0 and icBudgetCode = "":U
then do :
assign oiReturnStatus = -3
vcMessage = trim(#T-20'You must enter the budget identification (ID/code) for the overlap check.':255(699)T-20#).
<M-5 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-567':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end. /* if icBudgetTcRowid = ? or */
if iiBudgetID = 0
then do :
find tBudget where
tBudget.BudgetCode = icBudgetCode and
tBudget.tc_Status <> "D":U
no-lock no-error.
if available tBudget
then assign iiBudgetID = tBudget.Budget_ID.
else do :
<Q-7 run BudgetPrim (all) (Read) (NoCache)
(input ?, (BudgetID)
input icBudgetCode, (BudgetCode)
output dataset tqBudgetPrim) in BBudget >
find first tqBudgetPrim where
tqBudgetPrim.tcBudgetCode = icBudgetCode
no-lock no-error.
if not available tqBudgetPrim
then do :
assign oiReturnStatus = -3
vcMessage = trim(substitute(#T-21'Cannot state the ID of the budget based on the budget code (&1).':255(700)T-21#,icBudgetCode)).
<M-8 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-588':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end. /* if not available tqBudgetPrim */
assign iiBudgetID = tqBudgetPrim.tiBudget_ID.
end. /* if available tBudget */
end. /* if iiBudgetID = 0 */
/* ========================================================================================= */
/* Before continuing our overlap-check, we need to have all data in table tBudgetWBSResolved */
/* Either we have the budget in our instance (when called from ValidateComponent), */
/* either we have nothing and we need to use queries to retrieve the required data. */
/* ========================================================================================= */
empty temp-table tResolvedBudgetWBS.
find tBudget where
tBudget.Budget_ID = iiBudgetID and
tBudget.tc_Status <> "D":U
no-lock no-error.
if available tBudget
then do :
/* ==================================================================================== */
/* Compute the FDS-depth; number of entries in the FDS-structure; */
/* - All nodes <> TOTAL */
/* - All SAF-NODES */
/* ==================================================================================== */
DEPTHBLOCK: DO :
for each tBudgetFDS where
tBudgetFDS.tc_ParentRowid = tBudget.tc_Rowid and
tBudgetFDS.tc_Status <> "D":U
no-lock
by tBudgetFDS.BudgetFDSSeq :
assign viFDSDepth = viFDSDepth + 1.
end. /* for each tBudgetFDS where */
END. /* DEPTHBLOCK */
/* ==================================== */
/* Gather information for the resolving */
/* ==================================== */
find first tBudgetCompany where
tBudgetCompany.tc_ParentRowid = tBudget.tc_Rowid and
tBudgetCompany.tc_Status <> "D":U
no-lock no-error.
for each tBudgetWBS where
tBudgetWBS.tc_ParentRowid = tBudget.tc_Rowid and
tBudgetWBS.tc_Status <> "D":U
no-lock :
create tResolvedBudgetWBS.
assign tResolvedBudgetWBS.tiCompanyId = (if available tBudgetCompany then tBudgetCompany.Company_ID else 0)
tResolvedBudgetWBS.tcBudgetCode = tBudget.BudgetCode
tResolvedBudgetWBS.tiParentBudgetWBSID = tBudgetWBS.ParentBudgetWBS_ID
tResolvedBudgetWBS.tcBudgetWBSTcRowid = tBudgetWBS.tc_Rowid
tResolvedBudgetWBS.tiBudgetWBSID = tBudgetWBS.BudgetWBS_ID
tResolvedBudgetWBS.tcBudgetWBSCode = tBudgetWBS.BudgetWBSCode
tResolvedBudgetWBS.tiSafConceptID = tBudgetWBS.SafConcept_ID
tResolvedBudgetWBS.tiBudgetGroupID = tBudgetWBS.BudgetGroup_ID
tResolvedBudgetWBS.tiFDSSeq = tBudgetWBS.BudgetFDSSeq
tResolvedBudgetWBS.tcFDSType = tBudgetWBS.BudgetFDSType
tResolvedBudgetWBS.tcFDSCode = tBudgetWBS.BudgetWBSFDSCode
tResolvedBudgetWBS.tcFDSFromCode = tBudgetWBS.BudgetWBSFDSFromCode
tResolvedBudgetWBS.tcFDSToCode = tBudgetWBS.BudgetWBSFDSToCode
tResolvedBudgetWBS.tcFDSList = tBudgetWBS.BudgetWBSFDSList.
end. /* for each tBudgetWBS where */
end. /* if available tBudget */
else do :
/* ==================================== */
/* Gather information for the resolving */
/* ==================================== */
<Q-15 run BudgetPrim (all) (Read) (NoCache)
(input iiBudgetID, (BudgetID)
input ?, (BudgetCode)
output dataset tqBudgetPrim) in BBudget >
find first tqBudgetPrim no-lock no-error. /* error is checked before */
<Q-9 run BudgetCompanyByBudgetID (all) (Read) (NoCache)
(input ?, (CompanyId)
input iiBudgetID, (BudgetID)
output dataset tqBudgetCompanyByBudgetID) in BBudget >
find first tqBudgetCompanyByBudgetID no-lock no-error. /* error is checked before */
<Q-19 run BudgetWBSByBudgetIDWBSCode (all) (Read) (NoCache)
(input iiBudgetID, (BudgetID)
input ?, (BudgetWBSID)
input ?, (BudgetWBSCode)
input ?, (ParentBudgetWBSID)
input ?, (BudgetCode)
input ?, (BudgetStatus)
output dataset tqBudgetWBSByBudgetID) in BBudget >
/* ======================================================================= */
/* Compute the FDS-depth; number of entries in the FDS-structure */
/* ======================================================================= */
<Q-18 run BudgetFDSByBudgetIDType (all) (Read) (NoCache)
(input iiBudgetID, (BudgetID)
input ?, (BudgetFDSType)
input ?, (BudgetFDSID)
output dataset tqBudgetFDSByBudgetIDType) in BBudget >
DEPTHBLOCKQUERY: DO :
for each tBudgetFDS where
tqBudgetFDSByBudgetIDType.tiBudget_ID = iiBudgetID
no-lock
by tqBudgetFDSByBudgetIDType.tiBudgetFDSSeq :
assign viFDSDepth = viFDSDepth + 1.
end. /* for each tBudgetFDS where */
END. /* DEPTHBLOCKQUERY */
/* ============================================== */
/* Continue: Gather information for the resolving */
/* ============================================== */
for each tqBudgetWBSByBudgetID no-lock :
create tResolvedBudgetWBS.
assign tResolvedBudgetWBS.tiCompanyId = (if available tqBudgetCompanyByBudgetID then tqBudgetCompanyByBudgetID.tiCompany_ID else 0)
tResolvedBudgetWBS.tcBudgetCode = (if available tqBudgetPrim then tqBudgetPrim.tcBudgetCode else "?":U)
tResolvedBudgetWBS.tiParentBudgetWBSID = tBudgetWBS.ParentBudgetWBS_ID
tResolvedBudgetWBS.tcBudgetWBSTcRowid = tqBudgetWBSByBudgetID.tc_Rowid
tResolvedBudgetWBS.tiBudgetWBSID = tqBudgetWBSByBudgetID.tiBudgetWBS_ID
tResolvedBudgetWBS.tcBudgetWBSCode = tqBudgetWBSByBudgetID.tcBudgetWBSCode
tResolvedBudgetWBS.tiSafConceptID = tqBudgetWBSByBudgetID.tiSafConcept_ID
tResolvedBudgetWBS.tiBudgetGroupID = tqBudgetWBSByBudgetID.tiBudgetGroup_ID
tResolvedBudgetWBS.tiFDSSeq = tqBudgetWBSByBudgetID.tiBudgetFDSSeq
tResolvedBudgetWBS.tcFDSType = tqBudgetWBSByBudgetID.tcBudgetFDSType
tResolvedBudgetWBS.tcFDSCode = tqBudgetWBSByBudgetID.tcBudgetWBSFDSCode
tResolvedBudgetWBS.tcFDSFromCode = tqBudgetWBSByBudgetID.tcBudgetWBSFDSFromCode
tResolvedBudgetWBS.tcFDSToCode = tqBudgetWBSByBudgetID.tcBudgetWBSFDSToCode
tResolvedBudgetWBS.tcFDSList = tqBudgetWBSByBudgetID.tcBudgetWBSFDSList.
end. /* for each tqBudgetWBSByBudgetID */
end. /* if not available tBudget */
/* ======================================================= */
/* Return OK if there is no WBS information to be checked */
/* ======================================================= */
if not can-find (first tResolvedBudgetWBS)
then do :
assign oiReturnStatus = 0.
return.
end. /* if not can-find (first tResolvedBudgetWBS) */
/* ==================================================================================================== */
/* Make sure Resolved1-Resolved9 and tResolvedBudgetWBS.tcFullWBSCode gets filled in tResolvedBudgetWBS */
/* This method calls itself recursively by raising iiReloveLevel by 1 (except for nodes with type=TOTAL */
/* ==================================================================================================== */
<M-11 run BudgetCheckFDSOverlapSub1 (input 0 (iiParentBudgetWBSID),
input '':U (icParentBudgetWBSCode),
input viFDSDepth (iiMaxFDSSequence),
input 1 (iiResolveLevel),
input '':U (icResolved1),
input '':U (icResolved2),
input '':U (icResolved3),
input '':U (icResolved4),
input '':U (icResolved5),
input '':U (icResolved6),
input '':U (icResolved7),
input '':U (icResolved8),
input '':U (icResolved9),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
if viFcReturnSuper <> 0
then do :
find first tResolvedBudgetWBS no-lock no-error.
assign oiReturnStatus = -3
vcMessage = trim(substitute(#T-22'The COA overlap check cannot be performed for budget &1. Cannot resolve the COA values for the WBS topics.':255(701)T-22#,(if available tResolvedBudgetWBS then tResolvedBudgetWBS.tcBudgetCode else "?":U))) + chr(10) +
trim(substitute(#T-23'Detailed error status: &1.':255(702)T-23#,string(viFcReturnSuper))).
<M-12 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-589':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end. /* if viFcReturnSuper <> 0 */
/* ========================================================================== */
/* Check tResolvedBudgetWBS for overlap: go through all records of the lowest */
/* level and check if you can find another one that has overlap on all levels */
/* ========================================================================== */
<M-17 run BudgetCheckFDSOverlapSub2 (input viFDSDepth (iiFDSDepth),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
if viFcReturnSuper <> 0
then do :
assign oiReturnStatus = viFcReturnSuper.
if oiReturnStatus < 0
then return.
end. /* if viFcReturnSuper <> 0 */
/* ====================== */
/* Set ReturnStatus = OK */
/* ====================== */
assign oiReturnStatus = 0.