Parameters
| iiCCollection_ID | input | integer | |
| ilGroupingAllowed | input | logical | |
| icOutputFileName | input | character | |
| itPayDate | input | date | |
| iiGL_ID | input | integer | |
| oiReturnStatus | output | integer | Return status of the method. |
Internal usage
QadFinancials
program code (program7/bpaymentselection.p)
empty temp-table tExpFields.
/* Get the Country Code of Belgium */
<Q-6 run CountryByCountry (all) (Read) (NoCache)
(input ?, (CountryId)
input 'NL':U, (CountryCode)
output dataset tqCountryByCountry) in BCountry >
find first tqCountryByCountry no-error.
if not available tqCountryByCountry
then do:
assign vcMessage = #T-7'The system cannot find the country Netherlands.':80(14039)T-7#.
<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-3162':U (icFcMsgNumber),
input '':u (icFcExplanation),
input '':u (icFcIdentification),
input '':u (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BPaymentSelection>
assign oiReturnStatus = -1.
return.
end.
/* Get the Business Relation Code for the Company */
<Q-9 run CompanyPropertyForAllData (all) (Read) (NoCache)
(input viCompanyId, (CompanyId)
output dataset tqCompanyPropertyForAllData) in BCompanyProperty >
find first tqCompanyPropertyForAllData no-error.
if not available tqCompanyPropertyForAllData
then do:
assign vcMessage = #T-10'The system cannot find the entity property information.':80(999890829)T-10#.
<M-11 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-3163':U (icFcMsgNumber),
input '':u (icFcExplanation),
input '':u (icFcIdentification),
input '':u (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BPaymentSelection>
assign oiReturnStatus = -1.
return.
end.
/* Get the VAT number for the Business Relation Code of the company */
<Q-12 run VatNumberPrim (all) (Read) (NoCache)
(input ?, (VatNumberId)
input ?, (BusinessRelationId)
input ?, (IdentityCountryID)
input ?, (VatNumberIdentity)
input tqCompanyPropertyForAllData.tcCompanyPropertyCode, (BusinessRelationCode)
input {&BANKNUMBERVALIDATION-NLB}, (IdentityCountryCode)
output dataset tqVatNumberPrim) in BBusinessRelation >
find first tqVatNumberPrim no-error.
/* Select proper lines and fill in temporary table */
for each tCCollectionPaySel where
tCCollectionPaySel.CCollection_ID = iiCCollection_ID,
each tCDocumentInfoForCollection where
tCDocumentInfoForCollection.tcPayFormatTypeCode = tCCollectionPaySel.tcPayFormatType,
each tCDocumentInvoiceXrefPaySel where
tCDocumentInvoiceXrefPaySel.CDocument_ID = tCDocumentInfoForCollection.tiCDocument_ID,
each tPaySelLine where
tPaySelLine.PaySelLine_ID = tCDocumentInvoiceXRefPaySel.PaySelLine_ID and
tPaySelLine.PayFormatTypeCode = {&PAYMENTFORMAT-NL1},
first tPaySel where
tPaySel.tc_Rowid = tPaySelLine.tc_ParentRowid
break by tPaySelLine.tcCreditorCode
by tPaySelLine.tcInvoiceCurrencyCode
by tPaySelLine.BankNumber_ID:
/* Get the Creditor in order to decide if the grouping is possible */
if first-of(tPaySelLine.tcCreditorCode)
then do:
<M-13 run ExportNLInlandPreselect
(output vcCredBusRelationCode (ocCredBusRelationCode),
output vlCredIsIndividualPayment (olCredIsIndividualPayment),
output vcCredAddressLanguage (ocCredAddressLanguage),
output viFcReturnSuper (oiReturnStatus)) in BPaymentSelection>
if viFcReturnSuper < 0 or (viFcReturnSuper > 0 and oiReturnStatus = 0)
then assign oiReturnStatus = viFcReturnSuper.
if oiReturnStatus < 0 then return.
end.
if (ilGroupingAllowed and
first-of(tPaySelLine.BankNumber_ID) and
not vlCredIsIndividualPayment) or /* Possible grouping based on creditor */
tPaySelLine.tcTSM <> '':U or /* TSM filled in */
not ilGroupingAllowed or /* Grouping not allowed with the Payment Selection Transfer */
vlCredIsIndividualPayment /* Grouping allowed with the Payment Selection Transfer, but the creditor doesn't allow the grouping */
then do:
empty temp-table tqBankNumberPrim.
if tPaySelLine.BankNumber_ID <> ? and
tPaySelLine.BankNumber_ID <> 0
then do:
/* Get the Creditor's Bank Account on which the Payment has been Realised */
<Q-14 run BankNumberPrim (all) (Read) (NoCache)
(input tPaySelLine.BankNumber_ID, (BankNumberId)
input ?, (ParentObjectId)
input '':U, (BankNumber)
input '':U, (BankNumberExtension)
input ?, (BankPayFormatID)
output dataset tqBankNumberPrim) in BBankNumber >
end.
find first tqBankNumberPrim no-error.
if not available tqBankNumberPrim
then do:
assign vcMessage = #T-15'The supplier bank account ($1) is not defined in the system.':80(2985)T-15#.
<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-3170':U (icFcMsgNumber),
input '':u (icFcExplanation),
input '':u (icFcIdentification),
input '':u (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BPaymentSelection>
assign oiReturnStatus = min(-1, viFCReturnSuper).
return.
end.
create tExpFields.
assign tExpFields.tcCredCreditorCode = tPaySelLine.tcCreditorCode
tExpFields.tcCredBankNumber = tqBankNumberPrim.tcBankNumber
tExpFields.tcCredBankNumberValidation = tqBankNumberPrim.tcBankNumberValidation
tExpFields.tcCredBankNumberExtension = tqBankNumberPrim.tcBankNumberExtension
tExpFields.tcCredBusRelationCode = vcCredBusRelationCode
tExpFields.tcCredAddressLanguage = vcCredAddressLanguage
tExpFields.tcTSM = tPaySelLine.tcTSM
vcCredBankNumber = tqBankNumberPrim.tcBankNumber
vcCredBankNumberValidation = tqBankNumberPrim.tcBankNumberValidation
vcCredBankNumberExtension = tqBankNumberPrim.tcBankNumberExtension.
end.
else find tExpFields where
tExpFields.tcCredCreditorCode = tPaySelLine.tcCreditorCode and
tExpFields.tcCredBankNumber = vcCredBankNumber and
tExpFields.tcCredBankNumberValidation = vcCredBankNumberValidation and
tExpFields.tcCredBankNumberExtension = vcCredBankNumberExtension and
tExpFields.tcTSM = tPaySelLine.tcTSM
no-error.
if tExpFields.tcPaySelRef <> fill(chr(2),12)
then do:
if tExpFields.tcPaySelRef = '':U
then assign tExpFields.tcPaySelRef = tPaySel.PaySelCode.
else if tPaySel.PaySelCode <> tExpFields.tcPaySelRef
then assign tExpFields.tcPaySelRef = fill(chr(2),12).
end.
create tExportReferences.
assign tExportReferences.tiPaySelLineId = tPaySelLine.PaySelLine_ID
tExportReferences.tlPaySelLineIsRefInFile = true.
/* Get the Invoice for the PaySelectionLine in order to retrieve the Ext.reference */
if tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-INVOICE} OR
tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-INVOICECORR} OR
tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-CREDITNOTE} OR
tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-CREDITNOTECORR} OR
tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-PREPAYMENTINV} OR
tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-ADJUSTMENT}
then do:
<Q-17 run CInvoiceByPaymentInfo (all) (Read) (NoCache)
(input viCompanyId, (CompanyId)
input tExpFields.tcCredBusRelationCode, (BusinessRelationCode)
input tPaySelLine.PaySelLineParentObject_ID, (CInvoice_ID)
input '':U, (PaymentGroupCode)
input '':U, (CurrencyCode)
input '':U, (DivisionCode)
input ?, (BusinessRelationIsInterco)
input '':U, (CInvoiceType)
input ?, (IsInvoiceApproved)
input ?, (IsLockPayment)
input ?, (CInvoiceIsSelected)
input ?, (CInvoiceIsOpen)
input ?, (BusinessRelationCountryCode)
input {&ADDRESSTYPECODESYSTEM-HEADOFFICE}, (AddressTypeCode)
output dataset tqCInvoiceByPaymentInfo) in BCInvoice >
find first tqCInvoiceByPaymentInfo no-error.
if not available tqCInvoiceByPaymentInfo
then do:
vcMessage = #T-18'The specified supplier invoice is not defined in the system or is invalid.':80(999890830)T-18# .
<M-19 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-3171':U (icFcMsgNumber),
input '':u (icFcExplanation),
input '':u (icFcIdentification),
input '':u (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BPaymentSelection>
end.
assign viLength = length(tPaySelLine.tcTSM,'CHARACTER':U).
if tPaySelLine.tcTSM <> '':U
then do viPosCounter = 1 to viLength:
if lookup(substring(tPaySelLine.tcTSM,viPosCounter,1,'CHARACTER':U),"1,2,3,4,5,6,7,8,9,0":U) > 0
then do:
if length(tExpFields.tcReference1 + substring(tPaySelLine.tcTSM,viPosCounter,1,'CHARACTER':U),'CHARACTER':U) <= 12 /* Maximum 12 numeric positions of TSM */
then assign tExpFields.tcReference1 = tExpFields.tcReference1 + substring(tPaySelLine.tcTSM,viPosCounter,1,'CHARACTER':U).
else leave.
end.
end.
else do:
assign viLength = length(tExpFields.tcReference1 + tqCInvoiceByPaymentInfo.tcCInvoiceReference,'CHARACTER':U).
if viLength + 1 <= 53
then assign tExpFields.tcReference1 = tExpFields.tcReference1 + ' ':U + tqCInvoiceByPaymentInfo.tcCInvoiceReference.
else if viLength + 1 <= 53
then assign tExpFields.tcReference2 = tExpFields.tcReference2 + ' ':U + tqCInvoiceByPaymentInfo.tcCInvoiceReference.
else assign tExpFields.tcReference1 = '':U
tExpFields.tcReference2 = '':U
tExportReferences.tlPaySelLineIsRefInFile = false.
end.
end.
else do:
<Q-20 run GetDInvoiceForPaymentSelection (all) (Read) (NoCache)
(input viCompanyId, (CompanyId)
input ?, (IsPaymentAllowed)
input tExpFields.tcCredBusRelationCode, (BusinessRelationCode)
input tPaySelLine.PaySelLineParentObject_ID, (DInvoice_ID)
input ?, (CurrencyCode)
input ?, (DivisionCode)
input ?, (BusinessRelationIsInterco)
input ?, (DInvoiceType)
input ?, (DInvoiceIsOpen)
input ?, (DInvoiceIsSelected)
input ?, (BusinessRelationCountryCode)
input {&ADDRESSTYPECODESYSTEM-HEADOFFICE}, (AddressTypeCode)
output dataset tqGetDInvoiceForPaymentSelection) in BDInvoice >
find first tqGetDInvoiceForPaymentSelection no-error.
if not available tqGetDInvoiceForPaymentSelection
then do:
<M-21 run SetMessage
(input #T-22'The specified customer credit note is not defined in the system or is invalid.':80(2987)T-22# (icMessage),
input '':U (icArguments),
input '':U (icFieldName),
input '':U (icFieldValue),
input 'D':U (icType),
input 3 (iiSeverity),
input '':U (icRowid),
input 'QADFIN-3172':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BPaymentSelection>
assign oiReturnStatus = min(-1, viFCReturnSuper).
return.
end.
if viLength + 1 <= 53
then assign tExpFields.tcReference1 = tExpFields.tcReference1 + ' ':U + tqGetDInvoiceForPaymentSelection.tcDInvoiceTSMNumber.
else if vilength + 1 <= 53
then assign tExpFields.tcReference2 = tExpFields.tcReference2 + ' ':U + tqGetDInvoiceForPaymentSelection.tcDInvoiceTSMNumber.
else assign tExpFields.tcReference1 = '':U
tExpFields.tcReference2 = '':U
tExportReferences.tlPaySelLineIsRefInFile = false.
end.
/* Payment Amount */
if tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-INVOICE} or
tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-CREDITNOTECORR}
then assign tExpFields.tdAmountLC01 = if tPaySelLine.tcInvoiceCurrencyCode = vcCompanyLC
then tExpFields.tdAmountLC01 + abs(tPaySelLine.PaySelLineAmountTC) /* LC */
else tExpFields.tdAmountLC01 + abs(<M-36 RoundAmount
(input tPaySelLine.PaySelLineAmountTC * tqCInvoiceByPaymentInfo.tdCInvoiceExchangeRate * tqCInvoiceByPaymentInfo.tdCinvoiceRateScale (idUnroundedAmount),
input viCompanyLCId (iiCurrencyID),
input vcCompanyLC (icCurrencyCode)) in business>). /* TC <> LC */
else if tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-DEBTORCREDITNOTE}
then assign tExpFields.tdAmountLC01 = if tPaySelLine.tcInvoiceCurrencyCode = vcCompanyLC
then tExpFields.tdAmountLC01 + abs(tPaySelLine.PaySelLineAmountTC) /* LC */
else tExpFields.tdAmountLC01 + abs(<M-37 RoundAmount
(input tPaySelLine.PaySelLineAmountTC * tqGetDInvoiceForPaymentSelection.tdDInvoiceExchangeRate * tqGetDInvoiceForPaymentSelection.tdDInvoiceRateScale (idUnroundedAmount),
input viCompanyLCId (iiCurrencyID),
input vcCompanyLC (icCurrencyCode)) in business>). /* TC <> LC */
else if tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-CREDITNOTE} OR
tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-INVOICECORR} OR
tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-PREPAYMENTINV}
then assign tExpFields.tdAmountLC01 = if tPaySelLine.tcInvoiceCurrencyCode = vcCompanyLC
then tExpFields.tdAmountLC01 - abs(tPaySelLine.PaySelLineAmountTC) /* LC */
else tExpFields.tdAmountLC01 - abs(<M-38 RoundAmount
(input tPaySelLine.PaySelLineAmountTC * tqCInvoiceByPaymentInfo.tdCInvoiceExchangeRate * tqCInvoiceByPaymentInfo.tdCinvoiceRateScale (idUnroundedAmount),
input viCompanyLCId (iiCurrencyID),
input vcCompanyLC (icCurrencyCode)) in business>). /* TC <> LC */
else if tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-DEBTORCNCORR}
then assign tExpFields.tdAmountLC01 = if tPaySelLine.tcInvoiceCurrencyCode = vcCompanyLC
then tExpFields.tdAmountLC01 - abs(tPaySelLine.PaySelLineAmountTC) /* LC */
else tExpFields.tdAmountLC01 - abs(<M-39 RoundAmount
(input tPaySelLine.PaySelLineAmountTC * tqGetDInvoiceForPaymentSelection.tdDInvoiceExchangeRate * tqGetDInvoiceForPaymentSelection.tdDInvoiceRateScale (idUnroundedAmount),
input viCompanyLCId (iiCurrencyID),
input vcCompanyLC (icCurrencyCode)) in business>). /* TC <> LC */
else if tPaySelLine.PaySelLineObjectType = {&PAYMENTSELECTIONTYPE-ADJUSTMENT}
then assign tExpFields.tdAmountLC01 = if tPaySelLine.tcInvoiceCurrencyCode = vcCompanyLC
then tExpFields.tdAmountLC01 + tPaySelLine.PaySelLineAmountTC /* LC */
else tExpFields.tdAmountLC01 + <M-40 RoundAmount
(input tPaySelLine.PaySelLineAmountTC * tqGetDInvoiceForPaymentSelection.tdDInvoiceExchangeRate * tqGetDInvoiceForPaymentSelection.tdDInvoiceRateScale (idUnroundedAmount),
input viCompanyLCId (iiCurrencyID),
input vcCompanyLC (icCurrencyCode)) in business>. /* TC <> LC */
if itPayDate = ?
and tPaySel.PaySelDate <> ?
then assign itPayDate = tPaySel.PaySelDate.
end.
if itPayDate = ?
then assign itPayDate = today - 1. /* wrong - fictive - date -> validation error */
/* XE BTS 1823 */
/* Create payment file */
do on error undo, retry:
if retry
then do:
<M-23 run SetMessage
(input #T-24'The system cannot create the file ($1).':80(2988)T-24# (icMessage),
input icOutputFileName (icArguments),
input '':U (icFieldName),
input icOutputFileName (icFieldValue),
input 'D':U (icType),
input 3 (iiSeverity),
input '':U (icRowid),
input 'QADFIN-3173':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BPaymentSelection>
assign oiReturnStatus = -1.
return.
end.
/* Try to create the file */
output stream sExpStream to value(icOutputFileName).
end.
/* get bank number */
<Q-25 run BankNumberByParentID (all) (Read) (NoCache)
(input iiGL_ID, (ParentObjectId)
input {&BANKNUMBERPARENTTYPE-GL}, (BankNumberParentType)
input ?, (BankNumberIsDefault)
input viCompanyId, (CompanyId)
output dataset tqBankNumberByParentID) in BBankNumber >
find first tqBankNumberByParentID no-error.
if not available tqBankNumberByParentID
then do:
<M-26 run SetMessage
(input #T-27'The bank account number specified is not defined in the system.':80(999890831)T-27# (icMessage),
input '':U (icArguments),
input 'GL_ID':U (icFieldName),
input string(iiGL_ID) (icFieldValue),
input 'D':U (icType),
input 3 (iiSeverity),
input '':U (icRowid),
input 'QADFIN-3174':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BPaymentSelection>
output stream sExpStream close.
assign oiReturnStatus = -1.
return.
end.
else assign vcBankNumber = tqBankNumberByParentID.tcBankNumber.
/* Export header */
/*TODO*/
<Q-28 run CompanyPropertyByBusinessRel (all) (Read) (NoCache)
(input viCompanyId, (CompanyId)
input ?, (AddressType)
output dataset tqCompanyPropertyByBusinessRel) in BCompanyProperty >
find first tqCompanyPropertyByBusinessRel no-error.
if not available tqCompanyPropertyByBusinessRel
then do:
output stream sExpStream close.
assign oiReturnStatus = min(-1, viFcReturnSuper).
return.
end.
else do:
<Q-34 run AddressByAddressType (all) (Read) (NoCache)
(input tqCompanyPropertyByBusinessRel.tiBusinessRelation_ID, (BusinessRelationId)
input {&ADDRESSTYPECODESYSTEM-HEADOFFICE}, (AddressTypeCode)
output dataset tqAddressByAddressType) in BBusinessRelation >
find first tqAddressByAddressType where
tqAddressByAddressType.tiBusinessRelation_ID = tqCompanyPropertyByBusinessRel.tiBusinessRelation_ID and
tqAddressByAddressType.tcAddressTypeCode = {&ADDRESSTYPECODESYSTEM-HEADOFFICE}
no-error.
if available tqAddressByAddressType
then assign vcCompanyName = tqAddressByAddressType.tcBusinessRelationName1
vcCompanyCity = tqAddressByAddressType.tcAddressCity.
end.
/* Create the headerrecord 1 (Bestandverloopinfo) */
assign vcExpLine = "0001":U +
"A":U +
<M-30 FormatDateDDMMYY (input today (itDate)) in BDCollection> +
"CLIEOP03":U +
string(vcCompanyName, "x(5)":U) +
string(day(today), "99":U) +
"01":U +
"1":U +
string("", "x(21)":U).
/* Create the headerrecord 2 (Batchvoorloopinfo) */
assign vcExpLine = "0010":U +
"B":U +
"10":U +
string(trim(vcBankNumber), "x(10)":U) +
"0001":U +
"EUR":U +
string("":U, "x(26)":U).
put stream sExpStream unformatted vcExpLine skip.
/* Create the headerrecord 3 (Opdrachtgever info) */
assign vcExpLine = "0030B":U +
<M-35 FormatDateDDMMYY (input itPayDate (itDate)) in BDCollection> +
string(vcCompanyName, "x(35)":U) +
"P":U +
string("":U, "x(2)":U).
put stream sExpStream unformatted vcExpLine skip.
for each tExpFields by tExpFields.tcCredCreditorCode:
assign viLineCounter = viLineCounter + 1
vcExpLine = "0100A":U +
"1001":U +
string(tExpFields.tdAmountLC01 * 100, "999999999999":U) +
string(trim(tExpFields.tcCredBankNumber), "9999999999":U) +
string(trim(vcBankNumber), "9999999999":U) +
fill("":U, 42).
put stream sExpStream unformatted vcExpLine skip.
assign vcExpLine = "0110B":U +
string(tExpFields.tcCredCreditorCode, "x(35)":U) +
fill("":U, 10).
put stream sExpStream unformatted vcExpLine skip.
assign vcExpLine = "0113B":U +
string(tExpFields.tcCredAddressCity, "x(35)":U) +
fill("":U, 10).
put stream sExpStream unformatted vcExpLine skip.
assign vcExpLine = "0160A":U +
string(tExpFields.tcReference1, "x(16)":U) +
fill("":U, 29).
put stream sExpStream unformatted vcExpLine skip.
/* Create payrecords 3 (Naam begunstigde info) */
assign vcExpLine = "0170B":U +
string(vcCompanyName, "x(24)":U) +
fill("":U, 10).
put stream sExpStream unformatted vcExpLine skip.
/* Create payrecords 4 (Woonplaats begunstigde info) */
assign vcExpLine = "0173B":U +
string(vcCompanyCity, "x(35)":U) +
fill("":U, 10).
put stream sExpStream unformatted vcExpLine skip.
end.
/* TODO
assign vcExpLine = "9990A":U +
string(vdTotalLC * 100, "999999999999999999":U) +
string(vdTotalBankNrs, "9999999999":U) +
string(viPostCounter, "9999999":U) +
string("":U, "x(10)":U).
*/
/* Endrecord 2 (Bestandssluitinfo) */
assign vcExpLine = "9999A":U + string("":U, "x(45)":U).
put stream sExpStream unformatted vcExpLine skip.