|
Разработка автоматизированной системы учета выбывших из стационара_SHIFR_ILL="0000" &&SHIFR_ILL ELSE PRIVATE txts,string8 txts=SPACE(70) STORE "" TO string8 DO WHILE NUM_IB=_NUM_IB _SHIFR_ILL=SHIFR catalog(@_SHIFR_ILL,@txts) txts=TRIM(txts) context(@string8,"",txts,length,.F.) context(@string8," Дата проведения : ",DTOC(DATA)+".",length,.F.) context(@string8," Название операции : ",ALLTRIM(COMM),length,.F.) vars[26]=string8 SKIP 1 ENDDO RELEASE txts,string8 SELECT BUFF2 COMMIT APPEND FROM OP66 FOR NUM_IB=_NUM_IB ENDIF v=replicate(chr(178),30) @ 13,25 SAY v ******************* ФОРМИРОВАНИЕ ТЕКСТА ************************* string="" && Начальный текст SELECT karta SEEK _NUM_IB rez=FOUND() New_Str=.F. FOR i=1 TO LEN(promp) IF (i=23.AND._DIA_DIRECT#" ").OR.i=25.OR.i=26 New_Str=.T. ENDIF IF rez.AND.!EMPTY(vars[i]) row[i]=context(@string,promp[i],TRIM(vars[i])+".",length,New_Str) ELSE row[i]=context(@string,promp[i],vars[i],length,New_Str) ENDIF New_Str=.F. IF i=20 && Промпт "ИСХОД" IF _END1=2 && переведен context(@string,"Причина:",extra1(_END2,"RIZ2")+".",length,.F.) context(@string,"Куда:",extra1(_END3,"HOSP")+".",length,.F.) ELSEIF _END1=3 && умер context(@string,"Причина:",extra1(_END2,"RIZ3")+".",length,.F.) ENDIF ELSEIF i=22.AND._END1=3 context(@string,"Возраст на момент смерти :",; extra1(_OLD_D,"OLDS")+".",length,.F.) ELSEIF i=26 context(@string,"Обследование на реакцию ВАССЕРМАНА :","",length,.F.) ENDIF NEXT SET CURSOR ON SELECT (sel) RETURN ********************************************************************* * Функция инициализации диагнозов * ********************************************************************* FUNCTION initial1 PARAMETERS DBN PRIVATE sl,rez1 SET CURSOR OFF sl=SELECT() SELECT &DBN SET SOFTSEEK ON SEEK _NUM_IB SET SOFTSEEK OFF rez1=FOUND() IF !rez1 vars1[1]="" && Основной диагноз vars1[2]="" && Осложнения vars1[3]="" && Сопутствующие заболевания IF _END1=3 vars1[4]="" && Основной диагноз vars1[5]="" && Осложнения vars1[6]="" && Сопутствующие заболевания ENDIF _SHIFR=SPACE(4) && SHIFR _KOD1=0 && KOD1 _KOD2=0 && KOD2 ELSE PRIVATE txts,string2,string3,string4,string5,string6,string7 txts=SPACE(100) STORE "" TO string2,string3,string4,string5,string6,string7 DO WHILE NUM_IB=_NUM_IB _KOD1=KOD1 _KOD2=KOD2 _SHIFR=SHIFR IF _SHIFR="0000" txts="Здоров" ELSE IF _KOD1="1".OR._KOD1="2".AND._KOD2#"2" mkb(1,1,@_SHIFR,@txts) ENDIF ENDIF txts=SUBSTR(_SHIFR,1,3)+"."+SUBSTR(_SHIFR,4,1)+" "+"" IF _KOD2#"2" IF _KOD1="1" context(@string2,"",txts,length,.F.) context(@string2,"",ALLTRIM(COMM1),length,.F.) vars1[1]=string2 ELSEIF _KOD1="2" context(@string3,"",txts,length,.F.) vars1[2]=string3 ELSEIF _KOD1="3" context(@string4,"",ALLTRIM(COMM1),length,.F.) vars1[3]=string4 ENDIF ELSEIF _KOD2="2".AND._END1=3 IF _KOD1="1" context(@string5,"",txts,length,.F.) context(@string5,"",ALLTRIM(COMM1),length,.F.) vars1[4]=string5 ELSEIF _KOD1="2" context(@string6,"",ALLTRIM(COMM1),length,.F.) vars1[5]=string6 ELSEIF _KOD1="3" context(@string7,"",ALLTRIM(COMM1),length,.F.) vars1[6]=string7 ENDIF ENDIF SKIP 1 ENDDO RELEASE txts,string2,string3,string4,string5,string6,string7 SELECT BUFF APPEND FROM DIA66 FOR NUM_IB=_NUM_IB ENDIF PRIVATE string11,j string11="" New_Str=.T. context(@string11,SPACE(10)+"Клинический диагноз"," ",length,.T.) FOR j=1 TO s IF rez1.AND.!EMPTY(vars1[j]) row1[j]=context(@string11,promp1[j],TRIM(vars1[j])+".",length,New_Str) ELSE row1[j]=context(@string11,promp1[j],vars1[j],length,New_Str) ENDIF IF j=3.AND._END1=3 context(@string11," "," ",length,.T.) context(@string11,SPACE(10)+"Паталого-анатомический диагноз"," ",length,.T.) ENDIF NEXT SET CURSOR ON SELECT (sl) RETURN (string11) ********************************************************************* * Функция ввода даты * ********************************************************************* FUNCTION d_input PARAMETERS dat PRIVATE screen SAVE SCREEN TO screen SET CURSOR ON @ 10,25 CLEAR TO 15,55 @ 10,25 TO 15,55 saycent(10,30,50,"ВВЕДИТЕ В ФОРМАТЕ") @ 12,36 SAY "дд.мм.гг" @ 14,36 GET dat PICTURE "@D" READ SET CURSOR OFF RESTORE SCREEN FROM screen RETURN dat ********************************************************************* * Функция ввода массы пациента * ********************************************************************* FUNCTION m_input PRIVATE screen SAVE SCREEN TO screen SET CURSOR ON @ 10,25 CLEAR TO 15,55 @ 10,25 TO 15,55 saycent(10,30,50,"ВВЕДИТЕ В ФОРМАТЕ") @ 12,38 SAY "кг/гр." @ 14,38 GET _MASSA PICTURE "@P 99/999" READ SET CURSOR OFF RESTORE SCREEN FROM screen RETURN _MASSA ********************************************************************* * Функция проверки времени * ********************************************************************* FUNCTION check_T PARAMETERS timeS PRIVATE L,hour,mins L=.F. hour=SUBSTR(timeS,1,2) mins=SUBSTR(timeS,4,5) IF VAL(hour)=0.AND.EMPTY(_DATE_IN)=.F. vars[choice]=DTOC(_DATE_END)+SPACE(5)+"Проведено дней в стационаре :"+; STR(_ALL_DAY) ENDIF RETURN ********************************************************************* * Процедура работы с диагнозами * ********************************************************************* FUNCTION diagn PRIVATE txtf,sel,w_do PRIVATE F1,screen,color PRIVATE str PRIVATE s PRIVATE q PRIVATE string11 q=0 str="" txtf=SPACE(100) _SHIFR=SPACE(4) sel=SELECT() F1=0 string11=vars[25] s=IF(_END1=3,6,3) IF LEN(promp1)#s @ 11,18 CLEAR TO 13,62 @ 11,18 TO 13,62 saycent(12,20,60,"ФОРМИРУЕТСЯ МЕНЮ ДИАГНОЗОВ") DECLARE promp1[s],vars1[s],row1[s],col1[s] && массив промптеров дополн. меню promp1[1]="Основное заболевание :" promp1[2]="Осложнения :" promp1[3]="Сопутствующие заболевания :" IF s=6 promp1[4]="Основное заболевание :" promp1[5]="Осложнения :" promp1[6]="Сопутствующие заболевания :" ENDIF AFILL(vars1,' ') AFILL(col1,1) ************************************************************** string11=initial1("BUFF") && Функция формирования выводимого текста ************************************************************** ENDIF wt1=3 wb1=IF(s=3,12,20) wl1=2 wr1=77 length=wr1-wl1+1 && Длина строки текста, выводимого на экран beg_line1=1 PRIVATE New_Str1 && Признак новой строки для Context New_Str1=.F. && Без выделения промптеров cur_promp1=1 DO WHILE !gotomain q=hypertxt(wt1,wl1,wb1,wr1,string11,promp1,row1,col1,; @beg_line1,@cur_promp1,color9," ДИАГНОЗ ПАЦИЕНТА ") cur_promp1=cur_promp1%len(promp1)+1 DO CASE CASE q=0 LOOP CASE q=1.OR.q=2.OR.q=4 w_do=1 SAVE SCREEN TO screen @ 11,25 CLEAR TO 16,55 @ 11,25 TO 16,55 DOUBLE @ 11,30 PROMPT "ДОБАВИТЬ" @ 11,44 PROMPT "УДАЛИТЬ" IF EMPTY(vars1[q]).OR.BUFF->KOD1="2".AND.BUFF->KOD2="2" vars1[q]="" KEYBOARD CHR(13) ENDIF MENU TO w_do str=vars1[q] IF w_do=1 @ 13,30 SAY "ВВЕДИТЕ КОД" GET _SHIFR PICTURE "@R 999.9" READ IF LASTKEY()=27 vars1[q]=str RESTORE SCREEN FROM screen LOOP ENDIF F1=mkb(1,1,@_SHIFR,@txtf) IF F1#-1 txtf=SUBSTR(_SHIFR,1,3)+"."+SUBSTR(_SHIFR,4,1)+" "+; ""+"." SELECT BUFF APPEND BLANK REPLACE NUM_IB WITH _NUM_IB REPLACE SHIFR WITH _SHIFR REPLACE KOD2 WITH IF(q=4,"2","1") REPLACE KOD1 WITH IF(q=1.OR.q=4,"1","2") REPLACE COMM1 WITH MEMPRO(COMM1,10,5,18,75,; " ВВЕДИТЕ НЕОБХОДИМЫЕ ЗАМЕЧАНИЯ","ILLS",'ILLS') context(@str,"",txtf+".",length,.F.) context(@str,"Замечания :",ALLTRIM(COMM1),length,.T.) ENDIF ELSEIF w_do=2 PRIVATE i,j,k,EN,ET,NALL,MALL,NDEL NALL=INT(LEN(str)/length) MALL=NALL FOR i=1 TO NALL ET=ALLTRIM(SUBSTR(str,length*(i-1)+1,length)) EN=ASC(ET) IF EN>57 MALL=MALL-1 ENDIF NEXT DECLARE _0B[MALL],_0S[MALL] k=1 FOR j=1 TO NALL ET=ALLTRIM(SUBSTR(str,length*(j-1)+1,length)) EN=ASC(ET) IF EN60 MALL=MALL-1 ENDIF NEXT DECLARE _0B[MALL],_0S[MALL] k=1 FOR j=1 TO NALL ET=ALLTRIM(SUBSTR(stro,length*(j-1)+1,length)) EN=ASC(ET) IF EN=60 _0B[k]=SUBSTR(stro,length*(j-1)+1,length) _0S[k]=LEFT(ALLTRIM(_0B[k]),5) k=k+1 ELSE _0B[k-1]=_0B[k-1]+SUBSTR(stro,length*(j-1)+1,length) ENDIF NEXT NDEL=ACHOICE(13,35,15,45,_0S) IF LASTKEY()=27 RETURN ENDIF SELECT BUFF2 GO NDEL DELETE PACK stro="" FOR j=1 TO MALL IF j#NDEL stro=stro+_0B[j] ENDIF NEXT RELEASE j,NALL,NDEL RELEASE _0B,_0S ENDIF vars[choice]=stro SELECT (sel) RETURN ********************************************************************* * ПРОЦЕДУРА ЗАПОЛНЕНИЯ БД karta.dbf * ********************************************************************* PROCEDURE new_save PRIVATE sel,v sel=SELECT() SET CURSOR OFF SELECT karta @ 11,18 CLEAR TO 13,62 @ 10,17 TO 14,63 saycent(12,20,60,"ПОДОЖДИТЕ НЕМНОГО - ИДЕТ ЗАПИСЬ В БД") SET COLOR TO W/N v=replicate(chr(32),30) SET COLOR TO @ 13,25 SAY v SEEK _NUM_IB IF FOUND()=.F. APPEND BLANK REPLACE NUM_IB WITH _NUM_IB rec_num = RECNO() ENDIF REPLACE FAM WITH ALLTRIM(_FAM) REPLACE F_S_NAME WITH ALLTRIM(_F_S_NAME) REPLACE DATE_B WITH _DATE_B REPLACE HOUR_B WITH _HOUR_B REPLACE MINS_B WITH _MINS_B REPLACE POL WITH _POL REPLACE OLD WITH _OLD REPLACE OLD_D WITH _OLD_D REPLACE MASSA WITH _MASSA REPLACE PLACE_LIV WITH _PLACE_LIV REPLACE RAION WITH _RAION REPLACE CITY_VILL WITH _CITY_VILL REPLACE DIRECT1 WITH _DIRECT1 REPLACE DIRECT2 WITH _DIRECT2 REPLACE STATE WITH _STATE REPLACE PLACE WITH _PLACE *REPLACE WHY WITH _WHY REPLACE DEPARTMENT WITH _DEPARTMENT REPLACE KOIKA WITH _KOIKA REPLACE PASS WITH _PASS REPLACE TIME WITH _TIME REPLACE DATE_IN WITH _DATE_IN REPLACE HOUR_IN WITH _HOUR_IN REPLACE MINS_IN WITH _MINS_IN REPLACE END1 WITH _END1 REPLACE END2 WITH _END2 REPLACE END3 WITH _END3 REPLACE DATE_END WITH _DATE_END REPLACE HOUR_END WITH _HOUR_END REPLACE MINS_END WITH _MINS_END REPLACE ALL_DAY WITH _ALL_DAY REPLACE SHIFR WITH _DIA_DIRECT REPLACE NUM_COME WITH _NUM_COME REPLACE RW_DATE WITH _RW_DATE REPLACE RW_REZ WITH _RW_REZ REPLACE FAM_DOCTOR WITH _FAM_DOCTOR *REINDEX COMMIT v=replicate(chr(177),10) @ 13,25 SAY v SELECT DIA66 DELETE FOR NUM_IB=_NUM_IB PACK *COMMIT IF _END1=3 APPEND FROM BUFF FOR NUM_IB=_NUM_IB ELSE APPEND FROM BUFF FOR NUM_IB=_NUM_IB.AND.KOD2#"2" ENDIF *REINDEX COMMIT SELECT BUFF ZAP *COMMIT *REINDEX COMMIT v=replicate(chr(177),20) @ 13,25 SAY v SELECT OP66 DELETE FOR NUM_IB=_NUM_IB PACK *COMMIT APPEND FROM BUFF2 FOR NUM_IB=_NUM_IB v=replicate(chr(177),30) *REINDEX COMMIT @ 13,25 SAY v SELECT BUFF2 ZAP *COMMIT *REINDEX COMMIT SELECT (sel) RETURN ********************************************************************* * Процедура удаления записей * ********************************************************************* PROCEDURE del PRIVATE flag_del && число записей,помеченных для удаления PRIVATE nr,tr,del_str,temp,_01,_02,sel @ 5,1,22,78 BOX dn_s+fon1 sel=SELECT() flag_del=0 c_d=2 SELECT KARTA *RECALL ALL *GO TOP nr=RECCOUNT() DECLARE stor_ib[nr] DO WHILE !gotomain DO first @ 7,5,16,74 BOX singl+fon2 SET COLOR TO "r+*/b" saycent(5,0,79,if(DELETED(),"Запись помечена на удаление",SPACE(27))) SET COLOR TO (color1) @ 10,10 PROMPT IF(!BOF(),"Вернуться к предыдущей записи","******") @ 12,10 PROMPT IF(DELETED(),"Отменить удаление текущей записи",; "Пометить текущую запись на удаление") @ 14,10 PROMPT IF(!EOF(),"Перейти к следующей записи","******") @ 16,35 PROMPT "Выполнить" MESSAGE "Удалить помеченные записи и "+; "вернуться в главное меню" MENU TO c_d DO CASE CASE c_d=0 LOOP CASE c_d=1 IF(!BOF()) SKIP -1 ENDIF CASE c_d=2 IF(!EOF()) IF !DELETED() DELETE flag_del=flag_del+1 stor_ib[flag_del]=NUM_IB ELSE RECALL tr=ASCAN(stor_ib,NUM_IB) ADEL(stor_ib,tr) flag_del=flag_del-1 ENDIF ENDIF CASE c_d=3 IF(!EOF()) SKIP ENDIF CASE c_d=4 EXIT ENDCASE ENDDO IF flag_del>0 y=yesno(10,"Удалить помеченные "+alltrim(str(flag_del))+" записей ?") IF y=1 temp="NUM_IB='" del_str=temp+stor_ib[1]+"'" temp=".OR."+temp FOR tr=2 TO flag_del del_str=del_str+temp+stor_ib[tr]+"'" NEXT DELETER(del_str,"DIA66") && Удаление из DIA66.DBF DELETER(del_str,"OP66") && Удаление из OP66.DBF *************************************** pack && Удаление из KARTA66.DBF ELSE RECALL ALL GOTO TOP ENDIF ENDIF SELECT (sel) RETURN ********************************************************************* * Процедура формирования отчетных документов * ********************************************************************* FUNCTION rez PRIVATE _OTCH,_OTCH_N,scr1 _OTCH=00 _OTCH_N="" SAVE SCREEN TO scr1 PRIVATE sel sel=SELECT() PRIVATE _DATE_FROM _DATE_FROM=_today PRIVATE _DATE_TILL _DATE_TILL=_today PRIVATE dep,dep_name PRIVATE numb1 PRIVATE txt PRIVATE pole PRIVATE count count=1 PRIVATE _c _c=1 PRIVATE _p _p=1 PRIVATE OT1,OT2 PRIVATE coun,c1,v1,v2 PRIVATE f f=1 DO WHILE .T. SELECT 0 USE BUFF8.DBF INDEX BUFF8 ALIAS BUFF8 ZAP numb1=0 txt=SPACE(100) pole=1 STORE "" TO OT1,OT2 dep=0 dep_name="" codif1("PERD",@_p) IF _p=0 SELECT BUFF8 USE EXIT ELSEIF _p=2 _OTCH_N=codif1("OTCH",@_OTCH) IF _OTCH=0 SELECT BUFF8 USE EXIT ENDIF ENDIF dep_name=codif1("DEPS",@dep) IF _p=1.AND.dep=0 SELECT BUFF8 USE LOOP ENDIF dep_name=IF(dep=0,"Весь стационар",dep_name) IF period()=0 && Ввод пользователем периода отчета SET CURSOR OFF IF _p=1 ********************* МЕСЯЧНЫЕ ОТЧЕТЫ ********************** _OTCH_N="Месячный отчет" SELECT DIA66 SET RELATION TO SHIFR INTO BUFF8 SELECT karta SET RELATION TO NUM_IB INTO DIA66 GO TOP PRIVATE OT1D1,OT2D1,OT1D2,OT2D2 IF dep=2.OR.dep=11 OT1="OTD5.FRM" OT1D1="OTD2.FRM" OT2D1="OTD51.TXT" ELSE OT1="OTD.FRM" OT1D1="OTD1.FRM" OT2D1="OTD_1.TXT" OT1D2="OTD2.FRM" OT2D2="OTD_2.TXT" ENDIF DO show_st && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ DO WHILE !EOF() IF dep=KARTA->DEPARTMENT.AND.; KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_ENDEND1#3.AND.DIA66->KOD1="1" _SHIFR=DIA66->SHIFR SELECT BUFF8 IF EOF() APPEND BLANK REPLACE SHIFR WITH _SHIFR mkb(1,1,@_SHIFR,@txt) REPLACE NAME WITH txt ENDIF REPLACE COUNT1 WITH COUNT1+KARTA->ALL_DAY && ПРОВЕДЕНО ДНЕЙ REPLACE COUNT2 WITH COUNT2+1 && ВСЕГО БОЛЬНЫХ pole=FIELD(8+KARTA->RAION) REPLACE &pole WITH &pole+1 && из Москвы/Моск.обл./Иногородн./Село pole=FIELD(14+KARTA->NUM_COME) REPLACE &pole WITH &pole+1 && Первично/Повторно pole=FIELD(16+KARTA->DIRECT1) REPLACE &pole WITH &pole+1 && Направляющие организации *-------------------------------------------------------------------- IF dep=2.OR.dep=11 IF KARTA->OLDALL_DAY && К/Д IF KARTA->CITY_VILL=2 REPLACE C5 WITH C5+1 && В том числе из села REPLACE C6 WITH C6+KARTA->ALL_DAY && К/Д ENDIF ELSE IF KARTA->CITY_VILL=2 REPLACE C9 WITH C9+1 && Из села старше 1 года ENDIF ENDIF IF KARTA->OLD=1 pole=FIELD(43) ELSEIF KARTA->OLD=2 ad=piece(KARTA->HOUR_B,KARTA->MINS_B,KARTA->HOUR_END,KARTA- >MINS_END) ad=KARTA->DATE_END-KARTA->DATE_B+IF(ad=1,1,IF(ad>=0,0,-1)) pole=FIELD(42+IF(ad14.AND.adOLD) ENDIF *-------------------------------------------------------------------- ELSE IF KARTA->OLDALL_DAY && К/Д IF KARTA->CITY_VILL=2 REPLACE C5 WITH C5+1 && В том числе из села REPLACE C6 WITH C6+KARTA->ALL_DAY && К/Д ENDIF ELSEIF KARTA->OLDALL_DAY && К/Д IF KARTA->CITY_VILL=2 REPLACE C9 WITH C9+1 && В том числе из села REPLACE C0 WITH C0+KARTA->ALL_DAY && К/Д ENDIF ELSE REPLACE D1 WITH D1+1 && Всего 15 лет и старше REPLACE D2 WITH D2+KARTA->ALL_DAY && К/Д IF KARTA->CITY_VILL=2 REPLACE D3 WITH D3+1 && В том числе из села REPLACE D4 WITH D4+KARTA->ALL_DAY && К/Д ENDIF ENDIF IF KARTA->OLDOLD) ENDIF ENDIF *-------------------------------------------------------------------- REPLACE &pole WITH &pole+1 && Возраст SELECT KARTA ENDIF SKIP 1 show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ ENDDO SET RELATION TO SELECT DIA66 SET RELATION TO grad() && РАЗБИЕНИЕ БОЛЕЗНЕЙ НА КЛАССЫ SELECT BUFF8 OT2="OTD"+ALLTRIM(STR(dep))+".TXT" @ 13,25 SAY " СОЗДАЕТСЯ ОТЧЕТ : "+OT2+" " IF dep#2.AND.dep#11 REPORT FORM &OT1D2 TO FILE &OT2D2 PLAIN ENDIF REPORT FORM &OT1D1 TO FILE &OT2D1 PLAIN REPORT FORM &OT1 TO FILE &OT2 PLAIN 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_ENDKOD1="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->OLDEND1=1.OR.KARTA->END1=2 REPLACE COUNT2 WITH COUNT2+1 && ВЫПИСАНО REPLACE A3 WITH A3+KARTA->ALL_DAY && ПРОВЕДЕНО ИМИ ДНЕЙ IF KARTA->OLDEND1=3 REPLACE A5 WITH A5+1 && УМЕРЛО IF KARTA->OLDDEPARTMENT,.T.,.F.)).AND.; KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_ENDDATE_IN-KARTA->DATE_B+piece(KARTA->HOUR_B,KARTA->MINS_B,; KARTA->HOUR_IN,KARTA->MINS_IN))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))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))DEPARTMENT,.T.,.F.)).AND.; KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_ENDSHIFR 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->OLDEND1=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_ENDEND1 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_ENDKOD1="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_ENDSHIFR 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->OLDOLDWHY) 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_ENDEND1=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)DATE_END-KARTA->DATE_IN+; piece(KARTA->HOUR_IN,KARTA->MINS_IN,KARTA->HOUR_END,KARTA- >MINS_END)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_DALL_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)ALL_DAYALL_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)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(tDEPARTMENT.AND.; KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_ENDEND1=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 && Пол pole=FIELD(16+KARTA->DIRECT1) REPLACE &pole WITH &pole+1 && Направляющие организации REPLACE C3 WITH C3+1 && Всего умерло REPLACE C4 WITH C4+KARTA->ALL_DAY && К/Д IF KARTA->OLD=1 pole=FIELD(43) ELSEIF KARTA->OLD=2 ad=piece(KARTA->HOUR_B,KARTA->MINS_B,KARTA->HOUR_END,KARTA- >MINS_END) ad=KARTA->DATE_END-KARTA->DATE_B+IF(ad=1,1,IF(ad>=0,0,-1)) pole=FIELD(42+IF(ad14.AND.adOLD) ENDIF REPLACE &pole WITH &pole+1 && Возраст SELECT KARTA ENDIF SKIP 1 show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ ENDDO SET RELATION TO SELECT DIA66 SET RELATION TO grad() && РАЗБИЕНИЕ БОЛЕЗНЕЙ НА КЛАССЫ *------------------------------------------------ CASE _OTCH=11 *------------------------------------------------ codif1("FULL",@f) IF f=0 LOOP ENDIF SELECT DIA66 SET CURSOR OFF SET RELATION to SHIFR into BUFF8 SELECT OP66 SET RELATION to NUM_IB into KARTA, 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_ENDEND1=3.AND.DIA66->KOD1="1" state() && Поиск паталого-анатомического диагноза (если он есть) _SHIFR=DIA66->SHIFR _NUM_IB=OP66->NUM_IB SELECT BUFF8 IF EOF() APPEND BLANK REPLACE SHIFR WITH _SHIFR mkb(1,1,@_SHIFR,@txt) REPLACE NAME WITH txt ENDIF REPLACE COUNT1 WITH COUNT1+1 && ВСЕГО ОПЕРИРОВАННЫХ БОЛЬНЫХ SELECT 0 USE CATO.DBF INDEX CATO ALIAS CATO DO WHILE .T. SEEK OP66->SHIFR SELECT BUFF8 pole=FIELD(8+CATO->NUMBER) REPLACE &pole WITH &pole+1 REPLACE COUNT2 WITH COUNT2+1 && ВСЕГО ОПЕРАЦИЙ SKIP 1 ALIAS OP66 SELECT CATO IF OP66->NUM_IB#_NUM_IB SKIP -1 ALIAS OP66 EXIT ENDIF show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ ENDDO USE ENDIF SELECT OP66 SKIP 1 show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ ENDDO SET RELATION TO SELECT DIA66 SET RELATION TO grad() && РАЗБИЕНИЕ БОЛЕЗНЕЙ НА КЛАССЫ IF f=1 OT1="OTCH"+ALLTRIM(STR(_OTCH))+"L"+".FRM" ELSE 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 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=13 *------------------------------------------------ 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_ENDSHIFR>"0000".AND.DIA66->SHIFRKOD1="1" count=state() && Поиск паталого-анатомического диагноза (если он есть) _SHIFR=DIA66->SHIFR SELECT BUFF8 IF EOF() APPEND BLANK REPLACE SHIFR WITH _SHIFR ENDIF IF KARTA->END1=1.OR.KARTA->END1=2 REPLACE COUNT1 WITH COUNT1+1 && ОБЩЕЕ КОЛИЧЕСТВО ВЫБЫВШИХ REPLACE A1 WITH A1+KARTA->ALL_DAY && ПРОВЕДЕНО ИМИ ДНЕЙ IF KARTA->OLDEND1=3 REPLACE A2 WITH A2+1 && ОБЩЕЕ КОЛИЧЕСТВО УМЕРШИХ REPLACE A3 WITH A3+KARTA->ALL_DAY && ПРОВЕДЕНО ИМИ ДНЕЙ IF KARTA->OLDDEPARTMENT,.T.,.F.)).AND.; KARTA->DATE_END>=_DATE_FROM.AND.KARTA->DATE_ENDSHIFR>"0000".AND.DIA66->SHIFRKOD1="1" count=state() && Поиск паталого-анатомического диагноза (если он есть) _SHIFR=DIA66->SHIFR SELECT BUFF8 IF EOF() APPEND BLANK mkb(1,1,@_SHIFR,@txt) REPLACE NAME WITH txt REPLACE SHIFR WITH _SHIFR ENDIF pole=FIELD(8+KARTA->DEPARTMENT) REPLACE &pole WITH &pole+1 SELECT DIA66 ENDIF SKIP 1 show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ ENDDO SET RELATION TO numb_STR() && НУМЕРАЦИЯ СТРОК *----------------------------------------------- CASE _OTCH=15 *----------------------------------------------- SELECT KARTA GO TOP PRIVATE _NAME,_NUMBER 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_ENDRAION>1 SELECT BUFF8 IF KARTA->STATE=1 _NUMBER="" IF KARTA->PLACE=0 _SHIFR="99 " _NAME="Прочие области и районы РФ" ELSE _SHIFR=RIGHT(ALLTRIM(extra1(KARTA->PLACE,"PLCE")),4) _NAME=extra1(KARTA->PLACE,"PLCE") ENDIF IF KARTA->RAION=2 _NUMBER="*" _SHIFR="1000" _NAME="Московская область" ENDIF ELSE _NUMBER="*" _SHIFR=SPACE(2)+STR(KARTA->STATE,2) _NAME=extra1(KARTA->STATE,"STTE") ENDIF SEEK _SHIFR IF !FOUND() APPEND BLANK REPLACE NUMBER WITH _NUMBER,SHIFR WITH _SHIFR,NAME WITH _NAME ENDIF pole=FIELD(8+KARTA->DIRECT1) REPLACE &pole WITH &pole+1 && НАПРАВЛЯЮЩЕЕ УЧРЕЖДЕНИЕ pole=FIELD(23+KARTA->DEPARTMENT) REPLACE &pole WITH &pole+1 && ОТДЕЛЕНИЯ БОЛЬНИЦЫ pole=FIELD(38+KARTA->PASS) REPLACE &pole WITH &pole+1 && Планово/экстренно REPLACE COUNT1 WITH COUNT1+KARTA->ALL_DAY && Проведено дней REPLACE COUNT2 WITH COUNT2+1 && ВСЕГО ВЫПИСАНО SELECT KARTA ENDIF ENDIF SKIP 1 show_din(count) && ПРОЦЕДУРА ПРЕДСТАВЛЕНИЯ ОБРАБОТКИ ЗАПИСЕЙ ENDDO SELECT BUFF8 SUM COUNT1,COUNT2,A1,A2,A3,A4,A5,A6,A7,A8,A9,A0,; B1,B2,B3,B4,B5,B6,B7,B8,B9,B0,C1,C2,C3,C4,C5,C6,C7,C8,C9,C0 TO; _1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14,_15,_16,_17,_18,_19,; _20,_21,_22,_23,_24,_25,_26,_27,_28,_29,_30,_31,_32 && Суммирование по всем столбцам APPEND BLANK REPLACE SHIFR WITH " ",NAME WITH "Всего",COUNT1 WITH _1,; COUNT2 WITH _2,A1 WITH _3,A2 WITH _4,A3 WITH _5,A4 WITH _6,; A5 WITH _7,A6 WITH _8,A7 WITH _9,A8 WITH _10,A9 WITH _11,A0 WITH _12,; B1 WITH _13,B2 WITH _14,B3 WITH _15,B4 WITH _16,B5 WITH _17,; B6 WITH _18,B7 WITH _19,B8 WITH _20,B9 WITH _21,B0 WITH _22,; C1 WITH _23,C2 WITH _24,C3 WITH _25,C4 WITH _26,C5 WITH _27,; C6 WITH _28,C7 WITH _29,C8 WITH _30,C9 WITH _31,C0 WITH _32 SUM COUNT1,COUNT2,A1,A2,A3,A4,A5,A6,A7,A8,A9,A0,; B1,B2,B3,B4,B5,B6,B7,B8,B9,B0,C1,C2,C3,C4,C5,C6,C7,C8,C9,C0 TO; _1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14,_15,_16,_17,_18,_19,; _20,_21,_22,_23,_24,_25,_26,_27,_28,_29,_30,_31,_32; FOR SHIFR>" ".AND.SHIFR"1000" && Суммирование столбцов по всем областям РФ APPEND BLANK REPLACE SHIFR WITH "9990",NAME WITH "Всего по РФ",COUNT1 WITH _1,; COUNT2 WITH _2,A1 WITH _3,A2 WITH _4,A3 WITH _5,A4 WITH _6,; A5 WITH _7,A6 WITH _8,A7 WITH _9,A8 WITH _10,A9 WITH _11,A0 WITH _12,; B1 WITH _13,B2 WITH _14,B3 WITH _15,B4 WITH _16,B5 WITH _17,; B6 WITH _18,B7 WITH _19,B8 WITH _20,B9 WITH _21,B0 WITH _22,; C1 WITH _23,C2 WITH _24,C3 WITH _25,C4 WITH _26,C5 WITH _27,; C6 WITH _28,C7 WITH _29,C8 WITH _30,C9 WITH _31,C0 WITH _32 OT1D1="OTCH"+ALLTRIM(STR(_OTCH))+"1"+".FRM" && OTCH*1.FRM OT2D1="OTCH"+ALLTRIM(STR(_OTCH))+"1"+".TXT" && OTCH*1.TXT REPORT FORM &OT1D1 TO FILE &OT2D1 PLAIN *------------------------------------------------ CASE _OTCH=16.OR._OTCH=17.OR._OTCH=18.OR._OTCH=19 *------------------------------------------------ SELECT BUFF8 APPEND BLANK 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_ENDEND1=2 REPLACE A1 WITH A1+1 && ВСЕГО IF KARTA->OLDSHIFR="0000" && ОКАЗАВШИЕСЯ ЗДОРОВЫМИ REPLACE A3 WITH A3+1 ENDIF ELSEIF _OTCH=17.AND.KARTA->END1=3 IF KARTA->OLD=1 REPLACE A1 WITH A1+1 && УМЕРЛО В ВОЗРАСТЕ 0-6 СУТОК ENDIF IF (KARTA->DATE_END-KARTA->DATE_IN+; piece(KARTA->HOUR_IN,KARTA->MINS_IN,KARTA->HOUR_END,KARTA- >MINS_END)DATE_END-KARTA->DATE_B+; piece(KARTA->HOUR_B,KARTA->MINS_B,KARTA->HOUR_END,KARTA->MINS_END)OLDNUM_IB=KARTA->NUM_IB IF DIA66->KOD1="1".AND.; (DIA66->SHIFR>="4800".AND.DIA66->SHIFRSHIFR="410 ".OR.KARTA->SHIFR="412 ") IF KARTA->TIMEEND1=3.AND.(KARTA->DATE_END-KARTA->DATE_IN+; piece(KARTA->HOUR_IN,KARTA->MINS_IN,KARTA->HOUR_END,KARTA- >MINS_END)SHIFR>="6300".AND.KARTA->SHIFREND1=3 REPLACE A1 WITH A1+1 && ВСЕГО УМЕРЛО БЕРЕМЕННЫХ,РОЖЕНИЦ И РОДИЛЬНИЦ SELECT DIA66 state() && Поиск паталого-анатомического диагноза (если он есть) DO WHILE DIA66->NUM_IB=KARTA->NUM_IB IF DIA66->KOD1="1".AND.; (DIA66->SHIFR>="6300".AND.DIA66->SHIFRSHIFR_LEFT SEEK seek IF !EOF() IF BUFF8->SHIFR SHIFR_RIGH numb1=numb1+1 rec=RECNO() IF _OTCH=1 _SHIFR=SHIFR _COUNT1=COUNT1 _COUNT2=COUNT2 _A1=A1 _A2=A2 _A3=A3 _A4=A4 _A5=A5 _A6=A6 APPEND BLANK REPLACE SHIFR WITH _SHIFR,COUNT1 WITH _COUNT1,COUNT2 WITH _COUNT2,; A1 WITH _A1,A2 WITH _A2,A3 WITH _A3,A4 WITH _A4,; A5 WITH _A5,A6 WITH _A6 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 ENDIF REPLACE BUFF8->NUMBER WITH STR(numb1,2) REPLACE BUFF8->NAMECL WITH CLASS->NAME_CLASS REPLACE BUFF8->SHIFRL WITH CLASS->SHIFR_LEFT REPLACE BUFF8->SHIFRR WITH CLASS->SHIFR_RIGH IF _OTCH=6 SUM COUNT1 TO _COUNTALL WHILE BUFF8->SHIFR SHIFR_RIGH GO rec REPLACE BUFF8->COUNT2 WITH _COUNTALL ENDIF ENDIF SKIP 1 ALIAS CLASS 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(k=ALLTRIM(_FAM) GO TOP D2=EOF() menu1=5 SET FILTER TO ELSEIF menu1=3 SET CURSOR ON @ 10,45 GET _DATE_IN PICTURE "@D" READ SET CURSOR OFF SET FILTER TO DATE_IN=_DATE_IN GO TOP D2=EOF() IF D2=.F. menu1=1 @ 16,8 CLEAR TO 20,72 DO WHILE menu1#0.AND.!D2 _NUM_IB=NUM_IB _FAM=FAM _DATE_IN=DATE_IN DO first @ 11,14 TO 14,40 DOUBLE @ 12,15 PROMPT "СЛЕДУЮЩАЯ КАРТА " @ 13,15 PROMPT "ПРЕДЫДУЩАЯ КАРТА " MENU TO menu1 IF menu1=1 SKIP D2=EOF() ELSEIF menu1=2 SKIP -1 D2=BOF() ENDIF ENDDO menu1=1 ENDIF SET FILTER TO ELSEIF menu1=5 SKIP D2=EOF() ELSEIF menu1=6 SKIP -1 D2=BOF() ENDIF @ 16,8 CLEAR TO 20,72 IF D2=.F. _NUM_IB=NUM_IB _FAM=FAM _DATE_IN=DATE_IN DO first ELSEIF D2=.T. @ 17,25 TO 19,55 DOUBLE @ 18,31 SAY "БОЛЬШЕ ЗАПИСЕЙ НЕТ!" ENDIF ENDDO SET SOFTSEEK OFF SELECT (sel1) SET COLOR TO (clr1) RETURN ********************************************************************* * ПРОВЕРКА ПРАВИЛЬНОСТИ ЗАПОЛНЕНИЯ КАРТЫ * ********************************************************************* FUNCTION all_r PRIVATE _qui _qui=.F. IF EMPTY(_FAM)=.T. message('e',"НЕ ВВЕДЕНА ФАМИЛИЯ ПАЦИЕНТА") beg_line=1 cur_promp=2 ELSEIF EMPTY(_DATE_B)=.T. message('e',"НЕ ВВЕДЕНА ДАТА РОЖДЕНИЯ") beg_line=1 cur_promp=5 ELSEIF EMPTY(_OLD)=.T. message('e',"НЕ ВВЕДЕН ВОЗРАСТ") beg_line=1 cur_promp=6 ELSEIF EMPTY(_RAION)=.T. message('e',"НЕ ВВЕДЕН РАЙОН ПРОЖИВАНИЯ") beg_line=1 cur_promp=9 ELSEIF EMPTY(_CITY_VILL)=.T. message('e',"НЕ ВВЕДЕН ПУНКТ ") beg_line=1 cur_promp=10 ELSEIF EMPTY(_STATE)=.T. message('e',"НЕ ВВЕДЕНО НАЗВАНИЕ ГОСУДАРСТВА ") beg_line=1 cur_promp=12 ELSEIF EMPTY(_DEPARTMENT)=.T. message('e',"НЕ ВВЕДЕНO НАЗВАНИЕ ОТДЕЛЕНИЕ") beg_line=1 cur_promp=13 ELSEIF EMPTY(_KOIKA)=.T. message('e',"НЕ ВВЕДЕН ПРОФИЛЬ КОЙКИ") beg_line=1 cur_promp=14 ELSEIF EMPTY(_DATE_IN)=.T. message('e',"НЕ ВВЕДЕНА ДАТА ПОСТУПЛЕНИЯ") beg_line=1 cur_promp=17 ELSEIF EMPTY(_DATE_END)=.T. message('e',"НЕ ВВЕДЕНА ДАТА ВЫПИСКИ") beg_line=20 cur_promp=20 ELSEIF _ALL_DAY") beg_line=1 cur_promp=19 ELSEIF EMPTY(_NUM_COME)=.T. message('e',"НЕ ВВЕДЕНО КОЛИЧЕСТВО ГОСПИТАЛИЗАЦИЙ") beg_line=20 cur_promp=22 * ELSEIF EMPTY(_DIA_DIRECT)=.T. * message('e',"НЕ ВВЕДЕН НАПРАВЛЯЮЩИЙ ДИАГНОЗ") * beg_line=20 * cur_promp=21 ELSEIF LEN(vars1[1])=0 message('e',"НЕ ВВЕДЕН ОСНОВНОЙ ДИАГНОЗ") beg_line=20 cur_promp=23 ELSEIF AT("000.0",vars1[1])#0.AND.LEN(vars[1])>80 message('e',"ОШИБОЧНЫЙ ДИАГНОЗ") beg_line=20 cur_promp=25 ELSEIF AT("000.0",vars1[1])#0.AND.LEN(vars1[2])#0 message('e',"ОШИБОЧНЫЙ ДИАГНОЗ") beg_line=20 cur_promp=25 ELSE _qui=.T. ENDIF RETURN (_qui) ********************************************************************* * Представление на экране основной информации из 66 формы * ********************************************************************* PROCEDURE first IF !BOF().AND.!EOF() @ 16,8 CLEAR TO 20,72 @ 17,15 SAY "НОМЕР И/Б :"+NUM_IB @ 18,15 SAY "ФАМИЛИЯ БОЛЬНОГО :"+ALLTRIM(FAM) @ 19,15 SAY "ДАТА ПОСТУПЛЕНИЯ :" @ 19,34 SAY DATE_IN ENDIF RETURN ********************************************************************* * Каталог операций * ********************************************************************* FUNCTION catalog PARAMETERS s,t PRIVATE sel3,screen3,N3 sel3=SELECT() SAVE SCREEN TO screen3 select 0 use cato.dbf index cato alias cato SET SOFTSEEK ON SEEK s SET SOFTSEEK OFF IF FOUND() t=NAME_ILL ELSE private NUILL,K go top nuill=RECCOUNT() declare OPERATION[NUILL] for K=1 to NUILL operation[k]=NAME_ILL skip 1 next release NUILL,K @ 4,1 CLEAR TO 21,78 @ 4,1 TO 21,78 saycent(4,1,78," КАТАЛОГ ОПЕРАЦИЙ ") N3=ACHOICE(5,2,20,77,operation,.T.,"",NUMBER-1) IF LASTKEY()=27 RESTORE SCREEN FROM screen3 use SELECT (sel3) RETURN (-1) ENDIF GO N3 s=SHIFR t=NAME_ILL ENDIF RESTORE SCREEN FROM screen3 use SELECT (sel3) RETURN (0) ********************************************************************* * Процедура настройки каталогов * ********************************************************************* PROCEDURE recon PRIVATE N4,N5,cod_name STORE 0 TO N4,N5 DO WHILE gotomain=.F. cod_name=SPACE(4) codif1("CORR",@N4) IF LASTKEY()=27 SET CURSOR OFF RETURN ELSEIF N4=1 cod_name="RIGS" ELSEIF N4=2 cod_name="DIRS" ELSEIF N4=3 cod_name="STTE" ELSEIF N4=4 cod_name="HOSP" ELSEIF N4=5 cod_name="BIRS" ELSEIF N4=6 cod_name="RIZS" ELSEIF N4=7 cod_name="DEPS" ELSEIF N4=8 cod_name="KOIK" ELSEIF N4=9 cod_name="RIZ1" ELSEIF N4=10 cod_name="RIZ2" ELSEIF N4=11 cod_name="RIZ3" ELSEIF N4=12 cod_name="OLDS" ELSEIF N4=13 cod_name="PLCE" ENDIF codifM("CODIF",cod_name,@N5) ENDDO RELEASE N4,N5,cod_name RETURN ********************************************************************* * Продедура работы с каталогами * ********************************************************************* FUNCTION codifM PARAMETERS codfile,code_name,code_var PRIVATE screen,sel,ret,i,k,svtx,maxlen,color,count,first,x1,x2,y1,y2 PRIVATE prom,prom1 IF !t_qwerty RETURN 0 ENDIF SAVE SCREEN TO screen SET CURSOR OFF color=SETCOLOR() sel=SELECT() SET COLOR TO (color3) SET EXACT OFF SELECT &CODFILE CLEAR TYPEAHEAD prom= "ESC- отказ,ENTER-переименовать" prom1="INS-добавить,DEL-удалить" first=1 DO WHILE .T. SEEK (code_name) IF !FOUND() RETURN "" ENDIF svtx=ALLTRIM(TEXT) maxlen=MAX(LEN(svtx),MAX(LEN(prom),LEN(prom1))) COUNT WHILE SUBSTR(KEY,1,4)=SUBSTR(code_name+' ',1,4) TO COUNT count=count-1 && не учитываем заголовок DECLARE A[count],B[count] * A[]-массив для текстов шаблонов * B[]-массив для номеров шаблонов IF count=0 DECLARE A[1] a[1]=" Кодификатор пуст,воспользуйтесь клавишей INS" maxlen=MAX(maxlen,40) ENDIF SEEK(code_name) FOR k=1 TO COUNT SKIP A[K]=ALLTRIM(TEXT) B[K]=SUBSTR(KEY,5) maxlen=MAX(maxlen,LEN(A[K])) NEXT y1=12-ROUND(MIN(count,13)/2 +0.49,0) x1=37-ROUND(MIN(maxlen,72)/2 +0.49,0) * рисование рамки и заголовка * SET COLOR TO (color3) y2=MIN(y1+count+2,20) x2=MIN(x1+maxlen+3,77) RESTORE SCREEN FROM SCREEN @ y1,x1,y2,x2 BOX singl+fon2 @ y2,x1,y2+3,x2 BOX "+-+¦--L¦"+fon2 saycent(y2+1,x1,x2,prom) saycent(y2+2,x1,x2,prom1) saycent(y1,x1,x2,svtx) I=ACHOICE(y1+1,x1+1,y2-1,x2-1,a,.t.,"u_key1",first) IF i=0 ret="" CLEAR TYPEAHEAD EXIT ELSE DO CASE CASE LASTKEY()=13.AND.COUNT>0 && SEEK(code_name) SKIP I PRIVATE scr,col1,pict pict=SPACE(LEN(TEXT)) scr=SAVESCREEN(10,9,12,70) col1=SETCOLOR() SET COLOR TO (color7) @10,9,12,70 box singl+fon2 saycent(10,9,70,"ВВОДИТЕ НОВОЕ ИМЯ") SET CURSOR ON @ 11,10 GET pict READ PICT=STRTRAN(pict,'Н','H') SET CURSOR OFF SETCOLOR(col1) RESTSCREEN(10,9,12,70,scr) IF LASTKEY()#27.AND.!EMPTY(PICT) && ESC REPLACE TEXT WITH pict ENDIF RELEASE scr,col1,pict CASE LASTKEY()=22 && IF count>0 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 monsmonth(b_dat) old1=alltrim(str(year1)) else if month(today)NUL") DELETE FILE &_file RENAME _0000F TO &_file RETURN 0 ******************************************************************** Модуль: VIEWER.PRG ************************************************************************* * Функция просмотра текстового файла в заданном окне - fileview. * * Для перемещения текста в окне используются * * только: * * Параметры: * * filename - имя файла, * * wt,wl,wb,wr - окно просмотра, * * color - цвет [необязательный параметр], * * linewide - длина строки(гориз. скроллинг) [необязательный параметр]. * ************************************************************************* function fileview parameters filename,wt,wl,wb,wr,color,linewide private col_sv col_sv=setcolor() if pcount()cnt_pos cnt_pos=cnt_pos+1 p="pos"+alltrim(str(cnt_pos)) private &p &p=pos_str endif case f_mov=-1 fseek(fh,file_up,0) file_down=file_down-blok file_up=file_down-3*blok &buf=freadstr(fh,blok) str_vid=&buf buf=if(buf="buf1","buf2","buf1") str_vid=str_vid+&buf count=count-1 p="pos"+alltrim(str(count)) pos_str=&p+wb-wt+1 pos_cur=wb-wt+1 p_vid= rat(last,str_vid) str_vid=left(str_vid,p_vid-1) otherwise endcase enddo fclose(fh) set key 24 set key 18 set key 3 set key 29 set key 30 set key 31 setcolor(col_sv) RETURN(0) function mod parameters mode,line,col private key key=lastkey() do case case key=13 .and. line=lines .and. file_down-1 f_mov=-1 keyboard chr(23) return(0) otherwise lines=line endcase return(0) procedure cr keyboard chr(13) return procedure bl keyboard chr(32) return ----------------------- [pic] |
|
