Описание алгоритма программы

Схема алгоритма работы программы представлена на рис. 8.

Для работы с Международным классификатором болезней (МКБ) использовалась функция MKB().

Для работы с каталогом операций использовалась функция CATALOG().

 

Рис. 8 . Схема алгоритма работы программы .

Для работы со справочниками используются следующие функции:

Ø codif() - функция выбора альтернативы из вертикального меню, построенного на основе данных справочника.

Ø mempro(), codpic(), codtxt() - функции для экранного редактирования МЕМО - полей баз данных.

Ø extra() - функция восстановления текста выбранной альтернативы по ее номеру в справочнике.

Ø ins_pic() - функция добавления информации в справочник.

Ø del_pic() - функция удаления инфомации из справочника.

Для представления текста отчетного документа на экране используется функция viewer().

Используемые технические средства

Программа "КАРТА" предназначена для установки на персональных ЭВМ IBM PC XT/AT cо следующим набором периферийных устройств: принтер, дисплей с платой адаптера EGA\VGA, накопитель на жестком диске объемом не менее 80 Мб. Минимальный объем свободной оперативной памяти 540 Кб.

Вызов и загрузка

Для вызова программы следует набрать в командной строке:

=>karta

или выбрать файл karta.EXE с помощью «оболочки» типа 'NORTON COMMANDER' и нажать клавишу ENTER.

Входные данные

Входной информацией программы является следующая:

Ø данные, вводимые пользователем (см. "Руководство оператора");

Ø данные, хранящиеся в базе данных по пациентам (см. "Руководство системного программиста");

Ø текущая системная дата;

Ø данные, хранящиеся в справочных базах данных (см. "Руководство системного программиста").

Выходные данные

Выходной информацией программы является следующая:

Ø данные, введенные пользователем в базу данных по пациентам (см. "Руководство системного программиста");

Ø документы, сформированные по введенным данным(см. "Руководство оператора");

.
Текст программы на языке Clipper Summer'87

Модуль: Karta.prg

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

* Название программы :    "KARTA"                      *

* Дата последних изменений : 23.12.92                     *

* Исходный текст :        Clipper Summer'87            *

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

SET CONSOLE OFF

SET ESCAPE ON

SET MESSAGE TO 23 CENTER

SET BELL OF

SET DATE GERMAN

SET SCOREBOARD OFF

SET CONFIRM ON

SET WRAP ON

SET KEY -9 TO GO_MAIN       && ПО F10 - ВОЗВРАТ В МЕHЮ

SET KEY -29 TO recon

init_lib()    && Функция настройки для работы с библиотекой LIB29

t_qwerty=.T.

CLEAR

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

* глобальные переменные программы

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

PUBLIC edit_index && .T.- редактировать номер ИБ нельзя

              && .F.- можно

  edit_index=.F.

PUBLIC gotomain && принудительный возврат в главную процедуру

              && .T.- прервать внутренний цикл и вернуться в MAIN

  gotomain=.F.

PUBLIC _today && Текущая дата работы        

PUBLIC rec_num && Номер текущей записи

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

f1 = CHR(218) + CHR(196) + CHR(191) + CHR(179) + ;

CHR(217) + CHR(196) + CHR(192) + CHR(179)

f2 = CHR(201) + CHR(205) + CHR(187) + CHR(186) + ;

CHR(188) + CHR(205) + CHR(200) + CHR(186)

f3 = CHR(218) + CHR(196) + CHR(191) + CHR(179) + ;

CHR(180) + CHR(196) + CHR(195) + CHR(179)

f1_fon = CHR(218) + CHR(196) + CHR(191) + CHR(179) + ;

    CHR(217) + CHR(196) + CHR(192) + CHR(179) + ;

    CHR(178)

f2_fon = CHR(201) + CHR(205) + CHR(187) + CHR(186) + ;

    CHR(188) + CHR(205) + CHR(200) + CHR(186) + ;

    CHR(178)

dn_s=CHR(198)+CHR(205)+CHR(181)+CHR(179)+; && стыкуется с рамкой

  CHR(217)+CHR(196)+CHR(192)+CHR(179) && по верхней границе

fon1=CHR(177)

fon2=CHR(32)

 

singl=CHR(218)+CHR(196)+CHR(191)+CHR(179)+;

  CHR(217)+CHR(196)+CHR(192)+CHR(179)

doubl=CHR(201)+CHR(205)+CHR(187)+CHR(186)+;

CHR(188)+CHR(205)+CHR(200)+CHR(186)

 

IF .NOT. ISCOLOR()

   color1="W+/N,N/W,W+/N,W/N,W/N"    && для меню

   color2="W/N,W+/N"                 && для gets

   color3="W+/N,N/W"                 && для кодификаторов

   color4="W/N,N/W"                  && для рамки каталога

   color5="W/N,N/W"                  && для меню при редактировании

   color6="W/N,W+/N"                 && для memed

   color7=color2                        && для шаблонов

   color8="W/N,W+/N,N/W"             && для HYPERTEXT 1-го уровня

   color9="W/N,W+/N,N/W"             && для HYPERTEXT 2-го уровня

ELSE

   color1="W+/B,N/G,BG/N,RB+/B,BG/B"

   color2="BG/B,GR+/B,BG/B,RB+/B,BG/B"

   color3="N/W,W+/GR"

   color4="N/GR,W+/GR"

   color5="G+/B,N/W,BG/B,RB+/B,+GR/B"

   color6="W+/GR,N+/W"

   color7="N/GR,+GR/GR"

   color8="W+/B,G+/B,N/W"

   color9="B/G,W+/G,W+/N"

ENDIF

 

******************** ОБЪЯВЛЕНИЕ ПЕРЕМЕННЫХ **********************

PRIVATE _NUM_IB && Номер истории болезни больного

PRIVATE _FAM    && Фамилия больного

_FAM=SPACE(25)

PRIVATE _F_S_NAME && Имя,Отчество больного

PRIVATE _DATE_B && Дата рождения больного

PRIVATE time_B && Время рождения

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)

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)+" "+;

       "<"+TRIM(txtd)+">"  

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

DO WHILE NUM_IB=_NUM_IB

_SHIFR_ILL=SHIFR        

catalog(@_SHIFR_ILL,@txts)

txts=TRIM(txts)

context(@string8,"",txts,length,.F.)

context(@string8," Дата проведения :  ",DTOC(DATA)+".",length,.F.)

context(@string8," Название операции : ",ALLTRIM(COMM),length,.F.)

vars[26]=string8

SKIP 1      

ENDDO      

RELEASE txts,string8

SELECT BUFF2

COMMIT  

APPEND FROM OP66 FOR NUM_IB=_NUM_IB

ENDIF  

v=replicate(chr(178),30)

@ 13,25 SAY v

******************* ФОРМИРОВАНИЕ ТЕКСТА *************************

string=""                         && Начальный текст

SELECT karta

SEEK _NUM_IB

rez=FOUND()

New_Str=.F.

FOR i=1 TO LEN(promp)

IF (i=23.AND._DIA_DIRECT#" ").OR.i=25.OR.i=26

  New_Str=.T.

ENDIF      

IF rez.AND.!EMPTY(vars[i])

  row[i]=context(@string,promp[i],TRIM(vars[i])+".",length,New_Str)

ELSE

  row[i]=context(@string,promp[i],vars[i],length,New_Str)      

ENDIF  

  New_Str=.F.

IF i=20                       && Промпт "ИСХОД"

  IF _END1=2    && переведен

context(@string,"Причина:",extra1(_END2,"RIZ2")+".",length,.F.)

context(@string,"Куда:",extra1(_END3,"HOSP")+".",length,.F.)

  ELSEIF _END1=3 && умер

context(@string,"Причина:",extra1(_END2,"RIZ3")+".",length,.F.)

  ENDIF

ELSEIF i=22.AND._END1=3

  context(@string,"Возраст на момент смерти :",;

                   extra1(_OLD_D,"OLDS")+".",length,.F.)

ELSEIF i=26

  context(@string,"Обследование на реакцию ВАССЕРМАНА :","",length,.F.)

ENDIF

NEXT

SET CURSOR ON

SELECT (sel)

RETURN

 

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

*             Функция инициализации диагнозов             *

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

FUNCTION initial1

PARAMETERS DBN

PRIVATE sl,rez1

SET CURSOR OFF

sl=SELECT()

SELECT &DBN

SET SOFTSEEK ON

SEEK _NUM_IB

SET SOFTSEEK OFF

rez1=FOUND()

IF !rez1

vars1[1]=""                    && Основной диагноз

vars1[2]=""                    && Осложнения

vars1[3]=""                    && Сопутствующие заболевания

IF _END1=3

vars1[4]=""                 && Основной диагноз

vars1[5]=""                 && Осложнения

vars1[6]=""                 && Сопутствующие заболевания

ENDIF  

_SHIFR=SPACE(4) && SHIFR  

_KOD1=0    && KOD1

_KOD2=0    && KOD2

ELSE

PRIVATE txts,string2,string3,string4,string5,string6,string7

txts=SPACE(100)

STORE "" TO string2,string3,string4,string5,string6,string7

DO WHILE NUM_IB=_NUM_IB

_KOD1=KOD1

_KOD2=KOD2

_SHIFR=SHIFR        

IF _SHIFR="0000"

txts="Здоров"

ELSE 

IF _KOD1="1".OR._KOD1="2".AND._KOD2#"2"    

  mkb(1,1,@_SHIFR,@txts)

ENDIF

ENDIF

txts=SUBSTR(_SHIFR,1,3)+"."+SUBSTR(_SHIFR,4,1)+" "+"<"+TRIM(txts)+">"  

IF _KOD2#"2"

    IF _KOD1="1"

context(@string2,"",txts,length,.F.)

context(@string2,"",ALLTRIM(COMM1),length,.F.)

vars1[1]=string2

    ELSEIF _KOD1="2"

context(@string3,"",txts,length,.F.)

vars1[2]=string3        

    ELSEIF _KOD1="3"

context(@string4,"",ALLTRIM(COMM1),length,.F.)

vars1[3]=string4

    ENDIF         

ELSEIF _KOD2="2".AND._END1=3  

    IF _KOD1="1"

context(@string5,"",txts,length,.F.)

context(@string5,"",ALLTRIM(COMM1),length,.F.)

vars1[4]=string5   

    ELSEIF _KOD1="2"

context(@string6,"",ALLTRIM(COMM1),length,.F.)

vars1[5]=string6               

    ELSEIF _KOD1="3"        

context(@string7,"",ALLTRIM(COMM1),length,.F.)

vars1[6]=string7

    ENDIF

ENDIF  

SKIP 1      

ENDDO      

RELEASE txts,string2,string3,string4,string5,string6,string7

SELECT BUFF

APPEND FROM DIA66 FOR NUM_IB=_NUM_IB

ENDIF  

PRIVATE string11,j

string11=""

New_Str=.T.

context(@string11,SPACE(10)+"Клинический диагноз"," ",length,.T.)

FOR j=1 TO s

IF rez1.AND.!EMPTY(vars1[j])

row1[j]=context(@string11,promp1[j],TRIM(vars1[j])+".",length,New_Str)

ELSE

row1[j]=context(@string11,promp1[j],vars1[j],length,New_Str)

ENDIF  

IF j=3.AND._END1=3

context(@string11," "," ",length,.T.)

context(@string11,SPACE(10)+"Паталого-анатомический диагноз"," ",length,.T.)

ENDIF

NEXT

SET CURSOR ON

SELECT (sl)

RETURN (string11)

 

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

*                  Функция ввода даты                     *

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

FUNCTION d_input

PARAMETERS dat

PRIVATE screen

SAVE SCREEN TO screen

SET CURSOR ON

@ 10,25 CLEAR TO 15,55

@ 10,25 TO 15,55

saycent(10,30,50,"ВВЕДИТЕ В ФОРМАТЕ")

@ 12,36 SAY "дд.мм.гг"

@ 14,36 GET dat PICTURE "@D"

READ

SET CURSOR OFF

RESTORE SCREEN FROM screen

RETURN dat

 

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

*              Функция ввода массы пациента               *

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

FUNCTION m_input

PRIVATE screen

SAVE SCREEN TO screen

SET CURSOR ON

@ 10,25 CLEAR TO 15,55

@ 10,25 TO 15,55

saycent(10,30,50,"ВВЕДИТЕ В ФОРМАТЕ")

@ 12,38 SAY "кг/гр."

@ 14,38 GET _MASSA PICTURE "@P 99/999"

READ

SET CURSOR OFF

RESTORE SCREEN FROM screen

RETURN _MASSA

 

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

*               Функция проверки времени                  *

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

FUNCTION check_T

PARAMETERS timeS

PRIVATE L,hour,mins

L=.F.

hour=SUBSTR(timeS,1,2)

mins=SUBSTR(timeS,4,5)

IF VAL(hour)<24.AND.VAL(mins)<60

L=.T.

ENDIF  

RETURN (L)

 

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

*  Определение количества дней, проведеннх в стационаре   *

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

PROCEDURE ch_day     

PRIVATE string2

string2=""

vars[choice]=vars[choice]+"."

context(@string2,promp[choice],vars[choice],length,New_Str)

stuff1(@string,length,string2,choice,row,len(promp))

choice=21

vars[choice]=DTOC(_DATE_END)

IF _ALL_DAY>=0.AND.EMPTY(_DATE_IN)=.F.

vars[choice]=DTOC(_DATE_END)+SPACE(5)+"Проведено дней в стационаре :"+;

           STR(_ALL_DAY)

 

ENDIF           

RETURN

 

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

*              Процедура работы с диагнозами              *

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

FUNCTION diagn

PRIVATE txtf,sel,w_do

PRIVATE F1,screen,color

PRIVATE str

PRIVATE s

PRIVATE q

PRIVATE string11

q=0

str=""

txtf=SPACE(100)

_SHIFR=SPACE(4)

sel=SELECT()  

F1=0

string11=vars[25]

s=IF(_END1=3,6,3)

IF LEN(promp1)#s

@ 11,18 CLEAR TO 13,62

@ 11,18 TO 13,62

saycent(12,20,60,"ФОРМИРУЕТСЯ МЕНЮ ДИАГНОЗОВ")

DECLARE promp1[s],vars1[s],row1[s],col1[s] && массив промптеров дополн. меню

promp1[1]="Основное заболевание :"

promp1[2]="Осложнения :"

promp1[3]="Сопутствующие заболевания :"

IF s=6

promp1[4]="Основное заболевание :"

promp1[5]="Осложнения :"

promp1[6]="Сопутствующие заболевания :"

ENDIF  

AFILL(vars1,' ')

AFILL(col1,1)

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

string11=initial1("BUFF") && Функция формирования выводимого текста

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

ENDIF  

 

wt1=3

wb1=IF(s=3,12,20)

wl1=2

wr1=77

length=wr1-wl1+1 && Длина строки текста, выводимого на экран

beg_line1=1

PRIVATE New_Str1 && Признак новой строки для Context

New_Str1=.F.   && Без выделения промптеров

 

cur_promp1=1

DO WHILE !gotomain

q=hypertxt(wt1,wl1,wb1,wr1,string11,promp1,row1,col1,;

         @beg_line1,@cur_promp1,color9," ДИАГНОЗ ПАЦИЕНТА ")

cur_promp1=cur_promp1%len(promp1)+1

DO CASE

   CASE q=0

        LOOP

   CASE q=1.OR.q=2.OR.q=4

       w_do=1      

       SAVE SCREEN TO screen

       @ 11,25 CLEAR TO 16,55

       @ 11,25 TO 16,55 DOUBLE

       @ 11,30 PROMPT "ДОБАВИТЬ"

       @ 11,44 PROMPT "УДАЛИТЬ"

       IF EMPTY(vars1[q]).OR.BUFF->KOD1="2".AND.BUFF->KOD2="2"

        vars1[q]=""

          KEYBOARD CHR(13)

ENDIF     

MENU TO w_do

str=vars1[q]

       IF w_do=1

          @ 13,30 SAY "ВВЕДИТЕ КОД" GET _SHIFR PICTURE "@R 999.9"

        READ

          IF LASTKEY()=27

       vars1[q]=str

             RESTORE SCREEN FROM screen     

       LOOP

          ENDIF

           F1=mkb(1,1,@_SHIFR,@txtf)

        IF F1#-1     

           txtf=SUBSTR(_SHIFR,1,3)+"."+SUBSTR(_SHIFR,4,1)+" "+;

                               "<"+TRIM(txtf)+">"+"."

           SELECT BUFF  

           APPEND BLANK

           REPLACE NUM_IB WITH _NUM_IB

           REPLACE SHIFR WITH _SHIFR

           REPLACE KOD2 WITH IF(q=4,"2","1")

       REPLACE KOD1 WITH IF(q=1.OR.q=4,"1","2")

             REPLACE COMM1 WITH MEMPRO(COMM1,10,5,18,75,;

                           " ВВЕДИТЕ НЕОБХОДИМЫЕ ЗАМЕЧАНИЯ","ILLS",'ILLS')

             context(@str,"",txtf+".",length,.F.)

             context(@str,"Замечания :",ALLTRIM(COMM1),length,.T.)

          ENDIF

       ELSEIF w_do=2

          PRIVATE i,j,k,EN,ET,NALL,MALL,NDEL

        NALL=INT(LEN(str)/length)  

        MALL=NALL

        FOR i=1 TO NALL

            ET=ALLTRIM(SUBSTR(str,length*(i-1)+1,length))

            EN=ASC(ET)

            IF EN>57

                   MALL=MALL-1

            ENDIF

        NEXT

        DECLARE _0B[MALL],_0S[MALL]

        k=1

        FOR j=1 TO NALL

              ET=ALLTRIM(SUBSTR(str,length*(j-1)+1,length))

            EN=ASC(ET)

            IF EN<58

               _0B[k]=SUBSTR(str,length*(j-1)+1,length)     

               _0S[k]=LEFT(ALLTRIM(_0B[k]),5)              

               k=k+1

            ELSE

               _0B[k-1]=_0B[k-1]+SUBSTR(str,length*(j-1)+1,length)     

            ENDIF      

        NEXT

        NDEL=ACHOICE(13,35,15,45,_0S)

        SELECT BUFF

        IF q=1.OR.q=4

             SEEK _NUM_IB+IF(q=1,"1","2")+"1"

          ELSEIF q=2

             SEEK _NUM_IB+"1"+"2"

          ENDIF

          SKIP NDEL-1

          DELETE

        PACK

        str=""     

        FOR j=1 TO MALL

            IF j#NDEL

                 str=str+_0B[j]

        ENDIF  

        NEXT

        RELEASE j,NALL,NDEL

        RELEASE _0B,_0S

       ENDIF  

       vars1[q]=str  

       RESTORE SCREEN FROM screen     

       

   CASE q=3.OR.q=5.OR.q=6 

        PRIVATE str356

        STORE "" TO str356

        SELECT BUFF

  private s

  s=_NUM_IB+IF(q=3,"1","2")+IF(q=5,"2","3")

        SEEK s && _NUM_IB+IF(q=3,"1","2")+IF(q=5,"2","3")

        IF !FOUND()

           APPEND BLANK

           REPLACE NUM_IB WITH _NUM_IB

           REPLACE KOD1 WITH IF(q=5,"2","3")

           REPLACE KOD2 WITH IF(q=3,"1","2")        

        ENDIF

        SET CURSOR ON      

        REPLACE COMM1 WITH ;

        MEMPRO(COMM1,10,5,15,75,;

               IF(q=5," ВВЕДИТЕ НАЗВАНИЯ ОСЛОЖНЕНИЙ ",;

         " ВВЕДИТЕ НАЗВАНИЯ СОПУТСТВУЮЩИХ ЗАБОЛЕВАНИЙ "),;    

         "ILLS",'ILLS')

        context(@str356,"",ALLTRIM(COMM1),length,.F.)

        vars1[q]=str356

        RELEASE str356

   ENDCASE

 

 new_str1=.T.           

 string111=""

 context(@string111,promp1[q],vars1[q],length,New_Str1)

 IF q=3.AND._END1=3

context(@string111," "," ",length,.T.)

context(@string111,SPACE(10)+"Паталого-анатомический диагноз"," ",length,.T.)

 ENDIF  

 stuff1(@string11,length,string111,q,row1,len(promp1))

ENDDO

REINDEX

gotomain=.F.

SELECT (sel)

RETURN (string11)      

  

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

*              Процедура работы с операциями              *

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

PROCEDURE op

PRIVATE txto,sel,w_do

PRIVATE F2,screen,color

PRIVATE stro

STORE "" TO stro

txto=SPACE(80)

_SHIFR_ILL="0000"

sel=SELECT()  

SAVE SCREEN TO screen

@ 11,25 CLEAR TO 16,55

@ 11,25 TO 16,55 DOUBLE

@ 11,30 PROMPT "ДОБАВИТЬ"

@ 11,44 PROMPT "УДАЛИТЬ"

IF EMPTY(vars[choice])

KEYBOARD CHR(13)

ENDIF     

MENU TO w_do

stro=vars[choice]

IF w_do=1

@ 13,30 SAY "ВВЕДИТЕ КОД" GET _SHIFR_ILL PICTURE "@R 99.99"

READ

RESTORE SCREEN FROM screen

IF LASTKEY()=27

    RETURN

ENDIF 

F2=catalog(@_SHIFR_ILL,@txto)

IF F2#-1

  SELECT BUFF2  

  APPEND BLANK

  REPLACE NUM_IB WITH _NUM_IB

  REPLACE SHIFR WITH _SHIFR_ILL

  REPLACE DATA WITH d_input(DATA)

  SET CURSOR ON      

  REPLACE COMM WITH ;

   MEMPRO(COMM,10,5,15,75," ВВЕДИТЕ НАЗВАНИЕ ОПЕРАЦИИ ","OPER",'OPER')

  context(@stro,"",ALLTRIM(txto)+".",length,.F.)

  context(@stro," Дата проведения :  ",DTOC(DATA)+".",length,.F.)

  context(@stro," Название операции : ",ALLTRIM(COMM)+".",length,.F.)

ENDIF

ELSEIF w_do=2

PRIVATE i,j,k,EN,ET,NALL,MALL,NDEL

NALL=INT(LEN(stro)/length)  

MALL=NALL

FOR i=1 TO NALL

  ET=ALLTRIM(SUBSTR(stro,length*(i-1)+1,length))

  EN=ASC(ET)

  IF EN<>60

     MALL=MALL-1

  ENDIF

NEXT

DECLARE _0B[MALL],_0S[MALL]

k=1

FOR j=1 TO NALL

  ET=ALLTRIM(SUBSTR(stro,length*(j-1)+1,length))

  EN=ASC(ET)

  IF EN=60

   _0B[k]=SUBSTR(stro,length*(j-1)+1,length)     

   _0S[k]=LEFT(ALLTRIM(_0B[k]),5)              

   k=k+1

  ELSE

   _0B[k-1]=_0B[k-1]+SUBSTR(stro,length*(j-1)+1,length)     

  ENDIF      

NEXT

NDEL=ACHOICE(13,35,15,45,_0S)

IF LASTKEY()=27

    RETURN

ENDIF 

SELECT BUFF2

GO NDEL

DELETE

PACK

stro=""     

FOR j=1 TO MALL

   IF j#NDEL

      stro=stro+_0B[j]

ENDIF  

NEXT

RELEASE j,NALL,NDEL

RELEASE _0B,_0S

ENDIF  

vars[choice]=stro  

SELECT (sel)                

RETURN

 

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

*           ПРОЦЕДУРА ЗАПОЛНЕНИЯ БД karta.dbf             *

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

PROCEDURE new_save

PRIVATE sel,v

sel=SELECT()

SET CURSOR OFF

SELECT karta

@ 11,18 CLEAR TO 13,62 

@ 10,17 TO 14,63

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

SET COLOR TO W/N

v=replicate(chr(32),30)

SET COLOR TO

@ 13,25 SAY v

SEEK _NUM_IB

IF FOUND()=.F.

APPEND BLANK

REPLACE NUM_IB WITH _NUM_IB

rec_num = RECNO()

ENDIF  

REPLACE FAM   WITH ALLTRIM(_FAM)

REPLACE F_S_NAME WITH ALLTRIM(_F_S_NAME)

REPLACE DATE_B WITH _DATE_B

REPLACE HOUR_B WITH _HOUR_B

REPLACE MINS_B WITH _MINS_B

REPLACE POL   WITH _POL

REPLACE OLD   WITH _OLD

REPLACE OLD_D WITH _OLD_D

REPLACE MASSA WITH _MASSA

REPLACE PLACE_LIV WITH _PLACE_LIV

REPLACE RAION WITH _RAION

REPLACE CITY_VILL WITH _CITY_VILL

REPLACE DIRECT1 WITH _DIRECT1

REPLACE DIRECT2 WITH _DIRECT2

REPLACE STATE WITH _STATE

REPLACE PLACE WITH _PLACE

*REPLACE WHY   WITH _WHY

REPLACE DEPARTMENT WITH _DEPARTMENT

REPLACE KOIKA WITH _KOIKA

REPLACE PASS  WITH _PASS

REPLACE TIME  WITH _TIME

REPLACE DATE_IN WITH _DATE_IN

REPLACE HOUR_IN WITH _HOUR_IN

REPLACE MINS_IN WITH _MINS_IN

REPLACE END1  WITH _END1

REPLACE END2  WITH _END2

REPLACE END3  WITH _END3

REPLACE DATE_END WITH _DATE_END

REPLACE HOUR_END WITH _HOUR_END

REPLACE MINS_END WITH _MINS_END

REPLACE ALL_DAY WITH _ALL_DAY

REPLACE SHIFR WITH _DIA_DIRECT

REPLACE NUM_COME WITH _NUM_COME

REPLACE RW_DATE WITH _RW_DATE

REPLACE RW_REZ WITH _RW_REZ

REPLACE FAM_DOCTOR WITH _FAM_DOCTOR

*REINDEX

COMMIT

v=replicate(chr(177),10)

@ 13,25 SAY v

SELECT DIA66

DELETE FOR NUM_IB=_NUM_IB

PACK

*COMMIT

IF _END1=3

APPEND FROM BUFF FOR NUM_IB=_NUM_IB

ELSE

APPEND FROM BUFF FOR NUM_IB=_NUM_IB.AND.KOD2#"2"

ENDIF   

*REINDEX 

COMMIT

SELECT BUFF

ZAP

*COMMIT

*REINDEX

COMMIT

v=replicate(chr(177),20)

@ 13,25 SAY v

SELECT OP66

DELETE FOR NUM_IB=_NUM_IB

PACK

*COMMIT

APPEND FROM BUFF2 FOR NUM_IB=_NUM_IB

v=replicate(chr(177),30)

*REINDEX

COMMIT

@ 13,25 SAY v

SELECT BUFF2

ZAP

*COMMIT

*REINDEX

COMMIT

SELECT (sel)

RETURN

 

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

*                Процедура удаления записей               *

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

PROCEDURE del

PRIVATE flag_del         && число записей,помеченных для удаления

PRIVATE nr,tr,del_str,temp,_01,_02,sel

@ 5,1,22,78 BOX dn_s+fon1

sel=SELECT()

flag_del=0

c_d=2

SELECT KARTA

*RECALL ALL

*GO TOP

nr=RECCOUNT()

DECLARE stor_ib[nr]

DO WHILE !gotomain

DO first

@ 7,5,16,74 BOX singl+fon2

SET COLOR TO "r+*/b"

saycent(5,0,79,if(DELETED(),"Запись помечена на удаление",SPACE(27)))

SET COLOR TO (color1)

@ 10,10 PROMPT IF(!BOF(),"Вернуться к предыдущей записи","******")

@ 12,10 PROMPT IF(DELETED(),"Отменить удаление текущей записи",;

                   "Пометить текущую запись на удаление")

@ 14,10 PROMPT IF(!EOF(),"Перейти к следующей записи","******")

@ 16,35 PROMPT "Выполнить" MESSAGE "Удалить помеченные записи и "+;

                           "вернуться в главное меню"

MENU TO c_d

DO CASE

  CASE c_d=0

       LOOP

  CASE c_d=1

       IF(!BOF())

          SKIP -1

       ENDIF

  CASE c_d=2

       IF(!EOF())

          IF !DELETED