Разработка автоматизированной системы учета выбывших из стационара
Дипломная работа - Компьютеры, программирование
Другие дипломы по предмету Компьютеры, программирование
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 EN<58
_0B[k]=SUBSTR(str,length*(j-1)+1,length)
_0S[k]=LEFT(ALLTRIM(_0B[k]),5)
k=k+1
ELSE
_0B[k-1]=_0B[k-1]+SUBSTR(str,length*(j-1)+1,length)
ENDIF
NEXT
NDEL=ACHOICE(13,35,15,45,_0S)
SELECT BUFF
IF q=1.OR.q=4
SEEK _NUM_IB+IF(q=1,"1","2")+"1"
ELSEIF q=2
SEEK _NUM_IB+"1"+"2"
ENDIF
SKIP NDEL-1
DELETE
PACK
str=""
FOR j=1 TO MALL
IF j#NDEL
str=str+_0B[j]
ENDIF
NEXT
RELEASE j,NALL,NDEL
RELEASE _0B,_0S
ENDIF
vars1[q]=str
RESTORE SCREEN FROM screen
CASE q=3.OR.q=5.OR.q=6
PRIVATE str356
STORE "" TO str356
SELECT BUFF
private s
s=_NUM_IB+IF(q=3,"1","2")+IF(q=5,"2","3")
SEEK s && _NUM_IB+IF(q=3,"1","2")+IF(q=5,"2","3")
IF !FOUND()
APPEND BLANK
REPLACE NUM_IB WITH _NUM_IB
REPLACE KOD1 WITH IF(q=5,"2","3")
REPLACE KOD2 WITH IF(q=3,"1","2")
ENDIF
SET CURSOR ON
REPLACE COMM1 WITH ;
MEMPRO(COMM1,10,5,15,75,;
IF(q=5," ВВЕДИТЕ НАЗВАНИЯ ОСЛОЖНЕНИЙ ",;
" ВВЕДИТЕ НАЗВАНИЯ СОПУТСТВУЮЩИХ ЗАБОЛЕВАНИЙ "),;
"ILLS",ILLS)
context(@str356,"",ALLTRIM(COMM1),length,.F.)
vars1[q]=str356
RELEASE str356
ENDCASE
new_str1=.T.
string111=""
context(@string111,promp1[q],vars1[q],length,New_Str1)
IF q=3.AND._END1=3
context(@string111," "," ",length,.T.)
context(@string111,SPACE(10)+"Паталого-анатомический диагноз"," ",length,.T.)
ENDIF
stuff1(@string11,length,string111,q,row1,len(promp1))
ENDDO
REINDEX
gotomain=.F.
SELECT (sel)
RETURN (string11)
*********************************************************************
* Процедура работы с операциями *
*********************************************************************
PROCEDURE op
PRIVATE txto,sel,w_do
PRIVATE F2,screen,color
PRIVATE stro
STORE "" TO stro
txto=SPACE(80)
_SHIFR_ILL="0000"
sel=SELECT()
SAVE SCREEN TO screen
@ 11,25 CLEAR TO 16,55
@ 11,25 TO 16,55 DOUBLE
@ 11,30 PROMPT "ДОБАВИТЬ"
@ 11,44 PROMPT "УДАЛИТЬ"
IF EMPTY(vars[choice])
KEYBOARD CHR(13)
ENDIF
MENU TO w_do
stro=vars[choice]
IF w_do=1
@ 13,30 SAY "ВВЕДИТЕ КОД" GET _SHIFR_ILL PICTURE "@R 99.99"
READ
RESTORE SCREEN FROM screen
IF LASTKEY()=27
RETURN
ENDIF
F2=catalog(@_SHIFR_ILL,@txto)
IF F2#-1
SELECT BUFF2
APPEND BLANK
REPLACE NUM_IB WITH _NUM_IB
REPLACE SHIFR WITH _SHIFR_ILL
REPLACE DATA WITH d_input(DATA)
SET CURSOR ON
REPLACE COMM WITH ;
MEMPRO(COMM,10,5,15,75," ВВЕДИТЕ НАЗВАНИЕ ОПЕРАЦИИ ","OPER",OPER)
context(@stro,"",ALLTRIM(txto)+".",length,.F.)
context(@stro," Дата проведения : ",DTOC(DATA)+".",length,.F.)
context(@stro," Название операции : ",ALLTRIM(COMM)+".",length,.F.)
ENDIF
ELSEIF w_do=2
PRIVATE i,j,k,EN,ET,NALL,MALL,NDEL
NALL=INT(LEN(stro)/length)
MALL=NALL
FOR i=1 TO NALL
ET=ALLTRIM(SUBSTR(stro,length*(i-1)+1,length))
EN=ASC(ET)
IF EN<>60
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 _PL