frmfollowvisit.frm

1、以DLL形式提供医生工作站 2、 根据【检查项目】

VERSION 5.00
Object = "{806F1F89-D431-4F37-A387-2868CC03DCA8}#48.0#0"; "GetData.ocx"
Begin VB.Form frmFollowVisit 
   Caption         =   "随访记录"
   ClientHeight    =   6225
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9855
   LinkTopic       =   "Form1"
   ScaleHeight     =   6225
   ScaleWidth      =   9855
   Begin VB.CheckBox chkAddFollowVisit 
      Caption         =   "是否将该病历加入到随访病历库"
      ForeColor       =   &H000000FF&
      Height          =   315
      Left            =   45
      TabIndex        =   7
      Top             =   5805
      Width           =   3510
   End
   Begin GetData.XPB btnBack 
      Height          =   450
      Left            =   8460
      TabIndex        =   6
      Top             =   5730
      Width           =   1155
      _ExtentX        =   2037
      _ExtentY        =   794
      Caption         =   "返回"
      FontColor       =   -2147483630
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Frame frmFollowVisit 
      Caption         =   "临床病史"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   5595
      Left            =   30
      TabIndex        =   0
      Top             =   15
      Width           =   4740
      Begin VB.TextBox txtMedicalRecord 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   5160
         Left            =   105
         MultiLine       =   -1  'True
         TabIndex        =   2
         Top             =   300
         Width           =   4500
      End
   End
   Begin GetData.XPB btnOK 
      Height          =   450
      Left            =   5565
      TabIndex        =   4
      Top             =   5730
      Width           =   1155
      _ExtentX        =   2037
      _ExtentY        =   794
      Caption         =   "保存记录"
      FontColor       =   -2147483630
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Frame Frame2 
      Caption         =   "随访记录"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   5565
      Left            =   4860
      TabIndex        =   1
      Top             =   30
      Width           =   4860
      Begin VB.TextBox txtFollowVisit 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   5160
         Left            =   135
         MultiLine       =   -1  'True
         TabIndex        =   3
         Top             =   285
         Width           =   4590
      End
   End
   Begin GetData.XPB btnClear 
      Height          =   450
      Left            =   7020
      TabIndex        =   5
      Top             =   5730
      Width           =   1155
      _ExtentX        =   2037
      _ExtentY        =   794
      Caption         =   "清空记录"
      FontColor       =   -2147483630
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
End
Attribute VB_Name = "frmFollowVisit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'----------------------------------------------------------------------------------------------------
'文件：frmFollowVisit.frm
'作者：刘辉
'时间：2008-09-20
'说明：随访记录
'----------------------------------------------------------------------------------------------------



Option Explicit

Dim myConn As New ADODB.Connection

Public curList_ID As String

Private Sub btnBack_Click(Shifit As Integer)
On Error GoTo ErrHandler
    Unload Me
    frmReportEdit.SetFocus
    Exit Sub
ErrHandler:
     MsgBox Err.Description, vbExclamation, "提示"
End Sub

Private Sub btnClear_Click(Shifit As Integer)
On Error GoTo ErrHandler
    txtFollowVisit.Text = ""
    txtMedicalRecord.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "清空失败：" + Err.Description, vbExclamation, "提示"
End Sub

Private Sub btnOK_Click(Shifit As Integer)
On Error GoTo ErrHandler
    Dim strIs_Visit As String
    
    If chkAddFollowVisit.Value = 1 Then
        strIs_Visit = "是"
    Else
        strIs_Visit = "否"
    End If
    
    If curList_ID = "" Then
        MsgBox "患者信息错误，请重新选择患者记录！", vbExclamation, "提示"
        Unload Me
        Exit Sub
    End If
    
    Dim strSql As String
    Dim rsVisit As New ADODB.Recordset
    strSql = "UPDATE CHECK_LIST SET IS_VISIT = '" + strIs_Visit
    If Trim(txtFollowVisit.Text) <> "" Then
        strSql = strSql + "',FOLLOW_VISIT = '" + txtFollowVisit.Text
    End If
    If Trim(txtMedicalRecord.Text) <> "" Then
        strSql = strSql + "',MEDICAL_RECORD = '" + txtMedicalRecord.Text
    End If
        strSql = strSql + "' WHERE ID = '" + curList_ID + "'"
    If myConn.State = adStateClosed Then
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Sub
    End If
    
    If rsVisit.State = adStateOpen Then
        rsVisit.Close
    End If
    
    rsVisit.Open strSql, myConn
     
    MsgBox "保存成功", vbExclamation, "提示"
    Exit Sub
ErrHandler:
    MsgBox "保存失败：" + Err.Description, vbExclamation, "提示"
End Sub