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

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

""+"."

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 EN60

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_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(tDEPARTMENT.AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_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(k=ALLTRIM(_FAM)

GO TOP

D2=EOF()

menu1=5

SET FILTER TO

ELSEIF menu1=3

SET CURSOR ON

@ 10,45 GET _DATE_IN PICTURE "@D"

READ

SET CURSOR OFF

SET FILTER TO DATE_IN=_DATE_IN

GO TOP

D2=EOF()

IF D2=.F.

menu1=1

@ 16,8 CLEAR TO 20,72

DO WHILE menu1#0.AND.!D2

_NUM_IB=NUM_IB

_FAM=FAM

_DATE_IN=DATE_IN

DO first

@ 11,14 TO 14,40 DOUBLE

@ 12,15 PROMPT "СЛЕДУЮЩАЯ КАРТА "

@ 13,15 PROMPT "ПРЕДЫДУЩАЯ КАРТА "

MENU TO menu1

IF menu1=1

SKIP

D2=EOF()

ELSEIF menu1=2

SKIP -1

D2=BOF()

ENDIF

ENDDO

menu1=1

ENDIF

SET FILTER TO

ELSEIF menu1=5

SKIP

D2=EOF()

ELSEIF menu1=6

SKIP -1

D2=BOF()

ENDIF

@ 16,8 CLEAR TO 20,72

IF D2=.F.

_NUM_IB=NUM_IB

_FAM=FAM

_DATE_IN=DATE_IN

DO first

ELSEIF D2=.T.

@ 17,25 TO 19,55 DOUBLE

@ 18,31 SAY "БОЛЬШЕ ЗАПИСЕЙ НЕТ!"

ENDIF

ENDDO

SET SOFTSEEK OFF

SELECT (sel1)

SET COLOR TO (clr1)

RETURN

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

* ПРОВЕРКА ПРАВИЛЬНОСТИ ЗАПОЛНЕНИЯ КАРТЫ *

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

FUNCTION all_r

PRIVATE _qui

_qui=.F.

IF EMPTY(_FAM)=.T.

message('e',"НЕ ВВЕДЕНА ФАМИЛИЯ ПАЦИЕНТА")

beg_line=1

cur_promp=2

ELSEIF EMPTY(_DATE_B)=.T.

message('e',"НЕ ВВЕДЕНА ДАТА РОЖДЕНИЯ")

beg_line=1

cur_promp=5

ELSEIF EMPTY(_OLD)=.T.

message('e',"НЕ ВВЕДЕН ВОЗРАСТ")

beg_line=1

cur_promp=6

ELSEIF EMPTY(_RAION)=.T.

message('e',"НЕ ВВЕДЕН РАЙОН ПРОЖИВАНИЯ")

beg_line=1

cur_promp=9

ELSEIF EMPTY(_CITY_VILL)=.T.

message('e',"НЕ ВВЕДЕН ПУНКТ ")

beg_line=1

cur_promp=10

ELSEIF EMPTY(_STATE)=.T.

message('e',"НЕ ВВЕДЕНО НАЗВАНИЕ ГОСУДАРСТВА ")

beg_line=1

cur_promp=12

ELSEIF EMPTY(_DEPARTMENT)=.T.

message('e',"НЕ ВВЕДЕНO НАЗВАНИЕ ОТДЕЛЕНИЕ")

beg_line=1

cur_promp=13

ELSEIF EMPTY(_KOIKA)=.T.

message('e',"НЕ ВВЕДЕН ПРОФИЛЬ КОЙКИ")

beg_line=1

cur_promp=14

ELSEIF EMPTY(_DATE_IN)=.T.

message('e',"НЕ ВВЕДЕНА ДАТА ПОСТУПЛЕНИЯ")

beg_line=1

cur_promp=17

ELSEIF EMPTY(_DATE_END)=.T.

message('e',"НЕ ВВЕДЕНА ДАТА ВЫПИСКИ")

beg_line=20

cur_promp=20

ELSEIF _ALL_DAY")

beg_line=1

cur_promp=19

ELSEIF EMPTY(_NUM_COME)=.T.

message('e',"НЕ ВВЕДЕНО КОЛИЧЕСТВО ГОСПИТАЛИЗАЦИЙ")

beg_line=20

cur_promp=22

* ELSEIF EMPTY(_DIA_DIRECT)=.T.

* message('e',"НЕ ВВЕДЕН НАПРАВЛЯЮЩИЙ ДИАГНОЗ")

* beg_line=20

* cur_promp=21

ELSEIF LEN(vars1[1])=0

message('e',"НЕ ВВЕДЕН ОСНОВНОЙ ДИАГНОЗ")

beg_line=20

cur_promp=23

ELSEIF AT("000.0",vars1[1])#0.AND.LEN(vars[1])>80

message('e',"ОШИБОЧНЫЙ ДИАГНОЗ")

beg_line=20

cur_promp=25

ELSEIF AT("000.0",vars1[1])#0.AND.LEN(vars1[2])#0

message('e',"ОШИБОЧНЫЙ ДИАГНОЗ")

beg_line=20

cur_promp=25

ELSE

_qui=.T.

ENDIF

RETURN (_qui)

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

* Представление на экране основной информации из 66 формы *

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

PROCEDURE first

IF !BOF().AND.!EOF()

@ 16,8 CLEAR TO 20,72

@ 17,15 SAY "НОМЕР И/Б :"+NUM_IB

@ 18,15 SAY "ФАМИЛИЯ БОЛЬНОГО :"+ALLTRIM(FAM)

@ 19,15 SAY "ДАТА ПОСТУПЛЕНИЯ :"

@ 19,34 SAY DATE_IN

ENDIF

RETURN

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

* Каталог операций *

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

FUNCTION catalog

PARAMETERS s,t

PRIVATE sel3,screen3,N3

sel3=SELECT()

SAVE SCREEN TO screen3

select 0

use cato.dbf index cato alias cato

SET SOFTSEEK ON

SEEK s

SET SOFTSEEK OFF

IF FOUND()

t=NAME_ILL

ELSE

private NUILL,K

go top

nuill=RECCOUNT()

declare OPERATION[NUILL]

for K=1 to NUILL

operation[k]=NAME_ILL

skip 1

next

release NUILL,K

@ 4,1 CLEAR TO 21,78

@ 4,1 TO 21,78

saycent(4,1,78," КАТАЛОГ ОПЕРАЦИЙ ")

N3=ACHOICE(5,2,20,77,operation,.T.,"",NUMBER-1)

IF LASTKEY()=27

RESTORE SCREEN FROM screen3

use

SELECT (sel3)

RETURN (-1)

ENDIF

GO N3

s=SHIFR

t=NAME_ILL

ENDIF

RESTORE SCREEN FROM screen3

use

SELECT (sel3)

RETURN (0)

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

* Процедура настройки каталогов *

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

PROCEDURE recon

PRIVATE N4,N5,cod_name

STORE 0 TO N4,N5

DO WHILE gotomain=.F.

cod_name=SPACE(4)

codif1("CORR",@N4)

IF LASTKEY()=27

SET CURSOR OFF

RETURN

ELSEIF N4=1

cod_name="RIGS"

ELSEIF N4=2

cod_name="DIRS"

ELSEIF N4=3

cod_name="STTE"

ELSEIF N4=4

cod_name="HOSP"

ELSEIF N4=5

cod_name="BIRS"

ELSEIF N4=6

cod_name="RIZS"

ELSEIF N4=7

cod_name="DEPS"

ELSEIF N4=8

cod_name="KOIK"

ELSEIF N4=9

cod_name="RIZ1"

ELSEIF N4=10

cod_name="RIZ2"

ELSEIF N4=11

cod_name="RIZ3"

ELSEIF N4=12

cod_name="OLDS"

ELSEIF N4=13

cod_name="PLCE"

ENDIF

codifM("CODIF",cod_name,@N5)

ENDDO

RELEASE N4,N5,cod_name

RETURN

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

* Продедура работы с каталогами *

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

FUNCTION codifM

PARAMETERS codfile,code_name,code_var

PRIVATE screen,sel,ret,i,k,svtx,maxlen,color,count,first,x1,x2,y1,y2

PRIVATE prom,prom1

IF !t_qwerty

RETURN 0

ENDIF

SAVE SCREEN TO screen

SET CURSOR OFF

color=SETCOLOR()

sel=SELECT()

SET COLOR TO (color3)

SET EXACT OFF

SELECT &CODFILE

CLEAR TYPEAHEAD

prom= "ESC- отказ,ENTER-переименовать"

prom1="INS-добавить,DEL-удалить"

first=1

DO WHILE .T.

SEEK (code_name)

IF !FOUND()

RETURN ""

ENDIF

svtx=ALLTRIM(TEXT)

maxlen=MAX(LEN(svtx),MAX(LEN(prom),LEN(prom1)))

COUNT WHILE SUBSTR(KEY,1,4)=SUBSTR(code_name+' ',1,4) TO COUNT

count=count-1 && не учитываем заголовок

DECLARE A[count],B[count]

* A[]-массив для текстов шаблонов

* B[]-массив для номеров шаблонов

IF count=0

DECLARE A[1]

a[1]=" Кодификатор пуст,воспользуйтесь клавишей INS"

maxlen=MAX(maxlen,40)

ENDIF

SEEK(code_name)

FOR k=1 TO COUNT

SKIP

A[K]=ALLTRIM(TEXT)

B[K]=SUBSTR(KEY,5)

maxlen=MAX(maxlen,LEN(A[K]))

NEXT

y1=12-ROUND(MIN(count,13)/2 +0.49,0)

x1=37-ROUND(MIN(maxlen,72)/2 +0.49,0)

* рисование рамки и заголовка *

SET COLOR TO (color3)

y2=MIN(y1+count+2,20)

x2=MIN(x1+maxlen+3,77)

RESTORE SCREEN FROM SCREEN

@ y1,x1,y2,x2 BOX singl+fon2

@ y2,x1,y2+3,x2 BOX "+-+¦--L¦"+fon2

saycent(y2+1,x1,x2,prom)

saycent(y2+2,x1,x2,prom1)

saycent(y1,x1,x2,svtx)

I=ACHOICE(y1+1,x1+1,y2-1,x2-1,a,.t.,"u_key1",first)

IF i=0

ret=""

CLEAR TYPEAHEAD

EXIT

ELSE

DO CASE

CASE LASTKEY()=13.AND.COUNT>0 &&

SEEK(code_name)

SKIP I

PRIVATE scr,col1,pict

pict=SPACE(LEN(TEXT))

scr=SAVESCREEN(10,9,12,70)

col1=SETCOLOR()

SET COLOR TO (color7)

@10,9,12,70 box singl+fon2

saycent(10,9,70,"ВВОДИТЕ НОВОЕ ИМЯ")

SET CURSOR ON

@ 11,10 GET pict

READ

PICT=STRTRAN(pict,'Н','H')

SET CURSOR OFF

SETCOLOR(col1)

RESTSCREEN(10,9,12,70,scr)

IF LASTKEY()#27.AND.!EMPTY(PICT) && ESC

REPLACE TEXT WITH pict

ENDIF

RELEASE scr,col1,pict

CASE LASTKEY()=22 &&

IF count>0

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 monsmonth(b_dat)

old1=alltrim(str(year1))

else

if month(today)NUL")

DELETE FILE &_file

RENAME _0000F TO &_file

RETURN 0

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

Модуль: VIEWER.PRG

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

* Функция просмотра текстового файла в заданном окне - fileview.

*

* Для перемещения текста в окне используются

*

* только: *

* Параметры: *

* filename - имя файла, *

* wt,wl,wb,wr - окно просмотра, *

* color - цвет [необязательный параметр],

*

* linewide - длина строки(гориз. скроллинг) [необязательный параметр].

*

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

function fileview

parameters filename,wt,wl,wb,wr,color,linewide

private col_sv

col_sv=setcolor()

if pcount()cnt_pos

cnt_pos=cnt_pos+1

p="pos"+alltrim(str(cnt_pos))

private &p

&p=pos_str

endif

case f_mov=-1

fseek(fh,file_up,0)

file_down=file_down-blok

file_up=file_down-3*blok

&buf=freadstr(fh,blok)

str_vid=&buf

buf=if(buf="buf1","buf2","buf1")

str_vid=str_vid+&buf

count=count-1

p="pos"+alltrim(str(count))

pos_str=&p+wb-wt+1

pos_cur=wb-wt+1

p_vid= rat(last,str_vid)

str_vid=left(str_vid,p_vid-1)

otherwise

endcase

enddo

fclose(fh)

set key 24

set key 18

set key 3

set key 29

set key 30

set key 31

setcolor(col_sv)

RETURN(0)

function mod

parameters mode,line,col

private key

key=lastkey()

do case

case key=13 .and. line=lines .and. file_down-1

f_mov=-1

keyboard chr(23)

return(0)

otherwise

lines=line

endcase

return(0)

procedure cr

keyboard chr(13)

return

procedure bl

keyboard chr(32)

return

-----------------------

[pic]

Страницы: 1, 2, 3, 4, 5