Файл: Р азработка информационного комплекса для лечебного учреждения.doc

LOCAL buf, s_c, alt, i, str, one, too

// PUBLIC

buf=SAVESCREEN(0,0,24,79)

s_c=SETCOLOR("W+/BR+")

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

SELECT 2

SET FILTER TO !DELETED()

GOTO TOP

one=0

too=0

DO WHILE !EOF()

IF dat-LAST_DATE > 730

too=too+1

ELSE

IF dat-LAST_DATE > 365

one=one+1

ENDIF

ENDIF

SKIP

ENDDO

IF LASTKEY() = 27

INKEY(0)

ENDIF

CLEAR TYPEAHEAD

blank=str+lf+lf

flag=0

DO WHILE flag != 2

SETCOLOR("W/B")

@ 24,0 CLEAR TO 24,79

@ 24, 1 SAY '"Esc" - выход; F5 - печать'

SETCOLOR("W/BR")

@ 0,0 TO 23,79

str=MEMOEDIT(str,1,1,22,78,.F.,"BRO")

IF flag = -4

DO PRINTER

flag=1

ENDIF

ENDDO

SET FILTER TO

SETCOLOR(s_c)

RESTSCREEN(0,0,24,79,buf)

RETURN
PROCEDURE DISPAN

LOCAL buf1, s_c1, alt, i, str, maxS, maxl

PUBLIC cod, dis, ndra1

buf1=SAVESCREEN(0,0,24,79)

s_c1=SETCOLOR("W+/BR+")

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

SELECT 5

SET FILTER TO GROUP="DISPANSER" .AND. !DELETED()

COUNT FOR GROUP="DISPANSER" .AND. !DELETED() TO ndra1

GOTO TOP

IF ndra1 = 0

SETCOLOR("W+/B")

@ 10,10 CLEAR TO 15,70

@ 10,10 TO 15,70

@ 12, 20 SAY 'Выберите пункт "НАСТРОЙКА" в главном меню'

@ 13, 15 SAY 'и заполните список "Диспансеризация по заболеваниям"'

INKEY(delay)

SET FILTER TO

SETCOLOR(s_c1)

RESTSCREEN(0,0,24,79,buf1)

RETURN

ENDIF

SETCOLOR("W+/B")

@ 24,0 CLEAR TO 24,79

@ 24, 1 SAY "Выберите заболевание из списка"

adoc3:=ARRAY(ndra1)

aid3:=ARRAY(ndra1)

maxl=0

FOR i=1 TO ndra1

adoc3[i]=RTRIM(NAME)

aid3[i]=CODE

maxl=IF(LEN(RTRIM(NAME))>maxl, LEN(RTRIM(NAME)), maxl)

SKIP

NEXT

maxS=IF(8+ndra1<22, 8+ndra1, 22)

SET FILTER TO

DO WHILE .T.

SETCOLOR("W+/B")

@ 7,9 CLEAR TO maxS,10+maxl

@ 7,9 TO maxS,10+maxl

// @ 0,0 CLEAR TO 24,79

// @ 0,0 TO 23,79

CLEAR TYPEAHEAD

alt = ACHOICE(8,10,maxS-1,9+maxl,adoc3,.T.,"USE_PASS",alt)

IF alt != 0

dis=adoc3[alt]

cod=aid3[alt]

SELECT 1

SET FILTER TO DISPAN = cod .AND. !DELETED()

COUNT FOR DISPAN = cod .AND. !DELETED() TO ndra

GOTO TOP

IF ndra = 0 // по выбранному заболеванию список пуст

DO PASS_DIS

ELSE

DO LIST_DIS

ENDIF

ELSE

EXIT

ENDIF

ENDDO

SELECT 1

SET FILTER TO

SETCOLOR(s_c1)

RESTSCREEN(0,0,24,79,buf1)

RETURN
PROCEDURE LIST_DIS

LOCAL buf, buf1, s_c, sav_col, alt, filt, i, cit

buf=SAVESCREEN(0,0,24,79)

s_c=SETCOLOR("W+/B+")

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

SELECT 2

SET ORDER TO 1

SELECT 1

SET RELATION TO STR(ID,6) INTO pat_list

PUBLIC adoc[ndra], afs[ndra], adadr[ndra], aid[ndra]

FOR i=1 TO ndra

SELECT 5

LOCATE FOR GROUP="CITY" .AND. CODE=1->CITY

cit=TRIM(NAME)

SELECT 1

k=SUBSTR(TRIM(2->L_NAME)+" "+TRIM(+2->F_NAME)+" ";

+TRIM(2->S_NAME), 1, 45)

adoc[i]=k+SPACE(45-LEN(k));

+" "+DTOC(2->BR_DATE)+" "+DTOC(1->D_DATE)+;

+" "+DTOC(2->LAST_DATE)+"\\"+STR(ID)

k=SUBSTR(TRIM(2->L_NAME)+" "+TRIM(+2->F_NAME)+" ";

+TRIM(2->S_NAME), 1, 42)

adadr[i]=k+SPACE(42-LEN(k));

+" "+DTOC(2->BR_DATE)+" "+DTOC(1->D_DATE)+;

+" "+DTOC(2->LAST_DATE)+lf+" "+TRIM(cit)+" "+TRIM(ADDRESS1)

// adoc[i]=adoc[i]+"\\"+STR(ID)

SKIP

NEXT

ASORT(adoc)

ASORT(adadr)

FOR i=1 TO ndra

afs[i]=ASC(SUBSTR(adoc[i],1,1))

aid[i]=VAL(SUBSTR(adoc[i], AT("\\",adoc[i])+2))

adoc[i]=SUBSTR(adoc[i], 1, AT("\\",adoc[i])-1)

NEXT

// flag=0

alter=1

DO WHILE alter != 0 .AND. ndra != 0

SETCOLOR("W+/B+")

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

@ 24,1 SAY '"Esc" - выход; Enter - выбор; F2 - добавить; F5 - печать'

@ 0,46 SAY 'Д. Рожд. "Д"-учет Д. Фл-мы '

CLEAR TYPEAHEAD

alter = ACHOICE(1,1,22,78,adoc,.T.,"USE_ACO",alter)

DO CASE

CASE oper = 13

DO ARCH_DIS

// flag=0

CASE fl = 1 && Устанавливается в USE_ACO для выбора первой буквы

alter=lask

CASE fl = 2

alter=1

CASE fl = 3

alter=ndra

CASE oper = -1

DO PASS_DIS

// flag=0

CASE oper = -4

str=' больных, стоящих на "Д"-учете'+lf;

+SPACE(19)+'по заболеванию';

+'"'+LTRIM(dis)+'"'+lf;

+SPACE(36)+' Д. Рожд. "Д"-учет Д. фл-мы '

// +SPACE(42)+' Д. Рожд. "Д"-учет Д. фл-мы '

DO PRINT_ADR WITH str

// flag=0

ENDCASE

ENDDO

SETCOLOR(s_c)

RESTSCREEN(0,0,24,79,buf)

SET RELATION TO

RETURN
PROCEDURE ARCH_DIS

** просмотр флюорограмм Диспансерного пациента из списка

LOCAL buf, s_c, nn, dt, k1, fl_del

LOCAL alt, buf1, s_c1, maxS, res, i, k, ndra2

PUBLIC str

buf=SAVESCREEN(0,0,24,79)

s_c=SETCOLOR("W+/B+")

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

SELECT 1

SEEK STR(aid[alter],6)

SELECT 3

SEEK STR(aid[alter],6)

IF !FOUND()

SELECT 1

s_c=SETCOLOR("W+/BR+")

@ 10,10 CLEAR TO 17,70

@ 10,10 TO 17,70

@ 12,19 SAY "У этого больного нет НИ ОДНОЙ флюорограммы!"

@ 13,28 SAY "УДАЛИТЬ ЕГО из списка?"

@ 15,28 SAY 'Enter - ДА "Esc" - НЕТ'

DO WHILE .T.

INKEY(0)

DO CASE

CASE LASTKEY() = 13

DO DELIT_DIS

EXIT

CASE LASTKEY() = 27

// flag=1

EXIT

ENDCASE

ENDDO

ELSE

k=LEN(adoc[alter])

//k=CTOD(SUBSTR(adoc[alter], k-7))

k=CTOD(SUBSTR(adoc[alter], k-10))

DO WHILE !EOF()

IF FLUO_DATE = k

EXIT

ENDIF

SKIP

ENDDO

DO BILD_STR

SELECT 1

flag=0

DO WHILE flag != 2

SETCOLOR("W/B")

@ 24,0 CLEAR TO 24,79

@ 24, 1 SAY '"Esc" - выход; F3 - редактировать; F5 - печать; F8 - удалить'

SETCOLOR("W+/BR+")

CLEAR TYPEAHEAD

str=MEMOEDIT(str,1,1,22,78,.F.,"BRO_F8")

blank=str+lf+lf

DO CASE

CASE flag = -4

DO PRINTER // печатать бланк

//flag=1

CASE flag = -2

DO EDIT // редактировать бланк

//flag=1

CASE flag = -7

DO DELIT_DIS

flag=2

ENDCASE

ENDDO

ENDIF

SETCOLOR(s_c)

RESTSCREEN(0,0,24,79,buf)

RETURN
PROCEDURE DELIT_DIS

LOCAL buf1, s_c1

buf1=SAVESCREEN(10,10,17,70)

s_c1=SETCOLOR("W+/R")

@ 10,10 CLEAR TO 17,70

@ 10,10 TO 17,70

@ 12,12 SAY "Вы действительно хотите удалить этого больного из списка ?"

@ 15,28 SAY 'Enter - ДА "Esc" - НЕТ'

DO WHILE .T.

INKEY(0)

DO CASE

CASE LASTKEY() = 13

SEEK STR(aid[alter],6)

REPLACE D_DATE WITH CTOD(""), DISPAN WITH 0

COMMIT

ADEL(adoc,alter) // убираем из списка

ADEL(afs,alter)

ADEL(adadr,alter)

ADEL(aid,alter)

ndra=ndra-1

EXIT

CASE LASTKEY() = 27

// flag=1

EXIT

ENDCASE

ENDDO

SETCOLOR(s_c1)

RESTSCREEN(10,10,17,70,buf1)

RETURN
PROCEDURE PASS_DIS

LOCAL alt, i, lname, fname, sname, bri, sx, adr1, ndra

LOCAL nph, cit, cont, buf, buf1, sav_col, d_d, maxS, maxl, fl_seek

buf1=SAVESCREEN(0,0,24,79)

sav_col=SETCOLOR("W+/B+")

SET KEY 27 TO ESC_GETA

flag=0

nStr=24

nCol=1

str_dw="Введите паспортные данные"

DO STR_24

DO WHILE .T.

@ 0,0 CLEAR TO 23,79

@ 0,0 TO 23,79 DOUBLE

SELECT 2

lname=SPACE(LEN(L_NAME))

fname=SPACE(LEN(F_NAME))

sname=SPACE(LEN(S_NAME))

bri=CTOD("")

sx="М"

//pi=630000

//pi=STR(pi,6)

//arr="Новосибирская"

SELECT 1

arr=arr+SPACE(LEN(ARREA)-LEN(arr))

adr1=SPACE(LEN(ADDRESS1))

nph=SPACE(LEN(PHONE))

d_d=dat

@ 1, 1 SAY "Фамилия" GET lname

@ 2, 1 SAY "Имя " GET fname

@ 3, 1 SAY "Отчество" GET sname

@ 4, 1 SAY "Дата рождения" GET bri

READ

IF flag = 2

SETCOLOR(sav_col)

RESTSCREEN(0,0,24,79,buf1)

SET KEY 27 TO

RETURN

ENDIF

lname=Rusup(lname)

fname=Rusup(fname)

sname=Rusup(sname)

SELECT 2

SET ORDER TO 3

SEEK lname-fname-sname-DTOS(bri)

SET ORDER TO 1

fl_seek=0

IF !FOUND()

fl_seek=1

@ 4, 25 SAY "Пол (м/ж)" GET sx

@ 5, 1 SAY "Почтовый индекс" GET pi

@ 5, 30 SAY "Область" GET arr

READ

IF flag = 2

SETCOLOR(sav_col)

RESTSCREEN(0,0,24,79,buf1)

SET KEY 27 TO

RETURN

ENDIF

IF sx="†" .OR. sx="¦" .OR. sx=":" .OR. sx=";"

sx=.F.

ELSE

sx=.T.

ENDIF

SELECT 5

SET FILTER TO GROUP="CITY" .AND. !DELETED()

cit=1->CITY

COUNT FOR GROUP="CITY" .AND. !DELETED() TO ndra

GOTO TOP

IF ndra = 0

SETCOLOR("W+/B")

@ 10,10 CLEAR TO 15,70

@ 10,10 TO 15,70

INKEY(delay)

flag=2

SET FILTER TO

SETCOLOR(sav_col)

RESTSCREEN(0,0,24,79,buf1)

SET KEY 27 TO

RETURN

ENDIF

buf=SAVESCREEN(6,1,22,78)

adoc2:=ARRAY(ndra)

aid2:=ARRAY(ndra)

maxl=0

FOR i=1 TO ndra

adoc2[i]=RTRIM(NAME)

aid2[i]=CODE

IF aid2[i] = cit

alt=i

ENDIF

maxl=IF(LEN(RTRIM(NAME))>maxl, LEN(RTRIM(NAME)), maxl)

SKIP

NEXT

maxS=IF(8+ndra<22, 8+ndra, 22)

@ 7,9 CLEAR TO maxS,10+maxl

@ 7,9 TO maxS,10+maxl

alt = ACHOICE(8,10,maxS-1,9+maxl,adoc2,.T.,"USE_PASS",alt)

RESTSCREEN(6,1,22,78,buf)

SET FILTER TO

IF alt = 0

SETCOLOR(sav_col)

RESTSCREEN(0,0,24,79,buf1)

SET KEY 27 TO

RETURN

ENDIF

cit=aid2[alt]

@ 6, 1 SAY "Город/село "+adoc2[alt]

READ

IF flag = 2

SETCOLOR(sav_col)

RESTSCREEN(0,0,24,79,buf1)

SET KEY 27 TO

RETURN

ENDIF

ENDIF

@ 9, 1 SAY 'Дата взятия на "Д"-учет' GET d_d

READ

IF fl_seek = 1

SELECT 2

iden=LASTREC()+1

APPEND BLANK

REPLACE ID WITH iden, L_NAME WITH lname, F_NAME WITH fname

REPLACE S_NAME WITH sname, SEX WITH sx, BR_DATE WITH bri

SELECT 1

APPEND BLANK

REPLACE ID WITH iden, POST WITH VAL(pi), ARREA WITH arr

REPLACE CITY WITH cit, ADDRESS1 WITH adr1, PHONE WITH nph

REPLACE D_DATE WITH d_d, DISPAN WITH cod

COMMIT

ELSE

SELECT 2

iden=ID

SELECT 1

SET FILTER TO

SEEK STR(iden,6)

REPLACE D_DATE WITH d_d, DISPAN WITH cod

COMMIT

ENDIF

INKEY(del1)

ENDDO

RETURN
PROCEDURE PRINT_ADR

PARAMETERS str

LOCAL i

FOR i=1 TO ndra

blank=blank+adadr[i]+lf

NEXT

blank=blank+lf+lf

DO PRINTER

RETURN

PROCEDURE PRINT_LIST

PARAMETERS str

LOCAL i

FOR i=1 TO ndra

blank=blank+adoc[i]+lf

NEXT

blank=blank+lf+lf

DO PRINTER

RETURN
PROCEDURE PRINTER

LOCAL s_c, buf, flp

flp=0

s_c=SETCOLOR("W+/R+")

buf=SAVESCREEN(20,5,24,75)

DO WHILE !PRINTREADY(1)

@ 20,5 CLEAR TO 24,75

@ 20,5 TO 24,75

@ 21,19 SAY "Заправьте в прнтер бумагу и включите его."

@ 22,15 SAY "Если горят ON LINE Ё READY, нажмите клавишу Enter."

@ 23,21 SAY 'Для отмены печати нажмите клавишу "Esc".'

INKEY(0)

IF LASTKEY() = 27

flp=1

KEYBOARD CHR(1)

INKEY(0)

EXIT

ENDIF

ENDDO

IF flp = 0

SET DEVICE TO PRINTER

@ 0,0 SAY blank

SET DEVICE TO SCREEN

ENDIF

SETCOLOR(s_c)

RESTSCREEN(20,5,24,75,buf)

RETURN

FUNCTION USE_PASS

** пользовательская функция ACHOICE

PARAMETERS reg, num, nst

** параметры и возвращаемая величина - стандартные

PRIVATE vv

lask=LASTKEY()

DO CASE

CASE lask = 27

vv=0

CASE lask = 13

vv=1

OTHERWISE

vv=2

ENDCASE

oper=vv

RETURN vv

FUNCTION USE_SET

** пользовательская функция ACHOICE

PARAMETERS reg, num, nst

PRIVATE vv

lask=LASTKEY()

DO CASE

CASE lask = 27

vv=0

alt_rep=0

CASE lask = 13

vv=1

flag=13

CASE lask = -1

flag=-1

KEYBOARD CHR(13)

CASE lask = -2

flag=-2

KEYBOARD CHR(13)

CASE lask = -7

flag=-7

KEYBOARD CHR(13)

OTHERWISE

vv=2

ENDCASE

//oper=vv

RETURN vv

FUNCTION USE_F7

PARAMETERS reg, num, nst

PRIVATE vv

lask=LASTKEY()

DO CASE

CASE lask = 27

vv=0

alt_rep=0

CASE lask = 13

vv=1

CASE lask = -6

flag=3

KEYBOARD CHR(13)

OTHERWISE

vv=2

ENDCASE

oper=vv

RETURN vv

FUNCTION RUSUP

PARAMETERS str

PRIVATE co_co

IF !EMPTY(str)

co_co = ASC(str)

DO CASE

CASE co_co >= ASC(" ") .AND. co_co <= ASC(" ")

co_co = co_co - 32

CASE co_co >= ASC("а") .AND. co_co <= ASC(" ")

co_co = co_co - 80

ENDCASE

str = CHR(co_co) + SUBSTR(str,2)

ENDIF

RETURN(str)
PROCEDURE PERIOD

LOCAL buf, sav_col

//datBeg=dat-6

//datEnd=dat

SET KEY 27 TO ESC_GETA

buf=SAVESCREEN(8,18,14,62)

sav_col=SETCOLOR("W+/RB")

@ 8,18 CLEAR TO 14,62

@ 8,18 TO 14,62 DOUBLE

@10,21 SAY "Выберите дату начала периода: " GET datBeg

@12,21 SAY "Выберите дату конца периода: " GET datEnd

READ

SET KEY 27 TO

RESTSCREEN(8,18,14,62,buf)

SETCOLOR(sav_col)

RETURN
PROCEDURE STR_24

** вывод сообщения в строке

LOCAL s_c

s_c=SETCOLOR(color)

@ nStr,0 CLEAR TO nStr,79

// @ nStr,nCol CLEAR TO nStr,nCol+LEN(str_dw)-1

@ nStr,nCol SAY str_dw

SETCOLOR(s_c)

RETURN

FUNCTION USE_ACO

** пользовательская функция ACHOICE

PARAMETERS reg, num, nst

PRIVATE vv

oper=0

fl=0

vv=2

lask=LASTKEY()

DO CASE

CASE lask = 27 // .OR. lask = -9

vv=0

oper=1

flag=2

CASE lask = 13

vv=1

oper=13

//CASE lask = 1

// vv=0

//fl=2

//CASE lask = 6

// vv=0

//fl=3

CASE lask <= -1 .AND. lask >= -9

oper=lask

vv=0

OTHERWISE

lask=Rusup(CHR(lask))

lask=ASCAN(afs,ASC(lask))

IF lask != 0

vv=0

fl=1

ENDIF

ENDCASE

RETURN vv

Приложение 3.

Технология электронного документооборота с использованием