frmreportedit.frm

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

         BackStyle       =   0  'Transparent
         Caption         =   "姓    名"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00000000&
         Height          =   240
         Left            =   3555
         TabIndex        =   16
         Top             =   360
         Width           =   855
      End
      Begin VB.Label lblPSex 
         BackColor       =   &H00E0E0E0&
         BackStyle       =   0  'Transparent
         Caption         =   "性    别"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00000000&
         Height          =   210
         Left            =   9630
         TabIndex        =   15
         Top             =   345
         Width           =   915
      End
      Begin VB.Label lblPAge 
         BackColor       =   &H00E0E0E0&
         BackStyle       =   0  'Transparent
         Caption         =   "年    龄"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00000000&
         Height          =   210
         Left            =   12465
         TabIndex        =   14
         Top             =   375
         Width           =   915
      End
   End
End
Attribute VB_Name = "frmReportEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'----------------------------------------------------------------------------------------------------
'文件：frmReportEdit.frm
'作者： 刘辉，冷家锋
'时间：2008-11-11
'说明：报告编辑
'----------------------------------------------------------------------------------------------------



Option Explicit

'患者信息
Dim m_ptInfo As New ClsPatientInfo
'申请科室信息
Dim m_dptApplyDept() As DeptInfo
Dim m_nApplyDeptCount As Long

'本界面用到的所有数据库连接
Dim m_DbConn As New ADODB.Connection


Const SEX_MALE = "男"
Const SEX_FEMALE = "女"
Const SEX_UNKNOWN = "不详"
Const EMERGENCY_TREATMENT_DISCRIPTE = "此报告为急诊报告，如有疑问请及时与我科联系！"

Const WORDS_PER_LINE = 48 '25
Const SPLIT_FLAG = "//////"

'分割符
Const SPLIT_SIGN = "/"
'TREEVIEW KEY值 前缀
Const PRE_KEY_MAIIN = "M"
Const PRE_KEY_SUB = "S"

'当前记录ID
Public m_strCurListID As String

'影像号
Public image_Number As String

'设备型号
Public machine_Type As String

'修改报告时，原报告检查日期，检查医生,审核医师
Public m_dList_CheckDate As String
Public m_strCheckDoctor As String
Public m_strAuditDoctorName As String

'保存模板
Dim m_strCategoryName As String
Dim m_strIllName As String

'字库添目标标识
Dim strWordStoreSign As String
Dim strWordStoreID As String

'ZLJ 20080904
Dim strDiagnoseState As String
Dim nodeSelectedPub As Node
Dim nodeSelectedPri As Node
Dim strHospitalNumber As String
Dim bIsAuditPassed As Boolean
Dim bIsUndoAuditPassed As Boolean



'按钮事件--清除报告编辑
Private Sub btnCancel_Click(Shifit As Integer)
On Error GoTo ErrHandler
    txtPhotoDescription.Text = ""
    txtDiagnoseResult.Text = ""
    chkEmergencyTreatment.Value = 0
    chkPositiv.Value = 0
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"

End Sub


'
'Private Sub btnDirectorPreview_Click(Shifit As Integer)
'On Error GoTo ErrHandler
'
'    If Printers.Count = 0 Then
'        labNoteBoard.Caption = "您尚未安装打印机, 不可预览！"
'        MsgBox "您尚未安装打印机, 不可预览！", vbExclamation, "提示“"
'        Exit Sub
'    End If
'
'    Load PRNReport_DR
'    Call PRNReport_DR.Clear_Data
'    Call PRNReport_DR.Data_Init
'
'    PRNReport_DR.Show
'    Exit Sub
'ErrHandler:
'    MsgBox Err.Description, vbExclamation, "提示"
'    Unload PRNReport_DR
'
'End Sub
'
'Private Sub btnDirectorPrintReport_Click(Shifit As Integer)
'On Error GoTo ErrHandler
'    If Printers.Count = 0 Then
'        labNoteBoard.Caption = "您尚未安装打印机, 不可预览！"
'        MsgBox "您尚未安装打印机, 不可预览！", vbExclamation, "提示“"
'        Exit Sub
'    End If
'    Dim strErr As String
'    If PrintReport(m_strCurListID, m_DbConn, strErr) = True Then
'        MsgBox Err.Description, vbExclamation, "打印成功."
'    Else
'        MsgBox "打印失败!" + strErr, vbExclamation, "提示"
'    End If
'    Exit Sub
'ErrHandler:
'    MsgBox Err.Description, vbExclamation, "提示"
'
'End Sub


'Private Sub btnFollowVisit_Click(Shifit As Integer)
'On Error GoTo ErrHandler
'    Dim strIs_Visit As String
'
'    Load frmFollowVisit
'    frmFollowVisit.Show
'    frmFollowVisit.m_strCurListID = Me.m_strCurListID
'    Exit Sub
'ErrHandler:
'    MsgBox "随访出错：" + Err.Description, vbExclamation, "提示"
'End Sub


'按钮事件--退出报告编辑
Private Sub btnBack_Click()
On Error GoTo ErrHandler
    Dim strErr As String
    If ClearActivateValue(strErr) = False Then
        Unload Me
        Exit Sub
    End If
    Me.Hide
    
    Exit Sub
ErrHandler:
    MsgBox strErr + Err.Description, vbExclamation, "提示"
End Sub
'
''按钮事件----修改部位
'Private Sub btnModifyParts_Click(Shifit As Integer)
'On Error GoTo ErrHandler
'    Load frmCheckPart
'    frmCheckPart.Show vbModal
'    Exit Sub
'ErrHandler:
'    MsgBox Err.Description, vbExclamation, "提示"
'End Sub


'
''按钮事件--打印预览
'Private Sub btnPreviewReport_Click(Shifit As Integer)
'On Error GoTo ErrHandler
'    If Printers.Count = 0 Then
'        labNoteBoard.Caption = "您尚未安装打印机, 不能预览！"
'        MsgBox "您尚未安装打印机, 不能预览！", vbExclamation, "提示“"
'        Exit Sub
'    End If
'    Dim strErr As String
'    If PrintPreview(m_strCurListID, m_DbConn, strErr) = False Then
'        MsgBox "预览失败!" + strErr, vbExclamation, "提示"
'    End If
'    Exit Sub
'ErrHandler:
'    MsgBox Err.Description, vbExclamation, "提示"
'    Unload PRNReport_DR
'End Sub

''按钮事件--打印
'Private Sub btnPrint_Click(Shifit As Integer)
'On Error GoTo ErrHandler
'    If Printers.Count = 0 Then
'        labNoteBoard.Caption = "您尚未安装打印机, 不能打印!"
'        MsgBox "您尚未安装打印机, 不能打印!", vbExclamation, "提示“"
'        Exit Sub
'    End If
'    Dim strErr As String
'    If PrintReport(m_strCurListID, m_DbConn, strErr) = True Then
'        MsgBox "打印成功.", vbExclamation, "提示"
'    Else
'        MsgBox "打印失败,原因:" + strErr, vbExclamation, "提示"
'    End If
'    Exit Sub
'ErrHandler:
'    MsgBox Err.Description, vbExclamation, "提示"
'End Sub

'按钮事件----查询<历史记录>
Private Sub btnSearchHistory_Click()
    On Error GoTo ErrHandler
    Dim nStart As Long
    Dim nEnd As Long
    Dim strStartDate As String
    Dim strEndDate As String
    
    nStart = InStr(CStr(dtStartDate.Value), " ")     '第1个空格位置
    If nStart <= 0 Then
        strStartDate = CStr(dtStartDate.Value)
    Else
        strStartDate = left(CStr(dtStartDate.Value), nStart - 1) + CStr(" 00:00:00")
    End If
    
    
    nEnd = InStr(CStr(dtEndDate.Value), " ")     '第1个空格位置
    If nEnd <= 0 Then
        strEndDate = CStr(dtEndDate.Value)
    Else
         strEndDate = left(dtEndDate.Value, nEnd - 1) + CStr(" 23:59:59")
    End If
    
     
    Dim strWhereClause As String
    If Trim(strStartDate) <> "" Then
        strWhereClause = " CHECK_DATE>='" + strStartDate + "'"
    End If
    
    If Trim(strEndDate) <> "" Then
        If Trim(strWhereClause) <> "" Then
            strWhereClause = strWhereClause + " AND CHECK_DATE<='" + strEndDate + "'"
        Else
            strWhereClause = " CHECK_DATE<='" + strEndDate + "'"
        End If
        
    End If
    
    Dim strErr As String
     If False = GetPatientHistoryList(m_ptInfo.PATIENT_NAME, False, strWhereClause, lsvHistory, m_DbConn, strErr) Then
         MsgBox strErr, vbExclamation, "历史记录"
     End If
     
    
    Exit Sub
ErrHandler:
    
End Sub







'按钮事件----年龄单位下拉框
Private Sub cmbAgeWeigh_Click()
    On Error GoTo ErrHandler
    txtAgeWeigh.Text = cmbAgeWeigh.Text
    Exit Sub
ErrHandler:

End Sub


Private Sub cmbApplyDepartment_Click()
    On Error GoTo ErrHandler
    If cmbApplyDepartmentID.ListCount > cmbApplyDepartment.ListIndex Then
        cmbApplyDepartmentID.ListIndex = cmbApplyDepartment.ListIndex
    End If
    
    
    Dim myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    
    If myConn.STATE <> adStateOpen Then
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
    
    Dim strErr As String
    If False = GetApplyDocts(cmbApplyDepartmentID.Text, cmbApplyDoctorName, myConn, strErr) Then
        MsgBox strErr, vbExclamation, "<申请医生>初始化"
    End If
    
    txtApplyDept.Text = cmbApplyDepartment.Text
    Exit Sub
ErrHandler:
    Debug.Print Err.Description
End Sub



'单击事件----<申请医生>下拉框
Private Sub cmbApplyDoctorName_Click()
    On Error GoTo ErrHandler
    txtApplyDoctor.Text = cmbApplyDoctorName.Text
    Exit Sub
ErrHandler:
    
End Sub


'单击事件----性别下拉框
Private Sub cmbSex_Click()
    On Error GoTo ErrHandler
    txtSex.Text = cmbSex.Text
    Exit Sub
ErrHandler:
    
    
End Sub