Due to some technical error All Project source code & Project report are now available on www.ignousupport.blogspot.com Download all project for free
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