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