CASE i=29
vars[i]=codifpic("CODIF","FAMS",@_FAM_DOCTOR)
*********************************************
CASE i=25
vars[i]=diagn()
new_str=.T.
*********************************************
CASE i=26
DO op
new_str=.T.
ENDCASE
***********************************************************
string1=""
IF choice#25.AND.choice#26
vars[choice]=TRIM(vars[choice])+"."
ENDIF
context(@string1,promp[choice],vars[choice],length,New_Str)
IF choice=20
IF _END1=2 && переведен
context(@string1,"Причина:",codif1("RIZ2",@_END2)+".",length,.F.)
context(@string1,"Куда:",codif1("HOSP",@_END3)+".",length,.F.)
ELSEIF _END1=3 && умер
context(@string1,"Причина:",codif1("RIZ3",@_END2)+".",length,.F.)
ENDIF
ELSEIF choice=22.AND._END1=3
y_m_day(_DATE_B,_HOUR_B,_MINS_B,_DATE_END,_HOUR_END,_MINS_END)
context(@string1,"Возраст на момент смерти :",;
extra1(_OLD_D,"OLDS")+".",length,.F.)
ELSEIF choice=26
context(@string1,"Обследование на реакцию ВАССЕРМАНА :","",length,.F.)
ENDIF
stuff1(@string,length,string1,choice,row,len(promp))
ENDIF
ENDDO
RETURN
**********************************************************************
* ПРОЦЕДУРА ФОРМИРОВАНИЯ СОДЕРЖИМОГО 66 ФОРМЫ *
**********************************************************************
PROCEDURE initial
PRIVATE sel,i,v
PRIVATE rez
SET CURSOR OFF
sel=SELECT()
v=replicate(chr(176),30)
@ 13,25 SAY v
SELECT karta
vars[1]= SUBSTR(_NUM_IB,1,2)+'/'+SUBSTR(_NUM_IB,3,7)
vars[2] =FAM
_FAM=FAM
vars[3] =F_S_NAME
_F_S_NAME=F_S_NAME
vars[4]=DTOC(DATE_IN)
_DATE_IN=DATE_IN
*__________________________________
_HOUR_IN=HOUR_IN
_MINS_IN=MINS_IN
IF _HOUR_IN=0.AND._MINS_IN=0
time_IN="00.00"
ELSEIF _HOUR_IN=0
time_IN="00."+STR(MINS_IN)
ELSEIF _MINS_IN=0
time_IN=STR(HOUR_IN)+".00"
ELSE
time_IN=STR(HOUR_IN)+"."+STR(MINS_IN)
ENDIF
vars[5]=time_IN
*----------------------------------
vars[6] =extra1(POL,"POLS")
_POL=POL
vars[7] =DTOC(DATE_B)
_DATE_B=DATE_B
*__________________________________
_HOUR_B=HOUR_B
_MINS_B=MINS_B
IF _HOUR_B=0.AND._MINS_B=0
time_B="00.00"
ELSEIF _HOUR_B=0
time_B="00."+STR(MINS_B)
ELSEIF _MINS_B=0
time_B=STR(HOUR_B)+".00"
ELSE
time_B=STR(HOUR_B)+"."+STR(MINS_B)
ENDIF
vars[8]=time_B
*-----------------------------------
vars[9] =extra1(OLD,"OLDS")
_OLD=OLD
_OLD_D=OLD_D
vars[10] =MASSA
_MASSA =MASSA
vars[11] =PLACE_LIV
_PLACE_LIV=PLACE_LIV
vars[12] =extra1(RAION,"RIGS")
_RAION =RAION
vars[13]=extra1(CITY_VILL,"CITZ")
_CITY_VILL=CITY_VILL
*___________________________________
_DIRECT1=DIRECT1
_DIRECT2=DIRECT2
vars[14]=IF(_DIRECT2=0,extra1(_DIRECT1,"DIRS"),;
IF(_DIRECT1=1,extra1(_DIRECT2,"BIRS"),;
extra1(_DIRECT2,"HOSP")))
*------------------------------------
promp[15]=IF(PLACE#0,"Регион :","Государство :")
vars[15]=IF(STATE#0,IF(STATE=1,;
IF(PLACE=0,"Российская Федерация",extra1(PLACE,"PLCE")),;
extra1(STATE,"STTE")),;
"Российская Федерация")
_STATE=IF(STATE=0,1,STATE)
_PLACE=PLACE
vars[16]=extra1(DEPARTMENT,"DEPS")
_DEPARTMENT=DEPARTMENT
vars[17]=extra1(KOIKA,"KOIK")
_KOIKA=KOIKA
vars[18]=extra1(PASS,"EXTR")
_PASS=PASS
vars[19]=extra1(TIME,"TIMS")
_TIME=TIME
*__________________________________
_END1=END1
_END2=END2
_END3=END3
vars[20]=extra1(_END1,"REZS")
*----------------------------------
vars[21]=DTOC(DATE_END)
_DATE_END=DATE_END
*__________________________________
_HOUR_END=HOUR_END
_MINS_END=MINS_END
IF _HOUR_END=0.AND._MINS_END=0
time_END="00.00"
ELSEIF _HOUR_END=0
time_IN="00."+STR(MINS_END)
ELSEIF _MINS_END=0
time_IN=STR(HOUR_END)+".00"
ELSE
time_END=STR(HOUR_END)+"."+STR(MINS_END)
ENDIF
vars[22]=time_END
*__________________________________
_ALL_DAY=ALL_DAY
IF !EMPTY(_DATE_END)
vars[21]=vars[21]+SPACE(5)+"Проведено дней в стационаре :"+STR(_ALL_DAY)
ENDIF
*----------------------------------
_DIA_DIRECT=SHIFR
IF _DIA_DIRECT#" "
PRIVATE txtd
txtd=SPACE(100)
mkb(1,1,@_DIA_DIRECT,@txtd)
vars[23]=SUBSTR(_DIA_DIRECT,1,3)+"."+SUBSTR(_DIA_DIRECT,4,1)+" "+;
"<"+TRIM(txtd)+">"
RELEASE txtd
ELSEIF _DIA_DIRECT=" "
vars[23]=_DIA_DIRECT
ENDIF
*----------------------------------
vars[24]=extra1(NUM_COME,"VIZI")
_NUM_COME=NUM_COME
vars[27]=DTOC(RW_DATE)
_RW_DATE=RW_DATE
vars[28]=extra1(RW_REZ,"RWRZ")
_RW_REZ=RW_REZ
vars[29]=extra1(FAM_DOCTOR,"FAMS")
_FAM_DOCTOR=FAM_DOCTOR
v=replicate(chr(178),10)
@ 13,25 SAY v
*************************************
vars[25]=initial1("DIA66")
v=replicate(chr(178),20)
@ 13,25 SAY v
*************************************
SELECT op66
SET SOFTSEEK ON
seek _num_ib
SET SOFTSEEK OFF
IF !FOUND()
vars[26]="" && Хирургические операции
_SHIFR_ILL="0000" &&SHIFR_ILL
ELSE
PRIVATE txts,string8
txts=SPACE(70)
STORE "" TO string8
DO WHILE NUM_IB=_NUM_IB
_SHIFR_ILL=SHIFR
catalog(@_SHIFR_ILL,@txts)
txts=TRIM(txts)
context(@string8,"",txts,length,.F.)
context(@string8," Дата проведения : ",DTOC(DATA)+".",length,.F.)
context(@string8," Название операции : ",ALLTRIM(COMM),length,.F.)
vars[26]=string8
SKIP 1
ENDDO
RELEASE txts,string8
SELECT BUFF2
COMMIT
APPEND FROM OP66 FOR NUM_IB=_NUM_IB
ENDIF
v=replicate(chr(178),30)
@ 13,25 SAY v
******************* ФОРМИРОВАНИЕ ТЕКСТА *************************
string="" && Начальный текст
SELECT karta
SEEK _NUM_IB
rez=FOUND()
New_Str=.F.
FOR i=1 TO LEN(promp)
IF (i=23.AND._DIA_DIRECT#" ").OR.i=25.OR.i=26
New_Str=.T.
ENDIF
IF rez.AND.!EMPTY(vars[i])
row[i]=context(@string,promp[i],TRIM(vars[i])+".",length,New_Str)
ELSE
row[i]=context(@string,promp[i],vars[i],length,New_Str)
ENDIF
New_Str=.F.
IF i=20 && Промпт "ИСХОД"
IF _END1=2 && переведен
context(@string,"Причина:",extra1(_END2,"RIZ2")+".",length,.F.)
context(@string,"Куда:",extra1(_END3,"HOSP")+".",length,.F.)
ELSEIF _END1=3 && умер
context(@string,"Причина:",extra1(_END2,"RIZ3")+".",length,.F.)
ENDIF
ELSEIF i=22.AND._END1=3
context(@string,"Возраст на момент смерти :",;
extra1(_OLD_D,"OLDS")+".",length,.F.)
ELSEIF i=26
context(@string,"Обследование на реакцию ВАССЕРМАНА :","",length,.F.)
ENDIF
NEXT
SET CURSOR ON
SELECT (sel)
RETURN
*********************************************************************
* Функция инициализации диагнозов *
*********************************************************************
FUNCTION initial1
PARAMETERS DBN
PRIVATE sl,rez1
SET CURSOR OFF
sl=SELECT()
SELECT &DBN
SET SOFTSEEK ON
SEEK _NUM_IB
SET SOFTSEEK OFF
rez1=FOUND()
IF !rez1
vars1[1]="" && Основной диагноз
vars1[2]="" && Осложнения
vars1[3]="" && Сопутствующие заболевания
IF _END1=3
vars1[4]="" && Основной диагноз
vars1[5]="" && Осложнения
vars1[6]="" && Сопутствующие заболевания
ENDIF
_SHIFR=SPACE(4) && SHIFR
_KOD1=0 && KOD1
_KOD2=0 && KOD2
ELSE
PRIVATE txts,string2,string3,string4,string5,string6,string7
txts=SPACE(100)
STORE "" TO string2,string3,string4,string5,string6,string7
DO WHILE NUM_IB=_NUM_IB
_KOD1=KOD1
_KOD2=KOD2
_SHIFR=SHIFR
IF _SHIFR="0000"
txts="Здоров"
ELSE
IF _KOD1="1".OR._KOD1="2".AND._KOD2#"2"
mkb(1,1,@_SHIFR,@txts)
ENDIF
ENDIF
txts=SUBSTR(_SHIFR,1,3)+"."+SUBSTR(_SHIFR,4,1)+" "+"<"+TRIM(txts)+">"
IF _KOD2#"2"
IF _KOD1="1"
context(@string2,"",txts,length,.F.)
context(@string2,"",ALLTRIM(COMM1),length,.F.)
vars1[1]=string2
ELSEIF _KOD1="2"
context(@string3,"",txts,length,.F.)
vars1[2]=string3
ELSEIF _KOD1="3"
context(@string4,"",ALLTRIM(COMM1),length,.F.)
vars1[3]=string4
ENDIF
ELSEIF _KOD2="2".AND._END1=3
IF _KOD1="1"
context(@string5,"",txts,length,.F.)
context(@string5,"",ALLTRIM(COMM1),length,.F.)
vars1[4]=string5
ELSEIF _KOD1="2"
context(@string6,"",ALLTRIM(COMM1),length,.F.)
vars1[5]=string6
ELSEIF _KOD1="3"
context(@string7,"",ALLTRIM(COMM1),length,.F.)
vars1[6]=string7
ENDIF
ENDIF
SKIP 1
ENDDO
RELEASE txts,string2,string3,string4,string5,string6,string7
SELECT BUFF
APPEND FROM DIA66 FOR NUM_IB=_NUM_IB
ENDIF
PRIVATE string11,j
string11=""
New_Str=.T.
context(@string11,SPACE(10)+"Клинический диагноз"," ",length,.T.)
FOR j=1 TO s
IF rez1.AND.!EMPTY(vars1[j])
row1[j]=context(@string11,promp1[j],TRIM(vars1[j])+".",length,New_Str)
ELSE
row1[j]=context(@string11,promp1[j],vars1[j],length,New_Str)
ENDIF
IF j=3.AND._END1=3
context(@string11," "," ",length,.T.)
context(@string11,SPACE(10)+"Паталого-анатомический диагноз"," ",length,.T.)
ENDIF
NEXT
SET CURSOR ON
SELECT (sl)
RETURN (string11)
*********************************************************************
* Функция ввода даты *
*********************************************************************
FUNCTION d_input
PARAMETERS dat
PRIVATE screen
SAVE SCREEN TO screen
SET CURSOR ON
@ 10,25 CLEAR TO 15,55
@ 10,25 TO 15,55
saycent(10,30,50,"ВВЕДИТЕ В ФОРМАТЕ")
@ 12,36 SAY "дд.мм.гг"
@ 14,36 GET dat PICTURE "@D"
READ
SET CURSOR OFF
RESTORE SCREEN FROM screen
RETURN dat
*********************************************************************
* Функция ввода массы пациента *
*********************************************************************
FUNCTION m_input
PRIVATE screen
SAVE SCREEN TO screen
SET CURSOR ON
@ 10,25 CLEAR TO 15,55
@ 10,25 TO 15,55
saycent(10,30,50,"ВВЕДИТЕ В ФОРМАТЕ")
@ 12,38 SAY "кг/гр."
@ 14,38 GET _MASSA PICTURE "@P 99/999"
READ
SET CURSOR OFF
RESTORE SCREEN FROM screen
RETURN _MASSA
*********************************************************************
* Функция проверки времени *
*********************************************************************
FUNCTION check_T
PARAMETERS timeS
PRIVATE L,hour,mins
L=.F.
hour=SUBSTR(timeS,1,2)
mins=SUBSTR(timeS,4,5)
IF VAL(hour)<24.AND.VAL(mins)<60
L=.T.
ENDIF
RETURN (L)
*********************************************************************
* Определение количества дней, проведеннх в стационаре *
*********************************************************************
PROCEDURE ch_day
PRIVATE string2
string2=""
vars[choice]=vars[choice]+"."
context(@string2,promp[choice],vars[choice],length,New_Str)
stuff1(@string,length,string2,choice,row,len(promp))
choice=21
vars[choice]=DTOC(_DATE_END)
IF _ALL_DAY>=0.AND.EMPTY(_DATE_IN)=.F.
vars[choice]=DTOC(_DATE_END)+SPACE(5)+"Проведено дней в стационаре :"+;
STR(_ALL_DAY)
ENDIF
RETURN
*********************************************************************
* Процедура работы с диагнозами *
*********************************************************************
FUNCTION diagn
PRIVATE txtf,sel,w_do
PRIVATE F1,screen,color
PRIVATE str
PRIVATE s
PRIVATE q
PRIVATE string11
q=0
str=""
txtf=SPACE(100)
_SHIFR=SPACE(4)
sel=SELECT()
F1=0
string11=vars[25]
s=IF(_END1=3,6,3)
IF LEN(promp1)#s
@ 11,18 CLEAR TO 13,62
@ 11,18 TO 13,62
saycent(12,20,60,"ФОРМИРУЕТСЯ МЕНЮ ДИАГНОЗОВ")
DECLARE promp1[s],vars1[s],row1[s],col1[s] && массив промптеров дополн. меню
promp1[1]="Основное заболевание :"
promp1[2]="Осложнения :"
promp1[3]="Сопутствующие заболевания :"
IF s=6
promp1[4]="Основное заболевание :"
promp1[5]="Осложнения :"
promp1[6]="Сопутствующие заболевания :"
ENDIF
AFILL(vars1,' ')
AFILL(col1,1)
**************************************************************
string11=initial1("BUFF") && Функция формирования выводимого текста
**************************************************************
ENDIF
wt1=3
wb1=IF(s=3,12,20)
wl1=2
wr1=77
length=wr1-wl1+1 && Длина строки текста, выводимого на экран
beg_line1=1
PRIVATE New_Str1 && Признак новой строки для Context
New_Str1=.F. && Без выделения промптеров
cur_promp1=1
DO WHILE !gotomain
q=hypertxt(wt1,wl1,wb1,wr1,string11,promp1,row1,col1,;
@beg_line1,@cur_promp1,color9," ДИАГНОЗ ПАЦИЕНТА ")
cur_promp1=cur_promp1%len(promp1)+1
DO CASE
CASE q=0
LOOP
CASE q=1.OR.q=2.OR.q=4
w_do=1
SAVE SCREEN TO screen
@ 11,25 CLEAR TO 16,55
@ 11,25 TO 16,55 DOUBLE
@ 11,30 PROMPT "ДОБАВИТЬ"
@ 11,44 PROMPT "УДАЛИТЬ"
IF EMPTY(vars1[q]).OR.BUFF->KOD1="2".AND.BUFF->KOD2="2"
vars1[q]=""
KEYBOARD CHR(13)
ENDIF
MENU TO w_do
str=vars1[q]
IF w_do=1
@ 13,30 SAY "ВВЕДИТЕ КОД" GET _SHIFR PICTURE "@R 999.9"
READ
IF LASTKEY()=27
vars1[q]=str
RESTORE SCREEN FROM screen
LOOP
ENDIF
F1=mkb(1,1,@_SHIFR,@txtf)
IF F1#-1
txtf=SUBSTR(_SHIFR,1,3)+"."+SUBSTR(_SHIFR,4,1)+" "+;
"<"+TRIM(txtf)+">"+"."