Предыдущая страница реферата | 32  33  34  35  36  37  38  39  40  41  42

ELSE

EXIT

ENDIF

NEXT

SET SOFTSEEK OFF

SELECT CLASS

USE

SELECT (lsl)
RETURN 0

*********************************************************************
* Функция разбиения на группы ( для отчета N1,(N2 и N5) ) *
*********************************************************************
FUNCTION grad1 lsl=SELECT()

SELECT 0

IF _OTCH=1

USE GRUP1.DBF INDEX GRUP1 ALIAS GRUP

ELSE && для _OTCH=2 и _OTCH=5

USE GRUP2.DBF INDEX GRUP2 ALIAS GRUP

ENDIF

PRIVATE coun1,K,seek coun1=RECCOUNT() seek=" "

GO TOP

SELECT BUFF8

SET SOFTSEEK ON

FOR K=1 TO coun1 seek=GRUP->SHIFR_LEFT

SEEK seek

IF !EOF()

IF BUFF8->SHIFR SHIFR_RIGH

IF !EMPTY(BUFF8->NUMBER)

SKIP 1 ALIAS BUFF8

ENDIF rec=RECNO()

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

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

WHILE BUFF8->SHIFR SHIFR_RIGH

GOTO rec

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

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

REPLACE BUFF8->NUMBER WITH "-"

REPLACE BUFF8->NAMECL WITH GRUP->NAME_GRUP

REPLACE BUFF8->SHIFRL WITH GRUP->SHIFR_LEFT

REPLACE BUFF8->SHIFRR WITH GRUP->SHIFR_RIGH

ENDIF

SKIP 1 ALIAS GRUP

ELSE

EXIT

ENDIF

NEXT

SET SOFTSEEK OFF

SELECT GRUP

USE

SELECT (lsl)
RETURN 0

*********************************************************************
* Функция слияния двух текстовых файлов *
*********************************************************************
FUNCTION link2
PARAMETERS F1,F2
RUN ("COPY &F1+&F2 &F1>NUL")
DELETE FILE &F2
RETURN 0

*********************************************************************
* Представление на экране обработки записей БД ( начало ) *
*********************************************************************
PROCEDURE SHOW_ST
@ 4,7 CLEAR TO 15,72 saycent(5,5,75," *** "+_OTCH_N+" *** ") saycent(6,5,75,"по "+IF(dep=0,"всему стационару ","отделению "+dep_name)) saycent(7,5,75,"за период с "+DTOC(_DATE_FROM)+" по "+DTOC(_DATE_TILL))
STORE 0 TO c1,v1,v2 coun=RECCOUNT() v1=replicate(chr(178),60)
PRIVATE clr11 clr11=SETCOLOR()
SET COLOR TO (color1)
@ 8,8 CLEAR TO 15,71
@ 8,8 TO 15,71 DOUBLE saycent(15,5,75," ESC - прервать обработку ")
@ 12,9 TO 14,70
@ 13,10 say v1
@ 9,10 TO 11,37
@ 10,11 SAY "ОБРАБОТАНО:"
@ 10,24 SAY 0
@ 9,41 TO 11,70
@ 10,42 SAY "ВСЕГО ЗАПИСЕЙ:"
@ 10,61 SAY coun
SET COLOR TO (clr11)
RETURN

*********************************************************************
* Представление на экране обработки записей БД ( динамика ) *
*********************************************************************
PROCEDURE SHOW_DIN
PARAMETERS counts c1=c1+counts v2=replicate(chr(219),int(60*(c1/coun)))
@ 13,10 SAY v2
@ 10,24 SAY c1 count=1
RETURN

*********************************************************************
* Суммирование колонок по классам операций для отчета N3 *
*********************************************************************
FUNCTION summ
PRIVATE k,s,s1,n,A,B,C
SELECT BUFF8
SET SOFTSEEK ON
GO TOP
FOR k=2 TO 16 s=IF(k0 ins_pic(code_name,b[count])

ELSE ins_pic(code_name,' ')

ENDIF first=count+1

CASE LASTKEY()=7 &&

IF count>0 del_pic(code_name,i)

ENDIF first=i-1

ENDCASE

ENDIF
ENDDO
*CLEAR TYPEAHEAD
REINDEX
RESTORE SCREEN FROM screen
SET COLOR TO (color)
SELECT(sel)
SET CURSOR OFF
RETURN ret

*********************************************************************
* Проверка наличия в текущей директории файла отчета *
*********************************************************************
FUNCTION f_FRM
PRIVATE log,screen log=.T.
IF !FILE(OT1) log=.F.

SAVE SCREEN TO screen

@ 8,8 CLEAR TO 15,71

@ 8,8 TO 15,71 DOUBLE saycent(8,20,60,"ВНИМАНИЕ")

@ 11,15 SAY "ДЛЯ СОЗДАНИЯ ОТЧЕТА НЕОБХОДИМ ФАЙЛ :"+OT1

@ 12,15 SAY "УКАЗАННОГО ФАЙЛА НЕТ В РАБОЧЕЙ ДИРЕКТОРИИ"

INKEY(10)

RESTORE SCREEN FROM screen
ENDIF
RETURN (log)

*********************************************************************
* Функция ввода отчетного периода *
*********************************************************************
FUNCTION period
PRIVATE screen,M1,R1
R1=0
M1=1
SAVE SCREEN TO screen
SET CURSOR ON
@ 8,8 CLEAR TO 15,71
@ 8,8 TO 15,71 DOUBLE
DO WHILE .T. saycent(8,20,60,"ВВЕДИТЕ ОТЧЕТНЫЙ ПЕРИОД")
@ 9,17 TO 11,34
@ 10,20 SAY "c " GET _DATE_FROM PICTURE "@D"
@ 9,47 TO 11,64
@ 10,50 SAY "по " GET _DATE_TILL PICTURE "@D"
@ 12,17 TO 14,64
@ 13,21 PROMPT " Ok "
@ 13,38 PROMPT " ПОВТОР "
@ 13,53 PROMPT " ОТКАЗ "
READ
MENU TO M1
IF M1=1

EXIT
ELSEIF M1=2

M1=1
ELSEIF M1=0.OR.M1=3

R1=1

EXIT
ENDIF
ENDDO
SET CURSOR OFF
RESTORE SCREEN FROM screen
RETURN (R1)

*********************************************************************
* Вывод отчетного документа на печать *
*********************************************************************
FUNCTION do_PRN
PRIVATE YN
YN=1 codif1("PRNT",@YN)

IF YN=2

SET CURSOR OFF

TYPE &OT2 TO PRINT

ENDIF
RETURN 0

*********************************************************************
* Функция определения возраста пациента *
*********************************************************************
FUNCTION y_m_day
PARAMETERS day_bir,hour_bir,mins_bir,day_bas,hour_bas,mins_bas
PRIVATE years,mons,days,screen,txt
SAVE SCREEN TO screen txt="" years="00"
@ 1,20 CLEAR TO 3,60
@ 1,20 TO 3,60
@ 2,22 SAY IF(choice=8," Возраст пациента :","Возраст на момент смерти:") years=oldM(day_bir,day_bas)
IF VAL(years)>0 txt=years

IF VAL(years)=1 txt=txt+" год"

ELSEIF VAL(years)0 txt=ALLTRIM(STR(mons))

IF mons=1 txt=txt+" месяц"

ELSEIF mons

Скачали данный реферат: Палюлин, Моряков, Savvatij, Созонов, Rasskazov, Лёвкин, Grafov.
Последние просмотренные рефераты на тему: реферат на тему общество, курсовики скачать бесплатно, курсовики скачать бесплатно, темы рефератов по биологии.



Предыдущая страница реферата | 32  33  34  35  36  37  38  39  40  41  42

Поделитесь этой записью или добавьте в закладки