frmpurchases.frm

This file came from Planet-Source-Code.com...the home millions of lines of source code You can view

Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmbPID_Click()

Dim rsProdName As Recordset
Set rsProdName = New ADODB.Recordset


rsProdName.Open "Select * from Medicine_Details where ProductID = '" & cmbPID & "'", cnPatients, adOpenDynamic, adLockReadOnly


If rsProdName.RecordCount > 1 Then
    MsgBox " Database Error"
    Exit Sub
Else
    txtPName = rsProdName(1)
    txtunits = rsProdName(4)
    txtRPU = rsProdName(5)
End If

rsProdName.Close

End Sub

Private Sub cmbSID_Click()

Dim rsSupplierName As Recordset
Set rsSupplierName = New ADODB.Recordset


rsSupplierName.Open "Select * from Suppliers where SupplierID = '" & cmbSID & "'", cnPatients, adOpenDynamic, adLockReadOnly


If rsSupplierName.RecordCount > 1 Then
    MsgBox " Database Error"
    Exit Sub
Else
    txtSName = rsSupplierName(1)
    txtSCName = rsSupplierName(2)
    
End If

rsSupplierName.Close


End Sub

Private Sub cmdAddList_Click()

'On Error Resume Next
    Dim rsMed As Recordset
    Dim i As Integer
    
          
If MFG.Rows > 2 Then
    For i = 1 To MFG.Rows - 2 Step 1
        If MFG.TextMatrix(i, 2) = cmbPID Then
            MsgBox "Medicine Already Exist In The List Cannot Add Same Medicine Again.....", vbCritical + vbOKOnly
            Exit Sub
        End If
    Next i
End If

If txtAmount = "" Or txtNet = "" Or txtunits = "" Or txtRPU = "" Then
    MsgBox "Please Enter the relevant Fields"
    Exit Sub
End If
If Val(txtUPurchased) = 0 Then
    MsgBox "Quantity Cannot be Zero", vbCritical
    Exit Sub
End If




Row = MFG.Rows - 1
With MFG

        .Rows = .Rows + 1
                
        MFG.TextMatrix(Row, 1) = txtBillID
        MFG.TextMatrix(Row, 2) = cmbPID
        MFG.TextMatrix(Row, 3) = txtPName
        MFG.TextMatrix(Row, 4) = txtUPurchased
        MFG.TextMatrix(Row, 5) = txtRPU
        MFG.TextMatrix(Row, 6) = txtdis
        MFG.TextMatrix(Row, 7) = txtNet
        
          
  
    .FixedRows = 1
    .RowHeight(0) = .RowHeight(1) * 1.5
     Functions.SizeColumns MFG, Me
     MFGVALUES
     
     Row = Row + 1
     
End With


cmbSID.Enabled = False
Call CalcFinal
Call TextClear


End Sub
Public Sub CalcFinal()

Dim amount As Double
Dim Discount As Double
Dim Total As Double

If MFG.Rows > 2 Then
    For i = 1 To MFG.Rows - 2 Step 1
        amount = amount + (Val(MFG.TextMatrix(i, 5)) * Val(MFG.TextMatrix(i, 4)))
        Discount = Discount + MFG.TextMatrix(i, 6)
        Total = Total + MFG.TextMatrix(i, 7)
        
    Next i
End If
txtgrndtot = amount
txtdisgvn = Discount
txtpayable = Total
Debug.Print Val(amount) - Val(Discount)

End Sub

Public Sub TextClear()
txtunits = ""
txtUPurchased = ""
txtdis = ""
txtAmount = ""
txtNet = ""

cmbPID_Click
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdDelete_Click()
Dim selectedRow As Integer
selectedRow = MFG.Row


If selectedRow = MFG.Rows - 1 Then
    MsgBox "Invalid Selection.", vbCritical
    Exit Sub
End If


If Not MFG.TextMatrix(1, 1) = "" Then
    MFG.RemoveItem (selectedRow)
    Call CalcFinal
End If
End Sub

Private Sub cmdSave_Click()
   
   If MFG.Rows = 2 Then
    MsgBox "Please Add Items to list before you save", vbCritical, "Error Occured"
    Exit Sub
   End If

Dim flag, flag1, flag2 As Boolean

flag = False
flag1 = False
flag2 = False


    Dim rsOrderID As Recordset
    Dim OID As String
    Set rsOrderID = New ADODB.Recordset
    
    rsOrderID.Open " Select * from Purchase_Orders", cnPatients, adOpenDynamic, adLockPessimistic

    
    
    rsOrderID.AddNew
        rsOrderID(0) = txtBillID
        rsOrderID(1) = cmbSID
        rsOrderID(2) = DTPDate
        
    rsOrderID.Update
    flag = True
    
    rsOrderID.Close
    
Dim rsMed As Recordset
Set rsMed = New ADODB.Recordset
Dim MID As String
Dim RQuantity As Integer

Dim rsAddPatient As Recordset
Set rsAddPatient = New ADODB.Recordset
Dim rsStock As Recordset
Set rsStock = New ADODB.Recordset

    

rsMed.Open "SELECT * FROM Purchase_Orde_Details", cnPatients, adOpenDynamic, adLockPessimistic

For i = 1 To MFG.Rows - 2 Step 1

    ' Generating Purchase Order Details ID
    MID = Functions.UID(6, "PODRDTL_")
    rsAddPatient.Open " Select * from Purchase_Orde_Details", cnPatients, adOpenDynamic, adLockReadOnly
    If rsAddPatient.EOF = False Then
    While rsAddPatient.EOF = False
        If rsAddPatient(0) = MID Then
            MID = Functions.UID(6, "PODRDTL_")
            rsAddPatient.MoveFirst
        End If
    rsAddPatient.MoveNext
    Wend
    End If
    rsAddPatient.Close

        With rsMed
            .AddNew
                !PurchaseOrderDetailID = MID
                !PurchaseOrderID = txtBillID
                !PurchaseProductID = MFG.TextMatrix(i, 2)
                !PurchaseQUANTITY = Val(MFG.TextMatrix(i, 4))
                !PurchaseUnitPrice = Val(MFG.TextMatrix(i, 5))
                !PurchaseDiscount = Val(MFG.TextMatrix(i, 6))
                !NetValue = txtpayable
             .Update
             flag1 = True
        End With
        
        rsStock.Open "select * from Medicine_Details where ProductID= '" & MFG.TextMatrix(i, 2) & "'", cnPatients, adOpenDynamic, adLockPessimistic
        If rsStock.EOF = False Then
            rsStock(4) = rsStock(4) + Val(MFG.TextMatrix(i, 4))
            rsStock.Update
            flag2 = True
        End If
        rsStock.Close
Next
rsMed.Close
If flag = True And flag2 = True And flag1 = True Then
    MsgBox "Record Saved Succesfully !!", vbInformation, "Record Added"
    cmdSave.Enabled = False
Else
    MsgBox "An Error Occured while saving to the database", vbCritical
    Exit Sub
End If



End Sub



Private Sub cmdVProducts_Click()
FrmVProducts.Show
End Sub

Private Sub cndew_Click()
Dim ctl As Control

For Each ctl In Controls
    If TypeOf ctl Is TextBox Then
        ctl.Text = ""
    End If
Next
cmbSID.Enabled = True
cmdSave.Enabled = True
MFG.clear
MFG.Refresh
MFG.Rows = 2
Call Form_Load


End Sub

Private Sub Form_Load()

Call SetData
Call BillID
Call ProdDetails
Call MFGVALUES

End Sub

Public Sub SetData()

Dim rsSuppliers As Recordset
Set rsSuppliers = New ADODB.Recordset

  mbDataChanged = False
  rsSuppliers.Open "select * from Suppliers", cnPatients, adOpenDynamic, adLockOptimistic

rsSuppliers.MoveFirst

cmbSID.clear
While rsSuppliers.EOF = False
cmbSID.AddItem rsSuppliers(0)
rsSuppliers.MoveNext

Wend
rsSuppliers.Close


End Sub

Public Sub BillID()

   Dim BID As String
   Dim rsOrderID As Recordset
   Set rsOrderID = New ADODB.Recordset
    ' Generatin Order Details ID
        
    BID = Functions.UID(6, "MODRID_")
    rsOrderID.Open " Select * from Purchase_Orders", cnPatients, adOpenDynamic, adLockPessimistic
    If rsOrderID.EOF = False Then
    While rsOrderID.EOF = False
        If rsOrderID(0) = BID Then
            BID = Functions.UID(6, "MODRID_")
            rsOrderID.MoveFirst
        End If
    rsOrderID.MoveNext
    Wend
    End If
txtBillID = BID
rsOrderID.Close

End Sub

Public Sub MFGVALUES()
MFG.TextMatrix(0, 1) = "ORDER ID"
MFG.TextMatrix(0, 2) = "PRODUCT ID"
MFG.TextMatrix(0, 3) = "PRODUCT NAME"
MFG.TextMatrix(0, 4) = "QUANTITY"
MFG.TextMatrix(0, 5) = "UNIT PRICE"
MFG.TextMatrix(0, 6) = "DISCOUNT"
MFG.TextMatrix(0, 7) = "TOTAL AMOUNT"
Functions.SizeColumnHeaders MFG, Me

End Sub

Public Sub ProdDetails()

Dim rsAddProd As Recordset
Set rsAddProd = New ADODB.Recordset

rsAddProd.Open "Select * from Medicine_Details", cnPatients, adOpenDynamic, adLockReadOnly


cmbPID.clear
If rsAddProd.EOF = False Then
rsAddProd.MoveFirst

While rsAddProd.EOF = False
    cmbPID.AddItem rsAddProd(0)
    cmbPID.Text = rsAddProd(0)
    rsAddProd.MoveNext
Wend


End If

rsAddProd.Close


End Sub



Private Sub txtdis_Change()
txtAmount = Val(txtRPU) * Val(txtUPurchased)
txtNet = Val(txtAmount) - Val(txtdis)
End Sub

Private Sub txtUPurchased_Change()

txtAmount = Val(txtRPU) * Val(txtUPurchased)
txtNet = Val(txtAmount) - Val(txtdis)
End Sub


Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 22 Then KeyAscii = 0: Exit Sub
    KeyAscii = DataEntryValidation(KeyAscii, ActiveControl.Tag)
End Sub