Exercise 3: Write Lookup Routine
-
Start Studio, and create a new routine. This routine is also available in the SAMPLES namespace as BASlookup1.BAS.
-
The main subroutine.
Option Explicit dim id, name, phone, intdob, matches public sub main() dim done do getsubmit(id, done) ' let user submit a string for lookup if id = 0 then continue do display(id, "table") ' display the chosen person loop until done end sub
-
The getsubmit subroutine.
private sub getsubmit(ByRef id as %Integer, ByRef done as %Boolean) ' ask user what to search for, and take appropriate action dim submit id = 0 : done = False println : input "Lookup: ", submit : println if (submit = "") then ' user entered nothing done = True exit sub end if ' figure out what user entered if (submit = "?") then ' display help help() elseif (InStr(submit, "-") or (submit > 0 and submit < 999)) then println "...finding phone number" getphone(submit, id) elseif InStr(submit, ",") then submit = formatName@myBASdatent(submit) println "...finding name" getname(submit, id) elseif validDOB@myBASdatent(submit) then println "...finding birthday" getdob(submit, id) ' else it's an error end if end sub
-
The help subroutine.
private sub help() ' display different types of lookups println "You can enter:" println space(10), "* full name: Smith,John" println space(10), "* last name only: Smith," println space(10), "* partial name: Sm,J or Smith,J or Sm,John" println space(10), "* phone number with area code: 617-621-0600" println space(10), "* partial phone numbers: 617 or 617-621" println space(10), "* date of birth" println end sub
-
The getdob subroutine.
private sub getdob(dob as %String, ByRef id As %Integer) ' perform dob lookup ' no partial matches ' if user picks a name from the list, id is returned to the caller dim count, loopid erase matches intdob = validDOB@datent(dob) ' convert dob ' is the date of birth in the index? if not exists(^PersonI("DOB", intdob)) then print "...no matches" exit sub end if loopid = "" ' loop through ids, and number them do count = count + 1 loopid = traverse(^PersonI("DOB", intdob, loopid)) if loopid = "" then exit do matches(count) = loopid print count, ") " display(loopid, "line") loop pick(id) end sub
-
The getphone subroutine. The bug mentioned in the description for the Hands-On Exercise occurs when the user specifies a 3-digit area code for lookup. Traverse() interprets this as a number (no “-” character), so the first Traverse() below won't return the right result. The solution is in the line that precedes the first Traverse(): appending a “-” to the area code.
private sub getphone(origph as %String, ByRef id As %Integer) ' perform phone lookup ' if user picks a name from the list, id is returned to the caller erase matches dim count, loopid, ph count = 0 ' assume no matches if (origph > 0 and origph < 999) then origph = origph & "-" ' change to a string instead of a number end if ' origph may be an exact match, if not, use traverse() ph = origph if not exists(^PersonI("Phone", origph)) then ph = traverse(^PersonI("Phone", origph), 1, loopid) else loopid = ^PersonI("Phone", origph) end if ' loop through phone numbers, and number them, ' quit as soon as phone doesn't match original ' loopid holds the ONE id per phone number do count = count + 1 if left(ph, len(origph)) <> origph then exit do matches(count) = loopid print count, ") " display(loopid, "line") ph = traverse(^PersonI("Phone", ph), 1, loopid) loop if not exists(matches) then ' were there matches? print "...no matches" exit sub end if pick(id) end sub
-
The getname subroutine.
private sub getname(name As %String, ByRef id As %Integer) ' perform name lookup ' if user picks a name from the list, id is returned to the caller erase matches dim count, loopid, origln, origfn, ln, fn count = 0 ' assume no matches origln = piece(name, ",", 1) : origfn = piece(name, ",", 2) ' origln may be an exact match, if not, advance using traverse() ln = origln if not exists(^PersonI("Name", origln)) then set ln = traverse(^PersonI("Name", origln)) end if ' loop through last names ' quit as soon as last name doesn't match original do if (left(ln, len(origln)) <> origln) then exit do ' origfn may be an exact match, if not, advance using traverse() fn = origfn if (origfn = "") or not exists(^PersonI("Name", ln, origfn)) then fn = traverse(^PersonI("Name", ln, origfn)) end if ' loop through first names ' quit as soon as first name doesn't match original, or is "" do if ((left(fn, len(origfn)) <> origfn) or (fn = "")) then exit do loopid = "" ' loop through ids do loopid = traverse(^PersonI("Name", ln, fn, loopid)) if (loopid = "") then exit do count = count + 1 matches(count) = loopid print count, ") " display(loopid, "line") loop fn = traverse(^PersonI("Name", ln, fn)) loop ln = traverse(^PersonI("Name", ln)) loop if not exists(matches) then ' were there matches? print "...no matches" exit sub end if pick(id) end sub
-
The display subroutine.
private sub display(id As %Integer, style as %String) ' given an id, get data and write it dim rec rec = ^PersonD(id) name = piece(rec, "^", 1) phone = piece(rec, "^", 2) intdob = piece(rec, "^", 3) if style = "line" then println name, space(2), phone, space(2), DateConvert(intdob, vbToExternal) else display@myBASdatent() end if end sub
-
The pick subroutine.
private sub pick(ByRef id As %Integer) ' choose from the displayed items, and set up id ' id is 0 if no choice is made, id is >0 when user makes a choice dim choice do input "Choose by number: ", choice : println if (choice = "") then exit sub id = matches(choice) if (id <> "") then exit sub ' valid choice id = 0 println "Invalid choice" loop end sub
-
Click File –> Save.
-
Specify myBASlookup.BAS as the filename. Click Save As.
-
Start the Terminal, and run your routine, in the SAMPLES namespace, by typing do main^myBASlookup().