frmaffirmlvw.frm

本系统可用于医院和专业体检中心的健康体检管理

    Dim TmpclsDisk As New CDiskInfo
    Dim strTmpQueryCode As String
    Dim rstemp As ADODB.Recordset
    Dim cmdTemp As ADODB.Command
    Dim tmpHealthID As String
    Dim blnSel As Boolean
    Dim i As Integer
    
    Me.MousePointer = vbHourglass
    
    '是否有选择项目
    '循环每个大项，检查是否有输入
    blnSel = False
    For i = 1 To tvwGDXiang.Nodes.Count
        If Len(tvwGDXiang.Nodes(i).Key) = 5 Then
            If tvwGDXiang.Nodes(i).Checked = True Then
                blnSel = True
                Exit For
            End If
        End If
    Next
    If Not blnSel Then
        MsgBox "请选择体检项目！", vbInformation, "提示"
        GoTo ExitLab
    End If
'    If txt_p.Text = "" Then
'           MsgBox "请输入拼音！", vbInformation, "提示"
'            txt_p.SetFocus
'            GoTo ExitLab
'     End If
      txt_p.Text = ""
'     If txtGAGE.Text = "" Then
'           MsgBox "请输入年龄！", vbInformation, "提示"
'            txtGAGE.SetFocus
'            GoTo ExitLab
'     End If
    '检查是否添加或修改
    If mblnAdd = True Then
        mTmpHYKH = Trim(TxtGSelfBH.Text)
        cmdOKClick

        GoTo ExitLab
    End If
     
    If cmbGDWei.Text = "" Then
'        If cmbTJBZ.Text = "" Then
'            MsgBox "请选体检标准！", vbInformation, "提示"
'            cmbTJBZ.SetFocus
'            GoTo ExitLab
'        End If
    Else
        If CmbFZ.Text = "" Then
            MsgBox "请选择分组！", vbInformation, "提示"
            CmbFZ.SetFocus
            GoTo ExitLab
        End If
    End If
    
    If mintGrid = 1 Then '从第一个网格来
        '网格里是否有记录
        If Me.Lvw1.SelectedItem.Text = "" Then GoTo ExitLab
        
'        intRow = Me.MSHFlexGrid1.Row '当前行
        '检查是否有选择
        If Me.Lvw1.SelectedItem.Text = "" Then GoTo ExitLab
        
        '记录唯一编号
        lngGUID = Val(Me.Lvw1.SelectedItem.Text)
        
        If Me.Lvw1.SelectedItem.SubItems(4) <> "" Then
            '团检客户
            '首先检查是否参与分组
            strSQL = "select YYID from FZ_FZSJ" _
                    & " where GUID=" & lngGUID
            Set rsPerson = New ADODB.Recordset
            rsPerson.Open strSQL, GCon, adOpenStatic, adLockReadOnly
            If rsPerson.RecordCount < 1 Then
                MsgBox "客户“" & Me.Lvw1.SelectedItem.SubItems(3) _
                        & "”尚未参与分组，无法确认！" _
                        & vbCrLf & "请首先对该客户进行分组！", vbInformation, "提示"
                GoTo ExitLab
            End If
            
            blnTJ = True
        Else
            blnTJ = False
        End If
        
        '记录旧的健康档案号
        strOldHealthID = Me.Lvw1.SelectedItem.SubItems(1)
    Else
        '网格里是否有记录
        If Me.Lvw2.ListItems(1) = "" Then GoTo ExitLab
        
        intRow = Me.Lvw2.SelectedItem.Index '当前行
        '检查是否有选择
        If Me.Lvw2.SelectedItem.Text = "" Then GoTo ExitLab
        
        '记录唯一编号
        lngGUID = Val(Me.Lvw2.SelectedItem.Text)
        
        If Me.Lvw2.SelectedItem.SubItems(5) <> "" Then
            '团检客户
            '已经确认过，所以无需作是否分组的检查
            blnTJ = True
        Else
            blnTJ = False
        End If
        
        '记录旧的健康档案号
        strOldHealthID = Me.Lvw2.SelectedItem.SubItems(1)
    End If
    
    mTmpHYKH = Trim(TxtGSelfBH.Text)
   
    If AffirmPerson(lngGUID, strOldHealthID, blnTJ) = False Then GoTo ExitLab
        
    '********************20040507加入 闻*******************************
    '获得查询码
    Set rstemp = New ADODB.Recordset
    rstemp.Open "select GUID,HealthID,YYRXM from SET_GRXX where GUID=" & lngGUID, GCon, adOpenStatic, adLockReadOnly
    tmpHealthID = rstemp("HealthID")
'    strTmpQueryCode = TmpclsDisk.GetFixedSerialNumber(rsTemp("YYRXM") & rsTemp("HealthID"), 8)
    strTmpQueryCode = LongToString(rstemp("GUID"), 6) & TmpclsDisk.GetFixedSerialNumber(rstemp("GUID") & rstemp("HealthID"), 8)
    Set cmdTemp = New ADODB.Command
    Set cmdTemp.ActiveConnection = GCon
    cmdTemp.CommandText = "update SET_GRXX set CXM='" & strTmpQueryCode & "' where GUID=" & lngGUID
    cmdTemp.Execute
    TxtCXM.Text = strTmpQueryCode
    
    '********************20040507加入完 闻*****************************
    
    '*******************************************************************
    '发卡
    '*******************************************************************
    Call SendCardW(rstemp("HealthID"), TxtGSelfBH.Text, GCon, , False, True)
     
    '禁用“确认”按钮
    cmdAffirm.Enabled = False
    cmdIDCardAndPerson.Enabled = False
    
'    '将该条记录从MSHFlexGrid1移入MSHFlexGrid2,利用刷新显示
'    RefreshGrid

    '将该条记录从Lvw1移入lvw2
    '首先从LVW1中移除
    If mintGrid = 1 Then
       If Lvw1.ListItems.Count > 0 Then
         Lvw1.ListItems.Remove (Lvw1.SelectedItem.Index)
       End If
    End If
    RefreshLvw2
    
    If gJJXGuid <> "" Then
        ShowPersonInfo CLng(gJJXGuid)
        gJJXGuid = ""
    End If
    
'    wxw add 20050709 写入LIS接口表
    If ShanXiLis Then
        AddInterface lngGUID, IIf(cmbGSEX.Text = "男", 2, 1)
    End If
    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
'
    Me.MousePointer = vbDefault
    '跳转
    txtQuerySelfBH.SetFocus
End Sub

Private Sub CmdCancelAffirm_Click()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rsPerson As ADODB.Recordset
    Dim i As Integer, j As Integer
    Dim intRow As Integer
    Dim lngGUID As Long
    Dim strYYID As String '团检客户所属的团体编号
    
    Me.MousePointer = vbHourglass
    
    intRow = Me.Lvw2.SelectedItem.Index '当前行
    '检查是否有选择
    If Me.Lvw2.SelectedItem.Text = "" Then GoTo ExitLab
    
    '取消之前让用户确认
    If MsgBox("您确认要取消客户“" & Me.Lvw2.SelectedItem.SubItems(4) _
            & "”的确认吗？", vbQuestion + vbYesNo + vbDefaultButton2, _
            "询问") = vbNo Then GoTo ExitLab
    
    '获取唯一编号
    lngGUID = Val(Me.Lvw2.SelectedItem.Text)
    
    If Me.Lvw2.SelectedItem.SubItems(5) = "" Then
        '散检客户
        strSQL = "update YY_SJDJ set SFTJ=0" _
                & " where GUID=" & lngGUID
        GCon.Execute strSQL
    Else
        '团检客户
        '首先检查是否参与分组
        strSQL = "select YYID from FZ_FZSJ" _
                & " where GUID=" & lngGUID
        Set rsPerson = New ADODB.Recordset
        rsPerson.Open strSQL, GCon, adOpenStatic, adLockReadOnly
        If rsPerson.RecordCount < 1 Then
            MsgBox "客户“" & Me.Lvw2.SelectedItem.SubItems(4) _
                    & "”尚未参与分组，无法确认！" _
                    & vbCrLf & "请首先对该客户进行分组！", vbInformation, "提示"
            GoTo ExitLab
        End If
        
        '记录编号
        strYYID = rsPerson("YYID")
        
        '首先更新FZ_FZSJ表
        strSQL = "Update FZ_FZSJ set SFTJ=0" _
                & " where GUID=" & lngGUID
        GCon.Execute strSQL
        
'        '然后更新YY_TJDJ表
'        strSQL = "Update YY_TJDJ set SFTJ=1" _
'                & " where YYID='" & strYYID & "'"
'        GCon.Execute strSQL
    End If
    
    '将SET_GRXX中QRDJ字段恢复为0
    strSQL = "Update SET_GRXX set QRDJ=0" _
                & " where GUID=" & lngGUID
    GCon.Execute strSQL
    
    '********************20040412加入 闻*******************************
    '将该条记录从MSHFlexGrid1移入MSHFlexGrid2,利用刷新显示
    RefreshGrid
    '********************20040412加入完 闻*****************************
    
    '*******************20040412封闭 闻*******************************
'    '改变当前已确认用户的背景色
'    With Me.MSHFlexGrid1
'        .Row = intRow
'        For i = 0 To 4
'            .col = i
'            .CellBackColor = lngAffirm
'        Next
'    End With
    '*******************20040412封闭完 闻*******************************
    '禁用“确认”按钮
    CmdCancelAffirm.Enabled = False
    
    If ShanXiLis Then
        GCon.Execute "delete from interface_grxx where id=(select selfbh from set_grxx where guid=" & lngGUID & ")"
    End If
    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdFaKa_Click()
    Dim strCard As String
    Dim strHealthID As String
    Dim intRow As Integer
    
'    If mintGrid = 1 Then
'        If Me.MSHFlexGrid1.TextMatrix(1, 0) = "" Then Exit Sub
'
'        intRow = Me.MSHFlexGrid1.Row
'
'        strHealthID = Me.MSHFlexGrid1.TextMatrix(intRow, 1)
'    ElseIf mintGrid = 2 Then
'        If Me.MSHFlexGrid2.TextMatrix(1, 0) = "" Then Exit Sub
'
'        intRow = Me.MSHFlexGrid2.Row
'
'        strHealthID = Me.MSHFlexGrid2.TextMatrix(intRow, 1)
'    End If
    If mintGrid = 1 Then
        If Me.Lvw1.ListItems(1).Text = "" Then Exit Sub
        
        intRow = Me.Lvw1.SelectedItem.Index
        
        strHealthID = Me.Lvw1.SelectedItem.SubItems(1)
    ElseIf mintGrid = 2 Then
        If Me.Lvw2.ListItems(1).Text = "" Then Exit Sub
        
        intRow = Me.Lvw2.SelectedItem.Index
        
        strHealthID = Me.Lvw2.SelectedItem.SubItems(1)
    End If
    

    If strHealthID = "" Then Exit Sub
    
'    strCard = InputBox("请输入卡号：", "发卡")
    strCard = Trim(TxtGSelfBH.Text)
    If strCard = "" Then Exit Sub
    
    SendCard strHealthID, strCard
End Sub

Private Sub cmdIDCardAndPerson_Click()
    Dim strRet As String
    Dim strFileName
    
    strRet = dlgIDCardAndPerson.ShowPhotoAndScan
    Set dlgIDCardAndPerson = Nothing
    
    If strRet = "" Then GoTo ExitLab
    strFileName = Split(strRet, "|")
    m_strPhotoFile = strFileName(0)
    m_strScanFile = strFileName(1)
    
    GoTo ExitLab
ExitLab:
    '
End Sub

Private Sub cmdModify_Click()
    If txtGYYID.Text <> "" Then
        menuOperation = Modify
        
        SetGRInput True
'        姓名不允许修改
'        txtGYYRXM.Enabled = False
        
        mblnAdd = False
    
        cmdAdd.Enabled = False
        cmdModify.Enabled = False
        cmdPrintGuider.Enabled = False
        cmdPay.Enabled = False
        cmdFaKa.Enabled = False
        
        cmdAffirm.Enabled = True
        cmdIDCardAndPerson.Enabled = True
        '修改时禁用“取消确认”按钮
        CmdCancelAffirm.Enabled = False
    End If
    
    '清除复查标志
    mblnReCheck = False
    mblnBuCha = False
    m_enuCheckType = None
End Sub

Private Sub cmdPay_Click()
    Dim lngGUID As Long
    
    If mintGrid = 1 Then
        lngGUID = Val(Me.Lvw1.SelectedItem.Text)
    ElseIf mintGrid = 2 Then
        lngGUID = Val(Me.Lvw2.SelectedItem.Text)
    End If
    dlgPayMoney.ShowPersonMoney lngGUID, _
            g_typPersonAffirm.Price_InAffirm, g_typPersonAffirm.Charging_InAffirm
    Set dlgPayMoney = Nothing
End Sub

Private Sub cmdPrintBarCode_Click()
    Dim strPersonName As String
    Dim lngGUID As Long
    Dim strHealthID As String
    Dim s