VB6总结I

一.现在有一patient default了，需要记录下。打开select record页面，从上游数据库（patient、foreigner、1stApptDefault）中选择出要做default记录的这个人的这一次疗程，然后把此人的此疗程的一些具体信息显示在个人信息页面，并添加remarks，最后存入default表中。如果此人不存在上有数据库中，则选择add，打开一个空白信息页面，输入所有信息，除了Reg Date，存入default表中，以后当此人从unnotify转为notify时，点击Reg Date旁边的select notify case按钮，此人的所有信息被上有数据库的信息替代显示。

1.输入UIN或Name或Reg Date，在patient表中选择符合条件的病人的所有疗程记录

Private Sub cmdSearchTB_Click()
    Dim strCase As String, strSQL As String
    Dim rstCase As New ADODB.Recordset
    Dim dtmServerDate As Date
    dtmServerDate = GetServerDate
        
    strCase = "select top 100 p.patient_sysgen_id, p.patient_uin, p.patient_name, p.sex, p.date_birth, c.case_sysgen_id, c.date_registration, c.nationality from patient_case c, patient p "
    strCase = strCase & " where c.patient_sysgen_id = p.patient_sysgen_id and ( 1=1 "
       
    If optPatientUIN.Value = True Then
        If Trim(txtUIN) = "" Then
            Call gclsMessage.Blank("UIN of the Patient", Me.Caption)
            txtUIN.SetFocus
            Exit Sub
        End If
        strCase = strCase & " and p.patient_uin='" + txtUIN.Text + "' "
    ElseIf optPatientName.Value = True Then
        If Trim(txtName) = "" Then
            Call gclsMessage.Blank("Name of the Patient", Me.Caption)
            txtName.SetFocus
            Exit Sub
        End If
        strCase = strCase & " and p.patient_name like '%" + txtName.Text + "%'  "
    ElseIf optRegDate.Value = True Then
        If maskFrom.ClipText = "" Or maskTo.ClipText = "" Then
            Call gclsMessage.Blank("Registration Date Range", Me.Caption)
            maskFrom.SetFocus
            Exit Sub
        End If
        If gclsValidate.ValidDate(maskFrom) = False Then
            Call gclsMessage.InvalidDate("Date From", Me.Caption)
            maskFrom.SetFocus
            Exit Sub
        End If
        If gclsValidate.ValidDate(maskTo) = False Then
            Call gclsMessage.InvalidDate("Date To", Me.Caption)
            maskTo.SetFocus
            Exit Sub
        End If
        If Not gclsValidate.DateCompare(maskFrom, maskTo) Then
            Call gclsMessage.WarnMessage("Date From must not be later than Date To.", Me.Caption)
            maskFrom.SetFocus
            Exit Sub
        End If
        If Not gclsValidate.DateCompare(maskFrom, Format(dtmServerDate, "dd/mm/yyyy")) Or Not gclsValidate.DateCompare(maskTo, Format(dtmServerDate, "dd/mm/yyyy")) Then
            Call gclsMessage.WarnMessage("Registration Date Range must not be a future date range.", Me.Caption)
            maskFrom.SetFocus
            Exit Sub
        End If
        strCase = strCase & " and c.date_registration >= convert(datetime,'" & maskFrom & "',103) and  c.date_registration <= convert(datetime, '" & maskTo & "', 103)"
    Else
        MsgBox "Select any option button and then press Retrieve.", vbInformation
        Exit Sub
    End If
      
    strCase = strCase & ")"
    
    Set rstCase = gcnn.Execute(strCase)
    If Not (rstCase.BOF And rstCase.EOF) Then
        strSQL = strCase
        Call LoadfgPatientList(strSQL)
    Else
        Call gclsMessage.Unnotify(, Me.Caption)
    End If
    
    cmdSelect.Enabled = True
    cmdSelect.BackColor = gENABLED
End Sub

2.在grid中显示符合条件的病人的所有疗程，一个疗程一行，自带highlight

Public Sub LoadfgPatientList(ByVal strSQL As String)
    Dim rstPatientList As New ADODB.Recordset
    Dim intPatientListRow As Integer

    Dim cmCommand As New ADODB.Command
    cmCommand.ActiveConnection = gcnn
    cmCommand.CommandType = adCmdText
    cmCommand.CommandTimeout = 1800

    txtUIN.Text = ""
    txtName.Text = ""

Set rstPatientList = gcnn.Execute(strSQL)
    intPatientListRow = 1
    fgPatientList.Rows = 1
If Not (rstPatientList.BOF And rstPatientList.EOF) Then
    Do While Not rstPatientList.EOF
        fgPatientList.Rows = fgPatientList.Rows + 1
        
        fgPatientList.TextMatrix(intPatientListRow, fPatientListHiddenFieldCol) = IIf(IsNull(rstPatientList("patient_sysgen_id")), "", rstPatientList("patient_sysgen_id"))
        fgPatientList.TextMatrix(intPatientListRow, fPatientListSNoCol) = intPatientListRow
        fgPatientList.TextMatrix(intPatientListRow, fPatientListUINCol) = IIf(IsNull(rstPatientList("patient_uin")), "", rstPatientList("patient_uin"))
        fgPatientList.TextMatrix(intPatientListRow, fPatientListNameCol) = IIf(IsNull(rstPatientList("patient_name")), "", rstPatientList("patient_name"))
        fgPatientList.TextMatrix(intPatientListRow, fPatientListRegDateCol) = IIf(IsNull(rstPatientList("date_registration")), "", Format(rstPatientList("date_registration"), "dd/mm/yyyy"))
        fgPatientList.TextMatrix(intPatientListRow, fPatientListGenderCol) = IIf(IsNull(rstPatientList("sex")), "", rstPatientList("sex"))
        fgPatientList.TextMatrix(intPatientListRow, fPatientListDOBCol) = IIf(IsNull(rstPatientList("date_birth")), "", Format(rstPatientList("date_birth"), "dd/mm/yyyy"))
        fgPatientList.TextMatrix(intPatientListRow, fPatientListNationalityCol) = IIf(IsNull(rstPatientList("nationality")), "", rstPatientList("nationality"))
        fgPatientList.TextMatrix(intPatientListRow, fPatientListCaseNoCol) = IIf(IsNull(rstPatientList("case_sysgen_id")), "", rstPatientList("case_sysgen_id"))
    
        rstPatientList.MoveNext
        intPatientListRow = intPatientListRow + 1
    Loop
End If
    
    fgPatientList.Row = glngRowbookmark
    fgPatientList.Col = fPatientListSNoCol
    
    If fgPatientList.Rows > 1 Then
        fgPatientList.Row = 1
    Else
        Call gclsMessage.RecordNotFound(, Me.Caption)
    End If
    
    fgPatientList.SelectionMode = 1
    Call gclsGrid.RowHighLight(fgPatientList)
    Screen.MousePointer = vbDefault
Exit Sub
End Sub

3.选择要加入Default记录的病人的特定疗程，在新的页面显示此病人的详细个人信息

1>选择在列表中显示出来的病人，并给予“PA”的标记

Private Sub cmdSelect_Click()
    If fgPatientList.Row <> fgPatientList.RowSel Then
        Call gclsMessage.WarnMessage("Only one row can be selected for editing.", Me.Caption)
        Exit Sub
    End If
    Me.MousePointer = vbHourglass

    glngTBPatientSysgenId = fgPatientList.TextMatrix(fgPatientList.RowSel, 0)
    glngTBPatientCaseId = fgPatientList.TextMatrix(fgPatientList.RowSel, 8)
    
    gstrDefaulterParticularsMode = "PA"
    frmDefaultersTracingMaint.Show
    Me.MousePointer = vbDefault
End Sub

2>如果上有数据库中没有记录，则选择add一个unnotify的病人，并给予“UA”的标记

Private Sub cmdAdd_Click()
    gstrDefaulterParticularsMode = "UA"
    frmDefaultersTracingMaint.Show
End Sub

4.点击grid顺序倒序排列

Private Sub fgPatientList_Click()
   With fgPatientList
        If .MouseRow = 0 Then
           .Col = .MouseCol
           .ColSel = .MouseCol
            If sortedBy = flexSortGenericAscending Then
               .Sort = flexSortGenericDescending
               sortedBy = flexSortGenericDescending
            Else
                .Sort = flexSortGenericAscending
                sortedBy = flexSortGenericAscending
            End If
        End If
   End With
End Sub

5.按UIN、Name、Reg Date查询数据时，空间的可见和隐藏

Private Sub optPatientUIN_Click()
    Call EnablePatientUIN
    Call DisablePatientName
    Call DisableRegDate
End Sub

Private Sub optPatientName_Click()
    Call DisablePatientUIN
    Call EnablePatientName
    Call DisableRegDate
End Sub

Private Sub optRegDate_Click()
    Call DisablePatientUIN
    Call DisablePatientName
    Call EnableRegDate
End Sub

Private Sub EnablePatientUIN()
    txtUIN.Text = ""
    txtUIN.Enabled = True
    txtUIN.BackColor = gENABLED
'    txtUIN.SetFocus
End Sub

Private Sub DisablePatientUIN()
    txtUIN.Text = ""
    txtUIN.Enabled = False
    txtUIN.BackColor = gDISABLED
End Sub

Private Sub EnablePatientName()
    txtName.Text = ""
    txtName.Enabled = True
    txtName.BackColor = gENABLED
    txtName.SetFocus
End Sub

Private Sub DisablePatientName()
    txtName.Text = ""
    txtName.Enabled = False
    txtName.BackColor = gDISABLED
End Sub

Private Sub EnableRegDate()
    maskFrom.Enabled = True
    maskFrom.BackColor = gENABLED
    maskTo.Enabled = True
    maskTo.BackColor = gENABLED
    maskFrom.SetFocus
End Sub

Private Sub DisableRegDate()
    maskFrom.Mask = ""
    maskFrom.Text = ""
    maskFrom.Mask = "99/99/9999"
    maskFrom.Enabled = False
    maskFrom.BackColor = gDISABLED
    
    maskTo.Mask = ""
    maskTo.Text = ""
    maskTo.Mask = "99/99/9999"
    maskTo.Enabled = False
    maskTo.BackColor = gDISABLED
End Sub