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

@ 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 ADD_FLUO

ENDIF

CASE alt = 4

DO ZAK_DS

ENDCASE

ENDDO

DO BILD_STR

SETCOLOR(s_c)

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

RETURN
PROCEDURE ZAK_DS

LOCAL buf, s_c, ume, dir

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

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

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

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

SELECT 3

dt=DATE()

@1,1 SAY "Дата установления заключительного DS: " GET dt

SET KEY 27 TO ESC_GETA

flag=0

READ

SET KEY 27 TO

IF flag = 2

SETCOLOR(s_c)

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

RETURN

ENDIF

@2,1 SAY "Заключительный DS: "

@3,1 TO 22,78

//F4_fl=1

ume=IF(!EMPTY(ZAK_DS), ZAK_DS+lf, "")+DTOC(dt)+" "+lf

ume=MEMOEDIT(ume,4,2,21,77,.T.,"Hproblem")

//IF F4_fl = 2

// F4_fl=0

SELECT 3

str=str+lf+"Заключительный DS: "+ALLTRIM(ume)+lf

REPLACE ZAK_DS WITH ume

COMMIT

flag=2

SET FILTER TO

SETCOLOR(s_c)

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

RETURN

//ENDIF

//F4_fl=0

SETCOLOR(s_c)

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

RETURN
PROCEDURE PASSP

** ввод паспортных данных нового пациента 

LOCAL alt, i, lname, fname, sname, bri, ag, sx, wrk, adr1, pro

LOCAL adr2, nph, cit, grinv, arr, pi, cont, buf, buf1, sav_col

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

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

flag=0

@ 0,0 CLEAR TO 23,79

@ 0,0 TO 23,79 DOUBLE

nStr=24

nCol=1

str_dw="Отредактируйте паспортные данные"

DO STR_24

SELECT 2

lname=L_NAME

fname=F_NAME

sname=S_NAME

bri=BR_DATE

sx=IF(SEX=.T., "М", "Ж")

SELECT 1

pi=STR(POST)

arr=ARREA

adr1=ADDRESS1

adr2=ADDRESS2

nph=PHONE

grinv=INVALID

wrk=WORK

pro=PROF

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

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

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

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

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

RETURN

ENDIF

lname=Rusup(lname)

fname=Rusup(fname)

sname=Rusup(sname)

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

// SETCOLOR("W+/BG")

SET FILTER TO

SETCOLOR(sav_col)

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

RETURN

ENDIF

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

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

adoc1:=ARRAY(ndra)

aid1:=ARRAY(ndra)

maxl=0

FOR i=1 TO ndra

adoc1[i]=RTRIM(NAME)

aid1[i]=CODE

IF aid1[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,adoc1,.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)

RETURN

ENDIF

cit=aid1[alt]

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

@ 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

SETCOLOR(sav_col)

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

RETURN

ENDIF

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

cont=1->CONTING

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

INKEY(delay)

flag=2

// SETCOLOR("W+/BG")

SET FILTER TO

SETCOLOR(sav_col)

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

RETURN

ENDIF

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

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

adoc1:=ARRAY(ndra)

aid1:=ARRAY(ndra)

maxl=0

FOR i=1 TO ndra

adoc1[i]=RTRIM(NAME)

aid1[i]=CODE

IF aid1[i] = cont

alt=i

ENDIF

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

SKIP

NEXT

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

@ 14,9 CLEAR TO maxS,10+maxl

@ 14,9 TO maxS,10+maxl

alt = ACHOICE(15,10,maxS-1,9+maxl,adoc1,.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)

RETURN

ENDIF

cont=aid1[alt]

// npass=LTRIM(STR(2->NUM_PASS))

npass=2->NUM_PASS

READ

IF flag = 2

SETCOLOR(sav_col)

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

RETURN

ENDIF

SELECT 2

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

REPLACE NUM_PASS WITH npass

COMMIT

SELECT 3

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)

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

SELECT 1

REPLACE 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

SETCOLOR(sav_col)

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

RETURN
PROCEDURE FLUO

LOCAL buf, buf1, sav_col, i, ult, ume

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

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

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

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 24,79 DOUBLE

flag=0

add=.F.

ult=""

ume=""

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

sav_col=SETCOLOR("W+/RB")

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

@2, 1 TO 10,78

ult=MEMOEDIT(3->RESULT,3,2,9,77,.T.,"Hproblem")

@12, 1 SAY "Заключение"

@13, 1 TO 21,78

ume=MEMOEDIT(3->RESUME,14,2,20,77,.T.,"Hproblem")

SELECT 5

SETCOLOR("W+/BG")

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 24,79 DOUBLE

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

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

alt=i

ENDIF

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

SKIP

NEXT

s_c=SETCOLOR("W+/RB")

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

@ 2,9 CLEAR TO maxS,10+maxl

@ 2,9 TO maxS,10+maxl

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

SETCOLOR(s_c)

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

SET FILTER TO

IF alt = 0

flag=2

SETCOLOR(sav_col)

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

RETURN

ENDIF

pat=aid1[alt]

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

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

flag=2

DO WHILE flag = 2

alt=1

@ 2, 34 PROMPT " ­Ґв "

@ 2, 39 PROMPT " ¤  "

MENU TO alt

IF alt = 0

flag=2

SETCOLOR(sav_col)

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

RETURN

ENDIF

flag=0

IF alt = 2

add=.T.

// dt=dat

dt=3->ADD_DATE

ENDIF

ENDDO

IF add=.T.

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

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

alt=i

ENDIF

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

SKIP

NEXT

s_c=SETCOLOR("W+/RB")

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

@ 5,9 CLEAR TO maxS,10+maxl

@ 5,9 TO maxS,10+maxl

flag=0

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

SETCOLOR(s_c)

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

SET FILTER TO

IF alt = 0

flag=2

SETCOLOR(sav_col)

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

RETURN

ENDIF

mes=aid1[alt]

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

ENDIF

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

alt=1

@ 5, 34 PROMPT " нет "

@ 5, 39 PROMPT " да "

MENU TO alt

IF alt = 0

flag=2

SETCOLOR(sav_col)

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

RETURN

ENDIF

tes=IF(alt = 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

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] = sig

alt=i

ENDIF

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

SKIP

NEXT

s_c=SETCOLOR("W+/RB")

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

@ 7,9 CLEAR TO maxS,10+maxl

@ 7,9 TO maxS,10+maxl

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

SETCOLOR(s_c)

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

SET FILTER TO

IF alt = 0

flag=2

SETCOLOR(sav_col)

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

RETURN

ENDIF

sig=aid1[alt]

SELECT 3

REPLACE PATOL WITH pat, KEY WITH .F.

REPLACE ADDIT WITH add, DOCTOR WITH sig

REPLACE RESULT WITH ult, RESUME WITH ume

// REPLACE TEST WITH tes

COMMIT

IF add = .T.

REPLACE ADDIT WITH .T.

REPLACE ADD_DATE WITH dt, MESSAGE WITH mes

IF ADD_KEY = 0

REPLACE ADD_KEY WITH 1

ENDIF

COMMIT

ENDIF

SETCOLOR(sav_col)

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

RETURN
PROCEDURE ADD_FLUO

LOCAL buf, s_c, ume, dir

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

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

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

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

SELECT 3

dt=ADD_DATE

SET KEY 27 TO ESC_GETA

flag=0

READ

SET KEY 27 TO

IF flag = 2

SETCOLOR(s_c)

---

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

RETURN

ENDIF

F4_fl=1

ume=IF(EMPTY(RESUME_2), RESUME, RESUME_2)

ume=MEMOEDIT(ume,4,2,10,77,.T.,"Hproblem")

IF F4_fl = 2

F4_fl=0

SELECT 3

str=str+lf+

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

REPLACE ADD_KEY WITH 3, WHERE WITH 0

COMMIT

flag=2

SET FILTER TO

SETCOLOR(s_c)

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

RETURN

ENDIF

F4_fl=0

@24,0 SAY SPACE(60)

s_c1=SETCOLOR("W+/B")

SELECT 5

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

dir=3->WHERE

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

INKEY(delay)

flag=2

SET FILTER TO

SETCOLOR(s_c)

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

RETURN

ENDIF

buf1=SAVESCREEN(2,36,23,78)

adoc1:=ARRAY(ndra1)

aid1:=ARRAY(ndra1)

maxl=0

FOR i=1 TO ndra1

adoc1[i]=RTRIM(NAME)

aid1[i]=CODE

IF aid1[i] = dir

alt=i

ENDIF

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

SKIP

NEXT

SETCOLOR("W+/B")

maxl=IF(maxl>41, 41, maxl )

maxS=IF(13+ndra1>22, 22,13+ndra1 )

@ 12,36 CLEAR TO 13+ndra1,37+maxl

@ 12,36 TO 13+ndra1,37+maxl

alt = ACHOICE(13,37,12+ndra1,36+maxl,adoc1,.T.,"USE_PASS",alt)

RESTSCREEN(2,36,23,78,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]

@ 12, 37 SAY adoc1[alt]

SELECT 3

REPLACE WHERE WITH dir

REPLACE ADD_DATE WITH dt, RESUME_2 WITH ume

REPLACE ADD_KEY WITH 2

COMMIT

SETCOLOR("W/B")

@ 24,0 CLEAR TO 24,79

@ 24, 1 SAY '"Esc" - ўл室'

//INKEY()

//DO WHILE LASTKEY() != 27

//ENDDO

INKEY(0)

SETCOLOR(s_c)

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

RETURN
PROCEDURE REPORT

LOCAL buf, s_c, ndra1, i, j, dd

PUBLIC rep, alt_rep

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

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

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

flag=0

datBeg=dat-6

datEnd=dat

DO PERIOD

IF flag = 2

SETCOLOR(s_c)

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

RETURN

ENDIF

SELECT 3

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

// .AND. FLUO_DATE <= datEnd

GOTO TOP

dd=7

PUBLIC aid1[dd], adoc1[dd]

aid1[1]=" Обследование населения "

aid1[2]="Выявление туберкулеза и онкозаболеваний легких"

aid1[3]="Число не обследованных более года и двух лет "

aid1[4]=" Местро проживания – категории "

aid1[5]=" Категория – места проживания "

aid1[6]=" Список необследованных по населенным пунктам "

aid1[7]=" Количество снимков, сделанныхз лаборантами "

adoc1[1]="COMMON"

adoc1[2]="LUNGS"

adoc1[3]="QULIT"

adoc1[4]="CATEGOR"

adoc1[5]="CITY"

adoc1[6]="LISTING"

adoc1[7]="LABOR_N"

ndra1=LEN(aid1[2])

s_c=SETCOLOR("W+/BG")

@ 24,0 CLEAR TO 24,79

@ 24, 1 SAY '"Esc" - выход, "ENTER" – выбор отчета , F7 – все отчеты'

SETCOLOR("W+/BR")

@ 10,10 CLEAR TO 11+dd,70

@ 10,10 TO 11+dd,70

alt_rep=1

DO WHILE alt_rep != 0

flag=0

CLEAR TYPEAHEAD

alt_rep = ACHOICE(11,16,10+dd,15+ndra1,aid1,.T.,"USE_F7",alt_rep)

IF alt_rep != 0 .OR. flag =3

IF flag != 3 .AND. flag != 2

rep=aid1[alt_rep]

j=adoc1[alt_rep]

DO &j

ELSE

IF flag != 2

FOR i=1 TO dd

j=adoc1[i]

alt_rep=i

DO &j

NEXT

ENDIF

ENDIF

ENDIF

ENDDO

SETCOLOR(s_c)

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

SELECT 5

SET FILTER TO

SELECT 3

SET FILTER TO

// SET RELATION TO

RETURN
PROCEDURE COMMON

LOCAL buf, s_c, i, str, ndra, prof, diag, addk, fact

// PUBLIC

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

---

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

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

SELECT 5

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

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

PUBLIC arr_cod[ndra], arr_nam[ndra], arr_qua[ndra]

GOTO TOP

FOR i=1 TO ndra

arr_cod[i]=CODE

arr_nam[i]=NAME

arr_qua[i]=0

SKIP

NEXT

SELECT 3

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

.AND. FLUO_DATE <= datEnd

GOTO TOP

prof=0

diag=0

addk=0

fact=0

DO WHILE !EOF()

IF GOAL = .T.

diag=diag+1

ELSE

prof=prof+1

ENDIF

addk=IF(ADD_KEY = 0, addk, addk+1)

fact=IF(ADD_KEY = 2, fact+1, fact)

IF GOAL = .F. // профилактическое обследование

i=ASCAN(arr_cod,PATOL)

IF i != 0

arr_qua[i]=arr_qua[i]+1

ENDIF

ENDIF

SKIP

ENDDO

str=SPACE(35)+hosp+" "+addr+lf+lf;

+"Ћ ’ — … ’ "+'"'+ALLTRIM(aid1[alt_rep])+'"'+" "+lf;

+SPACE(24)+"за период с "+DTOC(datBeg)+" Ї® "+DTOC(datEnd)+lf+lf;

+"Число осмотров диагностических ................ - "+LTRIM(STR(diag))+lf;

+"Число осмотров профилактических ............... - "+LTRIM(STR(prof))+lf;

+"Из числа осмотренных нуждалось в дообследовании - "+LTRIM(STR(addk))+lf;

+" Дообследовано - "+LTRIM(STR(fact))+lf;

+"Впервые выявлено"+lf

FOR i=1 TO ndra

str=str+TRIM(SUBSTR(arr_nam[i],1,47));

+REPLICATE(".",47-LEN(TRIM(arr_nam[i])));

+" - "+LTRIM(STR(arr_qua[i]))+lf

NEXT

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

ENDIF

ENDDO

SET FILTER TO

SETCOLOR(s_c)

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

RETURN
PROCEDURE LUNGS

LOCAL buf, s_c, alt, i, str, prof, addk, fact, t1, t2, t3, t4

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

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

@ 0,0 CLEAR TO 24,79

@ 0,0 TO 23,79

prof=0

addk=0

fact=0

t1=0

t2=0

t3=0

t4=0

KEYBOARD CHR(1)

INKEY(0)

SETCOLOR("W/B")

@ 24,0 CLEAR TO 24,79

@ 24, 1 SAY '"Esc" - выход "Enter" - ввод'

SETCOLOR("W/BR")

@ 6,10 CLEAR TO 16,70

@ 6,10 TO 16,70

@ 8, 15 SAY "Дообследовано у фтизиатра  - " GET t1

@ 10, 15 SAY "Выявлено активного туберкулеза  - " GET t2

@ 12, 15 SAY "Дообследовано у онколога  - " GET t3

@ 14, 15 SAY "Выявлено онкобольных - " GET t4

SET KEY 27 TO ESC_GETA

flag=0

READ

SET KEY 27 TO

IF flag = 2

SETCOLOR(s_c)

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

KEYBOARD CHR(1)

RETURN

ENDIF

SELECT 3

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

.AND. FLUO_DATE <= datEnd

GOTO TOP

DO WHILE !EOF()

IF GOAL = .F.

prof=prof+1

ENDIF

addk=IF(WHERE = 1, addk+1, addk) //­ направлено к фтизиатру

fact=IF(WHERE = 2, fact+1, fact) //­ направлено к онкологу

SKIP

ENDDO

str=SPACE(35)+hosp+" "+addr+lf+lf;

+"О Т Ч Е Т "+'"'+ALLTRIM(aid1[alt_rep])+'"'+" "+lf;

+SPACE(24)+"за период "+DTOC(datBeg)+" Ї® "+DTOC(datEnd)+lf+lf;

+"Число осмотренных профилактических ............ - "+LTRIM(STR(prof))+lf;

+"Направлено к фтизиатру - "+LTRIM(STR(addk))+lf;

+SPACE(15)+"Дообследовано у фтизиатра  ... - "+LTRIM(STR(t1))+lf;

+SPACE(15)+"Выявлено активного туберкулеза  - "+LTRIM(STR(t2))+lf;

---