Разработка автоматизированной системы учета выбывших из стационара
| Категория реферата: Рефераты по информатике, программированию
| Теги реферата: индия реферат, изложение 4
| Добавил(а) на сайт: Jetush.
Предыдущая страница реферата | 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
Главная