Разработка автоматизированной системы учета выбывших из стационара
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)+"
"+;
""
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)
CASE i=29
vars[i]=codifpic("CODIF","FAMS",@_FAM_DOCTOR)
*********************************************
CASE i=25
vars[i]=diagn()
new_str=.T.
*********************************************
CASE i=26
DO op
new_str=.T.
ENDCASE
***********************************************************
string1=""
IF choice#25.AND.choice#26
vars[choice]=TRIM(vars[choice])+"."
ENDIF
context(@string1,promp[choice],vars[choice],length,New_Str)
IF choice=20
IF _END1=2 && переведен
context(@string1,"Причина:",codif1("RIZ2",@_END2)+".",length,.F.)
context(@string1,"Куда:",codif1("HOSP",@_END3)+".",length,.F.)
ELSEIF _END1=3 && умер
context(@string1,"Причина:",codif1("RIZ3",@_END2)+".",length,.F.)
ENDIF
ELSEIF choice=22.AND._END1=3
y_m_day(_DATE_B,_HOUR_B,_MINS_B,_DATE_END,_HOUR_END,_MINS_END)
context(@string1,"Возраст на момент смерти :",;
extra1(_OLD_D,"OLDS")+".",length,.F.)
ELSEIF choice=26
context(@string1,"Обследование на реакцию ВАССЕРМАНА :","",length,.F.)
ENDIF
stuff1(@string,length,string1,choice,row,len(promp))
ENDIF
ENDDO
RETURN
**********************************************************************
* ПРОЦЕДУРА ФОРМИРОВАНИЯ СОДЕРЖИМОГО 66 ФОРМЫ *
**********************************************************************
PROCEDURE initial
PRIVATE sel,i,v
PRIVATE rez
SET CURSOR OFF
sel=SELECT()
v=replicate(chr(176),30)
@ 13,25 SAY v
SELECT karta
vars[1]= SUBSTR(_NUM_IB,1,2)+'/'+SUBSTR(_NUM_IB,3,7)
vars[2] =FAM
_FAM=FAM
vars[3] =F_S_NAME
_F_S_NAME=F_S_NAME
vars[4]=DTOC(DATE_IN)
_DATE_IN=DATE_IN
*__________________________________
_HOUR_IN=HOUR_IN
_MINS_IN=MINS_IN
IF _HOUR_IN=0.AND._MINS_IN=0
time_IN="00.00"
ELSEIF _HOUR_IN=0
time_IN="00."+STR(MINS_IN)
ELSEIF _MINS_IN=0
time_IN=STR(HOUR_IN)+".00"
ELSE
time_IN=STR(HOUR_IN)+"."+STR(MINS_IN)
ENDIF
vars[5]=time_IN
*----------------------------------
vars[6] =extra1(POL,"POLS")
_POL=POL
vars[7] =DTOC(DATE_B)
_DATE_B=DATE_B
*__________________________________
_HOUR_B=HOUR_B
_MINS_B=MINS_B
IF _HOUR_B=0.AND._MINS_B=0
time_B="00.00"
ELSEIF _HOUR_B=0
time_B="00."+STR(MINS_B)
ELSEIF _MINS_B=0
time_B=STR(HOUR_B)+".00"
ELSE
time_B=STR(HOUR_B)+"."+STR(MINS_B)
ENDIF
vars[8]=time_B
*-----------------------------------
vars[9] =extra1(OLD,"OLDS")
_OLD=OLD
_OLD_D=OLD_D
vars[10] =MASSA
_MASSA =MASSA
vars[11] =PLACE_LIV
_PLACE_LIV=PLACE_LIV
vars[12] =extra1(RAION,"RIGS")
_RAION =RAION
vars[13]=extra1(CITY_VILL,"CITZ")
_CITY_VILL=CITY_VILL
*___________________________________
_DIRECT1=DIRECT1
_DIRECT2=DIRECT2
vars[14]=IF(_DIRECT2=0,extra1(_DIRECT1,"DIRS"),;
IF(_DIRECT1=1,extra1(_DIRECT2,"BIRS"),;
extra1(_DIRECT2,"HOSP")))
*------------------------------------
promp[15]=IF(PLACE#0,"Регион :","Государство :")
vars[15]=IF(STATE#0,IF(STATE=1,;
IF(PLACE=0,"Российская
Федерация",extra1(PLACE,"PLCE")),;
extra1(STATE,"STTE")),;
"Российская Федерация")
_STATE=IF(STATE=0,1,STATE)
_PLACE=PLACE
vars[16]=extra1(DEPARTMENT,"DEPS")
_DEPARTMENT=DEPARTMENT
vars[17]=extra1(KOIKA,"KOIK")
_KOIKA=KOIKA
vars[18]=extra1(PASS,"EXTR")
_PASS=PASS
vars[19]=extra1(TIME,"TIMS")
_TIME=TIME
*__________________________________
_END1=END1
_END2=END2
_END3=END3
vars[20]=extra1(_END1,"REZS")
*----------------------------------
vars[21]=DTOC(DATE_END)
_DATE_END=DATE_END
*__________________________________
_HOUR_END=HOUR_END
_MINS_END=MINS_END
IF _HOUR_END=0.AND._MINS_END=0
time_END="00.00"
ELSEIF _HOUR_END=0
time_IN="00."+STR(MINS_END)
ELSEIF _MINS_END=0
time_IN=STR(HOUR_END)+".00"
ELSE
time_END=STR(HOUR_END)+"."+STR(MINS_END)
ENDIF
vars[22]=time_END
*__________________________________
_ALL_DAY=ALL_DAY
IF !EMPTY(_DATE_END)
vars[21]=vars[21]+SPACE(5)+"Проведено дней в стационаре :"+STR(_ALL_DAY)
ENDIF
*----------------------------------
_DIA_DIRECT=SHIFR
IF _DIA_DIRECT#" "
PRIVATE txtd
txtd=SPACE(100)
mkb(1,1,@_DIA_DIRECT,@txtd)
vars[23]=SUBSTR(_DIA_DIRECT,1,3)+"."+SUBSTR(_DIA_DIRECT,4,1)+" "+;
""
RELEASE txtd
ELSEIF _DIA_DIRECT=" "
vars[23]=_DIA_DIRECT
ENDIF
*----------------------------------
vars[24]=extra1(NUM_COME,"VIZI")
_NUM_COME=NUM_COME
vars[27]=DTOC(RW_DATE)
_RW_DATE=RW_DATE
vars[28]=extra1(RW_REZ,"RWRZ")
_RW_REZ=RW_REZ
vars[29]=extra1(FAM_DOCTOR,"FAMS")
_FAM_DOCTOR=FAM_DOCTOR
v=replicate(chr(178),10)
@ 13,25 SAY v
*************************************
vars[25]=initial1("DIA66")
v=replicate(chr(178),20)
@ 13,25 SAY v
*************************************
SELECT op66
SET SOFTSEEK ON
seek _num_ib
SET SOFTSEEK OFF
IF !FOUND()
vars[26]="" && Хирургические операции
_SHIFR_ILL="0000" &&SHIFR_ILL
ELSE
PRIVATE txts,string8
txts=SPACE(70)
STORE "" TO string8
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11
|