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

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

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

READ

IF flag = 2

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

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

SET FILTER TO

SETCOLOR("W+/BG")

RETURN

ENDIF

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

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

adoc:=ARRAY(ndra)

aid:=ARRAY(ndra)

maxl=0

FOR i=1 TO ndra

adoc[i]=RTRIM(NAME)

aid[i]=CODE

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

SKIP

NEXT

s_c=SETCOLOR("W+/RB")

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

@ 7,9 CLEAR TO maxS,10+maxl

@ 7,9 TO maxS,10+maxl

alter=1

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

SETCOLOR(s_c)

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

SET FILTER TO

IF alter = 0

RETURN

ENDIF

cit=aid[alter]

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

@ 7, 1 SAY Адрес" GET adr1

@ 8, 1 SAY "Телефон" GET nph

@ 9, 1 SAY "Адрес родственников" GET adr2

@ 10, 1 SAY "(для инвалидов) группа инвалидности" GET grinv

@ 11, 1 SAY "Место работы" GET wrk

@ 12, 1 SAY "Профессия" GET pro

READ

IF flag = 2

RETURN

ENDIF

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

COUNT FOR GROUP="CONTING" .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, 20 SAY 'и заполните список «КАТЕГОРИЯ КОНТИНГЕНТА»'

INKEY(delay)

flag=2

SET FILTER TO

SETCOLOR("W+/BG")

RETURN

ENDIF

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

@ 13, 1 SAY "Выберите категорию контингента из списка"

adoc:=ARRAY(ndra)

aid:=ARRAY(ndra)

maxl=0

FOR i=1 TO ndra

adoc[i]=RTRIM(NAME)

aid[i]=CODE

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

SKIP

NEXT

s_c=SETCOLOR("W+/RB")

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

@ 14,9 CLEAR TO maxS,10+maxl

@ 14,9 TO maxS,10+maxl

alter=1

alter = ACHOICE(15,10,maxS-1,9+maxl,adoc,.T.,"USE_PASS",alter)

SETCOLOR(s_c)

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

SET FILTER TO

IF alter = 0

RETURN

ENDIF

cont=aid[alter]

@ 13, 1 SAY "Категория контингента  "+RTRIM(adoc[alter])

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

REPLACE NUM_PASS WITH VAL(npass)

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 ADDRESS2 WITH adr2, INVALID WITH grinv, WORK WITH wrk

REPLACE PROF WITH pro, CONTING WITH cont

COMMIT

ENDIF

fl_pass=1

INKEY(del1)

RETURN
PROCEDURE RESULT

** ввод доктором описания флюорограммы и заключения

LOCAL i, n, fil, str, nMes, dt, alt, dd

// dt=dat

flag=0

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

sav_col=SETCOLOR("W+/RB")

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 24,79 DOUBLE

s_c=SETCOLOR("W+/BG")

@ 8,25 CLEAR TO 14,55

---

@ 8,25 TO 14,55

@ 10, 34 SAY "Введите дату"

@ 12, 36 GET dat

READ

IF flag = 2

RETURN

ENDIF

SETCOLOR(s_c)

SELECT 2

SET RELATION TO

SELECT 3

COUNT FOR FLUO_DATE = dat .AND. (TEST = .T. .OR. KEY = .T.) TO ndra

IF ndra = 0

s_c=SETCOLOR("W+/R")

@ 8,10 CLEAR TO 14,70

@ 8,10 TO 14,70

@ 11, 17 SAY "‡  " + DTOC(dat)+ " нет ни одного не обработанного снимка !"

INKEY(delay)

SETCOLOR(sav_col)

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

RETURN

ENDIF

s_c=SETCOLOR("W+/B")

@ 8,15 CLEAR TO 18,65

@ 8,15 TO 18,65

@ 10, 20 SAY "Как будете вводить описания флюорограмм?"

alter=1

@ 12, 31 PROMPT "Описание флюорограмм"

@ 15, 31 PROMPT " Контрольное чтение "

MENU TO alter

SETCOLOR(s_c)

IF alter = 0

SETCOLOR(sav_col)

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

RETURN

ENDIF

fil="FLUO_DATE = dat .AND. KEY = .T."

str="ввода описания"

nMes=17

IF alter = 2

fil="FLUO_DATE = dat .AND. TEST = .T."

str="контрольного чтения"

nMes=13

ENDIF

// COUNT FOR &fil TO ndra

PUBLIC adoc:={}, aid:={} // adoc[ndra], aid[ndra]

SET RELATION TO STR(ID,6) INTO passport

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

SET FILTER TO &fil

IF ndra = 0

s_c=SETCOLOR("W+/R")

@ 8,8 CLEAR TO 14,72

@ 8,8 TO 14,72

@ 10, nMes SAY "За  " + DTOC(dat)+ " нет ни одного снимка для "+str+"!"

INKEY(delay)

SET FILTER TO

SETCOLOR(sav_col)

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

RETURN

ENDIF

ndra=0

SET INDEX TO

GOTO TOP

DO WHILE !EOF()

IF &fil

ndra=ndra+1

dd=LTRIM(STR(NUMBER))+" "+RTRIM(2->L_NAME)+" "+RTRIM(2->F_NAME);

+" "+RTRIM(2->S_NAME)+" "+DTOC(2->BR_DATE)

AADD(adoc,dd)

AADD(aid,RECNO())

ENDIF

SKIP

ENDDO

IF ndra = 0

s_c=SETCOLOR("W+/R")

@ 8,5 CLEAR TO 14,75

@ 8,5 TO 14,75

@ 8, nMes SAY "За " + DTOC(dat)+ " нет ни одного снимка для "+str+"!"

INKEY(delay)

SET FILTER TO

SET INDEX TO fluoteka

SETCOLOR(sav_col)

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

SET RELATION TO

RETURN

ENDIF

FOR i=1 TO ndra

adoc[i]=LTRIM(STR(NUMBER))+" "+RTRIM(2->L_NAME)+" "+RTRIM(2->F_NAME);

+" "+RTRIM(2->S_NAME)+" "+DTOC(2->BR_DATE)

aid[i]=RECNO()

SKIP

NEXT

SET INDEX TO fluoteka

alt=1

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

s_c=SETCOLOR("W+/RB")

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79 DOUBLE

nStr=24

nCol=1

str_dw='Выберите пациента ; "Esc" - выход'

DO STR_24

SETCOLOR("W+/RB")

@ 1,1 CLEAR TO 22,78

CLEAR TYPEAHEAD

alt = ACHOICE(1,1,22,78,adoc,.T.,"USE_PASS",alt)

SETCOLOR(s_c)

IF alt != 0

SELECT 3

GOTO aid[alt]

n=alt

DO IN_FLUO

IF flag != 2

ADEL(adoc,n)

ADEL(aid,n)

ndra=ndra-1

ELSE

flag=0

ENDIF

ELSE

EXIT

ENDIF

ENDDO

SELECT 3

SET FILTER TO

SET RELATION TO

SETCOLOR(sav_col)

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

RETURN
PROCEDURE IN_FLUO

LOCAL buf, buf1, i, cit, kat, wrk, pro, gl, dep, ult, ume

LOCAL add, pat, mes, tes, sig, dt, sav_col, ndra1, age

flag=0

add=.F.

ult=""

ume=""

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

sav_col=SETCOLOR("W+/B")

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79 DOUBLE

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)

SELECT 3

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

@1, 1 SAY RTRIM(2->L_NAME)+" "+RTRIM(2->F_NAME)+" "+RTRIM(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, 26 SAY "Возраст "+LTRIM(STR(age))

@2, 42 SAY "Паспорт (св/рожд.) "+LTRIM(STR(2->NUM_PASS))

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

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

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

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

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

@8, 1 SAY "Цель исследования "+gl

@9, 1 SAY "Направившее учреждение "+dep

@10, 1 SAY "DS при направлении"

@11, 1 SAY DS_INIT

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

@13, 1 TO 17,78

CLEAR TYPEAHEAD

ult=MEMOEDIT(RESULT,14,2,16,77,.T.)

@19, 1 TO 22,78

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

// SETCOLOR("W+/BG")

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79 DOUBLE

SELECT 5

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

pat=3->PATOL

COUNT FOR GROUP="PATOL" .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, 21 SAY 'и заполните список "ВЫЯВЛЕНА ПАТОЛОГИЯ"'

INKEY(delay)

flag=2

SET FILTER TO

SETCOLOR("W+/BG")

RETURN

ENDIF

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

@1, 1 SAY "Выявлена патология"

adoc1:=ARRAY(ndra1)

aid1:=ARRAY(ndra1)

maxl=0

FOR i=1 TO ndra1

adoc1[i]=RTRIM(NAME)

aid1[i]=CODE

IF aid1[i] = pat

alter=i

ENDIF

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

SKIP

NEXT

SETCOLOR("W+/RB")

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

@ 2,9 CLEAR TO maxS,10+maxl

@ 2,9 TO maxS,10+maxl

//alter=1

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

SETCOLOR("W+/B")

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

SET FILTER TO

IF alter = 0

// flag=1

flag=2

SETCOLOR(sav_col)

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

RETURN

ENDIF

pat=aid1[alter]

@ 1, 20 SAY RTRIM(adoc1[alter])

@ 2, 1 SAY "Нуждается в дообследовании?"

flag=2

DO WHILE flag = 2

alter=1

@ 2, 34 PROMPT " ­Ґв "

@ 2, 39 PROMPT " ¤  "

MENU TO alter

IF alter = 0

// flag=1

flag=2

SETCOLOR(sav_col)

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

RETURN

ENDIF

flag=0

IF alter = 2

add=.T.

dt=dat

@ 3, 1 SAY "Вызван на дообследование" GET dt

READ // Если Esc, то повторить запрос!

ENDIF

ENDDO

IF add=.T.

@ 4, 1 SAY "Сообщение отправлено"

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

mes=3->MESSAGE

COUNT FOR GROUP="MESSAGE" .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, 20 SAY 'и заполните список "СООБЩЕНИЕ ОТПРАВЛЕНО"'

INKEY(delay)

flag=2

SET FILTER TO

SETCOLOR("W+/BG")

RETURN

ENDIF

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

adoc1:=ARRAY(ndra1)

aid1:=ARRAY(ndra1)

maxl=0

FOR i=1 TO ndra1

adoc1[i]=RTRIM(NAME)

aid1[i]=CODE

IF aid1[i] = mes

alter=i

ENDIF

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

SKIP

NEXT

SETCOLOR("W+/RB")

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

@ 5,9 CLEAR TO maxS,10+maxl

@ 5,9 TO maxS,10+maxl

// alter=1

flag=0

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

SETCOLOR("W+/B")

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

SET FILTER TO

IF alter = 0

flag=2

// flag=1

SETCOLOR(sav_col)

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

RETURN

ENDIF

mes=aid1[alter]

---

@ 4, 23 SAY RTRIM(adoc1[alter])

ENDIF

@ 5, 1 SAY "Необходимо контрольное чтение?"

alter=1

@ 5, 34 PROMPT " ­Ґв "

@ 5, 39 PROMPT " ¤  "

MENU TO alter

IF alter = 0

// flag=1

flag=2

SETCOLOR(sav_col)

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

RETURN

ENDIF

tes=IF(alter = 2, .T., .F.)

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

sig=3->DOCTOR

COUNT FOR GROUP="DOCTOR" .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, 27 SAY 'и заполните список "ВРАЧИ"'

INKEY(delay)

flag=2

SET FILTER TO

SETCOLOR("W+/BG")

RETURN

ENDIF

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

adoc1:=ARRAY(ndra1)

aid1:=ARRAY(ndra1)

maxl=0

FOR i=1 TO ndra1

adoc1[i]=RTRIM(NAME)

IF aid1[i] = sig

alter=i

ENDIF

aid1[i]=CODE

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

SKIP

NEXT

SETCOLOR("W+/RB")

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

@ 7,9 CLEAR TO maxS,10+maxl

@ 7,9 TO maxS,10+maxl

//alter=1

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

SETCOLOR("W+/B")

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

SET FILTER TO

IF alter = 0

// flag=1

flag=2

SETCOLOR(sav_col)

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

RETURN

ENDIF

sig=aid1[alter]

@ 6, 6 SAY adoc1[alter]

SELECT 3

REPLACE PATOL WITH pat, KEY WITH .F.

REPLACE TEST WITH tes, ADDIT WITH add, DOCTOR WITH sig

REPLACE RESULT WITH ult, RESUME WITH ume

IF add = .T.

REPLACE ADDIT WITH .T. // нуждается в дообследовании

REPLACE ADD_DATE WITH dt, MESSAGE WITH mes

REPLACE ADD_KEY WITH 1

ENDIF

COMMIT

DO BILD_STR

blank=str+lf+lf

flag=0

DO WHILE flag != 2

SETCOLOR("W/BR")

@ 24,0 CLEAR TO 24,79

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

SETCOLOR("W/B")

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

IF flag = -4

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

flag=1

ENDIF

ENDDO

flag=1

RETURN
PROCEDURE ADDIT

LOCAL buf, sav_col, k, cit, fl_out, alt1

flag=0

datBeg=dat-6

datEnd=dat

DO PERIOD

IF flag = 2

flag=0

RETURN

ENDIF

SELECT 3

COUNT FOR !DELETED() .AND. FLUO_DATE >= datBeg;

.AND. FLUO_DATE <= datEnd .AND. ADD_KEY = 1 TO ndra

IF ndra = 0

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

s_c=SETCOLOR("W+/B")

@ 8,10 CLEAR TO 14,70

@ 8,10 TO 14,70

@ 10, 27 SAY "‡  ЇҐаЁ®¤ " + DTOC(datBeg)+" - "+DTOC(datEnd)

@ 11, 23 SAY "нет ни одного не просмотренного снимка !"

INKEY(delay)

SETCOLOR(s_c)

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

RETURN

ENDIF

SET FILTER TO !DELETED() .AND. FLUO_DATE >= datBeg;

.AND. FLUO_DATE <= datEnd .AND. ADD_KEY = 1

SELECT 3

GOTO TOP

SET RELATION TO STR(ID,6) INTO passport

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

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 3

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

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

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

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

+" "+LTRIM(STR(NUMBER))+"/"+LTRIM(STR(SERIY));

+SPACE(5-LEN(LTRIM(STR(NUMBER)))-LEN(LTRIM(STR(SERIY))));

+" "+DTOC(FLUO_DATE);

+"//"+TRIM(1->ARREA)+" "+TRIM(cit)+" "+TRIM(1->ADDRESS1);

+"\\"+STR(ID)

SKIP

NEXT

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

ndra=0

DO WHILE !EOF()

IF !DELETED() .AND. FLUO_DATE >= datBeg;

---

.AND. FLUO_DATE <= datEnd .AND. ADD_KEY = 1

ndra=ndra+1

SELECT 5

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

cit=TRIM(NAME)

SELECT 3

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

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

k=k+SPACE(37-LEN(k));

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

+" "+LTRIM(STR(NUMBER))+"/"+LTRIM(STR(SERIY));

+SPACE(5-LEN(LTRIM(STR(NUMBER)))-LEN(LTRIM(STR(SERIY))));

+" "+DTOC(FLUO_DATE);

+"//"+TRIM(1->ARREA)+" "+TRIM(cit)+" "+TRIM(1->ADDRESS1);

+"\\"+STR(RECNO()) //STR(ID)

AADD(adoc,k)

ENDIF

SKIP

ENDDO

IF ndra = 0

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

s_c=SETCOLOR("W+/B")

@ 8,10 CLEAR TO 14,70

@ 8,10 TO 14,70

@ 10, 27 SAY "За период " + DTOC(datBeg)+" - "+DTOC(datEnd)

@ 11, 23 SAY "нет ни одного непросмотренног снимка !"

INKEY(delay)

SETCOLOR(s_c)

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

SET RELATION TO

RETURN

ENDIF

ASORT(adoc)

FOR i=1 TO ndra

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

// adadr[i]=SUBSTR(adoc[i],AT("//",adoc[i])+2)

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

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

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

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

AADD(adadr,SUBSTR(adoc[i],AT("//",adoc[i])+2))

AADD(aid,VAL(SUBSTR(adadr[i], AT("\\",adadr[i])+2)))

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

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

NEXT

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

fl_out=0

alt1=1

// DO WHILE LASTKEY() != 27 .AND. ndra != 0

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

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

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

@ 24,1 SAY SPACE(78)

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

@ 0,38 SAY " Д. Рожден. Д. Вызова. N/Сер. Д. Фл-мы "

CLEAR TYPEAHEAD

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

IF flag= 2

fl_out=1

ENDIF

DO CASE

CASE oper = 13

alter=alt1

DO MAPPING

IF flag = 3 // этому пациенту дообследование ввели!

ADEL(adoc,alt1)

ADEL(afs,alt1)

ADEL(adadr,alt1)

ADEL(aid,alt1)

ndra=ndra-1

ENDIF

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

alt1=lask

CASE fl = 2

alt1=1

CASE fl = 3

alt1=ndra

CASE oper = -4

str="нуждается в дообследовании «+» за период с ";

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

DO PRINT_LIST WITH str

ENDCASE

ENDDO

SELECT 3

SET FILTER TO

SET RELATION TO

SETCOLOR(s_c)

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

RETURN
PROCEDURE MAPPING

LOCAL buf, s_c, str, cit, kat, ume, dir

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

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

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

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

SELECT 3

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

GOTO aid[alter]

SELECT 5

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

cit=RTRIM(NAME)

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

kat=RTRIM(NAME)

SELECT 3

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="Ф. И. О. - "+TRIM(2->L_NAME)+" "+TRIM(+2->F_NAME)+" ";

+TRIM(2->S_NAME)+lf;

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

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

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

+" "+RTRIM(1->ADDRESS1)+lf;

+"Категория - "+kat+lf;

---