time_B="00.00"
PRIVATE _HOUR_B && Часы рождения
PRIVATE _MINS_B && Минуты рождения
PRIVATE _POL && Пол
PRIVATE _OLD && Возраст на момент поступления
PRIVATE _OLD_D && Возраст на момент смерти
PRIVATE _MASSA && Масса
PRIVATE _PLACE_LIV && Место жительства
PRIVATE _RAION && Район проживания
PRIVATE _CITY_VILL && Городской/сельский житель
PRIVATE _DIRECT1 && Кем направлен
PRIVATE _DIRECT2 && Номер направляющего стационара
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)
**********************************************************************
**********************************************************************
* DET() - функция поиска необходимой для редактирования записи *
**********************************************************************
FUNCTION det
PRIVATE ret1,menu1
PRIVATE sel1,clr1,screen1
ret1=2
sel1=SELECT()
clr1=SETCOLOR()
SELECT karta
SET COLOR TO &color5
@ 10,8 CLEAR TO 14,72
SAVE SCREEN TO screen1
@ 11,15 PROMPT "ВВЕДИТЕ НОМЕР И/Б "
@ 13,15 PROMPT "ВВЕДИТЕ ФАМИЛИЮ БОЛЬНОГО "
MENU TO menu1
IF menu1=0
ret1=0
ELSEIF menu1=1
SET CURSOR ON
@ 11,45 GET _NUM_IB PICTURE "@R 99/99999"
READ
SET CURSOR OFF
SEEK _NUM_IB
IF FOUND()
ret1=1
ENDIF
ELSEIF menu1=2
SET CURSOR ON
@ 13,45 GET _FAM PICTURE "@K" VALID RUSSIAN(_FAM)
READ
SET CURSOR OFF
SET FILTER TO FAM=ALLTRIM(_FAM)
GO TOP
IF !EOF()
ret1=1
_NUM_IB=NUM_IB
ENDIF
SET FILTER TO
ENDIF
RESTORE SCREEN FROM screen1
SELECT (sel1)
SET COLOR TO (clr1)
RETURN (ret1)
**********************************************************************
* ЗАПОЛНЕНИЕ 66 ФОРМЫ *
**********************************************************************
PROCEDURE edit
PARAMETERS do_edit
PRIVATE wt,wb,wl,wr,choice,beg_line,length,string,string1,title
PRIVATE sel,str,i
**************** ОБЪЯВЛЕНИЕ МЕНЮ *****************
PRIVATE last,numenu
last=SELECT()
numenu=1
select 0
use menu.dbf index menu alias menu
numenu=RECCOUNT()
DECLARE promp[numenu-1],vars[numenu-1],row[numenu-1],col[numenu-1]
&& массив промптеров для основного меню
GO TOP
i=1
SEEK "MAIN"
title=STRTRAN(ALLTRIM(text),'Н','H')
SKIP
DO WHILE !EOF() &&LEFT(KEY,4)="MAIN"
promp[i]=STRTRAN(ALLTRIM(text),'Н','H')
i=i+1
SKIP
ENDDO
use
SELECT (last)
******************* КОНЕЦ ОБЪЯВЛЕНИЯ **************
AFILL(vars,' ')
AFILL(col,1)
wt=3
wb=22
wl=2
wr=77
length=wr-wl+1 && Длина строки текста, выводимого на экран
beg_line=1
PRIVATE New_Str && Признак новой строки для Context
New_Str=.F. && Без выделения промптеров
**************************************************************
s=IF(KARTA->END1=3,6,3)
DECLARE promp1[s],vars1[s],row1[s],col1[s] && массив промптеров дополн. меню
promp1[1]="Основное заболевание :"
promp1[2]="Осложнения :"
promp1[3]="Сопутствующие заболевания :"
AFILL(vars1,' ')
AFILL(col1,1)
IF s=6
promp1[4]="Основное заболевание :"
promp1[5]="Осложнения :"
promp1[6]="Сопутствующие заболевания :"
ENDIF
**************************************************************
DO initial && Процедура формирования выводимого текста
**************************************************************
cur_promp=1
@ 3,1 CLEAR TO 22,78
DO WHILE .T.
IF gotomain.AND.do_edit
IF yesno(12," Сохранить изменения в базе данных ? ")=1
IF all_r()
DO new_save
RETURN
ELSE
gotomain=.F.
ENDIF
ELSE
RETURN
ENDIF
ELSEIF gotomain.AND.!do_edit
RETURN
ENDIF
new_str=.F.
choice=hypertxt(wt,wl,wb,wr,string,promp,row,col,@beg_line,@cur_promp,color8,;
title)
cur_promp=cur_promp%len(promp)+1
IF do_edit
i=choice
DO CASE
CASE i=0
LOOP
CASE i=1
LOOP
CASE i=2
vars[i]=offset_get(wt,wl,beg_line,row[i],col[i],promp[i],@_FAM,;
"","RUSSIAN(_FAM)")
CASE i=3
vars[i]=offset_get(wt,wl,beg_line,row[i],col[i],promp[i],@_F_S_NAME,;
"","RUSSIAN(_F_S_NAME)")
CASE i=4
_DATE_IN=d_input(_DATE_IN)
vars[i]=DTOC(_DATE_IN)
_ALL_DAY=_DATE_END-_DATE_IN
IF _ALL_DAY=0
_ALL_DAY=1
ENDIF
DO ch_day && Изменение количества дней, проведеннх в стационаре
CASE i=5
vars[i]=offset_get(wt,wl,beg_line,row[i],col[i],promp[i],@time_IN,;
"99.99","check_T(time_IN)")
_HOUR_IN=VAL(SUBSTR(time_IN,1,2))
_MINS_IN=VAL(SUBSTR(time_IN,4,5))
CASE i=6
vars[i]=codif1("POLS",@_POL)
CASE i=7
_DATE_B=d_input(_DATE_B)
vars[i]=DTOC(_DATE_B)
CASE i=8
vars[i]=offset_get(wt,wl,beg_line,row[i],col[i],promp[i],@time_B,;
"99.99","check_T(time_B)")
_HOUR_B=VAL(SUBSTR(time_B,1,2))
_MINS_B=VAL(SUBSTR(time_B,4,5))
y_m_day(_DATE_B,_HOUR_B,_MINS_B,_DATE_IN,_HOUR_IN,_MINS_IN)
CASE i=9
vars[i]=codif1("OLDS",@_OLD)
CASE i=10
vars[i]=m_input() && Ввод веса тела
CASE i=11
vars[i]=offset_get(wt,wl,beg_line,row[i],col[i],promp[i],@_PLACE_LIV)
CASE i=12
vars[i]=codif1("RIGS",@_RAION)
CASE i=13
vars[i]=codif1("CITZ",@_CITY_VILL)
CASE i=14
vars[i]=codif1("DIRS",@_DIRECT1)
IF _DIRECT1=1
vars[i]=codif1("BIRS",@_DIRECT2)
ELSEIF _DIRECT1=2
vars[i]=codif1("HOSP",@_DIRECT2)
ELSE
_DIRECT2=0
ENDIF
CASE i=15
vars[i]=codifpic("CODIF","STTE",@_STATE)
IF _STATE=1
promp[i]="Регион :"
vars[i]=codifpic("CODIF","PLCE",@_PLACE)
ELSE
promp[i]="Государство :"
ENDIF
* CASE i=15
* vars[i]=codif1("RIZS",@_WHY)
CASE i=16
vars[i]=codif1("DEPS",@_DEPARTMENT)
CASE i=17
vars[i]=codif1("KOIK",@_KOIKA)
CASE i=18
vars[i]=codif1("EXTR",@_PASS)
CASE i=19
vars[i]=codif1("TIMS",@_TIME)
CASE i=20
vars[i]=codif1("REZS",@_END1)
CASE i=21
_DATE_END=d_input(_DATE_END)
vars[i]=DTOC(_DATE_END)
_ALL_DAY=_DATE_END-_DATE_IN
IF _ALL_DAY=0
_ALL_DAY=1
ENDIF
IF _ALL_DAY>=0.AND.EMPTY(_DATE_IN)=.F.
vars[i]=vars[i]+SPACE(5)+"Проведено дней в стационаре :"+STR(_ALL_DAY)
ENDIF
CASE i=22
vars[i]=offset_get(wt,wl,beg_line,row[i],col[i],promp[i],@time_END,;
"99.99","check_T(time_END)")
_HOUR_END=VAL(SUBSTR(time_END,1,2))
_MINS_END=VAL(SUBSTR(time_END,4,5))
CASE i=23
PRIVATE txtd
txtd=SPACE(100)
vars[i]=offset_get(wt,wl,beg_line,row[i],col[i],promp[i],@_DIA_DIRECT,;
"@R 999.9")
mkb(1,1,@_DIA_DIRECT,@txtd)
IF _DIA_DIRECT=" "
vars[23]=""
ELSE
vars[23]=SUBSTR(_DIA_DIRECT,1,3)+"."+SUBSTR(_DIA_DIRECT,4,1)+" "+;
"<"+TRIM(txtd)+">"
new_str=.T.
ENDIF
RELEASE txtd
CASE i=24
vars[i]=codif1("VIZI",@_NUM_COME)
CASE i=27
_RW_DATE=d_input(_RW_DATE)
vars[i]=DTOC(_RW_DATE)
CASE i=28
vars[i]=codif1("RWRZ",@_RW_REZ)