Смекни!
smekni.com

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

REPORT FORM OTCH.FRM TO FILE OTCH.TXT PLAIN

USE

corr_ttl("OTCH.TXT",dep_name,DTOC(_DATE_FROM),DTOC(_DATE_TILL))

link2("OTCH.TXT",OT2)

RENAME OTCH.TXT TO &OT2

link2(OT2,OT2D1)

IF dep#2.AND.dep#11

link2(OT2,OT2D2)

ENDIF

ELSEIF _p=2

********************* КВАРТАЛЬНЫЕ ОТЧЕТЫ **********************

OT1="OTCH"+ALLTRIM(STR(_OTCH))+".FRM"

OT2="OTCH"+ALLTRIM(STR(_OTCH))+".TXT"

IF f_FRM()

DO CASE

*-------------------------------------------------

CASE _OTCH=1

*-------------------------------------------------

SELECT DIA66

SET RELATION TO SHIFR INTO BUFF8

SELECT karta

SET RELATION TO NUM_IB INTO DIA66

GO TOP

DO show_st

DO WHILE !EOF()

IF IF(dep=0,.T.,IF(dep=KARTA->DEPARTMENT,.T.,.F.)).AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_END<=_DATE_TILL.AND.;

DIA66->KOD1="1"

state() && Поиск паталого-анатомического диагноза (если он есть)

_SHIFR=DIA66->SHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

ENDIF

IF KARTA->OLD>10 && СТАРШЕ 14 лет

IF KARTA->END1=1.OR.KARTA->END1=2

REPLACE COUNT1 WITH COUNT1+1 && ВЫПИСАНО

REPLACE A1 WITH A1+KARTA->ALL_DAY && ПРОВЕДЕНО ИМИ ДНЕЙ

ELSE && KARTA->END1=3

REPLACE A2 WITH A2+1 && УМЕРЛО

ENDIF

ELSE && KARTA->OLD<=10 && ДО 14 лет

IF KARTA->END1=1.OR.KARTA->END1=2

REPLACE COUNT2 WITH COUNT2+1 && ВЫПИСАНО

REPLACE A3 WITH A3+KARTA->ALL_DAY && ПРОВЕДЕНО ИМИ ДНЕЙ

IF KARTA->OLD<7

REPLACE A4 WITH A4+1 && ДЕТИ ДО 1 года

ENDIF

ELSE && KARTA->END1=3

REPLACE A5 WITH A5+1 && УМЕРЛО

IF KARTA->OLD<7

REPLACE A6 WITH A6+1 && ДЕТИ ДО 1 года

ENDIF

ENDIF

ENDIF

SELECT KARTA

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

IF INKEY(0.01)=27

IF yesno(14," Прервать обработку ? ")=1

SELECT (sel)

RETURN 0

ENDIF

ENDIF

ENDDO

SET RELATION TO

SELECT DIA66

SET RELATION TO

SELECT BUFF8

PRIVATE _COUNT1,_COUNT2,_A1,_A2,_A3,_A4,_A5,_A6

SUM COUNT1,COUNT2,A1,A2,A3,A4,A5,A6 TO ;

_COUNT1,_COUNT2,_A1,_A2,_A3,_A4,_A5,_A6

APPEND BLANK

REPLACE NUMBER WITH "|",NAMECL WITH "Всего :",;

SHIFRL WITH "0000",SHIFRR WITH "999 ",;

COUNT1 WITH _COUNT1,COUNT2 WITH _COUNT2,A1 WITH _A1,;

A2 WITH _A2,A3 WITH _A3,A4 WITH _A4,A5 WITH _A5,A6 WITH _A6

grad() && РАЗБИЕНИЕ БОЛЕЗНЕЙ НА КЛАССЫ

grad1() && РАЗБИЕНИЕ КЛАССОВ НА ГРУППЫ

*-------------------------------------------------

CASE _OTCH=2.OR._OTCH=5

*-------------------------------------------------

SELECT DIA66

SET RELATION TO SHIFR INTO BUFF8

SELECT KARTA

SET RELATION TO NUM_IB INTO DIA66

GO TOP

DO show_st

DO WHILE !EOF()

IF IF(dep=0,.T.,IF(dep=KARTA->DEPARTMENT,.T.,.F.)).AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_END<=_DATE_TILL.AND.;

(KARTA->DATE_IN-KARTA->DATE_B+piece(KARTA->HOUR_B,KARTA->MINS_B,;

KARTA->HOUR_IN,KARTA->MINS_IN))<7.AND.DIA66->KOD1="1"

state() && Поиск паталого-анатомического диагноза (если он есть)

_SHIFR=DIA66->SHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

ENDIF

IF LEFT(KARTA->MASSA,2)="00".OR.LEFT(KARTA->MASSA,2)=" ".AND.;

VAL(RIGHT(KARTA->MASSA,3))>500

REPLACE A1 WITH A1+1

IF KARTA->END1=3

REPLACE A2 WITH A2+1

IF (KARTA->DATE_END-KARTA->DATE_B+;

piece(KARTA->HOUR_B,KARTA->MINS_B,;

KARTA->HOUR_END,KARTA->MINS_END))<7

REPLACE A3 WITH A3+1

ENDIF

ENDIF

ELSE

REPLACE A4 WITH A4+1

IF KARTA->END1=3

REPLACE A5 WITH A5+1

IF (KARTA->DATE_END-KARTA->DATE_B+;

piece(KARTA->HOUR_B,KARTA->MINS_B,;

KARTA->HOUR_END,KARTA->MINS_END))<7

REPLACE A6 WITH A6+1

ENDIF

ENDIF

ENDIF

SELECT KARTA

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

SET RELATION TO

SELECT DIA66

SET RELATION TO

SELECT BUFF8

PRIVATE _COUNT1,_COUNT2,_A1,_A2,_A3,_A4,_A5,_A6

SUM COUNT1,COUNT2,A1,A2,A3,A4,A5,A6 TO ;

_COUNT1,_COUNT2,_A1,_A2,_A3,_A4,_A5,_A6

APPEND BLANK

REPLACE NUMBER WITH "|",NAMECL WITH "Всего детей :",;

COUNT1 WITH _COUNT1,COUNT2 WITH _COUNT2,A1 WITH _A1,;

A2 WITH _A2,A3 WITH _A3,A4 WITH _A4,A5 WITH _A5,A6 WITH _A6

grad1() && РАЗБИЕНИЕ БОЛЕЗНЕЙ НА ГРУППЫ

SUM COUNT1,COUNT2,A1,A2,A3,A4,A5,A6 TO ;

_COUNT1,_COUNT2,_A1,_A2,_A3,_A4,_A5,_A6 FOR NUMBER="-"

GO TOP

_COUNT1=COUNT1-_COUNT1

_COUNT2=COUNT2-_COUNT2

_A1=A1-_A1

_A2=A2-_A2

_A3=A3-_A3

_A4=A4-_A4

_A5=A5-_A5

_A6=A6-_A6

APPEND BLANK

REPLACE NUMBER WITH "-",SHIFR WITH "774 ";

NAMECL WITH "Прочие болезни плода и новорожденного",;

COUNT1 WITH _COUNT1,COUNT2 WITH _COUNT2,A1 WITH _A1,;

A2 WITH _A2,A3 WITH _A3,A4 WITH _A4,A5 WITH _A5,A6 WITH _A6

*-------------------------------------------------

CASE _OTCH=3

*-------------------------------------------------

SELECT OP66

SET RELATION TO NUM_IB INTO KARTA, TO SHIFR INTO BUFF8

GO TOP

DO show_st && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

DO WHILE !EOF()

IF IF(dep=0,.T.,IF(dep=KARTA->DEPARTMENT,.T.,.F.)).AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_END<=_DATE_TILL

_SHIFR_ILL=OP66->SHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR_ILL

catalog(@_SHIFR_ILL,@txt)

REPLACE NAME WITH ALLTRIM(txt)

ENDIF

REPLACE COUNT1 WITH COUNT1+1

IF KARTA->OLD<=10

REPLACE COUNT2 WITH COUNT2+1

ENDIF

IF KARTA->END1=3

REPLACE A1 WITH A1+1

ENDIF

SELECT OP66

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

SET RELATION TO

summ() && Суммирование по классам операций

*-------------------------------------------------

CASE _OTCH=4

*-------------------------------------------------

SELECT BUFF8

APPEND BLANK

REPLACE NUMBER WITH "1"

REPLACE NAME WITH "ВЫПИСАНО"

APPEND BLANK

REPLACE NUMBER WITH "2"

REPLACE NAME WITH "ПЕРЕВЕДЕНО"

APPEND BLANK

REPLACE NUMBER WITH "3"

REPLACE NAME WITH "УМЕРЛО"

SELECT KARTA

GO TOP

PRIVATE OT1D1,OT2D1

DO show_st && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

DO WHILE !EOF()

IF IF(dep=0,.T.,IF(dep=KARTA->DEPARTMENT,.T.,.F.)).AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_END<=_DATE_TILL

SELECT BUFF8

GOTO KARTA->END1

pole=FIELD(8+KARTA->OLD)

REPLACE &pole WITH &pole+1 && ВОЗРАСТ БОЛЬНЫХ

pole=FIELD(19+KARTA->RAION)

REPLACE &pole WITH &pole+1 && РАЙОН ПРОЖИВАНИЯ

REPLACE COUNT1 WITH COUNT1+KARTA->ALL_DAY && ПРОВЕДЕНО ДНЕЙ

REPLACE COUNT2 WITH COUNT2+1 && ВСЕГО БОЛЬНЫХ

SELECT KARTA

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

OT1D1="OTCH"+ALLTRIM(STR(_OTCH))+"1"+".FRM" && OTCH*1.FRM

OT2D1="OTCH"+ALLTRIM(STR(_OTCH))+"1"+".TXT" && OTCH*1.TXT

SELECT BUFF8

REPORT FORM &OT1D1 TO FILE &OT2D1 PLAIN

*-------------------------------------------------

CASE _OTCH=6.OR._OTCH=8

*-------------------------------------------------

SELECT DIA66

SET RELATION to NUM_IB into KARTA, TO SHIFR INTO BUFF8

GO TOP

DO show_st && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

DO WHILE !EOF()

IF IF(dep=0,.T.,IF(dep=KARTA->DEPARTMENT,.T.,.F.)).AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_END<=_DATE_TILL.AND.;

DIA66->KOD1="1"

count=state() && Поиск паталого-анатомического диагноза (если он есть)

_SHIFR=DIA66->SHIFR

SELECT BUFF8

IF _OTCH=6.AND.KARTA->END1=2

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

ENDIF

REPLACE COUNT1 WITH COUNT1+1

ELSEIF _OTCH=8.AND.KARTA->END1=3

pole=FIELD(8+KARTA->POL)

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

mkb(1,1,@_SHIFR,@txt)

REPLACE NAME WITH txt

ENDIF

REPLACE &pole WITH &pole+1

ENDIF

SELECT DIA66

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

SET RELATION TO

grad() && РАЗБИЕНИЕ БОЛЕЗНЕЙ НА КЛАССЫ

*------------------------------------------------

CASE _OTCH=7

*------------------------------------------------

SELECT KARTA

SET RELATION TO SHIFR INTO BUFF8

GO TOP

DO show_st && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

DO WHILE !EOF()

IF IF(dep=0,.T.,IF(dep=KARTA->DEPARTMENT,.T.,.F.)).AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_END<=_DATE_TILL

_SHIFR=KARTA->SHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

mkb(1,1,@_SHIFR,@txt)

REPLACE NAME WITH ALLTRIM(txt)

ENDIF

REPLACE A3 WITH A3+1 && Всего

IF KARTA->OLD<=7 && До 1 года

REPLACE A2 WITH A2+1

IF KARTA->OLD<=2 && До 28 дней

REPLACE A1 WITH A1+1

ENDIF

ENDIF

pole=FIELD(11+KARTA->WHY)

REPLACE &pole WITH &pole+1 && Причины направления

pole=FIELD(15+KARTA->DIRECT1)

REPLACE &pole WITH &pole+1 && Направляющие организации

SELECT KARTA

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

SET RELATION TO

numb_STR() && НУМЕРАЦИЯ СТРОК

*------------------------------------------------

CASE (_OTCH=9.AND.dep#14).OR._OTCH=10.OR._OTCH=12

*------------------------------------------------

SELECT DIA66

SET RELATION to NUM_IB into KARTA, TO SHIFR INTO BUFF8

GO TOP

PRIVATE OT1D1,OT2D1,OT1D2,OT2D2

DO show_st && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

DO WHILE !EOF()

IF IF(dep=0,.T.,IF(dep=KARTA->DEPARTMENT,.T.,.F.)).AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_END<=_DATE_TILL.AND.;

KARTA->END1=3.AND.DIA66->KOD1="1"

IF (_OTCH=9.OR.;

_OTCH=10.AND.;

(KARTA->DATE_END-KARTA->DATE_B+;

piece(KARTA->HOUR_B,KARTA->MINS_B,KARTA->HOUR_END,KARTA->MINS_END)<7).OR.;

_OTCH=12.AND.;

(KARTA->DATE_END-KARTA->DATE_IN+;

piece(KARTA->HOUR_IN,KARTA->MINS_IN,KARTA->HOUR_END,KARTA->MINS_END)<1))

count=state() && Поиск паталого-анатомического диагноза (если он есть)

_SHIFR=DIA66->SHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

mkb(1,1,@_SHIFR,@txt)

REPLACE NAME WITH txt

ENDIF

pole=FIELD(6+KARTA->POL)

REPLACE &pole WITH &pole+1 && ПОЛ УМЕРШИХ

IF _OTCH=9.OR._OTCH=12

REPLACE B2 WITH B2+KARTA->ALL_DAY && КОЛ-ВО ДНЕЙ, ПРОВЕДЕННОЕ ИМИ

IF _OTCH=9.AND.KARTA->OLD_D<7

REPLACE B3 WITH B3+KARTA->ALL_DAY && ---"--- БОЛЬНЫМИ ДО 1 года

ENDIF

pole=FIELD(8+KARTA->OLD_D)

ELSEIF _OTCH=10

PRIVATE ad

ad=piece(KARTA->HOUR_B,KARTA->MINS_B,KARTA->HOUR_END,KARTA->MINS_END)

pole=FIELD(9+(KARTA->DATE_END-KARTA->DATE_B+;

IF(ad=1,1,IF(ad>=0,0,-1))))

ENDIF

REPLACE &pole WITH &pole+1 && ВОЗРАСТ УМЕРШИХ

pole=FIELD(21+KARTA->DIRECT1)

REPLACE &pole WITH &pole+1 && НАПРАВЛЯЮЩЕЕ УЧРЕЖДЕНИЕ

pole=FIELD(35+KARTA->RAION)

REPLACE &pole WITH &pole+1 && РАЙОН

IF _OTCH=9

IF KARTA->ALL_DAY=1

pole=FIELD(44+IF(KARTA->DATE_END-KARTA->DATE_IN+;

piece(KARTA->HOUR_IN,KARTA->MINS_IN,;

KARTA->HOUR_END,KARTA->MINS_END)<1,0,1))

ELSE

pole=FIELD(44+IF(KARTA->ALL_DAY<4,KARTA->ALL_DAY,4))

ENDIF

ELSEIF _OTCH=10

IF KARTA->ALL_DAY=1

pole=FIELD(44+IF(KARTA->DATE_END-KARTA->DATE_IN+;

piece(KARTA->HOUR_IN,KARTA->MINS_IN,;

KARTA->HOUR_END,KARTA->MINS_END)<1,0,1))

ELSE

pole=FIELD(44+KARTA->ALL_DAY)

ENDIF

ELSE &&_OTCH=12

PRIVATE t,d

STORE 0 TO t,d

t=KARTA->DATE_END-KARTA->DATE_IN+;

piece(KARTA->HOUR_IN,KARTA->MINS_IN,KARTA->HOUR_END,KARTA->MINS_END)

d=IF(t<(0.5/24),0,IF(t<(1/24),1,IF(t<3/24,2,IF(t<10/24,3,4))))

pole=FIELD(44+d)

RELEASE t,d

ENDIF

REPLACE &pole WITH &pole+1 && ПРОВЕДЕНО ДНЕЙ

SELECT DIA66

ENDIF

ENDIF

SKIP 1

show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

ENDDO

SET RELATION TO

grad() && РАЗБИЕНИЕ БОЛЕЗНЕЙ НА КЛАССЫ

OT1D1="OTCH"+ALLTRIM(STR(_OTCH))+"1"+".FRM" && OTCH*1.FRM

OT2D1="OTCH"+ALLTRIM(STR(_OTCH))+"1"+".TXT" && OTCH*1.TXT

SELECT BUFF8

REPORT FORM &OT1D1 TO FILE &OT2D1 PLAIN

IF _OTCH=9.OR._OTCH=10

OT1D2="OTCH"+ALLTRIM(STR(_OTCH))+"2"+".FRM" && OTCH*2.FRM

OT2D2="OTCH"+ALLTRIM(STR(_OTCH))+"2"+".TXT" && OTCH*2.TXT

REPORT FORM &OT1D2 TO FILE &OT2D2 PLAIN

link2(OT2D1,OT2D2) && СЛИЯНИЕ ДВУХ ФАЙЛОВ

ENDIF

*------------------------------------------------------

CASE _OTCH=9.AND.dep=14 && Дла Неонатального центра

*------------------------------------------------------

SELECT DIA66

SET RELATION TO SHIFR INTO BUFF8

SELECT karta

SET RELATION TO NUM_IB INTO DIA66

GO TOP

OT1="NEONAT.FRM"

OT2="NEONAT.TXT"

DO show_st && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ

DO WHILE !EOF()

IF dep=KARTA->DEPARTMENT.AND.;

KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_END<=_DATE_TILL.AND.;

KARTA->END1=3.AND.DIA66->KOD1="1"

count=state() && Поиск паталого-анатомического диагноза (если он есть)

_SHIFR=DIA66->SHIFR

SELECT BUFF8

IF EOF()

APPEND BLANK

REPLACE SHIFR WITH _SHIFR

mkb(1,1,@_SHIFR,@txt)

REPLACE NAME WITH txt

ENDIF

pole=FIELD(6+KARTA->POL)

REPLACE &pole WITH &pole+1 && Пол