frmreceiptsae.frm

Inventory control system

        intTotalOnhand = GetTotalQty("Onhand", RSStockUnit!Order, RSStockUnit!Onhand, RSStockUnit)
        If intTotalOnhand >= 0 Then
        
            If intQtyOrdered > intTotalOnhand Then
                intExcessQty = intQtyOrdered - intTotalOnhand
                
                intTotalIncoming = GetTotalQty("Incoming", RSStockUnit!Order, RSStockUnit!Incoming, RSStockUnit)
                
                If intTotalIncoming > 0 And intTotalIncoming >= intExcessQty Then
                    intSuggestedQty = intExcessQty
                    With frmSuggestedQty
                        .intStockID = intStockID
                        .strProduct = nsdStock.Text
                        .intQtyOrdered = intTotalOnhand
                        .intQtySuggested = intExcessQty
                        
                        .show 1
                            
                        If .blnUseSuggestedQty = True And .blnCancel = False Then
                            blnAddIncoming = True
                            intSuggestedQty = intExcessQty
                        ElseIf .blnCancel = True Then
                            Exit Sub
                        End If
                        
                        intQtyOrdered = intTotalOnhand
                    End With
                Else
                    With frmSuggestedQty
                        .intStockID = intStockID
                        .strProduct = nsdStock.Text
                        .intQtyOrdered = intTotalOnhand
                        .intQtySuggested = intTotalIncoming
                        
                        .show 1
                            
                        If .blnUseSuggestedQty = True And .blnCancel = False Then
                            blnAddIncoming = True
                            intSuggestedQty = intTotalIncoming
                            
                            intCount = 1
                        ElseIf .blnCancel = True Then
                            Exit Sub
                        End If
                        
                        intQtyOrdered = intTotalOnhand
                    End With
                End If
            End If
        End If
    Else
        MsgBox "Insufficient qty", vbInformation
        With frmCustomersItem
            .StockID = intStockID
            
            .show 1
            RSStockUnit.Close
            
            If .blnCancel = False Then
                GoSub GetOnhand
            Else
                Exit Sub
            End If
        End With
    End If
    
    GoSub Continue
err:
    prompt_err err, Name, "cmdSave_Click"
    Screen.MousePointer = vbDefault
End Sub

Private Function DeductOnhand(QtyNeeded As Integer, ByVal Order As Integer, ByVal blnDeduct As Boolean, RS As Recordset) As Boolean
    Dim Onhand As Boolean
    Dim OrderTemp As Integer
    Dim QtyNeededTemp As Double
    
Reloop:
    OrderTemp = Order
    QtyNeededTemp = QtyNeeded
    RS.Find "Order = " & OrderTemp
    
    
    Do Until Onhand = True 'Or OrderTemp = 1
        If RS!Onhand >= QtyNeededTemp Then
            If blnDeduct = False Then
                DeductOnhand = True
                Exit Function
            Else
                Onhand = True
            End If
            
            If QtyNeededTemp > 0 And QtyNeededTemp < 1 Then
                QtyNeededTemp = 1
            Else
                QtyNeededTemp = CInt(QtyNeededTemp)
            End If
        Else
            OrderTemp = OrderTemp - 1
            If OrderTemp < 1 Then Exit Do
            QtyNeededTemp = (QtyNeededTemp - RS!Onhand) / RS!Qty
            
            RS.MoveFirst
            
            RS.Find "Order = " & OrderTemp
        End If
    Loop
    
    If Onhand = True Then
        Do
            RS!Onhand = RS!Onhand - QtyNeededTemp
            OrderTemp = OrderTemp + 1
            
            RS.MoveFirst
            RS.Find "Order = " & OrderTemp
            
            RS!Onhand = RS!Onhand + (QtyNeededTemp * RS!Qty)
            
            RS.Update
            
            Onhand = False
            
            If OrderTemp = Order Then
                DeductOnhand = True
                Exit Do
            Else
                GoSub Reloop
            End If
        Loop
    Else
        DeductOnhand = False
    End If
End Function

'Get the total Qty onhand, incoming and total of onhand and incoming
Private Function GetTotalQty(strField As String, Order As Integer, intOnhand As Integer, RS As Recordset)
    Dim strFieldValue As Integer
    Dim intOrder As Integer
    
    GetTotalQty = intOnhand
    
    intOrder = Order - 1
    
    Do Until intOrder < 1
        RS.MoveFirst
        RS.Find "Order = " & intOrder
        
        If strField = "Onhand" Then
            strFieldValue = RS!Onhand
        ElseIf strField = "Incoming" Then
            strFieldValue = RS!Incoming
        Else
            strFieldValue = RS!TotalQty
        End If
        
        GetTotalQty = GetTotalQty + GetTotalUnitQty(Order, intOrder, strFieldValue, RS)
        intOrder = intOrder - 1
    Loop
End Function

'This function is called by GetTotalQty Function
Private Function GetTotalUnitQty(Order As Integer, ByVal Ordertmp As Integer, intOnhand As Integer, RS As Recordset)
    GetTotalUnitQty = 1
    Do Until Order = Ordertmp
        Ordertmp = Ordertmp + 1
        
        RS.MoveNext
        
        GetTotalUnitQty = GetTotalUnitQty * RS!Qty
    Loop
    GetTotalUnitQty = intOnhand * GetTotalUnitQty
End Function

Private Function GetIncoming(QtyNeeded As Integer, ByVal Order As Integer, ByVal blnDeduct As Boolean, RS As Recordset) As Boolean
    Dim Onhand As Boolean
    Dim OrderTemp As Integer
    Dim QtyNeededTemp As Double
    
Reloop:
    OrderTemp = Order
    QtyNeededTemp = QtyNeeded
    RS.Find "Order = " & OrderTemp
    
    
    Do Until Onhand = True 'Or OrderTemp = 1
        If RS!Incoming >= QtyNeededTemp Then
            If blnDeduct = False Then
                GetIncoming = True
                Exit Function
            Else
                Onhand = True
            End If
            
            If QtyNeededTemp > 0 And QtyNeededTemp < 1 Then
                QtyNeededTemp = 1
            Else
                QtyNeededTemp = CInt(QtyNeededTemp)
            End If
        Else
            OrderTemp = OrderTemp - 1
            If OrderTemp < 1 Then Exit Do
            QtyNeededTemp = (QtyNeededTemp - RS!Incoming) / RS!Qty
            
            RS.MoveFirst
            
            RS.Find "Order = " & OrderTemp
        End If
    Loop
    
    If Onhand = True Then
        Do
            RS!Incoming = RS!Incoming - QtyNeededTemp
            OrderTemp = OrderTemp + 1
            
            RS.MoveFirst
            RS.Find "Order = " & OrderTemp
            
            RS!Incoming = RS!Incoming + (QtyNeededTemp * RS!Qty)
            
            RS.Update
            
            Onhand = False
            
            If OrderTemp = Order Then
                GetIncoming = True
                Exit Do
            Else
                GoSub Reloop
            End If
        Loop
    Else
        GetIncoming = False
    End If
End Function

Private Sub btnRemove_Click()
    'Remove selected load product
    With Grid
        'Update grooss to current purchase amount
        cIGross = cIGross - toNumber(Grid.TextMatrix(.RowSel, 8))
        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
        cDAmount = cDAmount - toNumber(toNumber(.TextMatrix(.Rows - 1, 9)) / 100) * (toNumber(toNumber(Grid.TextMatrix(.RowSel, 3)) * toNumber(Grid.TextMatrix(.RowSel, 5))))
        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
        
        Dim RSStockUnit As New Recordset
        
        RSStockUnit.CursorLocation = adUseClient
        RSStockUnit.Open "SELECT * FROM qry_Stock_Unit WHERE StockID =" & toNumber(Grid.TextMatrix(Grid.RowSel, 11)), CN, adOpenStatic, adLockOptimistic
        
        'deduct qty from Stock Unit's table
        RSStockUnit.Filter = "UnitID = " & getValueAt("SELECT UnitID,Unit FROM Unit WHERE Unit='" & .TextMatrix(Grid.RowSel, 4) & "'", "UnitID")

        RSStockUnit!Onhand = RSStockUnit!Onhand + toNumber(Grid.TextMatrix(Grid.RowSel, 3))

        RSStockUnit.Update
        
        RSStockUnit.Close
        
        'Save to stock card
        Dim RSStockCard As New Recordset

        RSStockCard.CursorLocation = adUseClient
        RSStockCard.Open "SELECT * FROM Stock_Card WHERE StockID = " & toNumber(Grid.TextMatrix(Grid.RowSel, 11)) & " AND RefNo2 = '" & txtRefNo.Text & "'", CN, adOpenStatic, adLockOptimistic
        
        RSStockCard!Pieces2 = RSStockCard!Pieces2 - toNumber(Grid.TextMatrix(Grid.RowSel, 3))
        
        RSStockCard.Update
        
        RSStockCard.Close
        
    If .Rows = 2 Then Grid.Rows = Grid.Rows + 1
        .RemoveItem (.RowSel)
    End With

    btnRemove.Visible = False
    Grid_Click
End Sub

Private Sub cboStatus_Click()
    If cboStatus.ListIndex = 0 And ReceiptBatchPK = 0 Then 'Sold
        cmdSave.Caption = "&Payment"
    Else 'Save
        cmdSave.Caption = "&Save"
    End If
End Sub

Private Sub ckFree_Click()
    If ckFree.Value = 1 Then 'If checked
        txtDisc.Text = "0"
'        txtDisc.Visible = False
        txtGross(1).Text = "0"
'        txtGross(1).Visible = False
        txtNetAmount.Text = "0.00"
'        txtNetAmount.Visible = False
'        Labels(17).Visible = False
'        Labels(14).Visible = False
'        Label1.Visible = False
    Else
        txtQty_Change
        
        txtGross(1).Visible = True
        txtDisc.Visible = True
        txtNetAmount.Visible = True
        Labels(17).Visible = True
        Labels(14).Visible = True
        Label1.Visible = True
    End If
End Sub

Private Sub cmdPrint_Click()
    Unload frmReports

    With frmReports
        .strReport = "Receipt Form Report"
        .strWhere = "{qry_Receipt_Form.ClientID} = " & nsdClient.Tag & " AND {qry_Receipt_Form.ReceiptID} = " & PK
        
        LoadForm frmReports
    End With
End Sub

Private Sub CmdTasks_Click()
    PopupMenu mnu_Tasks
End Sub

Private Sub dcRoute_Click(Area As Integer)
    Dim strRoute As String
    
    strRoute = getValueAt("SELECT Route, RouteID FROM Routes WHERE RouteID=" & dcRoute.BoundText, "Route")
    chkAddCharges.Value = changeTFValue(CStr(getValueAt("SELECT AddCharges, RouteID FROM Routes WHERE RouteID=" & dcRoute.BoundText, "AddCharges")))
    txtRefNo.Text = strRoute & Format(Date, "yy") & Format(PK, "000000")
End Sub

Private Sub dcUnit_Change()
    If dcUnit.Text = "" Then Exit Sub
    
    txtPrice.Text = toMoney(getValueAt("SELECT SalesPrice,ExtPrice FROM qry_Stock_Unit WHERE StockID= " & nsdStock.Tag & " AND UnitID = " & dcUnit.BoundText & "", "SalesPrice"))
    cSalesPrice = txtPrice.Text
    
    txtQty_Change
'    Validate_ExtPrice
End Sub

Private Sub mnu_History_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 mnu_Return_Click()
    Dim RSSalesReturn As New Recordset

    RSSalesReturn.CursorLocation = adUseClient
    RSSalesReturn.Open "SELECT SalesReturnID FROM Sales_Return WHERE ReceiptID=" & PK, CN, adOpenStatic, adLockOptimistic
    
    With frmSalesReturnAE
        If RSSalesReturn.RecordCount > 0 Then 'if record exist then edit record
            Dim blnStatus As Boolean
            
            blnStatus = getValueAt("SELECT SalesReturnID,Status FROM Sales_Return WHERE SalesReturnID=" & RSSalesReturn!SalesReturnID, "Status")
            
            If blnStatus Then 'true
                .State = adStateViewMode
            Else
                .State = adStateEditMode
            End If
            
            .PK = RSSalesReturn!SalesReturnID
        Else
            .State = adStateAddMode
            .ReceiptPK = PK
        End If