Description
Get the exchange rate.
Parameters
| iiCompanyId | input | integer | |
| iiCompanyLCId | input | integer | |
| iiFromCurrencyId | input | integer | |
| icFromCurrencyCode | input | character | |
| iiToCurrencyId | input | integer | |
| icToCurrencyCode | input | character | |
| iiExchangeRateTypeId | input | integer | |
| icExchangeRateTypeCode | input | character | |
| itValidityDate | input | date | |
| iiSessionID | input | integer | |
| ihParentInstance | input | handle | |
| odExchangeRate | output | decimal | |
| odExchangeRateScale | output | decimal | |
| oiReturnStatus | output | integer | |
Internal usage
unused
program code (program1/texchangerate.p)
/* =================================================================================================== */
/* Method : ApiGetExchangeRate */
/* Desc : Calculate exchange rate between two currencies */
/* --------------------------------------------------------------------------------------------------- */
/* Params: (I) CompanyId Company ID where exchange rate is needed */
/* (I) CompanyLCId Local currency ID */
/* (I) FromCurrencyId From currency ID */
/* (I) FromCurrency From currency code */
/* (I) ToCurrencyId To currency ID */
/* (I) ToCurrency To currency code */
/* (I) ExchangeRateTypeId Exchange rate type ID */
/* (I) ExchangeRateType Exchange rate type code */
/* (I) ValidityDate Validity date */
/* (I) SessionID Technical variable holding session ID */
/* (I) ParentInstance Technical variable with handle to parent instance */
/* (O) ExchangRate Exchange rate */
/* (O) ExchangeRateScale Exchange rate scale */
/* =================================================================================================== */
assign oiReturnStatus = -98
viLocalReturn = 0
viSessionID = iiSessionID.
/* =================================================================================================== */
/* Default output values */
/* =================================================================================================== */
assign odExchangeRate = ?
odExchangeRateScale = ?.
/* =================================================================================================== */
/* Normalize input parameters */
/* =================================================================================================== */
if iiCompanyId = 0 then assign iiCompanyId = ?.
if iiCompanyLCId = 0 then assign iiCompanyLCId = ?.
if iiFromCurrencyId = 0 then assign iiFromCurrencyId = ?.
if icFromCurrencyCode = "":U then assign icFromCurrencyCode = ?.
if iiToCurrencyId = 0 then assign iiToCurrencyId = ?.
if icToCurrencyCode = "":U then assign icToCurrencyCode = ?.
if iiExchangeRateTypeId = 0 then assign iiExchangeRateTypeId = ?.
if icExchangeRateTypeCode = "":U then assign icExchangeRateTypeCode = ?.
/* =================================================================================================== */
/* Default some parameters */
/* =================================================================================================== */
if iiExchangeRateTypeId = ? and
icExchangeRateTypeCode = ?
then assign icExchangeRateTypeCode = {&EXCHANGERATETYPE-ACCOUNTING}.
if itValidityDate = ?
then assign itValidityDate = today.
/* =================================================================================================== */
/* Validate input parameters */
/* =================================================================================================== */
if iiCompanyId = ? or
iiCompanyLCId = ? or
iiFromCurrencyId = ? and icFromCurrencyCode = ? or
iiToCurrencyId = ? and icToCurrencyCode = ? or
iiExchangeRateTypeId = ? and icExchangeRateTypeCode = ?
then do:
assign vcMessage = #T-1'Cannot retrieve exchange because not all mandatory input parameters are populated. See details in Context section.':255(71067)T-1#
vcContext = 'iiCompanyId=&1|iiCompanyLCId=&2|iiFromCurrencyId=&3|icFromCurrencyCode=&4|iiToCurrencyId=&5|icToCurrencyCode=&6|iiExchangeRateTypeId=&7|icExchangeRateTypeCode=&8':U
vcContext = replace(vcContext, '|':U, chr(2))
vcContext = substitute(vcContext, iiCompanyId, iiCompanyLCId, iiFromCurrencyId, icFromCurrencyCode, iiToCurrencyId, icToCurrencyCode, iiExchangeRateTypeId, icExchangeRateTypeCode).
RUN SetMessage in ihParentInstance (
input vcMessage,
input '':U,
input '':U,
input '':U,
input 'E':U,
input 3,
input '':U,
input 'TExchangeRate-0001':U,
input '':U,
input '':U,
input vcContext,
output viDummy ).
assign oiReturnStatus = -1.
return.
end.
/* =================================================================================================== */
/* if from and to currency are the same, then set rate to 1 */
/* =================================================================================================== */
if iiFromCurrencyId <> 0 and
iiFromCurrencyId <> ? and
iiFromCurrencyId = iiToCurrencyId or
icFromCurrencyCode <> '':U and
icFromCurrencyCode <> ? and
icFromCurrencyCode = icToCurrencyCode
then do:
assign odExchangeRate = 1
odExchangeRateScale = 1
oiReturnStatus = 0.
return.
end.
/* =================================================================================================== */
/* From currency */
/* =================================================================================================== */
if iiFromCurrencyId = ? or
icFromCurrencyCode = ?
then do:
<Q-3 run CurrencyPrim (all) (Read) (NoCache)
(input icFromCurrencyCode, (CurrencyCode)
input iiFromCurrencyId, (Currency_ID)
output dataset tqCurrencyPrim) in BCurrency >
find first tqCurrencyPrim no-error.
if not available tqCurrencyPrim
then do:
assign vcMessage = #T-8'Cannot retrieve exchange rate because of invalid From currency code: &1.':150(71068)T-8#
vcMessage = substitute(vcMessage, icFromCurrencyCode)
vcContext = 'iiCompanyId=&1|iiCompanyLCId=&2|iiFromCurrencyId=&3|icFromCurrencyCode=&4|iiToCurrencyId=&5|icToCurrencyCode=&6|iiExchangeRateTypeId=&7|icExchangeRateTypeCode=&8':U
vcContext = replace(vcContext, '|':U, chr(2))
vcContext = substitute(vcContext, iiCompanyId, iiCompanyLCId, iiFromCurrencyId, icFromCurrencyCode, iiToCurrencyId, icToCurrencyCode, iiExchangeRateTypeId, icExchangeRateTypeCode).
RUN SetMessage in ihParentInstance (
input vcMessage,
input '':U,
input '':U,
input '':U,
input 'E':U,
input 3,
input '':U,
input 'TExchangeRate-0002':U,
input '':U,
input '':U,
input vcContext,
output viDummy).
assign oiReturnStatus = -1.
return.
end.
assign iiFromCurrencyId = tqCurrencyPrim.tiCurrency_ID
icFromCurrencyCode = tqCurrencyPrim.tcCurrencyCode.
end.
/* =================================================================================================== */
/* To currency */
/* =================================================================================================== */
if iiToCurrencyId = ? or
icToCurrencyCode = ?
then do:
<Q-6 run CurrencyPrim (all) (Read) (NoCache)
(input icToCurrencyCode, (CurrencyCode)
input iiToCurrencyId, (Currency_ID)
output dataset tqCurrencyPrim) in BCurrency >
find first tqCurrencyPrim no-error.
if not available tqCurrencyPrim
then do:
assign vcMessage = #T-9'Cannot retrieve exchange rate because of invalid To currency code: &1.':150(71069)T-9#
vcMessage = substitute(vcMessage, icToCurrencyCode)
vcContext = 'iiCompanyId=&1|iiCompanyLCId=&2|iiFromCurrencyId=&3|icFromCurrencyCode=&4|iiToCurrencyId=&5|icToCurrencyCode=&6|iiExchangeRateTypeId=&7|icExchangeRateTypeCode=&8':U
vcContext = replace(vcContext, '|':U, chr(2))
vcContext = substitute(vcContext, iiCompanyId, iiCompanyLCId, iiFromCurrencyId, icFromCurrencyCode, iiToCurrencyId, icToCurrencyCode, iiExchangeRateTypeId, icExchangeRateTypeCode).
RUN SetMessage in ihParentInstance (
input vcMessage,
input '':U,
input '':U,
input '':U,
input 'E':U,
input 3,
input '':U,
input 'TExchangeRate-0003':U,
input '':U,
input '':U,
input vcContext,
output viDummy).
assign oiReturnStatus = -1.
return.
end.
assign iiToCurrencyId = tqCurrencyPrim.tiCurrency_ID
icToCurrencyCode = tqCurrencyPrim.tcCurrencyCode.
end.
/* =================================================================================================== */
/* Exchange Rate Type */
/* =================================================================================================== */
if iiExchangeRateTypeId = ? or
icExchangeRateTypeCode = ?
then do:
<Q-16 run ExchangeRateTypePrim (first) (Read) (NoCache)
(input iiExchangeRateTypeId, (ExchangeRateTypeId)
input icExchangeRateTypeCode, (ExchangeRateTypeCode)
output dataset tqExchangeRateTypePrim) in BExchangeRateType >
find first tqExchangeRateTypePrim no-error.
if not available tqExchangeRateTypePrim
then do:
assign vcMessage = #T-17'Invalid Exchange Rate type &1.':255(71062)T-17#
vcMessage = substitute(vcMessage, icExchangeRateTypeCode)
vcContext = 'iiCompanyId=&1|iiCompanyLCId=&2|iiFromCurrencyId=&3|icFromCurrencyCode=&4|iiToCurrencyId=&5|icToCurrencyCode=&6|iiExchangeRateTypeId=&7|icExchangeRateTypeCode=&8':U
vcContext = replace(vcContext, '|':U, chr(2))
vcContext = substitute(vcContext, iiCompanyId, iiCompanyLCId, iiFromCurrencyId, icFromCurrencyCode, iiToCurrencyId, icToCurrencyCode, iiExchangeRateTypeId, icExchangeRateTypeCode).
RUN SetMessage in ihParentInstance (
input vcMessage,
input '':U,
input '':U,
input '':U,
input 'S':U,
input 3,
input '':U,
input 'TExchangeRate-0004':U,
input '':U,
input '':U,
input vcContext,
output viDummy).
assign oiReturnStatus = -1.
return.
end.
assign iiExchangeRateTypeId = tqExchangeRateTypePrim.tiExchangeRateType_ID
icExchangeRateTypeCode = tqExchangeRateTypePrim.tcExchangeRateTypeCode.
end.
/* ===================================================== */
/* Get following info out of Session/Cacher */
/* - Is the current domain enabled for StatutoryCurrency */
/* - What is the Code and ID of the StatutoryCurrency */
/* ===================================================== */
if viSessionID <> 0 and
viSessionID <> ?
then do :
run StartCacherInPool (output vhCacher) no-error.
assign vhFcComponent = vhCacher
vcNameList = "CompanyCC,C,CompanyCCId,I,DomainIsStatutory,L":U
vcValueList = "":U.
<M-37 run GetValuesFromSession
(input viSessionID (iiSessionId),
input vcNameList (icNameList),
output vcValueList (ocValueList),
output viFcReturnSuper (oiReturnStatus)) in Cacher>
assign vcCompanyCC = entry(1,vcValueList,chr(2))
viCompanyCCID = integer(entry(2,vcValueList,chr(2)))
vlDomainIsStatutory = (entry(3,vcValueList,chr(2)) = "TRUE":U)
no-error.
end. /* if viSessionID <> 0 and */
/* ======================== Cascading rules =================================== */
/* We here compose an ordered list of rate-types that we should search a rate for */
/* If no rate is found for the first type then we search for a rate of the next type */
/* ================================================================================= */
/* Composing this list of types depends upon the type that is passed as input: */
/* - If the ToCurrency is the StatutoryCurrency and */
/* StatutoryCurrency is activiated on the domain and */
/* rate-type is Tax or Inventory */
/* Then - For Tax and for Inventory, Statutory is added to the list and if */
/* Statutory allows fallback then Accounting is added as well. */
/* - For Stat, Accounting is added if Stat allows fallback */
/* Else If the rate-type is not Accounting and the */
/* the rate-type allows fallback */
/* Then Accounting is added to the list */
/* ================================================================================= */
<Q-91 run ExchangeRateTypeByCode (all) (Read) (NoCache)
(input {&EXCHANGERATETYPE-STATUTORY}, (ExchangeRateTypeCode)
output dataset tqExchangeRateTypeByCode) in BExchangeRateType>
find first tqExchangeRateTypeByCode no-error.
if available tqExchangeRateTypeByCode
then assign vlStatutoryIsFallBack = tqExchangeRateTypeByCode.tlExchangeRateTypeIsFallBack.
<Q-74 run ExchangeRateTypeByCode (all) (Read) (NoCache)
(input tqExchangeRateTypePrim.tcExchangeRateTypeCode, (ExchangeRateTypeCode)
output dataset tqExchangeRateTypeByCode) in BExchangeRateType>
find first tqExchangeRateTypeByCode no-error.
if available tqExchangeRateTypeByCode
then do:
if (tqExchangeRateTypeByCode.tcExchangeRateTypeCode = {&EXCHANGERATETYPE-INVENTORY} or
tqExchangeRateTypeByCode.tcExchangeRateTypeCode = {&EXCHANGERATETYPE-VAT}) and
(icToCurrencyCode = vcCompanyCC or iiToCurrencyId = viCompanyCCId) and
vlDomainIsStatutory = true /* No statutory rates when statutory currency is not enabled. */
then assign iiExchangeRateTypeId = 0
vcRateTypes = if vlStatutoryIsFallBack
then tqExchangeRateTypeByCode.tcExchangeRateTypeCode + ",":U +
{&EXCHANGERATETYPE-STATUTORY} + ",":U +
{&EXCHANGERATETYPE-ACCOUNTING}
else tqExchangeRateTypeByCode.tcExchangeRateTypeCode + ",":U +
{&EXCHANGERATETYPE-STATUTORY}.
else if tqExchangeRateTypeByCode.tlExchangeRateTypeIsFallBack = true and
tqExchangeRateTypeByCode.tcExchangeRateTypeCode <> {&EXCHANGERATETYPE-ACCOUNTING}
then assign iiExchangeRateTypeId = 0
vcRateTypes = tqExchangeRateTypeByCode.tcExchangeRateTypeCode + ",":U +
{&EXCHANGERATETYPE-ACCOUNTING}.
else assign vcRateTypes = tqExchangeRateTypeByCode.tcExchangeRateTypeCode.
end. /* end of if available tqExchangeRateTypeByCode */
/* =================================================================================================== *
* Get exchange rate *
* =================================================================================================== */
EXCHANGE_RATE_BLOCK: do:
/* Again test for same currency - if passed From ID and To Code, previous check failed */
if iiFromCurrencyId = iiToCurrencyId
then do:
assign odExchangeRate = 1
odExchangeRateScale = 1.
leave EXCHANGE_RATE_BLOCK.
end.
do viIndex = 1 to num-entries(vcRateTypes):
assign icExchangeRateTypeCode = entry(viIndex, vcRateTypes).
/* =============================================================================================== *
* Lookup multiply rate *
* =============================================================================================== */
<Q-18 run ExchangeRateByCurrTypeValDate (first) (Read) (NoCache)
(input iiFromCurrencyId, (FromCurrencyId)
input iiToCurrencyId, (ToCurrencyId)
input iiExchangeRateTypeId, (ExchangeRateTypeId)
input itValidityDate, (ExchangeRateValidityDate)
input icFromCurrencyCode, (FromCurrencyCode)
input icToCurrencyCode, (ToCurrencyCode)
input icExchangeRateTypeCode, (ExchangeRateType)
input iiCompanyId, (CompanyId)
output dataset tqExchangeRateByCurrTypeValDate) in BExchangeRate >
find first tqExchangeRateByCurrTypeValDate no-error.
if available tqExchangeRateByCurrTypeValDate
then do:
assign odExchangeRate = tqExchangeRateByCurrTypeValDate.tdExchangeRate
odExchangeRateScale = tqExchangeRateByCurrTypeValDate.tdExchangeRateScale.
leave EXCHANGE_RATE_BLOCK.
end.
/* =============================================================================================== *
* Lookup divide rate *
* =============================================================================================== */
<Q-21 run ExchangeRateByCurrTypeValDate (first) (Read) (NoCache)
(input iiToCurrencyId, (FromCurrencyId)
input iiFromCurrencyId, (ToCurrencyId)
input iiExchangeRateTypeId, (ExchangeRateTypeId)
input itValidityDate, (ExchangeRateValidityDate)
input icToCurrencyCode, (FromCurrencyCode)
input icFromCurrencyCode, (ToCurrencyCode)
input icExchangeRateTypeCode, (ExchangeRateType)
input iiCompanyId, (CompanyId)
output dataset tqExchangeRateByCurrTypeValDate) in BExchangeRate >
find first tqExchangeRateByCurrTypeValDate no-error.
if available tqExchangeRateByCurrTypeValDate
then do:
assign odExchangeRate = (1 / tqExchangeRateByCurrTypeValDate.tdExchangeRate)
odExchangeRateScale = (1 / tqExchangeRateByCurrTypeValDate.tdExchangeRateScale).
leave EXCHANGE_RATE_BLOCK.
end.
/* ================================================================================================== */
/* We stop here as these types do not allow triangular rates to be used: Statutory, Inventory and VAT */
/* ================================================================================================== */
if icExchangeRateTypeCode = {&EXCHANGERATETYPE-STATUTORY} or
icExchangeRateTypeCode = {&EXCHANGERATETYPE-INVENTORY} or
icExchangeRateTypeCode = {&EXCHANGERATETYPE-VAT}
then next.
/* =============================================================================================== *
* in case the rate is not found, we try to find rates versus Local currency *
* CurrFrom --> LC and LC --> CurrTO *
* =============================================================================================== */
if iiFromCurrencyId <> iiCompanyLCId and
iiToCurrencyId <> iiCompanyLCId
then do:
assign vdFromExchangeRate = ?
vdFromExchangeRateScale = ?.
/* Lookup multiply rate for from currency to local currency */
<Q-22 run ExchangeRateByCurrTypeValDate (first) (Read) (NoCache)
(input iiFromCurrencyId, (FromCurrencyId)
input iiCompanyLCId, (ToCurrencyId)
input iiExchangeRateTypeId, (ExchangeRateTypeId)
input itValidityDate, (ExchangeRateValidityDate)
input ?, (FromCurrencyCode)
input ?, (ToCurrencyCode)
input icExchangeRateTypeCode, (ExchangeRateType)
input iiCompanyId, (CompanyId)
output dataset tqExchangeRateByCurrTypeValDate) in BExchangeRate >
find first tqExchangeRateByCurrTypeValDate no-error.
if available tqExchangeRateByCurrTypeValDate
then assign vdFromExchangeRate = tqExchangeRateByCurrTypeValDate.tdExchangeRate
vdFromExchangeRateScale = tqExchangeRateByCurrTypeValDate.tdExchangeRateScale.
else do:
/* Lookup multiply rate for from currency to local currency */
<Q-23 run ExchangeRateByCurrTypeValDate (first) (Read) (NoCache)
(input iiCompanyLCId, (FromCurrencyId)
input iiFromCurrencyId, (ToCurrencyId)
input iiExchangeRateTypeId, (ExchangeRateTypeId)
input itValidityDate, (ExchangeRateValidityDate)
input ?, (FromCurrencyCode)
input ?, (ToCurrencyCode)
input icExchangeRateTypeCode, (ExchangeRateType)
input iiCompanyId, (CompanyId)
output dataset tqExchangeRateByCurrTypeValDate) in BExchangeRate >
find first tqExchangeRateByCurrTypeValDate no-error.
if available tqExchangeRateByCurrTypeValDate
then assign vdFromExchangeRate = 1 / tqExchangeRateByCurrTypeValDate.tdExchangeRate
vdFromExchangeRateScale = 1 / tqExchangeRateByCurrTypeValDate.tdExchangeRateScale.
end.
/* In case we found a rate between CurrFrom & LC, we try to find a rate between LC & CurrTo */
if vdFromExchangeRate <> ? and
vdFromExchangeRate <> 0
then do :
assign vdToExchangeRate = ?
vdToExchangeRateScale = ?.
/* Lookup multiply rate for To currency to local currency */
<Q-24 run ExchangeRateByCurrTypeValDate (first) (Read) (NoCache)
(input iiToCurrencyId, (FromCurrencyId)
input iiCompanyLCId, (ToCurrencyId)
input iiExchangeRateTypeId, (ExchangeRateTypeId)
input itValidityDate, (ExchangeRateValidityDate)
input ?, (FromCurrencyCode)
input ?, (ToCurrencyCode)
input icExchangeRateTypeCode, (ExchangeRateType)
input iiCompanyId, (CompanyId)
output dataset tqExchangeRateByCurrTypeValDate) in BExchangeRate >
find first tqExchangeRateByCurrTypeValDate no-error.
if available tqExchangeRateByCurrTypeValDate
then assign vdToExchangeRate = tqExchangeRateByCurrTypeValDate.tdExchangeRate
vdToExchangeRateScale = tqExchangeRateByCurrTypeValDate.tdExchangeRateScale.
else do:
/* Lookup divide rate for local currency to To currency */
<Q-25 run ExchangeRateByCurrTypeValDate (first) (Read) (NoCache)
(input iiCompanyLCId, (FromCurrencyId)
input iiToCurrencyId, (ToCurrencyId)
input iiExchangeRateTypeId, (ExchangeRateTypeId)
input itValidityDate, (ExchangeRateValidityDate)
input ?, (FromCurrencyCode)
input ?, (ToCurrencyCode)
input icExchangeRateTypeCode, (ExchangeRateType)
input iiCompanyId, (CompanyId)
output dataset tqExchangeRateByCurrTypeValDate) in BExchangeRate >
find first tqExchangeRateByCurrTypeValDate no-error.
if available tqExchangeRateByCurrTypeValDate
then assign vdToExchangeRate = 1 / tqExchangeRateByCurrTypeValDate.tdExchangeRate
vdToExchangeRateScale = 1 / tqExchangeRateByCurrTypeValDate.tdExchangeRateScale.
end.
if vdToExchangeRate <> ? and
vdToExchangeRate <> 0
then do:
assign odExchangeRate = vdFromExchangeRate / vdToExchangeRate
odExchangeRateScale = vdFromExchangeRateScale / vdToExchangeRateScale.
leave EXCHANGE_RATE_BLOCK.
end.
end. /* if vdFromExchangeRate <> 0 */
end. /* if iiFromCurrencyId <> iiCompanyLCId and */
end. /* do viIndex = 1 to num-entries(vcRateTypes): */
end. /* EXCHANGE_RATE_BLOCK: */
/* ====================================== */
/* Check, whether exchange rate was found */
/* ====================================== */
if odExchangeRate = ? or
odExchangeRate = 0 or
odExchangeRateScale = ? or
odExchangeRateScale = 0
then do:
assign vcMessage = #T-28'There is missing definition of exchange rate between &1 and &2 currencies of type &3 valid from &4.':255(71064)T-28#
vcMessage = substitute(vcMessage, icFromCurrencyCode, icToCurrencyCode, icExchangeRateTypeCode, itValidityDate)
vcContext = 'iiCompanyId=&1|iiCompanyLCId=&2|iiFromCurrencyId=&3|icFromCurrencyCode=&4|iiToCurrencyId=&5|icToCurrencyCode=&6|iiExchangeRateTypeId=&7|icExchangeRateTypeCode=&8':U
vcContext = replace(vcContext, '|':U, chr(2))
vcContext = substitute(vcContext, iiCompanyId, iiCompanyLCId, iiFromCurrencyId, icFromCurrencyCode, iiToCurrencyId, icToCurrencyCode, iiExchangeRateTypeId, icExchangeRateTypeCode).
RUN SetMessage in ihParentInstance (
input vcMessage,
input '':U,
input '':U,
input '':U,
input 'E':U,
input 3,
input '':U,
input 'TExchangeRate-0005':U,
input '':U,
input '':U,
input vcContext,
output viDummy).
assign oiReturnStatus = -1.
return.
end.
/* ======= */
/* Return */
/* ======= */
assign oiReturnStatus = viLocalReturn.