Next Chapter 21 Anasthestic
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