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

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