frmassortedproductae.frm

Inventory control system

            'Increase the record count
            cIRowCount = cIRowCount + 1
        Else
            If MsgBox("Item already exist. Do you want to replace it?", vbQuestion + vbYesNo) = vbYes Then
                .Row = CurrRow
                                
                .TextMatrix(CurrRow, 1) = nsdStock.Text
                .TextMatrix(CurrRow, 2) = intQtyOrdered 'txtQty.Text
                .TextMatrix(CurrRow, 3) = dcUnit.Text
             
                'deduct qty from Stock Unit's table
                RSStockUnit.Filter = "UnitID = " & dcUnit.BoundText  'getValueAt("SELECT UnitID,Unit FROM Unit WHERE Unit='" & .TextMatrix(c, 4) & "'", "UnitID")
                
                RSStockUnit!Onhand = RSStockUnit!Onhand + intQtyOld
                
                RSStockUnit.Update
            Else
                Exit Sub
            End If
        End If
        
'        RSStockCard.Filter = "StockID = " & intStockID & " AND RefNo2 = '" & txtRefNo.Text & "'"
'
'        If RSStockCard.RecordCount = 0 Then RSStockCard.AddNew
'
'        'Deduct qty solt to stock card
'        RSStockCard!Type = "A" 'A for assorted product
'        RSStockCard!UnitID = dcUnit.BoundText
'        RSStockCard!RefNo2 = PK
'        RSStockCard!Pieces2 = intQtyOrdered
'        RSStockCard!StockID = intStockID
'
'        RSStockCard.Update
        
        RSStockUnit.Find "UnitID = " & dcUnit.BoundText

        'Deduct qty from highest unit breakdown if Onhand is less than qty ordered
        If RSStockUnit!Onhand < intQtyOrdered Then
            DeductOnhand intQtyOrdered, RSStockUnit!Order, True, RSStockUnit
        End If
        
        'deduct qty from Stock Unit's table
        RSStockUnit.Find "UnitID = " & dcUnit.BoundText
        
        RSStockUnit!Onhand = RSStockUnit!Onhand - intQtyOrdered
        
        RSStockUnit.Update
            
        'Highlight the current row's column
        .ColSel = 3
        'Display a remove button
        If blnAddIncoming = True Then
            intQtyOrdered = intSuggestedQty
            intCount = 2
            GoSub AddIncoming
            
'            blnAddIncoming = False
        End If
        
        Grid_Click
        'Reset the entry fields
        ResetEntry
    End With
    
    Exit Sub
    
GetOnhand:
    intTotalOnhInc = GetTotalQty("Total", RSStockUnit!Order, RSStockUnit!TotalQty, RSStockUnit)
    
    If intTotalOnhInc > 0 Then
    
        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) As Integer
    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 the record count
        cIRowCount = cIRowCount - 1
        
        If .Rows = 2 Then Grid.Rows = Grid.Rows + 1
        .RemoveItem (.RowSel)
    End With

    'Save to stock card
'    Dim RSStockCard As New Recordset
'
'    With RSStockCard
'        .CursorLocation = adUseClient
'        .Open "SELECT * FROM Stock_Card WHERE StockID = " & toNumber(Grid.TextMatrix(Grid.RowSel, 10)) & " AND RefNo2 = '" & txtRefNo.Text & "'", CN, adOpenStatic, adLockOptimistic
'
'        !Pieces2 = !Pieces2 - toNumber(Grid.TextMatrix(Grid.RowSel, 3))
'
'        .Update
'    End With
'
    btnRemove.Visible = False
    Grid_Click
End Sub

Private Sub CmdTasks_Click()
    PopupMenu mnu_Tasks
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 cmdCancel_Click()
On Error Resume Next

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

Private Sub cmdSave_Click()
On Error GoTo erR

    'Verify the entries
    If nsdProduct.Text = "" Then
        MsgBox "Please select a product.", vbExclamation
        nsdProduct.SetFocus
        Exit Sub
    End If
   
    If cIRowCount < 1 Then
        MsgBox "Please enter item to purchase before you can save this record.", vbExclamation
        nsdStock.SetFocus
        Exit Sub
    End If
              
    If MsgBox("This save the record. Do you want to proceed?", vbQuestion + vbYesNo) = vbNo Then Exit Sub

    Dim RSDetails As New Recordset

    RSDetails.CursorLocation = adUseClient
    RSDetails.Open "SELECT * FROM Assorted_Product_Detail WHERE AssortedProductID=" & PK, CN, adOpenStatic, adLockOptimistic

    Screen.MousePointer = vbHourglass

    Dim c As Integer

    DeleteItems
    
    'Save the record
    With rs
        If State = adStateAddMode Or State = adStatePopupMode Then
            .AddNew
            ![AssortedProductID] = PK
            ![StockID] = nsdProduct.BoundText
            
            ![DateAdded] = Now
            ![AddedByFK] = CurrUser.USER_PK
        ElseIf State = adStateEditMode Then
            .Close
            .Open "SELECT * FROM Assorted_Product WHERE AssortedProductID=" & PK, CN, adOpenStatic, adLockOptimistic
            
            ![DateModified] = Now
            ![LastUserFK] = CurrUser.USER_PK
        End If
        
        !Qty = txtQtyParent.Text
        !Date = dtpDate.Value
        ![Status] = IIf(cboStatus.Text = "Assorted", True, False)
        ![Notes] = txtNotes.Text

        .Update
    End With
    
    Dim intUnitsOrder As Integer
    Dim intQty As Integer
    
    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![AssortedProductID] = PK
                RSDetails![StockID] = toNumber(.TextMatrix(c, 4))
                RSDetails![Qty] = toNumber(.TextMatrix(c, 2))
                RSDetails![UnitID] = getUnitID(.TextMatrix(c, 3))
                
                RSDetails.Update
                
            ElseIf State = adStateEditMode Then
                RSDetails.Filter = "StockID = " & toNumber(.TextMatrix(c, 4))
            
                If RSDetails.RecordCount = 0 Then GoTo AddNew
                
                RSDetails![AssortedProductID] = PK
                RSDetails![StockID] = toNumber(.TextMatrix(c, 4))
                RSDetails![Qty] = toNumber(.TextMatrix(c, 2))
                RSDetails![UnitID] = getUnitID(.TextMatrix(c, 3))
                
                RSDetails.Update
                
            End If