frmpurchaseorderreturnae.frm

Inventory control system

        
        'Add record to stock card
        RSStockCard.AddNew
            
        RSStockCard!Type = "POR"
        RSStockCard!RefNo1 = ReceivePK
        RSStockCard!Pieces1 = "-" & toNumber(txtQty.Text)
        RSStockCard!Cost = toNumber(txtPrice.Text)
        RSStockCard!StockID = intStockID
            
        RSStockCard.Update
            
        'Deduct qty returned to qty onhand in Stock_Unit tables
        Dim RSStockUnit As New Recordset
    
        RSStockUnit.CursorLocation = adUseClient
        RSStockUnit.Open "SELECT * From Stock_Unit", CN, adOpenStatic, adLockOptimistic
            
        'Deduct qty returned in stocks table
        RSStockUnit.Filter = "StockID = " & intStockID & " AND UnitID = " & dcUnit.BoundText
        
        RSStockUnit!Onhand = RSStockUnit!Onhand - toNumber(txtQty.Text)
        
        RSStockUnit.Update
                    
        'Add the amount to current load amount
        cIGross = cIGross + toNumber(txtGross(1).Text)
        txtGross(2).Text = Format$(cIGross, "#,##0.00")
        
        cDAmount = cDAmount + toNumber(toNumber(txtDisc.Text) / 100) * (toNumber(toNumber(txtQty.Text) * toNumber(txtPrice.Text)))
        
        cIAmount = cIAmount + toNumber(txtNetAmount.Text)
        
        txtDesc.Text = Format$(cDAmount, "#,##0.00")
        txtNet.Text = Format$(cIAmount, "#,##0.00")
        
        'Highlight the current row's column
        .ColSel = 9
        'Display a remove button
        Grid_Click
        'Reset the entry fields
        ResetEntry
    End With
End Sub

Private Sub btnRemove_Click()
    '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, 8))
        txtNet.Text = Format$(cIAmount, "#,##0.00")
        'Update discount to current invoice disc
        cDAmount = cDAmount - toNumber(toNumber(txtDisc.Text) / 100) * (toNumber(toNumber(Grid.TextMatrix(.RowSel, 4)) * toNumber(Grid.TextMatrix(.RowSel, 6))))
        txtDesc.Text = Format$(cDAmount, "#,##0.00")

        '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 dcUnit_Change()
    If dcUnit.Text = "" Or nsdStock.Tag = "" Then Exit Sub
    
    txtPrice.Text = toMoney(getValueAt("SELECT SupplierPrice FROM qry_Stock_Unit WHERE StockID= " & nsdStock.Tag & " AND UnitID = " & dcUnit.BoundText & "", "SupplierPrice"))
End Sub

Private Sub nsdStock_Change()
    On Error Resume Next
    
    nsdStock.Tag = nsdStock.BoundText
    txtQty.Text = "0"
    
    dcUnit.Text = ""
    bind_dc "SELECT * FROM qry_Unit WHERE StockID=" & nsdStock.BoundText & " ORDER BY qry_Unit.Order ASC", "Unit", dcUnit, "UnitID", True
    
'    txtPrice.Text = toMoney(nsdStock.getSelValueAt(3)) 'Supplier Price
End Sub

Private Sub nsdVendor_Change()
    If nsdVendor.DisableDropdown = False Then
        txtLocation.Text = nsdVendor.getSelValueAt(3)
    End If
    
    nsdStock.sqlwCondition = "VendorID = " & nsdVendor.Tag
End Sub

Private Sub txtdisc_Change()
    txtQty_Change
End Sub

Private Sub txtdisc_Click()
    txtQty_Change
End Sub

Private Sub cmdCancel_Click()
On Error Resume Next

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

Private Sub txtDisc_GotFocus()
    HLText txtDisc
End Sub

Private Sub txtdisc_Validate(Cancel As Boolean)
    txtDisc.Text = toNumber(txtDisc.Text)
End Sub

Private Sub CmdSave_Click()
    'Verify the entries
    If txtReturnSlipNo.Text = "" Then
        MsgBox "Please don't leave Return Slip No field blank.", vbInformation
        txtReturnSlipNo.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 Local_Purchase_Return
    Dim RSReturn As New Recordset

    RSReturn.CursorLocation = adUseClient
    RSReturn.Open "SELECT * FROM Purchase_Order_Return WHERE POReturnID=" & PK, CN, adOpenStatic, adLockOptimistic ', adCmdTable

    'Connection for Purchase_Order_Return_Detail
    Dim RSDetails As New Recordset

    RSDetails.CursorLocation = adUseClient
    RSDetails.Open "SELECT * FROM Purchase_Order_Return_Detail WHERE POReturnID=" & PK, CN, adOpenStatic, adLockOptimistic ', adCmdTable

    Screen.MousePointer = vbHourglass

    Dim c As Integer
    
    DeleteItems
    
    On Error GoTo erR

    'Save the record
    With RSReturn
        If State = adStateAddMode Or State = adStatePopupMode Then
            .AddNew
            ![POReturnID] = PK
            ![VendorID] = nsdVendor.Tag
            ![RefNo] = ReceivePK
            
            ![DateAdded] = Now
            ![AddedByFK] = CurrUser.USER_PK
        ElseIf State = adStateEditMode Then
            .Close
            .Open "SELECT * FROM Purchase_Order_Return WHERE POReturnID=" & PK, CN, adOpenStatic, adLockOptimistic
            
            ![DateModified] = Now
            ![LastUserFK] = CurrUser.USER_PK
        End If

        ![ReturnSlipNo] = txtReturnSlipNo.Text
        ![Date] = dtpDate.Value
        ![Status] = IIf(cboStatus.Text = "Returned", True, False)
        ![Notes] = txtNotes.Text
        
        ![Gross] = toNumber(txtGross(2).Text)
        ![Discount] = txtDesc.Text
        ![NetAmount] = toNumber(txtNet.Text)
                
        .Update
    End With
   
    With Grid
        'Save the details of the records
        For c = 1 To cIRowCount
            .Row = c
            If State = adStateAddMode Or State = adStatePopupMode Then
AddNew:
                'Add qty received in Local Purchase Details
                RSDetails.AddNew
            
                RSDetails![POReturnID] = PK
                RSDetails![StockID] = toNumber(.TextMatrix(c, 10))
                RSDetails![Qty] = toNumber(.TextMatrix(c, 3))
                RSDetails![Unit] = getUnitID(.TextMatrix(c, 4))
                RSDetails![Price] = toNumber(.TextMatrix(c, 5))
                RSDetails![Discount] = toNumber(.TextMatrix(c, 7)) / 100
                RSDetails![ReturnType] = .TextMatrix(c, 9)
    
                RSDetails.Update
            ElseIf State = adStateEditMode Then
                RSDetails.Filter = "StockID = " & toNumber(.TextMatrix(c, 10))
            
                If RSDetails.RecordCount = 0 Then GoTo AddNew
            
                RSDetails![StockID] = toNumber(.TextMatrix(c, 10))
                RSDetails![Qty] = toNumber(.TextMatrix(c, 3))
                RSDetails![Unit] = getUnitID(.TextMatrix(c, 4))
                RSDetails![Price] = toNumber(.TextMatrix(c, 5))
                RSDetails![Discount] = toNumber(.TextMatrix(c, 7)) / 100
                RSDetails![ReturnType] = .TextMatrix(c, 9)
    
                RSDetails.Update
            End If
        Next c
    End With

    'Clear variables
    c = 0
    Set RSDetails = Nothing

    CN.CommitTrans

    blnSave = True

    HaveAction = True
    Screen.MousePointer = vbDefault

    If State = adStateAddMode Or State = adStateEditMode Then
        MsgBox "New record has been successfully saved.", vbInformation
        Unload Me
    End If

    Exit Sub
erR:
    blnSave = False
'    CN.RollbackTrans
'    CN.BeginTrans
    prompt_err erR, Name, "cmdSave_Click"
    Screen.MousePointer = vbDefault
End Sub

Private Sub cmdUsrHistory_Click()
    On Error Resume Next
    Dim tDate1 As String
    Dim tUser1 As String
    
    tDate1 = Format$(rs.Fields("DateAdded"), "MMM-dd-yyyy HH:MM AMPM")
    
    tUser1 = getValueAt("SELECT PK,CompleteName FROM tbl_SM_Users WHERE PK = " & rs.Fields("AddedByFK"), "CompleteName")
    
    MsgBox "Date Added: " & tDate1 & vbCrLf & _
           "Added By: " & tUser1 & vbCrLf & _
           "" & vbCrLf & _
           "Last Modified: n/a" & vbCrLf & _
           "Modified By: n/a", vbInformation, "Modification History"
           
    tDate1 = vbNullString
    tUser1 = vbNullString
End Sub

Private Sub Form_Activate()
    On Error Resume Next
    If CloseMe = True Then
        Unload Me
    Else
'        txtInvoiceNo.SetFocus
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then SendKeys ("{tab}")
End Sub

Private Sub Form_Load()
    InitGrid

    CN.BeginTrans
    
    Screen.MousePointer = vbHourglass
    
    'Check the form state
    If State = adStateAddMode Or State = adStatePopupMode Then
        InitNSD
        'Set the recordset
        rs.Open "SELECT * FROM qry_Forwarders_Receive WHERE ForwarderReceiveID=" & ReceivePK, CN, adOpenStatic, adLockOptimistic

        dtpDate.Value = Date
        Caption = "Create New Entry"
        cmdUsrHistory.Enabled = False
        
        GeneratePK
        DisplayForAdding
    Else
        'Set the recordset
        rs.Open "SELECT * FROM qry_Purchase_Order_Return WHERE POReturnID=" & PK, CN, adOpenStatic, adLockOptimistic
        
        If State = adStateViewMode Then
            cmdCancel.Caption = "Close"
                   
            DisplayForViewing
        Else
            InitNSD
            DisplayForEditing
            
            nsdStock.sqlwCondition = "VendorID = " & rs!VendorID
        End If
        
    End If
    
    Screen.MousePointer = vbDefault
End Sub

'Procedure used to generate PK
Private Sub GeneratePK()
    PK = getIndex("Purchase_Order_Return")
End Sub

Private Sub ResetEntry()
    'nsdStock.ResetValue
    txtPrice.Tag = 0
    txtPrice.Text = "0.00"
    txtQty.Text = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
'    If HaveAction = True Then
'        frmPOReturn.RefreshRecords
'    End If
    
    Set frmPOReturnAE = Nothing
End Sub

Private Sub Grid_Click()
    With Grid
        If State = adStateViewMode Then Exit Sub
    
        dcUnit.Text = ""
        On Error Resume Next
        bind_dc "SELECT * FROM qry_Unit WHERE StockID=" & .TextMatrix(.RowSel, 10), "Unit", dcUnit, "UnitID", True
        On Error GoTo 0
    
        nsdStock.Text = .TextMatrix(.RowSel, 2)
        nsdStock.Tag = .TextMatrix(.RowSel, 10) 'Add tag coz boundtext is empty
        txtQty = .TextMatrix(.RowSel, 3)
        
        dcUnit.Text = .TextMatrix(.RowSel, 4)
        txtPrice = toMoney(.TextMatrix(.RowSel, 5))
        txtGross(1) = toMoney(.TextMatrix(.RowSel, 6))
        txtDisc = toMoney(.TextMatrix(.RowSel, 7))
        txtNetAmount = toMoney(.TextMatrix(.RowSel, 8))
        cboReturnType = .TextMatrix(.RowSel, 9)
        
        If Grid.Rows = 2 And Grid.TextMatrix(1, 10) = "" Then
            btnRemove.Visible = False
        Else
            btnRemove.Visible = True
            btnRemove.Top = (Grid.CellTop + Grid.Top) - 20
            btnRemove.Left = Grid.Left + 50
        End If
    End With
End Sub

Private Sub Grid_Scroll()
    btnRemove.Visible = False
End Sub

Private Sub Grid_SelChange()
    Grid_Click
End Sub