Next Chapter 36 Doctor Entry
PROJECT SOURCE CODE
SPONSORED LINKS
Doctor Entry
Dim ADDMode As Boolean
Dim EditMode As Boolean
Dim EmptyTable As Boolean
Dim rst As New ADODB.Recordset
Dim s As String
Private Sub SetControls()
'Set Forms Control's status
'Called in Form_Load(), Navigation Buttons Click()
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
Me.combotitle.SetFocus
End Sub
Private Sub AddCmd_Click()
On Error GoTo ErHand
ADDMode = True
Call ClearFields
Call SetControls
Conn.BeginTrans
ErHand:
ErrHandler "DoctorFrm.AddCmd_Click()"
End Sub
Private Sub CancelCmd_Click()
On Error GoTo ErHand
ADDMode = False
EditMode = False
Call ClearFields
Call SetControls
Conn.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
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
'Delete Item
SQL = "DELETE FROM ACTrans WHERE ACCode = '" & txtaddress.Tag & "'"
Conn.Execute SQL, , adCmdText
SQL = "DELETE FROM ACMast WHERE ACCode = '" & txtaddress.Tag & "'"
Conn.Execute SQL, , adCmdText
SQL = "DELETE FROM DocMast WHERE ID = " & txtid & ""
Conn.Execute SQL, , adCmdText
Conn.CommitTrans
DocSrch.PopulateList
ExitLable:
If Cancelled Then Conn.RollbackTrans
ADDMode = False
EditMode = False
Call ClearFields
Call SetControls
End Sub
Private Sub EditCmd_Click()
EditMode = True
Call SetControls
Call ClearFields
Conn.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 DocMast Order by ID "
.PopulateList
Set .BoundTextBox = Me.txtid
End With
End Sub
Private Sub Form_Load()
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
End Sub
Private Sub ClearFields()
'To Clear forms fields
'Called in AddCmd_Click()
Set rst = New ADODB.Recordset
rst.Open "select max(id) from docmast", Conn, 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 docmast where id = " & DocID & "", Conn, adOpenDynamic, adLockOptimistic
On Error GoTo ErHand
If rst.EOF Then 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
Conn.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
' Set DocSrch.BoundTextBox = Nothing
' DocSrch.HideList
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 DocMast", Conn, adOpenDynamic, adLockOptimistic
GetItemCode = GetProperCode(IIf(IsNull(RS(0)), "1", RS(0) + 1), 4)
End Function
Private Function SavedData() As Boolean
On Error GoTo ErrLbl
If Not ValidateData Then Exit Function
Dim AccountName As String
Dim GroupNO As String
AccountName = combotitle & " " & txtfirst & " " & txtmiddle & " " & txtlast
'*************** Doctor Account Group Code
GroupNO = "Doctor Account"
' Create A New Account For This Doctor Or Update A Existing Account *********
Dim SQL As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
If ADDMode Then
SQL = "SELECT * FROM DocMast"
Else
SQL = "SELECT * FROM DocMast WHERE ID = " & txtid & ""
End If
rst.Open SQL, Conn, 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, "Doctor No :" & Val(txtid))
If txtaddress.Tag = "" Then Set rst = Nothing: Exit Function
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 DoctorList
End Sub
Next Chapter 37 Financial Ledger
Sponsored Links