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

Next Chapter 22 Appointment