Function BtnMatchColumnSystem()
'On Error GoTo err_BtnMatchColumnSystem
Dim OBL As Recordset, Source As Recordset, Sourceq As Recordset, EOR As Recordset, MainLine As Recordset
Dim nullSYSTEMNAME As String, wSYSTEMNAME As String, ySYSTEMNAME As String, dSYSTEMNAME As String, qSYSTEMNAME As String, xSYSTEMNAME As String, hSYSTEMNAME As String, zSYSTEMNAME As String, tSYSTEMNAME As String
nullSYSTEMNAME = "654"
wSYSTEMNAME = "645"
ySYSTEMNAME = "645"
dSYSTEMNAME = "615"
qSYSTEMNAME = "644"
xSYSTEMNAME = "644"
hSYSTEMNAME = "654"
zSYSTEMNAME = "654"
tSYSTEMNAME = "615"
m1 = "Matching data . . . "
DoCmd.OpenForm "Please Wait"
DoCmd.RepaintObject acForm, "Please Wait"
DoCmd.Hourglass True
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from OBLTmp;"
'extract only valid records from OBL file to local table - add rollup amt by crn
' myb = CurrentDb; myOBL = attached OBL database; my110 = attached Source database.
q = "INSERT INTO OBLTmp ( ORN, LINEID, CRN, Item, SI, CD, SC, OT, OrderNum, SJO, EOR, TRN, CCM, IFS_M, OBL, OBLAmt, OrigOBLAmt, PP, PPAmt, OrigPPAmt, AFD, NetOBL, OrigNetOBL ) "
q = q + "SELECT OBL.ORN, OBL.LINEID, OBL.CRN, OBL.Item, OBL.SI, OBL.CD, OBL.SC, OBL.OT, OBL.OrderNum, OBL.SJO, OBL.EOR, OBL.TRN, OBL.CCM, OBL.IFS_M, OBL.OBL AS OBL, cvtnlast([OBL]) AS OBLAmt, cvtnlast([OBL]) AS OrigOBLAmt, OBL.PROG_PAY AS PP, cvtnlast([PROG_PAY]) AS PPAmt, cvtnlast([PROG_PAY]) AS OrigPPAmt, OBL.AFD, NetOBLByOrnLINEIDCrn.NetOBL, NetOBLByOrnLINEIDCrn.NetOBL "
q = q + "FROM (OBL INNER JOIN NetOBLByOrnLINEIDCrn ON (OBL.LINEID = NetOBLByOrnLINEIDCrn.LINEID) AND (OBL.ORN = NetOBLByOrnLINEIDCrn.ORN) AND (OBL.CRN = NetOBLByOrnLINEIDCrn.CRN) AND (OBL.OT = NetOBLByOrnLINEIDCrn.OT) AND (OBL.SC = NetOBLByOrnLINEIDCrn.SC)) LEFT JOIN MyBadItem ON OBL.Item = MyBadItem.Item "
q = q + "WHERE (((OBL.Item) Is Not Null) AND ((MyBadItem.Item) Is Null)) OR (((OBL.Item) Is Not Null) AND ((MyBadItem.NotUsedFor)<>""Auto"" And (MyBadItem.NotUsedFor)<>""Both""));"
DoCmd.RunSQL q
'get date OBL file loaded
OBLload = DMax("[OBLLoaded]", "OBL")
Set myb = CurrentDb
Set ta = myb.OpenRecordset("MyCccTransCodes", dbOpenDynaset)
Do While Not ta.EOF
If ta!CccValue = "Blank" Then
nullSYSTEMNAME = ta!SYSTEMNAME
ElseIf ta!CccValue = "W" Then
wSYSTEMNAME = ta!SYSTEMNAME
ElseIf ta!CccValue = "Y" Then
ySYSTEMNAME = ta!SYSTEMNAME
ElseIf ta!CccValue = "D" Then
dSYSTEMNAME = ta!SYSTEMNAME
ElseIf ta!CccValue = "Q" Then
qSYSTEMNAME = ta!SYSTEMNAME
ElseIf ta!CccValue = "X" Then
xSYSTEMNAME = ta!SYSTEMNAME
ElseIf ta!CccValue = "H" Then
hSYSTEMNAME = ta!SYSTEMNAME
ElseIf ta!CccValue = "Z" Then
zSYSTEMNAME = ta!SYSTEMNAME
ElseIf ta!CccValue = "T" Then
tSYSTEMNAME = ta!SYSTEMNAME
End If
ta.MoveNext
Loop
Set ta = Nothing
Set my110 = DBEngine.Workspaces(0).OpenDatabase(Forms!switchboard!MySourceLoc)
Set myarcs = DBEngine.Workspaces(0).OpenDatabase(Forms!switchboard!MyArcsLoc)
Sourcetable = Forms!switchboard!MySc + "-Source"
Set Sourceq = myb.OpenRecordset("SourceSYSTEMNAME", dbOpenDynaset)
Set Source = my110.OpenRecordset(Sourcetable, dbOpenTable)
Source.Index = "PrimaryKey" 'LinkKey Field - AutoNumber Unique
Set EOR = myarcs.OpenRecordset("MyEorDefaults", dbOpenTable)
EOR.Index = "PrimaryKey" 'FY Field - Unique
If Sourceq.EOF Then GoTo exit_BtnMatchColumnSystem
Do Until Sourceq.EOF
foundmatch = 0
crsvou = False
If Sourceq!DovNo Like "9*" Then crsvou = True 'should be a CRS updated voucher
If InStr(Sourceq!Remarks, "CRS updated") > 0 Then crsvou = True 'should be a CRS updated voucher
If Not IsNumeric(Mid$(Sourceq!DovNo, 2, 1)) Then crsvou = True 'should be a CRS updated voucher
If Sourceq!LINEID = "ZZ" Then
Sourceq.Edit
Sourceq!UpdtReason = "ZZ"
Sourceq!LedgerKey = "ZZ"
Sourceq!ArcsLogic = "ZZ"
Sourceq!LastUpdtBy = "ARC"
Sourceq!BlkTktNo = Left$(Sourceq!BlkTktNo, 3) + Sourceq!OrigCmdDsg + "ARC"
Sourceq.Update
ElseIf (Sourceq!Usn = "W" Or Sourceq!Usn = "Y") And Sourceq!Bsn = "8242" Then 'w=progress pay PAYMENT (TOP of voucher), Y=progress pay RECOUPMENT (BOTTOM of voucher)
'OPTION FMS
'if Columbus provides a Item - look for matching Item and progress pay >0 - sort by OBL low to high
If Sourceq!LenItem > 0 Then
If Sourceq!ActAmt > 0 Then 'Debit Progress Pay
q = "SELECT OBLTmp.* FROM OBLTmp WHERE (((OBLTmp.ORN)=""" + Sourceq!OblgRefNoSpiin + """) AND ((OBLTmp.LINEID)=""" + Sourceq!LINEID + """) AND ((OBLTmp.SC)=""" + Sourceq!SiteCode + """) AND ((OBLTmp.Item)=""" + Sourceq!Item + """));"
Else
q = "SELECT OBLTmp.* FROM OBLTmp WHERE (((OBLTmp.ORN)=""" + Sourceq!OblgRefNoSpiin + """) AND ((OBLTmp.LINEID)=""" + Sourceq!LINEID + """) AND ((OBLTmp.SC)=""" + Sourceq!SiteCode + """) AND ((OBLTmp.PPAmt)>0) AND ((OBLTmp.Item)=""" + Sourceq!Item + """));"
End If
Set OBL = myb.OpenRecordset(q, dbOpenDynaset)
If Not OBL.EOF Then 'should be on matching OBL record (orn+LINEID+Item) IF ONE EXISTS
Sourceq.Edit
Sourceq!CmdDsg = OBL!CD
Sourceq!BlkTktNo = Left$(Sourceq!BlkTktNo, 3) + OBL!CD + "ARC"
If Sourceq!Usn = "W" Then
Sourceq!TrnsCd = wSYSTEMNAME
Sourceq!UpdtReason = "100-WFms"
Sourceq!ArcsLogic = "100-WFms"
Else
Sourceq!TrnsCd = ySYSTEMNAME
Sourceq!UpdtReason = "500-WFms"
Sourceq!ArcsLogic = "500-WFms"
End If
Sourceq!OBLAmt = OBL!OBLAmt
Sourceq!OBLDate = OBLload
Sourceq!ArcsMatchDate = Now
Sourceq!OrderNum = OBL!OrderNum
Sourceq!EOR = OBL!EOR
Sourceq!ComtRefNo = OBL!CRN
Sourceq!CostCenMgr = OBL!CCM
Sourceq!Qty = "00000000{"
Sourceq!Item = OBL!Item
Sourceq!SubOrderNum = OBL!SJO
Sourceq!IfsDocuNo = OBL!IFS_M
Sourceq!OkToExport = -1
foundmatch = -1
Sourceq!LedgerKey = "100"
If Forms!switchboard!MyCRSFlag = False And crsvou = True Then
Sourceq!OkToExport = 0
Sourceq!LedgerKey = "CRS"
End If
Sourceq!SiteCode = OBL!SC
Sourceq!ArcsAuto = -1
Sourceq!LastUpdtBy = "ARC"
Sourceq.Update
OBL.Edit
OBL!OBLHits = OBL!OBLHits + 1
OBL!PPAmt = OBL!PPAmt + Sourceq!ActAmt
OBL!PP = cvtlast12(OBL!PPAmt)
'adjust OBL amt
OBL!OBLAmt = OBL!OBLAmt - Sourceq!ActAmt
OBL!OBL = cvtlast12(OBL!OBLAmt)
chgtnet = OBL!NetOBL - Sourceq!ActAmt
chgfnet = OBL!NetOBL
chgfcrn = OBL!CRN
OBL.Update
OBLUpd = "UPDATE OBLTmp SET OBLTmp!NetOBL = " + Str(chgtnet) + " WHERE (((OBLTmp.CRN)=""" + OBL!CRN + """) AND ((OBLTmp.NetOBL)=" + Str(OBL!NetOBL) + "));"
' Set OBL = Nothing
DoCmd.RunSQL OBLUpd, False
Else 'look for matching 1st 4 of Item - if only one found - post
If Sourceq!ActAmt > 0 Then 'Debit Progress Pay
q = "SELECT OBLTmp.* FROM OBLTmp WHERE (((OBLTmp.ORN)=""" + Sourceq!OblgRefNoSpiin + """) AND ((OBLTmp.LINEID)=""" + Sourceq!LINEID + """) AND ((OBLTmp.SC)=""" + Sourceq!SiteCode + """) AND ((OBLTmp.Item) Like """ + Left$(Sourceq!Item, 4) + "*""));"
Else
q = "SELECT OBLTmp.* FROM OBLTmp WHERE (((OBLTmp.ORN)=""" + Sourceq!OblgRefNoSpiin + """) AND ((OBLTmp.LINEID)=""" + Sourceq!LINEID + """) AND ((OBLTmp.SC)=""" + Sourceq!SiteCode + """) AND ((OBLTmp.Item) Like """ + Left$(Sourceq!Item, 4) + "*""));"
End If
Set OBL = myb.OpenRecordset(q, dbOpenDynaset)
If Not OBL.EOF Then OBL.MoveLast 'should be on matching OBL record (orn+LINEID+1st 4 Item) IF ONE EXISTS
If OBL.RecordCount = 1 Then 'only 1 record found
Sourceq.Edit
Sourceq!CmdDsg = OBL!CD
Sourceq!BlkTktNo = Left$(Sourceq!BlkTktNo, 3) + OBL!CD + "ARC"
If Sourceq!Usn = "W" Then
Sourceq!TrnsCd = wSYSTEMNAME
Sourceq!UpdtReason = "200-WFms"
Sourceq!ArcsLogic = "200-WFms"
Else
Sourceq!TrnsCd = ySYSTEMNAME
Sourceq!UpdtReason = "600-WFms"
Sourceq!ArcsLogic = "600-WFms"
End If
Sourceq!OBLAmt = OBL!OBLAmt
Sourceq!OBLDate = OBLload
Sourceq!ArcsMatchDate = Now
Sourceq!OrderNum = OBL!OrderNum
Sourceq!EOR = OBL!EOR
Sourceq!ComtRefNo = OBL!CRN
Sourceq!CostCenMgr = OBL!CCM
Sourceq!Qty = "00000000{"
Sourceq!Item = OBL!Item
Sourceq!SubOrderNum = OBL!SJO
Sourceq!IfsDocuNo = OBL!IFS_M
Sourceq!OkToExport = -1
foundmatch = -1
Sourceq!LedgerKey = "100"
If Forms!switchboard!MyCRSFlag = False And crsvou = True Then
Sourceq!OkToExport = 0
Sourceq!LedgerKey = "CRS"
End If
Sourceq!SiteCode = OBL!SC
Sourceq!ArcsAuto = -1
Sourceq!LastUpdtBy = "ARC"
Sourceq.Update
OBL.Edit
OBL!OBLHits = OBL!OBLHits + 1
OBL!PPAmt = OBL!PPAmt + Sourceq!ActAmt
OBL!PP = cvtlast12(OBL!PPAmt)
'adjust OBL amt
OBL!OBLAmt = OBL!OBLAmt - Sourceq!ActAmt
OBL!OBL = cvtlast12(OBL!OBLAmt)
chgtnet = OBL!NetOBL - Sourceq!ActAmt
chgfnet = OBL!NetOBL
chgfcrn = OBL!CRN
OBL.Update
OBLUpd = "UPDATE OBLTmp SET OBLTmp!NetOBL = " + Str(chgtnet) + " WHERE (((OBLTmp.CRN)=""" + OBL!CRN + """) AND ((OBLTmp.NetOBL)=" + Str(OBL!NetOBL) + "));"
' Set OBL = Nothing
DoCmd.RunSQL OBLUpd, False
End If
End If
End If