Next Chapter 34 Diagnosis
Diagnosis
'******************************************************************
'******************************************************************
'** Author : Sameeullah
'** Phone No. : 0522-2647794
'** Mob. No. : 0522-9838068153
'** E-Mail : Welcome2001@indiatimes.comm
'** Subject : Item Group Creation DialogBox
'** Date : Friday, August, 01, 2003
'** Modified : Saturday, August, 02, 2003
'******************************************************************
'******************************************************************
Dim ADDMode As Boolean
Dim EditMode As Boolean
Dim Conn1 As New ADODB.Connection
Private Sub AddCmd_Click()
Dim DieseName, DieseCode As String
Call SetControls(False)
DieseName = InputBox("Enter Item Diese Name", "Diese Entry", , Me.Left + Me.Width + 50, 1050)
If Trim(DieseName) = "" Then GoTo ExitLable
Dim IGRst As New ADODB.Recordset
IGRst.CursorLocation = adUseClient
Conn1.BeginTrans
DieseCode = GetNextCode()
IGRst.Open "DIMast", Conn1, adOpenKeyset, adLockOptimistic, adCmdTable
With IGRst
.AddNew
!DICode = DieseCode
!DiName = StrConv(Trim(Left(DieseName, 50)), vbProperCase)
.Update
End With
Conn1.CommitTrans
Call PopulateDieseList
DieseList.SetFocus
ExitLable:
Call SetControls(True)
End Sub
Private Sub ExitCmd_Click()
Unload Me
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then Unload Me
End Sub
Private Sub Form_Load()
Set Conn1 = New ADODB.Connection
Conn1.CursorLocation = adUseClient
Conn1.Open ConnectString
Call PopulateDieseList
End Sub
Private Sub PopulateDieseList()
'To populating all groups in list
Dim SQL As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
SQL = "SELECT * FROM DiMast"
rst.Open SQL, Conn1, adOpenForwardOnly, adLockReadOnly, adCmdText
DieseList.View = lvwReport
DieseList.ColumnHeaders(1).Width = 5151.41 'Item Group
DieseList.ColumnHeaders(2).Width = 0 'Item Group Code
DieseList.ListItems.Clear
Do Until rst.EOF
With DieseList.ListItems.Add(, , rst!DiName)
.ListSubItems.Add , , rst!DICode
End With
rst.MoveNext
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Conn1.Close
Set Conn1 = Nothing
End Sub
Private Sub DieseList_AfterLabelEdit(Cancel As Integer, NewString As String)
On Error GoTo ErrLbl
Dim DieseCode, SQL As String
Dim Index As Integer
If DieseList.SelectedItem Is Nothing Then Exit Sub
Index = DieseList.SelectedItem.Index
If Trim(NewString) = "" Then
Cancel = True
MsgBox "Diese Name cannot be blank.", vbCritical, "Editing aborted"
GoTo EndLabel
End If
Dim IGRst As New ADODB.Recordset
IGRst.CursorLocation = adUseClient
Conn1.BeginTrans
DieseCode = DieseList.SelectedItem.SubItems(1)
SQL = "SELECT * FROM DiMast WHERE DICODE = " & DieseCode & ""
IGRst.Open SQL, Conn1, adOpenKeyset, adLockOptimistic, adCmdText
With IGRst
!DiName = StrConv(Trim(Left(NewString, 50)), vbProperCase)
.Update
End With
Conn1.CommitTrans
Call PopulateDieseList
DieseList.ListItems(Index).Selected = True
EndLabel:
DieseList.SetFocus
Call SetControls(True)
Exit Sub
ErrLbl:
ErrHandler "IGFrm.AfterLableEdit"
End Sub
Private Sub DieseList_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
With DieseList
.SortKey = ColumnHeader.Index - 1
.SortOrder = IIf(.SortOrder = lvwAscending, lvwDescending, lvwAscending)
.Sorted = True
End With
End Sub
Private Sub DieseList_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF2 Then
DieseList.StartLabelEdit
ElseIf KeyCode = vbKeyDelete Then
If MsgBox("This will delete selected item [" & DieseList.SelectedItem.Text & "] from the list. Are you sure to do this.", vbQuestion + vbYesNo + vbDefaultButton2, "Deletion Confirmation") = vbNo Then Exit Sub
' Dim Rst As New ADODB.Recordset
' Rst.CursorLocation = adUseClient
' Dim SQL As String
' SQL = "SELECT COUNT(*) FROM Medicine WHERE Diseases = '" & DieseList.SelectedItem.text & "'"
' Rst.Open SQL, Conn1, adOpenForwardOnly, adLockReadOnly, adCmdText
' If Not Rst(0) > 0 Then
Conn1.BeginTrans
Conn1.Execute "Delete FROM DiMast WHERE DICODE = " & DieseList.SelectedItem.SubItems(1) & "", , adCmdText
Conn1.CommitTrans
Call PopulateDieseList
DieseList.SetFocus
' Else
' MsgBox "The Diese you are trying to delete, could not be successful because Medicine of this Diseases is available.", vbCritical, "Deletion aborted"
' DieseList.SetFocus
' End If
End If
End Sub
Private Sub SetControls(ByVal Status As Boolean)
AddCmd.Enabled = Status
ExitCmd.Enabled = Status
End Sub
Private Function GetNextCode() As String
Dim RS As New ADODB.Recordset
RS.Open "Select Max(DICODE) From DiMast", Conn1, adOpenDynamic, adLockOptimistic
GetNextCode = GetProperCode(IIf(IsNull(RS(0)), "1", RS(0) + 1), 4)
End Function
Next Chapter 35 Discharge Ticket
Sponsored Links