Предыдущая страница реферата | 25  26  27  28  29  30  31  32  33  34  35 | Следующая страница реферата

@ 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

Рекомендуем скачать другие рефераты по теме: шпоры по философии, экзамен.





Предыдущая страница реферата | 25  26  27  28  29  30  31  32  33  34  35 | Следующая страница реферата