Description
This method can be used to rebuild a whole budget. First the existing budget will be deleted and afterwards the budget will be created again
Parameters
| icBudgetCode | input | character | BudgetCode |
| iiBudgetID | input | integer | Budget ID |
| oiReturnStatus | output | integer | Return status of the method. |
Internal usage
QadFinancials
program code (program6/bbudgetrebuild.p)
empty temp-table tNewQBudgetLA.
empty temp-table tNewQBudgetLC.
/* --------------- */
/* Initial actions */
/* --------------- */
/* check if the inputparameters contain the correct values */
if (icBudgetCode = ? or icBudgetCode = "":U) and
(iiBudgetID = ? or iiBudgetID = 0 )
then do:
<M-19 run SetMessage
(input trim(#T-61'Not all information that is required for rebuilding a budget is available.':255(738)T-61#) (icMessage),
input ? (icArguments),
input 'Budget Code':U (icFieldName),
input icBudgetCode (icFieldValue),
input 'E':U (icType),
input 3 (iiSeverity),
input ? (icRowid),
input 'QADFIN-2189':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudgetRebuild>
assign oiReturnStatus = -1.
return.
end.
/* Decode the BudgetCode into BudgetID so we can always use the ID */
/* check if the budget has the operational status */
if iiBudgetID = 0
then assign iiBudgetID = ?.
<Q-17 run BudgetByBudgetIDCodeStatus (all) (Read) (NoCache)
(input iiBudgetID, (BudgetID)
input icBudgetCode, (BudgetCode)
input ?, (BudgetStatus)
input viCompanyId, (CompanyId)
input ?, (ProjectCode)
input ?, (CostCentreCode)
input ?, (BudgetIsCheckActualOnLine)
input ?, (BudgetIsCheckCommitOnLine)
input ?, (BudgetIsAutoRollUp)
input ?, (ProjectID)
input ?, (CostCentreID)
input ?, (BudgetType)
output dataset tqBudgetByBudgetIDCodeStatus) in BBudget >
find first tqBudgetByBudgetIDCodeStatus no-lock no-error.
if not available tqBudgetByBudgetIDCodeStatus
then do:
<M-20 run SetMessage
(input trim(#T-62'The specified budget is not available in the system.':255(739)T-62#) (icMessage),
input ? (icArguments),
input 'Budget Code':U (icFieldName),
input icBudgetCode (icFieldValue),
input 'E':U (icType),
input 3 (iiSeverity),
input ? (icRowid),
input 'QADFIN-2190':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudgetRebuild>
assign oiReturnStatus = -1.
return.
end.
/* so we can always us ID and doens't have to use code */
assign iiBudgetID = tqBudgetByBudgetIDCodeStatus.tiBudget_ID
icBudgetCode = tqBudgetByBudgetIDCodeStatus.tcBudgetCode.
if tqBudgetByBudgetIDCodeStatus.tcBudgetStatus <> {&BUDGETSTATUS-OPERATIONAL}
then do:
<M-18 run SetMessage
(input trim(#T-63'You can only rebuild an operational budget.':255(740)T-63#) (icMessage),
input ? (icArguments),
input 'Budget Code':U (icFieldName),
input tqBudgetByBudgetIDCodeStatus.tcBudgetCode (icFieldValue),
input 'E':U (icType),
input 3 (iiSeverity),
input ? (icRowid),
input 'QADFIN-2188':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudgetRebuild>
assign oiReturnStatus = -1.
return.
end.
/* The budget rebuild can only be run when no QBudgetActual and no QBudgetCommitment records exist */
<Q-54 assign vlFcQueryRecordsAvailable = QBudgetLinkActualByAll (NoCache)
(input 0, (CompanyId)
input ?, (DaemonId)
input iiBudgetID, (BudgetID)) in BQBudgetActual>
if vlFcQueryRecordsAvailable <> false
then do:
<M-94 run SetMessage
(input #T-16'Budget daemon requests still exist. The budget cannot be rebuilt until the requests are processed by the daemon.':200(17822)T-16# (icMessage),
input '':U (icArguments),
input '':U (icFieldName),
input '':U (icFieldValue),
input 'E':U (icType),
input 2 (iiSeverity),
input '':U (icRowid),
input 'qadfin-476805':U (icFcMsgNumber),
input '':U (icFcExplanation),
input '':U (icFcIdentification),
input '':U (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudgetRebuild>
assign oiReturnStatus = -1.
return.
end. /* QBudgetActual records found */
<Q-3 assign vlFcQueryRecordsAvailable = QBudgetLinkCommitByAll (NoCache)
(input 0, (CompanyId)
input ?, (DaemonId)) in BQBudgetCommitment>
if vlFcQueryRecordsAvailable <> false
then do:
<M-6 run SetMessage
(input #T-8'Commitment Budget daemon requests still exist. The budget cannot be rebuilt until the requests are processed by the daemon.':200(17823)T-8# (icMessage),
input '':U (icArguments),
input '':U (icFieldName),
input '':U (icFieldValue),
input 'E':U (icType),
input 2 (iiSeverity),
input '':U (icRowid),
input 'qadfin-429335':U (icFcMsgNumber),
input '':U (icFcExplanation),
input '':U (icFcIdentification),
input '':U (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudgetRebuild>
assign oiReturnStatus = -1.
return.
end. /* QBudgetActual records found */
/* ======================================================================================= */
/* We run the method with direct db access statements for performance and memory reasons */
/* The method will clear the data of the existing budget and will create new queue records */
/* to be processed by the budget daemon */
/* ======================================================================================= */
<M-24 run ApiRebuildBudgetDIRECT
(input iiBudgetID (iiBudgetID),
output viDummy (oiQBudgetLinkActualCREATED#),
output viFcReturnSuper (oiReturnStatus)) in BBudgetRebuild>
assign vcMessage = trim ( #T-77'Rebuild ended successfully':255(835700275)T-77#) + ' : ' + trim (substitute (#T-55'&1 transaction lines were found for this budget and passed to the budget daemon.':255(5689424)T-55#,viDummy)).
<M-65 run SetMessage
(input vcMessage (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'W':U (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'qadfin-404806':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudgetRebuild>
assign oiReturnStatus = 1.
/* ... start replace by direct db
/* ----------------------------------------------------------------------------------------------- */
/* delete the records in budgetlink, budgetLinkAcc, budgetLinkAccDet, budgetlinkactuals and */
/* budgetlinkcommit for the right budgetID */
/* ----------------------------------------------------------------------------------------------- */
<M-80 run StartPersistence (output vhFcPL (ohPersistence),
output viFcReturnSuper (oiReturnStatus)) in BBudgetRebuild>
if oiReturnStatus <> 0
then return.
/* ------------------ delete budgetlink ------------------------------ */
assign vhFcComponent = vhFcPL
vcWhere = "For each BudgetLink where BudgetLink.Budget_ID = ":U + string(iiBudgetID).
<M-81 run WriteDirect (input 'BudgetLink':U (icTableName),
input vcWhere (icPrepare),
input '':U (icFieldList),
input '':U (icFieldListDataTypes),
input '':U (icAbsolute),
input '':U (icIncremental),
input {&TARGETPROCEDURE} (ihClass),
input vcUserLogin (icUserLogin),
output viFcReturnSuper (oiReturnStatus)) in persistence>
/* if record not found, no problem, then the record must not be deleted */
if oiReturnStatus = -4
then assign oiReturnStatus = 0.
/* ------------------ delete budgetlinkactual ----------------------- */
assign vhFcComponent = vhFcPL
vcWhere = "For each BudgetLinkActual where BudgetLinkActual.Budget_ID = ":U + string(iiBudgetID).
<M-82 run WriteDirect (input 'BudgetLinkActual':U (icTableName),
input vcWhere (icPrepare),
input '':U (icFieldList),
input '':U (icFieldListDataTypes),
input '':U (icAbsolute),
input '':U (icIncremental),
input {&TARGETPROCEDURE} (ihClass),
input vcUserLogin (icUserLogin),
output viFcReturnSuper (oiReturnStatus)) in persistence>
/* if record not found, no problem, then the record must not be deleted */
if oiReturnStatus = -4
then assign oiReturnStatus = 0.
/* ------------------ delete budgetlinkacc --------------------------- */
assign vhFcComponent = vhFcPL
vcWhere = "For each BudgetLinkAcc where BudgetLinkAcc.Budget_ID = ":U + string(iiBudgetID).
<M-83 run WriteDirect (input 'BudgetLinkAcc':U (icTableName),
input vcWhere (icPrepare),
input '':U (icFieldList),
input '':U (icFieldListDataTypes),
input '':U (icAbsolute),
input '':U (icIncremental),
input {&TARGETPROCEDURE} (ihClass),
input vcUserLogin (icUserLogin),
output viFcReturnSuper (oiReturnStatus)) in persistence>
/* if record not found, no problem, then the record must not be deleted */
if oiReturnStatus = -4
then assign oiReturnStatus = 0.
/* ------------------ delete budgetlinkaccdet------------------------- */
assign vhFcComponent = vhFcPL
vcWhere = "For each BudgetLinkAccDet where BudgetLinkAccDet.Budget_ID = ":U + string(iiBudgetID).
<M-84 run WriteDirect (input 'BudgetLinkAccDet':U (icTableName),
input vcWhere (icPrepare),
input '':U (icFieldList),
input '':U (icFieldListDataTypes),
input '':U (icAbsolute),
input '':U (icIncremental),
input {&TARGETPROCEDURE} (ihClass),
input vcUserLogin (icUserLogin),
output viFcReturnSuper (oiReturnStatus)) in persistence>
/* if record not found, no problem, then the record must not be deleted */
if oiReturnStatus = -4
then assign oiReturnStatus = 0.
/* ----------------------------- delete budgetlinkcommit ------------------------------ */
assign vhFcComponent = vhFcPL
vcWhere = "For each BudgetLinkCommit where BudgetLinkCommit.Budget_ID = ":U + string(iiBudgetID).
<M-85 run WriteDirect (input 'BudgetLinkCommit':U (icTableName),
input vcWhere (icPrepare),
input '':U (icFieldList),
input '':U (icFieldListDataTypes),
input '':U (icAbsolute),
input '':U (icIncremental),
input {&TARGETPROCEDURE} (ihClass),
input vcUserLogin (icUserLogin),
output viFcReturnSuper (oiReturnStatus)) in persistence>
/* if record not found, no problem, then the record must not be deleted */
if oiReturnStatus = -4
then assign oiReturnStatus = 0.
assign vhFcComponent = vhFcPL.
/* ----------------------------------------------------------------------------------------------- */
/* Get the information for building the Q records, those will be handled afterward by the daemon */
/* ----------------------------------------------------------------------------------------------- */
/* rebuild actuals by use of Posting information */
<M-91 run ApiRebuildBudgetPartTwo
(input iiBudgetID (iiBudgetId),
output viFcReturnSuper (oiReturnStatus)) in BBudgetRebuild>
if viFcReturnSuper < 0 or (viFcReturnSuper > 0 and oiReturnStatus = 0)
then assign oiReturnStatus = viFcReturnSuper.
if oiReturnStatus < 0 then return.
find first tNewQBudgetLA
no-lock no-error.
if available tNewQBudgetLA
then do:
if viBQBudgetActualBudgetRbID = 0 or viBQBudgetActualBudgetRbID = ?
then do:
<I-26 {bFcStartAndOpenInstance
&ADD-TO-TRANSACTION = "true"
&CLASS = "BQBudgetActual"}>
end.
else do:
<I-27 {bFcOpenInstance
&CLASS = "BQBudgetActual"}>
end.
<M-29 run ApiCreateQBudgetLinkActual (input tNewQBudgetLA (tNewQBudgetLinkActual),
output viReturnStatus (oiReturnStatus)) in BQBudgetActual>
<I-30 {bFcCloseInstance
&CLASS = "BQBudgetActual"}>
assign viFcReturnSuper = viReturnStatus.
if viFcReturnSuper < 0
then do:
assign oiReturnStatus = viFcReturnSuper.
return.
end.
end. /* available tNewQBudgetLA */
/* rebuild commitments by use of PO information */
find first tNewQBudgetLC
no-lock no-error.
if available tNewQBudgetLC
then do:
if viBQBudgetComBudgetRbID = 0 or viBQBudgetComBudgetRbID = ?
then do:
<I-33 {bFcStartAndOpenInstance
&ADD-TO-TRANSACTION = "yes"
&CLASS = "BQBudgetCommitment"}>
end.
else do:
<I-34 {bFcOpenInstance
&CLASS = "BQBudgetCommitment"}>
end.
<M-35 run ApiCreateQBudgetLinkCommit (input tNewQBudgetLC (tNewQBudgetLinkCommit),
output viReturnStatus (oiReturnStatus)) in BQBudgetCommitment>
<I-36 {bFcCloseInstance
&CLASS = "BQBudgetCommitment"}>
assign viFcReturnSuper = viReturnStatus.
if viFcReturnSuper < 0
then do:
assign oiReturnStatus = viFcReturnSuper.
return.
end.
end. /* available tNewQBudgetLC */
/* ==================================================================================== */
/* Save the whole thing into DB (including delete, and qActual ,qCommitments); */
/* Open instance, remove this component from the instance and Commit */
/* The remove is needed because otherwise the commit tries to execute some methods that */
/* our parent-class (BusinessComponent) doesn't have. This also implicates that with */
/* the call towards CommitTransaction we do not pass a value for 'ihParentInstance' */
/* ==================================================================================== */
<I-40 {bFcOpenInstance
&CLASS = "Transaction"}>
<M-38 run RemoveInstance (input viFcCurrentInstanceId (iiInstanceNr),
output viFcReturnSuper (oiReturnStatus)) in Transaction>
if viFcReturnSuper < 0
then do:
assign oiReturnStatus = viFcReturnSuper.
<I-39 {bFcCloseInstance
&CLASS = "Transaction"}>
return.
end. /* if viFcReturnSuper < 0 */
<M-42 run CommitTransaction
(input true (ilStop),
input ? (ihParentInstance),
output vcDummy (ocInstances),
output viFcReturnSuper (oiReturnStatus)) in Transaction>
if viFcReturnSuper < 0
then do:
assign oiReturnStatus = viFcReturnSuper.
<I-44 {bFcCloseInstance
&CLASS = "Transaction"}>
return.
end. /* if viFcReturnSuper < 0 */
<I-45 {bFcCloseAndStopInstance
&CLASS = "Transaction"}>
... end replace by direct db */
Sample code: how to call this method through RPCRequestService (QXtend Inbound)
define temp-table ttContext no-undo
field propertyQualifier as character
field propertyName as character
field propertyValue as character
index entityContext is primary unique
propertyQualifier
propertyName
index propertyQualifier
propertyQualifier.
define dataset dsContext for ttContext.
define variable vhContextDS as handle no-undo.
define variable vhExceptionDS as handle no-undo.
define variable vhServer as handle no-undo.
define variable vhInputDS as handle no-undo.
define variable vhInputOutputDS as handle no-undo.
define variable vhOutputDS as handle no-undo.
define variable vhParameter as handle no-undo.
/* Create context */
create ttContext.
assign ttContext.propertyName = "programName"
ttContext.propertyValue = "BBudgetRebuild".
create ttContext.
assign ttContext.propertyName = "methodName"
ttContext.propertyValue = "ApiRebuildBudget".
create ttContext.
assign ttContext.propertyName = "applicationId"
ttContext.propertyValue = "fin".
create ttContext.
assign ttContext.propertyName = "entity"
ttContext.propertyValue = "1000".
create ttContext.
assign ttContext.propertyName = "userName"
ttContext.propertyValue = "mfg".
create ttContext.
assign ttContext.propertyName = "password"
ttContext.propertyValue = "".
/* Create input dataset */
create dataset vhInputDS.
vhInputDS:read-xmlschema("file", "xml/bbudgetrebuild.apirebuildbudget.i.xsd", ?).
vhParameter = vhInputDS:get-buffer-handle("tParameterI").
vhParameter:buffer-create().
assign vhParameter::icBudgetCode = <parameter value>
vhParameter::iiBudgetID = <parameter value>.
/* Connect the AppServer */
create server vhServer.
vhServer:connect("-URL <appserver-url>").
if not vhServer:connected()
then do:
message "Could not connect AppServer" view-as alert-box error title "Error".
return.
end.
/* Run */
assign vhContextDS = dataset dsContext:handle.
run program/rpcrequestservice.p on vhServer
(input-output dataset-handle vhContextDS by-reference,
output dataset-handle vhExceptionDS,
input dataset-handle vhInputDS by-reference,
input-output dataset-handle vhInputOutputDS by-reference,
output dataset-handle vhOutputDS).
/* Handle output however you want, in this example, we dump it to xml */
if valid-handle(vhExceptionDS)
then vhExceptionDS:write-xml("file", "Exceptions.xml", true).
if valid-handle(vhOutputDS)
then vhOutputDS:write-xml("file", "Output.xml", true).
/* Cleanup */
vhServer:disconnect().
assign vhServer = ?.
if valid-handle(vhInputDS)
then delete object vhInputDS.
if valid-handle(vhOutputDS)
then delete object vhOutputDS.
if valid-handle(vhExceptionDS)
then delete object vhExceptionDS.