Разработка автоматизированной системы учета выбывших из стационара

Дипломная работа - Компьютеры, программирование

Другие дипломы по предмету Компьютеры, программирование



?ер направляющего стационара

PRIVATE _STATE && Название государства

PRIVATE _PLACE && Название области РФ

*PRIVATE _WHY && Причины направления

PRIVATE _DEPARTMENT && Отделение

PRIVATE _KOIKA && Профиль койки

PRIVATE _PASS && Характер поступления (экстренно,не экстренно)

PRIVATE _TIME && Через какое время после заболевания

PRIVATE _DATE_IN && Дата поступления

_DATE_IN=DATE()

PRIVATE time_IN && Время поступления

time_IN="00.00"

PRIVATE _HOUR_IN && Часы поступления

PRIVATE _MINS_IN && Минуты поступления

PRIVATE _END1 && Исход заболевания

PRIVATE _END2 && Причина исхода

PRIVATE _END3 && Если переведен, то куда

PRIVATE _DATE_END && Дата выписки

PRIVATE time_END && Время выписки

time_END="00.00"

PRIVATE _HOUR_END && Часы выписки

PRIVATE _MINS_END && Минуты выписки

PRIVATE _ALL_DAY && Общее количество дней, проведенных в стационаре

PRIVATE _DIA_DIRECT && Диагноз направляющего учреждения

PRIVATE _NUM_COME && Номер поступления

PRIVATE _RW_DATE && Дата анализа на RW

PRIVATE _RW_REZ && Результат анализа

PRIVATE _FAM_DOCTOR && Фамилия лечащего врача

PRIVATE _KOD1 && Клинический диагноз

PRIVATE _KOD2 && Поталого-анатомический диагноз

PRIVATE _SHIFR && Шифр заболевания по МКБ

PRIVATE _SHIFR_ILL && Шифр операции из каталога операций

*********************************************************************

SELECT 0 && БД шифров заболеваний всех больных

USE DIA66 INDEX DIA66 ALIAS DIA66

COPY STRUCTURE TO BUFF.DBF

SELECT 0 && Вспомогательная БД для формирования диагнозов больного

USE BUFF ALIAS BUFF

INDEX ON NUM_IB+KOD2+KOD1 TO BUFF.NTX

SELECT 0 && БД шифров операций всех больных

USE OP66 INDEX OP66 ALIAS OP66

COPY STRUCTURE TO BUFF2.DBF

SELECT 0 && Вспомогательная БД для формирования шифров операций

USE BUFF2 ALIAS BUFF2

INDEX ON NUM_IB TO BUFF2.NTX

SELECT 0 && БД кодификаторов

USE CODIF INDEX CODIF ALIAS CODIF

SELECT 0 && БД с основной информацией о пациентах

USE KARTA66 INDEX KARTA66 ALIAS KARTA

SELECT 0 && БД с шаблонами

USE CODPIC INDEX CODPIC ALIAS CODPIC

SELECT 0 && БД с прототипами

USE CODTXT INDEX CODTXT ALIAS CODTXT

*********************** ОСHОВHАЯ РАМКА ***************************

SET COLOR TO "W+/N"

flop_box(c, 0,0,24,79,doubl+fon1)

saycent(0,0,79," ФОРМА N 66 ")

saycent(24,0,79,  перемещение - выбор F10-меню )

******************** ВВОД СЕГОДHЯШHЕЙ ДАТЫ ***********************

SET COLOR TO(color2)

_today=DATE()

flop_box(c, 9,25,11,55,singl+fon2)

@ 10,32 SAY "СЕГОДHЯ:" GET _today

READ

_NUM_IB=RIGHT(STR(YEAR(_today)),2)+"00000"

**********************************************************************

* ОСНОВНОЙ ЦИКЛ ПРОГРАММЫ *

**********************************************************************

@ 1,1 CLEAR TO 23,78 && очистка экрана для переменных

SET COLOR TO (color1)

@ 2,1,22,78 BOX f1_fon

choice = 1

PRIVATE screen0

DO WHILE choice # 6

SET COLOR TO (color1)

gotomain=.f.

***************** ВЫВОД ГЛАВНОГО МЕНЮ *********************

@ 1,2 PROMPT "Создание" MESSAGE " ввод новой записи ИБ"

@ 1,12 PROMPT "Удаление" MESSAGE " удаление записи из ИБ"

@ 1,22 PROMPT "Редактирование/Печать" MESSAGE " редактирование записи ИБ "

@ 1,45 PROMPT "Навигатор" MESSAGE "движение по базе данных"

@ 1,56 PROMPT "Отчет" MESSAGE "составление отчетных форм"

@ 1,67 PROMPT " Выход " MESSAGE " выход из программы "

MENU TO choice

SAVE SCREEN TO screen0

DO CASE

CASE choice=1 && Добавления записи

IF( inpindex()=0) && Ввод ключа "НОМЕР ИСТОРИИ БОЛЕЗНИ"

@ 11,18 CLEAR TO 14,62

saycent(12,20,60,"ПОДОЖДИТЕ НЕМНОГО - ИДЕТ ИНИЦИАЛИЗАЦИЯ")

DO edit WITH .T.

ENDIF

CASE choice=2 && Удаление записи

DO del

CASE choice=3 && Изменение записи ИБ

SET COLOR TO(color2)

PRIVATE D1

DO WHILE .T.

D1=det() && Поиск нужной записи

IF D1=1 && Запись найдена

saycent(12,20,60,"ПОДОЖДИТЕ НЕМНОГО - ИДЕТ СЧИТЫВАНИЕ ИЗ БД")

DO edit WITH .T.

EXIT

ELSEIF D1=2 && Запись не найдена

saycent(12,20,60,"ИНФОРМАЦИИ ОБ УКАЗАННОМ БОЛЬНОМ В БД НЕТ ")

INKEY(5)

ELSE

EXIT

ENDIF

ENDDO

RELEASE D1

CASE choice=4 && Движение по БД

DO navy

CASE choice=5 && Составление отчетных документов

rez()

CASE choice=6 && Завершение программы

EXIT

ENDCASE

PRIVATE sel

sel=SELECT()

SELECT BUFF

ZAP

SELECT BUFF2

ZAP

SELECT (sel)

RELEASE sel

RESTORE SCREEN FROM screen0

ENDDO

COMMIT && Сохраняем рабочие области на диске

CLOSE ALL

DELETE FILE BUFF.DBF

DELETE FILE BUFF.DBT

DELETE FILE BUFF.NTX

DELETE FILE BUFF2.DBF

DELETE FILE BUFF2.DBT

DELETE FILE BUFF2.NTX

RETURN

**********************************************************************

* КОHЕЦ ГЛАВHОГО МОДУЛЯ *

**********************************************************************

**********************************************************************

* INPINDEX() - функция ввода номера истории болезни *

**********************************************************************

FUNCTION inpindex

PRIVATE sel,ret,scr

ret=-1

@ 2,1,4,78 BOX f3+fon2

sel=SELECT()

SELECT KARTA

SET CURSOR ON

DO WHILE !gotomain

SET COLOR TO(color2)

@ 3,28 SAY "Номер ИБ " GET _NUM_IB PICTURE "@R 99/99999"

READ

IF LASTKEY()=27 && ESC

ret= (-1)

EXIT

ENDIF

IF LEN(ALLTRIM(_NUM_IB))=7

SEEK _NUM_IB

IF FOUND()

TONE(100,3)

message(e,"ТАКАЯ ЗАПИСЬ УЖЕ СУЩЕСТВУЕТ,ПРОВЕРЬТЕ HОМЕР ИБ ")

LOOP

ENDIF

ret=0

EXIT

ELSE

TONE(100,3)

message(e,HЕ ЗАПОЛHЕH НОМЕР ИБ,ПРОВЕРЬТЕ ЗАПИСЬ)

ret=-1

ENDIF

ENDDO

SELECT(sel)

RETURN (ret)

**********************************