Accounting systems

Function EbcDic(ByVal tmpNumber As Double, ByVal tmpDec As Integer, ByVal tmpPlaces As Integer)
'--------------------------------------------------------------------------------------
'OneSource Requirement for Signed Numeric Fields
'Below is the conversion table of signed numeric values (right most over-punch character) to EBCIDIC:
'(you do not need to worry about positive numbers, it is only negative numbers that need the translation)

'Positive   'Negative
'0 = {      '0 = }
'1 = A      '1 = J
'2 = B      '2 = K
'3 = C      '3 = L
'4 = D      '4 = M
'5 = E      '5 = N
'6 = F      '6 = O
'7 = G      '7 = P
'8 = H      '8 = Q
'9 = I      '9 = R
'
'  (for example a -592.52 ... will be passed as 00000005925K)
'--------------------------------------------------------------------------------------

Dim tmpStr, tmpTrans, tmpPos, tmpFactor
Dim tmpFilled
tmpFilled = "00000000000000"
 
If Len(tmpNumber & "") = 0 Then
    EbcDic = right(tmpFilled, tmpPlaces)
    Exit Function
End If
 
Select Case tmpDec
Case 0
    tmpFactor = 1
Case 1
    tmpFactor = 10
Case 2
    tmpFactor = 100
Case 3
    tmpFactor = 1000
Case 4
    tmpFactor = 10000
End Select
 
If tmpNumber >= 0 Then
    EbcDic = right(tmpFilled & Int(tmpNumber * tmpFactor), tmpPlaces)
    Exit Function
Else
    tmpTrans = Int((tmpNumber * tmpFactor) * -1)
    tmpPos = InStr(1, "0123456789", right(tmpTrans, 1), 1)
 
    tmpStr = Left(tmpTrans, (Len(tmpTrans) - 1)) & right(Left("}JKLMNOPQR", tmpPos), 1)
   EbcDic = right(tmpFilled & tmpStr, tmpPlaces)
End If
 
End Function