NEAR EAST UNIVERSITY FACULTY OF ECONOMICS AND ADMINISTRATIVE SCIENCE DEPARTMENT OF COMPUTER INFORMAİION SYSTEMS

(1)

NEAR EAST UNIVERSITY

FACULTY OF ECONOMICS AND

ADMINISTRATIVE SCIENCE

DEPARTMENT OF COMPUTER

INFORMAİION

SYSTEMS

200212.UOJ.SUMMER-TERM

CIS 400

(Gra~uation Project)

Submitted To

: Dr. Yalçırl Akçalı

Miss.Nadire Çavuş

Submitted By

"': V~dat Gözügüzelli (950499)

Lefkoşa

2001--,1~}l!MIWJI

NEU ! I j i /.

(2)

'.eAGE

I.AKNOWLEDGMENTS...

.. ..

..

1 II. ABS TACT

--···---··

, _ ·-··---

---· -·-·-···

··-·----

,. . . .

~

III.INTRODUCTION...

3 IV.EXPLANATION

OF SYSTEMS...

,..

-Data Flow Diagram

,

1

S

- System.Block. Diagram.. ..•... ,..•... ·-····-···--..,.-···-·---·-···---···,... \

O

- Database Design

,

1"\

V.US.ER MANUAL ...•... ,

_.

,.

.,.

\3

VI.LIST Of SUBPROGRAMS

,

.

- Program.Flow Chart,

···--···---····-···---···-····-.. .. .. .. ..

\

"b

r Source Program

\...

.5

2..

- Screen Output.

_.

,.

'\5

VII ..R.EFERANCES ...•... _

-

\

00

(3)

AKNOWLEDGMENT

I would like to thank

my

teachers Dr.Yalçın Akçalı and Miss.Nadire

Çavuş for their valuable quidance in the course off this work.

I '

I

r

l

i

I

(4)

ABSTRACT

This project is about managing a middle sized medical office data processing. The

patient datas ~

stored and managed as files and kept as medical record of certain

individual patients.

This program makes data processing and managment in medical office an easy job

storeing data and keeping records off patients manually is a time consuming process.

In this program step by step ,approach simplifies run time data enty and medical

report keeping so this program allows user data entry deleteing record,upgrading

searching and getting a print out printer

Of

screen.

1

(5)

-III. INTRODUCTION

This program helps managment of data and medical records maintained in asmall to

medium sized medical office surroundings while using.the program the user can

enter patients records,delete or edit records maintain and upgrade while geting a

detailed print out of a certain record monitor or printer.The user can also view the

patients payment information on the screen furthermore the user can enter and have

access to information regarding medical expenditures of the office such as

injectors,surgical materials,pills etc.

This program has been programmed with Visual Basic6.0. The database ofte

program is the ACCESS database.

To install clinick system into computer needs about minimum 2 mb harddisc

space. You can find the information about installation in USER MANUAL part of the

documents.

I will prepare a Clinick information system project that includes the

automation of all manual processes which are made during the execution of a

Clinick data processing system . In my project we have 4 main processes to be

used.

1 - Record Process

2 - Account Process

1 -

Search Process

4 ~ Report Process

5

=

Exit

Explanation of Main Processes

I-Record process:This project includes

4 sub processes.

1.1-New Record Process

1.2-Patient medical autobiography process "

1.3-Patient phsycal cure process

1.4-Study and analysis process

Details of the subs processes of the record processes:

1.1-New Record Process:

This process allows new data input,update,search,delete and patient identification information

print-out

1.2. Patient medical autobiography process:

This process allows data entry,update,search,medical autobiography of the patient and

print-out

1.3-Patient phsycal cure process:

This process allows the general physical information about the patient.update.search and

print-out.

(6)

1.4-Study and analysis process:

The.resıılt.of.lah findings and the doctors opininon, recomm.endation,.entry~update,.s.earch,

print-out

2- Account Process:

This process allows patients receivable payment, information,.remaining.am.ount,and

the other

related transactions.

3-Search Process:

This process allows. us.er to find the. file numb.er. and.the.idenıification

of the. patient. This

search is done either by file number or the last and the first name of the patient.

4-Report Process:

Th.is process is divided into two sub-processes.

4.1-Lls.t of all patients:

Th.is process allows wieving of th.e. list of the total. number of patients.

4.2-Patient

authentic

information:

This process allows. detailed.and. spesific, information. regarding..p_atientS.: medical

records

and

the treatment procedure.

5-Exit:

This process allows. quitting. the program.

MINIMUM

SYSTEM REOIBREMENTS

TO EXECUTE PROGRAM

Any windows s.ys.temvergion.e.nough

Need Minimum 2 or more Gb harddisc space

4Mb.VGA

Processors 333mhz or more

s

or

t-nQ.te..:Mlı-Ram

800 x 600 Screen Resolution

22 x Cd Rom or a Flopy

(7)

· nh" "blto

Patient M.edıcal _ı\utobıogta:r

-s

~fo

about patient medical Autobiog,aphy

••

ı

~Study

And Analysis Info Any Patient

~ı

·Patientauthentic report

ııı,,f

·PatientPhysical Cure Info

...,

(8)

l?f)dn1q;}a

w;}rrua.

.ı{qrıt[ Jq;,([ fü;;,!Jl?& ~ OJrqJq;,p JCl;}fJl?J· . ll

--.•..

,$

"'

(1)

g. .=ı·

;;.

i:l

-~

~

.El

P'<

-

Request patient id knoledge

"'

<il (I) (.) o

•....

c,

'E

o (.) (I) p:::

~

u

8

(9)

Study And Analyze Info AnY -Patient o

~

.£

~

o

~

M

~

.

c:ı

~

_.I

~

_t;l p..

(10)

(11)

Medical Autobiography info; . (1)

-·-·

µ;o;

I

c;:l·

·-

;;>-.ı

t,j ~·

q

(12)

: 1(/)

-<

•Cl)

-ı

m

. i:

·.,a,

·r-0

(")

ı~

·•C

-

.;;:

Ci)

;tJ

:-1>·

_:;:

-n

.10

~

··o

r-

(13)

··-DATABASEOESJGN

KAYİT2 ELE

FLLL.t} \ i\f

t·cc•rr·r

'Vvnu,···rrr

_nc:t:

AD

rsxr:

10 o

SOYAD

TEXT·

15 o

DOGUMTAR

DATE

8 o

ADRES

TEXT

50 o

KAYTAR

DATE

8 o

SAYAc·

LONG

4 o

KANGUR·

TEXT

6 o

-MEDDUR

TEXT-

6 o

CİNSİYETİ,-

TEXT

7 o

TELNO ·

TEX-T

so·

o

KiMLiK

TEXT

50-

o

..

KA.YİTBLE

FIELD NAME

TYPE

WIDTH

DEC

SAYAC

LONG

4 o

·-

·,

-SİKAYETt ·

TEXT

250··

o

HİKAYESİ

·TEXT

250 o

GECHAS

.TEXT

25ff

o

'

·-TRAFİK

TEXT

250·

o

'

AİLEHAS

TEXT

250 o

'

ALERJ-i

TEXT

250 o

ALİSKANLİK

TEXT

250. o

' '

KULİLAC

TEXT

_"

250 -o

ZİYTAR

DATE

a.

o

·-

'

GELSAY

LONG.

4 o

'

FİZİKMU'SLE

FIELD NAME

TYPE

WIOTH.

DEC

BATAR·..

DATE

8 o

'

NABİZ·

TEXT

tOU

o

'

KANBASİNOf

TEXT

100 o

'

ATES

TEXT

100 o

'

SAYl1

'LONG

4 o

' ' '

SAYAC

LONG

4 o

BOY

TEXT

6 o

'

(14)

KILO

TEXT

8

\

o

SFMBULGU

MEMO

..

Q

IHTlMAU--

-MEN-O-

o

-..

TEDAV~--

MEMO

o

-'

FIELD NAME

TYPE

WIDTH.

DEC

LABARATUAR

'.

TEXT

250

Q

IDRARTET-

TEXT

25Cl.

o.

EKG·

FB<r-

25&·

(}-RADYOLOJi·

TEXT

\

25(T

()"

BUT AR

DATE

8 o

SAYAC-

' .

LONG ...

4,.

a

SAYiCJK

LONG--

4-

(}

MUHASEBE FILE

FIELD NAME

TYPE

WIDTH

DEC

I

SAYAC

LONG

4 o

-BATAR

DATE..

&,.

o

ALINAN·

LONG

4·

E)

...

(15)

V - USER MANUAL

How To Install This Program;

1- Put the CD into the CD ROM. Then click the

.~

~

"my computer'' icon

mımımıı.

f

_-

--ı

...-·

-2- Click CD ROM icon to open CD. Then Click the icon.

~

e=

.

Vedo

3

-

N

OW CIC

I . k h

t e , ,

:kur:

icon. Now you will see the

setup

icon.

tiöHUJ#lliP;Md;!iııfü --

_- - ~- "__

__

.

-ıı±ıJ2$JI

Welcome to the GOZUGUZELLI

!

KLİNİK PROGRAMI Setup Wizard .

This wiR install VERSION 1.0 on your computer.

It is recommended that you close aH other apphcations before continuing.

Click Next to continue. or Cancel to exit Setup.

4- This is setup page. Click next button to start installation.

5- Then you chose the programs directory

~5etııp\.¥,GÔ2ÜGÜ2Ellİ KLİNİKPROGRAMI

..-,,,.l'Jl2:~!1

Select Deatinalion Diıectı:,ıy ~,

\ı/here should GOZüGüZELLi KLİNİK PROGRAM I be installed? ~ i

...

~

··,,···,--,····-·.,-.,.·-- ..·---··--·--·-··-·-·.·-,·.-···-•---··'-.··.,.•.•··-~

Select the folder where you would like GOZüGüZELLi KLiNiK PROGRAM! to be installed. then click Next

1

,.=)adreste! ..:"') Copy of edb

.;:::ı

Copy of NOKİA

c: veda

The program reqı,ıires at least 22.7 MB of disk space.

(16)

6. when chose directory then chose the where should place the setup

program's shortcut._

-~-

.

~ S~tııp'\'/fıG!-J?ÜÇ\.İZELL

Select Staıt Menu Folder

\ı,/here should Setup place the program's shortcuts?

---,---~---· ---·--- ...-·

---Select the Start Menu folder in which you. would like Setup lo create the program's shortcuts. then c~c;k Nekt.

1BmfiifA:ı•ffliiılOif:ı;mQlTı-: Accessories

Administrative Tools Adobe Acrobat 4.0

Easy Applet Builder Games

IDAutomation.com. Inc. Applications lnno Setup 3

Java Stuff 2 Microsoft O ffüı:e Tools Microsoft SQL Server 6.5 :ıMir.rn~nft Vİ5:IJAI Slurlin hn

<Back [ Next> Cancel

7. When chose the setup place the programs shortcut place then show select

additional task form.

r

I

r

I'

Se!e::t.iie ;,,:!d~o,-ı.al~.ası..~)".l<iw,:>'Jl::i likeSEtl,'!) to p.wı:ır.m ,1hJ, imt,11.1'.g

ti1'.ıZOuüB::llİKUMı::. PitDGRi'•ML Ihmobi<. H6'•.t i~d:fı:•)ffil ;'c,;m')'

(17)

8.Then click next program installer redy to install program.

R<ead:v to, ln;ıa11

~i"et~t..p r.:rhö~.ı,ıe..,JJ.'h,ib::~ı'ıi·~t.&'l:n9 GDZ06L't2E

ıu

Kii.İt·llı< P~~o.n comcuıe-ı.

,ô,d,i!i;:mlta::\t:

ıo~t~ a

ds"tfl:..ttPtroı-.;-9.When click to install button start setup and show completing setup wizard form.

Completing the GÔZÜGÜZELLİ

K(,İNİK PROGRAMI Setup Wizard

Setup has finished installing GtlZÜGÜZELLİ KLİNİK PROGRAM! on your computer. The application may be launched by selecting the installed icons.

Click Finish to ewit Setup.

P Launch GOZUGUZELLi KLİNİK PROGRAMi

Finish

Click finish button and program locat~ your system.

. Now you can find the program your desktop. If you click Gözügüzelli Klinik

programı. shortkcut then you will see the Main Menu .

Program has 5 type process Menus and one about program info button,.

.

Arama Raporlar

Yeni

kayıt

,

Kayıt Muhasebe Arama Raporlar Hekkmde Çıbş r

Hastanın Tıbbi Özgeçmişi Muayene Bulguları ve Tedavi Tetkik ve Tahliller

(18)

1. RECORD

1.1 YENİ KAYIT (NEW RECORD): add new record. see figure 1'

1.2 HASTANIN TIBBİ ÖZ GEÇMİŞİ(MEDICAL AUTOBIOGRAPHY): This is used

for adding the patient autobigraphic information.

(KIRTASİYE ALIŞ ESKİ KAYITA EKLEME) see figure .2

1.3 MUAYENE BULGULARl(PATIENT PHYSICAL CURE): This is used for adding

the patient physical cure nformation. see figure .3

1.4 STUDY AND ANALYSIS : This is used for to adding study nad analyse results

see figure.5

2-ACCOUNT

Kayıt

f

M~hasebe Arama Raporlar Alacaklar }

2-ACCOUNT

2.1 ALACAKLAR(PATIENT DEBT) : This is the adding debtor patient record.

(PERSONEL KAYiT) see picture 6

3-SEARCH

Kayıt Muhasebe

J

A~a,.;;a-, Raporlar Hakkında Çıkış

I

~oy

isme,isme

veı

dosyan~y!2ör;_~

j

3~SEARCH

3.1 SOYİSME,İSME VE DOSYA NOYA GÖRE ARAMA(SEARCH BY SPECIFIC

ORDER) :Seach Patients record by id information. See figure. 7

(19)

4-REPORT

4. 1 HASTALARIN LİSTESİ(LIST

OF ALL PATIENT): Show all patients charactheristic

knowledge. See figure. 8

4.2 HAST AY A ÖZGÜN KAYITLAR( PATIENT AUTHENTIC REPORT): Show authentic

report pany patient. See figure. 9

5-ABOUT

5-1 HAKKINDA(ABOUT):Give

information about program.See figure. 10

6-EXIT

(20)

VI. List of Subprograms

USER FLOW CHARTS

START

1- RECORD 2-ACCOUNT 3-SEARCH 4..;REPORT 5-E~IT

0

,, <

(21)

YES

(22)

""·

1 - NEW RECORD

2 - MEDİCAL AUTOBIOGRAPHY 3- PATIENT PHYSICAL CURE 4 - STUDY ANO ANALYSIS .

(23)

L

YES

·G

(24)

1 - SAVE. 2- SEARCH 3- UPDATE 4-DELEtE

q-

PRINT OUT . i

r:ı

C)

NEW RECORD

C

~

~8

. /,

(25)

NTERING PATIENT INfORMATION Y.!:iS r/ ,-.'-

___

j"o

RETURN TO· MAİN MENU

(26)

SEARCH( ANY PATl~NT ID RECORD)

ENTER PATIENT DOSSIER

NUMBER A(.LABOUT PATIENTID INFORMATIOM·\)·

. DISPL,AYED .

'---~---·"

YES

NÇ)T FOUND .'J, NO RETURN

to·

MAİN MENU

-~---

..·~

(27)

UPDATE.(

ANY PATIENT ID

RECORD)

r

~NTER

DOSSIER

NUMBeR

,' ".· f\lOTfOUND

~

YES

., •• ,, 1' NO INFO. OF

SEARCH

Pf,..TIE:NT

RETURN

TO

MAİN MENU

_ ____,_(',r

DATA

ST(}REil

(28)

ENTER PATIENT DOSSIER . NUMijER . TO SEARCH INFO. OF SE4.RCH PATIENT

.~·'Jı

DELETED · PATIENT INFO . .'?,. NO RETURN TO MA!NMENU

(29)

PRINT

.

f

.

PATIENT ID KNOWLEDGE PRRINT OUT)

' ..' ..

.

;. ' ';.'. . ...

ENTER MTlENT DdSSIER NUMBER .. TO SEARÇH INFO. OF SEARCH PATIENT YES

~

NOTfOUND

)

(

_;~

..

~

ı

NO I PRlNTED IPCLIC~

YES

_I

••

YES EXIT NO RETURN TG

11

NO

· MAİNMENU ,. RETURN

ro'

(30)

¥f:DICAL AUTOBIOGRAPHY

1 -SAVE ~- S~ARCH 3-UADATE A- P~INT OUT

0

' . .

D

·-

'\

YES

ı,.(

1.1.4)

,./'

(31)

SAVE (AUTOB10GRAPHICAL

INFO}

ENTER DOSSIER l'jUMBER .Ô: NO NOT FQ\JND

· "· ·r-

NO INFO. Of ID SEARCH PATIENT ENTERING PATIENT AUTOBIOG. INFO ·RETURN TO MAİN MENU YES NO

--,·

DATA ( STQRED, \

(32)

SEARCH (ANY PATIENT AUTOBIOG.

RECORD)

' ' . ' . . YES NO AUTOBIOG. INFORMATION . ABOUT PArl$NT . DISPLAYED NOT FOUND NO

ENTER

PATIENT

VISIT

NLJM~FR

NO YES

o

ro

(33)

UPDATE(

ANY PATIENT AUTOBIOG. RECORD)

1:NTE~ DOSSIER NUMBER. YES NO NOT FOUND YES RETURN TO MAİN MENU INFO. OF ID SEARCH PATIENT NTER PATIENT VİSİT NO AUTOBIOG.INFO YES FO. OF AUTOBIOG. SEARCH PATll=.NT

NO

UPDATE PATIENT AUTOBIOG.INFO YES

(34)

PRINT (PATIENT AUTOBIG. KNOWLEDGE

PRRtNT OUT)

. ' \. ' . ': .. ' . . '

YES

ALL AUTQSIOG. INFORMATION ABOUT PATIENT

DISPLAYEiD NO

PATIENT ID. INFORMAl'ION

[)1$P~YEP. . . . NOT FPVND ENTER P,A.Tl!;NT VISIT NU~Si;R YES NO -ı..

(35)

PATIENT PHYSYCAL CURE

1.,..SAVF 2- SEARCt, · 3-4PDATf: 4-, PRINT

our

E

C'

"

YES

lit

1.1 A \

/

__

,..

(36)

SAVE (PHYSICAL CURE INFO)

_{. .} _. _; _. ...

NO

NOT

FOUND NO INFO. OF ID. SEARCH PATIENT ENTERING PATIENT PHY::\ICAL. INFO

"''

YES

NO

RETIJRN ·TO,'' MAİN MENU DATA STORED ,ı

(37)

SEARCH (ANY PATIENT PHYSICAL CURE .. RECORD)

,;;ı,ı·>4>1 ••• ,~~-~·---•

--

.•

---ENTER

PATIENT DOSSIER

NUMBER

YES PH'(;~c

60 ~~~:rıoN

DISPL.AYEC> NO NOT FOI.JND

ENTER

P,4tıENT

VIŞIT NUMBER

}

~

NO NO

_____

__._

__

....,._. •\,.•...•

...•,,,,

PHUSICAL CURE INFOR~kfl(l~l \

ABOUT PAlHpNif

t

DISPLAYED

l

,i

--""

V)

CV) YES

(38)

UPDATE

(ANY :PATIENT :PHYSICAL CURE. RECORD)

....,.. ..,,..,.,. YES

NO

NOT FOLJNq YE$ RETURN TO MAİN MENU INFO. Of ID SEARCH PATIENT

NTER PATIENT ViqİT

NO

AUTOB!Qq. INFO

YES

NO

NFO. OF PHYSIGAL CURE . . , SEARCH

PATIENT

NO· UPDATE PATIENT

pHısıcAL CURl;.ıt,ıı,o

--1···-DATA STORED .... YES

(39)

PRINT( PATIENT PHYSICAL CURE KNC>WLEDGE PRRINT OUT)

ENTER PATIENT DQSSIER NUMBER YES NO NOT FOUND

YES

NO

PATIENT IP. INFORW\TIQN PISPLAYl:D ENTER PATIENT . VISIT

t-JUM6i;R

YES

NO

PHYSICAL CURE INFORMI\T!ON . . ABOUT PATIENT .

(40)

STUDY AND ANAL YSE

1 -, S.AV~ 2- SijA~CH 3 .., U !PD,\ TE; 4- PRINT QUT

Q.'

l~J

'

F

(41)

SAVE (STUDY AND ANAL YSE INFO)

. . ' ' . : ' . '. ·' ,ı .· .

NO

NOT FOUND

YES

INFO. OF ID

SEARCH PATIENT ~NTERING PATIENT

STO. AND ANALYSE. !NF

ıı YES NO RETURNTÜ MAİN MENU DATA ST:0RED

(42)

SEARCH (ANY STUDY AND ANAL YSE .. RECORD)

. . ' . ', .

.

.' ..

...,...,..~"""~~,.,...,~·-- ..•...•.

~.-,,.~~~~~---~--

.•..

ıı

~~~..,.

'I,

TUDY AND ANALYSE INFORMATION \

, ABOUT PATl~NT . )·

DISPL.fı.YED ·

YEq

NO

'STUDY AND ANALYSE INFORMATION

, . '. . ABO\JT PATIENT .. . ' DISPLAYED

o

_!('

YES NOT F<~UND NO NO

---~

(43)

UPDATE (ANY PATIENT STUDY AND ANALYSE,

~CORD)

.' Et-:JTER DOSSIER NUMl;l~R NO YES _{INFO. OF ID} SEARCH PATIENT NOT FOUND NO YES

NO

FO. ABOUT STD&ANAL YSE SEARCH PATIENT RETlJl&TO MA,İNMENU UPDATE PATIENT STD&ANALVS~İNFO

DAT:-(-_.

STO:R.El)

---~~~

YES

(44)

PRINTOUT(PATIENT

STUDY AND ANAL YSE KNOWLEDGE)

I . ENTER PATIENT DOSSIER NUMBER NO

PATIENT ID. INFORMATION . DISPLAYED ENTER PATIENT

visıt

Nl./MBER

ı

~

V

.,

N9

NO

STUDY AND ANAL YSE INFORMATION A$OUT PATIENT

QISPLAYED

(45)

1 - PATIENT DEBT

o

YES

(46)

.,.,.,,'04.,.~~ .•

---ı•

NO NOT FOUND YES INFO. OF SEARCHED PAT\ENT. ENTERING PATIENT . DEBTOR. INFO_{ı .} _. _{. .} _. YES

NO

RERJRNTO MAİN MENU PATA STORED

(47)

1 - SEARCH BY NAME,SURNAME

OR DOSSIER NO.

YES

o

(48)

SEARCH( ANY STUDY AND ANAL YSE. RECORD)

,r,ıı.·, •...ı~ •••.• ,,..~ •••--··---·

cNTERSEARCH BY NAME.SURNAME OR DOSSIER NO.

YES

NO ABOUT PATIENT ID INFORMATION DISPLAYED

NOT FOUND

NO RETURN TO

(49)

1 - LIST ALL PATIENTS

2- PATIENT AUTHENTIC REPORT

(?

\

YES

ı,

4.·1

,J

"

/

YES

·G:ı

.ı'

"

.,,, RETURN TO MAİN MENU

(50)

LIST AL.L PATIENTS

LİST OF ALL PATlf:NT ID INFORMATION DO YOU WANT TOGO MAIN MENU NO RETURN TO MAİN MENU

(51)

PATIENT AUTHENTIC

REPQ.IJ'.

1 - SEARCH 2- PRINT OUT

(52)

SEARCH(ANY PATIE.NT

ID..

RECORD)

AUTHENTIC INFORMArtON ABOUT PATIENT DISPLAYED YES NO ABOUT PATIENT ID INFORMATION PISPL.AYEO NOT FOl,JND ENTER PATIENT VİSIT NUMBER YES NO

~

..

~--,---- ,. RETURN TO MAİN MENU NO

(53)

PRINTOUT( PATIENT AUTHENTIC

KNOWLEDGE)

YES

NO

PATIENT ID. INFORMATION DISPLAYED NOT FOUND ENTER PATIENT VISIT NUMBER YES NO NO YES PATIENT AUTHENTIC INFORMATION DISPLAY!:P

-~~

ı

NO

-

I

PRINTED

(54)

MODULE .

Declare Function Flash Window Lib "User32" (By Val hWnd As_ Long, ByVal blııvert As Long) As Long

Sub Flash(hFlash As Long, iTiınes As Im.egcr~sJntcn,ııiAs..Şingle)

Dim iAslnteger

For i=-O To iTimes

Call FlaslıWindow(hFlash, True) Dim Start J\.ı, Single

Start= Timer

Do While Timer <Start+ slnterval DoEvents

Loop .Next i

Call Flash Window(hFlash, False) End Sub

CLASS MODULE . Option Explicit Private Type RECT

left As Long tüp As Long Right As Long Bottom

As

Long End Type

Private Declare Function EillR.ectLib.IIU:seı:3.2.''. (J3¥YalhD.C..As.lııng,..lplli:.ct.As.RE.C.tB.y.V al hRmsb AsJ.;011g).~ Long

Private Declate Function CreateSolidBrush Lib "gdi32" (ByVai crCoior As Long) As Long \ ·

Private.Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hOC As Loag.Byval x As Long.Byval y As Long, ByVal lpString AsString, ByVal nCountAs Long) As Long

Private Declare Function.Get.DeviceCaps.Lilı-''.~.(B¥-VaUıD.C.. ..~sJ.oug,

ByVal

nlndex As Long) I\$Long

Private Const LOGPIXELSX = 88 ' Logical pixels/inch in X

J

Private Const LOGPIXELSY =90 ' Logical pixels.finch in Y

Private Declare Function Mt:ılDi.v Lib "kernel32" (ByVal nNuınber As Long, ByVal nNuınemtor As Long, ByVal nDenominator J\.s Long) As Long

Private ConstLF FACESIZE =32

Private Type LOGFONT ltHeight As Long liWidth A-s Long lfEscapementAs Long ltDrientatioo As Long ltweightAs Long Hltalu: As Byte lflJnderline As Byte lfStrikeüut As Byte lft',Jıar.set As Byte lfOutPrecision J\.s Byte lft::lipPrecision As Byte HQuality As Byte lfPitchAndFaınily As Byte

lfFareName(LF _FJ\.CESIZE) J\.s Byte End Type

Private Declare Function CreateFoo.tlndirect Lib "gdi32" Alias "CreateFontindiı;ectA" (lpL,ogF_,ont As LOGFONT)_As Long Private Declare Function SeleclOtajectLih "gdi32"{RyVal hf)C As Long, RyVal hOtajectAs Long) As Long

Private Declare Function Dcleteübject Lih, "gdi32.". (B.y\lalh0bj:c.ct.As. I .-ong) A5ı Long

.Private ConstFW NORMAL= 400

Private ConstFW_BOLD= 700

Private Const FF_DONTC.t\RE = O Private-Const DEFAULT_ QUALITY = -O

Private ConstDEFAlJLT PITCH= O

Private Const DEF J\.UL T CHARSET = I

Private Declare Function OleTran.slateColor Lib "OLEPR032.DLL" (ByVal OLE_Ç_OLOR As

Long.Byval

HPALETtE As Long, pccolorref J\.s Long) J\.-s Long

Private Const CLR,_INVALID = -1 Private m_picTiıis As Picturelsox

(55)

Private m_sCaption As String

Private m_hRGBS-tart(l To 3) As Integer Private m oStartC-olor As OLE COLOR

_-

-Private ırı-_bRGBEntl(l Tu.1) As Integer

Private,m_oEndColor As OLE_CO,LOR

Public Property T .et Caption(ByVal sCaption As String) m_sCapti:on=s<i::aption

End Property

Public Property Get CaptionQ As String Caption=m~sCaptim:ı

End Property

Puhlic Property Let DrawingObject(ByRef pie This As Picturelsox) Set mpic'Ihis =picThis

End Property

Public Property Get StartC-olorO As OLE"'COLOR

StartColor =m oStartColor \

End Property

Public Property Let StartColor(ByVal oColor As OLE_Ç':_OLOR) Dim !Color As Long

If (m_oStartColor <> oColor) Then m _oStartCokır = oCokır

OlcTranslatcColor oColor, -0, lColor m_bRGBStart(l) =lColor And &HFF&

m_bRGBStart(2) =((!Color And &HFFOO&) \ &HlOO) m_bRGBStart(3)'= ((lCokır And &HFFOOOO) \&Hl-0000) IfNot (m_picThis Is Nothing) Then

Draw 1

Endlf

Eooif

End Property

Public Property Get EndColor() As 0~°1LOR EndColor = m_oErldColor

End Property

Public Property Let EndColor(RyVal oColor As OLE_çOLOR) Dim lC-olor As Long

If~m_oEndColor <> oColor) Then

m-0EndColot=-OColor

üleTrnnslateColor oColor, -0, lColor

m_b;RGBEnd(l) =lC-oloı; And &HFF&

m_hRGB.End(2) =(qColor And &HFFOO&) \ &HJOO) m_bRGBEoo(3) =((lCol{)f And&HFFOOOO) \&HlOOOO) lfNot (m_picThis Is Nothing) Then

Draw End If End If End Property Public Sub Draw()

Dim !Height As Long, !Width As Long Dim lYStep As Long

Dim IY A's Long

Dim bR-GB( l To 3) As Integer Dim tLF As LOGFONT Dim hFnt As Long Dim hFntOld As Long Dim lR As Long DimrctAsRECT Dim hBr·As Long

Dim hOC As I .ong Dim dR( l To 3) As Double On Error G-oTo DrawError

hDC=m_picThis.hDC

Il-leight=m_pieThis Height\ ScreenTwipsPerPixelY ret.Right =myi:cThis.Width \ Screen.TwipsPeı:PixclY

(56)

' Set .a gnınuation of 255 pixels: JYStep =1Height\ 255 If{lYStep =-0) Then lYStep

=

1 End If rctBottom

=

!Height bRGB(l) =m_bRGBStart(l) bRGB(2)=

m_

hRGBStart(2) bRGB(3}=

-tn

_-bROBStart(3) dR(l)=m_bRGBEnd(l )-m_bRGBStart(l) dR(2)=m_bRGBEnd(2)- m_bRGBStart(2) dR(3) = m_bRGBEnd(3)- m_hRGBStart(3) For lY=!Height

fo

-O Step -lYStep

'Draw bar:

r-cttOp

=

rctBottom - lYSt-ep

hRr=CreateSolid~msh((bRGR(J)

*

&Hl 0000

+

hRGR(2)

*

&Hl 00&

+

hRGB(l ))) FillRcct hDC, ret, hBr

DeleteObject hBr r-ctBottonı

=

rcttüp ' Adjust colour:

bRGB{ l )=m~bRGBStart( 1)

+

dR(l)-_'" (lliı::i:glıt_= lY)-Llfl_eight bRGB(2)=m_bRGBStart(2) + dR(2) '"(lHeight- lY) I IHeight bRGB(3)

=

m_bRGBStaft(3) +dR(3)

*

(ll-Ieight-

IY)L

!Height 'Debug.Print bRGB(l ), (!Height - lY) / lHeight

NextlY pOLEFontToLogFont m_picT\ıis.Font, hDC, tLF tLF.liEscapement=;900 hFnt

=

CreateFontlndirect(tLF) If {hFnt-<>O) Then hFntOld=SelectObJect(hDC, hFnt)

lR=T-extOut{hDC, -0, lJ-I-eight- lf;, m_sCaption, L-en(m_sCiıption)) SelectOlajecthDC, hFntOld Del:eteObject hFnt Endlf m _pi.cThis.R-efr-esh Exit Sub DrawEırnr:

Debug.Print "Problem: "&Err.Description End Sub

Private Sub pOLEFontToLogFont(futThisAJ,StdFont, hDCAJ,Long,ttF As LOGFONT) Dim -sFont As String

Dim iCbar As Integer

'Convert an OLE StdFont to a LOGFONT structure: WithtLF

sFont=fnt'Ihis.Name

'There is a quicker way involving StrCqnv and Copylvlemory,but ' this is simpler!

F-0riChaı-

=

1 To Len(sForıt)

.lfFace-N.ıme(iChar - l )=-OByt-e{~sEont,~, l )))

NextiCbar )

' Based on the W~l32SDK documentation:

_l-fHeight = -MuU1iv{{fntThisSi:ze),(GetnevıceCaps(hOC, T,OGPTXRT~~Y)), 72)

.lüıaıic =üıı'Ilus.Iıalic lf (fntThis.Bold) Then .ltwei,ght= FW_BOLD Else .lfWeight

-=

FW_NORMı\L End If

.HUnderline =fntThis Und~line .ltstrikeOut ;=futThis.Strikethrough

(57)

(58)

I.FORM Option Explicit Dim iAs Integer Dim ikoıı(8) As String Dim ilkharf, yazi As String Dim cL As New cLogo Private Sub Fonn_Load()

cL.Drawi.ngObject= picLogo

cL.Caption = "Dr.Celalletdin Dedeoglµ" End Sub

Private Sub Forrn_Resize() On Error Resume Next

picLogo.Height = Me.ScaleHeight On Error GoTo O

cL.Draw

Forml.Enabled = True i =1

ikon(l) =App.Path+ "\ınoonOl.ico" ikon(2) =App.Path+ "\ınoon02.ico" ikon(3) =App.Path+ "\moilllÜ.?.ico" ikon(4) =App.Path+ "\ınoonOfl.ico" ikon(5) =App.Path+ "\ınoon05.ico" ik.on(6)=App.Path+ "\ınoon06.ico" ik.on(7)=App.Path+ "\ınoon07.ico" ik.on(8)=App.Path+ "\ınoon08.ico"

End Sub ·

Private Sub Labell _Click() Flash Me.liWnd, 20, 0.5 End Sub

Private Sub ınfızkay_Click() Fonn4.Show

End Sub

Private Sub mkay_Click() Forrn2.Show

End Sub

Private Sub ınnual_'Click() Formô.Show

End Sub

Private Sub mnubl_Click() DataReportJShow End Sub

Private Sub mnucikis_Click() End

Encl Sub

Private Sub mnuhaslis_Click() DataReport 1. Show

End Sub

Private Sub Illl\uprog_ClickO Forml I.Show

End Sub

Private Sub mnusa __Click() FonnlO.Show

End Sub

(59)

Form9.Şhow End Sub

Private Sub ımıusoy _ Click() Form7.Show

End Sub

Private Submnutet_Clıck() Form5.Show

End Sub

Private Sub mtanted _ Click() Form3.Show

End Sub

Private Sub Timerl_Timer() ilkharf= left(Labell.Caption, 1)

yazi = Righul.abell.Caption, Len(LabelL~)- 1)

Label I.Caption= yazi

+

ilkharf Forml.Icon = LoadPicture(ikon(i)) i = iMod 8+ I

End Sub

Private Sub Timer2_Timer() Dim Timer2

ilkharf = left(Labell.Caption, 1)

yazi = Right(Labell.Caption, Len(Labell.Caption)- 1)

Label I.Caption= yazi

+

ilkharf Dim sString As String

sString = "Bu program Vedat Gözügüzelli tarafıntan y_aratıldı" IfTimer2.Tag = O Then

Me.Caption= sString Timerz.Tag = 1

ElselfTimer2.Tag <Len(sString) Then

Me.Caption= Right(sString, Len(sString) - Timerz.Tag) Tiıner2.Tag = Timerz.Tag

+

1

ElselfTimer2.Tag

=

Len(sString) Then Me.Caption= sString Tiıner2.Tag=O End If End Sub 2.FORM Option Explicit

Private Declare Function ShellExecute Lib "slı.ell32.dll"·Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpüperation As String, ByVal lpFile As String, ByVal lpParametersAs String,

Byval

lpDirectory As String, ByVal nShowCmd As Long) As Long

Private verilerim As ADODB,Comıection Private depo As ADODB.Recordset Private depol As ADODB.Recordset Privatedepo2 As ADODB.Recordset Private depo3 As ADODB.Recordset Private depo4 As ADODB.Recordset Private dat3 As DataRepoıtl Private baglanti As String Private Sub Command l Dlickf) bul

Textl .text= "" Text2.text = "" Text3.text = ""

Combo1.text= "Kan gurubun'} seçiniz" Combo2.text = "Medeni durumu seç" Combo3.text = "ciniyeti seç" DTPickerl = Date

(60)

DTPicker2 = Date TextS.text = "" Text6.text = "" Textl.SetFocus Command4.Enabled = False Comınand3.Enabled = False Command6.Enabled = True End Sub

Private Sub Command6 _ Click() Dim sor, sql

sor= MsgBox("Kayıt yapılsın nu?", vblnformation + vb YesNo, "Kaydet") If sor = vbYes Then )

IfTextl.text <>""And Text2.text <>""And Text3.text <>""And Textô.text <>""And Text6.text <>""And Combol.text <> "Kan gurubunu seçiniz" And Combo2.text <> "Medeni durumu seç" And Combo3.text <> "ciniyeti seç" Then

sql = "insert into kayit2(ad, soyad, adres,Jrangur~meddur.,_ciıısİ¥etİ,.dogumtar,kaytar, sayac, telno, kimlik) v~lues(" sql=sq!& "'" &Textl.text & "'," '

sql=sql&11111_&

Text2.text& 111,11

sql=sql &11111_&

Text3.text &111,11

sql=sql& ""' &ComboI.text & "',"

sql=sq!&11111_&

Combo2.text& 111,11

sql = sq!&11111_&_Combo3.text_{& "',"}

sql = sql& 11111_&

DTPickerl.Value & 111,11

sql=sql& 11111_&

DTPicker2.Value& "',"

sql = sq!& 1"11 _&_{Labell3.Caption} _& 111,11

sql = sq!& ""' &TextS.text& 111,11

sql=sql&11111

&Text6.text& 111)11

verilerim.Execute (sql) verilerim.Close Data 1. Refresh

MsgBox ("Bilgiler Kaydedildi") kası

Else

MsgBox ("Hasta ile ilgili bütün alaıılan doldurun") Textl .SetFocus

End If End If End Sub

Private Sub Datal_Reposition() Dim kayitno, kaysayi

kayitno = Datal.Recordset.AbsolntePosition kaysayi = Datal.Recordset.RecordCount

Datal.Caption = Str(kayitno + 1) + "/" + Str(kaysayi) ~ End Sub

Private Sub Form_Load()

Form2.left = (Screen.Width - Form2.Width) / 2 Form2.t0p = (Screen.Height- Fomı2.Height) / 2

Datal.RecordSource ="select* from kayit2 order by ad asc" WithCombol .Addltem "Orh+" .Addlteın "Orh-" .Addltem "Arlı+" .Addltem "Arh-" .Addlteın "Brh+" .Addltem "Brh-" .Addlteın "ABrh+" .Addltem "ABrh-" End With

(61)

WithCombo2 .Additem "Evli" .Addltem "Bekar" End With WithCombo3 .Addltem "Erkek" .Addltem "Bayan" End With bul Commaııd4.Enabled = False Command3.Enabled = False End Sub

Public Sub bul() Dim sorgu, sorgul

Set verilerim= New ADODB.Coıınection verilerim.CursorLocation = adUseClient

baglanti = "Provider=Microsoft.jet.oledb.4.0; Data Source=C:\Documents and Settings\Vedat\My Documents\GRdproject\kayitl .mdb"

verilerim. Open baglanti Set depo= New ADODB.Recordset sorgu= "Select* from kayit2" Set depo = verilerim.Execute( sorgu) If depo.EOF Then

Label13.Caption = 1 Else

sorgul = "selectınax(sayac) as saydir.from.kayitz'' Set depo 1 = verilerim.Execute( sorgu 1) ) Label13.Caption= depol![saydir]

+

1 End If

depo.Close End Sub

Private Sub Commandô, Click() Dim ara As Integer

Dim addi As String

Set verilerim= New ADODB.Coımection verilerim.CursorLocation = adUseClient

baglanti = "Provider=Microsoft.jet.oledb.4.0; Data Source=C:\Docmnents and Setting_s\Vedat\My Documents\GRdproject\kayitl . mdb"

verilerim.Open baglanti

ara= Val(InputBox("Dosya nuınarasııu giriniz?")) addl ="select* from kayit2 where sayac="&ara& ""

Set depo3 = verilerim.Execute(addl) If depo3.EOF Then

MsgBox ("aradıgııuz dosya numarası bulunamadı") Else

Textl .text= depo3!(ad] Text2.text= depo3![soyad] TexG.text = depo3![adres] Coınbol.text = depo3![kangıır] Combo2.text = depo3![meddur] Combo3.text = depo3![cinsiyeti] DTPickerl = depo3![dogumtar] DTPicker2 = depo3![kaytar] Text5.text= depo3![telno] Textô.text = depo3!(kimlik] Labell3.Caption.= depo3![sayac] Textl .SetFocus depo3.Close Datal .Refresh Conıınand3.Enabled = True Coınınand4.Enabled = True Command6.Enabled = False End If End Sub

Private Sub Comınand3_Click() Dim sorgu, cevap As String

(62)

If cevap = vbYes Then

Set verilerim = New AOODB.Connection verilerim.Cursorl.ocation = adUseCHent

baglanti = "Provider=Microsoft.jet.oledb.4.0; Data Source=C:\Docuınents and Settings\Vedat\My Documents\GRdproject\kayitl .mdb"

sorgu= "update kayit2 set ad="&Textl .text& '",soyad="&Text2.text& "', adres="&Text3.text& "',kangur="&

Combol.text & "',meddur=" &Combo2.text& "',cinsiyeti="&Combo3.text& "',dogumtar=" &DTPickerl.Value & '",

kaytar="' &D1Picker2.Value & "', telno=" & Text5.text& "',kimlik="' &Text6.text& "' where sayac="&

Label13.Caption & " " verilerim.Execute (sorgu) kasl

End

If

End Sub

Private Sub Coınmand4_Click() Dim cevap! As String

(63)

-

-cevap1

=

MsgBox("Hasta Bilgilerini silmek istiyonnunuz 'r ; voınrormauou

-r- vuı '"''" ,v;

If cevap1 = vbYes Then

Set verilerim= New AOODB.Connection

,verilerim.Cursorf.ocation.

=.

ad.UseClient

baglanti

=

"Provideı:==Microsoft.jeLoledbAQ;_Data.Souı:ce=Cillocuments..and.SettingsWeıjat\My

Documents\GRdproject\kayitl.mdb"

verilerim.Openbaglanti

sorgu2 = "delete from kayit2 where sayac="

&

Labell3.Caption

& ""

sorgu3

=

"delete from kayit where sayaca" &LabelU.Caption_& ""

sorgu4 ="delete from fizikmu where sayac="

&

Label13.Caption

& ""

sorgu5

=

"delete from muhasebe where sayac="

&

Label13.Caption

& ""

sorgu6

==

"delete from tetkik where sayac=" & Label13.Caption

& ""

verilerim.Execute (sorgu2)

verilerim.Execute (sorgu3)

verilerim.Execute (sorgu4)

verilerim.Execute(sorgu5)

verilerim.Execute (sorgu6)

Command1 Click

bul

-kasl

End If

End Sub

Private Sub Command2 Click()

Unload Me

-End Sub

Private Sub Cmdprint_Click()

Dim soru As Integer

On Error Resume Next

soru= MsgBox("PrinterdenÇıktı almak istediğinizden emin roisiniz'Z'.',.v~esNo)

If soru

=

vbYes Then kayityazdir

CommonDialogl Action

= S

End Sub

Sub kayityazdir()

Dim x As Printer

Dim y, xl, x2, artim

On Error GoTo son

'Setup Printer

Printer.ScaleMode = 6

Printer.FontName

=

"TimesNew Roman Tur"

Printer.FontSize"' 14

y = 10: xl

=

5: x2

=

xL+ 50: artim

=

7 'head

Printer.CurrentX

=

1 Printer.CurrentY

=

2 .,

Printer.Print "HASTA- KAYIT KABUL''.&."

Printer.Line

(O,

9)-(Printer.ScaleWidth,9)

'start

(64)

y=y+artim

Printer.CurrentX

=

xl

Printer.CurrentY

=

y

Printer.Print "Dr Celal Dedeoğlu"

'I

If Not IsNııll(Textl .text) Then

y=y+artim

Printer.CurrentX

=

xl

Printer.CurrentY

=y

Printer.Print "Adı

:"

Printer.CurrentX

=

x2

Printer.CurrentY

=

y

Printer.Print Textl .text

End If

If Not IsNull(Text2.text) Then

y=y+artim

Printer.CurrentX

=

xl

Printer.CurrentY

=

y

Printer.Print "Soyadı:"

Printer.CurrentX

=

x2

Printer.CurrentY

= y

Printer.Print Text2.text

End If

If Not IsNull(Text3.text) Then

y=y+artim

Printer.CurrentX

= xl

Printer.CurrentY

=y

Printer.Print "Adresi :"

Printer.CurrentX

=

x2

Printer.CurrentY

=

y

Printer.Print Text3.text

End If

'Factory

'y = y + artim

'Printer.CurrentX

=

Xl

'Printer.CurrentY

=

y

'Printer.Print "Factory Process :"

IfNot IsNull(Combol.text) Then

y =y +artim

Printer.CurrentX

=

xl

Printer.CurrentY

=

y

Printer.Print "Kan gurubu:"

Printer.CurrentX

=

x2

Printer.CurrentY

=

y

Printer.Print Combol .text

Endlf

If Not IsNull(Cotnbo2.text) Then

y

=

v+

artinı

Printer.CurrentX

=

xl

Printer.CurrentY

=

y

Printer.Print "Medeni durumu:"

Printer.CurrentX

=

x2

Printer.CurrentY

= y

Printer.Print Combo2.text

End If

If Not IsNull(Combo3.text) Then

y == y

+

artım

Printer.CurrentX

=

xl

Printer.CurrentY

=

y

Printer.Print "Cinsiyeti :"

Printer.CurrentX

=

x2

Printer.CurrentY

=

y

Printer.Print Combo3.text

End If

If Not IsNull(DTPicker1 . Value) Then

y

=

y +

artinı

(65)

'Printer.Print "Emp~yee:" If Not IsNull(Text5.text) Tiıen

y=y+artim

Printer.CurrentX = xl Printer.CurrentY

=

y

Printer.Print "Telefon numarası:" Printer.CurrentX

=

x2 Printer.CurrentY=y Printer.Print Te45.text End If If Not IsNull(Text6.text~Then y=y+artim Printer.CurrentX = xl Printer.CurrentY = y

Printer.Print "Kimlik numarası :" Printer.CurrentX = x2

Printer.CurrentY=y Printer.Print Text6.text End If

Printer.Line (O, 140)-(Printer.ScaleWidth, 140) Printer.EndDoc

Exit Sub son:

MsgBox "Error:" &Err.Description, HÇ'Goziigüzelli" End Sub

Private Sub Text5_KeyPress(KeyAscii As Integer) IfKeyAscii

=

13 Then

KeyAscii=O SendKeys "{Tab}"

ElseifinStr(("1234567890" & vbBack & ""), Chr(KeyAscii))_=O Then KeyAscii=O

End If End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer) IfKeyAscii = 13 Then

KeyAscii = O SendKeys "{Tab}"

ElseiflnStr(("l234567890" &vbBack& ""),Chr(KeyAscii)) = O Then KeyAscii=O

End If End Sub Public Sub kasl() DataReport I .Refresh

(66)

Printer.CurrentX = xl Printer.CurrentY =y Printer.Print "Doğum tarihi :" Printer.CurreııtX = x2 Printer.CurrentY = y Printer.Print DTPickerl.Value End If

If Not IsNull(DTPicker2.Value) Theıı

y=y+artim (

Printer.CurrentX = xl Printer.CurrentY = y Printer.Print "Kayıt tatihi :" Printer.CurrentX

=

x2, Printer.CurrentY=y Printer.Print DTPicker2.Value End If 'y=y+artim 'Printer.CurrentX=XI

(67)

End Sub

Private Sub Fonn_Unload(Cancel As Integer) Unload Me

Fonnl .Enabled= True Form I.Show

End Sub

Private Sub Forrn_Activate() Forml.Enabled = False End Sub

3.FORM

Option Explicit

Private verilerim As ADODB.Connftion Private depo As ADODB.Recordset Private depot As ADODB.Recordset Private depo2 As ADODB.Recordset Private depo3 As ADODB.Recordset Private depo4 As ADODB.Recordset Private baglanti As String

Private arama

Private Sub Command I_ Click() DTPicker l = Date Textl.text = "" Text2.text

= ""

Text3.text = "" Text4.text

= ""

Text5.text= '"' Text6.text = "" Text7.text

= ""

Text8.text = "" Text9.text

= ""

TextlO.text= '"' Textl l.text = '"' Textl2.text

= "

11 Frame4.Visible=True Frame2. Visible

=

True Fraıne3.Visible

=

True Textl .SetFocus

Command2.Enabled=True

Command3.Enabled=True

End Sub

Private Sub Command2_Click() ~

Dim sor, sql, sa

sor= MsgBox("Hastanın Şikayet kayıtlı y_al)llsın mı?", vblnformation

+

vbYesNo,11Kardet")

If sor

=

vbYes Then

IfTextl.text <>""And Text2.text <>""And Textl I.text<>"" And Textl2.text <>1111

And Text3.text <> "" And Text4.text <> "" And Text5.text <> "" And Text6.text <> "" And Text7.text <>""And Text:8.text<>""And Text9.text <>""And TextlO.text <>""And Text5.text <> "" AndTextô.texts> "" Then

sa= Labell6.Caption

+

l

sql="insert into kayiusayac, sikayeti, hikayesi, gechas, trafik, ailehas, alerji, aliskaıılik, kulilac, ziytar,gelsay) values(" sql

=

sql & "" & Textl.text &11,"

sql

=

sql& "'" & Text! I .text& "',"

sql=sql & "'"&Textl2.text & "'," sql

=

sql & "'" & Text5.text & "'," sql

=

sql & "'" & Text6.text& "',"

sql

=

sql & '"" & Text7.text & "'," sql = sql & ""' & Text8.text & "'," sql

=

sql & ""' & Text9.text & "'," sql

=

sql & "'" & TextlO.text& 11',"

sql

=

sql & ""' & DTPickerl.Value &111,11

(68)

verilerim.Execute (sql) MsgBox ("Bilgiler Kaydedildi") Comınand2.Enabled = True DTPickerl = Date

Frame4.Visible = True Frame2. Visible = True Frame3.Visible = True Command2.Enabled = False kayitsay

Data I.Refresh Else

MsgBox ("Hasta ile ilgili bütün alanlan doldurun") Text! l.SetFocus

End If End If Datal.Refresh End Sub

Private Sub Fonn_Load() Command4.Enabled = False Frame4.Visible = True Frame2.Visible = True Frame3.Visible = True

Fonn2.left = (Screen.Width - Fonn2.Width) I 2

Fonn2.t0p = (Screen.Height- Fonn2.Heig!ıt) I 2

End Sub 1

Private Sub Command3_Click() Dim sorgu, cevap2

IfTextl.text =""Then MsgBox "Dosya noyu giriniz!" Textl .SetFocus

Else

arama= Val(InputBox("Ziyaret sayisini gjpniz")) Set verilerim= New AOODB.Coıuıection

verilerim.CursorLocation = adUseClient

baglanti = "Provider=Microsoft.jet.oledb.d.O;Data Source=C:\Documents and Settingş\Vedat\My Documents\GRdproject\kayitl .mdb"

sorgu= "select* from kayit where sayac="

+

Textl.text

+"

and gelsay="&arama& ""

Set depo3 = verilerim.Execute(sorgu) If depo3.EOF Then

MsgBox ("Aradıgınız ziyaret sayisinda.hir.hasta.bıılıınamadı")

Else )

Fraıne4.Visible = True Frame3.Visible = True Frame2.Visible = True Textl Ltext=depo3![sikayeti] Textl2.text = depo3![lıikayesi] Text5 = depo3![gechas] Text6 = depo3![trafık] Text"= depo3![ailelıas] Texts= depo3![alerji] Text9 = depo3![aliskanlik] TextIO = depo3![kulilac] DTPickerl = depo3![ziytar] Command2.Enabled=False Command4.Enabled = True End If End If End Sub

Private Sub Command4_Click() Dim cevap1 As String

Dim sorgu2 As String

cevap1 = MsgBox("Hasta Bilgilerini güncellemek istiyormusunuz ?", vbInformation

+

vbYesNo) If cevapI = vbYes Then

(69)

baglanti = "Provider=Microsoft.jet.oledb.4.0; Data Source=C:\Documents and Settings\Vedat\My Docuınents\GRdproject\kayitl .mdb"

sorgu2 = "update kayit set sikayeti=" + Textl I.text+"', hikayesi='"+ Textl2.text + "', gechas="' + Text5.text +'",trafik="' + Text6.text + "', ailehas=" + Text7.text +"',alerji="'+ Text8.text + "', aliskanlik='" + Text9.text + "', kulilac="' + TextlO.text +"' where gelsay=" & arama & ""

verilerim.Execute (sorgu2)

MsgBox ("Bilgiler güncelleştirildi") Frame2.Visible= True

Frame3. Visible = True Frame4.Visible = True

Datal.RecordSource ="select* from kayit where sayac=" + Textl.text + "" Data I.Refresh

End If End Sub

Private Sub Coımnand6_Click() Unload Me

End Sub

Private Sub Textl_KeyPress(KeyAsciiAs~eger) Dim sor

IfKeyAscii = 13 Then KeyAscii = O

Set verilerim= New ADODB.C-0nnection verilerim.CursorLocation==adUseClient

baglanti = "Provider=Microsoft.jet.oledb.4.0; Data Source=C:\Docuınents and Settiııgş\Vedat\My Documents\GRdproject\kayitl .ındb"

sor= "select." from kayit2 where sayac= "+ Textl.text + "" Set depo2 = verilerim.Execute(sor)

If depo2.EOF Then

MsgBox ("Aradıgınız hasta kaydı bulunamadı LYeui.KayitBölü.ı:nünd.eu..HaYdmı Yapınız") Textl.text = ""

Textl .SetFocus DBGridl.Visible ==False Else

kayitsay

Set depo3 = New ADODB.Recordset

Set depo3==verilerim.Execute("select count(sayac)aS\zar from kayitwhere sayac="

+

Textl.text

+ "")

Labell6.Caption = depo3![zar] Text2.text = depo2![ad] Text3.text = depo2![soyad] Text4.text= depo2![adres] 'Frame2.Visible = True 'Frame3.Visible = Trne 'Frame4.Visible = True Command2.Enabled = True End If End If

IfhıStr(("1234567890" &vbBack& ""),Chr(KeyAscii)) = O Then KeyAscii = O

End If End Sub

Public Sub kayitsay()

(70)

Datal.Refresh

DBGridl.Visible =True End Sub

Private Sub Cmdprint_Click() Dim soru As Integer

On Error Resume Next

soru = MsgBox("Printerden çıktı almak istediğinizden emin misiniz? ?", vbYesNo) If soru = vbYes Then kayityazdir

CommonDialogl Action= 5 End Sub

Sub kayityazdir() Dim x As Printer Dim y, xl, x2, artim On Error GoTo son 'Setup Printer Printer.ScaleMode = 6

Printer.FontName = "Times New Roman Tur" Printer.FontSize = 14

y = 10: xl = 5: x2 = xl

+

50: artim = 7 'head

Printer.CurrentX = l Printer.CurrentY = 2

Printer.Print "HASTANIN - TIBBI ÔZGEÇMfŞI"& " " &Fonnat(Date, "LongDate") Printer.Line (O, 9)-(Printer.ScaleWidth, 9)

'start y=y+artim Printer.CurrentX = xl Printer.CurrentY

=

y Printer.Print""

•/

IfNot IsNull(Labell6.Caption) Then y=y+artim

Printer.CurrentX = xl Printer.CurrentY = y Printer.Print "Ziyaret sayısı : " Printer.CurrentX = x2 Printer.CurrentY

=

y Printer.Print Labell 6.Caption End If

If Not IsNull(Textl.text) Then y=y+artim

Printer.CurrentX== xl Printer.CurrentY = y

Printer.Print "Dosya numarası:" Priııter.CurrentX=x2

Printer.CurrentY = y Printer.Print Textl .text End If

If Not IsNull(Text2.text) Then y=y+artim Printer.CurrentX = xl Printer.CurrentY = y Printer.Print "Adı Printer.CurrentX = x2 Printer.CurrentY = y Printer.Print Text2.text End If

It'Not IsNuff(Text3.text) Tiıen y=y+artim

Printer.CurrentX = xl Printer.CurrentY = y Printer.Print "Soy adı ·" Printer.CurrentX

=

x2 Printer.CurrentY = y Priııter.Print Text3.text

(71)

End If 'Factory

'y= y+artim

'Printer.Current.X= Xl 'Printer.CurrentY

=

y

'Printer.Print "Factory Process:" If Not IsNull(Text4.text) Then

y=y+artim Printer.Current.X= xl Printer.CurrentY=y Printer.Print "Adresi Printer.Current.X

=

x2 Printer.CurrentY = y Printer.Print Text4.text End If

IfNot IsNull(DTPickerl.Value) Then y=y+artim

Printer.Current.X= xl Printer.CurrentY = y Printer.Print "Kayıt tatihi :" Printer.Current.X= x2 Printer.CurrentY = y

Printer.Print DTPickerl .Value End If

If Not IsNull(Textl 1.text) Then y=y+artim Printer.Cnrrentx = xl Printer.CurrentY = y Printer.Print "Şikayeti ·" Printer.Current.X

=

x2 Printer.CurrentY=y Printer.Print Textl 1.text End If

If Not IsNull(Textl2.text) Then y=y+artim Printer.Current.X

=

xl Printer.CurrentY

=

y Printer.Print "Hikayesi Printer.Current.X= x2 Printer.CurrentY = y Printer.Print Textl2.text End If 'y=y+artim 'Printer.Current.X= XI 'Printer.CurrentY = y 'Printer.Print "Employee:" IfNot IsNull(Text5.text) Then

y=y+artim

Printer.Current.X= xl Printer.CurrentY = y

Printer.Print "Geçirdiği hastalıklar:" Printer.Current.X= x2

Printer.CurrentY = y Printer.Print Text5.text End If

If Not IsNull(Text6.text) Then y=y+artim

Printer.Current.X= xl Printer.CurrentY = y

Printer.Print "Trafik iş kazaları ·" Printer.Current.X= x2

(72)

Printer.CurrentX = xl Printer.CurrentY = y

Printer.Print "Ailevi hastalıkları ·" Printer.CurrentX = x2

Printer.CurrentX = xl Printer.Current¥= y Printer.Print "Alerji öyküsü Printer.CurrentX = x2 Printer.CurrentY = y Printer.Print Text8.text Eııdlf

If Not lsNull(Text9.text) Then y=y+artim Printer.CurreııtX = xl Printer.CurrentY=y Printer.Print "Alışkaıtlıklan ·" Printer.CurrentX = x2 Printer.CurrentY = y Printer.Print Text9.text End If

IfNot IsNull(TextlO.text) Then y=y+artim

Printer.CurrentX = xl Printer.Current¥= y

Printer.Print "Kullandığı ilaçlar:" Printer.CurrentX

=

x2

Printer.CurrentY = y Printer.Print TextlO.text End If

Printer.Line (O, 140)-(Printer.ScaleWidth, 140) Printer.End.Doc

Exit Sub son:

MsgBox "Error:"&Err.Description, 16; "G"oıuguzelli"

End Sub ·

Private Sub Form_Unload(Cancel As Integer) Unload Me

Forınl.Enabled

=

True Forml.Show

End Sub

Private Sub Fomı_Activate() Forınl.Enabled = False End Sub

4.FORM Option Explicit

Private verilerim As ADODB.Coımection Private depom As AOODB.Recordset Private depoml As ADODB.Recordset Private depom2 As ADODB.Recordset Private depo3 As ADODB.Recordset Private baglanti As String

Private arama

Private Sub Commandl_ Click() Textl.text = ""

(73)

Text3.text = 1111 Text4.text = "" Text5.text = "" DTPicker 1 = Date Text6.text = "" Text7.text = "" Text8.text = "" Text9.text = "" TextlO.text= "" Textl ltext= "" Textl2.text = "" Textl3.text= '"' Label20.Caption = "" Textl .SetFocus Comrnand2.Enabled = True Corrırrıand4.Enabled= False End Sub

Private Sub Command5_Click() Unload Me

End Sub Public Sub bull() Dim sorgu2, sorgu3

Set verilerim= New AOODB.Coımection verilerirrı.CursorLocation = adUseClient

baglanti = "provider=microsft.jet.oledb.4.0; data source=C:\Documents and Settingş\Vedat\My Docurrıents\GRdproject\kayitl .mdb"

Set depom= New AOODB.Recordset sorgu2 = " select

*

from fızikrrıu" Set depom= verilerirrı.Execute(sorgu2) If depom.EOF Then

Label20.Caption = 1 Else

sorgu3 = "select max(sayil) as say from fızikrrıu" Set depom= verilerirrı.Execute(sorgu3)

Label20.Caption = depom![say] End If

depom.Close End Sub

Private Sub Corrırrıand2_Click() ı.

Dim sor, sql, sa

sor = MsgBox("Hastanın fızik muayene bulguları y_a21lsın mı?", vblnfonnation

+

vbYesNo, "Ka

1

det") If sor = vbYes Then

IfText6.text <>""And Text7.text <>""And Text8.text <>'"'And Text9.text <>""And TextlO.text <> "'l..And Textl Ltext <> "" And Textl2.text <>""And Textl3.text <>1111

Then sa= Label20.Caption

+

1

sql = "insert into fızikrrıu(sayac,boy, kilo,.nabiz,kaobasinci,_ates,..sfmbıılgu,..ibtiınali,tedari,batar,...sa.)(iL)_ya)ues(" sql = sql& "" &Textl .text& ","

sql=sql& ""' &Text6.text& "',"

sql=sql& '"" &Text7.text& "',"

sql=sq)& "'" &Text8.text& "',"

sql = sql& "'" &Text9.text& "',"

sql = sql& "'" &TextlO.text& "',"

sql = sql& "111 &Textl Ltext& "',"

sql = sql&11111_&_Textl2.text _{& "',"}

sql = sql& ""' &Textl3.text & "',"

sql = sql&11111_&_{DTPickerl.Value} _{& '","}

sql=sql& "" &sa& ")"

(74)

MsgBox ("Bilgiler Kaydedildi") Comnıand2.Enabled = True Coımnand2.Enabled = False Else

MsgBox ("Hasta ile ilgili bütün alanlan doldurun") Textl l.SetFocus

End If End If Data I .Refresh End Sub

Private Sub Textl_KeyPress(KeyAscii As Integer) Dim sor

IfKeyAscii = 13 Then KeyAscii = O

Set verilerim= New ADODB.Connection verilerim.CursorLocation = adUseClient

baglanti = "Provider=Microsoft.jet.oledb.4.0; Data Source=C:\Documents and Settings\Vedat\My Documents\GRdproject\kayitl .mdb''

verilerim. Open baglanti

sor= "select* from kayit2 where sayac= "

+

Textl.text

+ ""

Set depoın2 = verilerim.Execute(sor)

If depoın2.EOF 11ıen

MsgBox ("Aradıgııuz hasta kaydı bulunamadı ! Yeni Kayit Bölümünden Hasta Kaydım Yapınız") Textl .text= "" Textl.SetFocus DBGridl.Visible = False Else Text2.text = depoın2![ad] Text3.text = depoın2![soyad] Text4.text = depoın2![cinsiyeti] Text5.text = depoın2! [adres]

Datal.RecordSource ="select* from fizikmu where sayac="

+

Textl.text

+ ""

Data I .Refresh

DBGridl.Visible = True

Set depoml = New ADODB.Recordset

Set depoml = verilerim.Execute("select count(sayac)as zar from fizikmu where sayac="

+

Textl.text

+ "")

Label20.Caption = depom1 ! [zar]

End If End If

IfinStr(("l234567890" &vbBack & "")~Chr(KeyAscii))_=O Then KeyAscii = O

End If End Sub

Private Sub Command3_Click() Dim sorgu, sor

If Text 1.text = "" Then

MsgBox "Hastanın dosya nunıarasııu giriniz!" Else

arama= Val(InputBox("Ziyaret sayisini giriniz")) Set verilerim= New ADODB.Coıınection

baglanti = "Provider=Microsoft.jet.oledb.4.0; Data Source=C:\Documents and Settings\Vedat\My Docuınents\GRdproject\kayitl .mdb"

sorgu= "select* from fizikmu where sayac="

+

Textl.text

+"

and sayil =" & arama &

1111

Set depo3 = verilerim.Execute(sorgu) If depo3.EOF Then

MsgBox ("aradıgınız dosya numarasındase.zi.yaretsayisindahrhastaKaydLbulııııaqıadı ")

Else )

sor= "select." from kayit2 where sayac= "

+

Textl.text

+ ""

Set depoın2 = verilerim.Execute(sor)

If depoın2.EOF Then

(75)

Textl.text = ""

Textl.Setfocus Else

Text2 .text = depom2![ad] Text3.text = depom2![soyad) Text4.text = depom2![cinsiyeti] Text5.text=depom2![adres] Label20.Caption = depo3! [sayı1] Text6.text=depo3![boy] Text7.text = depo3![kilo] Text8 = depo3![nabiz] Text9 = depo3![kanbasinci] TextlO = depo3![ates] Textl 1

=

depo3![sfınbulgu] Textl2 = depo3![ihtimali] Textl3 = depo3![tedavi]

Datal .RecordSource = "select

*

from fızikmu where sayac=" + Textl .text+ "" Daral.Refresh depo3.Close depom2.Close Command4.Enabled = True Command2.Enabled = False End If End If End If End Sub

Private Sub Command+_Click() Dim cevapl As String

Dim sorgu2 As String

'IfText6.Text <>""And Text7.Text <> "" And.Iext&.IexL<> "" And.Iext:9.TexL<> "" AndTextlO.TexL<:> "" And Textl 1.Text <>""And Textl2.Text <> "" And Textl3.Text <>""And Textl4.Text <>""And Textl5.Text <>""And Textl6.Text <>""And Textl7.Text <>""Then

cevap 1 = MsgBox("Hasta Bilgilerini güncellemek istiyormusunuz ?", vblnformation + vbYesNo) If cevap 1 = vbYes Then

Set verilerim= New ADODB.Coıınection verilerim.CursorLocation = adUseClient

baglanti = "Provider=Microsoft.j\!t.oledb.4.0;.DataSource=C:\Documents and Settiııgş\Vedat\My Documents\GRdproject\kayitl .mdb"

sorgu2

=

"update fızikmu set boy=" &Text6.text& "', kilo="'&Text7.text& "',nabiz='"&Text8.text& "',kanbasinci="'&

Text9.text& "',ates=" &TextlO.text& "',sfmbulgu=" &Textl l.text& "',ihtimali="&Textl2.text & "',tedavi=" &

Textl2.text & "'where sayil

="

&arama& "and sayac=" + Textl.text + "" verilerim.Execute (sorgu2)

MsgBox ("BilgÜer günceÜeştirildi")

Datal.RecordSource ="select* from kayit where sayac=v+ Textl.text + "" 'Datal .Refresh

Else

'MsgBox "Hastamn fızik ve tedavisi hakkında kayıt yoktur!", vbCritical + vbYesNo, "Tetkik ve tahlil formuna dön" 'End If

End If End Sub

KeyAscii = O SendKeys "{Tab}"

ElselfinStr(("l234567890" &vbBack& ""),Chr(KeyAscii)) = O Then KeyAscii = O

End If End Sub

(76)

KeyAscii = O

SendKeys "{Tab}"

ElselflnStr(("l234567890"

&

vbBack

& ""),

Chr(KeyAscii))

=O

Then

KeyAscii

=O

NEAR EAST UNIVERSITY FACULTY OF ECONOMICS AND ADMINISTRATIVE SCIENCE DEPARTMENT OF COMPUTER INFORMAİION SYSTEMS