frmfairbysick.frm

医院门诊医生工作站,vb6 SqlServer

   Begin VB.Label Label10 
      AutoSize        =   -1  'True
      Caption         =   "--"
      Height          =   180
      Left            =   2340
      TabIndex        =   33
      Top             =   5070
      Width           =   180
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "病案号:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   450
      TabIndex        =   3
      Top             =   105
      Width           =   735
   End
End
Attribute VB_Name = "frmFairBySick"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public QueryType As Integer '0 分类 1 明细 2 流水
Public SickObj As clsSick

Private OldSkID As String
Private NoNumClick As Boolean '屏蔽num 的Click事件,避免重复触发

Private Sub InitForm()
    Dim tmprs As Recordset
    
    cboCusmID.Clear
    cboCusmID.AddItem "全部"
    Set tmprs = gdbobj.GetNewRs("SELECT CusmID,Des FROM f_CusmKindSub" _
        & " WHERE CkID = 'Inpati_FairBySick'")
    Do Until tmprs.EOF
        cboCusmID.AddItem tmprs!CusmID & " " & tmprs!Des
        tmprs.MoveNext
    Loop
    cboCusmID.ListIndex = 0
    Select Case QueryType
        Case 0
            cboCusmID.Enabled = False
            Me.Caption = "病人分类费用查询"
            usp.ID = "B_CatiFairBySick"
            usp.SumRowStr = "<3>"
        Case 1
            Me.Caption = "病人明细费用查询"
            usp.ID = "B_DetailFairBySick"
            usp.SumRowStr = "<5>"
        Case 2
            Me.Caption = "病人流水费用查询"
            usp.ID = "B_SerialFairBySick"
            usp.SumRowStr = "<5>"
    End Select
    Set usp.DBInter = gdbobj
    Set usp.CurSpread = spd
    mskDate(0) = gfnGetTime(gstrCOMN_DATE)
    mskDate(1) = gfnGetTime(gstrCOMN_DATE)
    mskDate(0).Enabled = False
    mskDate(1).Enabled = False
    usp.Load
    hisFormClear Me
    spd.MaxRows = 0
    chkDate.value = 0
    If Not (SickObj Is Nothing) Then
        txtSkID = SickObj.SkID
        FillSickInfo
    End If
End Sub
Private Sub Init()
    hisFormClear Me
    spd.MaxRows = 0
    chkDate.value = 0
    If Not (SickObj Is Nothing) Then
        Set SickObj = Nothing
    End If
End Sub

Public Sub btg_Click(ByVal WhichB As Integer)
   Dim Title As String
    
    Select Case WhichB
        Case 0
            FillData
        Case 1
            If SickObj Is Nothing Then Exit Sub
            spd.PrintHeader = "    /fz""12"" /fb1 <" & gtydSysConfig.HospName & ">住院病人费用" _
                    & "                                  /n/n" _
                    & "/fz""10"" /fb0 病案号(次数)：" & SickObj.SkID & "(" & SickObj.num & ")" _
                    & Space(10) & "姓名:" & SickObj.Name _
                    & Space(10) & "性别:" & SickObj.SexDes & "/n" _
                    & "  入院日期:" & Format(SickObj.InDate, gstrCHINA_DATE) _
                    & cboSelect.Text & Space(10) & "发生日期:" & gfnGetTime(gstrCHINA_DATE) & "/n"
            spd.PrintRowHeaders = True
            spd.PrintShadows = False
            spd.PrintMarginLeft = 0
            spd.PrintUseDataMax = False
            spd.Action = SS_ACTION_PRINT
        Case 2
            Init
            Unload Me
    End Select
End Sub

Private Sub cboNum_Click()
    If SickObj Is Nothing Or NoNumClick Then Exit Sub
    SickObj.SkSerialByQuery = txtSkID & Format(cboNum.Text, "00")
    FillSickInfo True
End Sub

Private Sub chkDate_Click()
    If chkDate.value = 1 Then
        mskDate(0).Enabled = True
        mskDate(1).Enabled = True
        mskDate(0) = gfnGetTime(gstrCOMN_DATE)
        mskDate(1) = gfnGetTime(gstrCOMN_DATE)
    Else
        mskDate(0).Enabled = False
        mskDate(1).Enabled = False
    End If
End Sub


Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        hisToActiveCtl(Me).SetFocus
    End If
End Sub

Private Sub Form_Load()
    hisFormToCenter Me, frmMain
    InitForm
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmFairBySick = Nothing
End Sub
Private Sub FillData()
    Dim Other As String
    Dim CusmID As String
    
    If SickObj Is Nothing Then Exit Sub
    
    If cboCusmID.ListIndex <> 0 Then
        CusmID = left(cboCusmID.Text, InStr(cboCusmID.Text, " ") - 1)
    End If
    Screen.MousePointer = 11
    frmMain.Note = "正在统计数据。。。请等候"
    Select Case QueryType
        Case 0
            If cboSelect.Enabled Then
                Select Case cboSelect.ListIndex
                    Case 0, -1
                        Other = "Inpati_GetCatiFairBySick '" & SickObj.SkSerial & "',''"
                    Case 1
                        Other = "Inpati_GetCatiFairBySick '" & SickObj.SkSerial & "','-1'"
                    Case Else
                        Other = "Inpati_GetCatiFairBySick '" & SickObj.SkSerial & "','" & cboSelect.Text & "'"
                End Select
            Else
                Other = "Inpati_GetCatiFairBySick '" & SickObj.SkSerial & "',''"
            End If
            If chkDate.value = 1 Then
                Other = Other & ",'" & Format(mskDate(0), "yymmdd") & "','" _
                    & Format(CDate(mskDate(1)) + 1, "yymmdd") & "'"
            Else
                Other = Other & ",'',''"
            End If
        Case 1
            If cboSelect.Enabled Then
                Select Case cboSelect.ListIndex
                    Case 0, -1
                        Other = "Inpati_GetDetailFairBySick '" & SickObj.SkSerial & "',''"
                    Case 1
                        Other = "Inpati_GetDetailFairBySick '" & SickObj.SkSerial & "','-1'"
                    Case Else
                        Other = "Inpati_GetDetailFairBySick '" & SickObj.SkSerial & "','" & cboSelect.Text & "'"
                End Select
            Else
                Other = "Inpati_GetDetailFairBySick '" & SickObj.SkSerial & "',''"
            End If
            If chkDate.value = 1 Then
                Other = Other & ",'" & Format(mskDate(0), "yymmdd") & "','" _
                    & Format(CDate(mskDate(1)) + 1, "yymmdd") & "','" & CusmID & "'"
            Else
                Other = Other & ",'',''" & ",'" & CusmID & "'"
            End If
        Case 2
            If cboSelect.Enabled Then
                Select Case cboSelect.ListIndex
                    Case 0, -1
                        Other = "Inpati_getSerialFairBysick '" & SickObj.SkSerial & "',''"
                    Case 1
                        Other = "Inpati_getSerialFairBysick '" & SickObj.SkSerial & "','-1'"
                    Case Else
                        Other = "Inpati_getSerialFairBysick '" & SickObj.SkSerial & "','" & cboSelect.Text & "'"
                End Select
            Else
                Other = "Inpati_getSerialFairBysick '" & SickObj.SkSerial & "',''"
            End If
            If chkDate.value = 1 Then
                Other = Other & ",'" & Format(mskDate(0), "yymmdd") & "','" _
                    & Format(CDate(mskDate(1)) + 1, "yymmdd") & "','" & CusmID & "'"
            Else
                Other = Other & ",'',''" & ",'" & CusmID & "'"
            End If
            
    End Select
    usp.sql = Other
    usp.Refresh
    
    frmMain.Note = ""
    Screen.MousePointer = 0
    
End Sub



Private Sub mskDate_LostFocus(Index As Integer)
    If Not IsDate(mskDate(Index).Text) Then
        MsgBox gstrDATE_ERROR_MSG, vbCritical
        mskDate(Index).SetFocus
    End If
End Sub

Private Sub spd_RightClick(ByVal ClickType As Integer, ByVal Col As Long, ByVal Row As Long, ByVal MouseX As Long, ByVal MouseY As Long)
    Call usp.RightClick
End Sub

Private Sub txtSkID_GotFocus()
    OldSkID = txtSkID
End Sub

Private Sub txtSkID_LostFocus()
    Dim mStr As String
    
    If txtSkID = OldSkID Then Exit Sub
    If txtSkID = "" Then
        Init
        Exit Sub
    End If
    If SickObj Is Nothing Then
        Set SickObj = New clsSick
    End If
    SickObj.SkIDByQuery = txtSkID
    If Not SickObj.IfRegInfo Then
        MsgBox "病案号> " & txtSkID & " <不存在", vbCritical
        Init
        txtSkID.SetFocus
        Exit Sub
    End If
    FillSickInfo
End Sub

Private Sub FillSickInfo(Optional NoFillNum As Boolean = False)
    Dim i As Integer
    Dim tmprs As Recordset
    
    NoNumClick = True
    If Not NoFillNum Then
        cboNum.Clear
        For i = 1 To SickObj.num
            cboNum.AddItem i
        Next i
        cboNum.ListIndex = cboNum.ListCount - 1
    End If
    cboSelect.Clear
    cboSelect.Enabled = False
    Set tmprs = gdbobj.GetNewRs("SELECT SickFoot.FootSerial FROM SickFoot " _
        & "INNER JOIN SickPay ON SickFoot.FootSerial = SickPay.FootSerial AND SickPay.PayType in (1,2) " _
        & "WHERE SkSerial = '" & SickObj.SkSerial & "'")
    If tmprs.RecordCount >= 1 Then
        cboSelect.Enabled = True
        cboSelect.AddItem "全部"
        cboSelect.AddItem "未结算"
        Do Until tmprs.EOF
            cboSelect.AddItem tmprs!FootSerial
            tmprs.MoveNext
        Loop
        cboSelect.ListIndex = 0
    Else
        cboSelect.Enabled = False
    End If
    spd.MaxRows = 0
    cboCusmID.ListIndex = 0
    SumFair
    Call gfnFillDataBySickRegInfo(Me, SickObj)
    NoNumClick = False
    
End Sub

Private Sub SumFair()
    Dim sql As String
    sql = "Select sum(Fair) from fairmarksub " _
        & "inner join fairmarkmain on fairmarksub.markserial=fairmarkmain.markserial " _
        & "where skserial='" & SickObj.SkSerial & "' and footserial is null "
    If gdbobj.GetRs("sql") > 0 Then
        SickObj.Fair = IIf(IsNull(gdbobj.Rs(0)), 0, gdbobj.Rs(0))
    End If
    sql = "Select sum(payFair) from sickpay " _
        & "where skserial='" & SickObj.SkSerial & "' and footserial is null and paytype=0 "
    If gdbobj.GetRs("sql") > 0 Then
        SickObj.PrePay = IIf(IsNull(gdbobj.Rs(0)), 0, gdbobj.Rs(0))
    End If
    
End Sub