6. Разработка контрольного примера

6.1. Исходные данные файла

Данные из файла представлены в таблице 6.1.

Ном. карточки	ФИО больного	Дата рождения больного	ФИО врача	Дата послед. посещения	Диагноз
1496	НЕМТЫРЕВ	1977-09-12	КЛИМЕНКО	2010-11-12	ПНЕВМОНИЯ
1234	МОРОЗОВ	2007-12-12	ЧЕРНОУС	2010-09-09	АНГИНА
3694	КУЛЬКОВА	1995-08-17	РОМАНЕНКО	2010-11-14	ЯЗВА
1458	РУМЯНЦЕВ	1955-12-23	КАРИМОВА	2010-11-09	ГРИПП
5698	АНИКИН	1945-09-08	ЛОБАНОВ	2010-11-13	ГРИПП
1478	РЫЖИКОВА	2005-11-04	КАРИМОВ	2010-11-14	БРОНХИТ
3695	ДУДАРЕВ	1964-02-26	РОМАНЕНКО	2010-11-13	ВЕТРЯНКА
1425	ХВОСТОВА	1936-05-27	КАРИМОВА	2010-11-11	ВЕТРЯНКА
3658	СЕРЕГИН	1999-02-03	ЛОБАНОВ	2010-11-12	ГРИПП
1256	РОМАНОВ	1996-04-12	ЛОБАНОВ	2011-08-19	ПНЕВМОНИЯ

Таблица 6.1.Данные из файла

6.2. Тестовые наборы

Тестовые наборы для первой справки представлены в таблице 6.2

Таблица 6.2. Тестовые наборы для справки №1

Набор	Количество больных принятых врачом за последнюю неделю
ЛОБАНОВ	СЕРЕГИН, РОМАНОВ, АНИКИН
РОМАНЕНКО	КУЛЬКОВА, ДУДАРЕВ

Тестовые наборы для второй справки представлены в таблице 6.3

Таблица 6.3. Тестовые наборы для справки №2

Набор			Больные в возрасте от a до b и определенном диагнозом
a	b	диагноз
10	18	ГРИПП	СЕРЕГИН
18	25	ПНЕВМОНИЯ	НЕМТЫРЕВА
5	10	ГРИПП	в возрастной категории от 5 до 10 пациентов с данным диагнозом нет
10	15	ВЕТРЯНКА	в возрастной категории от 10 до 15 пациентов с данным диагнозом нет

7. Разработка программного кода

1. Процедуры стандартного модуля

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

Option Base 1

Dim NK1$(), FIOb1$(), DATAr1() As Date, FIOv1$(), DATAp1() As Date, Diagnoz1$(), i%, t As Byte

'процедура считывания информации из файла

Sub Schit(NK1$(), FIOb1$(), DATAr1() As Date, FIOv1$(), DATAp1() As Date, Diagnoz1$(), i%)

Open "Poliklinika.txt" For Input As #1

i = 1

If LOF(1) = 0 Then

MsgBox "Извините,Файл пуст.", , "Введите данные"

i = 0

Else

Do Until EOF(1)

ReDim Preserve NK1(i), FIOb1(i), DATAr1(i), FIOv1(i), DATAp1(i), Diagnoz1(i)

Input #1, NK1(i), FIOb1(i), DATAr1(i), FIOv1(i), DATAp1(i), Diagnoz1(i)

i = i + 1

Loop

i = i - 1

ReDim Preserve NK1(i), FIOb1(i), DATAr1(i), FIOv1(i), DATAp1(i), Diagnoz1(i)

End If

Close #1

End Sub

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

Sub vivod()

Schit NK1(), FIOb1(), DATAr1(), FIOv1(), DATAp1(), Diagnoz1(), i

If i <> 0 Then

ochist

For q = 1 To i

Frm1.LstN.AddItem NK1(q)

Frm1.LstF_B.AddItem FIOb1(q)

Frm1.LstD_R.AddItem DATAr1(q)

Frm1.LstF_V.AddItem FIOv1(q)

Frm1.LstD_P.AddItem DATAp1(q)

Frm1.LstDg.AddItem Diagnoz1(q)

Next

End If

End Sub

'Функция для ввода даты

Function VvodData(a As String, b) As Date

Dim Vvod As Variant

Do

Vvod = InputBox(a, "Ввод даты данных", b)

If Vvod = Empty Then

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

ElseIf Val(Left(Vvod, 2)) > 31 Or Val(Left(Vvod, 2)) < 1 Then

MsgBox "В месяце 31 день!Повротите ввод.", 16, "Ошибка"

ElseIf Val(Mid(Vvod, 4, 2)) < 1 Or Val(Mid(Vvod, 4, 2)) > 12 Then

MsgBox "Месяц введен некорректно!Повротите ввод.", 16, "Ошибка"

ElseIf Val(Right(Vvod, 4)) < 1900 Then

MsgBox "Год рождения введен некорректно!Повротите ввод.", 16, "Ошибка"

ElseIf CDate(Vvod) > Date Then

MsgBox "Вы ввели дату,больше текущей! Повторите ввод", 16, "Ошибка"

Else

Exit Do

End If

Loop

VvodData = CDate(Vvod)

End Function

'процедура очищения списков

Sub ochist()

Frm1.LstN.Clear

Frm1.LstF_B.Clear

Frm1.LstD_R.Clear

Frm1.LstF_V.Clear

Frm1.LstD_P.Clear

Frm1.LstDg.Clear

End Sub

'функция для контроля на повтор номера карточки

Function kontr(prv_NK$)

Open "Poliklinika.txt" For Input As #1

i = 1

kontr = 1

Do Until EOF(1)

ReDim Preserve NK1(i), FIOb1(i), DATAr1(i), FIOv1(i), DATAp1(i), Diagnoz1(i)

Input #1, NK1(i), FIOb1(i), DATAr1(i), FIOv1(i), DATAp1(i), Diagnoz1(i)

If prv_NK = NK1(i) Then

MsgBox " Пациент с таким номером карточки уже зарегистрирован! Повторите ввод.", 48, "Ошибка"

kontr = 0

Exit Do

End If

Loop

Close #1

End Function

' удаление курсора

Public Sub sinchr()

Frm1.LstN.ListIndex = -1

Frm1.LstF_V.ListIndex = -1

Frm1.LstD_P.ListIndex = -1

Frm1.LstD_R.ListIndex = -1

Frm1.LstDg.ListIndex = -1

Frm1.LstF_B.ListIndex = -1

End Sub