RAILWAY RESERVATION – SCHEME Programming

THANKS TO SATYA FOR THE CODE – satish.smart@rediffmail.com

;;—————————————————————————————-
;; Database
;;—————————————————————————————-
;; Data definition :
;; (define-struct train(source destination train-no no-of-seats-ac no-of-seats-nonac))
;; train is a structure: (make-train ‘kolkata ‘chennai 1234 24 89)) where source is a symbol, destination is a symbol, train-no is a number, no-of-seats-ac is a number, no-of seats-nonac is a number.

(define-struct train(source destination train-no no-of-seats-ac no-of-seats-nonac))

;; Data definition :
;;(define-struct passenger-id(name age sex class train-no seat-no))
;; passenger-id is a structure: (make-passenger-id ‘azhar 21 ‘m ‘ac 1234 50)) where name is a symbol, age is a number, sex is a symbol, class is a symbol,train-no is a number ,seat-no is a number.
(define-struct passenger-id(name age sex class train-no seat-no))

(define train1(make-train ‘kolkata ‘chennai 1234 24 89))
(define train2(make-train ‘kolkata ‘chennai 1235 24 89))

;(define passenger1(make-passenger-id ‘azhar 20 ‘m ‘ac 1234 88))
;(define passenger2(make-passenger-id ‘azhar 20 ‘m ‘ac 1234 87))

;train_list is list of structure train.
(define train_list(list train1 train2))

;passenger_list is a list of structure passenger list.
(define passenger_list (list ))
;;—————————————————————————————-

(define Userid “Enter administrator id:: “)
(define Password “Enter password:: “)
;; Data definition :
;; (define-struct administrator(admin_id admin_password))
;;where admin_id is a symbol and admin_password is a symbol
;;(define admin (make-administrator ‘mahesh ‘rahul))
(define-struct administrator(admin_id admin_password))

(define admin_list ‘())
;;Contract: me-user : string -> void
;;Purpose: To display a massage and generate a input box to take input.
;;Example: (me-user “Enter a number: “)
;; Enter a number:
(define (me-user admin)

(display admin)
(read))

;;Contract: me-admin : string -> void
;;Purpose: To display a massage and generate a input box to take input.
;;Example: (me-admin “Enter a number: “)
;; Enter a number:
(define (me-admin me)

(display me)
(read))

;;contract:check-login:symbol symbol => boolean
;;purpose:to input the username and password and check whether the user name and password matches or not
;;example (check-login ‘mahesh ‘rahul)
;;=>1
(define (check-login id password)
(set! admin_list (append (list (make-administrator 1234 ‘rahul)) admin_list))
(if (not(eqv? id (administrator-admin_id (car admin_list)))) 0
(if (not(eqv? password (administrator-admin_password(car admin_list)))) 0
1
)))

(load “database.ss”)
(load “fun.ss”)
(load “adminfunc.ss”)
;;(load “prompt.ss”)
;;(load “supportivefunctions.ss”)

;;****************************************************************************************
;; Main Menu
;;****************************************************************************************
;;Contract: main-menu : void -> void
;;Purpose: To display main menu and taking input for the options.
;;Example: (main-menu)
; ****************************************************************************************
; RESERVATION FOR RAILWAYS
; ****************************************************************************************
; MAIN MENU
; ****************************************************************************************
; 1. Admin Menu
; 2. Customer Menu
; 3. Exit
; Enter your Choice:
;;Definition:

(define (main-menu)
(newline)
(display “——————————-”)
(newline)
(display ” RESERVATION FOR RAILWAY “)
(newline)
(display “$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$”)
(newline)
(display ” MAIN MENU “)
(newline)
(display “——————————-”)
(newline)
(display ” 1. Admin Menu “)
(newline)
(display ” 2. Customer Menu “)
(newline)
(display ” 3. Exit “)
(newline)
(let ([choice (choice-read "Enter your Choice: ")])
(cond
[(number? choice)
(cond
[(= choice 1) (admin-menu)]
[(= choice 2) (customer-menu)]
[(= choice 3) (display "BYE BYE")]
[else (display "Entry is Wrong")(newline)(main-menu)]
)
]
[else (display "Enter a proper option...")(newline)(main-menu)]
)
))

;;****************************************************************************************
;; Admin Menu
;;****************************************************************************************
;;Contract: admin-menu : void -> void
;;Purpose: To display menu for the administrator and take input for it
;;Example: (admin-menu)
; ****************************************************************************************
; RESERVATION FOR RAILWAYS
; ****************************************************************************************
; ADMIN MENU
; ****************************************************************************************
; 1. Add new train
; 2. Remove train
; 3. Show updated
; 4. List of passanger in a train
; 5. exit
; Enter your Choice:
;;Definition:
(define (admin-menu)
(let ([id (me-user Userid)] [ps (me-admin Password)] )
(if (= 1 (check-login id ps))
(begin
(newline)
(display “************************************”)
(newline)
(display ” RESERVATION FOR RAILWAYS “)
(newline)
(display “***************************************”)
(newline)
(display ” ADMIN MENU “)
(newline)
(display “——————————-”)
(newline)
(display ” 1. Add new train “)
(newline)
(display ” 2. Remove train “)
(newline)
(display ” 3. Show Train list “)
(newline)
(display ” 4. Produce passenger list “)
(newline)
(display ” 5. exit “)
(newline))
(begin
(display “Enter a valid ID and password”)
(main-menu))))
(newline)
(let ([choice (choice-read "Enter your Choice: ")])
(cond
[(number? choice)
(cond
[(= choice 1) (add-train-details)]
[(= choice 2) (remove-train)]
[(= choice 3) (show-train-list)]
[(= choice 4) (show-passenger-list)]
[(= choice 5) (main-menu)]
[else (display "Wrong entry")(newline)(admin-menu)]
)
]
[else (display "Enter a proper option...")(newline)(admin-menu)]
)
))

;;****************************************************************************************
;; CUSTOMER MENU
;;****************************************************************************************
;;Contract: custome-menu : void -> void
;;Purpose: To display menu for the customer and taking input for the options.
;;Example: (customer-menu)
; ****************************************************************************************
; RESERVATION FOR RAILWAYS
; ****************************************************************************************
; Customer Menu
; ****************************************************************************************
; 1. Check Train Availability
; 2. Check Seat Availibility
; 3. Reservation
; 4. main menu
; Enter your Choice:
;;Definition:
(define (customer-menu)
(newline)
(display “————————————–”)
(newline)
(display ” RESERVATION FOR RAILWAYS “)
(newline)
(display “————————————–”)
(newline)
(display ” CUSTOMER MENU “)
(newline)
(display “————————————–”)
(newline)
(display ” 1. Check Train Availability “)
(newline)
(display ” 2. Check Seat Availibility “)
(newline)
(display ” 3. Reservation “)
(newline)
(display ” 4. Main menu” )
(newline)
(let ([choice (choice-read "Enter your Choice: ")])
(cond
[(number? choice)
(cond
[(= choice 1) (check-train-availability)]
[(= choice 2) (check-seat-availability)]
[(= choice 3) (reservation)]
[(= choice 4) (main-menu)]
[else (display "Wrong Entry..")(newline)(customer-menu)]
)
]
[else (display "Enter a proper option...")(newline)(customer-menu)]
)
))
;;****************************************************************************************
;; Accepting Input Values
;;****************************************************************************************
;;Contract: choice-read : string -> void
;;Purpose: To display a massage and generate a input box to take input.
;;Example: (choice-read “Enter a number: “)
;; Enter a number:
(define (choice-read msg)
(display msg)
(read))

(main-menu)

Doctor Details Management (OOPS Concept) – Scheme

;;SPECIFICATION:——-TO MANAGE THE DOCTOR DETAILS OF DEPARTMENT OF HEALTH.—————-

;;PURPOSE: Health department is fully automated where we have 4 health care centres.

;;ONLY ADMINISTRATOR can add,delete,modify and display the details of the doctor

;;ASSUMPTIONS:
;; 1.Database of all centres is centralised.

;;LIMITATION
;; 1.No login is present in the system.
;; 2.Only administrator can access the system
;; 3.A maximum of 1000 records can be added as we have defined the length of the Vector as 1000

;;=========================================================================================================
;;defining the vector.

(define hcc(make-vector 1000)) ;;main vector of the HCC which stores doctor details and location id
(define doc_start_id 1000)   ;;for the first Doctor ID and incremented by 1 as a new doctor is added
(define index 0)            ;; initial index for hcc_vector(not using vector length function as index is incremented
;;each time a new doctor is added)
(define hcc_temp_id 0)

;;==============================================================================================
;;=============================CLASS FOR THE DOCTOR=============================================
;;==============================================================================================
;;PURPOSE:DOCTOR IS A CLASS WHICH STORES DOCTOR DETAILS(DOCTORID,DOCTORNAME,DOCTORPHONENUMBER,HCCID)
;;        AND PERFORMS OPERATIONS ON THEM.

(define (doctor)

;; Data members
(define doctor_id 0)
(define doctor_name “”)
(define doctor_phno 0)
(define doctor_hccid 0)

;; Member Functions

;;=========FUNCTION TO GET THE DOCTOR NAME FROM THE USER==============
;;CONTRACT: (setdocname) void=>void.
;;PURPOSE: It’s used to read the doctor name from console and to validate it for being text.
;;TESTCASE:(setdocname)(“Mary”)=>will set doctor name as Mary
;;(16234)=>The Name has to be a String inside Double Quotes.Please Enter the Name again.

(define (setdocname)
(display “\n Enter the Doctor Name inside double quotes.”)
(set! doctor_name(read))
(if (not (string? doctor_name))
(begin
(display “\n The Name has to be a String inside Double Quotes.”)
(display “\n Please Enter the Name again.”)
(setdocname)
)
(begin
(if (string->number doctor_name)
(begin
(display “\n Please Do not Enter numbers inside double quotes.”)
(display “\n Please Enter the Name Again.”)
(setdocname)
)
(begin
(set! doctor_name doctor_name)
)
)
)
)
)

;;============FUNCTION TO GET THE DOCTOR PHONE NUMBER FROM THE USER=============
;;CONTRACT: (setdocphno) void=>void.
;;PURPOSE: It’s used to read the doctor phone number from console and to validate it for being a number.
;;TESTCASE:(setdocphno)(9900990099)=>will set doctor phone number as 9900990099
;;(gasdgs)=>The Phone Number has to be a Number.Please Enter the Phone Number again.

(define (setdocphno)
(display “\n Enter the Phone Number of the Doctor.”)
(set! doctor_phno(read))
(if (not (number? doctor_phno))
(begin
(display “\n The Phone Number has to be a Number.”)
(display “\n Please Enter the Phone Number again.”)
(setdocphno)
)
(begin
(set! doctor_phno doctor_phno)
)
)
)

;;===========FUNCTION TO GET THE DOCTOR HCC ID FROM THE USER==================
;;CONTRACT: (setdochccid) void=>void.
;;PURPOSE: It’s used to read the doctor hcc id from console and to validate it for bring a number between 1 and 4.
;;TESTCASE:(setdochccid)(1)=>will set doctor hcc id as 1
;;(gasdgs)=>The HCC ID has to be a Number.Please Enter the HCC ID again.
;;(6)=>The HCC ID has to be between 1 and 4.Please Enter the HCC ID again.

(define (setdochccid)
(display “\n Enter the HCC ID of the Doctor.”)
(display “\n 1:Delhi 2:Mumbai 3:Hyderabad 4:Bengaluru”)
(set! doctor_hccid(read))
(if (not (number? doctor_hccid))
(begin
(display “\n The HCC ID has to be a Number.”)
(display “\n Please Enter the HCC ID again.”)
(setdochccid)
)
)
(if (and (>= doctor_hccid 1) (<= doctor_hccid 4))
(begin
(set! doctor_hccid doctor_hccid)
)
(begin
(display “\n The HCC ID has to be between 1 and 4.”)
(display “\n Please Enter the HCC ID again.”)
(setdochccid)
)
)
)

;;============FUNCTION TO DISPLAY THE DOCTOR ID OF THE DOCTOR============
;;CONTRACT:(getdocid) void=>void.
;;PURPOSE:It display the doctor ID.
;;TESTCASE:(getdocid)=>1000.

(define (getdocid)
(display doctor_id)
)

;;============FUNCTION TO DISPLAY THE NAME OF THE DOCTOR=================
;;CONTRACT:(getdocname) void=>void.
;;PURPOSE:It display the doctor Name.
;;TESTCASE:(getdocname)=>Mary.

(define (getdocname)
(display doctor_name)
)

;;============FUNCTION TO DISPLAY THE PHONE NUMBER OF THE DOCTOR============
;;CONTRACT:(getdocphno) void=>void.
;;PURPOSE:It display the doctor phno.
;;TESTCASE:(getdocphno)=>9900990099.

(define (getdocphno)
(display doctor_phno)
)

;;==============FUNCTION TO DISPLAY THE HCC ID OF THE DOCTOR=================
;;CONTRACT:(getdochccid) void=>void.
;;PURPOSE:It display the doctor’s location id.
;;TESTCASE:(getdochccid)=>1.

(define (getdochccid)
(display doctor_hccid)
)

;;==============FUNCTION TO GET THE DOCTOR ID OF THE DOCTOR====================
;;CONTRACT:(get_doc_id) void=>number.
;;PURPOSE:It returns the Doctor ID.
;;TESTCASE:(get_doc_id)=>1000.

(define (get_doc_id)
doctor_id
)

;;===============FUNCTION TO GET THE LOCATION ID OF THE DOCTOR=================
;;CONTRACT:(get_hcc_id) void=>number.
;;PURPOSE:It returns the Doctor Location ID.
;;TESTCASE:(get_hcc_id)=>1

(define (get_hcc_id)
doctor_hccid
)

;;========FUNCTION TO ADD A NEW DOCTOR===================
;;DATA METHOD TO ADD A NEW DOCTOR.
;;CONTRACT: void===>void.
;;PURPOSE:Procedure to add a doctor where doctor details are read from the console.
;;TESTCASES:
;; (Mary 9900990099 1)=>Doctor Added.The Doctor ID is:1000

(define (add_doctor)
(set! doctor_id doc_start_id)
(setdocname)
(setdocphno)
(setdochccid)
(vector-set! hcc index doc_temp)
(set! doc_temp(doctor))
(display “\n Doctor Added.The Doctor ID is:”)
(display doctor_id)
(set! index ( + index 1))
(set! doc_start_id ( + doc_start_id 1))
(main_menu)
)

;;=================FUNCTION TO DISPLAY A DOCTOR/ALL DOCTORS=====================
;;FUCNTION TO DISPLAY A PARTICULAR DOCTOR BASED ON EMPLOYEE ID / LIST OF ALL DOCTORS
;;CONTRACT: (display_doctor) void=>void.
;;Display procedure for displaying all the doctor’s details or the details of the particular doctor.
;;TESTCASE:
;;(1001)==>(1001 mary 9900990099 1 DELHI) – displays details doctor with doctor id as 1001
;;(1)==>display list of all the doctors.
;;(1005) ==> Display’s Doctor does’nt exist if the doctor id is not there.

(define (display_doctor)
(define choice 0)
(define flag 0)
(display “\n To Display list of all the Doctors Enter 1.”)
(display “\n Enter a Doctor ID for a particular doctor.”)
(display “\n **Note – The Doctor ID Starts from 1000**”)
(set! choice(read))
(if (number? choice)
(begin
(if (= choice 1)
(begin
(let loop((i 0))
(define doc_temp(doctor))
(define hcc_temp(hcclocation))
(if (< i index)
(begin
(set! doc_temp (vector-ref hcc i))
(if (not (= (doc_temp ‘get_doc_id) -1))
(begin
(set! flag 1)
(display “\n =====DOCTOR DETAILS=======”)
(display “\n Doctor ID:”)
(doc_temp ‘getdocid)
(display “\n Doctor Name:”)
(doc_temp ‘getdocname)
(display “\n Doctor Phone Number:”)
(doc_temp ‘getdocphno)
(display “\n Doctor HCC ID:”)
(doc_temp ‘getdochccid)
(set! hcc_temp_id (doc_temp ‘gethccid))
(hcc_temp ’set_hcc_id)
(display “\n HCC Name:”)
(hcc_temp ‘disp_hcc_name)
(display “\n ===========================”)
)
)
(loop(+ i 1))
)
)
)
)
)
(if (>= choice 1000)
(begin
(let loop((i 0))
(define doc_temp(doctor))
(define hcc_temp(hcclocation))
(if (< i index)
(begin
(set! doc_temp (vector-ref hcc i))
(if (= (doc_temp ‘get_doc_id) choice)
(begin
(set! flag 1)
(set! doc_temp (vector-ref hcc i))
(display “\n =====DOCTOR DETAILS=======”)
(display “\n Doctor ID:”)
(doc_temp ‘getdocid)
(display “\n Doctor Name:”)
(doc_temp ‘getdocname)
(display “\n Doctor Phone Number:”)
(doc_temp ‘getdocphno)
(display “\n Doctor HCC ID:”)
(doc_temp ‘getdochccid)
(set! hcc_temp_id (doc_temp ‘gethccid))
(hcc_temp ’set_hcc_id)
(display “\n HCC Name:”)
(hcc_temp ‘disp_hcc_name)
(display “\n ===========================”)
)
)
(loop (+ i 1))
)
)
)
)
)
(if (= flag 0)
(begin
(display “\n ======================”)
(display “\n Doctor Does’nt Exist”)
(display “\n ======================”)
)
)
(main_menu)
)
(begin
(newline)
(display “\n ================================================”)
(display “\n The Choice has to be a Number.Please Enter Again”)
(display “\n ================================================”)
(display_doctor)
)
)
)

;;======================FUNCTION TO SET DOCTOR DETAILS AS EMPTY==============
;;PURPOSE:IT’S USED TO SET THE VALUES.USED BY THE delete_doctor function
;;CONTRACT:(empty_doctor)void=>void.
;;TESTCASE:(empty_doctor)(-1 “” 0 0).

(define (empty_doctor)
(set! doctor_id -1)
(set! doctor_name “”)
(set! doctor_phno 0)
(set! doctor_hccid 0)
)

;;=======================FUNCTION TO DELETE A DOCTOR=====================
;;CONTRACT:(delete_doctor) void=>void.
;;PURPOSE:Procedure to delete doctor’s record.
;;TESTCASE:
;;IN DELETE PROCEDURE (1000)=>Doctor is Deleted.
;;If ID is not there then it display Doctor not found.

(define (delete_doctor)
(define choice 0) ;choice is used as local variable for reading the doctor id
(define flag 0)
(define d -1)
(begin
(display “\n Enter the Doctor ID which is to be Deleted”)
(set! choice(read))
(if (number? choice)
(begin
(let loop (( i 0))
(define doc_temp(doctor))
(if (< i index)
(begin
(set! doc_temp (vector-ref hcc i))
(if (= (doc_temp ‘get_doc_id) choice)
(begin
(set! flag 1)
(doc_temp ‘emptydoctor)
(vector-set! hcc i doc_temp)
(display “\n Doctor Deleted”)
)
)
(loop (+ i 1))
)
)
)
)
(begin
(newline)
(display “\n ============================================================”)
(display “\n The Doctor ID has to be Number Please Enter Doctor ID again.”)
(display “\n =============================================================”)
(delete_doctor)
)
)
(if (= flag 0)
(begin
(display “\n ======================”)
(display “\n Doctor Does’nt Exist”)
(display “\n ======================”)
)
)
(main_menu)
)
)

;;=======================FUNCTION TO DISPLAY THE LIST OF ALL DOCTORS IN A PARTICULAR LOCATION==============
;;FUNCTION TO DISPLAY THE LIST OF ALL DOCTORS IN A PARTICULAR LOCATION
;;CONTRACT:(display_location) void=>void.
;;PURPOSE:Display procedure for list of doctors at a particular location.
;;TESTCASE: (1)==>List of all doctors for location 1.
;; if hccid <1 and hccid >4 then location not found.
;;if the input is greater then 4 or less than 1 ==>Location Not found.

(define (display_location)
(define choice 0) ;choice is a local variable where we will read the location id
(define n 0)
(define flag 0)
(begin
(display “\n 1:Delhi 2:Mumbai 3:Hyderabad 4:Bengaluru”)
(display “\n Enter the Location Number : “)
(set! choice(read))
(if (number? choice)
(begin
(if (and (>= choice 1) (<= choice 4))
(begin
(let loop((i 0))
(define doc_temp(doctor))
(define hcc_temp(hcclocation))
(if (< i index)
(begin
(set! doc_temp (vector-ref hcc i))
(if (= (doc_temp ‘gethccid) choice)
(begin
(set! flag 1)
(display “\n =====DOCTOR DETAILS=======”)
(display “\n Doctor ID:”)
(doc_temp ‘getdocid)
(display “\n Doctor Name:”)
(doc_temp ‘getdocname)
(display “\n Doctor Phone Number:”)
(doc_temp ‘getdocphno)
(display “\n Doctor HCC ID:”)
(doc_temp ‘getdochccid)
(set! hcc_temp_id (doc_temp ‘gethccid))
(hcc_temp ’set_hcc_id)
(display “\n HCC Name:”)
(hcc_temp ‘disp_hcc_name)
(display “\n ===========================”)
)
)
(loop (+ i 1))
)
)
)
)
(begin
(display “\n ======================”)
(display “\n Location Does’nt Exist”)
(display “\n ======================”)
(main_menu)
)
)
)
(begin
(display “\n ==================================================”)
(display “\n The Location has to be a Number.Please Enter Again”)
(display “\n ===================================================”)
(display_location)
)
)
(if ( = flag 0)
(begin
(display “\n ========================”)
(display “\n No Doctors in Location.”)
(display “\n =========================”)
)
)
)
(main_menu)
)

;;======================FUNCTION TO MODIFY DOCTOR DETAILS============
;;CONTRACT:(modify_doctor) void=>void.
;;PURPOSE:Procedure to modify all the fields or any individual field of doctor details.
;;TESTCASE:(modify_doctor) 1000 If ID Present then =>displays old values => Asks what has to be modified(name,phone number
;;hccid)and modifes it.Modifying one field is also allowed.
;;If ID not present =>Doctor Does’nt Exist.

(define (modify_doctor)
(define choice 0) ;;to get id of doctor
(define flag 0) ;;for doctor id found / not
(define modify_choice 0)
(begin
(display “\n Enter the ID of the Doctor who is to be Updated.”)
(set! choice(read))
(if (number? choice)
(begin
(let loop((i 0))
(define doc_temp(doctor))
(define hcc_temp(hcclocation))
(if (< i index)
(begin
(set! doc_temp (vector-ref hcc i))
(if (= (doc_temp ‘get_doc_id) choice)
(begin
(set! flag 1)
(display “\n =====OLD DOCTOR DETAILS=======”)
(display “\n Doctor ID:”)
(doc_temp ‘getdocid)
(display “\n Doctor Name:”)
(doc_temp ‘getdocname)
(display “\n Doctor Phone Number:”)
(doc_temp ‘getdocphno)
(display “\n Doctor HCC ID:”)
(doc_temp ‘getdochccid)
(set! hcc_temp_id (doc_temp ‘gethccid))
(hcc_temp ’set_hcc_id)
(display “\n HCC Name:”)
(hcc_temp ‘disp_hcc_name)
(display “\n ===========================”)
(display “\n 1.Modify Doctor Name”)
(display “\n 2.Modify Doctor Phone Number”)
(display “\n 3.Modify Doctor Location(HCCID)”)
(display “\n 4.Modify All Details”)
(display “\n Please Enter your Choice”)
(set! modify_choice(read))
(if (number? modify_choice)
(begin
(case modify_choice
((1) (doc_temp ’setdocname)
(display “\n ======================”)
(display “\n Doctor Name Modified.”)
(display “\n ======================”))
((2) (doc_temp ’setdocphno)
(display “\n ==============================”)
(display “\n Doctor Phone Number Modified.”)
(display “\n ==============================”))
((3) (doc_temp ’setdochccid)
(display “\n =========================”)
(display “\n Doctor HCC ID Modified.”)
(display “\n =========================”))
((4) (doc_temp ’setdocname)
(doc_temp ’setdocphno)
(doc_temp ’setdochccid)
(display “\n =========================”)
(display “\n Doctor Details Modified.”)
(display “\n =========================”))
(else ((display “\n Wrong Choice.”)
(modify_doctor)))
)
)
(begin
(display “\n================================”)
(display “\n The Choice has to be a Number.”)
(display “\n=================================”)
(modify_doctor)
)
)
(vector-set! hcc index doc_temp)
)
)
(loop(+ i 1))
)
)
)
)
(begin
(display “\n ==================================”)
(display “\n The Doctor ID has to be a Number.”)
(display “\n Please Enter the  Doctor ID Again.”)
(display “\n ==================================”)
(modify_doctor)
)

)
(if ( = flag 0)
(display “\n Doctor Does’nt Exist.”)
)
(main_menu)
)
)

;;=======================FUNCTION TO EXIT============================
;;CONTRACT:(exitmain) void=>void.
;;PURPOSE:(exitmain) is used to exit.

(define (exitmain)
(begin
(display “\n Exiting ………..Exited”)
)
)

;;===================LAMBDA – THE INTERFACING FUNCTION==================
;;PURPOSE: Its a function for interacting with the methods of the class.
(lambda (msg)
(cond
((eqv? msg ‘add_doctor)(add_doctor))
((eqv? msg ‘display_doctor)(display_doctor))
((eqv? msg ‘getdocid)(getdocid))
((eqv? msg ‘getdocname)(getdocname))
((eqv? msg ‘getdocphno)(getdocphno))
((eqv? msg ‘getdochccid)(getdochccid))
((eqv? msg ‘get_doc_id)(get_doc_id))
((eqv? msg ‘delete_doctor)(delete_doctor))
((eqv? msg ‘exit)(exitmain))
((eqv? msg ‘emptydoctor)(empty_doctor))
((eqv? msg ‘gethccid)(get_hcc_id))
((eqv? msg ‘display_location)(display_location))
((eqv? msg ‘modify_doctor)(modify_doctor))
((eqv? msg ’setdocname)(setdocname))
((eqv? msg ’setdocphno)(setdocphno))
((eqv? msg ’setdochccid)(setdochccid))
(else (error msg “\n Not a Supported Function”))
)
)

) ;;================END OF CLASS DEFINITION FOR DOCTOR==========================
;;==============================================================================
;;==============================================================================

;;******************************************************************************
;;******************************************************************************

;;==============================================================================
;;========================CLASS FOR LOCATION====================================
;;==============================================================================

;;purpose:hcclocation is another class for healthcare centre names.

(define (hcclocation)

;;data members

(define hcc_id 0)
(define hcc_name “”)

;;member functions

;;========FUNCTION TO RETRIVE HCC ID======================
;;CONTRACT:(get_hcc_id) void=>number.
;;PURPOSE: To retrieve the hccid for objects of the class.
;;TESTCASE:(get_hcc_id)=>1.

(define (get_hcc_id) hcc_id)

;;===============FUNCTION TO RETRIVE HCC NAME========================
;;CONTRACT:(get_hcc_id) void=>string.
;;PURPOSE: To retrieve the hccname for objects of the class.
;;TESTCASE:(get_hcc_id)=>Delhi.

(define (get_hcc_name) hcc_name)

;;==============FUNCTION TO SET HCC ID==========================
;;CONTRACT:(set_hcc_id) number=>void.
;;PURPOSE: To set the hcc_id.

(define (set_hcc_id z)
(set! hcc_id z)
)

;;================FUNCTION TO DISPLAY THE NAME OF THE LOCATION===================
;;CONTRACT: (disp_hcc_name) void => void.
;;PURPOSE:To display the names of the health care centre location.
(define (disp_hcc_name)
(cond
((eqv? hcc_id 1)(display “Delhi”))
((eqv? hcc_id 2)(display “Mumbai”))
((eqv? hcc_id 3)(display “Hyderabad”))
((eqv? hcc_id 4)(display “Bengaluru”))
)
)

;;==========INTERFACING FUNCTION – LAMBDA==============
;;PURPOSE: Its a function for interacting with the methods of the hcclocation class.

(lambda (msg)
(cond
((eqv? msg ’set_hcc_id)(set_hcc_id hcc_temp_id))
((eqv? msg ‘disp_hcc_name)(disp_hcc_name))
)
)

) ;;==================END OF LOCATION CLASS======================================
;;===============================================================================
;;===============================================================================

;;Object of the Doctor Class.
(define doc_temp(doctor))

;;CONTRACT:It reads from choice from the console.
;;PURPOSE:Main menu procedure to get the menu for choosing options.

(define (main_menu)
(define choice 0) ;choice is a local declaration for reading the number to select the procedure.

(begin
(display “\n =============================================================”)
(display “\n ===========Welcome to Doctor Management System===============”)
(display “\n =============================================================”)
(display “\n 1.Add a Doctor”)
(display “\n 2.Delete a Doctor”)
(display “\n 3.Modify a Doctor”)
(display “\n 4.Display a Doctor / All Dcotors”)
(display “\n 5.Display List of Doctors in a Location “)
(display “\n 6.Exit”)
(display “\n Enter your CHOICE”)
(set! choice(read))
(cond
((eqv? choice 1) (doc_temp ‘add_doctor))
((eqv? choice 2) (doc_temp ‘delete_doctor))
((eqv? choice 3) (doc_temp ‘modify_doctor))
((eqv? choice 4) (doc_temp ‘display_doctor))
((eqv? choice 5) (doc_temp ‘display_location))
((eqv? choice 6) (doc_temp ‘exit))
(else (main_menu))
)
)
)

(main_menu)

;;==============================================================================================
;;====================================END OF PROGRAM============================================
;;==============================================================================================

Polymorphism in Scheme – An example

;;======GLOBAL VARIABLES=====
(define t1 0)
(define t2 0)
;;=====CLASS DEFINITION=====
(define (classarea)

;;DATA MEMBERS

(define a 0)
(define b 0)
(define c 0)

;;MEMBER FUNCTION

(define (seta p)
(set! a p)
)

(define (setb q)
(set! b q)
)

(define (setc r)
(set! c r)
)

(define (areasquare)
(display “\n Area of Square is :”)
(foo a)
)

(define (arearectangle)
(display “\n Area of Rectangle is :”)
(foo a b)
)

(define foo
(case-lambda
((x) (* x x))
((x y) (* x y))
)
)

(lambda (msg)
(case msg
((1)
(display “\n Enter the side of the square”)
(set! t1(read))
(seta t1)
(areasquare)

)
((2)
(display “\n Enter the lenght of the rectangle”)
(set! t1(read))
(seta t1)
(display “\n Enter the breadth of the rectangle”)
(set! t2(read))
(setb t2)
(arearectangle)

)
)
)
)

(define z(classarea))

(z 1)
(z 2)

Vectors and Classes in Scheme – a simple example

(define shop(make-vector 10))

(define (product p_id p_name p_cid p_price)
(define (dispproduct)
(display “\n =====PRODUCT DETAILS=======”)
(display “\n Product ID:”)
(display p_id)
(display “\n Product Name:”)
(display p_name)
(display “\n Product Category ID:”)
(display p_cid)
(display “\n Product Unit Price:”)
(display p_price)
(display “\n ===========================”)
)
(define (readproduct)
(display “\n Enter the Product ID:”)
(set! p_id(read))
(display “\n Enter the Product Name:”)
(set! p_name(read))
(display “\n Enter the Product Category ID:”)
(set! p_cid(read))
(display “\n Enter the Product Unit Price:”)
(set! p_price(read))
)
(define (changeprice)
(display “\n Enter the new price”)
(set! p_price(read))
)
(lambda (msg)
(cond
((eqv? msg ‘readpdt)(readproduct))
((eqv? msg ‘disppdt)(dispproduct))
((eqv? msg ‘changeprice)(changeprice))
(else (error msg “is not a Supported Function”))
)
)
)

;;=====END OF CLASS DEFINITION==========================
(define (getshop)
(let loop((i 0))
(define p1(product 0 “” 0 0)) ;;the most important line(remember the placement)
(if (< i 3)
(begin

(p1 ‘readpdt)
(vector-set! shop i p1)
(loop (+ i 1))
)
)
)
)

(define (dispshop)
(let loop((i 0))
(if (< i 3)
(begin
((vector-ref shop i) ‘disppdt)
(loop(+ i 1))
)
)
)
)
(getshop)
(dispshop)

Function Overloading in Scheme – An example

PROGRAM :-

;; Schemes offer a case-lambda macro

(define foo
(case-lambda
((x) “no additional args”)
((x y) “1 additional arg”)
((x y z) “2 additional args”)
((x . any) “even more additional args”)))

TEST CASES:-

> (foo 1)
“no additional args”
> (foo 2)
“no additional args”
> (foo 1 2)
“1 additional arg”
> (foo 1 2 3)
“2 additional args”
> (foo 1 2 3 4 5 6)
“even more additional args”

Vectors + Classes + Inheritance in Scheme Programming – an example

(define s_id 0)
(define s_name “”)
(define s_courseid -1)
(define s_sex -1) ;1-male,0-female
(define s_phno 0)
(define h_name “”)
(define h_id 0)
(define s_db(vector 10))

(define (student)

;;DATA MEMBERS
(define student_id 0)
(define student_name “”)
(define student_courseid -1)
(define student_sex -1)
(define student_phno 0)

;;MEMBER FUNCTIONS

;;fn to set student id
(define (setID)
(display “\n Enter Student ID:”)
(set! s_id(read))
(if (not(number? s_id))
(begin
(display “\n Student ID has to be a number”)
(setID)
)
(begin
(set! student_id s_id)
)
)
)
(define (setName)
(display “\n Enter Student Name:”)
(set! s_name(read))
(if (not(string? s_name))
(begin
(display “\n Student Name has to be a string.”)
(setName)
)
(begin
(set! student_name s_name)
)
)
)

(define (setCourse)
(display “\n Enter Student Course:”)
(set! s_courseid(read))
(set! student_courseid s_courseid)
)

(define (setSex)
(display “\n Enter the Sex of the Student:”)
(set! s_sex(read))
(set! student_sex s_sex)
)

(define (setPhno)
(display “\n Enter the Phone Number of the Student:”)
(set! s_phno(read))
(set! student_phno s_phno)
)

(define (displaydetails)
(display “\n Student ID:”)
(display student_id)
(display “\n Student Name:”)
(display student_name)
(display “\n Student Course:”)
(display student_courseid)
(display “\n Sex:”)
(display student_sex)
(display “\n Student Phone Number:”)
(display student_phno)
)

(define (modify_phno)
(display “\n Enter the new Phone Number:”)
(set! s_phno(read))
(set! student_phno s_phno)
)

(lambda (msg)
(cond
[(eqv? msg 'setid)(setID)]
[(eqv? msg 'setname)(setName)]
[(eqv? msg 'setcourse)(setCourse)]
[(eqv? msg 'setsex)(setSex)]
[(eqv? msg 'setphno)(setPhno)]
[(eqv? msg 'displaydetails)(displaydetails)]
)
)
)

;;end of class defn

(define (hostel)
(define stud1(student))
;;DATA MEMBERS
(define hostel_name “”)
(define hostel_id 0)

;;MEMBER FUNCTIONS
(define (setHostelName)
(display “\n Enter Hostel Name:”)
(set! h_name(read))
(set! hostel_name h_name)
)

(define (setHostelId)
(display “\n Enter Hostel ID:”)
(set! h_id(read))
(set! hostel_id h_id)
)

(define (displayHostel)
(display “\n Hostel Name:”)
(display hostel_name)
(display “\n Hostel ID:”)
(display hostel_id)
)

(lambda(msg)
(cond
[(eqv? msg 'hostelname)(setHostelName)]
[(eqv? msg 'hostelid)(setHostelId)]
[(eqv? msg 'displayhostel)(displayHostel)]
[#t (stud1 msg)]
)
)
)

(define mr(student))

(define mrhostel(hostel))
(define copy (hostel))

(mrhostel ’setid)
(mrhostel ’setname)
(mrhostel ’setcourse)
(mrhostel ’setsex)
(mrhostel ’setphno)
(mrhostel ‘hostelname)
(mrhostel ‘hostelid)
;(mrhostel ‘displaydetails)
;(mrhostel ‘displayhostel)
(vector-set! s_db 0 mrhostel) ;setting 0th index of vector s_db as mrhostel
(set! copy (vector-ref s_db 0)) ;;copying 0th index of s_db to copy
(copy ‘displaydetails) ;calling fns using copy
(copy ‘displayhostel)  ;calling fns using copy

Inhertitance in Scheme – 2 ways

First WAY

Code: -

;;defn of super class
(define (superclass)
(define (inclass)
(display “\n In Super Class”)
)
(define (disp)
(display “\n Display of Super Class”)
)
(lambda(main)
(case main
((1) (inclass))
((2) (disp))
)
)
) ;;end of superclass
;;defn of subclass
(define (subclass)
(define super(superclass))
(define (subclass1)
(display “\n In Sub Class”)
)
(define (disp)
(display “\n Display of Sub Class”)
)
(lambda (main)
(case main
((1) (super 1))
((2) (super 2))
((3) (subclass1))
((4) (disp))
)
)
)
;;end of sub class

(define sub(subclass))
(sub 1)
(sub 2)
(sub 3)
(sub 4)

Output:-

In Super Class
Display of Super Class
In Sub Class
Display of Sub Class

Second Way

Code :-

;;defn of super class
(define (superclass)
(define (inclass)
(display “\n In Super Class”)
)
(define (disp)
(display “\n Display of Super Class”)
)
(lambda(msg)
(cond
((eqv? msg ‘inclass)(inclass))
((eqv? msg ‘disp)(disp))
)
)
)
;;end of superclass
;;defn of subclass
(define (subclass)
(define super(superclass))
(define (subclass1)
(display “\n In Sub Class”)
)
(define (disp)
(display “\n Display of Sub Class”)
)
(lambda (msg)
(cond
((eqv? msg ’subclass1)(subclass1))
((eqv? msg ‘disp)(disp))
(#t (super msg))
)
)
);;end of sub class

(define sub(subclass))
(sub ‘inclass) ;calls superclass fn
(sub ‘disp)    ;;calls subclass fn(even though super class also has fn called ‘disp
(sub ’subclass1) ;;calls subclass fn
(sub ‘disp)      ;;calls sub class fn

Output :-

In Super Class
Display of Sub Class
In Sub Class
Display of Sub Class

Inheritance in Scheme Programming

(define s_id 0)
(define s_name “”)
(define s_courseid -1)
(define s_sex -1) ;1-male,0-female
(define s_phno 0)
(define h_name “”)
(define h_id 0)

(define (student)

;;DATA MEMBERS
(define student_id 0)
(define student_name “”)
(define student_courseid -1)
(define student_sex -1)
(define student_phno 0)

;;MEMBER FUNCTIONS

;;fn to set student id
(define (setID)
(display “\n Enter Student ID:”)
(set! s_id(read))
(set! student_id s_id)
)

(define (setName)
(display “\n Enter Student Name:”)
(set! s_name(read))
(set! student_name s_name)
)

(define (setCourse)
(display “\n Enter Student Course:”)
(set! s_courseid(read))
(set! student_courseid s_courseid)
)

(define (setSex)
(display “\n Enter the Sex of the Student:”)
(set! s_sex(read))
(set! student_sex s_sex)
)

(define (setPhno)
(display “\n Enter the Phone Number of the Student:”)
(set! s_phno(read))
(set! student_phno s_phno)
)

(define (displaydetails)
(display “\n Student ID:”)
(display student_id)
(display “\n Student Name:”)
(display student_name)
(display “\n Student Course:”)
(display student_courseid)
(display “\n Sex:”)
(display student_sex)
(display “\nStudent Phone Number:”)
(display student_phno)
)

(define (modify_phno)
(display “\n Enter the new Phone Number:”)
(set! s_phno(read))
(set! student_phno s_phno)
)

(lambda (msg)
(cond
[(eqv? msg 'setid)(setID)]
[(eqv? msg 'setname)(setName)]
[(eqv? msg 'setcourse)(setCourse)]
[(eqv? msg 'setsex)(setSex)]
[(eqv? msg 'setphno)(setPhno)]
[(eqv? msg 'displaydetails)(displaydetails)]
)
)
)

;;end of class defn

(define (hostel)
(define stud1(student))
;;DATA MEMBERS
(define hostel_name “”)
(define hostel_id 0)

;;MEMBER FUNCTIONS
(define (setHostelName)
(display “\n Enter Hostel Name:”)
(set! h_name(read))
(set! hostel_name h_name)
)

(define (setHostelId)
(display “\n Enter Hostel ID:”)
(set! h_id(read))
(set! hostel_id h_id)
)

(define (displayHostel)
(display “\n Hostel Name:”)
(display hostel_name)
(display “\n Hostel ID:”)
(display hostel_id)
)

(lambda(msg)
(cond
[(eqv? msg 'hostelname)(setHostelName)]
[(eqv? msg 'hostelid)(setHostelId)]
[(eqv? msg 'displayhostel)(displayHostel)]
[#t (stud1 msg)]
)
)
)

(define mr(student))

(define mrhostel(hostel))

(mrhostel ’setid)
(mrhostel ’setname)
(mrhostel ’setcourse)
(mrhostel ’setsex)
(mrhostel ’setphno)
(mrhostel ‘hostelname)
(mrhostel ‘hostelid)
(mrhostel ‘displaydetails)
(mrhostel ‘displayhostel)

OOPS BASICS (CLASS) in SCHEME

(define (point x y) ;;like creating a class in c
(define (getx) x) ;;private Function 1 to return x
(define (gety) y) ;;private function 2 to return y

(define (add a b) ;;private function to add 2 points
(begin
(define sum1 0)
(define sum2 0)
(set! sum1 (+ (a ‘getx)(b ‘getx)))
(set! sum2 (+ (a ‘gety)(b ‘gety)))
(display sum1)
(newline)
(display sum2)
)
)
(lambda(message) ;telling what various calls mean
(cond
((eqv? message ‘getx) (getx)) ;;whn object ‘getx is called it will call (getx)
((eqv? message ‘gety) (gety)) ;;whn object ‘gety is called it will call (gety)
((eqv? message ‘add) (add p1 p2)) ;;add p1 and p2(not called as yet)
(else (error “Undefined Message” message))
)
)
)     ;end of class defintion
(define p1(point 1 2)) ;creating object of class point
(define p2(point 3 4)) ;creating object of class point
;(p ‘getx)
;(newline)
;(p ‘gety)
;(newline)
(p1 ‘add) ;calling p1 ‘add – we need an instance of the class to call any fucntion of the class.
;(newline)
; (add p1 p2)
;(p ‘getx)
;(newline)
;(p ‘gety)

Doctor Details Management in Scheme Language

This Program was created by my group for the Structured Programming Case Study for TCS ILP in Scheme Programming Language.

Use this as a reference and it’s a fully functional program with all the validations.

;SPECIFICATION:——-Health department wants to automate its doctor’s details management across various
;; health care centres. Health department has only 4 health care centres.The administrator
;; should be able to add, delete,modify the doctor details for a health care centre. He should
;; be able to view the list of all doctors who are present in a particular
;; health centre..—————-

;;PURPOSE: Health department is automated fully where we have 4 health care centres.

;;ONLY ADMINISTRATOR can add,delete,modify and display the details of the doctor

;;ASSUMPTIONS:
;; 1.Database of all centres is centralised.

;;LIMITATION
;; 1.No login is present in the system.
;; 2.Only administrator can access the system
;; 3.A maximum of 1000 records can be added as we have defined the length of the Vector as 1000

;;=========================================================================================================

;; defining the structures,instance of the structure and the vector.

(define hcc_vector(make-vector 1000)) ;;main vector of the HCC which stores doctor details and location id
(define-struct doctor(doctor_id doctor_name doctor_phno hccid)) ;;structure defn for the doctor
(define-struct hcclocation(hcc_id hcc_name)) ;;structure defn for the HCC Location
(define doctor_instance(make-doctor 0 “” 0 0)) ;;temporary instance of doctor structure

;;Four Instances of hcclocation structure, One for each of the Centers

(define hcc_location1(make-hcclocation 1 “Delhi”)) ;;1st Location
(define hcc_location2(make-hcclocation 2 “Mumbai”)) ;;2nd Location
(define hcc_location3(make-hcclocation 3 “Hyderabad”)) ;;3rd Location
(define hcc_location4(make-hcclocation 4 “Bengaluru”)) ;;4th Location

;;===============================================================================================

;;GLOBAL DECLARATIONS

(define doc_id_start 1000) ;;for the first Doctor ID and incremented by 1 as a new doctor is added
(define doc_temp_name “”) ;;for storing name of the doctor entered by admin
(define doc_temp_phno 0) ;;for storing temporary phone number of docotor entered by admin
(define hccid_temp 0) ;;for storing hccid(location id) of doctor as entered by admin
(define index 0) ;; initial index for hcc_vector(not using vector length function as index is incremented each time
;; a new doctor is added)

;;==================================================================================================

;;Function to ADD A NEW DOCTOR.
;;CONTRACT: NOINPUT===>addition sucessfull.
;;PURPOSE:Procedure to add a doctor where doctor details are read from the console.
;;TESTCASES:
;; (mary 9900990099 1)=>Doctor added successfully Doctorid-1000

(define (add_doctor)
(begin
(set! doc_temp_name “”) ;;setting to “”every time a new doctor has to be added to prevent previous values being written
(set! doc_temp_phno 0) ;;setting to 0 every time a new doctor has to be added to prevent previous values being written
(set! hccid_temp 0) ;;setting to 0 every time a new doctor has to be added to prevent previous values being written
(newline)
(display “Enter the name of the doctor inside Double Quotes. “) ;asking for name
(set! doc_temp_name(read)) ;storing in doc_temp_name
(if (not (string? doc_temp_name)) ;checking if it is string or not
(begin
(display “The Name has to be in Characters”)
(newline)
(display “Please Enter all Details again.”) ;if not enter all details again
(add_doctor)
)
(begin
(set! doc_temp_name doc_temp_name) ;else store in same
)
)
(newline)
(display “Enter the phone number of the doctor”) ;asking for phone number
(set! doc_temp_phno(read)) ;storing phone number
(if (not (number? doc_temp_phno)) ;checking for phone number to be a number
(begin
(display “The Phone Number has to be a Number”)
(newline)
(display “Please Enter all the Details again”)
(add_doctor) ;if not enter all details again
)
(begin
(set! doc_temp_phno doc_temp_phno) ;else store in same
)
)
(display “Enter the HCC ID of the doctor”) ;asking for HCC id
(newline)
(display “1:Delhi 2:Mumbai 3:Hyderabad 4:Bengaluru”) ;displaying list of centers
(set! hccid_temp(read)) ;storing in hccid_temp
(if (not (number? hccid_temp)) ;checking for hccid to be a number
(begin
(display “The HCC ID has to be a Number”)
(newline)
(display “Please Enter all the Details again”)
(add_doctor) ;if not enter all details again
)
(begin
(set! hccid_temp hccid_temp) ;else store in same.
)
)
(if (and (>= hccid_temp 1) (<= hccid_temp 4)) ;checking for hccid to between 1 and 4
(begin
(vector-set! hcc_vector index(make-doctor doc_id_start doc_temp_name doc_temp_phno hccid_temp))
(newline)
(display “Doctor Added Successfully.The Doctor ID is : “)
(display doc_id_start)
(set! doc_id_start (+ 1 doc_id_start))
(set! index (+ index 1))
(main_menu) ;if yes save and go back to main menu and give doctor id
)
(begin
(display “Location Does’nt Exist.”)
(newline)
(display “Please Enter all the Details again”)
(add_doctor) ;else display error msg and enter all the details again
)
)

)
)

;;END OF THE FUNCTION TO ADD A DOCTOR.

;;=====================================================================================================

;;FUCNTION TO DISPLAY A PARTICULAR DOCTOR BASED ON EMPLOYEE ID / LIST OF ALL DOCTORS
;;CONTRACT: NOINPUT===>DISPLAYS DOCTOR’S DETAILS.
;;Display procedure for displaying all the doctor’s details or the details of the particular doctor.
;;TESTCASE:
;;(1001)==>(1001 mary 9900990099 1 DELHI) – displays details doctor with doctor id as 1000
;;(1)==>List of all doctor’s
;;(1005) ==> Display’s Doctor does’nt exist if the doctor id is not there.

(define (display_doctor)
(define choice 0) ;choice is a local variable id for user’s choice
(define flag 0) ;if doctor found then falg is set as 1, else 0 and appropiate message is displayed.
(define n 0) ;for displaying location
(begin
(display “To Display list of all the Doctors Enter 1.”)
(newline)
(display “Enter a Doctor ID for a particular doctor.”)
(newline)
(display “**Note – The Doctor ID Starts from 1000**”)
(set! choice(read)) ;reading user’s choice
(if (number? choice) ;checking for choice to be a number
(begin
(if (= choice 1) ;if choice=1 means (display all the doctors in the HEALH DEPARTMENT.
(begin
(let loop((i 0)) ;looping to display all the doctor’s details
(if (< i index)
(begin
(if (not (= (doctor-doctor_id (vector-ref hcc_vector i)) -1))
(begin
(set! flag 1) ;doctor found set flag as 1
(newline)
(display “===================”)
(newline)
(display “Doctor Details “)
(newline)
(display “===================”)
(newline)
(display “Doctor ID – “)
(display (doctor-doctor_id (vector-ref hcc_vector i)))
(newline)
(display “Doctor Name – “)
(display (doctor-doctor_name (vector-ref hcc_vector i)))
(newline)
(display “Doctor Phone Number – “)
(display (doctor-doctor_phno (vector-ref hcc_vector i)))
(newline)
(display “Doctor Location Id – “)
(display (doctor-hccid (vector-ref hcc_vector i)))
(newline)
(display “Doctor Location Name-”)
(set! n(doctor-hccid(vector-ref hcc_vector i)))
(case n
((1) (display (hcclocation-hcc_name hcc_location1)))
((2) (display (hcclocation-hcc_name hcc_location2)))
((3) (display (hcclocation-hcc_name hcc_location3)))
((4) (display (hcclocation-hcc_name hcc_location4)))
)
)
)
(loop (+ i 1))
)
)
)
)
)
(if (>= choice 1000) ;if choice >=1000 means doctor id is entered and search for it
(begin
(let loop((i 0))
(if (< i index)
(begin
(if (= (doctor-doctor_id(vector-ref hcc_vector i)) choice) ;comparing to find doctor id
(begin
(set! flag 1) ;doctor found – set flag as 1
(newline)
(display “===================”)
(newline)
(display “Doctor Details “)
(newline)
(display “===================”)
(newline)
(display “Doctor ID – “)
(display (doctor-doctor_id (vector-ref hcc_vector i)))
(newline)
(display “Doctor Name – “)
(display (doctor-doctor_name (vector-ref hcc_vector i)))
(newline)
(display “Doctor Phone Number – “)
(display (doctor-doctor_phno (vector-ref hcc_vector i)))
(newline)
(display “Doctor Location – “)
(display (doctor-hccid (vector-ref hcc_vector i)))
(newline)
(display “Doctor Location Name-”)
(set! n(doctor-hccid(vector-ref hcc_vector i)))
(case n
((1) (display (hcclocation-hcc_name hcc_location1)))
((2) (display (hcclocation-hcc_name hcc_location2)))
((3) (display (hcclocation-hcc_name hcc_location3)))
((4) (display (hcclocation-hcc_name hcc_location4)))

)
)
)
(loop (+ i 1))
)
)
)
)
)
(if (= flag 0) ;flag=0 means doctor with that id does’nt exist.
(begin
(display “Doctor Does’nt Exist”) ;hence display appropiate message
)
)
(main_menu) ;goto main menu
)
(begin ;in case choice entered is not a number.So enter choice again
(newline)
(display “================================================”)
(newline)
(display “The Choice has to be a Number.Please Enter Again”)
(newline)
(display “================================================”)
(newline)
(display_doctor) ;call same fucntion again
)
)
)
)

;;END OF FUNCTION TO DISPLAY A DOCTOR DETAILS BASED ON DOCTOR ID/LIST OF ALL THE DOCTORS.

;;==============================================================================================

;;FUNCTION TO DISPLAY THE LIST OF ALL DOCTORS IN A PARTICULAR LOCATION

;;CONTRACT: NOINPUT==>DISPLAY THE DETAILS
;;PURPOSE:Display procedure for list of doctors at a particular location.
;;TESTCASE: (1)==>List of all doctors for that particular location.
;; if hccid <1 and hccid >4 then location not found.
;;if the input is greater then 4 or less than 1 ==>Location Not found.

(define (display_location)
(define choice 0) ;choice is a local variable where we will read the location id
(define n 0) ;to display location
(define flag 0)
(begin
(newline)
(display “1:Delhi 2:Mumbai 3:Hyderabad 4:Bengaluru”) ;list of locationid and corresponding location name
(newline)
(display “Enter the Location Number : “) ;asking user for location number
(set! choice(read)) ;storing in read
(if (number? choice) ;checking if entered choice is a number or not
(begin
(if (and (>= choice 1) (<= choice 4)) ;checking if choice of location is between 1 and 4
(begin
(let loop((i 0))
(if (< i index)
(begin
(if (= (doctor-hccid(vector-ref hcc_vector i)) choice) ;checking if hccid of doctor=choice
(begin ;if true – display
(set! flag 1)
(newline)
(display “===================”)
(newline)
(display “Doctor Details “)
(newline)
(display “===================”)
(newline)
(display “Doctor ID – “)
(display (doctor-doctor_id (vector-ref hcc_vector i)))
(newline)
(display “Doctor Name – “)
(display (doctor-doctor_name (vector-ref hcc_vector i)))
(newline)
(display “Doctor Phone Number – “)
(display (doctor-doctor_phno (vector-ref hcc_vector i)))
(newline)
(display “Doctor Location – “)
(display (doctor-hccid (vector-ref hcc_vector i)))
(newline)
(display “Doctor Location Name-”)
(set! n(doctor-hccid(vector-ref hcc_vector i)))
(case n
((1) (display (hcclocation-hcc_name hcc_location1)))
((2) (display (hcclocation-hcc_name hcc_location2)))
((3) (display (hcclocation-hcc_name hcc_location3)))
((4) (display (hcclocation-hcc_name hcc_location4)))
)
)
)
(loop (+ i 1))
)
)
)
)
(begin
(display “Location Does’nt Exist”)
)
)
(if (= flag 0)
(begin
(newline)
(display “===============================”)
(newline)
(display “Location has no doctors.”)
(newline)
(display “===============================”)
(newline)
)
)
(main_menu)
)
(begin
(newline)
(display “==================================================”)
(newline)
(display “The Location has to be a Number.Please Enter Again”)
(newline)
(display “===================================================”)
(display_location)
)
)
)
)

;;END OF FUNCTION TO DISPLAY LIST OF ALL DOCTORS IN A PARTICULAR LOACTION.

;;=============================================================================================

;;CONTRACT:Read the id==>Doctor is Deleted
;;PURPOSE:Procedure to delete doctor’s record.
;;IN DELETE PROCEDURE (1000)=>Doctor is Deleted
;;If ID is not there then it display Doctor not found.

(define (delete_doctor)
(define choice 0) ;choice is used as local variable for reading the doctor id
(define flag 0)
(define d -1)
(begin
(display “Enter the Doctor ID which is to be Deleted”)
(set! choice(read))
(if (number? choice)
(begin
(let loop (( i 0))
(if (< i index)
(begin
(if (= (doctor-doctor_id(vector-ref hcc_vector i)) choice)
(begin
(set! flag 1)
(set! doctor_instance(make-doctor d “” 0 0))
(vector-set! hcc_vector i doctor_instance)
(display “Doctor Deleted”)
)
)
(loop (+ i 1))
)
)
)
(if (= flag 0)
(display “Doctor Does’nt Exist”)
)
(main_menu)
)
(begin
(newline)
(display “============================================================”)
(newline)
(display “The Doctor ID has to be Number Please Enter Doctor ID again.”)
(newline)
(display “=============================================================”)
(newline)
(delete_doctor)
)
)
)
)

;;======================================================================================================

;;CONTRACT:ID is read from the console==>Doctor Details modified.
;;PURPOSE:Procedure to modify all the fields of doctor details.
;;TESTS:If ID is present==>Doctor details modified else ==>Doctor not found.
;;Limitation: It does’nt modify single field.
;;Limitation: If the data is not validated the Admin will have to Enter the Doctor ID and again and the process will
;; continue as usual.

(define (modify_doctor)
(define doc_temp_id 0) ;doc_temp_id is a local declaration for reading the doctor id.
(define flag 0)
(define n 0)
(begin
(newline)
(display “Enter the Doctor-ID whose details have to be Modified”)
(set! doc_temp_id(read))
(if (number? doc_temp_id)
(begin
(let loop((i 0))
(if (< i index)
(begin
(if (= (doctor-doctor_id(vector-ref hcc_vector i)) doc_temp_id)
(begin
(newline)
(display “=========OLD Details==============”)
(newline)
(display “Doctor Name : “)
(display (doctor-doctor_name(vector-ref hcc_vector i)))
(newline)
(display “Doctor Phone Number : “)
(display (doctor-doctor_phno(vector-ref hcc_vector i)))
(newline)
(display “Doctor Location ID : “)
(display (doctor-hccid(vector-ref hcc_vector i)))
(newline)
(display “Doctor Location Name : “)
(set! n(doctor-hccid(vector-ref hcc_vector i)))
(case n
((1) (display (hcclocation-hcc_name hcc_location1)))
((2) (display (hcclocation-hcc_name hcc_location2)))
((3) (display (hcclocation-hcc_name hcc_location3)))
((4) (display (hcclocation-hcc_name hcc_location4)))
)
(newline)
(display “===================================”)
(newline)
(set! flag 1)
(display “Enter the New Details”)
(newline)
(display “Enter the Doctor’s New Name inside double Quotes- “)
(set! doc_temp_name(read))
(if (not (string? doc_temp_name))
(begin
(display “The Name has to be in Characters”)
(newline)
(display “Please Enter all Details again.”)
(modify_doctor)
)
(begin
(set! doc_temp_name doc_temp_name)
)
)
(newline)
(display “Enter the New Phone Number – “)
(set! doc_temp_phno(read))
(if (not (number? doc_temp_phno))
(begin
(display “The Phone Number has to be a Number”)
(newline)
(display “Please Enter all the Details again”)
(modify_doctor)
)
(begin
(set! doc_temp_phno doc_temp_phno)
)
)
(newline)
(display “Enter the New Location ID – “)
(newline)
(display “1:Delhi 2:Mumbai 3:Hyderabad 4:Bengaluru”)
(newline)
(set! hccid_temp(read))
(if (not (number? hccid_temp))
(begin
(display “The HCC ID has to be a Number”)
(newline)
(display “Please Enter all the Details again”)
(modify_doctor)
)
(begin
(set! hccid_temp hccid_temp)
)
)
(newline)
(if (and (>= hccid_temp 1) (<= hccid_temp 4))
(begin
(set! doctor_instance(make-doctor doc_temp_id doc_temp_name doc_temp_phno hccid_temp))
(vector-set! hcc_vector i doctor_instance)
(display “Details Modified”)
)
(begin
(display “Location Does’nt Exist”)
(newline)
(display “Please Enter all the Details Again.”)
(modify_doctor)
)
)
)
)
(loop (+ i 1))
)
)
)
(if (= flag 0)
(begin
(display “Doctor with this ID does not exist”)
)
)
(main_menu)
)
(begin
(newline)
(display “============================================================”)
(newline)
(display “The Doctor ID has to be a Number.Please Enter Again.”)
(newline)
(display “============================================================”)
(modify_doctor)
)
)
)
)
;;==================================================================================================
;;CONTRACT:NOINPUT==>NOOUTPUT.
;;PURPOSE:Exit procedure to exit from the main..

(define (exitmain)
(begin
(display “Exiting ………..Exited”)
(exit)
)
)

;;====================================================================================================

;;CONTRACT:It reads from choice from the console.

;;PURPOSE:Main menu procedure to get the menu for choosing options.

(define (main_menu)
(define choice 0) ;choice is a local declaration for reading the number to select the procedure.
(begin
(newline)
(display “=============================================================”)
(newline)
(display “===========Welcome to Doctor Management System===============”)
(newline)
(display “==============================================================”)
(newline)
(display “1.Add a Doctor”)
(newline)
(display “2.Delete a Doctor”)
(newline)
(display “3.Modify a Doctor”)
(newline)
(display “4.Display a Doctor / All Dcotors”)
(newline)
(display “5.Display List of Doctors in a Location “)
(newline)
(display “6.Exit”)
(newline)
(display “Enter your CHOICE”)
(set! choice(read))
(cond
((eqv? choice 1) (add_doctor))
((eqv? choice 2) (delete_doctor))
((eqv? choice 3) (modify_doctor))
((eqv? choice 4) (display_doctor))
((eqv? choice 5) (display_location))
((eqv? choice 6) (exitmain))
(else (main_menu))
)
)
)

;;==============================================================================================================

(main_menu) ;;calling the main_menu function to display the menu.