Sales_Module

C:\Integral Accounting Pro v3.1 (Full Version)\Project\Sales_Module.bas
Generated: 4/16/2003 2:01:12 PM


Table of Contents
BuildAgedReceivables
CreateBackOrder
GetARInvoiceDiscount
MonthEndSales
PostCreditMemo
PostInvoice
PostReturn
PostSalesMemo
GetMaxID
DeleteNewRecord
GetInformAboutSysCompany

Attribute VB_Name = "Sales_Module" ''{*********************************************************** ''-TITLE: Sales_Module ''-MODULE ID: 2.14 ''-PURPOSE: This module displays Sales ''-USAGE: ''-INPUT ASSERTION: Expects as input : nothing ''-OUTPUT ASSERTION: This module returns no values ''-CALLS: This module calls no other modules ''-CALLED BY: Sales_Module ''-TABLES/FIELDS USED: ''-TABLES/FIELDS AFFECTED: ''-VARIABLES: ''-METHOD: ''-REVISION HISTORY: Created before 12/01/2000, Corrected 04/07/2003 ''-REMARKS: ''***********************************************************} Option Explicit ''{*********************************************************** ''-TITLE: BuildAgedReceivables ''-MODULE ID: 2.14 ''-PURPOSE: This procedure displays Build Aged Receivables ''-USAGE: BuildAgedReceivables() ''-INPUT ASSERTION: ''-OUTPUT ASSERTION: Integer ''-CALLS: LogError ''-CALLED BY: BuildAgedReceivables; Main_Menu.mnuAgedReceivablesDetail_Click; Main_Menu.mnuAgedReceivablesSummary_Click ''-TABLES/FIELDS USED: "[Print Aged Receivables Work] "[SYS Company] "[AR Customer] [AR Sales] [qryCustomerPayments] [qryCustomerPayments2] /All or Any of the Fields ''-TABLES/FIELDS AFFECTED: [Print Aged Receivables Work] /All or Any of the Fields ''-VARIABLES: db, rsWork, cmdtemp, rsPayments, CustomerID$, rsCompany, Period1%, Period2%, Period3%, AgeBy%, CurrentAmt@, Period1Amt@, Period2Amt@, Period3Amt@, Period4Amt@, TotalAmount@, CurrentPeriod%, Balance@, Days&, TransAmount@, TransDate, rsARSale, rsARCustomer, Order% ''-METHOD: ''-REVISION HISTORY: Created before 12/01/2000, Corrected 04/07/2003 ''-REMARKS: ''***********************************************************}
Function BuildAgedReceivables() As Integer Table of Contents Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open gblADOProvider Dim rsWork As Recordset Dim cmdtemp As Recordset Set cmdtemp = New Recordset db.Execute "DELETE FROM [Print Aged Receivables Work]" Set rsWork = New Recordset rsWork.Open "[Print Aged Receivables Work]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim rsPayments As Recordset Dim CustomerID$ Dim rsCompany As Recordset Set rsCompany = New Recordset rsCompany.Open "[SYS Company]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim Period1% Dim Period2% Dim Period3% Dim AgeBy% rsCompany.MoveFirst Period1% = rsCompany("SYS COM Sales Period 1") Period2% = rsCompany("SYS COM Sales Period 2") Period3% = rsCompany("SYS COM Sales Period 3") AgeBy% = IIf(IsNull(rsCompany("SYS COM Sales Age Invoices By")), 1, rsCompany("SYS COM Sales Age Invoices By")) Dim CurrentAmt@ Dim Period1Amt@ Dim Period2Amt@ Dim Period3Amt@ Dim Period4Amt@ Dim TotalAmount@ Dim CurrentPeriod% Dim Balance@ Dim Days& TotalAmount@ = 0 Balance@ = 0 Dim TransAmount@ Dim TransDate Dim rsARSale As Recordset Dim rsARCustomer As Recordset Set rsARCustomer = New Recordset rsARCustomer.Open "[AR Customer]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim Order% Order% = 0 rsARCustomer.MoveFirst Do While Not rsARCustomer.EOF CustomerID$ = rsARCustomer("AR CUST Customer ID") Set rsARSale = New Recordset rsARSale.Open "SELECT * FROM [AR Sales] WHERE [AR SALE Customer ID] = '" & CustomerID$ & "'AND [AR SALE Document Type] in ('Invoice','Beginning Balance','Return') AND [AR SALE Posted YN] = 1 ORDER BY [AR SALE Date] Asc", db, adOpenStatic, adLockOptimistic, adCmdText If rsARSale.RecordCount > 0 Then rsARSale.MoveFirst Do While Not rsARSale.EOF rsWork.AddNew rsWork("Customer ID") = CustomerID$ rsWork("Order") = Order% rsWork("Transaction Type") = rsARSale("AR SALE Document Type") rsWork("Transaction ID") = rsARSale("AR SALE Ext Document #") rsWork("Transaction Description") = rsARSale("AR SALE Description") rsWork("Applied To") = "" If (AgeBy% = 1) Then 'Use Invoice Date TransDate = IIf(IsNull(rsARSale("AR SALE Date")), format("1/1/90", "Short Date"), rsARSale("AR SALE Date")) Else 'Use Due Date TransDate = IIf(IsNull(rsARSale("AR SALE Due Date")), format("1/1/90", "Short Date"), rsARSale("AR SALE Due Date")) End If rsWork("Transaction Date") = TransDate TransAmount@ = rsARSale("AR SALE Total") Days& = DateDiff("d", TransDate, Now) Select Case Days& Case Is < 0 CurrentPeriod% = 1 rsWork("Period 1") = TransAmount@ Case 0 To Period1% CurrentPeriod% = 1 rsWork("Period 1") = TransAmount@ Case Period1% To Period2% CurrentPeriod% = 2 rsWork("Period 2") = TransAmount@ Case Period2% To Period3% CurrentPeriod% = 3 rsWork("Period 3") = TransAmount@ Case Else CurrentPeriod% = 4 rsWork("Period 4") = TransAmount@ End Select rsWork("Balance") = TransAmount@ rsWork.Update Order% = Order% + 1 TotalAmount@ = TotalAmount@ + TransAmount@ Err = 0 Set rsPayments = New Recordset rsPayments.Open "SELECT * FROM [qryCustomerPayments] where [AR CROSS Payed ID] = " & rsARSale("AR SALE Document #") & " AND [AR PAY Posted YN] = 1", db, adOpenStatic, adLockOptimistic, adCmdText If rsPayments.RecordCount = 0 Then GoTo SkipAgedPayments rsPayments.MoveFirst Do While Not rsPayments.EOF If rsPayments("AR CROSS Applied Amount") >= 0.01 Then rsWork.AddNew rsWork("Customer ID") = CustomerID$ rsWork("Order") = Order% rsWork("Transaction Date") = rsPayments("AR PAY Transaction Date") rsWork("Transaction Type") = rsPayments("AR PAY Type") rsWork("Transaction ID") = rsPayments("AR PAY Check No") rsWork("Transaction Description") = "Applied to " & rsARSale("AR SALE Ext Document #") rsWork("Applied To") = rsARSale("AR SALE Ext Document #") Select Case CurrentPeriod% Case 1 rsWork("Period 1") = rsPayments("AR CROSS Applied Amount") * -1 Case 2 rsWork("Period 2") = rsPayments("AR CROSS Applied Amount") * -1 Case 3 rsWork("Period 3") = rsPayments("AR CROSS Applied Amount") * -1 Case 4 rsWork("Period 4") = rsPayments("AR CROSS Applied Amount") * -1 End Select rsWork("Balance") = rsPayments("AR CROSS Applied Amount") * -1 rsWork.Update Order% = Order% + 1 TotalAmount@ = TotalAmount@ - rsPayments("AR CROSS Applied Amount") End If If rsPayments("AR CROSS Discount Taken") >= 0.01 Then rsWork.AddNew rsWork("Customer ID") = CustomerID$ rsWork("Order") = Order% rsWork("Transaction Date") = rsPayments("AR PAY Transaction Date") rsWork("Transaction Type") = "Discount" rsWork("Transaction ID") = rsPayments("AR PAY Check No") rsWork("Transaction Description") = "Applied to " & rsARSale("AR SALE Ext Document #") rsWork("Applied To") = rsARSale("AR SALE Ext Document #") Select Case CurrentPeriod% Case 1 rsWork("Period 1") = rsPayments("AR CROSS Discount Taken") * -1 Case 2 rsWork("Period 2") = rsPayments("AR CROSS Discount Taken") * -1 Case 3 rsWork("Period 3") = rsPayments("AR CROSS Discount Taken") * -1 Case 4 rsWork("Period 4") = rsPayments("AR CROSS Discount Taken") * -1 End Select rsWork("Balance") = rsPayments("AR CROSS Discount Taken") * -1 rsWork.Update Order% = Order% + 1 TotalAmount@ = TotalAmount@ - rsPayments("AR CROSS Discount Taken") End If rsPayments.MoveNext Loop rsPayments.Close SkipAgedPayments: rsARSale.MoveNext Loop End If Err = 0 Set rsPayments = New Recordset rsPayments.Open "SELECT * FROM [qryCustomerPayments2] where [AR PAY Customer No] = '" & CustomerID$ & "' AND [AR PAY Unapplied Amount] > 0 AND [AR PAY Posted YN] = 1", db, adOpenStatic, adLockOptimistic, adCmdText If rsPayments.RecordCount = 0 Then GoTo SkipAgedPayments2 rsPayments.MoveFirst Do While Not rsPayments.EOF rsWork.AddNew rsWork("Customer ID") = CustomerID$ rsWork("Order") = Order% rsWork("Transaction Date") = rsPayments("AR PAY Transaction Date") rsWork("Transaction Type") = rsPayments("AR PAY Type") rsWork("Transaction ID") = rsPayments("AR PAY Check No") rsWork("Transaction Description") = "Unapplied" rsWork("Applied To") = "" Days& = DateDiff("d", rsWork("Transaction Date"), Now) Select Case Days& Case Is < 0 rsWork("Period 1") = rsPayments("AR PAY UnApplied Amount") * -1 Case 0 To Period1% rsWork("Period 1") = rsPayments("AR PAY UnApplied Amount") * -1 Case Period1% To Period2% rsWork("Period 2") = rsPayments("AR PAY UnApplied Amount") * -1 Case Period2% To Period3% rsWork("Period 3") = rsPayments("AR PAY UnApplied Amount") * -1 Case Else rsWork("Period 4") = rsPayments("AR PAY UnApplied Amount") * -1 End Select Balance@ = Balance@ - rsPayments("AR PAY UnApplied Amount") rsWork("Balance") = rsPayments("AR PAY UnApplied Amount") * -1 rsWork.Update Order% = Order% + 1 rsPayments.MoveNext Loop SkipAgedPayments2: rsARCustomer.MoveNext Loop On Error Resume Next rsWork.Close Set rsWork = Nothing rsPayments.Close Set rsPayments = Nothing rsCompany.Close Set rsCompany = Nothing rsARCustomer.Close Set rsARCustomer = Nothing rsARSale.Close Set rsARSale = Nothing db.Close Set db = Nothing Exit Function BuildAgedReceivables_Error: Call LogError("Sales Module", "BuildAgedReceivables", Now, Err, Error, True) Resume Next End Function ''{*********************************************************** ''-TITLE: CreateBackOrder ''-MODULE ID: 2.14 ''-PURPOSE: Creates Back Order ''-USAGE: CreateBackOrder(DocumentKey&, AskForInvoice%) ''-INPUT ASSERTION: DocumentKey&, AskForInvoice% ''-OUTPUT ASSERTION: Integer ''-CALLS: This procedure calls no other functions ''-CALLED BY: CreateBackOrder; frm_AR_Order_Entry.cmdCreateInvoice_Click ''-TABLES/FIELDS USED: "[AR Order] [SYS Recurred] [AR Order Detail] /All or Any of the Fields ''-TABLES/FIELDS AFFECTED: ''-VARIABLES: db, rs, rs2, rsDetail, rsDetail2, rsRecur, MyCounter&, MyCounter2&, x%, Count%, rsSeek, Counter%, Success%, DetailCounter& ''-METHOD: ''-REVISION HISTORY: Created before 12/01/2000, Corrected 04/07/2003 ''-REMARKS: ''***********************************************************}
Function CreateBackOrder(DocumentKey&, AskForInvoice%) As Integer Table of Contents Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open gblADOProvider Dim rs As Recordset Dim rs2 As Recordset Dim rsDetail As Recordset Dim rsDetail2 As Recordset Set rs = New Recordset Set rs2 = New Recordset rs.Open "[AR Order]", db, adOpenStatic, adLockOptimistic, adCmdTable rs2.Open "[AR Order]", db, adOpenStatic, adLockOptimistic, adCmdTable rs.MoveFirst rs.Find "[AR ORDER Document #]=" & DocumentKey& If rs.EOF Then MsgBox "Data Not Found", vbCritical, "Error" End If Dim rsRecur As Recordset Set rsRecur = New Recordset rsRecur.Open "[SYS Recurred]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim MyCounter& Dim MyCounter2& MyCounter& = DocumentKey& db.BeginTrans Dim x% Dim Count% Count% = rs2.Fields.Count rs2.AddNew For x% = 1 To Count% - 1 If IsNull(rs(x%)) = False Then If rs2(x%).Type = 202 Or rs2(x%).Type = 203 Then rs2(x%) = rs(x%) & "" Else rs2(x%) = rs(x%) End If End If Next x% If AskForInvoice% = True Then gNewInvoice$ = InputBox("Enter new order #") Else Dim rsSeek As Recordset Set rsSeek = New Recordset rsSeek.Open "[AR Order]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim Counter% Counter% = 1 Dim Success% Success% = False Do While Not Success% gNewInvoice$ = rs2("AR ORDER Ext Document #") & "-" & Trim(str(Counter%)) rsSeek.MoveFirst rsSeek.Find "[AR ORDER Ext Document #]='" & gNewInvoice$ & "'" If rsSeek.EOF Then Success% = True Else Success% = False Counter% = Counter% + 1 End If Loop End If If gNewInvoice$ = "" Then db.RollbackTrans CreateBackOrder% = 1 Exit Function End If rs2("AR ORDER Ext Document #") = gNewInvoice$ rs2("AR ORDER Document Type") = "Backorder" rs2("AR ORDER Invoiced") = False rs2("AR ORDER Date") = Date rs2("AR ORDER Recurring YN") = False rs2("AR ORDER Recur Type") = "Never" rs2("AR ORDER Posted YN") = False rs2("AR ORDER Amount Paid") = 0 rs2("AR ORDER Check Number") = "" rs2![AR ORDER Subtotal] = 0 rs2![AR ORDER Sales Tax] = 0 rs2![AR ORDER Discount Amount] = 0 rs2![AR ORDER Total] = 0 rs2.Update MyCounter2& = rs2("AR ORDER Document #") Dim DetailCounter& Set rsDetail = New Recordset rsDetail.Open "SELECT * FROM [AR Order Detail] where [AR ORDERD Document #] = " & MyCounter&, db, adOpenStatic, adLockOptimistic, adCmdText rsDetail.MoveLast rsDetail.MoveFirst If (rs.BOF And rs.EOF) Then Else Set rsDetail2 = New Recordset rsDetail2.Open "[AR Order Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable Do While Not rsDetail.EOF If rsDetail("AR ORDERD Qty") - rsDetail("AR ORDERD Qty To Invoice") > 0 Then Count% = rsDetail.Fields.Count rsDetail2.AddNew For x% = 1 To Count% - 1 If IsNull(rsDetail(x%)) = False Then If rsDetail2(x%).Type = 202 Or rsDetail2(x%).Type = 203 Then rsDetail2(x%) = rsDetail(x%) & "" Else rsDetail2(x%) = rsDetail(x%) End If End If Next x% rsDetail2("AR ORDERD Qty") = rsDetail("AR ORDERD Qty") - rsDetail("AR ORDERD Qty To Invoice") rsDetail2("AR ORDERD Qty To Invoice") = 0 rsDetail2("AR ORDERD Document #") = MyCounter2& rsDetail2![AR ORDERD Item Total] = 0 rsDetail2.Update End If rsDetail.MoveNext Loop End If SkipDetail: db.CommitTrans CreateBackOrder% = True rs.Close Set rs = Nothing rs2.Close Set rs2 = Nothing rsRecur.Close Set rsRecur = Nothing rsDetail.Close Set rsDetail = Nothing rsDetail2.Close Set rsDetail2 = Nothing rsSeek.Close Set rsSeek = Nothing db.Close Set db = Nothing Exit Function CopyFailed: db.RollbackTrans CreateBackOrder% = False rs.Close Set rs = Nothing rs2.Close Set rs2 = Nothing rsRecur.Close Set rsRecur = Nothing rsDetail.Close Set rsDetail = Nothing rsDetail2.Close Set rsDetail2 = Nothing rsSeek.Close Set rsSeek = Nothing db.Close Set db = Nothing Exit Function CreateBackorder_Error: Resume Next rs.Close Set rs = Nothing rs2.Close Set rs2 = Nothing rsRecur.Close Set rsRecur = Nothing rsDetail.Close Set rsDetail = Nothing rsDetail2.Close Set rsDetail2 = Nothing rsSeek.Close Set rsSeek = Nothing db.Close Set db = Nothing End Function ''{*********************************************************** ''-TITLE: GetARInvoiceDiscount ''-MODULE ID: 2.14 ''-PURPOSE: Gets AR Invoice Discount ''-USAGE: GetARInvoiceDiscount(InvoiceID&, vntInDate As Variant, FromInvoice%) ''-INPUT ASSERTION: InvoiceID&, vntInDate As Variant, FromInvoice% ''-OUTPUT ASSERTION: ''-CALLS: LogError ''-CALLED BY: GetARInvoiceDiscount; frm_AP_Cash_Payments.RebuildTable; frm_AR_Cash_Receipts.RebuildTable ''-TABLES/FIELDS USED: "[AR Sales] "[List Payment Terms] /All or Any of the Fields ''-TABLES/FIELDS AFFECTED: ''-VARIABLES: ReferNo&, vntInvoiceDate, PaymentTerms$, Discount#, DiscountDays#, Diff%, DiscountAmount@, vntDate, db, rsSales, rsTerms ''-METHOD: ''-REVISION HISTORY: Created before 12/01/2000, Corrected 04/07/2003 ''-REMARKS: ''***********************************************************}
Function GetARInvoiceDiscount(InvoiceID&, vntInDate As Variant, FromInvoice%) Table of Contents Dim ReferNo& Dim vntInvoiceDate As Variant Dim PaymentTerms$ Dim Discount# Dim DiscountDays# Dim Diff% Dim DiscountAmount@ Dim vntDate As Variant vntDate = vntInDate Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open gblADOProvider Dim rsSales As Recordset Set rsSales = New Recordset rsSales.Open "[AR Sales]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim rsTerms As Recordset Set rsTerms = New Recordset rsTerms.Open "[List Payment Terms]", db, adOpenStatic, adLockOptimistic, adCmdTable rsSales.MoveFirst rsSales.Find "[AR SALE Document #]=" & InvoiceID& If rsSales.EOF = True Then GetARInvoiceDiscount = 0# Exit Function Else If IsNull(vntDate) Then vntDate = DateValue(format(Now, "Short Date")) If IsDate(vntDate) Then Else vntDate = DateValue(format(Now, "Short Date")) End If vntInvoiceDate = rsSales("AR SALE Date") PaymentTerms$ = NZ(rsSales("AR Sale Payment Terms")) rsTerms.MoveFirst rsTerms.Find "[LIST PAY Description]='" & PaymentTerms$ & "'" If rsTerms.EOF = True Then GetARInvoiceDiscount = 0# Exit Function Else Discount# = rsTerms("LIST PAY Discount") If Discount# = 0 Then GetARInvoiceDiscount = 0# Exit Function Else Discount# = Discount# / 100 End If DiscountDays# = rsTerms("LIST PAY Discount Days") Diff% = DateDiff("d", vntInvoiceDate, vntDate) If Diff% <= DiscountDays# Then DiscountAmount@ = rsSales("AR SALE Total") * Discount# GetARInvoiceDiscount = Round(CDbl(DiscountAmount@)) Else GetARInvoiceDiscount = 0# End If End If End If rsSales.Close Set rsSales = Nothing rsTerms.Close Set rsTerms = Nothing db.Close Set db = Nothing Exit Function GetARInvoiceDiscount_Error: Call LogError("Sales Module", "GetARInvoiceDiscount", Now, Err, Error, True) Resume Next rsSales.Close Set rsSales = Nothing rsTerms.Close Set rsTerms = Nothing db.Close Set db = Nothing End Function ''{*********************************************************** ''-TITLE: MonthEndSales ''-MODULE ID: 2.14 ''-PURPOSE: Displays Month End Sales ''-USAGE: MonthEndSales() ''-INPUT ASSERTION: ''-OUTPUT ASSERTION: ''-CALLS: LogError ''-CALLED BY: MonthEndSales; frm_MonthEnd.Command4_Click ''-TABLES/FIELDS USED: [AR Sales] [AR PAYMENT Header] /All or Any of the Fields ''-TABLES/FIELDS AFFECTED: ''-VARIABLES: db, rs, rs2 ''-METHOD: ''-REVISION HISTORY: Created before 12/01/2000, Corrected 04/07/2003 ''-REMARKS: ''***********************************************************}
Sub MonthEndSales() Table of Contents Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open gblADOProvider Dim rs As Recordset Dim rs2 As Recordset Set rs = New Recordset rs.Open "Select * from [AR Sales] where [AR SALE Cleared] = 0 and [AR SALE Balance Due] < .01", db, adOpenStatic, adLockOptimistic, adCmdText rs.MoveFirst If Not rs.EOF Then Do While Not rs.EOF rs("AR SALE Cleared") = True rs.Update rs.MoveNext Loop End If Set rs2 = New Recordset rs2.Open "SELECT * FROM [AR PAYMENT Header] where [AR PAY Cleared] = 0 and [AR PAY Unapplied Amount] < .01", db, adOpenStatic, adLockOptimistic, adCmdText rs2.MoveFirst If Not rs2.EOF Then Do While Not rs.EOF rs2("AR PAY Cleared") = True rs2.Update rs2.MoveNext Loop End If rs.Close Set rs = Nothing rs2.Close Set rs2 = Nothing db.Close Set db = Nothing Exit Sub MonthEndSales_Error: Call LogError("Sales Module", "MonthEndSales", Now, Err, Error, True) rs.Close Set rs = Nothing rs2.Close Set rs2 = Nothing db.Close Set db = Nothing Exit Sub rs.Close Set rs = Nothing rs2.Close Set rs2 = Nothing db.Close Set db = Nothing End Sub ''{*********************************************************** ''-TITLE: PostCreditMemo ''-MODULE ID: 2.14 ''-PURPOSE: Displays Post Credit ''-USAGE: PostCreditMemo(DocumentKey&, intShowError As Integer) ''-INPUT ASSERTION: DocumentKey&, intShowError As Integer ''-OUTPUT ASSERTION: Integer ''-CALLS: VerifyPeriod, LogError ''-CALLED BY: PostCreditMemo; frm_AR_Credit_Entry.cmdPostInvoice_Click; frm_AR_Batch_Posting.cmdPost_Click ''-TABLES/FIELDS USED: "[SYS Company] "[GL Work Detail] "[AR Sales] [AR Customer] "[AR Payment Header] "[AR Payment Invoice Cross Reference] "[GL Transaction] [SYS Tax Group Detail] [AR Sales Detail] /All or Any of the Fields ''-TABLES/FIELDS AFFECTED: [GL Work Detail] /All or Any of the Fields ''-VARIABLES: msg$, title$, db, rsCompany, rsGLWorkDetail, rsSales, PostDate%, InvoiceType$, TranDate, PeriodToPost%, PeriodClosed%, cmdtemp, rsCustomer, SalesAcctDefault%, CustomerSalesAcct$, rsARPaymentHeader, rsARCross, PaymentID&, rsGLTrans, refr$, desc$, NewNumber&, GLTaxAcct$, TaxGroup$, TaxPercent#, TaxID$, rsTaxGroupDetail, Longer&, InventoryAcct$, rsDetail, Success% ''-METHOD: ''-REVISION HISTORY: Created before 12/01/2000, Corrected 04/07/2003 by Foundation Corp ''-REMARKS: ''***********************************************************}
Function PostCreditMemo(DocumentKey&, intShowError As Integer) As Integer Table of Contents Dim msg$ Dim title$ Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open gblADOProvider Dim rsCompany As Recordset Set rsCompany = New Recordset rsCompany.Open "[SYS Company]", db, adOpenStatic, adLockOptimistic, adCmdTable If rsCompany("SYS Com Sales AR Acct") = "" Or IsNull(rsCompany("SYS Com Sales AR Acct")) Or IsEmpty(rsCompany("SYS Com Sales AR Acct")) Then rsCompany.Close Set rsCompany = Nothing db.Close Set db = Nothing MsgBox "Field [SYS Com Sales AR Acct] in the table [SYS Company] is empty." & Chr(10) & Chr(10) & "Please, set [GL Sales AR Account] in Sales Setup", vbOKOnly + vbExclamation PostCreditMemo = False Exit Function End If Dim rsGLWorkDetail As Recordset Set rsGLWorkDetail = New Recordset rsGLWorkDetail.Open "[GL Work Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim rsSales As Recordset Set rsSales = New Recordset rsSales.Open "[AR Sales]", db, adOpenStatic, adLockOptimistic, adCmdTable rsSales.MoveFirst rsSales.Find "[AR SALE Document #]=" & DocumentKey& Dim PostDate% PostDate% = rsCompany("SYS COM GL Post By Date") Dim InvoiceType$ InvoiceType$ = "Credit Memo" Dim TranDate As Variant If PostDate% = 1 Then TranDate = DateValue(format(Now, "Short Date")) Else TranDate = DateValue(rsSales("AR SALE Date")) End If Dim PeriodToPost% Dim PeriodClosed% Call VerifyPeriod(TranDate, PeriodToPost%, PeriodClosed%) If PeriodClosed% = True Then MsgBox "Unable to post transaction to a closed period.", , "Post Invoice Error" GoTo UnableToPostCreditHere End If Dim cmdtemp As Recordset Set cmdtemp = New Recordset cmdtemp.Open "DELETE FROM [GL Work Detail]", db, , , adCmdText Set cmdtemp = Nothing Dim rsCustomer As Recordset Set rsCustomer = New Recordset rsCustomer.Open "SELECT * FROM [AR Customer] WHERE [AR CUST Customer ID] = '" & rsSales("AR SALE Customer ID") & "'", db, adOpenStatic, adLockOptimistic, adCmdText Dim SalesAcctDefault% Dim CustomerSalesAcct$ SalesAcctDefault% = rsCompany("SYS COM Sales Acct Default") CustomerSalesAcct$ = "" If SalesAcctDefault% = 1 Then CustomerSalesAcct$ = IIf(IsNull(rsCustomer("AR CUST Sales Account")), "", rsCustomer("AR CUST Sales Account")) End If rsCustomer.Update Dim rsARPaymentHeader As Recordset Set rsARPaymentHeader = New Recordset rsARPaymentHeader.Open "[AR Payment Header]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim rsARCross As Recordset Set rsARCross = New Recordset rsARCross.Open "[AR Payment Invoice Cross Reference]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim PaymentID& If rsSales("AR SALE Total") > 0 Then rsARPaymentHeader.AddNew rsARPaymentHeader("AR PAY Type") = "Credit Memo" rsARPaymentHeader("AR PAY Check No") = "CM " & rsSales("AR SALE Ext Document #") & "" rsARPaymentHeader("AR PAY Customer No") = rsSales("AR SALE Customer ID") & "" rsARPaymentHeader("AR PAY Transaction Date") = rsSales("AR SALE Date") rsARPaymentHeader("AR PAY Amount") = rsSales("AR SALE Total") rsARPaymentHeader("AR PAY UnApplied Amount") = rsSales("AR SALE Total") 'Cannot have unapplied amounts here rsARPaymentHeader("AR PAY Bank Account") = rsSales("AR SALE Check Acct ID") rsARPaymentHeader("AR PAY Status") = "Posted" rsARPaymentHeader("AR PAY NSF") = False rsARPaymentHeader("AR PAY Posted YN") = True rsARPaymentHeader("AR PAY Cleared") = False rsARPaymentHeader.Update PaymentID& = rsARPaymentHeader("AR PAY ID") End If Dim rsGLTrans As Recordset Set rsGLTrans = New Recordset rsGLTrans.Open "[GL Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim refr$ Dim desc$ Dim NewNumber& rsGLTrans.AddNew rsGLTrans("GL TRANS Document #") = "CREDIT MEMO " & rsSales("AR SALE Ext Document #") rsGLTrans("GL TRANS Type") = "Credit Memo" If PostDate% = 1 Then rsGLTrans("GL TRANS Date") = format(Now, "Short Date") Else rsGLTrans("GL TRANS Date") = rsSales("AR SALE Date") End If refr$ = rsSales("AR SALE Bill To") rsGLTrans("GL TRANS Reference") = refr$ rsGLTrans("GL TRANS Amount") = rsSales("AR SALE Total") rsGLTrans("GL TRANS Posted YN") = 1 desc$ = IIf(IsNull(rsSales("AR SALE Description")), "", rsSales("AR SALE Description")) If Len(Trim$(desc$)) = 0 Then desc$ = "CREDIT MEMO " & rsSales("AR SALE Ext Document #") End If rsGLTrans("GL TRANS Description") = desc$ rsGLTrans("GL TRANS Source") = "CREDIT MEMO " & rsSales("AR SALE Ext Document #") rsGLTrans("GL TRANS System Generated") = True rsGLTrans.Update NewNumber& = rsGLTrans("GL TRANS Number") ' ' If rsSales("AR SALE Total") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsCompany("SYS COM Sales AR Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = 0 rsGLWorkDetail("GW TRANSD Credit Amount") = rsSales("AR SALE Total") rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If If rsSales("AR SALE Discount Amount") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsCompany("SYS COM Sales Discount Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = 0 rsGLWorkDetail("GW TRANSD Credit Amount") = rsSales("AR SALE Discount Amount") rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If Dim GLTaxAcct$ Dim TaxGroup$ Dim TaxPercent# Dim TaxID$ If rsSales("AR SALE Sales Tax") > 0 Then GLTaxAcct$ = "" TaxGroup$ = IIf(IsNull(rsSales("AR SALE Tax Group")), rsCompany("SYS COM Sales Sales Tax"), rsSales("AR SALE Tax Group")) Dim rsTaxGroupDetail As Recordset Set rsTaxGroupDetail = New Recordset rsTaxGroupDetail.Open "SELECT * FROM [SYS Tax Group Detail] where [SYS TAXGRPD Group ID] = '" & TaxGroup$ & "'", db, adOpenStatic, adLockOptimistic, adCmdText If rsTaxGroupDetail.RecordCount = 0 Then Else rsTaxGroupDetail.MoveFirst Do While rsTaxGroupDetail.EOF = False TaxPercent# = 0 TaxID$ = rsTaxGroupDetail("SYS TAXGRPD Tax ID") TaxPercent# = DLookup("[SYS Tax Percent]", "[SYS Tax]", "[SYS Tax ID] = '" & TaxID$ & "'") GLTaxAcct$ = DLookup("[SYS Tax Account]", "[SYS Tax]", "[SYS Tax ID] = '" & TaxID$ & "'") If GLTaxAcct$ = "" Then GLTaxAcct$ = rsCompany("SYS COM Sales Sales Acct") End If rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = GLTaxAcct$ rsGLWorkDetail("GW TRANSD Debit Amount") = Round(rsSales("AR SALE Taxable Subtotal") * (TaxPercent# / 100)) rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update rsTaxGroupDetail.MoveNext Loop End If End If If rsSales("AR SALE Freight") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsCompany("SYS COM Sales Freight Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = rsSales("AR SALE Freight") rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If Dim Longer& Dim InventoryAcct$ Dim rsDetail As Recordset Set rsDetail = New Recordset Longer& = 0 rsDetail.Open "SELECT * FROM [AR Sales Detail] where [AR SALED Document #] = " & rsSales("AR SALE Document #"), db, adOpenStatic, adLockOptimistic, adCmdText If rsDetail.RecordCount = 0 Then Else rsDetail.MoveFirst Do While rsDetail.EOF = False rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsDetail("AR SALED Posting Account") rsGLWorkDetail("GW TRANSD Debit Amount") = rsDetail("AR SALED Item Total") rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update rsDetail.MoveNext Loop End If Dim Success% Success% = PostGLWorkDetail_New(db, rsGLWorkDetail, TranDate, NewNumber&) If Success% = False Then MsgBox "An error occurred writing GL Transaction!", , "Error" PostCreditMemo = False Exit Function End If PostCreditMemo_Exit: PostCreditMemo = True rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsDetail.Close Set rsDetail = Nothing Set rsTaxGroupDetail = Nothing rsGLTrans.Close Set rsGLTrans = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing rsARPaymentHeader.Close Set rsARPaymentHeader = Nothing rsARCross.Close Set rsARCross = Nothing rsCustomer.Close Set rsCustomer = Nothing Set rsCompany = Nothing db.Close Set db = Nothing Exit Function PostCreditMemo_Error: Call LogError("Sales Module", "PostCreditMemo", Now, Err, Error, intShowError) PostCreditMemo = False rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsDetail.Close Set rsDetail = Nothing rsTaxGroupDetail.Close Set rsTaxGroupDetail = Nothing rsGLTrans.Close Set rsGLTrans = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing rsARPaymentHeader.Close Set rsARPaymentHeader = Nothing rsARCross.Close Set rsARCross = Nothing rsCustomer.Close Set rsCustomer = Nothing rsCompany.Close Set rsCompany = Nothing db.Close Set db = Nothing Exit Function UnableToPostCreditHere: PostCreditMemo = False rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing If Not rsDetail Is Nothing Then rsDetail.Close Set rsDetail = Nothing End If If Not rsTaxGroupDetail Is Nothing Then rsTaxGroupDetail.Close Set rsTaxGroupDetail = Nothing End If If Not rsGLTrans Is Nothing Then rsGLTrans.Close Set rsGLTrans = Nothing End If rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing If Not rsARPaymentHeader Is Nothing Then rsARPaymentHeader.Close Set rsARPaymentHeader = Nothing End If If Not rsARCross Is Nothing Then rsARCross.Close Set rsARCross = Nothing End If If Not rsCustomer Is Nothing Then rsCustomer.Close Set rsCustomer = Nothing End If If Not rsCompany Is Nothing Then rsCompany.Close Set rsCompany = Nothing End If db.Close Set db = Nothing Exit Function rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsDetail.Close Set rsDetail = Nothing rsTaxGroupDetail.Close Set rsTaxGroupDetail = Nothing rsGLTrans.Close Set rsGLTrans = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing rsARPaymentHeader.Close Set rsARPaymentHeader = Nothing rsARCross.Close Set rsARCross = Nothing rsCustomer.Close Set rsCustomer = Nothing rsCompany.Close Set rsCompany = Nothing db.Close Set db = Nothing End Function ''{*********************************************************** ''-TITLE: PostInvoice ''-MODULE ID: 2.14 ''-PURPOSE: Posts Invoice ''-USAGE: PostInvoice(DocumentKey&, intShowError As Integer) ''-INPUT ASSERTION: DocumentKey&, intShowError As Integer ''-OUTPUT ASSERTION: Integer ''-CALLS: VerifyPeriod, LogError ''-CALLED BY: PostInvoice; frm_AR_Order_Entry.cmdCreateInvoice_Click; frm_AR_Sales_Entry.cmdPostInvoice_Click; frm_AR_Batch_Posting.cmdPost_Click ''-TABLES/FIELDS USED: "[SYS Company] "[GL Work Detail] "[AR Sales] [AR Customer] "[AR Payment Header] "[AR Payment Invoice Cross Reference] "[INV Items] [AR Sales Detail] "[GL Transaction] [SYS Tax Group Detail] /All or Any of the Fields ''-TABLES/FIELDS AFFECTED: [GL Work Detail] /All or Any of the Fields ''-VARIABLES: msg$, title$, db, rsCompany, rsGLWorkDetail, rsSales, PostDate%, InvoiceType$, TranDate, PeriodToPost%, PeriodClosed%, cmdtemp, BankKey$, AppliedAmount@, rsCustomer, SalesAcctDefault%, CustomerSalesAcct$, CurrentBalance@, PaymentID&, rsARPaymentHeader, rsARCross, rsInventory, rsDetail, QtySold#, CostMethod%, ItemCost#, rsGLTrans, refr$, desc$, NewNumber&, Longer&, InventoryAcct$, GLTaxAcct$, TaxGroup$, TaxPercent#, TaxID$, Taxtotal#, rsTaxGroupDetail, COGS@, InventoryCost@, COGSAccount$, TempCost#, Success%, n ''-METHOD: ''-REVISION HISTORY: Created before 12/01/2000, Corrected 04/07/2003 ''-REMARKS: ''***********************************************************}
Function PostInvoice(DocumentKey&, intShowError As Integer) As Integer Table of Contents On Error GoTo PostInvoice_Error Dim msg$ Dim title$ Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open gblADOProvider Dim rsCompany As Recordset Set rsCompany = New Recordset rsCompany.Open "[SYS Company]", db, adOpenStatic, adLockOptimistic, adCmdTable rsCompany.MoveFirst Dim rsGLWorkDetail As Recordset Set rsGLWorkDetail = New Recordset rsGLWorkDetail.Open "[GL Work Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim rsSales As Recordset Set rsSales = New Recordset rsSales.Open "[AR Sales]", db, adOpenStatic, adLockOptimistic, adCmdTable rsSales.MoveFirst rsSales.Find "[AR SALE Document #]=" & DocumentKey& Dim PostDate% PostDate% = rsCompany("SYS COM GL Post By Date") Dim InvoiceType$ InvoiceType$ = rsSales("AR SALE Document Type") Dim TranDate As Variant If PostDate% = 1 Then TranDate = DateValue(format(Now, "Short Date")) Else TranDate = DateValue(rsSales("AR SALE Date")) End If Dim PeriodToPost% Dim PeriodClosed% Call VerifyPeriod(TranDate, PeriodToPost%, PeriodClosed%) If PeriodClosed% = True Then MsgBox "Unable to post transaction to a closed period.", , "Post Invoice Error" GoTo UnableToPostHere End If Dim cmdtemp As Recordset Set cmdtemp = New Recordset cmdtemp.Open "DELETE FROM [GL Work Detail]", db, , , adCmdText Set cmdtemp = Nothing Dim BankKey$ BankKey$ = IIf(IsNull(rsSales("AR SALE Check Acct ID")), "", rsSales("AR SALE Check Acct ID")) Dim AppliedAmount@ If IsNull(rsSales("AR SALE Amount Paid")) Then AppliedAmount@ = 0 Else AppliedAmount@ = rsSales("AR SALE Amount Paid") End If Dim rsCustomer As Recordset Set rsCustomer = New Recordset rsCustomer.Open "SELECT * FROM [AR Customer] WHERE [AR CUST Customer ID] = '" & rsSales("AR SALE Customer ID") & "'", db, adOpenStatic, adLockOptimistic, adCmdText Dim SalesAcctDefault% Dim CustomerSalesAcct$ Dim CurrentBalance@ SalesAcctDefault% = rsCompany("SYS COM Sales Acct Default") CustomerSalesAcct$ = "" If SalesAcctDefault% = 1 Then CustomerSalesAcct$ = IIf(IsNull(rsCustomer("AR CUST Sales Account")), "", rsCustomer("AR CUST Sales Account")) End If rsCustomer("AR CUST Payments YTD") = rsCustomer("AR CUST Payments YTD") + rsSales("AR SALE Amount Paid") rsCustomer("AR CUST Payments Lifetime") = rsCustomer("AR CUST Payments Lifetime") + rsSales("AR SALE Amount Paid") rsCustomer("AR CUST Sales YTD") = rsCustomer("AR CUST Sales YTD") + rsSales("AR SALE Total") rsCustomer("AR CUST Sales Lifetime") = rsCustomer("AR CUST Sales Lifetime") + rsSales("AR SALE Total") rsCustomer("AR CUST Invoices Lifetime") = rsCustomer("AR CUST Invoices Lifetime") + 1 rsCustomer("AR CUST Invoices YTD") = rsCustomer("AR CUST Invoices YTD") + 1 If rsSales("AR SALE Total") - rsSales("AR SALE Amount Paid") > 0 Then CurrentBalance@ = IIf(IsNull(rsCustomer("AR CUST Financial Period 1")), 0, rsCustomer("AR CUST Financial Period 1")) CurrentBalance@ = CurrentBalance@ + (rsSales("AR SALE Total") - rsSales("AR SALE Amount Paid")) rsCustomer("AR CUST Financial Period 1") = CurrentBalance@ If CurrentBalance@ > IIf(IsNull(rsCustomer("AR CUST Highest Balance")), 0, rsCustomer("AR CUST Highest Balance")) Then rsCustomer("AR CUST Highest Balance") = CurrentBalance@ End If rsCustomer.Update Dim PaymentID& If AppliedAmount@ > 0 Then Dim rsARPaymentHeader As Recordset Set rsARPaymentHeader = New Recordset rsARPaymentHeader.Open "[AR Payment Header]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim rsARCross As Recordset rsARPaymentHeader.AddNew rsARPaymentHeader("AR PAY Type") = "Payment" rsARPaymentHeader("AR PAY Check No") = CStr(rsSales("AR SALE Check Number")) rsARPaymentHeader("AR PAY Customer No") = CStr(rsSales("AR SALE Customer ID")) rsARPaymentHeader("AR PAY Transaction Date") = rsSales("AR SALE Date") rsARPaymentHeader("AR PAY Amount") = rsSales("AR SALE Amount Paid") rsARPaymentHeader("AR PAY UnApplied Amount") = 0 'Cannot have unapplied amounts here rsARPaymentHeader("AR PAY Bank Account") = BankKey$ rsARPaymentHeader("AR PAY Status") = "Posted" rsARPaymentHeader("AR PAY Posted YN") = True rsARPaymentHeader("AR PAY NSF") = False rsARPaymentHeader("AR PAY Cleared") = False rsARPaymentHeader.Update rsARPaymentHeader.Requery '<<<----- do we need this with adUseClient existance rsARPaymentHeader.MoveLast PaymentID& = rsARPaymentHeader("AR PAY ID") Set rsARCross = New Recordset rsARCross.Open "[AR Payment Invoice Cross Reference]", db, adOpenStatic, adLockOptimistic, adCmdTable rsARCross.AddNew rsARCross("AR CROSS Payment ID") = PaymentID& rsARCross("AR CROSS Payed ID") = rsSales("AR SALE Document #") rsARCross("AR CROSS Discount Taken") = 0 rsARCross("AR CROSS Write Off Amount") = 0 rsARCross("AR CROSS Applied Amount") = AppliedAmount@ rsARCross("AR CROSS Cleared") = False rsARCross.Update End If Dim rsInventory As Recordset Dim rsDetail As Recordset Set rsInventory = New Recordset rsInventory.Open "[INV Items]", db, adOpenStatic, adLockOptimistic, adCmdTable Set rsDetail = New Recordset rsDetail.Open "SELECT * FROM [AR Sales Detail] where [AR SALED Document #] = " & rsSales("AR SALE Document #"), db, adOpenStatic, adLockOptimistic, adCmdText rsDetail.MoveLast rsDetail.MoveFirst Dim QtySold# Dim CostMethod% CostMethod% = rsCompany("SYS COM Inventory Cost Method Last YN") If rsDetail.RecordCount = 0 Then Else Do While rsDetail.EOF = False rsInventory.MoveFirst rsInventory.Find "[INV ITEM Id] ='" & rsDetail("AR SALED Item ID") & "'" If rsInventory.EOF = True Then Else Dim ItemCost# ItemCost# = 0 If CostMethod% = 0 Then ItemCost# = IIf(IsNull(rsInventory("INV ITEM Average Cost")), 0, rsInventory("INV ITEM Average Cost")) If ItemCost# = 0 Then ItemCost# = IIf(IsNull(rsInventory("INV ITEM Standard Cost")), 0, rsInventory("INV ITEM Standard Cost")) End If Else ItemCost# = IIf(IsNull(rsInventory("INV ITEM Standard Cost")), 0, rsInventory("INV ITEM Standard Cost")) If ItemCost# = 0 Then ItemCost# = IIf(IsNull(rsInventory("INV ITEM Average Cost")), 0, rsInventory("INV ITEM Average Cost")) End If End If rsDetail("AR SALED Item Cost") = ItemCost# rsDetail.Update QtySold# = rsDetail("AR SALED Qty") * GetUOMMultiplier(rsDetail("AR SALED Item ID"), rsDetail("AR SALED Units")) rsInventory("INV ITEM Qty On Hand") = rsInventory("INV ITEM Qty On Hand") - QtySold# rsInventory.Update End If rsDetail.MoveNext If Err = 3021 Then Exit Do Loop End If Dim rsGLTrans As Recordset Set rsGLTrans = New Recordset rsGLTrans.Open "[GL Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim refr$ Dim desc$ Dim NewNumber& rsGLTrans.AddNew rsGLTrans("GL TRANS Document #") = "INV " & rsSales("AR SALE Ext Document #") If rsSales("AR SALE Document Type") = "Service Invoice" Then rsGLTrans("GL TRANS Type") = "SERINV" Else rsGLTrans("GL TRANS Type") = "Invoice" End If If PostDate% = 1 Then rsGLTrans("GL TRANS Date") = format(Now, "Short Date") Else rsGLTrans("GL TRANS Date") = rsSales("AR SALE Date") End If refr$ = rsSales("AR SALE Bill To") rsGLTrans("GL TRANS Reference") = refr$ rsGLTrans("GL TRANS Amount") = rsSales("AR SALE Total") rsGLTrans("GL TRANS Posted YN") = 1 desc$ = IIf(IsNull(rsSales("AR SALE Description")), "", rsSales("AR SALE Description")) If Len(Trim$(desc$)) = 0 Then desc$ = "INV " & rsSales("AR SALE Ext Document #") End If rsGLTrans("GL TRANS Description") = desc$ rsGLTrans("GL TRANS Source") = "INV " & rsSales("AR SALE Ext Document #") rsGLTrans("GL TRANS System Generated") = True rsGLTrans.Update NewNumber& = rsGLTrans("GL TRANS Number") ' ' If rsSales("AR SALE Total") - rsSales("AR SALE Amount Paid") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = CStr(rsCompany("SYS COM Sales AR Acct")) rsGLWorkDetail("GW TRANSD Debit Amount") = rsSales("AR SALE Total") - rsSales("AR SALE Amount Paid") rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If If rsSales("AR SALE Amount Paid") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = BankKey$ rsGLWorkDetail("GW TRANSD Debit Amount") = rsSales("AR SALE Amount Paid") rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If If rsSales("AR SALE Discount Amount") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsCompany("SYS COM Sales Discount Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = rsSales("AR SALE Discount Amount") rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If Dim Longer& Dim InventoryAcct$ If SalesAcctDefault% = 1 Then If CustomerSalesAcct$ = "" Then ' if no acct then use CustomerSalesAcct$ = rsCompany("SYS COM Sales Sales Acct") End If rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = CustomerSalesAcct$ rsGLWorkDetail("GW TRANSD Debit Amount") = 0 rsGLWorkDetail("GW TRANSD Credit Amount") = rsSales("AR SALE SubTotal") rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update Else Longer& = 0 If rsDetail.RecordCount = 0 Then Else rsDetail.MoveFirst Do While rsDetail.EOF = False InventoryAcct$ = NZ(rsDetail("AR SALED Posting Account")) If InventoryAcct$ = "" Then If rsDetail("AR SALED Row Type") = "N" Then ' process non-stock InventoryAcct$ = rsCompany("SYS COM Sales Misc Acct") Else rsInventory.MoveFirst rsInventory.Find "[INV ITEM Id]='" & rsDetail("AR SALED Item ID") & "'" If rsInventory.EOF = True Then InventoryAcct$ = rsCompany("SYS COM Sales Sales Acct") Else InventoryAcct$ = IIf(IsNull(rsInventory("INV ITEM Sales Account")), rsCompany("SYS COM Sales Sales Acct"), rsInventory("INV ITEM Sales Account")) End If End If End If rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = InventoryAcct$ rsGLWorkDetail("GW TRANSD Debit Amount") = 0 rsGLWorkDetail("GW TRANSD Credit Amount") = rsDetail("AR SALED Item Total") rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update rsDetail.MoveNext Loop End If End If Dim GLTaxAcct$ Dim TaxGroup$ Dim TaxPercent# Dim TaxID$ Dim Taxtotal# If rsSales("AR SALE Sales Tax") > 0 Then GLTaxAcct$ = "" TaxGroup$ = IIf(IsNull(rsSales("AR SALE Tax Group")), rsCompany("SYS COM Sales Sales Tax"), rsSales("AR SALE Tax Group")) Dim rsTaxGroupDetail As Recordset Set rsTaxGroupDetail = New Recordset rsTaxGroupDetail.Open "SELECT * FROM [SYS Tax Group Detail] where [SYS TAXGRPD Group ID] = '" & TaxGroup$ & "'", db, adOpenStatic, adLockOptimistic, adCmdText rsTaxGroupDetail.MoveLast rsTaxGroupDetail.MoveFirst If rsTaxGroupDetail.RecordCount = 0 Then Else Do While rsTaxGroupDetail.EOF = False TaxPercent# = 0 TaxID$ = rsTaxGroupDetail("SYS TAXGRPD Tax ID") TaxPercent# = DLookup("[SYS Tax Percent]", "[SYS Tax]", "[SYS Tax ID] = '" & TaxID$ & "'") GLTaxAcct$ = NZ(DLookup("[SYS Tax Account]", "[SYS Tax]", "[SYS Tax ID] = '" & TaxID$ & "'")) If GLTaxAcct$ = "" Then GLTaxAcct$ = rsCompany("SYS COM Sales Sales Acct") End If rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = GLTaxAcct$ rsGLWorkDetail("GW TRANSD Debit Amount") = 0 Taxtotal# = Round(rsSales("AR SALE Taxable Subtotal") * (TaxPercent# / 100)) rsGLWorkDetail("GW TRANSD Credit Amount") = Round(Taxtotal#) rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update rsTaxGroupDetail.MoveNext Loop End If End If If rsSales("AR SALE Freight") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsCompany("SYS COM Sales Freight Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = 0 rsGLWorkDetail("GW TRANSD Credit Amount") = rsSales("AR SALE Freight") rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If ' ' Dim COGS@ Dim InventoryCost@ Dim COGSAccount$ COGS@ = 0 Longer& = 0 If rsDetail.RecordCount = 0 Then Else rsDetail.MoveFirst Do While rsDetail.EOF = False InventoryAcct$ = "" COGSAccount$ = "" InventoryCost@ = 0 If rsDetail("AR SALED Row Type") = "N" Then ' process non-stock InventoryAcct$ = rsCompany("SYS COM Sales Misc Acct") COGSAccount$ = rsCompany("SYS COM Sales COGS Acct") Else rsInventory.MoveFirst rsInventory.Find "[INV ITEM Id]='" & rsDetail("AR SALED Item ID") & "'" If rsInventory.EOF = True Then InventoryAcct$ = rsCompany("SYS COM Sales Inventory Acct") COGSAccount$ = rsCompany("SYS COM Sales COGS Acct") Else InventoryAcct$ = IIf(IsNull(rsInventory("INV ITEM Inventory Account")), rsCompany("SYS COM Sales Inventory Acct"), rsInventory("INV ITEM Inventory Account")) COGSAccount$ = IIf(IsNull(rsInventory("INV ITEM Cost Of Sales Account")), rsCompany("SYS COM Sales COGS Acct"), rsInventory("INV ITEM Cost Of Sales Account")) InventoryCost@ = IIf(IsNull(rsInventory("INV ITEM Average Cost")), 0, rsInventory("INV ITEM Average Cost")) End If End If If InventoryCost@ = 0 Then InventoryCost@ = IIf(IsNull(rsDetail("AR SALED Item Cost")), 0, rsDetail("AR SALED Item Cost")) Dim TempCost# TempCost# = InventoryCost@ InventoryCost@ = Round(TempCost#) If rsDetail("AR SALED Row Type") = "N" Then QtySold# = rsDetail("AR SALED Qty") Else QtySold# = rsDetail("AR SALED Qty") * GetUOMMultiplier(rsDetail("AR SALED Item ID"), rsDetail("AR SALED Units")) End If InventoryCost@ = InventoryCost@ * QtySold# 'tbARSalesDetail("AR SALED Qty") InventoryCost@ = DropAllBut2(InventoryCost@) If InventoryCost@ = 0 Then Else COGS@ = COGS@ + InventoryCost@ rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = InventoryAcct$ rsGLWorkDetail("GW TRANSD Debit Amount") = 0 rsGLWorkDetail("GW TRANSD Credit Amount") = InventoryCost@ rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = COGSAccount$ 'rsCompany("SYS COM Sales COGS Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = InventoryCost@ rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If rsDetail.MoveNext Loop End If Dim Success% Dim n n = rsGLWorkDetail.RecordCount Success% = PostGLWorkDetail_New(db, rsGLWorkDetail, TranDate, NewNumber&) If Success% = False Then MsgBox "An error occurred writing GL Transaction!", , "Error" PostInvoice = False Exit Function End If PostInvoice_Exit: PostInvoice = True rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsDetail.Close Set rsDetail = Nothing Set rsTaxGroupDetail = Nothing rsGLTrans.Close Set rsGLTrans = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing Set rsARPaymentHeader = Nothing Set rsARCross = Nothing rsCustomer.Close Set rsCustomer = Nothing Set rsCompany = Nothing rsInventory.Close Set rsInventory = Nothing db.Close Set db = Nothing Exit Function PostInvoice_Error: If Err.Number = -2147217887 Then MsgBox "In your database already exist same record or you did try before post this record!!!" Screen.MousePointer = vbNormal PostInvoice = True GoTo nextline: End If Call LogError("Sales Module", "PostInvoice", Now, Err, Error, intShowError) PostInvoice = False Resume Next nextline: rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsDetail.Close Set rsDetail = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing rsCustomer.Close Set rsCustomer = Nothing rsInventory.Close Set rsInventory = Nothing db.Close Set db = Nothing Exit Function UnableToPostHere: PostInvoice = False rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing db.Close Set db = Nothing Exit Function rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsDetail.Close Set rsDetail = Nothing rsTaxGroupDetail.Close Set rsTaxGroupDetail = Nothing rsGLTrans.Close Set rsGLTrans = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing rsARPaymentHeader.Close Set rsARPaymentHeader = Nothing rsARCross.Close Set rsARCross = Nothing rsCustomer.Close Set rsCustomer = Nothing rsCompany.Close Set rsCompany = Nothing rsInventory.Close Set rsInventory = Nothing db.Close Set db = Nothing End Function ''{*********************************************************** ''-TITLE: PostReturn ''-MODULE ID: 2.14 ''-PURPOSE: Posts Return ''-USAGE: PostReturn(DocumentKey&, intShowError As Integer) ''-INPUT ASSERTION: DocumentKey&, intShowError As Integer ''-OUTPUT ASSERTION: Integer ''-CALLS: VerifyPeriod, LogError ''-CALLED BY: PostReturn; frm_AR_Return_Entry.cmdPostInvoice_Click; frm_AR_Batch_Posting.cmdPost_Click ''-TABLES/FIELDS USED: "[SYS Company] "[GL Work Detail] "[AR Sales] [AR Customer] "[INV Items] [AR Sales Detail] "[AR Payment Header] "[AR Payment Invoice Cross Reference] "[GL Transaction] [SYS TAX Group Detail] /All or Any of the Fields ''-TABLES/FIELDS AFFECTED: [GL Work Detail] /All or Any of the Fields ''-VARIABLES: msg$, title$, db, rsCompany, rsGLWorkDetail, rsSales, PostDate%, InvoiceType$, TranDate, PeriodToPost%, PeriodClosed%, rsCustomer, SalesAcctDefault%, CustomerSalesAcct$, CurrentBalance@, rsInventory, rsDetail, QtySold#, CostMethod%, ItemCost#, PaymentID&, rsARPaymentHeader, rsARCross, rsGLTrans, refr$, desc$, NewNumber&, TotalTaxPercent#, GLTaxAcct$, TaxGroup$, TaxID$, TaxPercent#, rsTaxGroupDetail, COGS@, InventoryCost@, COGSAccount$, InventoryAcct$, TempCost#, Success% ''-METHOD: ''-REVISION HISTORY: Created before 12/01/2000, Corrected 04/07/2003 ''-REMARKS: ''***********************************************************}
Function PostReturn(DocumentKey&, intShowError As Integer) As Integer Table of Contents Dim msg$ Dim title$ Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open gblADOProvider Dim rsCompany As Recordset Set rsCompany = New Recordset rsCompany.Open "[SYS Company]", db, adOpenStatic, adLockOptimistic, adCmdTable If rsCompany("SYS Com Sales return Acct") = "" Or IsNull(rsCompany("SYS Com Sales return Acct")) Or IsEmpty(rsCompany("SYS Com Sales return Acct")) Then rsCompany.Close Set rsCompany = Nothing db.Close Set db = Nothing MsgBox "Field [SYS Com Sales Return Acct] in the table [SYS Company] is empty." & Chr(10) & Chr(10) & "Please, set [GL Sales Return] in Sales Setup", vbOKOnly + vbExclamation PostReturn = False Exit Function End If rsCompany.MoveFirst Dim rsGLWorkDetail As Recordset Set rsGLWorkDetail = New Recordset rsGLWorkDetail.Open "[GL Work Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim rsSales As Recordset Set rsSales = New Recordset rsSales.Open "[AR Sales]", db, adOpenStatic, adLockOptimistic, adCmdTable rsSales.MoveFirst rsSales.Find "[AR SALE Document #]='" & DocumentKey& & "'" Dim PostDate% PostDate% = rsCompany![SYS COM GL Post By Date] Dim InvoiceType$ InvoiceType$ = "Return" Dim TranDate As Variant If PostDate% = 1 Then TranDate = DateValue(format(Now, "Short Date")) Else TranDate = DateValue(rsSales![AR SALE Date]) End If Dim PeriodToPost% Dim PeriodClosed% Call VerifyPeriod(TranDate, PeriodToPost%, PeriodClosed%) If PeriodClosed% = True Then MsgBox "Unable to post transaction to a closed period.", , "Post Return Error" GoTo UnableToPostReturnHere Exit Function End If db.Execute "DELETE FROM [GL Work Detail]" Dim rsCustomer As Recordset Set rsCustomer = New Recordset rsCustomer.Open "SELECT * FROM [AR Customer] where [AR CUST Customer ID] = '" & rsSales![AR SALE Customer ID] & "'", db, adOpenStatic, adLockOptimistic, adCmdText Dim SalesAcctDefault% Dim CustomerSalesAcct$ SalesAcctDefault% = rsCompany![SYS COM Sales Acct Default] CustomerSalesAcct$ = "" If SalesAcctDefault% = 1 Then CustomerSalesAcct$ = IIf(IsNull(rsCustomer![AR CUST Sales Account]), "", rsCustomer![AR CUST Sales Account]) End If Dim CurrentBalance@ rsCustomer![AR CUST Sales YTD] = rsCustomer![AR CUST Sales YTD] - rsSales![AR SALE Total] rsCustomer![AR CUST Sales Lifetime] = rsCustomer![AR CUST Sales Lifetime] - rsSales![AR SALE Total] CurrentBalance@ = IIf(IsNull(rsCustomer![AR CUST Financial Period 1]), 0, rsCustomer![AR CUST Financial Period 1]) CurrentBalance@ = CurrentBalance@ - rsSales![AR SALE Total] rsCustomer![AR CUST Financial Period 1] = CurrentBalance@ rsCustomer.Update Dim rsInventory As Recordset Dim rsDetail As Recordset Set rsInventory = New Recordset Set rsDetail = New Recordset rsInventory.Open "[INV Items]", db, adOpenStatic, adLockOptimistic, adCmdTable rsDetail.Open "SELECT * FROM [AR Sales Detail] where [AR SALED Document #] = " & rsSales![AR SALE Document #], db, adOpenStatic, adLockOptimistic, adCmdText rsDetail.MoveFirst Dim QtySold# Dim CostMethod% If rsDetail.RecordCount = 0 Then Else Do While Not rsDetail.EOF rsInventory.MoveFirst rsInventory.Find "[INV ITEM Id]='" & rsDetail![AR SALED Item ID] & "'" If rsInventory.EOF = True Then Else Dim ItemCost# ItemCost# = 0 If CostMethod% = 0 Then ItemCost# = IIf(IsNull(rsInventory("INV ITEM Average Cost")), 0, rsInventory("INV ITEM Average Cost")) If ItemCost# = 0 Then ItemCost# = IIf(IsNull(rsInventory("INV ITEM Standard Cost")), 0, rsInventory("INV ITEM Standard Cost")) End If Else ItemCost# = IIf(IsNull(rsInventory("INV ITEM Standard Cost")), 0, rsInventory("INV ITEM Standard Cost")) If ItemCost# = 0 Then ItemCost# = IIf(IsNull(rsInventory("INV ITEM Average Cost")), 0, rsInventory("INV ITEM Average Cost")) End If End If rsDetail("AR SALED Item Cost") = ItemCost# rsDetail.Update QtySold# = rsDetail("AR SALED Qty") * GetUOMMultiplier(rsDetail("AR SALED Item ID"), rsDetail("AR SALED Units")) rsInventory("INV ITEM Qty On Hand") = rsInventory("INV ITEM Qty On Hand") + QtySold# 'tbARSalesDetail("AR SALED Qty") rsInventory.Update End If rsDetail.MoveNext Loop End If Dim PaymentID& Dim rsARPaymentHeader As Recordset Set rsARPaymentHeader = New Recordset rsARPaymentHeader.Open "[AR Payment Header]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim rsARCross As Recordset Set rsARCross = New Recordset rsARCross.Open "[AR Payment Invoice Cross Reference]", db, adOpenStatic, adLockOptimistic, adCmdTable rsARPaymentHeader.AddNew rsARPaymentHeader("AR PAY Type") = "Return" rsARPaymentHeader("AR PAY Check No") = "RET " & rsSales("AR SALE Ext Document #") rsARPaymentHeader("AR PAY Customer No") = rsSales("AR SALE Customer ID") & "" rsARPaymentHeader("AR PAY Transaction Date") = rsSales("AR SALE Date") rsARPaymentHeader("AR PAY Amount") = rsSales("AR SALE Total") rsARPaymentHeader("AR PAY UnApplied Amount") = rsSales("AR SALE Total") 'Cannot have unapplied amounts here rsARPaymentHeader("AR PAY Bank Account") = "None" rsARPaymentHeader("AR PAY Status") = "Posted" rsARPaymentHeader("AR PAY NSF") = False rsARPaymentHeader("AR PAY Posted YN") = True rsARPaymentHeader("AR PAY Cleared") = False rsARPaymentHeader.Update PaymentID& = rsARPaymentHeader("AR PAY ID") Dim rsGLTrans As Recordset Set rsGLTrans = New Recordset rsGLTrans.Open "[GL Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim refr$ Dim desc$ Dim NewNumber& rsGLTrans.AddNew rsGLTrans("GL TRANS Document #") = "RET " & rsSales("AR SALE Ext Document #") rsGLTrans("GL TRANS Type") = "Return" If PostDate% = 1 Then rsGLTrans("GL TRANS Date") = format(Now, "Short Date") Else rsGLTrans("GL TRANS Date") = rsSales("AR SALE Date") End If refr$ = rsSales("AR SALE Bill To") rsGLTrans("GL TRANS Reference") = refr$ rsGLTrans("GL TRANS Amount") = rsSales("AR SALE Total") rsGLTrans("GL TRANS Posted YN") = True desc$ = IIf(IsNull(rsSales("AR SALE Description")), "", rsSales("AR SALE Description")) If Len(Trim$(desc$)) = 0 Then desc$ = "RET " & rsSales("AR SALE Ext Document #") End If rsGLTrans("GL TRANS Description") = desc$ rsGLTrans("GL TRANS Source") = "RET " & rsSales("AR SALE Ext Document #") rsGLTrans.Update NewNumber& = rsGLTrans("GL TRANS Number") ' ' rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsCompany("SYS COM Sales Return Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = rsSales("AR SALE SubTotal") rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update Dim TotalTaxPercent# Dim GLTaxAcct$ Dim TaxGroup$ Dim TaxID$ Dim TaxPercent# If rsSales("AR SALE Sales Tax") > 0 Then TotalTaxPercent# = 0 GLTaxAcct$ = "" TaxGroup$ = IIf(IsNull(rsSales("AR SALE Tax Group")), rsCompany("SYS COM Sales Sales Tax"), rsSales("AR SALE Tax Group")) Dim rsTaxGroupDetail As New Recordset rsTaxGroupDetail.Open "SELECT * FROM [SYS TAX Group Detail] where [SYS TAXGRPD Group ID] = '" & TaxGroup$ & "'", db, adOpenStatic, adLockOptimistic, adCmdText If rsTaxGroupDetail.RecordCount = 0 Then Else rsTaxGroupDetail.MoveFirst Do While rsTaxGroupDetail.EOF = False TaxPercent# = 0 TaxID$ = rsTaxGroupDetail("SYS TAXGRPD Tax ID") TaxPercent# = DLookup("[SYS Tax Percent]", "[SYS Tax]", "[SYS Tax ID] = '" & TaxID$ & "'") GLTaxAcct$ = DLookup("[SYS Tax Account]", "[SYS Tax]", "[SYS Tax ID] = '" & TaxID$ & "'") If GLTaxAcct$ = "" Then GLTaxAcct$ = rsCompany("SYS COM Sales Sales Acct") End If rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = GLTaxAcct$ rsGLWorkDetail("GW TRANSD Debit Amount") = Round(rsSales("AR SALE Taxable Subtotal") * (TaxPercent# / 100)) rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update rsTaxGroupDetail.MoveNext Loop End If End If If rsSales("AR SALE Freight") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsCompany("SYS COM Sales Freight Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = rsSales("AR SALE Freight") rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If If rsSales("AR SALE Total") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsCompany("SYS COM Sales AR Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = 0 rsGLWorkDetail("GW TRANSD Credit Amount") = rsSales("AR SALE Total") rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If If rsSales("AR SALE Discount Amount") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsCompany("SYS COM Sales Discount Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = 0 rsGLWorkDetail("GW TRANSD Credit Amount") = rsSales("AR SALE Discount Amount") rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If ' ' Dim COGS@ Dim InventoryCost@ Dim COGSAccount$ COGS@ = 0 Dim InventoryAcct$ If rsDetail.RecordCount = 0 Then Else rsDetail.MoveFirst Do While rsDetail.EOF = False InventoryAcct$ = "" COGSAccount$ = "" If InventoryAcct$ = "" Then If rsDetail("AR SALED Row Type") = "N" Then ' process non-stock InventoryAcct$ = rsCompany("SYS COM Sales Misc Acct") COGSAccount$ = rsCompany("SYS COM Sales COGS Acct") Else rsInventory.MoveFirst rsInventory.Find "[INV ITEM Id]='" & rsDetail("AR SALED Item ID") & "'" If rsInventory.EOF = True Then InventoryAcct$ = rsCompany("SYS COM Sales Inventory Acct") COGSAccount$ = rsCompany("SYS COM Sales COGS Acct") Else InventoryAcct$ = IIf(IsNull(rsInventory("INV ITEM Inventory Account")), rsCompany("SYS COM Sales Inventory Acct"), rsInventory("INV ITEM Inventory Account")) COGSAccount$ = IIf(IsNull(rsInventory("INV ITEM Cost Of Sales Account")), rsCompany("SYS COM Sales COGS Acct"), rsInventory("INV ITEM Cost Of Sales Account")) InventoryCost@ = IIf(IsNull(rsInventory("INV ITEM Average Cost")), 0, rsInventory("INV ITEM Average Cost")) End If End If End If InventoryCost@ = 0 If rsDetail("AR SALED Row Type") = "N" Then ' process non-stock Else InventoryCost@ = DLookup("[INV ITEM Average Cost]", "[INV Items]", "[INV ITEM ID] = '" & rsDetail("AR SALED Item ID") & "'") End If If InventoryCost@ = 0 Then InventoryCost@ = IIf(IsNull(rsDetail("AR SALED Item Cost")), 0, rsDetail("AR SALED Item Cost")) Dim TempCost# TempCost# = InventoryCost@ InventoryCost@ = Round(TempCost#) If rsDetail("AR SALED Row Type") = "N" Then QtySold# = rsDetail("AR SALED Qty") Else QtySold# = rsDetail("AR SALED Qty") * GetUOMMultiplier(rsDetail("AR SALED Item ID"), rsDetail("AR SALED Units")) End If InventoryCost@ = InventoryCost@ * QtySold# InventoryCost@ = DropAllBut2(InventoryCost@) If InventoryCost@ = 0 Then Else COGS@ = COGS@ + InventoryCost@ rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = InventoryAcct$ rsGLWorkDetail("GW TRANSD Debit Amount") = InventoryCost@ rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = COGSAccount$ rsGLWorkDetail("GW TRANSD Debit Amount") = 0 rsGLWorkDetail("GW TRANSD Credit Amount") = InventoryCost@ rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If rsDetail.MoveNext Loop End If Dim Success% Success% = PostGLWorkDetail_New(db, rsGLWorkDetail, TranDate, NewNumber&) If Success% = False Then MsgBox "An error occurred writing GL Transaction!", , "Error" PostReturn = False Exit Function End If PostReturns_Exit: PostReturn = True rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsDetail.Close Set rsDetail = Nothing Set rsTaxGroupDetail = Nothing rsGLTrans.Close Set rsGLTrans = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing rsARPaymentHeader.Close Set rsARPaymentHeader = Nothing rsARCross.Close Set rsARCross = Nothing rsCustomer.Close Set rsCustomer = Nothing Set rsCompany = Nothing rsInventory.Close Set rsInventory = Nothing db.Close Set db = Nothing Exit Function PostReturn_Error: PostReturns_Error: Call LogError("Sales Module", "PostReturn", Now, Err, Error, intShowError) PostReturn = False rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsDetail.Close Set rsDetail = Nothing rsTaxGroupDetail.Close Set rsTaxGroupDetail = Nothing rsGLTrans.Close Set rsGLTrans = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing rsARPaymentHeader.Close Set rsARPaymentHeader = Nothing rsARCross.Close Set rsARCross = Nothing rsCustomer.Close Set rsCustomer = Nothing rsCompany.Close Set rsCompany = Nothing rsInventory.Close Set rsInventory = Nothing db.Close Set db = Nothing Exit Function UnableToPostReturnHere: PostReturn = False rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing db.Close Set db = Nothing Exit Function rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsDetail.Close Set rsDetail = Nothing rsTaxGroupDetail.Close Set rsTaxGroupDetail = Nothing rsGLTrans.Close Set rsGLTrans = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing rsARPaymentHeader.Close Set rsARPaymentHeader = Nothing rsARCross.Close Set rsARCross = Nothing rsCustomer.Close Set rsCustomer = Nothing rsCompany.Close Set rsCompany = Nothing rsInventory.Close Set rsInventory = Nothing db.Close Set db = Nothing End Function ''{*********************************************************** ''-TITLE: PostSalesMemo ''-MODULE ID: 2.14 ''-PURPOSE: Posts Sales ''-USAGE: PostSalesMemo(DocumentKey&, intShowError As Integer) ''-INPUT ASSERTION: DocumentKey&, intShowError As Integer ''-OUTPUT ASSERTION: ''-CALLS: VerifyPeriod, LogError ''-CALLED BY: PostSalesMemo; frm_AR_Sales_Memo_Entry.cmdPostInvoice_Click; frm_AR_Batch_Posting.cmdPost_Click ''-TABLES/FIELDS USED: "[SYS Company] "[GL Work Detail] "[AR Sales] [AR Customer] "[AR Payment Header] "[AR Payment Invoice Cross Reference] "[GL Transaction] [SYS Tax Group Detail] [AR Sales Detail] "[AR Payment Header] "[AR Payment Invoice Cross Reference] /All or Any of the Fields ''-TABLES/FIELDS AFFECTED: [GL Work Detail] /All or Any of the Fields ''-VARIABLES: msg$, title$, db, rsCompany, rsGLWorkDetail, rsSales, PostDate%, InvoiceType$, TranDate, PeriodToPost%, PeriodClosed%, cmdtemp, BankKey$, AppliedAmount@, rsCustomer, CurrentBalance@, SalesAcctDefault%, CustomerSalesAcct$, PaymentID&, rsARPaymentHeader, rsARCross, rsGLTrans, refr$, desc$, NewNumber&, GLTaxAcct$, TaxGroup$, TaxPercent#, TaxID$, rsTaxGroupDetail, Longer&, InventoryAcct$, rsDetail, Success% ''-METHOD: ''-REVISION HISTORY: Created before 12/01/2000, Corrected 04/07/2003 ''-REMARKS: ''***********************************************************}
Function PostSalesMemo(DocumentKey&, intShowError As Integer) Table of Contents Dim msg$ Dim title$ Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open gblADOProvider Dim rsCompany As Recordset Set rsCompany = New Recordset rsCompany.Open "[SYS Company]", db, adOpenStatic, adLockOptimistic, adCmdTable rsCompany.MoveFirst Dim rsGLWorkDetail As Recordset Set rsGLWorkDetail = New Recordset rsGLWorkDetail.Open "[GL Work Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim rsSales As Recordset Set rsSales = New Recordset rsSales.Open "[AR Sales]", db, adOpenStatic, adLockOptimistic, adCmdTable rsSales.MoveFirst rsSales.Find "[AR SALE Document #]=" & DocumentKey& Dim PostDate% PostDate% = rsCompany("SYS COM GL Post By Date") Dim InvoiceType$ InvoiceType$ = rsSales("AR SALE Document Type") Dim TranDate As Variant If PostDate% = 1 Then TranDate = DateValue(format(Now, "Short Date")) Else TranDate = DateValue(rsSales("AR SALE Date")) End If Dim PeriodToPost% Dim PeriodClosed% Call VerifyPeriod(TranDate, PeriodToPost%, PeriodClosed%) If PeriodClosed% = True Then MsgBox "Unable to post transaction to a closed period.", , "Post Invoice Error" GoTo UnableToPostMemoHere End If Dim cmdtemp As Recordset Set cmdtemp = New Recordset cmdtemp.Open "DELETE FROM [GL Work Detail]", db, , , adCmdText Set cmdtemp = Nothing Dim BankKey$ BankKey$ = IIf(IsNull(rsSales("AR SALE Check Acct ID")), "", rsSales("AR SALE Check Acct ID")) Dim AppliedAmount@ If IsNull(rsSales("AR SALE Amount Paid")) Then AppliedAmount@ = 0 Else AppliedAmount@ = rsSales("AR SALE Amount Paid") End If Dim rsCustomer As Recordset Dim CurrentBalance@ Set rsCustomer = New Recordset rsCustomer.Open "SELECT * FROM [AR Customer] WHERE [AR CUST Customer ID] = '" & rsSales("AR SALE Customer ID") & "'", db, adOpenStatic, adLockOptimistic, adCmdText Dim SalesAcctDefault% Dim CustomerSalesAcct$ SalesAcctDefault% = rsCompany("SYS COM Sales Acct Default") CustomerSalesAcct$ = "" If SalesAcctDefault% = 1 Then CustomerSalesAcct$ = IIf(IsNull(rsCustomer("AR CUST Sales Account")), "", rsCustomer("AR CUST Sales Account")) End If rsCustomer("AR CUST Payments YTD") = rsCustomer("AR CUST Payments YTD") + rsSales("AR SALE Amount Paid") rsCustomer("AR CUST Payments Lifetime") = rsCustomer("AR CUST Payments Lifetime") + rsSales("AR SALE Amount Paid") rsCustomer("AR CUST Sales YTD") = rsCustomer("AR CUST Sales YTD") + rsSales("AR SALE Total") rsCustomer("AR CUST Sales Lifetime") = rsCustomer("AR CUST Sales Lifetime") + rsSales("AR SALE Total") rsCustomer("AR CUST Invoices Lifetime") = rsCustomer("AR CUST Invoices Lifetime") + 1 rsCustomer("AR CUST Invoices YTD") = rsCustomer("AR CUST Invoices YTD") + 1 If rsSales("AR SALE Total") - rsSales("AR SALE Amount Paid") > 0 Then CurrentBalance@ = IIf(IsNull(rsCustomer("AR CUST Financial Period 1")), 0, rsCustomer("AR CUST Financial Period 1")) CurrentBalance@ = CurrentBalance@ + (rsSales("AR SALE Total") - rsSales("AR SALE Amount Paid")) rsCustomer("AR CUST Financial Period 1") = CurrentBalance@ If CurrentBalance@ > IIf(IsNull(rsCustomer("AR CUST Highest Balance")), 0, rsCustomer("AR CUST Highest Balance")) Then rsCustomer("AR CUST Highest Balance") = CurrentBalance@ End If rsCustomer.Update Dim PaymentID& If AppliedAmount@ > 0 Then Dim rsARPaymentHeader As Recordset Set rsARPaymentHeader = New Recordset rsARPaymentHeader.Open "[AR Payment Header]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim rsARCross As Recordset Set rsARCross = New Recordset rsARCross.Open "[AR Payment Invoice Cross Reference]", db, adOpenStatic, adLockOptimistic, adCmdTable rsARPaymentHeader.AddNew rsARPaymentHeader("AR PAY Type") = "Payment Invoice" rsARPaymentHeader("AR PAY Check No") = rsSales("AR SALE Check Number") & "" rsARPaymentHeader("AR PAY Customer No") = rsSales("AR SALE Customer ID") & "" rsARPaymentHeader("AR PAY Transaction Date") = rsSales("AR SALE Date") rsARPaymentHeader("AR PAY Amount") = rsSales("AR SALE Amount Paid") rsARPaymentHeader("AR PAY UnApplied Amount") = 0 'Cannot have unapplied amounts here rsARPaymentHeader("AR PAY Bank Account") = BankKey$ rsARPaymentHeader("AR PAY Status") = "Posted" rsARPaymentHeader("AR PAY Posted YN") = True rsARPaymentHeader("AR PAY NSF") = False rsARPaymentHeader("AR PAY Cleared") = False rsARPaymentHeader.Update PaymentID& = rsARPaymentHeader("AR PAY ID") rsARCross.AddNew rsARCross("AR CROSS Payment ID") = PaymentID& rsARCross("AR CROSS Payed ID") = rsSales("AR SALE Document #") rsARCross("AR CROSS Discount Taken") = 0 rsARCross("AR CROSS Write Off Amount") = 0 rsARCross("AR CROSS Applied Amount") = AppliedAmount@ rsARCross("AR CROSS Cleared") = False rsARCross.Update End If Dim rsGLTrans As Recordset Set rsGLTrans = New Recordset rsGLTrans.Open "[GL Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable Dim refr$ Dim desc$ Dim NewNumber& rsGLTrans.AddNew rsGLTrans("GL TRANS Document #") = "SALES MEMO " & rsSales("AR SALE Ext Document #") rsGLTrans("GL TRANS Type") = "Sales Memo" If PostDate% = 1 Then rsGLTrans("GL TRANS Date") = format(Now, "Short Date") Else rsGLTrans("GL TRANS Date") = rsSales("AR SALE Date") End If refr$ = rsSales("AR SALE Bill To") rsGLTrans("GL TRANS Reference") = refr$ rsGLTrans("GL TRANS Amount") = rsSales("AR SALE Total") rsGLTrans("GL TRANS Posted YN") = 1 desc$ = IIf(IsNull(rsSales("AR SALE Description")), "", rsSales("AR SALE Description")) If Len(Trim$(desc$)) = 0 Then desc$ = "SALES MEMO " & rsSales("AR SALE Ext Document #") End If rsGLTrans("GL TRANS Description") = desc$ rsGLTrans("GL TRANS Source") = "SALES MEMO " & rsSales("AR SALE Ext Document #") rsGLTrans("GL TRANS System Generated") = True rsGLTrans.Update NewNumber& = rsGLTrans("GL TRANS Number") ' ' If rsSales("AR SALE Total") - rsSales("AR SALE Amount Paid") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsCompany("SYS COM Sales AR Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = rsSales("AR SALE Total") - rsSales("AR SALE Amount Paid") rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If If rsSales("AR SALE Amount Paid") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = BankKey$ rsGLWorkDetail("GW TRANSD Debit Amount") = rsSales("AR SALE Amount Paid") rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If If rsSales("AR SALE Discount Amount") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsCompany("SYS COM Sales Discount Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = rsSales("AR SALE Discount Amount") rsGLWorkDetail("GW TRANSD Credit Amount") = 0 rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If Dim GLTaxAcct$ Dim TaxGroup$ Dim TaxPercent# Dim TaxID$ If rsSales("AR SALE Sales Tax") > 0 Then GLTaxAcct$ = "" TaxGroup$ = IIf(IsNull(rsSales("AR SALE Tax Group")), rsCompany("SYS COM Sales Sales Tax"), rsSales("AR SALE Tax Group")) Dim rsTaxGroupDetail As Recordset Set rsTaxGroupDetail = New Recordset rsTaxGroupDetail.Open "SELECT * FROM [SYS Tax Group Detail] where [SYS TAXGRPD Group ID] = '" & TaxGroup$ & "'", db, adOpenStatic, adLockOptimistic, adCmdText rsTaxGroupDetail.MoveLast rsTaxGroupDetail.MoveFirst If rsTaxGroupDetail.RecordCount = 0 Then Else Do While rsTaxGroupDetail.EOF = False TaxPercent# = 0 TaxID$ = rsTaxGroupDetail("SYS TAXGRPD Tax ID") TaxPercent# = DLookup("[SYS Tax Percent]", "[SYS Tax]", "[SYS Tax ID] = '" & TaxID$ & "'") GLTaxAcct$ = DLookup("[SYS Tax Account]", "[SYS Tax]", "[SYS Tax ID] = '" & TaxID$ & "'") If GLTaxAcct$ = "" Then GLTaxAcct$ = rsCompany("SYS COM Sales Sales Acct") End If rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = GLTaxAcct$ rsGLWorkDetail("GW TRANSD Debit Amount") = 0 rsGLWorkDetail("GW TRANSD Credit Amount") = Round(rsSales("AR SALE Taxable Subtotal") * (TaxPercent# / 100)) rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update rsTaxGroupDetail.MoveNext Loop End If End If If rsSales("AR SALE Freight") > 0 Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsCompany("SYS COM Sales Freight Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = 0 rsGLWorkDetail("GW TRANSD Credit Amount") = rsSales("AR SALE Freight") rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If Dim Longer& Dim InventoryAcct$ Dim rsDetail As Recordset Set rsDetail = New Recordset Longer& = 0 rsDetail.Open "SELECT * FROM [AR Sales Detail] where [AR SALED Document #] = " & rsSales("AR SALE Document #"), db, adOpenStatic, adLockOptimistic, adCmdText rsDetail.MoveLast rsDetail.MoveFirst If rsDetail.RecordCount = 0 Then Else Do While rsDetail.EOF = False rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsDetail("AR SALED Posting Account") rsGLWorkDetail("GW TRANSD Debit Amount") = 0 rsGLWorkDetail("GW TRANSD Credit Amount") = rsDetail("AR SALED Item Total") rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update rsDetail.MoveNext If Err = 3021 Then Exit Do Loop End If If rsSales("AR SALE Amount Paid") > rsSales("AR SALE Total") Then rsGLWorkDetail.AddNew rsGLWorkDetail("GW TRANSD Number") = NewNumber& rsGLWorkDetail("GW TRANSD Account") = rsCompany("SYS COM Sales AR Acct") rsGLWorkDetail("GW TRANSD Debit Amount") = 0 rsGLWorkDetail("GW TRANSD Credit Amount") = rsSales("AR SALE Amount Paid") - rsSales("AR SALE Total") rsGLWorkDetail("GW TRANSD Project") = "" rsGLWorkDetail.Update End If Dim Success% Success% = PostGLWorkDetail_New(db, rsGLWorkDetail, TranDate, NewNumber&) If Success% = False Then MsgBox "An error occurred writing GL Transaction!", , "Error" PostSalesMemo = False Exit Function End If PostSalesMemo_Exit: PostSalesMemo = True rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsDetail.Close Set rsDetail = Nothing Set rsTaxGroupDetail = Nothing rsGLTrans.Close Set rsGLTrans = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsARPaymentHeader = New Recordset rsARPaymentHeader.Open "[AR Payment Header]", db, adOpenStatic, adLockOptimistic, adCmdTable Set rsSales = Nothing rsARPaymentHeader.Close Set rsARPaymentHeader = Nothing Set rsARCross = New Recordset rsARCross.Open "[AR Payment Invoice Cross Reference]", db, adOpenStatic, adLockOptimistic, adCmdTable rsARCross.Close Set rsARCross = Nothing rsCustomer.Close Set rsCustomer = Nothing Set rsCompany = Nothing db.Close Set db = Nothing Exit Function PostSalesMemo_error: Call LogError("Sales Module", "PostSalesMemo", Now, Err, Error, intShowError) PostSalesMemo = False rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsDetail.Close Set rsDetail = Nothing rsTaxGroupDetail.Close Set rsTaxGroupDetail = Nothing rsGLTrans.Close Set rsGLTrans = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing rsARPaymentHeader.Close Set rsARPaymentHeader = Nothing rsARCross.Close Set rsARCross = Nothing rsCustomer.Close Set rsCustomer = Nothing rsCompany.Close Set rsCompany = Nothing db.Close Set db = Nothing Exit Function UnableToPostMemoHere: PostSalesMemo = False rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing db.Close Set db = Nothing Exit Function rsGLWorkDetail.Close Set rsGLWorkDetail = Nothing rsDetail.Close Set rsDetail = Nothing rsTaxGroupDetail.Close Set rsTaxGroupDetail = Nothing rsGLTrans.Close Set rsGLTrans = Nothing rsCompany.Close Set rsCompany = Nothing rsSales.Close Set rsSales = Nothing rsARPaymentHeader.Close Set rsARPaymentHeader = Nothing rsARCross.Close Set rsARCross = Nothing rsCustomer.Close Set rsCustomer = Nothing rsCompany.Close Set rsCompany = Nothing db.Close Set db = Nothing End Function ''{*********************************************************** ''-TITLE: GetMaxID ''-MODULE ID: 2.14 ''-PURPOSE: Gets Max of ID ''-USAGE: GetMaxID(strSQL As String) ''-INPUT ASSERTION: strSQL As String ''-OUTPUT ASSERTION: Integer ''-CALLS: This procedure calls no other functions ''-CALLED BY: GetMaxID; frm_AP_Receiving_Entry.cmdPost_Click; frm_AP_Receiving_Entry.cmdPost_Click; frm_AP_Receiving_Entry.cmdPost_Click; frm_AP_Receiving_Entry.cmdPost_Click; frm_AP_RMA_Entry.cmdPost_Click; frm_AP_RMA_Entry.cmdPost_Click; frm_AP_RMA_Entry.cmdPost_Click; frm_AP_RMA_Entry.cmdPost_Click; frm_AP_Voucher_Entry.cmdPost_Click; frm_AP_Voucher_Entry.cmdPost_Click; frm_AP_Voucher_Entry.cmdPost_Click; frm_AP_Voucher_Entry.cmdPost_Click; frm_AR_Return_Entry.cmdPostInvoice_Click; frm_AR_Return_Entry.cmdPostInvoice_Click; frm_AR_Return_Entry.cmdPostInvoice_Click; frm_AR_Return_Entry.cmdPostInvoice_Click; frm_AR_Sales_Memo_Entry.cmdPostInvoice_Click; frm_AR_Sales_Memo_Entry.cmdPostInvoice_Click; frm_AR_Sales_Memo_Entry.cmdPostInvoice_Click; frm_AR_Sales_Memo_Entry.cmdPostInvoice_Click; frm_AR_Sales_Entry.cmdPostInvoice_Click; frm_AR_Sales_Entry.cmdPostInvoice_Click; frm_AR_Sales_Entry.cmdPostInvoice_Click; frm_AR_Sales_Entry.cmdPostInvoice_Click; frm_AP_Credit_Entry.cmdPost_Click; frm_AP_Credit_Entry.cmdPost_Click; frm_AP_Credit_Entry.cmdPost_Click; frm_AP_Credit_Entry.cmdPost_Click; frm_AR_Credit_Entry.cmdPostInvoice_Click; frm_AR_Credit_Entry.cmdPostInvoice_Click; frm_AR_Credit_Entry.cmdPostInvoice_Click; frm_AR_Credit_Entry.cmdPostInvoice_Click ''-TABLES/FIELDS USED: /All or Any of the Fields ''-TABLES/FIELDS AFFECTED: ''-VARIABLES: db, rs ''-METHOD: ''-REVISION HISTORY: Created before 12/01/2000, Corrected 04/07/2003 ''-REMARKS: ''***********************************************************}
Function GetMaxID(strSQL As String) As Integer Table of Contents Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open gblADOProvider Dim rs As Recordset Set rs = New Recordset rs.Open strSQL, db, , , adCmdTable If IsEmpty(rs.RecordCount) Then GetMaxID = 0 Else If IsNull(rs!max_ID) Then GetMaxID = 0 Else GetMaxID = rs!max_ID End If rs.Close End If End Function ''{*********************************************************** ''-TITLE: DeleteNewRecord ''-MODULE ID: 2.14 ''-PURPOSE: Deletes New Record ''-USAGE: DeleteNewRecord(strSQL As String, field As String, DeleteID As Variant, strDelete As String) ''-INPUT ASSERTION: strSQL As String, field As String, DeleteID As Variant, strDelete As String ''-OUTPUT ASSERTION: Variant ''-CALLS: This procedure calls no other functions ''-CALLED BY: DeleteNewRecord; frm_AP_Receiving_Entry.cmdPost_Click; frm_AP_Receiving_Entry.cmdPost_Click; frm_AP_RMA_Entry.cmdPost_Click; frm_AP_RMA_Entry.cmdPost_Click; frm_AP_Voucher_Entry.cmdPost_Click; frm_AP_Voucher_Entry.cmdPost_Click; frm_AR_Return_Entry.cmdPostInvoice_Click; frm_AR_Return_Entry.cmdPostInvoice_Click; frm_AR_Sales_Memo_Entry.cmdPostInvoice_Click; frm_AR_Sales_Memo_Entry.cmdPostInvoice_Click; frm_AR_Sales_Entry.cmdPostInvoice_Click; frm_AR_Sales_Entry.cmdPostInvoice_Click; frm_AP_Credit_Entry.cmdPost_Click; frm_AP_Credit_Entry.cmdPost_Click; frm_AR_Credit_Entry.cmdPostInvoice_Click; frm_AR_Credit_Entry.cmdPostInvoice_Click ''-TABLES/FIELDS USED: ''-TABLES/FIELDS AFFECTED: ''-VARIABLES: db, st, ID_Delete, rs, i ''-METHOD: ''-REVISION HISTORY: Created before 12/01/2000, Corrected 04/07/2003 ''-REMARKS: ''***********************************************************}
Function DeleteNewRecord(strSQL As String, field As String, DeleteID As Variant, strDelete As String) Table of Contents Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open gblADOProvider Dim st As String Dim ID_Delete As Variant Dim rs As Recordset Set rs = New Recordset rs.Open strSQL, db rs.MoveFirst Dim i As Integer For i = 0 To rs.RecordCount - 1 If rs(field) > DeleteID Then Exit For End If rs.MoveNext Next i If i = rs.RecordCount Then Exit Function End If st = strDelete & rs(field) rs.Close db.Execute st End Function ''{*********************************************************** ''-TITLE: GetInformAboutSysCompany ''-MODULE ID: 2.14 ''-PURPOSE: Gets Inform About Sys Company ''-USAGE: GetInformAboutSysCompany(COGS As Boolean) ''-INPUT ASSERTION: COGS As Boolean ''-OUTPUT ASSERTION: ''-CALLS: This procedure calls no other functions ''-CALLED BY: GetInformAboutSysCompany; frm_AR_Return_Entry.cmdPostInvoice_Click; frm_AR_Sales_Memo_Entry.cmdPostInvoice_Click; frm_AR_Sales_Entry.cmdPostInvoice_Click; frm_AR_Credit_Entry.cmdPostInvoice_Click ''-TABLES/FIELDS USED: "[SYS Company] /All or Any of the Fields ''-TABLES/FIELDS AFFECTED: ''-VARIABLES: db, rsCompany ''-METHOD: ''-REVISION HISTORY: Created before 12/01/2000, Corrected 04/07/2003 ''-REMARKS: ''***********************************************************}
Function GetInformAboutSysCompany(COGS As Boolean) Table of Contents Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open gblADOProvider Dim rsCompany As Recordset Set rsCompany = New Recordset rsCompany.Open "[SYS Company]", db, adOpenStatic, adLockOptimistic, adCmdTable If rsCompany("SYS Com Sales return Acct") = "" Or IsNull(rsCompany("SYS Com Sales return Acct")) Or IsEmpty(rsCompany("SYS Com Sales return Acct")) Then rsCompany.Close Set rsCompany = Nothing db.Close Set db = Nothing MsgBox "Field [SYS Com Sales Return Acct] in the table [SYS Company] is empty." & Chr(10) & Chr(10) & "Please, set [GL Sales Return] in Sales Setup", vbOKOnly + vbExclamation GetInformAboutSysCompany = False Exit Function End If If rsCompany("SYS Com Sales Discount Acct") = "" Or IsNull(rsCompany("SYS Com Sales Discount Acct")) Or IsEmpty(rsCompany("SYS Com Sales Discount Acct")) Then rsCompany.Close Set rsCompany = Nothing db.Close Set db = Nothing MsgBox "Field [SYS Com Sales Discount Acct] in the table [SYS Company] is empty." & Chr(10) & Chr(10) & "Please, set [GL Sales Discount] in Sales Setup", vbOKOnly + vbExclamation GetInformAboutSysCompany = False Exit Function End If If rsCompany("SYS Com Sales Freight Acct") = "" Or IsNull(rsCompany("SYS Com Sales Freight Acct")) Or IsEmpty(rsCompany("SYS Com Sales Freight Acct")) Then rsCompany.Close Set rsCompany = Nothing db.Close Set db = Nothing MsgBox "Field [SYS Com Sales Freight Acct] in the table [SYS Company] is empty." & Chr(10) & Chr(10) & "Please, set [GL Sales Freight] in Sales Setup", vbOKOnly + vbExclamation GetInformAboutSysCompany = False Exit Function End If If COGS = True Then If rsCompany("SYS Com Sales COGS Acct") = "" Or IsNull(rsCompany("SYS Com Sales COGS Acct")) Or IsEmpty(rsCompany("SYS Com Sales COGS Acct")) Then rsCompany.Close Set rsCompany = Nothing db.Close Set db = Nothing MsgBox "Field [SYS Com Sales COGS Acct] in the table [SYS Company] is empty." & Chr(10) & Chr(10) & "Please, set [GL Sales COGS] in Sales Setup", vbOKOnly + vbExclamation GetInformAboutSysCompany = False Exit Function End If End If db.Close Set db = Nothing GetInformAboutSysCompany = True End Function