|
|
Используемые технические средства ⇐ ПредыдущаяСтр 5 из 5 Программа "КАРТА" предназначена для установки на персональных ЭВМ IBM PC XT/AT cо следующим набором периферийных устройств: принтер, дисплей с платой адаптера EGA\VGA, накопитель на жестком диске объемом не менее 80 Мб. Минимальный объем свободной оперативной памяти 540 Кб. Вызов и загрузка Для вызова программы следует набрать в командной строке: =>karta или выбрать файл karta.EXE с помощью «оболочки» типа 'NORTON COMMANDER' и нажать клавишу ENTER. Входные данные Входной информацией программы является следующая: Ø данные, вводимые пользователем (см. "Руководство оператора"); Ø данные, хранящиеся в базе данных по пациентам (см. "Руководство системного программиста"); Ø текущая системная дата; Ø данные, хранящиеся в справочных базах данных (см. "Руководство системного программиста"). Выходные данные Выходной информацией программы является следующая: Ø данные, введенные пользователем в базу данных по пациентам (см. "Руководство системного программиста"); Ø документы, сформированные по введенным данным(см. "Руководство оператора"); . Модуль: 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() DELETE flag_del=flag_del+1 stor_ib[flag_del]=NUM_IB ELSE RECALL tr=ASCAN(stor_ib,NUM_IB) ADEL(stor_ib,tr) flag_del=flag_del-1 ENDIF ENDIF CASE c_d=3 IF(!EOF()) SKIP ENDIF CASE c_d=4 EXIT ENDCASE ENDDO IF flag_del>0 y=yesno(10,"Удалить помеченные "+alltrim(str(flag_del))+" записей?") IF y=1 temp="NUM_IB='" del_str=temp+stor_ib[1]+"'" temp=".OR."+temp FOR tr=2 TO flag_del del_str=del_str+temp+stor_ib[tr]+"'" NEXT DELETER(del_str,"DIA66") && Удаление из DIA66.DBF DELETER(del_str,"OP66") && Удаление из OP66.DBF *************************************** pack && Удаление из KARTA66.DBF ELSE RECALL ALL GOTO TOP ENDIF ENDIF SELECT (sel) RETURN
********************************************************************* * Процедура формирования отчетных документов * ********************************************************************* FUNCTION rez PRIVATE _OTCH,_OTCH_N,scr1 _OTCH=00 _OTCH_N="" SAVE SCREEN TO scr1 PRIVATE sel sel=SELECT() PRIVATE _DATE_FROM _DATE_FROM=_today PRIVATE _DATE_TILL _DATE_TILL=_today PRIVATE dep,dep_name PRIVATE numb1 PRIVATE txt PRIVATE pole PRIVATE count count=1 PRIVATE _c _c=1 PRIVATE _p _p=1 PRIVATE OT1,OT2 PRIVATE coun,c1,v1,v2 PRIVATE f f=1 DO WHILE.T. SELECT 0 USE BUFF8.DBF INDEX BUFF8 ALIAS BUFF8 ZAP numb1=0 txt=SPACE(100) pole=1 STORE "" TO OT1,OT2 dep=0 dep_name="" codif1("PERD",@_p) IF _p=0 SELECT BUFF8 USE EXIT ELSEIF _p=2 _OTCH_N=codif1("OTCH",@_OTCH) IF _OTCH=0 SELECT BUFF8 USE EXIT ENDIF ENDIF dep_name=codif1("DEPS",@dep) IF _p=1.AND.dep=0 SELECT BUFF8 USE LOOP ENDIF dep_name=IF(dep=0,"Весь стационар",dep_name) IF period()=0 && Ввод пользователем периода отчета SET CURSOR OFF IF _p=1 ********************* МЕСЯЧНЫЕ ОТЧЕТЫ ********************** _OTCH_N="Месячный отчет" SELECT DIA66 SET RELATION TO SHIFR INTO BUFF8 SELECT karta SET RELATION TO NUM_IB INTO DIA66 GO TOP PRIVATE OT1D1,OT2D1,OT1D2,OT2D2 IF dep=2.OR.dep=11 OT1="OTD5.FRM" OT1D1="OTD2.FRM" OT2D1="OTD51.TXT" ELSE OT1="OTD.FRM" OT1D1="OTD1.FRM" OT2D1="OTD_1.TXT" OT1D2="OTD2.FRM" OT2D2="OTD_2.TXT" ENDIF DO show_st && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ DO WHILE!EOF() IF dep=KARTA->DEPARTMENT.AND.; KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_END<=_DATE_TILL.AND.; KARTA->END1#3.AND.DIA66->KOD1="1" _SHIFR=DIA66->SHIFR SELECT BUFF8 IF EOF() APPEND BLANK REPLACE SHIFR WITH _SHIFR mkb(1,1,@_SHIFR,@txt) REPLACE NAME WITH txt ENDIF REPLACE COUNT1 WITH COUNT1+KARTA->ALL_DAY && ПРОВЕДЕНО ДНЕЙ REPLACE COUNT2 WITH COUNT2+1 && ВСЕГО БОЛЬНЫХ pole=FIELD(8+KARTA->RAION) REPLACE &pole WITH &pole+1 && из Москвы/Моск.обл./Иногородн./Село pole=FIELD(14+KARTA->NUM_COME) REPLACE &pole WITH &pole+1 && Первично/Повторно pole=FIELD(16+KARTA->DIRECT1) REPLACE &pole WITH &pole+1 && Направляющие организации *-------------------------------------------------------------------- IF dep=2.OR.dep=11 IF KARTA->OLD<7 REPLACE C3 WITH C3+1 && Всего до 1 года REPLACE C4 WITH C4+KARTA->ALL_DAY && К/Д IF KARTA->CITY_VILL=2 REPLACE C5 WITH C5+1 && В том числе из села REPLACE C6 WITH C6+KARTA->ALL_DAY && К/Д ENDIF ELSE IF KARTA->CITY_VILL=2 REPLACE C9 WITH C9+1 && Из села старше 1 года ENDIF ENDIF IF KARTA->OLD=1 pole=FIELD(43) ELSEIF KARTA->OLD=2 ad=piece(KARTA->HOUR_B,KARTA->MINS_B,KARTA->HOUR_END,KARTA->MINS_END) ad=KARTA->DATE_END-KARTA->DATE_B+IF(ad=1,1,IF(ad>=0,0,-1)) pole=FIELD(42+IF(ad<=14,2,IF(ad>14.AND.ad<=21,3,4))) ELSE pole=FIELD(44+KARTA->OLD) ENDIF *-------------------------------------------------------------------- ELSE IF KARTA->OLD<7 REPLACE C3 WITH C3+1 && Всего до 1 года REPLACE C4 WITH C4+KARTA->ALL_DAY && К/Д IF KARTA->CITY_VILL=2 REPLACE C5 WITH C5+1 && В том числе из села REPLACE C6 WITH C6+KARTA->ALL_DAY && К/Д ENDIF ELSEIF KARTA->OLD<11 REPLACE C7 WITH C7+1 && Всего до 14 лет REPLACE C8 WITH C8+KARTA->ALL_DAY && К/Д IF KARTA->CITY_VILL=2 REPLACE C9 WITH C9+1 && В том числе из села REPLACE C0 WITH C0+KARTA->ALL_DAY && К/Д ENDIF ELSE REPLACE D1 WITH D1+1 && Всего 15 лет и старше REPLACE D2 WITH D2+KARTA->ALL_DAY && К/Д IF KARTA->CITY_VILL=2 REPLACE D3 WITH D3+1 && В том числе из села REPLACE D4 WITH D4+KARTA->ALL_DAY && К/Д ENDIF ENDIF IF KARTA->OLD<=3 pole=FIELD(43) ELSE pole=FIELD(40+KARTA->OLD) ENDIF ENDIF *-------------------------------------------------------------------- REPLACE &pole WITH &pole+1 && Возраст SELECT KARTA ENDIF SKIP 1 show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ ENDDO SET RELATION TO SELECT DIA66 SET RELATION TO grad() && РАЗБИЕНИЕ БОЛЕЗНЕЙ НА КЛАССЫ SELECT BUFF8 OT2="OTD"+ALLTRIM(STR(dep))+".TXT" @ 13,25 SAY " СОЗДАЕТСЯ ОТЧЕТ: "+OT2+" " IF dep#2.AND.dep#11 REPORT FORM &OT1D2 TO FILE &OT2D2 PLAIN ENDIF REPORT FORM &OT1D1 TO FILE &OT2D1 PLAIN REPORT FORM &OT1 TO FILE &OT2 PLAIN REPORT FORM OTCH.FRM TO FILE OTCH.TXT PLAIN USE corr_ttl("OTCH.TXT",dep_name,DTOC(_DATE_FROM),DTOC(_DATE_TILL)) link2("OTCH.TXT",OT2) RENAME OTCH.TXT TO &OT2 link2(OT2,OT2D1) IF dep#2.AND.dep#11 link2(OT2,OT2D2) ENDIF ELSEIF _p=2 ********************* КВАРТАЛЬНЫЕ ОТЧЕТЫ **********************
OT1="OTCH"+ALLTRIM(STR(_OTCH))+".FRM" OT2="OTCH"+ALLTRIM(STR(_OTCH))+".TXT" IF f_FRM() DO CASE *------------------------------------------------- CASE _OTCH=1 *------------------------------------------------- SELECT DIA66 SET RELATION TO SHIFR INTO BUFF8 SELECT karta SET RELATION TO NUM_IB INTO DIA66 GO TOP DO show_st DO WHILE!EOF() IF IF(dep=0,.T.,IF(dep=KARTA->DEPARTMENT,.T.,.F.)).AND.; KARTA->DATE_END>=_DATE_FROM.AND.KART   Что способствует осуществлению желаний? Стопроцентная, непоколебимая уверенность в своем...  ЧТО И КАК ПИСАЛИ О МОДЕ В ЖУРНАЛАХ НАЧАЛА XX ВЕКА Первый номер журнала «Аполлон» за 1909 г. начинался, по сути, с программного заявления редакции журнала...  Система охраняемых территорий в США Изучение особо охраняемых природных территорий(ООПТ) США представляет особый интерес по многим причинам...  Что вызывает тренды на фондовых и товарных рынках Объяснение теории грузового поезда Первые 17 лет моих рыночных исследований сводились к попыткам вычислить, когда этот... Не нашли то, что искали? Воспользуйтесь поиском гугл на сайте:
|