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

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