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


iiBudgetIDinputintegerID of Budget; idintifies the budget-record the check is needed for
icBudgetCodeinputcharacterBudgetCode; identifies the budget wherefor the check is needed (not used when BudgetID is passed)
oiReturnStatusoutputintegerReturn status of the method.


Internal usage


QadFinancials
method BBudget.AdditionalUpdValBudgetFDSOverlap


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.