| iiSourceBudgetID | input | integer | SourceBudgetID |
| icSourceBudgetCode | input | character | SourceBudgetCode (this parameter is not used in case parameter SourceBudgetID is filled) |
| icNewBudgetCode | input | character | NewBudgetCode |
| icNewBudgetDesccription | input | character | NewBudgetDesccription |
| icNewBudgetProjectCode | input | character | NewBudgetProjectCode; project-code for the new budget (this is only allowed if the source-budget has a projects defined). |
| icNewBudgetCostCentreCode | input | character | NewBudgetCostCentreCode; project-code for the new budget (this is only allowed if the source-budget has a projects defined). |
| ilCopyWBSFigures | input | logical | ResetAllWBSFigures; Set to true if you want the new budget to have the same figures as the source-budget Set to false if you want the new budget to have no figurs on the wbs-nodes. |
| tNewBudgetPeriod | input | temp-table | Temp-table containing the new budget-periods for the new budget. Note that when they are passed, the number of periods should be the same as the number of periods of the source-budget. If no budgetperiods are passed then the new budget will have the same periods as the source-budget. |
| tSafStructureLinkSkipCreation | input | temp-table | SafStructureLinkSkipCreation; temp-table that is used as input by method ApiCopyBudget. For every BudgetWBS on a project- or a cost-centre budget, the link between the safstructure and the project/cost-centre is created (when it does not yet exist in he db) in a submethod of AddtionalUpdates. When method ApiCopyBudget is executed from BProject, then BProject has already done the same. This leads to double created link records. Solution: BProject passes a list of the SafStructureLinks it has already created itself and we check this list before we create the links. |
| iiBSafStructureLinkID | input | integer | Instance-ID of BSafStructureLink; pass a value for this paramater in case you al ready have started BSafStructureLink. Normaly this will be the case if you passed records for temp-table SafStructureLinkSkipCreation. |
| oiNewBudgetID | output | integer | NewBudgetID |
| oiReturnStatus | output | integer | Return status of the method. |
QadFinancials
/* Set default return status */
assign oiReturnStatus = -98.
/* Validate input parameters */
if iiSourceBudgetID = ? then assign iiSourceBudgetID = 0.
if icSourceBudgetCode = ? then assign icSourceBudgetCode = "":U.
if icNewBudgetCode = ? then assign icNewBudgetCode = "":U.
if icNewBudgetDesccription = ? then assign icNewBudgetDesccription = "":U.
if icNewBudgetProjectCode = ? then assign icNewBudgetProjectCode = "":U.
if icNewBudgetCostCentreCode = ? then assign icNewBudgetCostCentreCode = "":U.
if iiSourceBudgetID = 0 and icSourceBudgetCode = "":U
then do :
assign oiReturnStatus = -1
vcMessage = trim(#T-19'If you want to copy a budget, you must enter the code or the ID of the source budget.':255(716)T-19#).
<M-9 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-586':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end. /* if iiSourceBudgetID = 0 and */
/* Convert icSourceBudgetCode into iiSourceBudgetID when needed */
if iiSourceBudgetID = 0
then do :
<Q-4 run BudgetPrim (all) (Read) (NoCache)
(input ?, (BudgetID)
input icSourceBudgetCode, (BudgetCode)
output dataset tqBudgetPrim) in BBudget >
find tqBudgetPrim where
tqBudgetPrim.tcBudgetCode = icSourceBudgetCode
no-lock no-error.
if not available tqBudgetPrim
then do :
assign oiReturnStatus = -1
vcMessage = trim(substitute(#T-20'Cannot find the budget based on its code (&1).':255(717)T-20#,icSourceBudgetCode)).
<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-584':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end. /* if not available tqBudgetPrim */
assign iiSourceBudgetID = tqBudgetPrim.tiBudget_ID.
end. /* if iiSourceBudgetID = 0 */
/* Load the instance and perform validations between the instance and the input parameters */
<M-6 run DataLoad
(input '':U (icRowids),
input string(iisourceBudgetID) (icPkeys),
input ? (icObjectIds),
input '' (icFreeform),
input false (ilKeepPrevious),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
if viFcReturnSuper <> 0 /* -4 = instance not found */
then do :
assign oiReturnStatus = viFcReturnSuper
vcMessage = trim(substitute(#T-21'Cannot load the budget based on its ID (&1). Budget code: &2.':255(718)T-21#,string(iiSourceBudgetID),icSourceBudgetCode)) + chr(10) +
trim(substitute(#T-22'Error number: &1.':255(719)T-22#,string(oiReturnStatus))).
<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-585':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end. /* if viFcReturnSuper <> 0 */
find first tBudget where
tBudget.Budget_ID = iiSourceBudgetID
no-lock no-error.
if not available tBudget
then do :
assign oiReturnStatus = -1
vcMessage = trim(substitute(#T-23'Cannot find the loaded budget based on its ID (&1). Budget code: &2.':255(720)T-23#,string(iiSourceBudgetID),icSourceBudgetCode)).
<M-10 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-578':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end. /* if not available tBudget */
if tBudget.Project_ID <> 0 and icNewBudgetProjectCode = "":U
then do :
assign oiReturnStatus = -1
vcMessage = trim(#T-24'You must enter a project code for the new budget, because the source budget was also linked to a project.':255(721)T-24#) + chr(10) +
trim(substitute(#T-25'Project of the source budget: &1.':255(722)T-25#,tBudget.tcProjectCode)).
<M-13 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-580':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end. /* if tBudget.Project_ID <> 0 and icNewBudgetProjectCode = "":U */
if tBudget.Project_ID = 0 and icNewBudgetProjectCode <> "":U
then do :
assign oiReturnStatus = -1
vcMessage = trim(#T-26'The project code of the new budget is obsolete, because the source budget was not linked to a project.':255(723)T-26#) + chr(10) +
trim(substitute(#T-27'Project of the new budget: &1.':255(724)T-27#,icNewBudgetProjectCode)).
<M-14 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-581':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end. /* if tBudget.Project_ID = 0 and icNewBudgetProjectCode <> "":U */
/* test if source and new budget has the same definition of safs */
if tBudget.Project_ID <> 0 and icNewBudgetProjectCode <> "":U
then do:
<Q-40 run ProjectById (all) (Read) (NoCache)
(input viCompanyId, (CompanyId)
input tBudget.Project_ID, (ProjectId)
output dataset tqProjectById) in BProject >
find first tqProjectById no-error.
assign vlSourceProjectIsWithSaf = if available tqProjectById
then tqProjectById.tlProjectIsWithSaf
else false.
<Q-41 run ProjectByCode (all) (Read) (NoCache)
(input viCompanyId, (CompanyId)
input icNewBudgetProjectCode, (ProjectCode)
output dataset tqProjectByCode) in BProject >
find first tqProjectByCode no-error.
if available tqProjectByCode
then do:
if tqProjectByCode.tlProjectIsWithSaf <> vlSourceProjectIsWithSaf
then do:
assign oiReturnStatus = -1
vcMessage = trim(#T-62'There is a mismatch in the definition of the saf structure for both projects.':255(16354)T-62#) + chr(10) +
trim(substitute(#T-63'Project of the source budget: &1.':255(16355)T-63#,tBudget.tcProjectCode)).
<M-42 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-3612':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end.
assign viProjectId = tqProjectByCode.tiProject_ID.
end.
assign vlError = false.
<Q-46 run GetSafStructureLinkForProject (all) (Read) (NoCache)
(input tBudget.Project_ID, (Project_ID)
input ?, (ProjectCode)
input viCompanyId, (CompanyId)
input ?, (SafStructureCode)
output dataset tqGetSafStructureLinkForProject) in BSafStructureLink >
for each tqGetSafStructureLinkForProject:
<Q-47 assign vlFcQueryRecordsAvailable = GetSafStructureLinkForProject (NoCache) (input viProjectId, (Project_ID)
input ?, (ProjectCode)
input viCompanyId, (CompanyId)
input tqGetSafStructureLinkForProject.tcSafStructureCode, (SafStructureCode)) in BSafStructureLink >
if not vlFcQueryRecordsAvailable
then do:
assign vlError = true.
leave.
end.
end.
if vlError
then do:
assign oiReturnStatus = -1
vcMessage = trim(#T-49'The SAF structures linked to the source project are not linked to the target project.':150(16239)T-49#) + chr(10) +
trim(substitute(#T-50'Source budget: &1.':150(16240)T-50#,tBudget.BudgetCode)) + chr(10) +
trim(substitute(#T-51'Project of the source budget: &1.':150(16241)T-51#,tBudget.tcProjectCode)) + chr(10) +
trim(substitute(#T-52'Target budget: &1.':150(16242)T-52#,icNewBudgetCode)) + chr(10) +
trim(substitute(#T-53'Project of the target budget: &1.':150(16243)T-53#,icNewBudgetProjectCode)).
<M-48 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-3905':U (icFcMsgNumber),
input '':U (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
return.
end.
end.
if tBudget.CostCentre_ID <> 0 and icNewBudgetCostCentreCode = "":U
then do :
assign oiReturnStatus = -1
vcMessage = trim(#T-28'You must enter a cost center code for the new budget, because the source budget was also linked to a cost center.':255(725)T-28#) + chr(10) +
trim(substitute(#T-29'Cost center of the source budget: &1.':255(726)T-29#,tBudget.tcCostCentreCode)).
<M-15 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-582':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end. /* if tBudget.CostCentre_ID <> 0 and icNewBudgetCostCentreCode = "":U */
if tBudget.CostCentre_ID = 0 and icNewBudgetCostCentreCode <> "":U
then do :
assign oiReturnStatus = -1
vcMessage = trim(#T-30'The cost center code of the new budget is obsolete, because the source budget was not linked to a cost center.':255(727)T-30#) + chr(10) +
trim(substitute(#T-31'Cost center of the new budget: &1.':255(728)T-31#,icNewBudgetCostCentreCode)).
<M-16 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-583':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end. /* if tBudget.CostCentre_ID = 0 and icNewBudgetCostCentreCode <> "":U */
/* test if source and new budget has the same definition of safs */
if tBudget.CostCentre_ID <> 0 and icNewBudgetCostCentreCode <> "":U
then do:
<Q-43 run CostCentreByCodeID (all) (Read) (NoCache)
(input viCompanyId, (CompanyId)
input ?, (CostCentreCode)
input tBudget.CostCentre_ID, (CostCentreID)
output dataset tqCostCentreByCodeID) in BCostCentre >
find first tqCostCentreByCodeID no-error.
assign vlSourceCCIsWithSaf = if available tqCostCentreByCodeID
then tqCostCentreByCodeID.tlCostCentreIsWithSaf
else false.
<Q-44 run CostCentreByCodeID (all) (Read) (NoCache)
(input viCompanyId, (CompanyId)
input icNewBudgetCostCentreCode, (CostCentreCode)
input ?, (CostCentreID)
output dataset tqCostCentreByCodeID) in BCostCentre >
find first tqCostCentreByCodeID no-error.
if available tqCostCentreByCodeID
then do:
if tqCostCentreByCodeID.tlCostCentreIsWithSaf <> vlSourceCCIsWithSaf
then do:
assign oiReturnStatus = -1
vcMessage = trim(#T-64'There is a mismatch in the definition of the SAF structure for both cost centers.':255(16356)T-64#) + chr(10) +
trim(substitute(#T-65'Cost center of the source budget: &1.':255(16357)T-65#,tBudget.tcCostCentreCode)).
<M-45 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-3613':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end.
assign viCostCentreId = tqCostCentreByCodeID.tiCostCentre_ID.
end.
assign vlError = false.
<Q-54 run GetSafStructureLinkForCC (all) (Read) (NoCache)
(input tBudget.CostCentre_ID, (CostCenter_ID)
input viCompanyId, (CompanyId)
input ?, (CostCentreCode)
input ?, (SafStructureCode)
output dataset tqGetSafStructureLinkForCC) in BSafStructureLink >
for each tqGetSafStructureLinkForCC:
<Q-55 assign vlFcQueryRecordsAvailable = GetSafStructureLinkForCC (NoCache) (input viCostCentreId, (CostCenter_ID)
input viCompanyId, (CompanyId)
input ?, (CostCentreCode)
input tqGetSafStructureLinkForCC.tcSafStructureCode, (SafStructureCode)) in BSafStructureLink >
if not vlFcQueryRecordsAvailable
then do:
assign vlError = true.
leave.
end.
end.
if vlError
then do:
assign oiReturnStatus = -1
vcMessage = trim(#T-57'The SAF structures linked to the source cost center are not linked to the target cost center.':150(16249)T-57#) + chr(10) +
trim(substitute(#T-58'Source budget: &1.':150(16240)T-58#,tBudget.BudgetCode)) + chr(10) +
trim(substitute(#T-59'Cost center of the source budget: &1.':150(16250)T-59#,tBudget.tcCostCentreCode)) + chr(10) +
trim(substitute(#T-60'Target budget: &1.':150(16242)T-60#,icNewBudgetCode)) + chr(10) +
trim(substitute(#T-61'Cost center of the target budget: &1.':150(16251)T-61#,icNewBudgetCostCentreCode)).
<M-56 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-3914':U (icFcMsgNumber),
input '':U (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
return.
end.
end.
/* As the SetNewStatus changes the ID-fields and as we have a link between BudgetVersionGLFig */
/* and BudgetWBS (BudgetVersionGLFig.BudgetWBS_ID), the link will no longer be valid after */
/* the SetNewStatus is performed. Solution: Use field BudgetVersionFigure.tcBudgetWBSCode to */
/* store BudgetWBS.tc_rowid before the execution and re-assign these fields after the call */
/* Involved fields: BudgetVersionFigure.tcBudgetWBSCode and BudgetVersionFigure.BudgetWBS_ID */
/* For tBudgetWBS.ParentBudgetWBS_ID, table tNewBudgetWBS is used */
empty temp-table tNewBudgetWBS.
for each tBudgetWBS :
for each tBudgetVersionGLFig where
tBudgetVersionGLFig.BudgetWBS_ID = tBudgetWBS.BudgetWBS_ID :
assign tBudgetVersionGLFig.tcBudgetWBSCode = tBudgetWBS.tc_Rowid.
end. /* for each tBudgetVersionGLFig where */
for each tBudgetVersionFig where
tBudgetVersionFig.BudgetWBS_ID = tBudgetWBS.BudgetWBS_ID :
assign tBudgetVersionFig.tcBudgetWBSCode = tBudgetWBS.tc_Rowid.
end. /* for each tBudgetVersionFig where */
create tNewBudgetWBS.
buffer-copy tBudgetWBS except BudgetWBSSeq to tNewBudgetWBS.
end. /* for each tBudgetWBS */
/* Mark the instance as a new one and copy the input information to the instance */
/* Calling SetNewStatus will result in new values for all ID-fields and the value of all */
/* tc_status-fields will be set to "N":U. After calling this method we can set oiNewBudgetID */
<M-11 run SetNewStatus (output viFcReturnSuper (oiReturnStatus)) in BBudget>
if viFcReturnSuper <> 0
then do :
assign oiReturnStatus = viFcReturnSuper
vcMessage = trim(substitute(#T-32'Cannot mark the loaded instance (&1/&2) as a new instance.':255(729)T-32#,string(iiSourceBudgetID),icSourceBudgetCode)) + chr(10) +
trim(substitute(#T-33'Error number: &1.':255(719)T-33#,string(oiReturnStatus))).
<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-579':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end. /* if viFcReturnSuper <> 0 */
find first tbudget no-error.
assign oiNewBudgetID = tBudget.Budget_ID
tBudget.BudgetCode = if icNewBudgetCode <> "":U
then icNewBudgetCode
else substring(trim(#T-34'Copy of':10(730)t-34#) + " ":U + tBudget.BudgetCode,1,20,"CHARACTER":U)
tBudget.BudgetDescription = if icNewBudgetDesccription <> "":U
then icNewBudgetDesccription
else tBudget.BudgetDescription
tBudget.BudgetStatus = {&BUDGETSTATUS-VALID}.
/*SetNewStatus is not re-setting tTransString.tiParentObject_ID. So Reset it here*/
for each tTransString:
assign tTransString.tiParentObject_ID = oiNewBudgetID.
end.
for each tBudgetVersion where
tBudgetVersion.Budget_ID = tBudget.Budget_ID:
assign tBudgetVersion.BudgetVersionCreateDate = today
tBudgetVersion.BudgetVersionCreateTime = time
tBudgetVersion.tc_Status = (if tBudgetVersion.tc_Status = "":U
then "C":U
else tBudgetVersion.tc_Status).
end. /* for each tBudgetVersion where ... */
if icNewBudgetProjectCode <> "":U
then assign tBudget.Project_ID = viProjectId
tBudget.tcProjectCode = icNewBudgetProjectCode.
if icNewBudgetCostCentreCode <> "":U
then assign tBudget.CostCentre_ID = viCostCentreId
tBudget.tcCostCentreCode = icNewBudgetCostCentreCode.
/* As the SetNewStatus changed the ID-fields and as we have a link between BudgetVersionGLFig */
/* and BudgetWBS (BudgetVersionGLFig.BudgetWBS_ID), the link will no longer be valid after */
/* the SetNewStatus is performed. Solution: Use field BudgetVersionFigure.tcBudgetWBSCode to */
/* store BudgetWBS.tc_rowid before the execution and re-assign these fields after the call */
/* Involved fields: BudgetVersionFigure.tcBudgetWBSCode and BudgetVersionFigure.BudgetWBS_ID */
/* Here we reset the Involced fields. */
/* For tBudgetWBS.ParentBudgetWBS_ID, table tNewBudgetWBS is used */
/* As the relation BudgetFDS-BudgetWBS is no primary relation, tBudgetWBS.BudgetFDS_ID is not */
/* automaticaly assigned with the correct value of the corresponding BudgetFDS.BudgetFDS_ID */
/* Therefor we assign it manualy based on field BudgetFDSSeq (in table BudgetFDS and BudgetWBS) */
for each tBudgetWBS :
for each tBudgetVersionGLFig where
tBudgetVersionGLFig.tcBudgetWBSCode = tBudgetWBS.tc_Rowid :
assign tBudgetVersionGLFig.BudgetWBS_ID = tBudgetWBS.BudgetWBS_ID.
end. /* for each tBudgetVersionGLFig where */
for each tBudgetVersionFig where
tBudgetVersionFig.tcBudgetWBSCode = tBudgetWBS.tc_Rowid :
assign tBudgetVersionFig.BudgetWBS_ID = tBudgetWBS.BudgetWBS_ID.
end. /* for each tBudgetVersionFig where */
if tBudgetWBS.ParentBudgetWBS_ID <> ? and tBudgetWBS.ParentBudgetWBS_ID <> 0
then do :
find tNewBudgetWBS where tNewBudgetWBS.BudgetWBS_ID = tBudgetWBS.ParentBudgetWBS_ID no-lock no-error.
if not available tNewBudgetWBS then next.
find btBudgetWBS where btBudgetWBS.tc_Rowid = tNewBudgetWBS.tc_Rowid no-lock no-error.
if not available btBudgetWBS then next.
assign tBudgetWBS.ParentBudgetWBS_ID = btBudgetWBS.BudgetWBS_ID.
end. /* if tBudgetWBS.ParentBudgetWBS_ID <> ? and tBudgetWBS.ParentBudgetWBS_ID <> 0 */
find tBudgetFDS where
tBudgetFDS.tc_ParentRowid = tBudgetWBS.tc_ParentRowid and
tBudgetFDS.BudgetFDSSeq = tBudgetWBS.BudgetFDSSeq
no-lock no-error.
if available tBudgetFDS
then assign tBudgetWBS.BudgetFDS_ID = tBudgetFDS.BudgetFDS_ID.
end. /* for each tBudgetWBS */
/* Call a submethod that will clear the figures */
if ilCopyWBSFigures = false
then do :
<M-18 run ApiCopyBudgetClearFigures (output viFcReturnSuper (oiReturnStatus)) in BBudget>
end. /* if ilCopyWBSFigures = false */
/* In case new budget-periods are passed as input for this method; */
/* Replace the information of the existing periods with the new information */
if can-find (first tNewBudgetPeriod)
then do :
for each tBudgetPeriod where
tBudgetPeriod.tc_ParentRowid = tBudget.tc_Rowid
no-lock :
assign viSourcePeriods = viSourcePeriods + 1.
end. /* for each tBudgetPeriod no-lock : */
for each tNewBudgetPeriod no-lock :
assign viTargetPeriods = viTargetPeriods + 1.
end. /* for each tNewBudgetPeriod no-lock : */
if viSourcePeriods <> viTargetPeriods
then do :
assign oiReturnStatus = -1
vcMessage = trim(substitute(#T-35'The number of periods of the source budget (&1/&2) differs from the number of periods for the new budget.':255(731)T-35#,icSourceBudgetCode,string(iiSourceBudgetID))) + chr(10) +
trim(substitute(#T-36'Number of periods of the source budget: &1.':255(732)T-36#,string(viSourcePeriods))) + chr(10) +
trim(substitute(#T-37'Number of periods for the new budget: &1.':255(733)T-37#,string(viTargetPeriods))).
<M-17 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-587':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BBudget>
Return.
end. /* if viSourcePeriods <> viTargetPeriods */
assign viPeriodSequence = 0.
for each tNewBudgetPeriod
by tNewBudgetPeriod.BudgetPeriodFromDate :
assign viPeriodSequence = viPeriodSequence + 1.
find tBudgetPeriod where
tBudgetPeriod.tc_ParentRowid = tBudget.tc_Rowid and
tBudgetPeriod.BudgetPeriodSeq = viPeriodSequence
no-error.
if not available tBudgetPeriod
then next.
assign tBudgetPeriod.BudgetPeriodCode = tNewBudgetPeriod.BudgetPeriodCode
tBudgetPeriod.BudgetPeriodFromDate = tNewBudgetPeriod.BudgetPeriodFromDate
tBudgetPeriod.BudgetPeriodTillDate = tNewBudgetPeriod.BudgetPeriodTillDate
tBudgetPeriod.BudgetPeriodSeq = viPeriodSequence.
end. /* for each tNewBudgetPeriod */
end. /* if can-find (first tNewBudgetPeriod) */
/* Due to the strange construct in method BBudget:ValidateComponent() that assigns tBudgetCompany.tc_Status, we have to ensure here */
/* we assign tBudgetCompany.tcCompanyUpdateStatus to avoid that the tBudgetCompany records get marked as deleted in that method */
for each tBudgetCompany where
tBudgetCompany.tc_ParentRowid = tBudget.tc_Rowid and
tBudgetCompany.tc_Status = "N":U and
tBudgetCompany.tcCompanyUpdateStatus = "":U :
if tBudget.BudgetIsFRWLinked = true
then assign tBudgetCompany.tcCompanyUpdateStatus = "M":U.
else assign tBudgetCompany.tcCompanyUpdateStatus = tBudgetCompany.tc_Status.
end. /* for each tBudgetCompany where */
/* Set Return-status = OK (needed to catch warnings in the called methods further on) */
assign oiReturnStatus = 0.
/* Call Validate (this calls StopExternalInstances) */
<M-1 run ValidateBC (output viFcReturnSuper (oiReturnStatus)) in BBudget>
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if oiReturnStatus < 0 then return.
/* In case an instance-ID was passed for BSafStructureLink then assign viBSafStructureLinkBudgetID */
/* to iiBSafStructureLinkID here. This needs to be done after calling ValidateComponent because all */
/* external instances are stopped there and we want to use the instance in AdditionalUpdates */
assign viBSafStructureLinkBudgetID = iiBSafStructureLinkID.
/* Call AdditionalUpdates and DataSave */
<M-2 run AdditionalUpdates (output viFcReturnSuper (oiReturnStatus)) in BBudget>
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if oiReturnStatus < 0 then return.
<M-3 run DataSave (output viFcReturnSuper (oiReturnStatus)) in BBudget>
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if oiReturnStatus < 0 then return.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 = "BBudget".
create ttContext.
assign ttContext.propertyName = "methodName"
ttContext.propertyValue = "ApiCopyBudget".
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/bbudget.apicopybudget.i.xsd", ?).
vhParameter = vhInputDS:get-buffer-handle("tParameterI").
vhParameter:buffer-create().
assign vhParameter::iiSourceBudgetID = <parameter value>
vhParameter::icSourceBudgetCode = <parameter value>
vhParameter::icNewBudgetCode = <parameter value>
vhParameter::icNewBudgetDesccription = <parameter value>
vhParameter::icNewBudgetProjectCode = <parameter value>
vhParameter::icNewBudgetCostCentreCode = <parameter value>
vhParameter::ilCopyWBSFigures = <parameter value>
vhParameter::iiBSafStructureLinkID = <parameter value>.
vhParameter = vhInputDS:get-buffer-handle("tNewBudgetPeriod").
vhParameter:buffer-create().
assign vhParameter::<field-name-1> = <field-value-1>
vhParameter::<field-name-2> = <field-value-2>
...
vhParameter = vhInputDS:get-buffer-handle("tSafStructureLinkSkipCreation").
vhParameter:buffer-create().
assign vhParameter::<field-name-1> = <field-value-1>
vhParameter::<field-name-2> = <field-value-2>
...
/* 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.