Pasted

** / ********************************************* ************************
FUNCTION GenBic (pcEntity, plMsg)
** --------------------------------------------- **
* Routine to calculate the BIC code from the CCC code - VALID only for SPAIN-
* Parameters:
* pcEntity = Code of the entity. Corresponds to positions 1 to 4 of the CCC
* plMsg = Option to activate warning messages
* ------------------------------------------------- ----
plMsg = IIF (vartype (plMsg) = 'L', plMsg, .F.)
 IF empty (pcEntity)
	if plMsg
		Messagebox ('The entity code is unknown', 32, 'BIC Code')
	endif
	return ('')
endif
 IF vartype (pcEntity) = 'N'
	pcEntity = PADL (alltrim (str (pcEntity)), 4, '0')
endif
 IF len (PCEntity)! = 4
	if plMsg
		Messagebox ('Bad entity code', 32, 'BIC code')
	endif
	return (space (11))
endif
 local lcBIC, llError, lcDevuelve
 lcBIC = 'BIC' + pcEntity
 BIC0003 = 'BDEPESM1XXX'
BIC0011 = 'ALLFESMMXXX'
BIC0019 = 'DEUTESBBXXX'
BIC0021 = 'BCNDESM1XXX'
BIC0030 = 'ESPCESMMXXX'
BIC0031 = 'ETCHES2GXXX'
BIC0036 = 'SABNESMMXXX'
BIC0046 = 'GALEES2GXXX'
BIC0049 = 'BSCHESMMXXX'
BIC0057 = 'BVADESMMXXX'
BIC0058 = 'BNPAESMMXXX'
BIC0059 = 'MADRESMMXXX'
BIC0061 = 'BMARES2MXXX'
BIC0065 = 'BARCESMMXXX'
BIC0072 = 'PSTRESMMXXX'
BIC0073 = 'OPENESMMXXX'
BIC0075 = 'POPUESMMXXX'
BIC0078 = 'BAPUES22XXX'
BIC0081 = 'BSABESBBXXX'
BIC0083 = 'RENBESMMXXX'
BIC0086 = 'NORTESMMXXX'
BIC0093 = 'VALEESVVXXX'
BIC0094 = 'BVALESMMXXX'
BIC0099 = 'AHCRESVVXXX'
BIC0106 = 'LOYDESMMXXX'
BIC0107 = 'BNLIESM1XXX'
BIC0108 = 'SOGEESMMXXX'
BIC0113 = 'INBBESM1XXX'
BIC0121 = 'OCBAESM1XXX'
BIC0122 = 'CITIES2XXXX'
BIC0125 = 'BAOFESM1XXX'
BIC0128 = 'BKBKESMMXXX'
BIC0129 = 'INALESM1XXX'
BIC0130 = 'CGDIESMMXXX'
BIC0131 = 'BESMESMMXXX'
BIC0132 = 'PRNEESM1XXX'
BIC0133 = 'MIKBESB1XXX'
BIC0136 = 'AREBESMMXXX'
BIC0138 = 'BKOAES22XXX'
BIC0144 = 'PARBESMXXXX'
BIC0145 = 'DEUTESM1XXX'
BIC0149 = 'BNPAESMSXXX'
BIC0151 = 'CHASESM3XXX'
BIC0152 = 'BPLCESMMXXX'
BIC0154 = 'BSUIESMMXXX'
BIC0155 = 'BRASESMMXXX'
BIC0156 = 'ABNAESMMXXX'
BIC0159 = 'COBAESMXXXX'
BIC0160 = 'BOTKESMXXXX'
BIC0161 = 'BKTRESM1XXX'
BIC0162 = 'MIDLESMMXXX'
BIC0167 = 'GEBAESMMXXX'
BIC0168 = 'BBRUESMXXXX'
BIC0169 = 'NACNESMMXXX'
BIC0182 = 'BBVAESMMXXX'
BIC0184 = 'BEDFESM1XXX'
BIC0186 = 'BFIVESBBXXX'
BIC0188 = 'ALCLESMMXXX'
BIC0190 = 'BBPIESMMXXX'
BIC0196 = 'WELAESMMXXX'
BIC0198 = 'BCOEESMMXXX'
BIC0200 = 'PRVBESB1XXX'
BIC0205 = 'DECRESM1XXX'
BIC0211 = 'PROAESMMXXX'
BIC0216 = 'POHIESMMXXX'
BIC0217 = 'HLFXESMMXXX'
BIC0218 = 'FCEFESM1XXX'
BIC0219 = 'BMCEESMMXXX'
BIC0220 = 'FIOFESM1XXX'
BIC0223 = 'GEECESB1XXX'
BIC0224 = 'SCFBESMMXXX'
BIC0225 = 'FIEIESM1XXX'
BIC0226 = 'UBSWESMMXXX'
BIC0227 = 'UNOEESM1XXX'
BIC0228 = 'IXIUESM1XXX'
BIC0229 = 'POPLESMMXXX'
BIC0231 = 'DSBLESMMXXX'
BIC0232 = 'INVLESMMXXX'
BIC0233 = 'POPIESMMXXX'
BIC0234 = 'CCOCESMMXXX'
BIC0235 = 'PIESESM1XXX'
BIC0236 = 'LOYIESMMXXX'
BIC0237 = 'CSURES2CXXX'
BIC0486 = 'THREE2BXXX'
BIC0487 = 'GBMNESMMXXX'
BIC0488 = 'BFASESMMXXX'
BIC1000 = 'ICROESMMXXX'
BIC1113 = 'BSUDESM1XXX'
BIC1116 = 'SCSIESM1XXX'
BIC1127 = 'SCBLESM1XXX'
BIC1156 = 'IRVTESM1XXX'
BIC1164 = 'ESBFESM1XXX'
BIC1168 = 'BNACESM1XXX'
BIC1173 = 'COURESB1XXX'
BIC1182 = 'HYVEESM1XXX'
BIC1191 = 'HANDES21XXX'
BIC1193 = 'PKBSES21XXX'
BIC1196 = 'AEEVESM1XXX'
BIC1197 = 'BILLESB1XXX'
BIC1199 = 'CRGEESM1XXX'
BIC1209 = 'ABCMESM1XXX'
BIC1210 = 'REDEESM1XXX'
BIC1221 = 'PNBMESM1XXX'
BIC1224 = 'RHRHESM1XXX'
BIC1227 = 'BSSAESB1XXX'
BIC1231 = 'BOCAES21XXX'
BIC1233 = 'BCMAESM1XXX'
BIC1234 = 'PRBAESM1XXX'
BIC1236 = 'HELAESM1XXX'
BIC1238 = 'BIMEESM1XXX'
BIC1240 = 'LOFPESB1XXX'
BIC1241 = 'STOLESM1XXX'
BIC1242 = 'SOLAESB1XXX'
BIC1245 = 'BEIVESM1XXX'
BIC1248 = 'WAFAESM1XXX'
BIC1249 = 'NPBSES21XXX'
BIC1251 = 'IHZUES21XXX'
BIC1255 = 'AARBESM1XXX'
BIC1451 = 'CRCGESB1XXX'
BIC1454 = 'NEWGESM1XXX'
BIC1457 = 'LLISESM1XXX'
BIC1459 = 'PRABESMMXXX'
BIC1460 = 'CRESESMMXXX'
BIC1462 = 'ASSCESM1XXX'
BIC1463 = 'PSABESM1XXX'
BIC1464 = 'NFFSESM1XXX'
BIC1465 = 'INGDESMMXXX'
BIC1466 = 'FRANESM1XXX'
BIC1467 = 'EHYPESMXXXX'
BIC1469 = 'SHSAESM1XXX'
BIC1470 = 'BPIPESM1XXX'
BIC1472 = 'UCSSESM1XXX'
BIC1473 = 'PRIBESMXXXX'
BIC1474 = 'CITIESMXXXX'
BIC1475 = 'CCSEESM1XXX'
BIC1478 = 'MLIBESM1XXX'
BIC1479 = 'NATXESMMXXX'
BIC1480 = 'VOWAES21XXX'
BIC1485 = 'BOFAES2XXXX'
BIC1488 = 'PICTESMMXXX'
BIC1490 = 'SELFESMMXXX'
BIC1491 = 'TRIOESMMXXX'
BIC1494 = 'BCITESMMXXX'
BIC1497 = 'ESSIESMMXXX'
BIC1501 = 'DPBBESM1XXX'
BIC1502 = 'IKBDESM1XXX'
BIC1505 = 'ARABESMMXXX'
BIC1506 = 'MLCBESM1XXX'
BIC1522 = 'EFGBESMMXXX'
BIC1524 = 'UBIBESMMXXX'
BIC1525 = 'BCDMESMMXXX'
BIC1534 = 'KBLXESMMXXX'
BIC1538 = 'ICBKESMMXXX'
BIC1544 = 'BACAESMMXXX'
BIC1545 = 'AGRIESMMXXX'
BIC2000 = 'CECAESMMXXX'
BIC2010 = 'CECAESMM010'
BIC2013 = 'CESCESBBXXX'
BIC2017 = 'CECAESMM017'
BIC2018 = 'CECAESMM018'
BIC2031 = 'CECAESMM031'
BIC2038 = 'CAHMESMMXXX'
BIC2043 = 'CECAESMM043'
BIC2045 = 'CECAESMM045'
BIC2048 = 'CECAESMM048'
BIC2051 = 'CECAESMM051'
BIC2052 = 'CECAESMM052'
BIC2056 = 'CECAESMM056'
BIC2066 = 'CECAESMM066'
BIC2080 = 'CAGLESMMVIG'
BIC2081 = 'CECAESMM081'
BIC2085 = 'CAZRES2ZXXX'
BIC2086 = 'CECAESMM086'
BIC2095 = 'BASKES2BXXX'
BIC2096 = 'CSPAES2LXXX'
BIC2099 = 'CECAESMM099'
BIC2100 = 'CAIXESBBXXX'
BIC2101 = 'CGGKES22XXX'
BIC2103 = 'UCJAES2MXXX'
BIC2104 = 'CSSOES2SXXX'
BIC2105 = 'CECAESMM105'
BIC2107 = 'BBVAESMM107'
BIC2108 = 'CSPAES2L108'
BIC3001 = 'BCOEESMM001'
BIC3007 = 'BCOEESMM007'
BIC3008 = 'BCOEESMM008'
BIC3009 = 'BCOEESMM009'
BIC3016 = 'BCOEESMM016'
BIC3017 = 'BCOEESMM017'
BIC3018 = 'BCOEESMM018'
BIC3020 = 'BCOEESMM020'
BIC3023 = 'BCOEESMM023'
BIC3025 = 'CDENESBBXXX'
BIC3029 = 'CCRIES2A029'
BIC3035 = 'CLPEES2MXXX'
BIC3045 = 'CCRIES2A045'
BIC3058 = 'CCRIES2AXXX'
BIC3059 = 'BCOEESMM059'
BIC3063 = 'BCOEESMM063'
BIC3067 = 'BCOEESMM067'
BIC3070 = 'BCOEESMM070'
BIC3076 = 'BCOEESMM076'
BIC3080 = 'BCOEESMM080'
BIC3081 = 'BCOEESMM081'
BIC3084 = 'CVRVES2BXXX'
BIC3085 = 'BCOEESMM085'
BIC3089 = 'BCOEESMM089'
BIC3095 = 'CCRIES2A095'
BIC3096 = 'BCOEESMM096'
BIC3098 = 'BCOEESMM098'
BIC3102 = 'BCOEESMM102'
BIC3104 = 'BCOEESMM104'
BIC3105 = 'CCRIES2A105'
BIC3110 = 'BCOEESMM110'
BIC3111 = 'BCOEESMM111'
BIC3112 = 'CCRIES2A112'
BIC3113 = 'BCOEESMM113'
BIC3115 = 'BCOEESMM115'
BIC3116 = 'BCOEESMM116'
BIC3117 = 'BCOEESMM117'
BIC3118 = 'CCRIES2A118'
BIC3119 = 'CCRIES2A119'
BIC3121 = 'CCRIES2A121'
BIC3123 = 'CCRIES2A123'
BIC3127 = 'BCOEESMM127'
BIC3130 = 'BCOEESMM130'
BIC3134 = 'BCOEESMM134'
BIC3135 = 'CCRIES2A135'
BIC3137 = 'CCRIES2A137'
BIC3138 = 'BCOEESMM138'
BIC3140 = 'BCOEESMM140'
BIC3144 = 'BCOEESMM144'
BIC3146 = 'CCCVESM1XXX'
BIC3150 = 'BCOEESMM150'
BIC3152 = 'CCRIES2A152'
BIC3157 = 'CCRIES2A157'
BIC3159 = 'BCOEESMM159'
BIC3160 = 'CCRIES2A160'
BIC3162 = 'BCOEESMM162'
BIC3165 = 'CCRIES2A165'
BIC3166 = 'BCOEESMM166'
BIC3171 = 'CXAVESB1XXX'
BIC3172 = 'CCOCESMMXXX'
BIC3174 = 'BCOEESMM174'
BIC3177 = 'BCOEESMM177'
BIC3179 = 'CCRIES2A179'
BIC3183 = 'CASDESBBXXX'
BIC3186 = 'CCRIES2A186'
BIC3187 = 'BCOEESMM187'
BIC3188 = 'CCRIES2A188'
BIC3190 = 'BCOEESMM190'
BIC3191 = 'BCOEESMM191'
BIC6814 = 'MNTYESMMXXX'
BIC6852 = 'BMEUESM1XXX'
BIC8233 = 'CSFAESM1XXX'
BIC8512 = 'UCINESMMXXX'
BIC8835 = 'SBFCESMMXXX'
BIC9000 = 'ESPBESMMXXX'
  ** / Error handling for VFP version 6
public llErrorBIC
llErrorBIC = .F.
 ON ERROR DO error_BIC WITH ERROR (), MESSAGE (), MESSAGE (1), PROGRAM (), LINEN ()
	lcDevuelve = & lcBIC
ON ERROR
 if llErrorBIC
	lcDevuelve = space (11)	
	if plMsg
		MESSAGEBOX ('BIC code not found or unknown', 16, 'ERROR')
	endif
endif
 *! * ** / Error handling for VFP version 9 
*! * TRY
*! * lcDevuelve = & lcBIC
*! * CATCH
*! * lcDevuelve = space (11)
*! * if plMsg
*! * MESSAGEBOX ('BIC code not found or unknown', 16, 'ERROR')
*! * endif
*! * END
 release llErrorBIC
return lcDevuelve
ENDFUNC
 PROCEDURE error_BIC
	PARAMETER merror, mess, mess1, mprog, mlineno
	** / BIC code does not exist and generates error
	llErrorBIC = .T.
 *! *? 'Error number:' + LTRIM (STR (merror))
*! *? 'Error message:' + mess
*! *? 'Line of code with error:' + mess1
*! *? 'Line number of error:' + LTRIM (STR (mlinene))
*! *? 'Program with error:' + mprog
 ENDPROC
 FUNCTION CALCULA_IBAN (lcCCC, llIban)
** --------------------------------------------- **
* Routine to calculate the IBAN code from the CCC code - VALID only for SPAIN-
* Parameters:
* lcCCC = CCC Code
* llIban = Option to obtain only the IBAN part (ES + 2 control digits). By default .F.
* ------------------------------------------------- ----
LOCAL nParte1 AS Integer, nResul1 AS Integer, cResul1 AS String,;
	  nPart2 AS Integer, nResul2 AS Integer, cResul2 AS String ,;
	  nPart3 AS Integer, nResul3 AS Integer, cResul3 AS String ,;
	  nPart4 AS Integer, nResul4 AS Integer, cResul4 AS String ,;
	  CCC AS String, nDigitosControl AS Integer, cDigitosControl AS String
Local llSoloIBAN
llSoloIBAN = IIF (vartype (llIban) = 'L', llIban, .F.)
** Value of each letter to convert the country code to numeric 
Local A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y , Z
A = 10 
B = 11 
C = 12 
D = 13 
E = 14 
F = 15
G = 16 
H = 17 
I = 18 
J = 19 
K = 20 
L = 21 
M = 22 
N = 23 
O = 24 
P = 25 
Q = 26 
R = 27 
S = 28
T = 29
U = 30 
V = 31 
W = 32 
X = 33
Y = 34 
Z = 35 
 if parameters ()> 0
	** / Delete scripts in the CCC and blank spaces
	CCC = alltrim (STRTRAN (STRTRAN (m.lcCCC, '-', ''), '', ''))
endif
 IF LEN (CCC) # 20
** / = MESSAGEBOX ('You must enter a valid CCC (20 digits).', 0 + 32 + 0, 'User information.')	
RETURN (m.CCC)
ENDIF
 ** Convert the letters of the country (ES) into numbers by applying E = 14; S = 28
** In this example I add to the CCC the numbers corresponding to the "ES" and two zeros at the end 
cAux = CCC + '14 '+' 28 '+' 00 '
 ** As the resulting number is very large (26 digits) and VFP can not handle such large numeric or integer fields
** what is done is to go calculating by smaller chains (up to 9 digits) and concatenating the partial results
nPart1 = VAL (SUBSTR (cAux, 1.7))
nResul1 = MOD (nParte1,97)
cResul1 = ALLTRIM (STR (nResul1))
 nParte2 = VAL (cResul1 + SUBSTR (cAux, 8.7))
nResul2 = MOD (nParte2,97)
cResul2 = ALLTRIM (STR (nResul2))
 nPart3 = VAL (cResul2 + SUBSTR (cAux, 15.7))
nResul3 = MOD (nPart3,97)
cResul3 = ALLTRIM (STR (nResul3))
 nParte4 = VAL (cResul3 + SUBSTR (cAux, 22.5))
nResul4 = MOD (nParte4,97)
cResul4 = ALLTRIM (STR (nResul4))
 nDigitosControl = 98 - VAL (cResul4)
cDigitosControl = ALLTRIM (STR (nDigitosControl))
 ** The calculated control digits must be 2 so if the result is less than 10, add a 0 ahead
cDigitosControl = PADL (cDigitosControl, 2, "0")
 ** / WAIT WINDOW 'CALCULATED IBAN CODE:' + 'ES' + cDigitosControl + CCC
return ('ES' + cDigitosControl + IIF (llSoloIBAN, '', CCC))
endfunc
** --------------------------------------------- **
  FUNCTION CALCULA_ACREEDOR (lcCIF, lcSufix, llDControl)
** --------------------------------------------- **
* Routine to calculate the CREDITOR code from the CIF of the entity
* Parameters:
* lcCIF = CIF of the entity
* lcSuffix = Code suffix of the entity. By default '000'
* llDControl = Get only part ES + the two control digits. By default .F.
* ------------------------------------------------- ----
 LOCAL nParte1 AS Integer, nResul1 AS Integer, cResul1 AS String,;
	  nPart2 AS Integer, nResul2 AS Integer, cResul2 AS String ,;
	  CIF AS String, nDigitosControl AS Integer, cDigitosControl AS String
 Local llSoloDControl, letraCIF, Sufix
Suffix = IIF (vartype (lcSufix) = 'C', lcSuffix, '000')
llDControl = IIF (vartype (llDControl) = 'L', llDControl, .F.)
 ** Value of each letter to convert the country code to numeric 
Local A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y , Z
A = 10 
B = 11 
C = 12 
D = 13 
E = 14 
F = 15
G = 16 
H = 17 
I = 18 
J = 19 
K = 20 
L = 21 
M = 22 
N = 23 
O = 24 
P = 25 
Q = 26 
R = 27 
S = 28
T = 29
U = 30 
V = 31 
W = 32 
X = 33
Y = 34 
Z = 35 
 if parameters ()> 0
	** / Remove scripts and blanks in the CIF
	CIF = alltrim (STRTRAN (STRTRAN (m.lcCIF, '-', ''), '', ''))
endif
 IF LEN (m.CIF) # 9 OR ISDIGIT (m.CIF)
	MESSAGEBOX ('CIF not valid (Letter + 8 digits).', 0 + 32 + 0, 'CIF:' + m.lcCIF)	
	RETURN (m.CIF)
ENDIF
 ** Convert the letters of the country (ES) into numbers by applying E = 14; S = 28 and the letter of the CIF for its value
** In this example I add to the CIF the numbers corresponding to the "ES" and two zeros at the end 
letraCIF = SUBSTR (CIF, 1,1)
 cAux = alltrim (str (& letterCIF)) + substr (CIF, 2,8) + '14' + '28' + '00'
 nPart1 = VAL (SUBSTR (cAux, 1.8))
nResul1 = MOD (nParte1,97)
cResul1 = ALLTRIM (STR (nResul1))
 nParte2 = VAL (cResul1 + SUBSTR (cAux, 9.8))
nResul2 = MOD (nParte2,97)
cResul2 = ALLTRIM (STR (nResul2))
 nDigitosControl = 98 - VAL (cResul2)
cDigitosControl = ALLTRIM (STR (nDigitosControl))
 ** The calculated control digits must be 2 so if the result is less than 10, add a 0 ahead
cDigitosControl = PADL (cDigitosControl, 2, "0")
 return ('ES' + cDigitosControl + IIF (llDControl, '', m.Sufix + CIF))
endfunc
** --------------------------------------------- **
  FUNCTION TEXT_IBAN (lcCCC, llOculta, plMsg)
** --------------------------------------------- **
* Routine to display the IBAN code on paper from the CCC code with the possibility of partially hiding the CCC
* Parameters:
* lcCCC = CCC Code
* llOculta = Option to hide part of the CCC
* plMsg = Option to activate warning messages
* ------------------------------------------------- ----
plMsg = IIF (vartype (plMsg) = 'L', plMsg, .F.)
llOculta = IIF (vartype (llOculta) = 'L', llOculta, .F.)
 IF EMPTY (lcCCC)
	if plMsg
		MESSAGEBOX ('You must enter a valid CCC (20 digits) or a valid IBAN account (24 characters)', 0 + 32 + 0, 'CCC / IBAN Account not valid')
	endif
	RETURN ('IBAN?')
ENDIF
 ** / Delete scripts in the CCC
lcCCC = alltrim (STRTRAN (STRTRAN (m.lcCCC, '-', ''), '', ''))
 ** / Check if it is a CCC account
IF LEN (lcCCC) = 20 && CCC
	lcIBAN = Calcula_IBAN (lcCCC, .F.)
else
	lcIBAN = 'ES **' + lcCCC
	if plMsg
		MESSAGEBOX ('You must enter a valid CCC (20 digits).', 0 + 32 + 0, 'Error in CCC')
	endif
Endif
 return ('IBAN' + space (1) +;
		substr (lcIBAN, 1,4) + space (1) +;
		substr (lcIBAN, 5.4) + space (1) +;
		IIF (llOculta, '****', substr (lcIBAN, 9.4)) + space (1) +;
		IIF (llOculta, '****', substr (lcIBAN, 13.4)) + space (1) +;
		IIF (llOculta, '****', substr (lcIBAN, 17,4)) + space (1) +;
		substr (lcIBAN, 21.4))
endfunc