frmorder.frm

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

If rsProductName.RecordCount > 1 Then
    MsgBox " Database Error"
    stock = 0
    txtStock = stock
    Exit Sub
ElseIf rsProductName.RecordCount = 0 Then
    txtmedname = ""
    txtRPU = "0.00"
    stock = 0

Else
    txtmedname = rsProductName(1)
    txtRPU = rsProductName(5)
    stock = rsProductName(4)
    
End If

txtStock = stock

rsProductName.Close

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 CalFinal
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
cmbPtID.Enabled = True
cmdSave.Enabled = True
MFG.clear
MFG.Refresh
MFG.Rows = 2
Call Form_Load
End Sub

Private Sub Command1_Click()
Dim strReport As String
Dim strTXT As String

strTXT = txtBillID.Text
strReport = App.Path & "\Reports\Pharmacy\invoice.rpt"
PInvoice.DiscardSavedData = True
PInvoice.ReportFileName = strReport
PInvoice.ReplaceSelectionFormula ("{OrderDetails.OrderID} = '" & strTXT & "'")
PInvoice.WindowState = crptMaximized
PInvoice.Action = 1
End Sub

Private Sub Command2_Click()
MsgBox MFG.Row
MsgBox MFG.Rows
End Sub

Private Sub Form_Load()

Call SetData
Call BillID
Call CustDetails
Call MFGVALUES
Command1.Enabled = False
DTPDate.Value = Date
DTPIssue.Value = Date

End Sub

Public Sub SetData()

Dim rsCategories As Recordset
Set rsCategories = New ADODB.Recordset

rsCategories.Open "select * from Medicine_Categories", cnPatients, adOpenDynamic, adLockOptimistic
cmbCID.clear
While rsCategories.EOF = False
cmbCID.AddItem rsCategories(0)
rsCategories.MoveNext

Wend
rsCategories.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 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

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 CustDetails()

Dim rsAddCust As Recordset
Set rsAddCust = New ADODB.Recordset

rsAddCust.Open "Select * from Customers", cnPatients, adOpenDynamic, adLockReadOnly

cmbPtID.clear
If rsAddCust.EOF = False Then
rsAddCust.MoveFirst

While rsAddCust.EOF = False
    cmbPtID.AddItem rsAddCust(0)
    rsAddCust.MoveNext
Wend


End If

rsAddCust.Close


End Sub







Private Sub txtdis_Change()
txtAmount = Val(txtRPU) * Val(txtqty)
txttotamt = Val(txtAmount) - Val(txtdis)
End Sub

Private Sub txtqty_Change()

txtAmount = Val(txtRPU) * Val(txtqty)
txttotamt = Val(txtAmount) - Val(txtdis)
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 txttotamt = "" Or txtqty = "" Or txtRPU = "" Then
    MsgBox "Please Enter the relevant Fields"
    Exit Sub
End If
If Val(txtqty) = 0 Then
    MsgBox "Quantity Cannot be Zero", vbCritical
    Exit Sub
End If
If Val(txtqty) > stock Then
    MsgBox "The Quantity Cannot be greater than Stock", vbCritical
    Exit Sub
End If
If cmbPtID = "" Then
    MsgBox "Please Select the Customer ID", vbCritical
    cmbPtID.SetFocus
    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) = txtmedname
        MFG.TextMatrix(Row, 4) = txtqty
        MFG.TextMatrix(Row, 5) = txtRPU
        MFG.TextMatrix(Row, 6) = txtdis
        MFG.TextMatrix(Row, 7) = txttotamt
        
  
    .FixedRows = 1
    .RowHeight(0) = .RowHeight(1) * 1.5
     Functions.SizeColumns MFG, Me
     MFGVALUES
     
     Row = Row + 1
     
End With

cmbPtID.Enabled = False

Call CalFinal
Call TextClear

End Sub
Public Sub CalFinal()
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 + Val(MFG.TextMatrix(i, 6))
        Total = Total + Val(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()
txtqty = ""
txtdis = ""
txtAmount = ""
txttotamt = ""

cmbPID_Click
End Sub



Private Sub cmdSave_Click()
    Dim rsOrderID As Recordset

   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

   
    Set rsOrderID = New ADODB.Recordset
   
    rsOrderID.Open " Select * from Orders", cnPatients, adOpenDynamic, adLockPessimistic
      
    
    rsOrderID.AddNew
        rsOrderID(0) = txtBillID
        rsOrderID(1) = cmbPtID
        rsOrderID(2) = DTPDate
    rsOrderID.Update
    flag2 = 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 OrderDetails", cnPatients, adOpenDynamic, adLockPessimistic

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

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

        With rsMed
            .AddNew
                !OrderDetailID = MID
                !OrderID = txtBillID
                !ProductID = MFG.TextMatrix(i, 2)
                !QUANTITY = MFG.TextMatrix(i, 4)
                !UNITPRICE = MFG.TextMatrix(i, 5)
                !Discount = Val(MFG.TextMatrix(i, 6))
                !NetValue = (Val(MFG.TextMatrix(i, 4)) * Val(MFG.TextMatrix(i, 5))) - Val(MFG.TextMatrix(i, 6))
            .Update
            flag = True
        End With
        
        ' Substract the stock from the products
        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
            flag1 = True
        End If
        rsStock.Close
Next

rsMed.Close

If flag = True And flag1 = True And flag2 = True Then
    MsgBox "Record Saved Succesfully !!"
Else
    MsgBox "Error Updating Record", vbCritical
End If

Command1.Enabled = True
cmdSave.Enabled = False



End Sub

Private Sub txtqty_LostFocus()
If Val(txtqty) > stock Then
    MsgBox "The Quantity Cannot be greater than Stock", vbCritical
End If

End Sub

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