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

+"Место работы - "+RTRIM(1->WORK)+lf;

+"Профессия - "+RTRIM(1->PROF)+lf;

+"DS при направлении - "+RTRIM(DS_INIT)+lf;

+"Описание флюорограммы - "+lf;

+STRTRAN(RESULT, CHR(141)+CHR(10), lf)+lf

@1,1 SAY "”. €. Ћ. - "+TRIM(2->L_NAME)+" "+TRIM(+2->F_NAME)+" ";

+TRIM(2->S_NAME)

age=YEAR(dat)-YEAR(2->BR_DATE)

IF MONTH(dat) < MONTH(2->BR_DATE)

age=age-1

ENDIF

IF MONTH(dat) = MONTH(2->BR_DATE)

IF DAY(dat) < DAY(2->BR_DATE)

age=age-1

ENDIF

ENDIF

@2,1 SAY "Дата рождения - "+DTOC(2->BR_DATE);

+" Возраст - "+LTRIM(STR(age))

@3,1 SAY "Место жительства  - "+RTRIM(1->ARREA)+", "+cit

@4,1 SAY " "+RTRIM(1->ADDRESS1)

@5,1 SAY "Категория - "+kat

@6,1 SAY "Место работы - "+RTRIM(1->WORK)

@7,1 SAY "Профессия - "+RTRIM(1->PROF)

@8,1 SAY "DS при направлении - "+RTRIM(DS_INIT)

@9,1 SAY "Описание флюорограммы - "

res=STRTRAN(RESULT, CHR(141)+CHR(10), CHR(13)+CHR(10))

i=10

k=AT(CHR(13)+CHR(10), res)

DO WHILE k !=0

@ i,1 SAY SUBSTR(res,1,k-1)

str=str+SUBSTR(res,1,k-1)

res=SUBSTR(res,k+2)

k=AT(CHR(13)+CHR(10), res)

i=i+1

ENDDO

str=str+res

@ i,1 SAY res

IF i > 14

INKEY(delay)

@ 15,1 CLEAR TO 22,78

ENDIF

flag=0

dt=ADD_DATE

@15,1 SAY "„ Дата дообследования- " GET dt

SET KEY 27 TO ESC_GETA

READ

SET KEY 27 TO

IF flag = 2

SETCOLOR(s_c)

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

RETURN

ENDIF

F4_fl=1

@16,1 SAY «Заключение после дообследования - "

@17,1 TO 21,78

ume=MEMOEDIT(RESUME,18,2,20,77,.T.)

IF F4_fl != 2

F4_fl=0

@24,0 SAY SPACE(60)

@22,1 SAY "Больной направлен (куда/к кому) - "

s_c1=SETCOLOR("W+/B")

SELECT 5

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

COUNT FOR GROUP="WHERE" .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, 22 SAY 'и заполните список БОЛЬНОЙ НАПРАВЛЕН'

INKEY(delay)

flag=2

SET FILTER TO

SETCOLOR(s_c)

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

RETURN

ENDIF

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

adoc1:=ARRAY(ndra1)

aid1:=ARRAY(ndra1)

maxl=0

FOR i=1 TO ndra1

adoc1[i]=RTRIM(NAME)

aid1[i]=CODE

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

SKIP

NEXT

maxl=IF(37+maxl<80, maxl, 42)

SETCOLOR("W+/B")

maxS=IF(22-ndra1>2, 22-ndra1, 2)

@ maxS,36 CLEAR TO 23,37+maxl

@ maxS,36 TO 23,37+maxl

alt=1

alt = ACHOICE(maxS+1,37,22,36+maxl,adoc1,.T.,"USE_PASS",alt)

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

SETCOLOR(s_c1)

SET FILTER TO

IF alt = 0

flag=2

SETCOLOR(s_c)

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

RETURN

ENDIF

dir=aid1[alt]

@ 22, 37 SAY SUBSTR(adoc1[alt], 1, 41)

REPLACE WHERE WITH dir

REPLACE ADD_DATE WITH dt, RESUME_2 WITH ume

REPLACE ADD_KEY WITH 2

COMMIT

ELSE

REPLACE ADD_DATE WITH dt, RESUME_2 WITH "HҐпўЄ "

REPLACE ADD_KEY WITH 3, WHERE WITH 0

COMMIT

F4_fl=0

@16,35 SAY '"Неявка "'

@17,1 CLEAR TO 21,78

ENDIF

DO BILD_STR

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")

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

IF flag = -4

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

flag=1

ELSE

flag=3

ENDIF

ENDDO

SETCOLOR(s_c)

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

RETURN
PROCEDURE ARCHIV

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

PRIVATE nn, j, atr

PUBLIC fl_per, cond, cond_cit, cit_cit, fl_ln, cond_wh, i, nnDoc, cit

---

PUBLIC adoc:={}, afs:={}, adadr:={}, aid:={}

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

alt=1

atr=1

ln=SPACE(30)

datBeg=dat-6

datEnd=dat

DO WHILE .T. // ndra = 0

SELECT 3

SET RELATION TO

SELECT 1

SET RELATION TO

SELECT 2

SET ORDER TO 1

SET RELATION TO STR(ID,6) INTO passport

SET RELATION TO STR(ID,6) INTO fluoteka ADDITIVE

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

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

i=0

ln=ln+SPACE(30-LEN(ln))

nnDoc=SPACE(7)

SETCOLOR("W+/BG+")

flag=0

str_dw='"Esc" – поиск без задания периода '

nStr=24

nCol=1

DO STR_24

DO PERIOD

fl_per=IF(flag = 2, .F., .T.)

nStr=24

nCol=1

str_dw='"Esc" – отказ от работы с архивом'

DO STR_24

CLEAR TYPEAHEAD

@ 10, 26 CLEAR TO 15, 54

@ 10, 26 TO 15, 54 DOUBLE

@ 11, 29 PROMPT " поиск по фамилии "

@ 12, 29 PROMPT " поиск по документу "

@ 13, 29 PROMPT "по населенному пункту"

@ 14, 29 PROMPT "по номеру флюорограммы"

MENU TO alt

IF alt = 0

flag=2

EXIT

ENDIF

flag=0

DO CASE

CASE alt = 1

nStr=24

nCol=1

str_dw='"Esc" – изменить период поиска в архиве'

DO STR_24

@ 20, 10 CLEAR TO 22, 70

@ 20, 10 TO 22, 70

@ 21, 16 SAY "Введите фамилию: " GET ln

SET KEY 27 TO ESC_GETA

READ

SET KEY 27 TO

IF flag != 2

IF !EMPTY(ln)

ln=Rusup(TRIM(LTRIM(ln)))

cond_wh="ln $ L_NAME"

cond="!DELETED()";

+IF(fl_per=.T.,".AND. 3->FLUO_DATE>=datBeg .AND. 3->FLUO_DATE<=datEnd","")

fl_ln=.T.

SET ORDER TO 3

SEEK ln

DO MAP_PREP

ENDIF

ENDIF

CASE alt = 2

nStr=24

nCol=1

str_dw='"Esc"

DO STR_24

@ 20, 10 CLEAR TO 22, 70

@ 20, 10 TO 22, 70

@ 21, 20 SAY "Введите номре паспорта св /рожд.: " GET nnDoc

SET KEY 27 TO ESC_GETA

READ

SET KEY 27 TO

IF flag != 2

nnDoc=VAL(nnDoc)

cond_wh="NUM_PASS=nnDoc"

cond="!DELETED()";

+IF(fl_per=.T.,".AND. 3->FLUO_DATE>=datBeg .AND. 3->FLUO_DATE<=datEnd","")

fl_ln=.F.

SET ORDER TO 2

SEEK STR(nnDoc,7)

DO MAP_PREP

ENDIF

CASE alt = 3

SELECT 2

SET ORDER TO 1

SELECT 5

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

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

@ 12, 20 SAY '

@ 13, 25 SAY '

INKEY(delay)

flag=2

EXIT

ENDIF

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

@ 6, 1 SAY "Выберите город или село из списка"

adoc1:=ARRAY(ndra)

aid1:=ARRAY(ndra)

maxl=0

FOR j=1 TO ndra

adoc1[j]=RTRIM(NAME)

aid1[j]=CODE

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

SKIP

NEXT

s_c1=SETCOLOR("W+/RB")

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

@ 7,9 CLEAR TO maxS,10+maxl

@ 7,9 TO maxS,10+maxl

CLEAR TYPEAHEAD

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

SETCOLOR(s_c1)

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

SET FILTER TO

IF atr != 0

cit_cit=aid1[atr]

cit=adoc1[atr]

cond_cit="1->CITY=cit_cit"

cond="!DELETED()";

+IF(fl_per=.T.,".AND. 3->FLUO_DATE>=datBeg .AND. 3->FLUO_DATE<=datEnd","")

DO PREP_3

ASORT(adoc)

FOR j=1 TO i

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

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

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

NEXT

ELSE

KEYBOARD CHR(13) // чтобы не сработало INKEY(delay)

ENDIF

SELECT 1

SET FILTER TO

SET RELATION TO

CASE alt = 4

nnDoc=SPACE(3)

serDoc=SPACE(2)

nStr=24

nCol=1

str_dw='"Esc" – изменить период поиска в архиве'

DO STR_24

@ 19, 10 CLEAR TO 22, 70

@ 19, 10 TO 22, 70

---

@ 20, 20 SAY "Введите номре флюорограммы: " GET nnDoc

@ 21, 20 SAY "Введите серию флюорограммы: " GET serDoc

SET KEY 27 TO ESC_GETA

READ

SET KEY 27 TO

IF flag != 2

nnDoc=VAL(nnDoc)

serDoc=VAL(serDoc)

cond="!DELETED() .AND. NUMBER=nnDoc .AND. SERIY=serDoc";

+IF(fl_per=.T.,".AND. FLUO_DATE>=datBeg .AND. FLUO_DATE<=datEnd","")

DO PREP_4

ASORT(adoc)

FOR j=1 TO i

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

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

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

NEXT

ENDIF

SELECT 3

SET FILTER TO

SET RELATION TO

ENDCASE

IF i = 0

@ 0,0 CLEAR TO 24,79

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

SETCOLOR("W+/R+")

buf1=SAVESCREEN(2,10,6,70)

@ 2, 10 CLEAR TO 6,70

@ 2, 10 TO 6,70

INKEY(delay)

// SET ORDER TO 1

SETCOLOR("W+/B+")

RESTSCREEN(2,10,6,70,buf1)

ELSE

alter=1

flag =0

ndra=i

DO WHILE flag != 2 .AND. ndra != 0

SETCOLOR("W+/B+")

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

SETCOLOR("W+/BR+")

@ 24,0 CLEAR TO 24,79

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

// @ 0,54 SAY "Д. Рожд. С. N Д. Фл-мы"

@ 0,50 SAY " Д. Рожд. С. N Д. Фл-мы"

SETCOLOR("W+/B+")

CLEAR TYPEAHEAD

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

DO CASE

CASE oper = 13

DO MAP_ARCH

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

alter=lask

CASE fl = 2

alter=1

CASE fl = 3

alter=ndra

CASE oper = -4

str="прошедших флюорографию" + " за период;

+DTOC(datBeg) + " Ї® " + DTOC(datEnd)

DO PRINT_LIST WITH str

ENDCASE

ENDDO

ENDIF

ENDDO

SELECT 2

SET ORDER TO 1

SET RELATION TO

SETCOLOR(s_c)

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

RETURN
PROCEDURE PREP_3

PRIVATE nn

PUBLIC adoc:={}, afs:={}, adadr:={}, aid:={}

SELECT 2

SET RELATION TO

SELECT 1

SET FILTER TO &cond_cit

GOTO TOP

i=0

IF !EOF()

SET RELATION TO STR(ID,6) INTO fluoteka

DO WHILE !EOF()

nn=ID

DO WHILE 3->ID = nn

IF &cond

i=i+1

SELECT 2

SEEK STR(nn,6)

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

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

AADD(adoc, k+SPACE(49-LEN(k));

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

+" "+LTRIM(STR(3->SERIY))+SPACE(2-LEN(LTRIM(STR(3->SERIY))));

+" "+LTRIM(STR(3->NUMBER))+SPACE(3-LEN(LTRIM(STR(3->NUMBER))));

+" "+DTOC(3->FLUO_DATE)+"\\"+STR(ID))

AADD(aid,ID)

AADD(adadr,TRIM(1->ARREA)+" "+TRIM(cit)+" "+TRIM(1->ADDRESS1))

AADD(afs,"")

ENDIF

SELECT 3

SKIP

ENDDO

SELECT 1

SKIP

ENDDO

ENDIF

RETURN
PROCEDURE PREP_4

PRIVATE nn

PUBLIC adoc:={}, afs:={}, adadr:={}, aid:={}

SELECT 2

SET ORDER TO 1

SET RELATION TO

SELECT 3

SET FILTER TO &cond

GOTO TOP

i=0

IF !EOF()

SET RELATION TO STR(ID,6) INTO pat_list

SET RELATION TO STR(ID,6) INTO passport ADDITIVE

DO WHILE !EOF()

i=i+1

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

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

AADD(adoc, k+SPACE(49-LEN(k));

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

+" "+LTRIM(STR(3->SERIY))+SPACE(2-LEN(LTRIM(STR(3->SERIY))));

+" "+LTRIM(STR(3->NUMBER))+SPACE(3-LEN(LTRIM(STR(3->NUMBER))));

+" "+DTOC(3->FLUO_DATE)+"\\"+STR(ID))

AADD(aid,ID)

// AADD(adadr,TRIM(1->ARREA)+" "+TRIM(cit)+" "+TRIM(1->ADDRESS1))

AADD(afs,"")

SKIP

ENDDO

ENDIF

RETURN
PROCEDURE MAP_PREP

PRIVATE nn

PUBLIC adoc:={}, afs:={}, adadr:={}, aid:={}

---

i=0

DO WHILE &cond_wh

nn= ID

DO WHILE 3->ID = nn

IF &cond

i=i+1

SELECT 5

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

cit=TRIM(NAME)

SELECT 2

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

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

AADD(adoc, k+SPACE(49-LEN(k));

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

+" "+LTRIM(STR(3->SERIY))+SPACE(2-LEN(LTRIM(STR(3->SERIY))));

+" "+LTRIM(STR(3->NUMBER))+SPACE(3-LEN(LTRIM(STR(3->NUMBER))));

+" "+DTOC(3->FLUO_DATE))

AADD(aid,ID)

AADD(adadr,TRIM(1->ARREA)+" "+TRIM(cit)+" "+TRIM(1->ADDRESS1))

AADD(afs,"")

ENDIF

SELECT 3

SKIP

ENDDO

SELECT 2

SKIP

ENDDO

RETURN
PROCEDURE MAP_ARCH

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

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

PUBLIC str

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

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

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

SELECT 3

//SELECT 2

//SET ORDER TO 1

SEEK STR(aid[alter],6)

k=LEN(adoc[alter])

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

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

DO WHILE !EOF()

IF 3->FLUO_DATE = k

EXIT

ENDIF

SKIP

ENDDO

SELECT 2

SET ORDER TO 1

SET RELATION TO

SET RELATION TO STR(ID,6) INTO passport

SEEK STR(aid[alter],6)

DO BILD_STR

flag=0

fl_del=0

DO WHILE flag != 2 .AND. fl_del = 0

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

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

s_c1=SETCOLOR("W+/R")

@ 10,10 CLEAR TO 16,70

@ 10,10 TO 16,70

DO WHILE .T.

INKEY(0)

DO CASE

CASE LASTKEY() = 13

// dt=SUBSTR(adoc[alter],LEN(adoc[alter])-8) // удалить флюорограмму

// nn=SUBSTR(adoc[alter],LEN(adoc[alter])-11,3)

dt=SUBSTR(adoc[alter],LEN(adoc[alter])-10) // удалить флюорограмму

nn=SUBSTR(adoc[alter],LEN(adoc[alter])-13,3)

k1=0

SELECT 3

// SEEK STR(aid[alter],6)

DO WHILE ID=aid[alter]

k1=k1+1

IF FLUO_DATE = CTOD(LTRIM(dt)) .AND. NUMBER = VAL(nn)

DELETE

EXIT

ENDIF

SKIP

ENDDO

IF k1 = 1

// SKIP -1

SELECT 1

DELETE

SELECT 2

DELETE

SELECT 3

ENDIF

fl_del=1

// flag=1

EXIT

CASE LASTKEY() = 27

// flag=1

EXIT

ENDCASE

ENDDO

SETCOLOR(s_c1)

RESTSCREEN(10,10,16,70,buf1)

ENDCASE

ENDDO

SELECT 2

SET RELATION TO STR(ID,6) INTO passport

SET RELATION TO STR(ID,6) INTO fluoteka ADDITIVE

SET ORDER TO 1

flag=1

SETCOLOR(s_c)

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

RETURN
PROCEDURE BILD_STR

LOCAL cit, kat, dep, gl, wh, pat, age, doct

SELECT 5

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

cit=RTRIM(NAME)

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

kat=RTRIM(NAME)

LOCATE FOR GROUP="DEPART" .AND. CODE=3->DEPART

dep=RTRIM(NAME)

LOCATE FOR GROUP="DOCTOR" .AND. CODE=3->DOCTOR

doct=RTRIM(NAME)

LOCATE FOR GROUP="WHERE" .AND. CODE=3->WHERE

wh=RTRIM(NAME)

LOCATE FOR GROUP="PATOL" .AND. CODE=3->PATOL

pat=RTRIM(NAME)

SELECT 3

gl=IF(GOAL=.F., "профилактическая", "диагностическая")

age=YEAR(dat)-YEAR(2->BR_DATE)

IF MONTH(dat) < MONTH(2->BR_DATE)

age=age-1

ENDIF

IF MONTH(dat) = MONTH(2->BR_DATE)

IF DAY(dat) < DAY(2->BR_DATE)

age=age-1

ENDIF

ENDIF

str=str+"‚а з "+doct

IF !EMPTY(ZAK_DS)

---

str=str+lf+lf+"Заключительный диагноз"+lf+ALLTRIM(ZAK_DS)+lf

ENDIF

RETURN
FUNCTION BRO

PARAMETERS mode_memo_ed, row, col

//LOCAL co_co

IF flag != 1

DO CASE

CASE LASTKEY() = 27

flag=2

KEYBOARD CHR(23) && Ctrl+W

CASE LASTKEY() = -4

flag=-4

KEYBOARD CHR(23) && Ctrl+W

CASE LASTKEY() = -2

flag=-2

KEYBOARD CHR(23) && Ctrl+W

ENDCASE

ELSE

flag=0

KEYBOARD CHR(1)

ENDIF

// RETURN(co_co)

RETURN
FUNCTION BRO_F8

PARAMETERS mode_memo_ed, row, col

LOCAL co_co

IF flag != 1

DO CASE

CASE LASTKEY() = 27

flag=2

KEYBOARD CHR(23) && Ctrl+W

CASE LASTKEY() = -4

flag=-4

KEYBOARD CHR(23) && Ctrl+W

CASE LASTKEY() = -2

flag=-2

KEYBOARD CHR(23) && Ctrl+W

CASE LASTKEY() = -7

flag=-7

KEYBOARD CHR(23) && Ctrl+W

ENDCASE

ELSE

flag=0

KEYBOARD CHR(1)

ENDIF

RETURN(co_co)
PROCEDURE EDIT

LOCAL alt, s_c, buf, s_c1, buf1, numb, ser, sel, k, qu, ar, dd

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

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

@ 0, 0 CLEAR TO 24, 79

@ 1, 1 TO 23, 78

alt=1

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

DO WHILE alt != 0

SETCOLOR("W+/BG+")

@ 8, 20 CLEAR TO 18, 60

@ 8, 20 TO 18, 60

@ 10, 30 PROMPT " паспортные данные"

@ 12, 30 PROMPT " данные обследования"

@ 14, 30 PROMPT "данные дообследования"

@ 16, 30 PROMPT " заключительный DS "

MENU TO alt

DO CASE

CASE alt = 1

DO PASSP

CASE alt = 2

sel=SELECT()

SELECT 3

dd=FLUO_DATE

numb=STR(NUMBER)

ser=STR(SERIY)

qu=STR(QUAL)

@ 8,20 CLEAR TO 20,60

@ 8,20 TO 20,60

@ 11,30 SAY "Дата " GET dd

@ 13,30 SAY "Номер" GET numb

@ 15,30 SAY "Серия" GET ser

@ 17,30 SAY "Число снимков" GET qu

@ 24,1 SAY "Отредактируйте дату, номер и серию флюорограммы"

READ

SELECT 5

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

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

GOTO TOP

IF ndra = 0

SETCOLOR("W+/B")

@ 8,10 CLEAR TO 20,70

@ 8,10 TO 20,70

INKEY(delay)

flag=2

SETCOLOR("W+/BG")

SET FILTER TO

RETURN

ENDIF

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

@ 24,0 CLEAR TO 24,79

ad:=ARRAY(ndra)

ai:=ARRAY(ndra)

maxl=0

FOR i=1 TO ndra

ad[i]=RTRIM(NAME)

ai[i]=CODE

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

SKIP

NEXT

SETCOLOR("W+/B")

@ 8,20 CLEAR TO 20,60

s_c=SETCOLOR("W+/RB")

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

@ 10,9 CLEAR TO maxS,10+maxl

@ 10,9 TO maxS,10+maxl

ar=ASCAN(ai,3->LABORANT)

ar = ACHOICE(11,10,maxS-1,9+maxl,ad,.T.,"USE_PASS",ar)

SETCOLOR(s_c)

SET FILTER TO

IF ar = 0

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

RETURN

ENDIF

SELECT 2

IF fluoteka->FLUO_DATE = pat_list->LAST_DATE

REPLACE LAST_DATE WITH dd

ENDIF

SELECT 3

REPLACE SERIY WITH VAL(ser), NUMBER WITH VAL(numb);

,QUAL WITH VAL(qu), LABORANT WITH ai[ar], FLUO_DATE WITH dd

COMMIT

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

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

adoc[alter]=k+SPACE(49-LEN(k));

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

+" "+LTRIM(STR(3->SERIY))+SPACE(2-LEN(LTRIM(STR(3->SERIY))));

+" "+LTRIM(STR(3->NUMBER))+SPACE(3-LEN(LTRIM(STR(3->NUMBER))));

+" "+DTOC(3->FLUO_DATE)

SELECT(sel)

IF 3->PATOL = 0

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

s_c1=SETCOLOR("W+/R")

@ 10,10 CLEAR TO 14,70

@ 10,10 TO 14,70

@ 12,21 SAY "Џ® н⮬г б­Ё¬Єг Ќ… ‚‚…„…ЌЋ § Є«о祭ЁҐ!"

INKEY(delay)

SETCOLOR(s_c1)

RESTSCREEN(10,10,14,70,buf1)

ELSE

DO FLUO

ENDIF

CASE alt = 3

IF 3->PATOL = 0

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

s_c1=SETCOLOR("W+/R")

---