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

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

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

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

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

.

Текст программы на языке 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)+" "+;

""

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

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

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

""+"."

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 EN0

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_ENDEND1#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->OLDALL_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(ad14.AND.adOLD)

ENDIF

*--------------------------------------------------------------------

ELSE

IF KARTA->OLDALL_DAY && К/Д

IF KARTA->CITY_VILL=2

REPLACE C5 WITH C5+1 && В том числе из села

REPLACE C6 WITH C6+KARTA->ALL_DAY && К/Д

ENDIF

ELSEIF KARTA->OLDALL_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->OLDOLD)

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.KARTA->DATE_ENDKOD1="1"

state() && Поиск паталого-анатомического диагноза (если он есть)

_SHIFR=DIA66->SHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

ENDIF

IF KARTA->OLD>10 && СТАРШЕ 14 лет

IF KARTA->END1=1.OR.KARTA->END1=2

REPLACE COUNT1 WITH COUNT1+1 && ВЫПИСАНО

REPLACE A1 WITH A1+KARTA->ALL_DAY && ПРОВЕДЕНО ИМИ ДНЕЙ

ELSE && KARTA->END1=3

REPLACE A2 WITH A2+1 && УМЕРЛО

ENDIF

ELSE && KARTA->OLDEND1=1.OR.KARTA->END1=2

REPLACE COUNT2 WITH COUNT2+1 && ВЫПИСАНО

REPLACE A3 WITH A3+KARTA->ALL_DAY && ПРОВЕДЕНО ИМИ ДНЕЙ

IF KARTA->OLDEND1=3

REPLACE A5 WITH A5+1 && УМЕРЛО

IF KARTA->OLDDEPARTMENT,.T.,.F.)).AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_ENDDATE_IN-KARTA->DATE_B+piece(KARTA->HOUR_B,KARTA->MINS_B,;

KARTA->HOUR_IN,KARTA->MINS_IN))KOD1="1"

state() && Поиск паталого-анатомического диагноза (если он есть)

_SHIFR=DIA66->SHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

ENDIF

IF LEFT(KARTA->MASSA,2)="00".OR.LEFT(KARTA->MASSA,2)=" ".AND.;

VAL(RIGHT(KARTA->MASSA,3))>500

REPLACE A1 WITH A1+1

IF KARTA->END1=3

REPLACE A2 WITH A2+1

IF (KARTA->DATE_END-KARTA->DATE_B+;

piece(KARTA->HOUR_B,KARTA->MINS_B,;

KARTA->HOUR_END,KARTA->MINS_END))END1=3

REPLACE A5 WITH A5+1

IF (KARTA->DATE_END-KARTA->DATE_B+;

piece(KARTA->HOUR_B,KARTA->MINS_B,;

KARTA->HOUR_END,KARTA->MINS_END))DEPARTMENT,.T.,.F.)).AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_ENDSHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR_ILL

catalog(@_SHIFR_ILL,@txt)

REPLACE NAME WITH ALLTRIM(txt)

ENDIF

REPLACE COUNT1 WITH COUNT1+1

IF KARTA->OLDEND1=3

REPLACE A1 WITH A1+1

ENDIF

SELECT OP66

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

SET RELATION TO

summ() && Суммирование по классам операций

*-------------------------------------------------

CASE _OTCH=4

*-------------------------------------------------

SELECT BUFF8

APPEND BLANK

REPLACE NUMBER WITH "1"

REPLACE NAME WITH "ВЫПИСАНО"

APPEND BLANK

REPLACE NUMBER WITH "2"

REPLACE NAME WITH "ПЕРЕВЕДЕНО"

APPEND BLANK

REPLACE NUMBER WITH "3"

REPLACE NAME WITH "УМЕРЛО"

SELECT KARTA

GO TOP

PRIVATE OT1D1,OT2D1

DO show_st && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

DO WHILE !EOF()

IF IF(dep=0,.T.,IF(dep=KARTA->DEPARTMENT,.T.,.F.)).AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_ENDEND1

pole=FIELD(8+KARTA->OLD)

REPLACE &pole WITH &pole+1 && ВОЗРАСТ БОЛЬНЫХ

pole=FIELD(19+KARTA->RAION)

REPLACE &pole WITH &pole+1 && РАЙОН ПРОЖИВАНИЯ

REPLACE COUNT1 WITH COUNT1+KARTA->ALL_DAY && ПРОВЕДЕНО ДНЕЙ

REPLACE COUNT2 WITH COUNT2+1 && ВСЕГО БОЛЬНЫХ

SELECT KARTA

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

OT1D1="OTCH"+ALLTRIM(STR(_OTCH))+"1"+".FRM" && OTCH*1.FRM

OT2D1="OTCH"+ALLTRIM(STR(_OTCH))+"1"+".TXT" && OTCH*1.TXT

SELECT BUFF8

REPORT FORM &OT1D1 TO FILE &OT2D1 PLAIN

*-------------------------------------------------

CASE _OTCH=6.OR._OTCH=8

*-------------------------------------------------

SELECT DIA66

SET RELATION to NUM_IB into KARTA, TO SHIFR INTO BUFF8

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.KARTA->DATE_ENDKOD1="1"

count=state() && Поиск паталого-анатомического диагноза (если он есть)

_SHIFR=DIA66->SHIFR

SELECT BUFF8

IF _OTCH=6.AND.KARTA->END1=2

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

ENDIF

REPLACE COUNT1 WITH COUNT1+1

ELSEIF _OTCH=8.AND.KARTA->END1=3

pole=FIELD(8+KARTA->POL)

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

mkb(1,1,@_SHIFR,@txt)

REPLACE NAME WITH txt

ENDIF

REPLACE &pole WITH &pole+1

ENDIF

SELECT DIA66

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

SET RELATION TO

grad() && РАЗБИЕНИЕ БОЛЕЗНЕЙ НА КЛАССЫ

*------------------------------------------------

CASE _OTCH=7

*------------------------------------------------

SELECT KARTA

SET RELATION TO SHIFR INTO BUFF8

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.KARTA->DATE_ENDSHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

mkb(1,1,@_SHIFR,@txt)

REPLACE NAME WITH ALLTRIM(txt)

ENDIF

REPLACE A3 WITH A3+1 && Всего

IF KARTA->OLDOLDWHY)

REPLACE &pole WITH &pole+1 && Причины направления

pole=FIELD(15+KARTA->DIRECT1)

REPLACE &pole WITH &pole+1 && Направляющие организации

SELECT KARTA

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

SET RELATION TO

numb_STR() && НУМЕРАЦИЯ СТРОК

*------------------------------------------------

CASE (_OTCH=9.AND.dep#14).OR._OTCH=10.OR._OTCH=12

*------------------------------------------------

SELECT DIA66

SET RELATION to NUM_IB into KARTA, TO SHIFR INTO BUFF8

GO TOP

PRIVATE OT1D1,OT2D1,OT1D2,OT2D2

DO show_st && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

DO WHILE !EOF()

IF IF(dep=0,.T.,IF(dep=KARTA->DEPARTMENT,.T.,.F.)).AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_ENDEND1=3.AND.DIA66->KOD1="1"

IF (_OTCH=9.OR.;

_OTCH=10.AND.;

(KARTA->DATE_END-KARTA->DATE_B+;

piece(KARTA->HOUR_B,KARTA->MINS_B,KARTA->HOUR_END,KARTA->MINS_END)DATE_END-KARTA->DATE_IN+;

piece(KARTA->HOUR_IN,KARTA->MINS_IN,KARTA->HOUR_END,KARTA->MINS_END)SHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

mkb(1,1,@_SHIFR,@txt)

REPLACE NAME WITH txt

ENDIF

pole=FIELD(6+KARTA->POL)

REPLACE &pole WITH &pole+1 && ПОЛ УМЕРШИХ

IF _OTCH=9.OR._OTCH=12

REPLACE B2 WITH B2+KARTA->ALL_DAY && КОЛ-ВО ДНЕЙ, ПРОВЕДЕННОЕ ИМИ

IF _OTCH=9.AND.KARTA->OLD_DALL_DAY && ---"--- БОЛЬНЫМИ ДО 1 года

ENDIF

pole=FIELD(8+KARTA->OLD_D)

ELSEIF _OTCH=10

PRIVATE ad

ad=piece(KARTA->HOUR_B,KARTA->MINS_B,KARTA->HOUR_END,KARTA->MINS_END)

pole=FIELD(9+(KARTA->DATE_END-KARTA->DATE_B+;

IF(ad=1,1,IF(ad>=0,0,-1))))

ENDIF

REPLACE &pole WITH &pole+1 && ВОЗРАСТ УМЕРШИХ

pole=FIELD(21+KARTA->DIRECT1)

REPLACE &pole WITH &pole+1 && НАПРАВЛЯЮЩЕЕ УЧРЕЖДЕНИЕ

pole=FIELD(35+KARTA->RAION)

REPLACE &pole WITH &pole+1 && РАЙОН

IF _OTCH=9

IF KARTA->ALL_DAY=1

pole=FIELD(44+IF(KARTA->DATE_END-KARTA->DATE_IN+;

piece(KARTA->HOUR_IN,KARTA->MINS_IN,;

KARTA->HOUR_END,KARTA->MINS_END)ALL_DAYALL_DAY,4))

ENDIF

ELSEIF _OTCH=10

IF KARTA->ALL_DAY=1

pole=FIELD(44+IF(KARTA->DATE_END-KARTA->DATE_IN+;

piece(KARTA->HOUR_IN,KARTA->MINS_IN,;

KARTA->HOUR_END,KARTA->MINS_END)ALL_DAY)

ENDIF

ELSE &&_OTCH=12

PRIVATE t,d

STORE 0 TO t,d

t=KARTA->DATE_END-KARTA->DATE_IN+;

piece(KARTA->HOUR_IN,KARTA->MINS_IN,KARTA->HOUR_END,KARTA->MINS_END)

d=IF(tDATE_ENDEND1=3.AND.DIA66->KOD1="1"

count=state() && Поиск паталого-анатомического диагноза (если он есть)

_SHIFR=DIA66->SHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

mkb(1,1,@_SHIFR,@txt)

REPLACE NAME WITH txt

ENDIF

pole=FIELD(6+KARTA->POL)

REPLACE &pole WITH &pole+1 && Пол

pole=FIELD(16+KARTA->DIRECT1)

REPLACE &pole WITH &pole+1 && Направляющие организации

REPLACE C3 WITH C3+1 && Всего умерло

REPLACE C4 WITH C4+KARTA->ALL_DAY && К/Д

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(ad14.AND.adOLD)

ENDIF

REPLACE &pole WITH &pole+1 && Возраст

SELECT KARTA

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

SET RELATION TO

SELECT DIA66

SET RELATION TO

grad() && РАЗБИЕНИЕ БОЛЕЗНЕЙ НА КЛАССЫ

*------------------------------------------------

CASE _OTCH=11

*------------------------------------------------

codif1("FULL",@f)

IF f=0

LOOP

ENDIF

SELECT DIA66

SET CURSOR OFF

SET RELATION to SHIFR into BUFF8

SELECT OP66

SET RELATION to NUM_IB into KARTA, 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.KARTA->DATE_ENDEND1=3.AND.DIA66->KOD1="1"

state() && Поиск паталого-анатомического диагноза (если он есть)

_SHIFR=DIA66->SHIFR

_NUM_IB=OP66->NUM_IB

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

mkb(1,1,@_SHIFR,@txt)

REPLACE NAME WITH txt

ENDIF

REPLACE COUNT1 WITH COUNT1+1 && ВСЕГО ОПЕРИРОВАННЫХ БОЛЬНЫХ

SELECT 0

USE CATO.DBF INDEX CATO ALIAS CATO

DO WHILE .T.

SEEK OP66->SHIFR

SELECT BUFF8

pole=FIELD(8+CATO->NUMBER)

REPLACE &pole WITH &pole+1

REPLACE COUNT2 WITH COUNT2+1 && ВСЕГО ОПЕРАЦИЙ

SKIP 1 ALIAS OP66

SELECT CATO

IF OP66->NUM_IB#_NUM_IB

SKIP -1 ALIAS OP66

EXIT

ENDIF

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

USE

ENDIF

SELECT OP66

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

SET RELATION TO

SELECT DIA66

SET RELATION TO

grad() && РАЗБИЕНИЕ БОЛЕЗНЕЙ НА КЛАССЫ

IF f=1

OT1="OTCH"+ALLTRIM(STR(_OTCH))+"L"+".FRM"

ELSE

OT1D1="OTCH"+ALLTRIM(STR(_OTCH))+"1"+".FRM" && OTCH*1.FRM

OT2D1="OTCH"+ALLTRIM(STR(_OTCH))+"1"+".TXT" && OTCH*1.TXT

SELECT BUFF8

REPORT FORM &OT1D1 TO FILE &OT2D1 PLAIN

OT1D2="OTCH"+ALLTRIM(STR(_OTCH))+"2"+".FRM" && OTCH*2.FRM

OT2D2="OTCH"+ALLTRIM(STR(_OTCH))+"2"+".TXT" && OTCH*2.TXT

REPORT FORM &OT1D2 TO FILE &OT2D2 PLAIN

link2(OT2D1,OT2D2) && СЛИЯНИЕ ДВУХ ФАЙЛОВ

ENDIF

*------------------------------------------------

CASE _OTCH=13

*------------------------------------------------

SELECT DIA66

SET RELATION to NUM_IB into KARTA, TO SHIFR INTO BUFF8

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.KARTA->DATE_ENDSHIFR>"0000".AND.DIA66->SHIFRKOD1="1"

count=state() && Поиск паталого-анатомического диагноза (если он есть)

_SHIFR=DIA66->SHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

ENDIF

IF KARTA->END1=1.OR.KARTA->END1=2

REPLACE COUNT1 WITH COUNT1+1 && ОБЩЕЕ КОЛИЧЕСТВО ВЫБЫВШИХ

REPLACE A1 WITH A1+KARTA->ALL_DAY && ПРОВЕДЕНО ИМИ ДНЕЙ

IF KARTA->OLDEND1=3

REPLACE A2 WITH A2+1 && ОБЩЕЕ КОЛИЧЕСТВО УМЕРШИХ

REPLACE A3 WITH A3+KARTA->ALL_DAY && ПРОВЕДЕНО ИМИ ДНЕЙ

IF KARTA->OLDDEPARTMENT,.T.,.F.)).AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_ENDSHIFR>"0000".AND.DIA66->SHIFRKOD1="1"

count=state() && Поиск паталого-анатомического диагноза (если он есть)

_SHIFR=DIA66->SHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

mkb(1,1,@_SHIFR,@txt)

REPLACE NAME WITH txt

REPLACE SHIFR WITH _SHIFR

ENDIF

pole=FIELD(8+KARTA->DEPARTMENT)

REPLACE &pole WITH &pole+1

SELECT DIA66

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

SET RELATION TO

numb_STR() && НУМЕРАЦИЯ СТРОК

*-----------------------------------------------

CASE _OTCH=15

*-----------------------------------------------

SELECT KARTA

GO TOP

PRIVATE _NAME,_NUMBER

PRIVATE OT1D1,OT2D1

DO show_st && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

DO WHILE !EOF()

IF IF(dep=0,.T.,IF(dep=KARTA->DEPARTMENT,.T.,.F.)).AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_ENDRAION>1

SELECT BUFF8

IF KARTA->STATE=1

_NUMBER=""

IF KARTA->PLACE=0

_SHIFR="99 "

_NAME="Прочие области и районы РФ"

ELSE

_SHIFR=RIGHT(ALLTRIM(extra1(KARTA->PLACE,"PLCE")),4)

_NAME=extra1(KARTA->PLACE,"PLCE")

ENDIF

IF KARTA->RAION=2

_NUMBER="*"

_SHIFR="1000"

_NAME="Московская область"

ENDIF

ELSE

_NUMBER="*"

_SHIFR=SPACE(2)+STR(KARTA->STATE,2)

_NAME=extra1(KARTA->STATE,"STTE")

ENDIF

SEEK _SHIFR

IF !FOUND()

APPEND BLANK

REPLACE NUMBER WITH _NUMBER,SHIFR WITH _SHIFR,NAME WITH _NAME

ENDIF

pole=FIELD(8+KARTA->DIRECT1)

REPLACE &pole WITH &pole+1 && НАПРАВЛЯЮЩЕЕ УЧРЕЖДЕНИЕ

pole=FIELD(23+KARTA->DEPARTMENT)

REPLACE &pole WITH &pole+1 && ОТДЕЛЕНИЯ БОЛЬНИЦЫ

pole=FIELD(38+KARTA->PASS)

REPLACE &pole WITH &pole+1 && Планово/экстренно

REPLACE COUNT1 WITH COUNT1+KARTA->ALL_DAY && Проведено дней

REPLACE COUNT2 WITH COUNT2+1 && ВСЕГО ВЫПИСАНО

SELECT KARTA

ENDIF

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

SELECT BUFF8

SUM COUNT1,COUNT2,A1,A2,A3,A4,A5,A6,A7,A8,A9,A0,;

B1,B2,B3,B4,B5,B6,B7,B8,B9,B0,C1,C2,C3,C4,C5,C6,C7,C8,C9,C0 TO;

_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14,_15,_16,_17,_18,_19,;

_20,_21,_22,_23,_24,_25,_26,_27,_28,_29,_30,_31,_32

&& Суммирование по всем столбцам

APPEND BLANK

REPLACE SHIFR WITH " ",NAME WITH "Всего",COUNT1 WITH _1,;

COUNT2 WITH _2,A1 WITH _3,A2 WITH _4,A3 WITH _5,A4 WITH _6,;

A5 WITH _7,A6 WITH _8,A7 WITH _9,A8 WITH _10,A9 WITH _11,A0 WITH _12,;

B1 WITH _13,B2 WITH _14,B3 WITH _15,B4 WITH _16,B5 WITH _17,;

B6 WITH _18,B7 WITH _19,B8 WITH _20,B9 WITH _21,B0 WITH _22,;

C1 WITH _23,C2 WITH _24,C3 WITH _25,C4 WITH _26,C5 WITH _27,;

C6 WITH _28,C7 WITH _29,C8 WITH _30,C9 WITH _31,C0 WITH _32

SUM COUNT1,COUNT2,A1,A2,A3,A4,A5,A6,A7,A8,A9,A0,;

B1,B2,B3,B4,B5,B6,B7,B8,B9,B0,C1,C2,C3,C4,C5,C6,C7,C8,C9,C0 TO;

_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14,_15,_16,_17,_18,_19,;

_20,_21,_22,_23,_24,_25,_26,_27,_28,_29,_30,_31,_32;

FOR SHIFR>" ".AND.SHIFR"1000"

&& Суммирование столбцов по всем областям РФ

APPEND BLANK

REPLACE SHIFR WITH "9990",NAME WITH "Всего по РФ",COUNT1 WITH _1,;

COUNT2 WITH _2,A1 WITH _3,A2 WITH _4,A3 WITH _5,A4 WITH _6,;

A5 WITH _7,A6 WITH _8,A7 WITH _9,A8 WITH _10,A9 WITH _11,A0 WITH _12,;

B1 WITH _13,B2 WITH _14,B3 WITH _15,B4 WITH _16,B5 WITH _17,;

B6 WITH _18,B7 WITH _19,B8 WITH _20,B9 WITH _21,B0 WITH _22,;

C1 WITH _23,C2 WITH _24,C3 WITH _25,C4 WITH _26,C5 WITH _27,;

C6 WITH _28,C7 WITH _29,C8 WITH _30,C9 WITH _31,C0 WITH _32

OT1D1="OTCH"+ALLTRIM(STR(_OTCH))+"1"+".FRM" && OTCH*1.FRM

OT2D1="OTCH"+ALLTRIM(STR(_OTCH))+"1"+".TXT" && OTCH*1.TXT

REPORT FORM &OT1D1 TO FILE &OT2D1 PLAIN

*------------------------------------------------

CASE _OTCH=16.OR._OTCH=17.OR._OTCH=18.OR._OTCH=19

*------------------------------------------------

SELECT BUFF8

APPEND BLANK

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.KARTA->DATE_ENDEND1=2

REPLACE A1 WITH A1+1 && ВСЕГО

IF KARTA->OLDSHIFR="0000" && ОКАЗАВШИЕСЯ ЗДОРОВЫМИ

REPLACE A3 WITH A3+1

ENDIF

ELSEIF _OTCH=17.AND.KARTA->END1=3

IF KARTA->OLD=1

REPLACE A1 WITH A1+1 && УМЕРЛО В ВОЗРАСТЕ 0-6 СУТОК

ENDIF

IF (KARTA->DATE_END-KARTA->DATE_IN+;

piece(KARTA->HOUR_IN,KARTA->MINS_IN,KARTA->HOUR_END,KARTA->MINS_END)DATE_END-KARTA->DATE_B+;

piece(KARTA->HOUR_B,KARTA->MINS_B,KARTA->HOUR_END,KARTA->MINS_END)OLDNUM_IB=KARTA->NUM_IB

IF DIA66->KOD1="1".AND.;

(DIA66->SHIFR>="4800".AND.DIA66->SHIFRSHIFR="410 ".OR.KARTA->SHIFR="412 ")

IF KARTA->TIMEEND1=3.AND.(KARTA->DATE_END-KARTA->DATE_IN+;

piece(KARTA->HOUR_IN,KARTA->MINS_IN,KARTA->HOUR_END,KARTA->MINS_END)SHIFR>="6300".AND.KARTA->SHIFREND1=3

REPLACE A1 WITH A1+1 && ВСЕГО УМЕРЛО БЕРЕМЕННЫХ,РОЖЕНИЦ И РОДИЛЬНИЦ

SELECT DIA66

state() && Поиск паталого-анатомического диагноза (если он есть)

DO WHILE DIA66->NUM_IB=KARTA->NUM_IB

IF DIA66->KOD1="1".AND.;

(DIA66->SHIFR>="6300".AND.DIA66->SHIFRSHIFR_LEFT

SEEK seek

IF !EOF()

IF BUFF8->SHIFR SHIFR_RIGH

numb1=numb1+1

rec=RECNO()

IF _OTCH=1

_SHIFR=SHIFR

_COUNT1=COUNT1

_COUNT2=COUNT2

_A1=A1

_A2=A2

_A3=A3

_A4=A4

_A5=A5

_A6=A6

APPEND BLANK

REPLACE SHIFR WITH _SHIFR,COUNT1 WITH _COUNT1,COUNT2 WITH _COUNT2,;

A1 WITH _A1,A2 WITH _A2,A3 WITH _A3,A4 WITH _A4,;

A5 WITH _A5,A6 WITH _A6

SUM COUNT1,COUNT2,A1,A2,A3,A4,A5,A6 TO ;

_COUNT1,_COUNT2,_A1,_A2,_A3,_A4,_A5,_A6 ;

WHILE BUFF8->SHIFR SHIFR_RIGH

GOTO rec

REPLACE COUNT1 WITH _COUNT1,COUNT2 WITH _COUNT2,A1 WITH _A1,;

A2 WITH _A2,A3 WITH _A3,A4 WITH _A4,A5 WITH _A5,A6 WITH _A6

ENDIF

REPLACE BUFF8->NUMBER WITH STR(numb1,2)

REPLACE BUFF8->NAMECL WITH CLASS->NAME_CLASS

REPLACE BUFF8->SHIFRL WITH CLASS->SHIFR_LEFT

REPLACE BUFF8->SHIFRR WITH CLASS->SHIFR_RIGH

IF _OTCH=6

SUM COUNT1 TO _COUNTALL WHILE BUFF8->SHIFR SHIFR_RIGH

GO rec

REPLACE BUFF8->COUNT2 WITH _COUNTALL

ENDIF

ENDIF

SKIP 1 ALIAS CLASS

ELSE

EXIT

ENDIF

NEXT

SET SOFTSEEK OFF

SELECT CLASS

USE

SELECT (lsl)

RETURN 0

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

* Функция разбиения на группы ( для отчета N1,(N2 и N5) ) *

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

FUNCTION grad1

lsl=SELECT()

SELECT 0

IF _OTCH=1

USE GRUP1.DBF INDEX GRUP1 ALIAS GRUP

ELSE && для _OTCH=2 и _OTCH=5

USE GRUP2.DBF INDEX GRUP2 ALIAS GRUP

ENDIF

PRIVATE coun1,K,seek

coun1=RECCOUNT()

seek=" "

GO TOP

SELECT BUFF8

SET SOFTSEEK ON

FOR K=1 TO coun1

seek=GRUP->SHIFR_LEFT

SEEK seek

IF !EOF()

IF BUFF8->SHIFR SHIFR_RIGH

IF !EMPTY(BUFF8->NUMBER)

SKIP 1 ALIAS BUFF8

ENDIF

rec=RECNO()

SUM COUNT1,COUNT2,A1,A2,A3,A4,A5,A6 TO ;

_COUNT1,_COUNT2,_A1,_A2,_A3,_A4,_A5,_A6 ;

WHILE BUFF8->SHIFR SHIFR_RIGH

GOTO rec

REPLACE COUNT1 WITH _COUNT1,COUNT2 WITH _COUNT2,A1 WITH _A1,;

A2 WITH _A2,A3 WITH _A3,A4 WITH _A4,A5 WITH _A5,A6 WITH _A6

REPLACE BUFF8->NUMBER WITH "-"

REPLACE BUFF8->NAMECL WITH GRUP->NAME_GRUP

REPLACE BUFF8->SHIFRL WITH GRUP->SHIFR_LEFT

REPLACE BUFF8->SHIFRR WITH GRUP->SHIFR_RIGH

ENDIF

SKIP 1 ALIAS GRUP

ELSE

EXIT

ENDIF

NEXT

SET SOFTSEEK OFF

SELECT GRUP

USE

SELECT (lsl)

RETURN 0

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

* Функция слияния двух текстовых файлов *

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

FUNCTION link2

PARAMETERS F1,F2

RUN ("COPY &F1+&F2 &F1>NUL")

DELETE FILE &F2

RETURN 0

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

* Представление на экране обработки записей БД ( начало ) *

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

PROCEDURE SHOW_ST

@ 4,7 CLEAR TO 15,72

saycent(5,5,75," *** "+_OTCH_N+" *** ")

saycent(6,5,75,"по "+IF(dep=0,"всему стационару ","отделению "+dep_name))

saycent(7,5,75,"за период с "+DTOC(_DATE_FROM)+" по "+DTOC(_DATE_TILL))

STORE 0 TO c1,v1,v2

coun=RECCOUNT()

v1=replicate(chr(178),60)

PRIVATE clr11

clr11=SETCOLOR()

SET COLOR TO (color1)

@ 8,8 CLEAR TO 15,71

@ 8,8 TO 15,71 DOUBLE

saycent(15,5,75," ESC - прервать обработку ")

@ 12,9 TO 14,70

@ 13,10 say v1

@ 9,10 TO 11,37

@ 10,11 SAY "ОБРАБОТАНО:"

@ 10,24 SAY 0

@ 9,41 TO 11,70

@ 10,42 SAY "ВСЕГО ЗАПИСЕЙ:"

@ 10,61 SAY coun

SET COLOR TO (clr11)

RETURN

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

* Представление на экране обработки записей БД ( динамика ) *

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

PROCEDURE SHOW_DIN

PARAMETERS counts

c1=c1+counts

v2=replicate(chr(219),int(60*(c1/coun)))

@ 13,10 SAY v2

@ 10,24 SAY c1

count=1

RETURN

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

* Суммирование колонок по классам операций для отчета N3 *

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

FUNCTION summ

PRIVATE k,s,s1,n,A,B,C

SELECT BUFF8

SET SOFTSEEK ON

GO TOP

FOR k=2 TO 16

s=IF(k0

ins_pic(code_name,b[count])

ELSE

ins_pic(code_name,' ')

ENDIF

first=count+1

CASE LASTKEY()=7 &&

IF count>0

del_pic(code_name,i)

ENDIF

first=i-1

ENDCASE

ENDIF

ENDDO

*CLEAR TYPEAHEAD

REINDEX

RESTORE SCREEN FROM screen

SET COLOR TO (color)

SELECT(sel)

SET CURSOR OFF

RETURN ret

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

* Проверка наличия в текущей директории файла отчета *

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

FUNCTION f_FRM

PRIVATE log,screen

log=.T.

IF !FILE(OT1)

log=.F.

SAVE SCREEN TO screen

@ 8,8 CLEAR TO 15,71

@ 8,8 TO 15,71 DOUBLE

saycent(8,20,60,"ВНИМАНИЕ")

@ 11,15 SAY "ДЛЯ СОЗДАНИЯ ОТЧЕТА НЕОБХОДИМ ФАЙЛ :"+OT1

@ 12,15 SAY "УКАЗАННОГО ФАЙЛА НЕТ В РАБОЧЕЙ ДИРЕКТОРИИ"

INKEY(10)

RESTORE SCREEN FROM screen

ENDIF

RETURN (log)

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

* Функция ввода отчетного периода *

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

FUNCTION period

PRIVATE screen,M1,R1

R1=0

M1=1

SAVE SCREEN TO screen

SET CURSOR ON

@ 8,8 CLEAR TO 15,71

@ 8,8 TO 15,71 DOUBLE

DO WHILE .T.

saycent(8,20,60,"ВВЕДИТЕ ОТЧЕТНЫЙ ПЕРИОД")

@ 9,17 TO 11,34

@ 10,20 SAY "c " GET _DATE_FROM PICTURE "@D"

@ 9,47 TO 11,64

@ 10,50 SAY "по " GET _DATE_TILL PICTURE "@D"

@ 12,17 TO 14,64

@ 13,21 PROMPT " Ok "

@ 13,38 PROMPT " ПОВТОР "

@ 13,53 PROMPT " ОТКАЗ "

READ

MENU TO M1

IF M1=1

EXIT

ELSEIF M1=2

M1=1

ELSEIF M1=0.OR.M1=3

R1=1

EXIT

ENDIF

ENDDO

SET CURSOR OFF

RESTORE SCREEN FROM screen

RETURN (R1)

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

* Вывод отчетного документа на печать *

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

FUNCTION do_PRN

PRIVATE YN

YN=1

codif1("PRNT",@YN)

IF YN=2

SET CURSOR OFF

TYPE &OT2 TO PRINT

ENDIF

RETURN 0

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

* Функция определения возраста пациента *

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

FUNCTION y_m_day

PARAMETERS day_bir,hour_bir,mins_bir,day_bas,hour_bas,mins_bas

PRIVATE years,mons,days,screen,txt

SAVE SCREEN TO screen

txt=""

years="00"

@ 1,20 CLEAR TO 3,60

@ 1,20 TO 3,60

@ 2,22 SAY IF(choice=8," Возраст пациента :","Возраст на момент смерти:")

years=oldM(day_bir,day_bas)

IF VAL(years)>0

txt=years

IF VAL(years)=1

txt=txt+" год"

ELSEIF VAL(years)0

txt=ALLTRIM(STR(mons))

IF mons=1

txt=txt+" месяц"

ELSEIF mons