type empNoType : string (5) % create new type (5-character string)
type empRecType : % defines a redcord layout
record % records are made up of fields
no : empNoType
surname : string (20)
given : string (10)
initial : string (1)
rate : real
hireYear : int
hireMonth : int
sinnum : int
end record
const filename := "EMPLOYEE.bin"
const prompt_r := 7
const prompt_c := 20
const title_indent := 10
const input_c := prompt_c + 15
proc displayPrompts
cls
locate (prompt_r, prompt_c + title_indent)
put "EMPLOYEE MAINTENANCE"
locate (prompt_r + 1, prompt_c + title_indent)
put "===================="
locate (prompt_r + 3, prompt_c)
put "Employee # :"
locate (prompt_r + 5, prompt_c)
put "1) Surname :"
locate (prompt_r + 6, prompt_c)
put "2) Given :"
locate (prompt_r + 7, prompt_c)
put "3) Initial :"
locate (prompt_r + 8, prompt_c)
put "4) Rate :"
locate (prompt_r + 9, prompt_c)
put "5) Year Hired :"
locate (prompt_r + 10, prompt_c)
put "6) Month Hired:"
locate (prompt_r + 11, prompt_c)
put "7) SIN :"
locate (prompt_r + 13, prompt_c)
put "Selection :"
end displayPrompts
proc displayData (out : empRecType)
locate (prompt_r + 3, input_c)
put out.no : 5 ..
locate (prompt_r + 5, input_c)
put out.surname : 20 ..
locate (prompt_r + 6, input_c)
put out.given : 10 ..
locate (prompt_r + 7, input_c)
put out.initial : 1 ..
locate (prompt_r + 8, input_c)
put out.rate : 7 : 2 ..
locate (prompt_r + 9, input_c)
put out.hireYear : 4 ..
locate (prompt_r + 10, input_c)
put out.hireMonth : 2 ..
locate (prompt_r + 11, input_c)
put out.sinnum : 2 ..
end displayData
function getKey : empNoType
var emp : empNoType
const zeroes := "00000"
loop
locate (prompt_r + 3, input_c)
put "" : 10 ..
locate (prompt_r + 3, input_c)
get emp : *
exit when emp = ""
emp := zeroes (1 .. 5 - length (emp)) + emp
locate (prompt_r + 3, input_c)
put emp : 5
exit when length (emp) = 5
end loop
result emp
end getKey
function getSurname : string (20)
var surname : string (20)
loop
locate (prompt_r + 5, input_c)
put "" : 10 ..
locate (prompt_r + 5, input_c)
get surname : *
exit when length (surname) > 0 and length (surname) <= 20
end loop
result surname
end getSurname
function getGiven : string (10)
var given : string (10)
loop
locate (prompt_r + 6, input_c)
put "" : 10 ..
locate (prompt_r + 6, input_c)
get given : *
exit when length (given) > 0 and length (given) <= 10
end loop
result given
end getGiven
function getInitial : string (1)
var initial : string (1)
loop
locate (prompt_r + 7, input_c)
put "" : 10 ..
locate (prompt_r + 7, input_c)
get initial : *
exit when length (initial) = 1
end loop
result initial
end getInitial
function getRate : real
var rate : real
loop
locate (prompt_r + 8, input_c)
put "" : 10 ..
locate (prompt_r + 8, input_c)
get rate
exit when rate > 0 and rate < 1000
end loop
result rate
end getRate
function getYear : int
var hireYear : int
loop
locate (prompt_r + 9, input_c)
put "" : 10 ..
locate (prompt_r + 9, input_c)
get hireYear
exit when hireYear > 1900
end loop
result hireYear
end getYear
function getMonth : int
var hireMonth : int
loop
locate (prompt_r + 10, input_c)
put "" : 10 ..
locate (prompt_r + 10, input_c)
get hireMonth
exit when hireMonth > 0 and hireMonth <= 12
end loop
result hireMonth
end getMonth
function getSIN : int
const nonums := "1234567890"
var sinnum, position, sum : int
var temp : string
sum := 0
temp := ""
loop
locate (prompt_r + 11, input_c)
put "" : 10 ..
locate (prompt_r + 11, input_c)
get sinnum
exit when length (intstr (sinnum)) = 9
end loop
for i : 1 .. length (intstr(sinnum))
position := index (nonums, intstr(sinnum) (i .. i))
if position > 0 then
temp := temp + intstr(sinnum) (i .. i)
end if
end for
for i : 2 .. 9 by 2
sum := sum + strint (temp (i .. i)) * 2 div 10
+ strint (temp (i .. i)) * 2 mod 10
end for
for i : 1 .. 7 by 2
sum := sum + strint (temp (i .. i))
end for
if 10 - sum mod 10 = strint (temp (9 .. 9)) then
result sinnum
else result 0
end if
end getSIN
proc getData (which : int, var emp : empRecType)
var start, finish : int
if which = 0 then % get all fields
start := 1
finish := 7
else % get specified field
start := which
finish := which
end if
for i : start .. finish
case i of
label 1 :
emp.surname := getSurname
label 2 :
emp.given := getGiven
label 3 :
emp.initial := getInitial
label 4 :
emp.rate := getRate
label 5 :
emp.hireYear := getYear
label 6 :
emp.hireMonth := getMonth
label 7 :
emp.sinnum := getSIN
label :
end case
end for
end getData
function getChoice : string (2)
var no : string
loop
locate (prompt_r + 13, input_c)
put "" : 7 ..
locate (prompt_r + 13, input_c)
get no : *
exit when no = "" or (no >= "1" and no <= "7")
end loop
result no
end getChoice
%=================== main ===============================
var employee : empRecType % variable to hold an employee
var key : empNoType
var fileno, recno, fld : int
var fldno : string (1)
var found : boolean
open : fileno, filename, read, mod, write, seek % open a binary file
loop
displayPrompts
key := getKey % get key field
exit when key = ""
seek : fileno, 0 % got to start of file
found := false % assume new record
loop
exit when eof (fileno)
tell : fileno, recno % save position in file
read : fileno, employee
if employee.no = key then % check for existing record
found := true
exit
end if
end loop
if not found then % get fields for new record
employee.no := key
getData (0, employee)
end if
loop % allow changes to record
displayData (employee)
fldno := getChoice
exit when fldno = ""
fld := strint (fldno)
getData (fld, employee)
end loop
if found then
seek : fileno, recno % position for existing record
else
seek : fileno, * % position for new record
end if
write : fileno, employee
end loop
close : fileno