Description
This procedure merges profiles of merged elements
Parameters
| iiMasterObjectId | input | integer | |
| iiRedundantObjectId | input | integer | |
| oiReturnStatus | output | integer | Return status of the method. |
Internal usage
QadFinancials
program code (program6/bsharedsetmerge.p)
/* =================================================================================================== */
/* Method : MergeProfiles */
/* Desc : This method makes optimalization of profiles linked to merged master and redundant */
/* element */
/* --------------------------------------------------------------------------------------------------- */
/* Params: (I) MasterObjectId ID of master object */
/* (I) RedundantObjectId ID of redundant object */
/* =================================================================================================== */
define buffer bMasterProfile for tqProfileForSharedSetMerge.
define buffer bRedundantProfile for tqProfileForSharedSetMerge.
if iiMasterObjectId = 0 or
iiMasterObjectId = ? or
iiRedundantObjectId = 0 or
iiRedundantObjectId = ?
then return.
assign oiReturnStatus = -98.
/* =============================================================================================== */
/* Load profiles pointing to master and redundant element */
/* =============================================================================================== */
<Q-1 run ProfileForSharedSetMerge (all) (Read) (NoCache)
(input iiMasterObjectId, (MasterObjectId)
input iiRedundantObjectId, (RedundantObjectId)
output dataset tqProfileForSharedSetMerge) in BProfile >
/* =============================================================================================== */
/* Profiles optimalization */
/* ----------------------------------------------------------------------------------------------- */
/* There is missing definition of profile for master element */
/* =============================================================================================== */
/* if there is not any profile pointing to master element */
find first bMasterProfile where
bMasterProfile.tiProfileLinkObject = iiMasterObjectId no-error.
if not available bMasterProfile
then do:
for each bRedundantProfile where
bRedundantProfile.tiProfileLinkObject_ID = iiRedundantObjectId:
/* if profile of redundant element is not pointing to any */
/* element in master shared set, repoint this profile to master shared set */
if not can-find(first tqProfileForSharedSetMerge where
tqProfileForSharedSetMerge.tiProfile_ID = bRedundantProfile.tiProfile_ID and
tqProfileForSharedSetMerge.tiSharedSet_ID = viMasterSharedSetId)
then do:
/* first be sure, there is not profile link pointing to master shared set */
/* there can be but with invalid link */
assign vcStatement = 'for each ProfileLink where ':U +
'ProfileLink.Profile_ID = &1 and ':U +
'ProfileLink.SharedSet_ID = &2':U
vcStatement = substitute(vcStatement, bRedundantProfile.tiProfile_ID, viMasterSharedSetId ).
<M-11 run StartPersistence
(output vhFcComponent (ohPersistence),
output viFcReturnSuper (oiReturnStatus)) in BSharedSetMerge>
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0 then return.
<M-12 run WriteDirect
(input 'ProfileLink':U (icTableName),
input vcStatement (icPrepare),
input '':U (icFieldList),
input '':U (icFieldListDataTypes),
input '':U (icAbsolute),
input '':U (icIncremental),
input {&TARGETPROCEDURE} (ihClass),
input vcUserLogin (icUserLogin),
output viFcReturnSuper (oiReturnStatus)) in Progress>
if viFcReturnSuper = -4 then assign viFcReturnSuper = 0.
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0 then return.
/* repoint profile link from redundant to master shared set */
assign vcStatement = 'for each ProfileLink where ':U +
'ProfileLink.ProfileLink_ID = &1':U
vcStatement = substitute(vcStatement, bRedundantProfile.tiProfileLink_ID ).
<M-7 run StartPersistence
(output vhFcComponent (ohPersistence),
output viFcReturnSuper (oiReturnStatus)) in BSharedSetMerge>
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0 then return.
<M-2 run WriteDirect
(input 'ProfileLink':U (icTableName),
input vcStatement (icPrepare),
input 'SharedSet_ID,ProfileLinkObject_ID':U (icFieldList),
input 'i,i':U (icFieldListDataTypes),
input substitute('&1':U + chr(2) + '&2':U, viMasterSharedSetId, iiMasterObjectId) (icAbsolute),
input '':U (icIncremental),
input {&TARGETPROCEDURE} (ihClass),
input vcUserLogin (icUserLogin),
output viFcReturnSuper (oiReturnStatus)) in Progress>
if viFcReturnSuper = -4 then assign viFcReturnSuper = 0.
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0 then return.
end.
/* if profile of redundant element is pointing to redundant element but also to other element */
/* in master shared set then corresponding one -> master definition prevails (this situation */
/* is reported as warning during validation */
else do:
/* delete definition of redundant profile link, master profile link remais there */
assign vcStatement = 'for each ProfileLink where ':U +
'ProfileLink.ProfileLink_ID = &1':U
vcStatement = substitute(vcStatement, bRedundantProfile.tiProfileLink_ID ).
<M-8 run StartPersistence
(output vhFcComponent (ohPersistence),
output viFcReturnSuper (oiReturnStatus)) in BSharedSetMerge>
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0 then return.
<M-3 run WriteDirect
(input 'ProfileLink':U (icTableName),
input vcStatement (icPrepare),
input '':U (icFieldList),
input '':U (icFieldListDataTypes),
input '':U (icAbsolute),
input '':U (icIncremental),
input {&TARGETPROCEDURE} (ihClass),
input vcUserLogin (icUserLogin),
output viFcReturnSuper (oiReturnStatus)) in Progress>
if viFcReturnSuper = -4 then assign viFcReturnSuper = 0.
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0 then return.
end.
end. /* for each bRedundantProfile where */
end. /* if not available bMasterProfile */
/* ============================================================================================== */
/* There is profile pointing to master element (definition of master element prevails definition */
/* of redundant element */
/* ============================================================================================== */
else do:
/* Go through all profile/profile links pointing to redundant element */
for each bRedundantProfile where
bRedundantProfile.tiProfileLinkObject_ID = iiRedundantObjectId:
if bMasterProfile.tiProfile_ID <> bRedundantProfile.tiProfile_ID
then do:
/* replace all references to redundant profile by master profile */
run value("ref_int/rss_profile.p":U)
(input {&TARGETPROCEDURE},
input vcUserLogin,
input viSessionId,
input bRedundantProfile.tiProfile_ID,
input bMasterProfile.tiProfile_ID,
output viFcReturnSuper).
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0 then return.
end.
/* delete profile link to redundant element */
assign vlDeleteProfile = not can-find(first tqProfileForSharedSetMerge where
tqProfileForSharedSetMerge.tiProfile_ID = bRedundantProfile.tiProfile_ID and
tqProfileForSharedSetMerge.tiProfileLink_ID <> bRedundantProfile.tiProfileLink_ID).
/* if profile doest no contain any other valid profile link, delete all profile links, else only redundant */
if vlDeleteProfile
then assign vcStatement = 'for each ProfileLink where ':U +
' ProfileLink.Profile_ID = &1':U
vcStatement = substitute(vcStatement, bRedundantProfile.tiProfile_ID ).
else assign vcStatement = 'for each ProfileLink where ':U +
'ProfileLink.ProfileLink_ID = &1':U
vcStatement = substitute(vcStatement, bRedundantProfile.tiProfileLink_ID ).
<M-9 run StartPersistence
(output vhFcComponent (ohPersistence),
output viFcReturnSuper (oiReturnStatus)) in BSharedSetMerge>
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0 then return.
<M-4 run WriteDirect
(input 'ProfileLink':U (icTableName),
input vcStatement (icPrepare),
input '':U (icFieldList),
input '':U (icFieldListDataTypes),
input '':U (icAbsolute),
input '':U (icIncremental),
input {&TARGETPROCEDURE} (ihClass),
input vcUserLogin (icUserLogin),
output viFcReturnSuper (oiReturnStatus)) in Progress>
if viFcReturnSuper = -4 then assign viFcReturnSuper = 0.
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0 then return.
/* if profile doest no contain any other profile link, delete profile also */
if vlDeleteProfile
then do:
assign vcStatement = 'for each Profile where ':U +
'Profile.Profile_ID = &1':U
vcStatement = substitute(vcStatement, bRedundantProfile.tiProfile_ID ).
<M-10 run StartPersistence
(output vhFcComponent (ohPersistence),
output viFcReturnSuper (oiReturnStatus)) in BSharedSetMerge>
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0 then return.
<M-5 run WriteDirect
(input 'Profile':U (icTableName),
input vcStatement (icPrepare),
input '':U (icFieldList),
input '':U (icFieldListDataTypes),
input '':U (icAbsolute),
input '':U (icIncremental),
input {&TARGETPROCEDURE} (ihClass),
input vcUserLogin (icUserLogin),
output viFcReturnSuper (oiReturnStatus)) in Progress>
if viFcReturnSuper = -4 then assign viFcReturnSuper = 0.
if viFcReturnSuper <> 0 then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0 then return.
end. /* if not can-find(first tqProfileForSharedSetMerge where */
end. /* for each bRedundantProfile where */
end. /* else do if not available bMasterProfile */
/* =================================================================================================== */
/* Return */
/* =================================================================================================== */
if oiReturnStatus = -98 then assign oiReturnStatus = 0.