---

Option Compare Database
Option Explicit

' ===== Задание 4 =====
Private Sub btnTask4_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset, rsNew As DAO.Recordset
    Dim tdf As DAO.TableDef
    Dim summa As Currency, vsego As Currency, srednee As Currency
    Dim kolVsego As Long, kolDorogih As Long

    Set db = CurrentDb

    ' 1. Считаем общую сумму лечения и среднюю
    Set rs = db.OpenRecordset("Стационар")
    Do Until rs.EOF
        vsego = vsego + rs("ДнейЛечения") * rs("СтоимостьДня")
        kolVsego = kolVsego + 1
        rs.MoveNext
    Loop
    srednee = vsego / kolVsego

    ' 2. Удаляем старую таблицу, если уже запускали
    On Error Resume Next
    DoCmd.Close acTable, "ДорогиеНал"
    db.TableDefs.Delete "ДорогиеНал"
    On Error GoTo 0

    ' 3. Создаём новую таблицу и её поля
    Set tdf = db.CreateTableDef("ДорогиеНал")
    tdf.Fields.Append tdf.CreateField("КодПациента", dbLong)
    tdf.Fields.Append tdf.CreateField("ФИОПациента", dbText, 100)
    tdf.Fields.Append tdf.CreateField("ФИОВрача", dbText, 100)
    tdf.Fields.Append tdf.CreateField("Диагноз", dbText, 100)
    tdf.Fields.Append tdf.CreateField("Сумма", dbCurrency)
    tdf.Fields.Append tdf.CreateField("Процент", dbDouble)
    db.TableDefs.Append tdf

    ' 4. Переносим тех, кто платит наличными и дороже среднего
    Set rsNew = db.OpenRecordset("ДорогиеНал")
    rs.MoveFirst
    Do Until rs.EOF
        summa = rs("ДнейЛечения") * rs("СтоимостьДня")
        If rs("КатегорияОплаты") = "нал" And summa > srednee Then
            rsNew.AddNew
            rsNew("КодПациента") = rs("КодПациента")
            rsNew("ФИОПациента") = rs("ФИОПациента")
            rsNew("ФИОВрача") = rs("ФИОВрача")
            rsNew("Диагноз") = rs("Диагноз")
            rsNew("Сумма") = summa
            rsNew("Процент") = Round(summa / vsego * 100, 2)
            rsNew.Update
            kolDorogih = kolDorogih + 1
        End If
        rs.MoveNext
    Loop
    rs.Close
    rsNew.Close

    Application.RefreshDatabaseWindow
    MsgBox "Средняя стоимость лечения: " & srednee & " руб." & vbCrLf & _
           "Дорогих пациентов с наличной оплатой: " & kolDorogih & " из " & kolVsego & _
           " (" & Format(kolDorogih / kolVsego * 100, "0.0") & "%)"
    DoCmd.OpenTable "ДорогиеНал"
End Sub

' ===== Задание 5 =====
Private Sub btnTask5_Click()
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim rs As DAO.Recordset
    Dim estPole As Boolean
    Dim summa As Currency, vsego As Currency
    Dim kol As Long, kolSkidka As Long
    Dim procent As Double, sredProcent As Double

    Set db = CurrentDb
    Set tdf = db.TableDefs("Стационар")

    ' 1. Добавляем поле «Скидка», если его ещё нет
    For Each fld In tdf.Fields
        If fld.Name = "Скидка" Then estPole = True
    Next
    If Not estPole Then
        tdf.Fields.Append tdf.CreateField("Скидка", dbCurrency)
    End If

    ' 2. Общая сумма и средний процент (100% / число больных)
    Set rs = db.OpenRecordset("Стационар")
    Do Until rs.EOF
        vsego = vsego + rs("ДнейЛечения") * rs("СтоимостьДня")
        kol = kol + 1
        rs.MoveNext
    Loop
    sredProcent = 100 / kol

    ' 3. Скидка 10% тем, у кого процент выше среднего
    rs.MoveFirst
    Do Until rs.EOF
        summa = rs("ДнейЛечения") * rs("СтоимостьДня")
        procent = summa / vsego * 100
        rs.Edit
        If procent > sredProcent Then
            rs("Скидка") = summa * 0.1
            rs("СтоимостьДня") = rs("СтоимостьДня") * 0.9
            kolSkidka = kolSkidka + 1
        Else
            rs("Скидка") = 0
        End If
        rs.Update
        rs.MoveNext
    Loop
    rs.Close

    MsgBox "Средний процент: " & Format(sredProcent, "0.00") & "%" & vbCrLf & _
           "Скидку 10% получили: " & kolSkidka & " чел."
    DoCmd.OpenTable "Стационар"
End Sub

' ===== Задание 6 =====
Private Sub btnTask6_Click()
    Dim rs As DAO.Recordset
    Dim kol(1 To 100) As Long
    Dim summa(1 To 100) As Currency
    Dim fio(1 To 100) As String
    Dim kod As Long, i As Long
    Dim otvet As String

    Set rs = CurrentDb.OpenRecordset("Стационар")

    ' 1. Безнал +40%, нал +25%
    Do Until rs.EOF
        rs.Edit
        If rs("КатегорияОплаты") = "безнал" Then
            rs("СтоимостьДня") = rs("СтоимостьДня") * 1.4
        Else
            rs("СтоимостьДня") = rs("СтоимостьДня") * 1.25
        End If
        rs.Update
        rs.MoveNext
    Loop

    ' 2. Считаем больных и сумму у каждого врача
    rs.MoveFirst
    Do Until rs.EOF
        kod = rs("КодВрача")
        kol(kod) = kol(kod) + 1
        summa(kod) = summa(kod) + rs("ДнейЛечения") * rs("СтоимостьДня")
        fio(kod) = rs("ФИОВрача")
        rs.MoveNext
    Loop
    rs.Close

    ' 3. Выводим итоги
    For i = 1 To 100
        If kol(i) > 0 Then
            otvet = otvet & fio(i) & ": больных " & kol(i) & _
                    ", сумма " & Format(summa(i), "#,##0.00") & " руб." & vbCrLf
        End If
    Next
    MsgBox otvet, , "Итоги по врачам"
End Sub