Due to some technical error All Project source code & Project report are now available on www.ignousupport.blogspot.com Download all project for free
Anasthestic
Dim ADDMode As Boolean
Dim EditMode As Boolean
Dim EmptyTable As Boolean
Dim Conn1 As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim s As String
Private Sub SetControls()
AddCmd.Enabled = Not (ADDMode Or EditMode)
txtid.Enabled = (EditMode)
EditCMD.Enabled = Not (EmptyTable Or ADDMode Or EditMode)
SaveCmd.Enabled = (ADDMode Or EditMode)
CancelCmd.Enabled = (ADDMode Or EditMode)
DelCmd.Enabled = (Not EmptyTable) And (ADDMode Or EditMode)
ExitCmd.Enabled = Not (ADDMode Or EditMode)
Set DocSrch.BoundTextBox = IIf(EditMode, Me.txtid, Nothing)
If Not (ADDMode Or EditMode) Then DocSrch.HideList
On Error Resume Next
combotitle.SetFocus
End Sub
Private Sub AddCmd_Click()
On Error GoTo ErHand
ADDMode = True
Call ClearFields
Call SetControls
Conn1.BeginTrans
ErHand:
ErrHandler "DoctorFrm.AddCmd_Click()"
End Sub
Private Sub CancelCmd_Click()
On Error GoTo ErHand
ADDMode = False
EditMode = False
Call ClearFields
Call SetControls
Conn1.RollbackTrans
ErHand:
ErrHandler "DoctorFrm.AddCmd_Click()"
End Sub
Private Sub DelCmd_Click()
Dim Cancelled As Boolean
Dim SQL As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
Conn1.BeginTrans
If Me.txtid = "" Then MsgBox "Please select Doctor Name from list to delete.", vbCritical, "Doctor is not selected": Exit Sub
If MsgBox("This will delete the selected item [" & Me.combotitle & " " & Me.txtfirst & " " & Me.txtmiddle & " " & txtlast & "]. Are you sure to delete it ?", vbQuestion + vbYesNo + vbDefaultButton2, "Deletion Confirmation") = vbNo Then Cancelled = True: GoTo ExitLable
SQL = "DELETE FROM ACTrans WHERE ACCode = '" & txtaddress.Tag & "'"
Conn1.Execute SQL, , adCmdText
SQL = "DELETE FROM ACMast WHERE ACCode = '" & txtaddress.Tag & "'"
Conn1.Execute SQL, , adCmdText
SQL = "DELETE FROM Anaes WHERE ID = " & txtid & ""
Conn1.Execute SQL, , adCmdText
Conn1.CommitTrans
DocSrch.PopulateList
ExitLable:
If Cancelled Then Conn1.RollbackTrans
ADDMode = False
EditMode = False
Call ClearFields
Call SetControls
End Sub
Private Sub EditCmd_Click()
EditMode = True
Call SetControls
Call ClearFields
Conn1.BeginTrans
txtid.Enabled = True
Me.txtid.SetFocus
End Sub
Private Sub ExitCmd_Click()
Unload Me
End Sub
Private Sub SetSearchEngines()
'Called in Form_Load()
With DocSrch
.DBConnectString = ConnectString
.SQLString = "SELECT ID,convert(nvarchar,ID) + space(1) + Title + space(1) + FName + space(1) + MName + space(1) + LName FROM Anaes Order by ID "
.PopulateList
Set .BoundTextBox = Me.txtid
End With
End Sub
Private Sub Form_Load()
Set Conn1 = New ADODB.Connection
Conn1.CursorLocation = adUseClient
Conn1.Open ConnectString
Call SetSearchEngines
Call SetControls
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
If (ADDMode Or EditMode) Then
Cancel = True
Exit Sub
End If
Conn1.Close
Set Conn1 = Nothing
End Sub
Private Sub ClearFields()
'To Clear forms fields
'Called in AddCmd_Click()
Set rst = New ADODB.Recordset
rst.Open "select max(id) from Anaes", Conn1, adOpenDynamic, adLockOptimistic
If IsNull(rst.Fields(0)) = False Then
txtid = rst.Fields(0) + 1
Else
txtid = 1
End If
rst.Close
With Me
txtaddress = ""
txtaddress.Tag = ""
txtcity = ""
txtfirst = ""
txtlast = ""
txtmiddle = ""
combotitle = ""
comboidentity = ""
txtspel = ""
txtpin = ""
txtpo = ""
txtpr = ""
txtorg = ""
txtnotes = ""
txtmobile = ""
End With
End Sub
Private Sub SetFieldsValues(DocID As String)
'Set database values in the forms fields
'Called in ItemDBCtl_MoveComplete()
If DocID = "" Then Exit Sub
Set rst = New ADODB.Recordset
rst.Open "select * from Anaes where id = " & DocID & "", Conn1, adOpenDynamic, adLockOptimistic
On Error GoTo ErHand
'If Not (Rst.RecordCount > 0) Then Call ClearFields: Exit Sub
If rst.EOF Then rst.MoveLast
If rst.BOF Then rst.MoveFirst
With Me
combotitle = rst!Title
txtfirst = rst!FName
txtmiddle = rst!MName & ""
txtlast = rst!LName & ""
comboidentity = rst!iden & ""
txtspel = rst!speciality & ""
txtaddress = rst!Address & ""
txtcity = rst!City & ""
txtpin = rst!pincode & ""
txtpo = rst!PhoneOff & ""
txtpr = rst!PhoneRes & ""
txtmobile = rst!mobile & ""
txtnotes = rst!notes & ""
txtorg = rst!Hospital & ""
txtaddress.Tag = rst!AccountNo & ""
End With
ErHand:
ErrHandler "ItemFrm.AddCmd_Click()"
End Sub
Private Sub SaveCmd_Click()
If Not SavedData Then Exit Sub
Conn1.CommitTrans
DocSrch.PopulateList
ADDMode = False
EditMode = False
Call SetControls
End Sub
Private Sub Txtid_GotFocus()
If Not EditMode Then Exit Sub
DocSrch.SearchValue txtid
DocSrch.PopulateList
End Sub
Private Sub txtid_LostFocus()
If Not (ADDMode Or EditMode) Then Exit Sub
If Not Trim(txtid) = "" Then
Call SetFieldsValues(txtid.Text)
End If
End Sub
Private Function ValidateData() As Boolean
With Me
If Trim(.txtid) = "" Then
MsgBox "Please enter Doctor name.", vbCritical, "Missing values"
.txtid.SetFocus
ElseIf Trim(.txtfirst) = "" Then
MsgBox "Please Fill Doctor's First Name to edit.", vbCritical, "Missing values"
.txtfirst.SetFocus
ElseIf Trim(.txtaddress) = "" Then
MsgBox "Please Fill Address.", vbCritical, "Missing values"
.txtaddress.SetFocus
ElseIf Trim(.txtspel) = "" Then
MsgBox "Please Fill Specilist Field.", vbCritical, "Missing values"
.txtspel.SetFocus
Else
ValidateData = True
End If
End With
End Function
Private Function GetItemCode()
Dim RS As New ADODB.Recordset
RS.Open "Select Max(ID) From Anaes", Conn1, adOpenDynamic, adLockOptimistic
GetItemCode = GetProperCode(IIf(IsNull(RS(0)), "1", RS(0) + 1), 4)
End Function
Private Function SavedData() As Boolean
On Error GoTo ErrLbl
Dim AccountName As String
Dim GroupNO As String
If Not ValidateData Then Exit Function
AccountName = combotitle & " " & txtfirst & " " & txtmiddle & " " & txtlast
'*************** Anaesthetist Account Group Code
GroupNO = "Anaesthetist Account"
Dim SQL As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
If ADDMode Then
SQL = "SELECT * FROM Anaes"
Else
SQL = "SELECT * FROM Anaes WHERE ID = " & txtid & ""
End If
rst.Open SQL, Conn1, adOpenKeyset, adLockOptimistic, adCmdText
With Me
If ADDMode Then
rst.AddNew
txtid = GetItemCode()
rst("ID") = txtid
End If
txtaddress.Tag = SaveAccount(txtaddress.Tag, AccountName, GroupNO, ADDMode, txtcity, txtaddress, txtpo, txtpr, "Anaesthetist No : " & Val(txtid))
If txtaddress.Tag = "" Then Exit Function: Set rst = Nothing
rst("Title") = Trim(.combotitle) & ""
rst("FName") = Trim(.txtfirst) & ""
rst("MName") = Trim(.txtmiddle) & ""
rst("LName") = Trim(.txtlast) & ""
rst("IDEN") = Trim(.comboidentity) & ""
rst("Speciality") = Trim(.txtspel) & ""
rst("Address") = Trim(.txtaddress) & ""
rst("Mobile") = Trim(.txtmobile) & ""
rst("City") = Trim(.txtcity) & ""
rst("PINCode") = Trim(.txtpin) & ""
rst("PhoneOff") = Val(.txtpo) & ""
rst("PhoneRes") = Trim(.txtpr) & ""
rst("Notes") = Trim(.txtnotes) & ""
rst("Hospital") = Trim(.txtorg) & ""
rst("AccountNO") = Trim(.txtaddress.Tag) & ""
rst.Update
End With
SavedData = True
Exit Function
ErrLbl:
ErrHandler "Function ItemFrm.SavedData"
End Function
Private Sub cmdlist_Click()
Load Anaeslist
End Sub
Sponsored Links