profesional informatica - evidenta spital

 

EVIDENTA SPITAL

Programul principal : Spital.prg realizeaza o interfata tip meniu care ofera posibilitatea de a face internari, externari, cautari, listari, lucrul cu bazele de date in functie de cele zece optiuni principale ("bar-uri") pe care le afiseaza dupa cum urmeaza:

1. Internare

2. Listare pacienti

3. Doctori

4. Externare pacient

5. Stergere ecran

6. Vizitare pacient

7. Informatii

8. Despre

9. Iesire

10. Iesire in FoxPro

O alta serie de optiuni se vor deschide in urma actionarii asupra unuia dintre bar-urile principale

Bazele de date cu lucreaza programul sunt dupa cum urmeaza :

1.PACIENT.DBF contine campurile : nume, varsta, camera, medic, camera, data _int, data_ext, etaj

2.DOCTORI.DBF contine campurile: nume, varsta ,specializarea, grad, beginprg, endprg, npac, disp, pac1

3.CAMERA.DBF  contine campurile : numar, disponibil, etaj

4.BOALA.DBF contine campurile: simptoma1, simptoma2, simptoma3,simptoma4, nume, test, timp

Spital.prg

set talk off  -impiedica afisarea pe ecran sau intr-o fereastra a conversatiei sistemului

set safety off -cu safety off nu se face avertizarea cand se suprascrie un fisier

clear

close all -inchide toate bazele de date ce pot fi active

use pacient in 1 -foloseste baza de date "pacient.dbf" in zona 1 de lucru

use boala in 2  -foloseste baza de date "boala.dbf" in zona 2 de lucru

use doctor in 3  -foloseste baza de date "doctor.dbf" in zona 3 de lucru

use camera in 4 -foloseste baza de date "camera.dbf" in zona 4 de lucru

declare a[10] -se declara un vector cu 10 elemente

define popup meniu from 5,20 to 15,60 title 'Spital' color scheme 6

- se defineste un popup "meniu" incepand cu linia 5 coloana 20 pana la linia 15 coloana 60

a[1]='1.Internare' 

a[2]='2.Listare pacienti'

a[3]='3.Doctori'

a[4]='4.Externare pacient  - se initializeaza componentele vectorului "a" cu cate o optiune

a[5]='5.Stergere ecran'

a[6]='6.Vizitare pacient'

a[7]='7.Informatii'

a[8]='8.Despre'

a[9]='9.Iesire'

a[10]='10.Iesire FoxPro'

define bar 1 of meniu prompt a[1]

define bar 2 of meniu prompt a[2]

define bar 3 of meniu prompt a[3]

define bar 4 of meniu prompt a[4] -se definesc 10 bar-uri ale meniului principal "meniu" fiecare

define bar 5 of meniu prompt a[5] bar fiind o componenta a vectorului "a"

define bar 6 of meniu prompt a[6]

define bar 7 of meniu prompt a[7]

define bar 8 of meniu prompt a[8]

define bar 9 of meniu prompt a[9]

define bar 10 of meniu prompt a[10]

on selection bar 8 of meniu do despre

on selection bar 7 of meniu do info

on selection bar 1 of meniu do internare

on selection bar 2 of meniu do listare - in cazul selectarii unui bar (optiune) se efectueaza una

on selection bar 5 of meniu do stergecr din procedurile corespunzatoare

on selection bar 6 of meniu do vizitare

on selection bar 3 of meniu do pdoctor

on selection bar 4 of meniu do extern

on selection bar 9 of meniu do iesire

on selection bar 10 of meniu do qtt

activate popup meniu - activeaza pop-upul deja definit si il afiseaza

deactivate popup meniu - dezactiveaza pop-upul si il indeparteza de pe ecran, dar nu si din memorie

procedure qtt

quit procedura "qtt" realizeaza iesirea dintr-un sub meniu

return

procedure despre

clear  - procedura "despre" ascunde meniul principal si afiseaza autorul lucrari de fata

hide popup meniu

wait''

return

procedure iesire

delete file .spital.err - procedura "iesire" face iesirea din program, dezactiveaza meniul, il

deactivate popup meniu indeparteaza din memorie, inchide toate datele de baze.

release popup meniu

close databases

return

procedure internare

clear

hide popup meniu

select 2

replace test with 0 all

select 4

locate for disponibil=.T.

if found()

nrcam=numar

nret=etaj

define window numvars title 'Informatii despre pacient' from 1,1 to 10,45

activate window numvars

@ 2,2 say 'Nume:' get num default(space(25))

read

select 1

locate for alltrim(upper(nume))=alltrim(upper(num))

if found()

@3,2 say 'Pacientul exista in baza de date!'

wait''

release window numvars

else

select 4

@3,2 say 'Varsta: ' get var default 18

read

release window numvars

clear

define window ssii title 'Simptomele pacientului: ' from 1,1 to 22,70

activate window ssii

@4,3 say'Codul simptomelor: '

@5,3 say'0 pentru finalizare'

@6,3 say'1 pentru febra'

@7,3 say'2 pentru durere la inghitire'

@8,3 say'3 lipsa poftei de mancare'

@9,3 say'4 pentru tuse'

@10,3 say'5 pentru iritatii'

@11,3 say'6 daca pacientul nu are pofta de mancare'

@12,3 say'7 pentru dureri de burta'

@13,3 say'8 pentru durere de cap'

@14,3 say'9 pentru transpitratii'

@15,3 say'10 pentru dureri la nivelul cosului pieptului'

@16,3 say'11 pentru senzatii de voma'

select 2

replace test with 0 all

declare simptoma[5]

for i=1 to 5

input 'Simptoma: ' to simpt

if simpt=0

simptoma[i]=0

exit

else

simptoma[i]=simpt

select 2

go top

scan for (simptoma1=simptoma[i]).or.(simptoma2=simptoma[i]).or.(simptoma3=simptoma[i]).or.(simptoma4=simptoma[i])

replace test with test+1

endscan

endif

endfor

select 2

if simptoma[1]=0

?'Nu suferiti de nici o boala,nu e nevoie sa fiti internat'

wait''

release window ssii

return

else

select 4

replace disponibil with .F.

select 2

go top

calculate max(test) to maxsimpt

?'Pacientul este suspect de: '

locate for test=maxsimpt

??nume

?'Urmeaza sa fie internat pentru cercetari.'

wait''

release window ssii

boalal=nume

dataext=timp

select 1

go bottom

append blank

replace nume with num,varsta with var

replace data_int with date(),camera with nrcam,etaj with nret

replace data_ext with date()+dataext

replace boala with alltrim(boalal)

clear

?'Pacientul a fost internat in camera ',alltrim(str(nrcam)),' la etajul ',alltrim(str(nret)),'.'

?'Pacientul este sub ingrijirea doctorului:'

select 3

locate for disp=.t.

if found()

replace npac with npac+1

if npac>=4

replace disp with .f.

endif

if len(alltrim(pac1))=0

replace pac1 with num

else

if len(alltrim(pac2))=0

replace pac2 with num

else

if len(alltrim(pac3))=0

replace pac3 with num

else

if len(alltrim(pac4))=0

replace pac4 with num

endif

endif

endif

endif

??' ',nume

wait''

else

?'Nu mai sunt camere libere,nu se mai fac internari'

wait''

endif

endif

endif

endif

endif

return

procedura interanare

ascunde meniul

selecteaza zona 2 de lucru

inlocuieste toate campurile test cu 0 (adica initial pacientul nu sufera de nici o boala)

se selecteaza zona 4

cauta pentru campul disponibil

dc.acesta este true adica daca este pat disponibil se inregistreaza nr. camerei si etajul la care se afla

- se defineste o fereastra numvars (care contine informatii despre pacient

- utilizatorului i se cere sa introduca un nume - daca acesta este in baza de date se afiseaza mesaj

- daca nu se selecteaza zona de lucru 4,

- se cere varsta pacientului

- se prezinta o serie de simptome din care se aleg cele corespunzatoare (in functie de simptomele alese se identifica boala si se afiseaza camera si etajul la care va fi internat pacientul, precum si doctorul care se va ocupa de el si intre ce ore)

- daca nu mai sunt paturi libere se afiseaza mesajul : Nu mai sunt camere libere nu se mai fac internari

procedure listare

select 1

hide popup meniu

index on nume to ordpac - listeaza toti pacienti din pacient.dbf. cu campurile: nume si varsta

?''

list fields nume,varsta off

wait''

return

procedure stergecr

clear - sterge ecranul

return

procedure vizitare

hide popup meniu

clear

@2,2 say 'Nume pacient: ' get num default(space(25))

read

select 1

locate for upper(alltrim(nume))=upper(alltrim(num))

if found()

nrcam=camera

nret=etaj

?'Pacientul este internat in camera: ',alltrim(str(nrcam)),' etaj: ',alltrim(str(nret))

else

?'Pacient inexistent,sau externat.'

endif

wait''

return

Procedura vizitare

-cere utilizatorului sa introduca un nume

- daca acest nume se afla in baza de date atunci este afisata camera si etajul in care este pacientul

in caz contrar se afiseaza mesajul : pacient inexistent sau externat.

procedure pdoctor

hide popup meniu

define menu medic Message 'Doctorii din spital'

define pad p1 of medic prompt '<Listare' at 1,26 key alt+l,''

define pad p2 of medic prompt '<Stergere Ecran' at 1,36 key alt+s,''

define pad p3 of medic prompt '<Bolnavi' at 1,53 key alt+b,''

define pad p4 of medic prompt '<Program' at 1,16 key alt+p,''

select 3

on selection pad p1 of medic do listmed

on selection pad p3 of medic do med2bol

on selection pad p2 of medic do stergecr

on selection pad p4 of medic do programmed

clear

activate menu medic

return

Procedura pdoctor

Defineste un meniu cu 4 pad-uri respectiv :p1,p2,p3,p4

in cazul selectarii p1 se executa:

- procedura listmed care face listarea tuturor medicilor cu

campurile nume, grad, specializ

daca se selecteaza p2 se executa procedura de stergere a ecranului

- daca se selecteaza p3 se executa:

- procedura med2bol afiseaza numele medicului si cati pacineti are acesta in ingrijire

daca se selecteaza p4 se executa :

- procedura programmed - listeaza orele intre care un medic are grija de pacinetii sai.

procedure programmed

clear

hide menu medic

?''

ora1=9

ora2=11

select 3

scan

nr=7

if len(alltrim(pac1))!=0

nr=nr+2

endif

if len(alltrim(pac2))!=0

nr=nr+2

endif

if len(alltrim(pac3))!=0

nr=nr+2

endif

if len(alltrim(pac4))!=0

nr=nr+2

endif

if nr=7

ora1=ora1+2

ora2=ora2+2

if ora2>=24

ora1=0

ora2=2

endif

replace beginprg with nr

replace endprg with nr+3

? alltrim(nume),'Nu are nici un pacient in ingrijire.'

else

replace beginprg with 7

replace endprg with nr

?'Medicul ',alltrim(nume),'va avea grija de pacient(i) intre orele: ',beginprg,' si ',endprg

endif

wait''

endscan

return

procedure med2bol

select 3

hide menu medic

?''

scan

?'-------- ----- ------ ----- ----- ------------'

?nume

if npac>=1

?'are ',npac,' pacient(i):'

?''

if len(alltrim(pac1))!=0

??' ',pac1

endif

if len(alltrim(pac2))!=0

?' ', pac2

endif

if len(alltrim(pac3))!=0

?' ',pac3

endif

if len(alltrim(pac4))!=0

?' ',pac4

endif

else

?'Nu are nici un pacient in ingrijire'

endif

wait''

endscan

return

procedure listmed

hide menu medic

?''

index on grad to ordmed

list nume,grad,specializ off

wait''

return

procedure extern

hide popup meniu

select 1

scan

@2,7 say 'Doriti sa faceti externari?' get varr function '*R Da;Nu' default 0

read

if varr=2

return

endif

locate for date()-data_ext>=0

if found()

num=nume

nrcam=camera

?'Pacientul ',alltrim(num),' este externat'

wait''

clear

delete

pack

select 3

locate for alltrim(upper(pac1))=alltrim(upper(num))

if found()

replace npac with npac-1

if npac<4

replace disp with .t.

endif

replace pac1 with ''

endif

locate for alltrim(upper(pac2))=alltrim(upper(num))

if found()

replace npac with npac-1

if npac<4

replace disp with .t.

endif

replace pac2 with ''

endif

locate for alltrim(upper(pac3))=alltrim(upper(num))

if found()

replace npac with npac-1

if npac<4

replace disp with .t.

endif

replace pac3 with ''

endif

locate for alltrim(upper(pac4))=alltrim(upper(num))

if found()

replace npac with npac-1

if npac<4

replace disp with .t.

endif

replace pac4 with ''

endif

sele 4

locate for numar=nrcam

replace disponibil with .t.

else

?'Ne se pot face externari,sau baza de date este vida'

wait''

clear

endif

endscan

return

procedura extern

ascunde meniul

selecteaza zona 1 de lucru

intreaba utilizatorul daca doreste sa faca externari : in caz ca pacientul exista atunci se afiseaza mesaj ca a fost externat si este sters din baza de date, eliberandu-se astefel camera, programul medicului etc.

- daca numele introdus nu se gaseste in baza de date se afiseaza mesaj corespunzator

procedure info

hide popup meniu

define menu informatii Message 'Informatii utile'

define pad pp1 of informatii prompt '<Camere' at 1,20 key alt+c,''

define pad pp2 of informatii prompt '<Stergere Ecran' at 1,28 key alt+s,''

define pad pp3 of informatii prompt '<Pacienti' at 1,43 key alt+p,''

define pad pp4 of informatii prompt '<Timp' at 1,52 key alt+t,''

on selection pad pp1 of informatii do camr

on selection pad pp3 of informatii do pacb

on selection pad pp2 of informatii do stergecr -se realizeaza un meniu "Informatii utile" cu patru

on selection pad pp4 of informatii do timp2pac pad-uri care afiseaza informatii despre pacienti,

activate menu informatii camere,perioda internarii

return

procedure camr

define menu camre Message 'Camera'

define pad ppp1 of camre prompt 'Camere libere' at 2,31

define pad ppp2 of camre prompt 'Lista camere' at 3,31

on selection pad ppp1 of camre do infoc

on selection pad ppp2 of camre do listcam

activate menu camre

return

procedure infoc

hide menu camre

?''

sele camera

ii=0

scan for disponibil=.T.

ii=ii+1 - calculeaza numarul camerelor disponibile

endscan

?'Camere libere: ',ii

return

procedure listcam

hide menu camre

clear

?''

select camera

scan -listeza camerele care sunt libere sau ocupate

if disponibil=.T.

@3,4 say 'Camera '+alltrim(str(numar))+' este libera.'

wait''

clear

else

@3,4 say 'Camera '+alltrim(str(numar))+' este ocupata.'

wait''

clear

endif

endscan

return

procedure pacb

hide menu informatii

select pacient

?'' -listeaza numele pacientilor internatii precum si boala de care sufera

list nume,boala off

return

procedure timp2pac

select pacient

?''

scan all

v=date()-data_int  -procedura listeaza perioada internarii un pacient

if v>0

?alltrim(nume),' este internat de ',alltrim(str(v)),' zile'

else

?alltrim(nume),' a fost internat astazi'

endif

endscan

return