演習 3 ： Lookup ルーチンの記述
-
スタジオを開始し、新規ルーチンを作成します。このルーチンも BASlookup1.BAS として、SAMPLES ネームスペースで使用できます。
-
以下は、main サブルーチンです。
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 -
以下は、getsubmit サブルーチンです。
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 -
以下は、help サブルーチンです。
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 -
以下は、getdob サブルーチンです。
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 -
以下は、getphone サブルーチンです。検索のために 3 桁のエリア・コードを指定すると、演習で述べたバグが発生します。Traverse() は、“-” 文字ではなく、数としてこれを解釈するので、以下の最初の Traverse() は正しい結果を返しません。回避策として、最初の Traverse() の前の行で、エリア・コードに “-” を追加します。
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 -
以下は、getname サブルーチンです。
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 -
以下は、display サブルーチンです。
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 -
以下は、pick サブルーチンです。
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 -
[ファイル]→[保存] をクリックします。
-
ファイル名に myBASlookup.BAS を指定します。[名前を付けて保存] をクリックします。
-
ターミナルを開始し、SAMPLES ネームスペースで do main^myBASlookup() と入力してルーチンを実行します。
