Разработка автоматизированной системы учета выбывших из стационара
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)
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11
|