SELECT BUFF
APPEND BLANK
REPLACE NUM_IB WITH _NUM_IB
REPLACE SHIFR WITH _SHIFR
REPLACE KOD2 WITH IF(q=4,"2","1")
REPLACE KOD1 WITH IF(q=1.OR.q=4,"1","2")
REPLACE COMM1 WITH MEMPRO(COMM1,10,5,18,75,;
" ВВЕДИТЕ НЕОБХОДИМЫЕ ЗАМЕЧАНИЯ","ILLS",'ILLS')
context(@str,"",txtf+".",length,.F.)
context(@str,"Замечания :",ALLTRIM(COMM1),length,.T.)
ENDIF
ELSEIF w_do=2
PRIVATE i,j,k,EN,ET,NALL,MALL,NDEL
NALL=INT(LEN(str)/length)
MALL=NALL
FOR i=1 TO NALL
ET=ALLTRIM(SUBSTR(str,length*(i-1)+1,length))
EN=ASC(ET)
IF EN>57
MALL=MALL-1
ENDIF
NEXT
DECLARE _0B[MALL],_0S[MALL]
k=1
FOR j=1 TO NALL
ET=ALLTRIM(SUBSTR(str,length*(j-1)+1,length))
EN=ASC(ET)
IF EN<58
_0B[k]=SUBSTR(str,length*(j-1)+1,length)
_0S[k]=LEFT(ALLTRIM(_0B[k]),5)
k=k+1
ELSE
_0B[k-1]=_0B[k-1]+SUBSTR(str,length*(j-1)+1,length)
ENDIF
NEXT
NDEL=ACHOICE(13,35,15,45,_0S)
SELECT BUFF
IF q=1.OR.q=4
SEEK _NUM_IB+IF(q=1,"1","2")+"1"
ELSEIF q=2
SEEK _NUM_IB+"1"+"2"
ENDIF
SKIP NDEL-1
DELETE
PACK
str=""
FOR j=1 TO MALL
IF j#NDEL
str=str+_0B[j]
ENDIF
NEXT
RELEASE j,NALL,NDEL
RELEASE _0B,_0S
ENDIF
vars1[q]=str
RESTORE SCREEN FROM screen
CASE q=3.OR.q=5.OR.q=6
PRIVATE str356
STORE "" TO str356
SELECT BUFF
private s
s=_NUM_IB+IF(q=3,"1","2")+IF(q=5,"2","3")
SEEK s && _NUM_IB+IF(q=3,"1","2")+IF(q=5,"2","3")
IF !FOUND()
APPEND BLANK
REPLACE NUM_IB WITH _NUM_IB
REPLACE KOD1 WITH IF(q=5,"2","3")
REPLACE KOD2 WITH IF(q=3,"1","2")
ENDIF
SET CURSOR ON
REPLACE COMM1 WITH ;
MEMPRO(COMM1,10,5,15,75,;
IF(q=5," ВВЕДИТЕ НАЗВАНИЯ ОСЛОЖНЕНИЙ ",;
" ВВЕДИТЕ НАЗВАНИЯ СОПУТСТВУЮЩИХ ЗАБОЛЕВАНИЙ "),;
"ILLS",'ILLS')
context(@str356,"",ALLTRIM(COMM1),length,.F.)
vars1[q]=str356
RELEASE str356
ENDCASE
new_str1=.T.
string111=""
context(@string111,promp1[q],vars1[q],length,New_Str1)
IF q=3.AND._END1=3
context(@string111," "," ",length,.T.)
context(@string111,SPACE(10)+"Паталого-анатомический диагноз"," ",length,.T.)
ENDIF
stuff1(@string11,length,string111,q,row1,len(promp1))
ENDDO
REINDEX
gotomain=.F.
SELECT (sel)
RETURN (string11)
*********************************************************************
* Процедура работы с операциями *
*********************************************************************
PROCEDURE op
PRIVATE txto,sel,w_do
PRIVATE F2,screen,color
PRIVATE stro
STORE "" TO stro
txto=SPACE(80)
_SHIFR_ILL="0000"
sel=SELECT()
SAVE SCREEN TO screen
@ 11,25 CLEAR TO 16,55
@ 11,25 TO 16,55 DOUBLE
@ 11,30 PROMPT "ДОБАВИТЬ"
@ 11,44 PROMPT "УДАЛИТЬ"
IF EMPTY(vars[choice])
KEYBOARD CHR(13)
ENDIF
MENU TO w_do
stro=vars[choice]
IF w_do=1
@ 13,30 SAY "ВВЕДИТЕ КОД" GET _SHIFR_ILL PICTURE "@R 99.99"
READ
RESTORE SCREEN FROM screen
IF LASTKEY()=27
RETURN
ENDIF
F2=catalog(@_SHIFR_ILL,@txto)
IF F2#-1
SELECT BUFF2
APPEND BLANK
REPLACE NUM_IB WITH _NUM_IB
REPLACE SHIFR WITH _SHIFR_ILL
REPLACE DATA WITH d_input(DATA)
SET CURSOR ON
REPLACE COMM WITH ;
MEMPRO(COMM,10,5,15,75," ВВЕДИТЕ НАЗВАНИЕ ОПЕРАЦИИ ","OPER",'OPER')
context(@stro,"",ALLTRIM(txto)+".",length,.F.)
context(@stro," Дата проведения : ",DTOC(DATA)+".",length,.F.)
context(@stro," Название операции : ",ALLTRIM(COMM)+".",length,.F.)
ENDIF
ELSEIF w_do=2
PRIVATE i,j,k,EN,ET,NALL,MALL,NDEL
NALL=INT(LEN(stro)/length)
MALL=NALL
FOR i=1 TO NALL
ET=ALLTRIM(SUBSTR(stro,length*(i-1)+1,length))
EN=ASC(ET)
IF EN<>60
MALL=MALL-1
ENDIF
NEXT
DECLARE _0B[MALL],_0S[MALL]
k=1
FOR j=1 TO NALL
ET=ALLTRIM(SUBSTR(stro,length*(j-1)+1,length))
EN=ASC(ET)
IF EN=60
_0B[k]=SUBSTR(stro,length*(j-1)+1,length)
_0S[k]=LEFT(ALLTRIM(_0B[k]),5)
k=k+1
ELSE
_0B[k-1]=_0B[k-1]+SUBSTR(stro,length*(j-1)+1,length)
ENDIF
NEXT
NDEL=ACHOICE(13,35,15,45,_0S)
IF LASTKEY()=27
RETURN
ENDIF
SELECT BUFF2
GO NDEL
DELETE
PACK
stro=""
FOR j=1 TO MALL
IF j#NDEL
stro=stro+_0B[j]
ENDIF
NEXT
RELEASE j,NALL,NDEL
RELEASE _0B,_0S
ENDIF
vars[choice]=stro
SELECT (sel)
RETURN
*********************************************************************
* ПРОЦЕДУРА ЗАПОЛНЕНИЯ БД karta.dbf *
*********************************************************************
PROCEDURE new_save
PRIVATE sel,v
sel=SELECT()
SET CURSOR OFF
SELECT karta
@ 11,18 CLEAR TO 13,62
@ 10,17 TO 14,63
saycent(12,20,60,"ПОДОЖДИТЕ НЕМНОГО - ИДЕТ ЗАПИСЬ В БД")
SET COLOR TO W/N
v=replicate(chr(32),30)
SET COLOR TO
@ 13,25 SAY v
SEEK _NUM_IB
IF FOUND()=.F.
APPEND BLANK
REPLACE NUM_IB WITH _NUM_IB
rec_num = RECNO()
ENDIF
REPLACE FAM WITH ALLTRIM(_FAM)
REPLACE F_S_NAME WITH ALLTRIM(_F_S_NAME)
REPLACE DATE_B WITH _DATE_B
REPLACE HOUR_B WITH _HOUR_B
REPLACE MINS_B WITH _MINS_B
REPLACE POL WITH _POL
REPLACE OLD WITH _OLD
REPLACE OLD_D WITH _OLD_D
REPLACE MASSA WITH _MASSA
REPLACE PLACE_LIV WITH _PLACE_LIV
REPLACE RAION WITH _RAION
REPLACE CITY_VILL WITH _CITY_VILL
REPLACE DIRECT1 WITH _DIRECT1
REPLACE DIRECT2 WITH _DIRECT2
REPLACE STATE WITH _STATE
REPLACE PLACE WITH _PLACE
*REPLACE WHY WITH _WHY
REPLACE DEPARTMENT WITH _DEPARTMENT
REPLACE KOIKA WITH _KOIKA
REPLACE PASS WITH _PASS
REPLACE TIME WITH _TIME
REPLACE DATE_IN WITH _DATE_IN
REPLACE HOUR_IN WITH _HOUR_IN
REPLACE MINS_IN WITH _MINS_IN
REPLACE END1 WITH _END1
REPLACE END2 WITH _END2
REPLACE END3 WITH _END3
REPLACE DATE_END WITH _DATE_END
REPLACE HOUR_END WITH _HOUR_END
REPLACE MINS_END WITH _MINS_END
REPLACE ALL_DAY WITH _ALL_DAY
REPLACE SHIFR WITH _DIA_DIRECT
REPLACE NUM_COME WITH _NUM_COME
REPLACE RW_DATE WITH _RW_DATE
REPLACE RW_REZ WITH _RW_REZ
REPLACE FAM_DOCTOR WITH _FAM_DOCTOR
*REINDEX
COMMIT
v=replicate(chr(177),10)
@ 13,25 SAY v
SELECT DIA66
DELETE FOR NUM_IB=_NUM_IB
PACK
*COMMIT
IF _END1=3
APPEND FROM BUFF FOR NUM_IB=_NUM_IB
ELSE
APPEND FROM BUFF FOR NUM_IB=_NUM_IB.AND.KOD2#"2"
ENDIF
*REINDEX
COMMIT
SELECT BUFF
ZAP
*COMMIT
*REINDEX
COMMIT
v=replicate(chr(177),20)
@ 13,25 SAY v
SELECT OP66
DELETE FOR NUM_IB=_NUM_IB
PACK
*COMMIT
APPEND FROM BUFF2 FOR NUM_IB=_NUM_IB
v=replicate(chr(177),30)
*REINDEX
COMMIT
@ 13,25 SAY v
SELECT BUFF2
ZAP
*COMMIT
*REINDEX
COMMIT
SELECT (sel)
RETURN
*********************************************************************
* Процедура удаления записей *
*********************************************************************
PROCEDURE del
PRIVATE flag_del && число записей,помеченных для удаления
PRIVATE nr,tr,del_str,temp,_01,_02,sel
@ 5,1,22,78 BOX dn_s+fon1
sel=SELECT()
flag_del=0
c_d=2
SELECT KARTA
*RECALL ALL
*GO TOP
nr=RECCOUNT()
DECLARE stor_ib[nr]
DO WHILE !gotomain
DO first
@ 7,5,16,74 BOX singl+fon2
SET COLOR TO "r+*/b"
saycent(5,0,79,if(DELETED(),"Запись помечена на удаление",SPACE(27)))
SET COLOR TO (color1)
@ 10,10 PROMPT IF(!BOF(),"Вернуться к предыдущей записи","******")
@ 12,10 PROMPT IF(DELETED(),"Отменить удаление текущей записи",;
"Пометить текущую запись на удаление")
@ 14,10 PROMPT IF(!EOF(),"Перейти к следующей записи","******")
@ 16,35 PROMPT "Выполнить" MESSAGE "Удалить помеченные записи и "+;
"вернуться в главное меню"
MENU TO c_d
DO CASE
CASE c_d=0
LOOP
CASE c_d=1
IF(!BOF())
SKIP -1
ENDIF
CASE c_d=2
IF(!EOF())
IF !DELETED()
DELETE
flag_del=flag_del+1
stor_ib[flag_del]=NUM_IB
ELSE
RECALL
tr=ASCAN(stor_ib,NUM_IB)
ADEL(stor_ib,tr)
flag_del=flag_del-1
ENDIF
ENDIF
CASE c_d=3
IF(!EOF())
SKIP
ENDIF
CASE c_d=4
EXIT
ENDCASE
ENDDO
IF flag_del>0
y=yesno(10,"Удалить помеченные "+alltrim(str(flag_del))+" записей ?")
IF y=1
temp="NUM_IB='"
del_str=temp+stor_ib[1]+"'"
temp=".OR."+temp
FOR tr=2 TO flag_del
del_str=del_str+temp+stor_ib[tr]+"'"
NEXT
DELETER(del_str,"DIA66") && Удаление из DIA66.DBF
DELETER(del_str,"OP66") && Удаление из OP66.DBF
***************************************
pack && Удаление из KARTA66.DBF
ELSE
RECALL ALL
GOTO TOP
ENDIF
ENDIF
SELECT (sel)
RETURN
*********************************************************************
* Процедура формирования отчетных документов *
*********************************************************************
FUNCTION rez
PRIVATE _OTCH,_OTCH_N,scr1
_OTCH=00
_OTCH_N=""
SAVE SCREEN TO scr1
PRIVATE sel
sel=SELECT()
PRIVATE _DATE_FROM
_DATE_FROM=_today
PRIVATE _DATE_TILL
_DATE_TILL=_today
PRIVATE dep,dep_name
PRIVATE numb1
PRIVATE txt
PRIVATE pole
PRIVATE count
count=1
PRIVATE _c
_c=1
PRIVATE _p
_p=1
PRIVATE OT1,OT2
PRIVATE coun,c1,v1,v2
PRIVATE f
f=1
DO WHILE .T.
SELECT 0
USE BUFF8.DBF INDEX BUFF8 ALIAS BUFF8
ZAP
numb1=0
txt=SPACE(100)
pole=1
STORE "" TO OT1,OT2
dep=0
dep_name=""
codif1("PERD",@_p)
IF _p=0
SELECT BUFF8
USE
EXIT
ELSEIF _p=2
_OTCH_N=codif1("OTCH",@_OTCH)
IF _OTCH=0
SELECT BUFF8
USE
EXIT
ENDIF
ENDIF
dep_name=codif1("DEPS",@dep)
IF _p=1.AND.dep=0
SELECT BUFF8
USE
LOOP
ENDIF
dep_name=IF(dep=0,"Весь стационар",dep_name)
IF period()=0 && Ввод пользователем периода отчета
SET CURSOR OFF
IF _p=1
********************* МЕСЯЧНЫЕ ОТЧЕТЫ **********************
_OTCH_N="Месячный отчет"
SELECT DIA66
SET RELATION TO SHIFR INTO BUFF8
SELECT karta
SET RELATION TO NUM_IB INTO DIA66
GO TOP
PRIVATE OT1D1,OT2D1,OT1D2,OT2D2
IF dep=2.OR.dep=11
OT1="OTD5.FRM"
OT1D1="OTD2.FRM"
OT2D1="OTD51.TXT"
ELSE
OT1="OTD.FRM"
OT1D1="OTD1.FRM"
OT2D1="OTD_1.TXT"
OT1D2="OTD2.FRM"
OT2D2="OTD_2.TXT"
ENDIF
DO show_st && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ
DO WHILE !EOF()
IF dep=KARTA->DEPARTMENT.AND.;
KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_END<=_DATE_TILL.AND.;
KARTA->END1#3.AND.DIA66->KOD1="1"
_SHIFR=DIA66->SHIFR
SELECT BUFF8
IF EOF()
APPEND BLANK
REPLACE SHIFR WITH _SHIFR
mkb(1,1,@_SHIFR,@txt)
REPLACE NAME WITH txt
ENDIF
REPLACE COUNT1 WITH COUNT1+KARTA->ALL_DAY && ПРОВЕДЕНО ДНЕЙ
REPLACE COUNT2 WITH COUNT2+1 && ВСЕГО БОЛЬНЫХ
pole=FIELD(8+KARTA->RAION)
REPLACE &pole WITH &pole+1 && из Москвы/Моск.обл./Иногородн./Село
pole=FIELD(14+KARTA->NUM_COME)
REPLACE &pole WITH &pole+1 && Первично/Повторно
pole=FIELD(16+KARTA->DIRECT1)
REPLACE &pole WITH &pole+1 && Направляющие организации
*--------------------------------------------------------------------
IF dep=2.OR.dep=11
IF KARTA->OLD<7
REPLACE C3 WITH C3+1 && Всего до 1 года
REPLACE C4 WITH C4+KARTA->ALL_DAY && К/Д
IF KARTA->CITY_VILL=2
REPLACE C5 WITH C5+1 && В том числе из села
REPLACE C6 WITH C6+KARTA->ALL_DAY && К/Д
ENDIF
ELSE
IF KARTA->CITY_VILL=2
REPLACE C9 WITH C9+1 && Из села старше 1 года
ENDIF
ENDIF
IF KARTA->OLD=1
pole=FIELD(43)
ELSEIF KARTA->OLD=2
ad=piece(KARTA->HOUR_B,KARTA->MINS_B,KARTA->HOUR_END,KARTA->MINS_END)
ad=KARTA->DATE_END-KARTA->DATE_B+IF(ad=1,1,IF(ad>=0,0,-1))
pole=FIELD(42+IF(ad<=14,2,IF(ad>14.AND.ad<=21,3,4)))
ELSE
pole=FIELD(44+KARTA->OLD)
ENDIF
*--------------------------------------------------------------------
ELSE
IF KARTA->OLD<7
REPLACE C3 WITH C3+1 && Всего до 1 года
REPLACE C4 WITH C4+KARTA->ALL_DAY && К/Д
IF KARTA->CITY_VILL=2
REPLACE C5 WITH C5+1 && В том числе из села
REPLACE C6 WITH C6+KARTA->ALL_DAY && К/Д
ENDIF
ELSEIF KARTA->OLD<11
REPLACE C7 WITH C7+1 && Всего до 14 лет
REPLACE C8 WITH C8+KARTA->ALL_DAY && К/Д
IF KARTA->CITY_VILL=2
REPLACE C9 WITH C9+1 && В том числе из села
REPLACE C0 WITH C0+KARTA->ALL_DAY && К/Д
ENDIF
ELSE
REPLACE D1 WITH D1+1 && Всего 15 лет и старше
REPLACE D2 WITH D2+KARTA->ALL_DAY && К/Д
IF KARTA->CITY_VILL=2
REPLACE D3 WITH D3+1 && В том числе из села
REPLACE D4 WITH D4+KARTA->ALL_DAY && К/Д
ENDIF
ENDIF
IF KARTA->OLD<=3
pole=FIELD(43)
ELSE
pole=FIELD(40+KARTA->OLD)
ENDIF
ENDIF
*--------------------------------------------------------------------
REPLACE &pole WITH &pole+1 && Возраст
SELECT KARTA
ENDIF
SKIP 1
show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ
ENDDO
SET RELATION TO
SELECT DIA66
SET RELATION TO
grad() && РАЗБИЕНИЕ БОЛЕЗНЕЙ НА КЛАССЫ
SELECT BUFF8
OT2="OTD"+ALLTRIM(STR(dep))+".TXT"
@ 13,25 SAY " СОЗДАЕТСЯ ОТЧЕТ : "+OT2+" "
IF dep#2.AND.dep#11
REPORT FORM &OT1D2 TO FILE &OT2D2 PLAIN
ENDIF
REPORT FORM &OT1D1 TO FILE &OT2D1 PLAIN
REPORT FORM &OT1 TO FILE &OT2 PLAIN