frmpurchaseorderreceiveae.frm

Inventory control system

      Height          =   240
      Left            =   9150
      TabIndex        =   31
      Top             =   7560
      Visible         =   0   'False
      Width           =   2040
   End
   Begin VB.Label Label5 
      Alignment       =   1  'Right Justify
      Caption         =   "Tax Base"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000011D&
      Height          =   240
      Left            =   9150
      TabIndex        =   30
      Top             =   7260
      Visible         =   0   'False
      Width           =   2040
   End
   Begin VB.Label Label4 
      Alignment       =   1  'Right Justify
      Caption         =   "Discount"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000011D&
      Height          =   240
      Left            =   9150
      TabIndex        =   29
      Top             =   6960
      Width           =   2040
   End
   Begin VB.Menu mnu_Tasks 
      Caption         =   "Purchase Receive Tasks"
      Visible         =   0   'False
      Begin VB.Menu mnu_History 
         Caption         =   "Modification History"
      End
      Begin VB.Menu mnu_ReturnItems 
         Caption         =   "Return Items"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnu_Vat 
         Caption         =   "Show VAT && Taxbase"
      End
   End
End
Attribute VB_Name = "frmPOReceiveLocalAE"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public State                As FormState 'Variable used to determine on how the form used
Public PK                   As Long 'Variable used to get what record is going to edit (PO)
Public InvoicePK            As Long 'Variable used to get what record is going to edit (Invoice)
Public CloseMe              As Boolean
Public ForCusAcc            As Boolean

Dim cIGross                 As Currency 'Gross Amount
Dim cIAmount                As Currency 'Current Invoice Amount
Dim cDAmount                As Currency 'Current Invoice Discount Amount
Dim cIRowCount              As Integer

Dim HaveAction              As Boolean 'Variable used to detect if the user perform some action
Dim RS                      As New Recordset 'Main recordset for Invoice
Dim blnSave                 As Boolean
Dim intQtyOld               As Integer 'Allowed value for receive qty

Private Sub btnUpdate_Click()
    Dim CurrRow As Integer
    Dim curDiscPerc As Currency
    Dim curExtDiscPerc As Currency
    Dim intQty As Integer
    
    CurrRow = getFlexPos(Grid, 12, txtStock.Tag)

    'Add to grid
    With Grid
        .Row = CurrRow
        
        'Restore back the invoice amount and discount
        cIGross = cIGross - toNumber(Grid.TextMatrix(.RowSel, 6))
        txtGross(2).Text = Format$(cIGross, "#,##0.00")
        cIAmount = cIAmount - toNumber(Grid.TextMatrix(.RowSel, 10))
        txtNet.Text = Format$(cIAmount, "#,##0.00")
        
        'Compute discount
        curDiscPerc = .TextMatrix(1, 6) * .TextMatrix(1, 7) / 100
        curExtDiscPerc = .TextMatrix(1, 6) * .TextMatrix(1, 8) / 100
        
        cDAmount = cDAmount - (curDiscPerc + curExtDiscPerc + txtExtDiscAmt.Text)
        
        txtDesc.Text = Format$(cDAmount, "#,##0.00")
        
        .TextMatrix(CurrRow, 3) = txtQty.Text
        .TextMatrix(CurrRow, 4) = dcUnit.Text
        .TextMatrix(CurrRow, 5) = toMoney(txtPrice.Text)
        .TextMatrix(CurrRow, 6) = toMoney(txtGross(1).Text)
        .TextMatrix(CurrRow, 7) = toMoney(txtDiscPercent.Text)
        .TextMatrix(CurrRow, 8) = toNumber(txtExtDiscPerc.Text)
        .TextMatrix(CurrRow, 9) = toMoney(txtExtDiscAmt.Text)
        .TextMatrix(CurrRow, 10) = toMoney(toNumber(txtNetAmount.Text))
        .TextMatrix(CurrRow, 11) = toMoney(dcWarehouse.Text)
        
        'Add the amount to current load amount
        cIGross = cIGross + toNumber(txtGross(1).Text)
        txtGross(2).Text = Format$(cIGross, "#,##0.00")
        
        'Compute discount
        curDiscPerc = txtGross(1).Text * txtDiscPercent.Text / 100
        curExtDiscPerc = txtGross(1).Text * txtExtDiscPerc.Text / 100
        
        cDAmount = curDiscPerc + curExtDiscPerc + txtExtDiscAmt.Text
        
        cIAmount = cIAmount + toNumber(txtNetAmount.Text)
        
        txtDesc.Text = Format$(cDAmount, "#,##0.00")
        txtNet.Text = Format$(cIAmount, "#,##0.00")
        txtTaxBase.Text = toMoney(txtNet.Text / 1.12)
        txtVat.Text = toMoney(txtNet.Text - txtTaxBase.Text)
        
        'Save to Purchase Order Details
        Dim RSPODetails As New Recordset
        
        RSPODetails.CursorLocation = adUseClient
        RSPODetails.Open "SELECT * From Purchase_Order_Detail Where POID = " & txtPONo.Tag, CN, adOpenStatic, adLockOptimistic
        
        'add qty received in Purchase Order Details
        RSPODetails.Find "[StockID] = " & txtStock.Tag, , adSearchForward, 1
       
        If txtQty > intQtyOld Then
            intQty = txtQty.Text - intQtyOld
            RSPODetails!QtyReceived = toNumber(RSPODetails!QtyReceived) + intQty
        Else
            intQty = intQtyOld - txtQty
            RSPODetails!QtyReceived = toNumber(RSPODetails!QtyReceived) - intQty
        End If
        
        RSPODetails.Update
        '-----------------
        
        'Highlight the current row's column
        .ColSel = 10
        'Display a remove button
        Grid_Click
        'Reset the entry fields
        ResetEntry
    End With
End Sub

Private Sub btnRemove_Click()
    Dim curDiscPerc As Currency
    Dim curExtDiscPerc As Currency
    
    'Remove selected load product
    With Grid
        'Update grooss to current purchase amount
        cIGross = cIGross - toNumber(Grid.TextMatrix(.RowSel, 6))
        txtGross(2).Text = Format$(cIGross, "#,##0.00")
        'Update amount to current invoice amount
        cIAmount = cIAmount - toNumber(Grid.TextMatrix(.RowSel, 10))
        txtNet.Text = Format$(cIAmount, "#,##0.00")
        'Update discount to current invoice disc
        curDiscPerc = .TextMatrix(1, 6) * .TextMatrix(1, 7) / 100
        curExtDiscPerc = .TextMatrix(1, 6) * .TextMatrix(1, 8) / 100
        
        cDAmount = cDAmount - (curDiscPerc + curExtDiscPerc + txtExtDiscAmt.Text)
        
        txtDesc.Text = Format$(cDAmount, "#,##0.00")
        txtTaxBase.Text = toMoney(txtNet.Text / 1.12)
        txtVat.Text = toMoney(txtNet.Text - txtTaxBase.Text)
        
        'Update the record count
        cIRowCount = cIRowCount - 1
        
        If .Rows = 2 Then Grid.Rows = Grid.Rows + 1
        .RemoveItem (.RowSel)
    End With

    btnRemove.Visible = False
    Grid_Click
End Sub

Private Sub cmdCancel_Click()
On Error Resume Next

    If blnSave = False Then CN.RollbackTrans
    
    Unload Me
End Sub

Private Sub cmdSave_Click()
    'Verify the entries
    If txtDRNo = "" Then
        MsgBox "Please don't leave DR No Field blank", vbInformation
        txtDRNo.SetFocus
        Exit Sub
    End If
   
    If cIRowCount < 1 Then
        MsgBox "Please enter item to return before saving this record.", vbExclamation
        Exit Sub
    End If
   
    If MsgBox("This save the record. Do you want to proceed?", vbQuestion + vbYesNo) = vbNo Then Exit Sub

    'Connection for Purchase_Order_Receive
    Dim RSReceive As New Recordset

    RSReceive.CursorLocation = adUseClient
    RSReceive.Open "SELECT * FROM Purchase_Order_Receive_Local WHERE InvoiceID=" & InvoicePK, CN, adOpenStatic, adLockOptimistic

    Screen.MousePointer = vbHourglass

    Dim c As Integer

    On Error GoTo err

    DeleteItems
    
    'Save the record
    With RSReceive
        If State = adStateAddMode Or State = adStatePopupMode Then
            .AddNew
            
            InvoicePK = getIndex("Purchase_Order_Receive_Local")
            ![InvoiceID] = InvoicePK
            ![POID] = PK
          
            ![DateAdded] = Now
            ![AddedByFK] = CurrUser.USER_PK
        End If
        ![DRNo] = txtDRNo.Text
        ![DRDate] = dtpDRDate.Value
        ![DeliveryNo] = txtDeliveryNo.Text
        ![DeliveryDate] = dtpDeliveryDate.Value
        
        ![Gross] = toNumber(txtGross(2).Text)
        ![Discount] = txtDesc.Text
        ![TaxBase] = toNumber(txtTaxBase.Text)
        ![Vat] = toNumber(txtVat.Text)
        ![NetAmount] = toNumber(txtNet.Text)
        
        ![Notes] = txtNotes.Text
        ![Remarks] = IIf(optReceived.Value, "R", "L") 'R = Received; L = Lost
        ![Status] = IIf(cboStatus.Text = "Received", True, False)
        
        ![DateModified] = Now
        ![LastUserFK] = CurrUser.USER_PK
        
        .Update
    End With
   
    'Connection for Purchase_Order_Receiving_Detail
    Dim RSDetails As New Recordset

    RSDetails.CursorLocation = adUseClient
    RSDetails.Open "SELECT * FROM Purchase_Order_Receive_Local_Detail WHERE InvoiceID=" & InvoicePK, CN, adOpenStatic, adLockOptimistic
    
    'Save to stock card
    Dim RSStockCard As New Recordset

    RSStockCard.CursorLocation = adUseClient
    RSStockCard.Open "SELECT * FROM Stock_Card", CN, adOpenStatic, adLockOptimistic
    
    'Add qty ordered to qty onhand
    Dim RSStockUnit As New Recordset

    RSStockUnit.CursorLocation = adUseClient
    RSStockUnit.Open "SELECT * From Stock_Unit", CN, adOpenStatic, adLockOptimistic
       
'    'Save to Purchase Order Details
'    Dim RSPODetails As New Recordset
'
'    RSPODetails.CursorLocation = adUseClient
'    RSPODetails.Open "SELECT * From Purchase_Order_Detail Where POID = " & PK, CN, adOpenStatic, adLockOptimistic
    
    'Save to Landed Cost table
    Dim RSLandedCost As New Recordset

    RSLandedCost.CursorLocation = adUseClient
    
    With Grid
        
        'Save the details of the records to Purchase_Order_Receive_Local_Detail
        For c = 1 To cIRowCount
            .Row = c
            If State = adStateAddMode Or State = adStatePopupMode Then
AddNew:
            
                RSDetails.AddNew
    
                RSDetails![InvoiceID] = InvoicePK
                RSDetails![StockID] = toNumber(.TextMatrix(c, 12))
                RSDetails![Qty] = toNumber(.TextMatrix(c, 3))
                RSDetails![Unit] = getValueAt("SELECT UnitID,Unit FROM Unit WHERE Unit='" & .TextMatrix(c, 4) & "'", "UnitID")
                RSDetails![Price] = toNumber(.TextMatrix(c, 5))
                RSDetails![DiscPercent] = toNumber(.TextMatrix(c, 7)) / 100
                RSDetails![ExtDiscPercent] = toNumber(.TextMatrix(c, 8)) / 100
                RSDetails![ExtDiscAmt] = toNumber(.TextMatrix(c, 9))
                RSDetails![WarehouseID] = getValueAt("SELECT WarehouseID,Warehouse FROM Warehouses WHERE Warehouse='" & .TextMatrix(c, 11) & "'", "WarehouseID")
    
                RSDetails.Update
            ElseIf State = adStateEditMode Then
                RSDetails.Filter = "StockID = " & toNumber(.TextMatrix(c, 12))
            
                If RSDetails.RecordCount = 0 Then GoTo AddNew

                RSDetails![Qty] = toNumber(.TextMatrix(c, 3))
                RSDetails![Unit] = getValueAt("SELECT UnitID,Unit FROM Unit WHERE Unit='" & .TextMatrix(c, 4) & "'", "UnitID")
                RSDetails![Price] = toNumber(.TextMatrix(c, 5))
                RSDetails![DiscPercent] = toNumber(.TextMatrix(c, 7)) / 100
                RSDetails![ExtDiscPercent] = toNumber(.TextMatrix(c, 8)) / 100
                RSDetails![ExtDiscAmt] = toNumber(.TextMatrix(c, 9))
                RSDetails![WarehouseID] = getValueAt("SELECT WarehouseID,Warehouse FROM Warehouses WHERE Warehouse='" & .TextMatrix(c, 11) & "'", "WarehouseID")

                RSDetails.Update
                
            End If
            
            If State = adStateAddMode Then
                RSStockCard.AddNew
    
                RSStockCard!Type = "PRL"
                RSStockCard!UnitID = getValueAt("SELECT UnitID,Unit FROM Unit WHERE Unit='" & .TextMatrix(c, 4) & "'", "UnitID")
                RSStockCard!RefNo1 = txtDRNo.Text
                RSStockCard!Incoming = toNumber(.TextMatrix(c, 3))
                RSStockCard!Cost = toNumber(.TextMatrix(c, 5))
                RSStockCard!StockID = toNumber(.TextMatrix(c, 12))
    
                RSStockCard.Update
                '-----------------
                
                RSStockUnit.Filter = "StockID = " & toNumber(.TextMatrix(c, 12)) & " AND UnitID = " & getValueAt("SELECT UnitID,Unit FROM Unit WHERE Unit='" & .TextMatrix(c, 4) & "'", "UnitID")

                RSStockUnit!Incoming = RSStockUnit!Incoming + toNumber(.TextMatrix(c, 3))
                RSStockUnit.Update
            ElseIf cboStatus.Text = "On Hold" And State = adStateEditMode Then
                RSStockCard.Filter = "StockID = " & toNumber(.TextMatrix(c, 12)) & " AND RefNo1 = '" & txtDRNo.Text & "'"
                RSStockUnit.Filter = "StockID = " & toNumber(.TextMatrix(c, 12)) & " AND UnitID = " & getValueAt("SELECT UnitID,Unit FROM Unit WHERE Unit='" & .TextMatrix(c, 4) & "'", "UnitID")
               
                'Restore Pending from incoming
                RSStockUnit!Incoming = RSStockUnit!Incoming - RSStockCard!Incoming
                
                RSStockUnit.Update
                '-----------------
                
                'Update Incoming, Overight Incoming encoded in add mode
                RSStockCard!Incoming = toNumber(.TextMatrix(c, 3))
    
                RSStockCard.Update
                '-----------------

                RSStockUnit!Incoming = RSStockUnit!Incoming + toNumber(.TextMatrix(c, 3))
                
                RSStockUnit.Update
            End If
            
            If cboStatus.Text = "Received" And optReceived.Value = True Then
                'Add qty received to stock card
                RSStockCard.Filter = "StockID = " & toNumber(.TextMatrix(c, 12)) & " AND RefNo1 = '" & txtDRNo.Text & "'"