frmfeeslist.frm

Form_Resiz Me.ImageList1.ListImages(1).Picture

             VaSpPati.MaxRows = Fix(rs.RecordCount / 2) + 1
         End If
         Dim i As Integer
         Dim J As Integer
         Dim TotalPrice As Double
         TotalPrice = 0
         i = 0
         J = 1
         For n = 1 To rs.RecordCount
             With VaSpPati
             
             .Row = J
             If i Mod 2 = 0 Then
                 .Col = 1
                 .Text = rs!Info
                 .Col = 2
                 .Text = Format(rs!DJ, "0.00##")
                 .Col = 3
                 .Text = CStr(rs!Sl)
                 .Col = 4
                 .Text = rs!DW
                 .Col = 5
                 .Text = Format(rs!FyRq, "yyyy-MM-dd HH:mm")
                 .Col = 6
                 .Text = IIf(IsNull(rs!feeslevel), "", rs!feeslevel)
                 .Col = 7
                 .Text = Format(rs!HJJE, "0.00##")
                 TotalPrice = Format(TotalPrice + Format(rs!HJJE, "0.00"), "0.00##")
                 
             Else
                 .Col = 8
                 .Text = rs!Info
                 .Col = 9
                 .Text = Format(rs!DJ, "0.00##")
                 .Col = 10
                 .Text = CStr(rs!Sl)
                 .Col = 11
                 .Text = rs!DW
                 .Col = 12
                 .Text = Format(rs!FyRq, "yyyy-MM-dd HH:mm")
                 .Col = 13
                 .Text = IIf(IsNull(rs!feeslevel), "", rs!feeslevel)
                 .Col = 14
                 .Text = Format(rs!HJJE, "0.00##")
                 TotalPrice = Format(TotalPrice + Format(rs!HJJE, "0.00"), "0.00##")
                 
                 J = J + 1
             End If
             End With
             i = i + 1
             rs.MoveNext
         Next n
        
            VaSpPati.Row = VaSpPati.MaxRows
            VaSpPati.Col = 1
            VaSpPati.Text = "合计"
            VaSpPati.Col = 2
            VaSpPati.Text = Format(TotalPrice, "0.00##")
            
            '费用合计
            VaSpPati.Col = 8
            VaSpPati.Text = "费用合计"
            VaSpPati.Col = 9
            curFy = 0
            sql = "Select sum(ssje) as je From Bill Where Blh='" & rs1!Blh & "' And Knd3=1 And Th in(0,2,3) "
            rs2.Open sql, gcnnDatabase, adOpenForwardOnly, adLockReadOnly
            If rs2.RecordCount > 0 Then
                VaSpPati.Text = Format(rs2!je, "0.00##")
                curFy = IIf(IsNull(rs2!je), 0, rs2!je)
            Else
                VaSpPati.Text = "0.00"
                curFy = 0
            End If
            rs2.Close
            
             '预交款
            VaSpPati.MaxRows = VaSpPati.MaxRows + 1
            VaSpPati.Row = VaSpPati.MaxRows + 1
            VaSpPati.Col = 1
            VaSpPati.Text = "预交款"
            VaSpPati.Col = 2
            sql = "Select je From zy_yj Where Blh='" & rs1!Blh & "' "
            rs2.Open sql, gcnnDatabase, adOpenForwardOnly, adLockReadOnly
            curYj = 0
            If rs2.RecordCount > 0 Then
                VaSpPati.Text = Format(rs2!je, "0.00")
                curYj = IIf(IsNull(rs2!je), 0, rs2!je)
            Else
                VaSpPati.Text = "0.00"
                curYj = 0
            End If
            rs2.Close
            
            VaSpPati.Col = 8
            VaSpPati.Text = "费用余额"
            VaSpPati.Col = 9
            VaSpPati.Text = Format(curYj - curFy, "0.00")
        
            VaSpPati.PrintJobName = "一日清单打印"
            VaSpPati.PrintHeader = "/n/c/fn""宋体""/fz""14""/fb1" & jdSysBase.HospitalName & Me.Caption _
            & "" _
            & "/n/l/fn""宋体""/fz""12""/fb1" & cmbDepart.Text & "(病历号：" & rs1!Blh & ") " & rs1!HZXM & " 从" & Format(dtpBegin.value, "yyyy-MM-dd") & "至" & Format(dtpEnd.value, "yyyy-MM-dd") & "/n"
            VaSpPati.PrintFooter = "/n/c/fn""宋体""/fz""12""/fb1" & "第 /p 页/n/n/n"
            VaSpPati.GridShowHoriz = True
            VaSpPati.PrintBorder = True
            VaSpPati.PrintColHeaders = True
            VaSpPati.PrintColor = True
            VaSpPati.PrintGrid = IIf(Me.chkPrintGrid.value = 1, True, False)
            VaSpPati.FontSize = 12
            VaSpPati.PrintMarginTop = 0
            VaSpPati.PrintMarginBottom = 0
            VaSpPati.PrintMarginLeft = 0
            VaSpPati.PrintMarginRight = 0
            VaSpPati.PrintType = 0
            VaSpPati.PrintType = SS_PRINT_ALL
            VaSpPati.PrintRowHeaders = True
            VaSpPati.PrintShadows = False
            VaSpPati.PrintUseDataMax = True
            ' Perform the printing action
            VaSpPati.Action = SS_ACTION_PRINT
        End If
        rs.Close
        rs1.MoveNext
    Next m
    rs1.Close
End Sub

Private Sub cmdprint_Click()
    VaSpPati.PrintAbortMsg = "正在打印.... - 单击[取消]退出"
    VaSpPati.PrintJobName = "一日清单信息打印"
    VaSpPati.PrintHeader = "/n/l/fn""宋体""/fz""12""/fb1" & jdSysBase.HospitalName & Me.Caption _
    & "" _
    & "/n/l/fn""宋体""/fz""9""/fb1" & cmbDepart.Text & "(病历号：" & cmbPatiNoList.Text & ")" & cmbPatiNameList.Text & " 从" & Format(dtpBegin.value, "yyyy-MM-dd") & "至" & Format(dtpEnd.value, "yyyy-MM-dd") & "/n"
    VaSpPati.PrintFooter = "/n/c/fn""宋体""/fz""9""/fb1" & "第 /p 页/n/n/n"
    VaSpPati.GridShowHoriz = True
    VaSpPati.PrintBorder = True
    VaSpPati.PrintColHeaders = True
    VaSpPati.PrintColor = True
    VaSpPati.PrintGrid = IIf(Me.chkPrintGrid.value = 1, True, False)
    VaSpPati.FontSize = 9
    VaSpPati.PrintMarginTop = 0
    VaSpPati.PrintMarginBottom = 0
    VaSpPati.PrintMarginLeft = 0
    VaSpPati.PrintMarginRight = 0
    VaSpPati.PrintType = 0
    VaSpPati.PrintType = SS_PRINT_ALL
    VaSpPati.PrintRowHeaders = True
    VaSpPati.PrintShadows = False
    VaSpPati.PrintUseDataMax = True
    ' Perform the printing action
    VaSpPati.Action = SS_ACTION_PRINT
    VaSpPati.SetFocus
End Sub
    
Private Sub cmdQuery_Click()
    'FindListZyy
    FindListAll
End Sub
    
Private Sub cmdReturn_Click()
    Unload Me
End Sub
    
Private Sub Form_Activate()
    Me.chkGg.value = Val(jdFunction.jdReadIniData("jdUser.ini", "用户设置", "清单规格"))
    Me.chkPrintGrid.value = Val(jdFunction.jdReadIniData("jdUser.ini", "用户设置", "打印网格[一清单]"))
    Me.chkfylb.value = Val(jdFunction.jdReadIniData("jdUser.ini", "用户设置", "清单显示费用类别"))
    jdFunction.jdRestoreFormState Me
End Sub

Private Sub picV_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        Me.picV.Top = Me.picV.Top + y
        Form_Resize
    End If
End Sub

Private Sub picV_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim sngTemp As Single
    If Button = vbLeftButton Then
        Me.picV.Top = Me.picV.Top + y
        Form_Resize
    End If
End Sub

Private Sub Form_Load()
    jdFunction.jdSetFormIcon Me
    
    Dim rstData As New ADODB.Recordset
    Dim strSQL As String
    Dim strWhere As String

    cmbPatiStatus.AddItem "在院"
    cmbPatiStatus.AddItem "出院"
    cmbPatiStatus.ListIndex = 0
    Dim strDate As String
    strDate = jdFunction.jdGetServerTime()
    dtpBegin.value = Format(strDate, "yyyy-MM-dd 00:00:00")    '开始时间
    dtpEnd.value = Format(strDate, "yyyy-MM-dd 23:59:59")   '结束时间
    
    '初始化病区
    cmbDepart.Clear
    strSQL = " Select * From Department" & _
          " Inner Join dbo.Enumerate On Enumerate.lngEnumerateId = Department.lngDepartmentTypeId " & _
          " Where strEnumerateName = '治疗病区' "
    
    If UCase(jdSysBase.DeptType) = UCase("治疗病区") Then
        strWhere = " And Department.lngDepartmentId= '" & jdSysBase.DepartmentId & "'"
    Else
        strWhere = ""
    End If
    
    strSQL = strSQL & " " & strWhere
      
    rstData.Open strSQL, gcnnDatabase, , , adCmdText
    If Not rstData.BOF Then
        rstData.MoveFirst
        While Not rstData.EOF
            cmbDepart.AddItem rstData!strDepartmentName
            rstData.MoveNext
        Wend
    End If
    rstData.Close
    Set rstData = Nothing
    If Me.cmbDepart.ListCount >= 1 Then Me.cmbDepart.ListIndex = 0
    
    If jdFunction.jdGetGridState(Me.vasfbhj, "frmFeesList.vasfbhj") Then
    
    End If
    If jdFunction.jdGetGridState(Me.VaSpPati, "frmFeesList.VaSpPati") Then
    
    End If
    
    Dim intHeight As Integer
    intHeight = Val(jdFunction.jdReadIniData("jdUser.ini", "控件高度", "frmFeesList_Height"))
    Me.picV.Top = intHeight
End Sub

Private Sub FndRen(Blh As String, Bdate As Date, Edate As Date)
    Dim YJJe, YjyE As Single
    Dim YJfs As String
    Dim Cnt As Integer
    Dim sumZ As Single
    Dim HZXM As String
    Dim Ryrq, Cyrq As Date
    Dim RsT, rsyj As ADODB.Recordset
    Dim strSQL As String
    
    strSQL = "Select Top 1 HzXm,RyRq,CyRq From Zy_BlSy Where Blh='" & Blh & "' Order By RyRq Desc"
    Set RsT = Nothing
    Set RsT = New ADODB.Recordset
    RsT.Open strSQL, gcnnDatabase, adOpenForwardOnly, adLockReadOnly, adCmdText
    If Not RsT.BOF Then
        HZXM = RsT!HZXM
        Ryrq = RsT!Ryrq
        Cyrq = RsT!Cyrq
    End If
    RsT.Close
    If cmbPatiStatus.Text = "出院" Then
        strSQL = " Select Sum(Bill.Hjje) as Hjje,Sum(Bill.ssje) as ssje,Class.Class,Bill.Classid,Bill.JfBz From Bill,Class  " & _
               " Where Bill.Classid=Class.id And Bill.Th in (0,2,3) "
        strSQL = strSQL & "And Bill.Blh='" & Blh & "'And (Bill.JfBz In (6,7)) And Bill.FyRq >='" & Bdate & "' And Bill.FyRq<= '" & Edate & "'"
        strSQL = strSQL & " Group By Class.Class,Bill.Classid,Bill.JfBz Order By Bill.Classid"
    Else
        '查询在院、出院未结算病人的
        strSQL = " Select Sum(Bill.Hjje) As Hjje,Sum(Bill.SsJe) As SsJe,Class.Class,Bill.Classid,Bill.JfBz From Bill,Class  " & _
               " Where Bill.Classid=Class.id And Bill.Th In (0,2,3) "
        strSQL = strSQL & "And Bill.Blh='" & Blh & "'And (Bill.JfBz In (3,4,6)) And Bill.FyRq >='" & Bdate & "' And Bill.FyRq<= '" & Edate & "'"
        strSQL = strSQL & "  Group By Class.Class,Bill.Classid,Bill.JfBz Order By Bill.Classid"
    End If
    
    Set RsT = Nothing
    Set RsT = New ADODB.Recordset
    RsT.Open strSQL, gcnnDatabase, adOpenForwardOnly, adLockReadOnly, adCmdText
    If RsT.RecordCount = 0 Then
        RsT.Close
        Exit Sub
    End If
    sumZ = 0# '费用总额
    Cnt = 0

    While Not RsT.EOF
        Cnt = Cnt + 1
        sumZ = sumZ + RsT!HJJE
        RsT.MoveNext
    Wend
    vasfbhj.MaxRows = Cnt + 1
    '注意此处的表格行计数器的设计,由于不能确定每个人的费用项目数,行数需要临时增加
    Cnt = 1
    RsT.MoveFirst
    While Not RsT.EOF
        With vasfbhj
            .Row = Cnt
            .Col = 1
            .Text = Blh
            .Col = 2
            .Text = HZXM
            .Col = 3
            .Text = RsT!Class
            .Col = 4
            .Text = Format(RsT!HJJE, "0.00##")
            Cnt = Cnt + 1
            RsT.MoveNext
        End With
    Wend
    vasfbhj.Row = Cnt + 1
    vasfbhj.Col = 1
    vasfbhj.Text = "费用合计"
    vasfbhj.Col = 2
    vasfbhj.Text = Format(sumZ, "0.00##")
    RsT.Close
End Sub
    
Private Sub Form_Resize()
    On Error Resume Next

    jdFunction.jdSetFormMin Me
    Me.picV.Left = Me.fraMain.Left