1. Процедуры формы Form1.Frm

‘Объявление глобальных перемен

Dim NK$(), FIOb$(), DATAr() As Date, FIOv$(), DATAp() As Date, Diagnoz$(), i%

‘Очистка метки

Private Sub LstD_P_Click()

Label8.Caption = ""

End Sub

‘Очистка метки

Private Sub LstD_R_Click()

Label8.Caption = ""

End Sub

‘Очистка метки

Private Sub LstF_B_Click()

Label8.Caption = ""

End Sub

‘Очистка метки

Private Sub LstN_Click()

Label8.Caption = ""

End Sub

' выбор врача, принимающем больных

Private Sub LstF_V_Click()

Dim k As Byte

Label8.Caption = ""

If LstF_V.ListIndex <> -1 Then

Schit NK(), FIOb(), DATAr(), FIOv(), DATAp(), Diagnoz(), i%

Label8.Caption = "Лечащий врач << " & LstF_V.Text & ">> принял пациентов "

For k = 0 To i - 1

If LstF_V.Text = LstF_V.List(k) Then

Label8.Caption = Label8.Caption + LstF_B.List(k) & ", "

End If

Next k

Label8.Caption = Mid(Label8.Caption, 1, Len(Label8.Caption) - 2) & ". "

End If

End Sub

' выбор пациентов с одинаковым диагнозом

Private Sub LstDg_Click()

Dim k As Byte, a As Byte, b As Byte, vosr As Byte

Label8.Caption = ""

If LstDg.ListIndex <> -1 Then

Schit NK(), FIOb(), DATAr(), FIOv(), DATAp(), Diagnoz(), i%

a = InputBox("Введите нижний порог", "Ввод порога")

b = InputBox("Введите верхний порог", "Ввод порога")

Label8.Caption = "C диагнозом << " & LstDg.Text & ">> пациенты "

For k = 0 To i - 1

If LstDg.Text = LstDg.List(k) Then

vosr = (Date - DATAr(k + 1)) / 365 'находим возраст всех больных в списке

If vosr >= CInt(a) And vosr <= CInt(b) Then

Label8.Caption = Label8.Caption + LstF_B.List(k) & ", "

End If

End If

Next k

If Len(Label8.Caption) > 37 Then

Label8.Caption = Mid(Label8.Caption, 1, Len(Label8.Caption) - 2) & ". В возрастной категории от " & a & " до " & b & " лет."

Else

Label8.Caption = ""

MsgBox "В возрастной категории от " & a & " до " & b & " лет пациентов с данным диагнозом нет."

sinchr

End If

End If

End Sub

' Выбор справки о диагнозе

Private Sub mnuDiagnItem_Click()

sinchr

mnuUdZapItem.Enabled = False

Label8.Caption = ""

If mnuDiagnItem.Checked = False Then

mnuDiagnItem.Checked = True

mnuPriemItem.Checked = False

MsgBox "Выберите из списка ДИАГНОЗ", 64, "Сообщение"

Else

mnuDiagnItem.Checked = False

mnuUdZapItem.Enabled = True

End If

End Sub

'Процедура добавления пациента в файл

Private Sub mnuPostUchPazItem_Click()

Dim NK$, FIOb$, DATAr As Date, FIOv$, DATAp As Date, Diagnoz$, prv2%, prv As Byte

Label8.Caption = ""

t = 6

' ввод номера карточки

Do Until t = 7

prv = 0

Do

NK = InputBox("Введите номер карточки больного", "Ввод данных")

If NK = Empty Then

MsgBox "Вы ничего не ввели!Пожалуйста, повторите ввод!", 16, "Ошибка"

ElseIf Val(NK) = 0 Then

MsgBox "Введите целое число!Пожалуйста, повторите ввод!", 16, "Ошибка"

ElseIf Len(NK) <> 4 Then

MsgBox "Номер карточки должен содержать 4 цифры. Повторите ввод.", 16, "Ошибка"

Else

prv = 1

End If

prv2 = 0

prv2 = kontr(NK)

If prv = 1 And prv2 = 1 Then Exit Do

Loop

' ввод фамилии пациента

Do

FIOb = UCase(InputBox("Введите фамилию больного", "Ввод данных"))

If FIOb = Empty Then

MsgBox "Вы ничего не ввели!Пожалуйста, повторите ввод!", 16, "Ошибка"

ElseIf Val(FIOb) <> 0 Then

MsgBox "Некорректный ввод фамилии!Пожалуйста, повторите ввод!", 16, "Ошибка"

Else

Exit Do

End If

Loop

' ввод даты рождения больного

DATAr = CDate(VvodData("Введите дату рождения пациента в формате <<дд.мм.гггг>>", " "))

'Процедура добавления пациента в файл(окончание)

' ввод фамилии лечащего врача

Do

FIOv = UCase(InputBox("Введите фамилию лечащего врача", "Ввод данных"))

If FIOv = Empty Then

MsgBox "Вы ничего не ввели!Пожалуйста, повторите ввод!", 16, "Ошибка"

ElseIf Val(FIOv) <> 0 Then

MsgBox "Некорректный ввод фамилии!Пожалуйста, повторите ввод!", 16, "Ошибка"

Else

Exit Do

End If

Loop

' ввод даты приема

d = Date

DATAp = CDate(VvodData("Введите дату последнего посещения врача пациентом в формате <<дд.мм.гггг>>", d))

' ввод диагноза

Do

Diagnoz = UCase(InputBox("Введите диагноз больного", "Ввод данных"))

If Diagnoz = Empty Then

MsgBox "Вы ничего не ввели! Пожалуйста, повторите ввод!", 16, "Ошибка"

ElseIf Val(Diagnoz) <> 0 Then

MsgBox "Некорректный ввод диагноза.Пожалуйста, повторите ввод!", 16, "Ошибка"

Else

Exit Do

End If

Loop

Open "Poliklinika.txt" For Append As #1

Write #1, NK, FIOb, DATAr, FIOv, DATAp, Diagnoz 'запись в файл пациентов

Close #1

t = MsgBox("Следующий пациент?", vbYesNo, "")

Loop

MsgBox "Данные успешно занесены в файл", 64, "Информация"

vivod

End Sub

' Выбор справки о больных принятых одним врачем

Private Sub mnuPriemItem_Click()

mnuUdZapItem.Enabled = False

sinchr

Label8.Caption = ""

If mnuPriemItem.Checked = False Then

mnuPriemItem.Checked = True

mnuDiagnItem.Checked = False

MsgBox "Выбирете из списка ФАМИЛИЮ врача, пациентов которого Вы хотите посмотреть", 64, "Справка"

Else

mnuPriemItem.Checked = False

mnuUdZapItem.Enabled = True

End If

End Sub

' формирование всей информации о пациентах

Private Sub mnuSpisPazItem_Click()

vivod

mnuSpravka.Enabled = True

End Sub

'Процедура выхода из программы

Private Sub mnuExit_Click()

Dim EndP As Byte

EndP = MsgBox("Вы уверены что хотите выйти?", 36, "Выход")

If EndP = 6 Then End

End Sub

' процедура вывода системного времени при загрузке формы

Private Sub Form_Load()

Frm1.Caption = "Текущая дата " & Date & ""

End Sub

'процедура удаления пациента

Private Sub mnuUdZapItem_Click()

Dim k As Byte, i%, r As Byte, g As Byte

If LstN.ListIndex <> -1 Or LstF_V.ListIndex <> -1 Or LstD_R.ListIndex <> -1 Or LstD_P.ListIndex <> -1 Or LstDg.ListIndex <> -1 Then

Sinchr

'процедура удаления пациента(окончание)

MsgBox "Выбирать можно только из списка ФАМИЛИЙ больных. Пожалуйста, повторите выбор", 16, "Ошибка"

Else

t = MsgBox("Вы точно хотите удалить запись?", 36, "")

If t = 6 Then

i = 0

Schit NK(), FIOb(), DATAr(), FIOv(), DATAp(), Diagnoz(), i

s = LstF_B.ListIndex

k = 1

If s = -1 Then

MsgBox "Не выбран пациент, которого нужно удалить.Пожалуйста, повторите выбор!", 16, "Ошибка"

Else

Do

For g = s + 1 To i - 1

NK(g) = NK(g + 1)

FIOb(g) = FIOb(g + 1)

DATAr(g) = DATAr(g + 1)

FIOv(g) = FIOv(g + 1)

DATAp(g) = DATAp(g + 1)

Diagnoz(g) = Diagnoz(g + 1)

Next

LstN.RemoveItem (r)

LstF_V.RemoveItem (r)

LstF_B.RemoveItem (r)

LstD_P.RemoveItem (r)

LstD_R.RemoveItem (r)

LstDg.RemoveItem (r)

Exit Do

k = k + 1

Loop

Open "Poliklinika.txt" For Output As #1

For k = 1 To i - 1

Write #1, NK(k), FIOb(k), DATAr(k), FIOv(k), DATAp(k), Diagnoz(k)

Next

Close #1

End If

ochist 'очищаем листы

vivod 'выводим данные из файла

End If

End If

End Sub