frmfeeslist.frm

Form_Resiz Me.ImageList1.ListImages(1).Picture

    Me.picV.Width = Me.fraMain.Width
    
    If Me.picV.Top < 3000 Then Me.picV.Top = 3000
    If Me.picV.Top > Me.ScaleHeight - Me.fraCtl.Height - 1000 Then Me.picV.Top = Me.ScaleHeight - Me.fraCtl.Height - 1000
    
    Me.fraInfo.Move 30, 30, Me.ScaleWidth - 60
    Me.fraMain.Move Me.fraInfo.Left, Me.fraInfo.Top + Me.fraInfo.Height + 30, _
                        Me.fraInfo.Width, _
                        Me.picV.Top - Me.fraMain.Top
    Me.VaSpPati.Move 60, 150, Me.fraMain.Width - 120, Me.fraMain.Height - 210
    
    Me.fraSub.Move Me.fraInfo.Left, _
                   Me.picV.Top + Me.picV.Height, _
                   Me.fraInfo.Width, _
                   Me.ScaleHeight - Me.fraSub.Top - Me.fraCtl.Height - 120
    Me.vasfbhj.Move 60, 150, Me.fraSub.Width - 120, Me.fraSub.Height - 210
    Me.fraCtl.Move Me.fraInfo.Left, Me.fraSub.Top + Me.fraSub.Height + 30, Me.fraInfo.Width
    
    chkfylb.Move Me.fraCtl.Width - Me.chkfylb.Width - 60, Me.cmdKsPrint.Top
    Me.chkGg.Move Me.fraCtl.Width - Me.chkGg.Width - chkfylb.Width - 60, Me.cmdKsPrint.Top
    Me.chkPrintGrid.Move Me.fraCtl.Width - Me.chkPrintGrid.Width - Me.chkGg.Width - chkfylb.Width - 60, Me.chkGg.Top

    Me.Refresh
End Sub

Private Sub FindListAll()
    VaSpPati.MaxRows = 0
    Dim rs As New ADODB.Recordset
    Dim strSQL As String
    Dim g As Integer
    Dim curYj As Currency
    Dim curFy As Currency
    Dim strSel As String
    
    If Me.chkGg.value = 1 Then
        strSel = " (Bill.Info + ' ' + Bill.GG) As Info "
    Else
        strSel = "Bill.Info"
    End If
    
    If cmbPatiStatus.Text = "出院" Then
        strSQL = " Select " & strSel & ",Bill.Dj,Bill.Sl,Bill.Dw,Bill.FyRq,Bill.Hjje,Bill.FeesLevel " & _
                 " From Bill " & _
                 " Where Bill.Blh='" & cmbPatiNoList.Text & "' And Bill.FyRq<='" & dtpEnd.value & _
                 "' And Bill.FyRq>='" & dtpBegin.value & "' And (Bill.JfBz In (6,7)) And Bill.Th In(0,2,3)  Order By Bill.Th, Bill.FyRq"
    Else
        strSQL = " Select " & strSel & ",Bill.Dj,Bill.Sl,Bill.Dw,Bill.FyRq,Bill.Hjje,Bill.FeesLevel " & _
                 " From Bill " & _
                 " Where Bill.Blh='" & cmbPatiNoList.Text & "' And Bill.FyRq<='" & dtpEnd.value & _
                 "' And Bill.FyRq>='" & dtpBegin.value & "' And (Bill.JfBz In (3,4,6)) And Bill.Th In(0,2,3)  Order By Bill.Th, Bill.FyRq"
    End If
    rs.Open strSQL, gcnnDatabase, adOpenStatic, adLockReadOnly
    If rs.EOF Then Exit Sub
    rs.MoveFirst
    Dim Cnt As Integer
    Cnt = 0
    While Not rs.EOF
        Cnt = Cnt + 1
        rs.MoveNext
    Wend
    g = Cnt Mod 2
    If g <> 0 Then
        VaSpPati.MaxRows = Fix(Cnt / 2) + 2
    Else
        VaSpPati.MaxRows = Fix(Cnt / 2) + 1
    End If
    rs.MoveFirst
    Dim i As Integer
    Dim J As Integer
    Dim TotalPrice As Double
    TotalPrice = 0
    i = 0
    J = 1
    While Not rs.EOF
        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")
                If chkfylb.value = 1 Then
                    .Col = 6
                    .Text = rs!feeslevel & ""
                End If
                .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")
                If chkfylb.value = 1 Then
                    .Col = 13
                    .Text = rs!feeslevel & ""
                End If
                .Col = 14
                .Text = Format(rs!HJJE, "0.00")
                TotalPrice = TotalPrice + Format(rs!HJJE, "0.00")
                J = J + 1
            End If
        End With
        i = i + 1
        rs.MoveNext
    Wend
    VaSpPati.Row = VaSpPati.MaxRows
    VaSpPati.Col = 1
    VaSpPati.Text = "合计"
    VaSpPati.Col = 2
    VaSpPati.Text = Format(TotalPrice, "0.00##")
    rs.Close
    '费用累计
    VaSpPati.Col = 8
    VaSpPati.Text = "费用累计"
    VaSpPati.Col = 9
    curFy = 0
    strSQL = " Select Sum(Hjje) As Je From Bill " & _
             " Where Blh='" & cmbPatiNoList.Text & "' And Knd3=1 And (Th In (0,2,3)) And FyRq <= '" & Me.dtpEnd.value & "'"
    rs.Open strSQL, gcnnDatabase, adOpenForwardOnly, adLockReadOnly
    If rs.RecordCount > 0 Then
        VaSpPati.Text = Format(rs!je, "0.00##")
        curFy = rs!je
    Else
        VaSpPati.Text = "0.00##"
    End If
    rs.Close
     '预交款
    VaSpPati.MaxRows = VaSpPati.MaxRows + 1
    VaSpPati.Row = VaSpPati.MaxRows + 1
    VaSpPati.Col = 1
    VaSpPati.Text = "预交款"
    VaSpPati.Col = 2
    strSQL = " Select Sum(Je) As Je From Zy_YjLr " & _
             " Where Blh='" & cmbPatiNoList.Text & "' And  JsBz = '押金' And Rq <= '" & Me.dtpEnd.value & "'"
    rs.Open strSQL, gcnnDatabase, adOpenForwardOnly, adLockReadOnly
    curYj = 0
    If rs.RecordCount > 0 Then
        VaSpPati.Text = Format(jdFunction.jdNvl(rs!je, 0), "0.00##")
        curYj = Format(jdFunction.jdNvl(rs!je, 0), "0.00##")
    Else
        VaSpPati.Text = "0.00"
    End If
    rs.Close
    VaSpPati.Col = 8
    VaSpPati.Text = "费用余额"
    VaSpPati.Col = 9
    VaSpPati.Text = Format(curYj - curFy, "0.00##")
End Sub

Private Sub FindListZyy()
    VaSpPati.MaxRows = 0
    Dim rs As ADODB.Recordset
    Dim sql As String
    Dim g As Integer
    Dim curYj As Currency
    Dim curFy As Currency
    
    If cmbPatiStatus.Text = "出院" Then
        sql = " Select Bill.ypid, Bill.Info,Bill.Dj,Bill.Sl,Bill.Dw,Bill.FyRq,Bill.Hjje,Bill.FeesLevel " & _
              " From Bill " & _
              " Where Bill.Blh='" & cmbPatiNoList.Text & "' And Bill.FyRq<='" & dtpEnd.value & "'And Bill.FyRq>='" & dtpBegin.value & _
              "' And (Bill.JfBz In (6,7)) " & _
              " And Bill.Th in(0,2,3) And Cast(YpId As NvarChar) Not In (Select XmId From 清单不显示列表)  " & _
              " Order By Bill.Th,Bill.FyRq"
    Else
        sql = " Select Bill.ypid,Bill.Info,Bill.Dj,Bill.Sl,Bill.Dw,Bill.FyRq,Bill.Hjje,Bill.FeesLevel " & _
              " From Bill " & _
              " Where Bill.Blh='" & cmbPatiNoList.Text & "' And Bill.FyRq<='" & dtpEnd.value & "'And Bill.FyRq>='" & dtpBegin.value & "' And (Bill.JfBz In (3,4,6)) And Bill.Th In (0,2,3) " & _
              " And Cast(YpId As nvarChar) Not In (Select XmId From 清单不显示列表)  " & _
              " Order By Bill.Th, Bill.FyRq"
    End If
    
    Set rs = New ADODB.Recordset
    rs.Open sql, gcnnDatabase, adOpenStatic, adLockReadOnly
    If rs.EOF Then Exit Sub
    rs.MoveFirst
    Dim Cnt As Integer
    Cnt = 0
    While Not rs.EOF
        Cnt = Cnt + 1
        rs.MoveNext
    Wend
    g = Cnt Mod 2
    If g <> 0 Then
        VaSpPati.MaxRows = Fix(Cnt / 2) + 2
    Else
        VaSpPati.MaxRows = Fix(Cnt / 2) + 1
    End If
    rs.MoveFirst
    Dim i As Integer
    Dim J As Integer
    Dim TotalPrice As Double
    TotalPrice = 0
    i = 0
    J = 1
    While Not rs.EOF
        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")
                .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
    Wend
    VaSpPati.Row = VaSpPati.MaxRows
    VaSpPati.Col = 1
    VaSpPati.Text = "合计"
    VaSpPati.Col = 2
    VaSpPati.Text = Format(TotalPrice, "0.00##")
    rs.Close
    
    '费用合计
    VaSpPati.Col = 8
    VaSpPati.Text = "费用合计"
    VaSpPati.Col = 9
    curFy = 0
    sql = "Select Sum(ssje) As Je From Bill Where Blh='" & cmbPatiNoList.Text & "' And Knd3=1 And Th In(0,2,3) "
    rs.Open sql, gcnnDatabase, adOpenForwardOnly, adLockReadOnly
    If rs.RecordCount > 0 Then
        VaSpPati.Text = Format(rs!je, "0.00##")
        curFy = rs!je
    Else
        VaSpPati.Text = "0.00"
    End If
    rs.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='" & cmbPatiNoList.Text & "' "
    rs.Open sql, gcnnDatabase, adOpenForwardOnly, adLockReadOnly
    curYj = 0
    If rs.RecordCount > 0 Then
        VaSpPati.Text = Format(rs!je, "0.00##")
        curYj = rs!je
    Else
        VaSpPati.Text = "0.00"
    End If
    rs.Close
    
    VaSpPati.Col = 8
    VaSpPati.Text = "费用余额"
    VaSpPati.Col = 9
    VaSpPati.Text = Format(curYj - curFy, "0.00##")
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call jdFunction.jdSetGridState(Me.vasfbhj, "frmFeesList.vasfbhj")
    Call jdFunction.jdSetGridState(Me.VaSpPati, "frmFeesList.VaSpPati")
    
    Call jdFunction.jdWriteIniData("jdUser.ini", "控件高度", "frmFeesList_Height", Me.picV.Top)

    Call jdFunction.jdWriteIniData("jdUser.ini", "用户设置", "清单规格", Me.chkGg.value)
    Call jdFunction.jdWriteIniData("jdUser.ini", "用户设置", "打印网格[一清单]", Me.chkPrintGrid.value)
    Call jdFunction.jdWriteIniData("jdUser.ini", "用户设置", "清单显示费用类别", Me.chkfylb.value)
    jdFunction.jdSaveFormState Me
End Sub

Private Sub vasfbhj_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then Call jdFunction.jdFontSet(Me.vasfbhj)
End Sub

Private Sub VaSpPati_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then Call jdFunction.jdFontSet(Me.VaSpPati)
End Sub