Caché Basic Tutorial
Exercise 3: Write Lookup Routine
[Home] [Back] 
InterSystems: The power behind what matters   
Class Reference   
Search:    

  1. Start Studio, and create a new routine. This routine is also available in the SAMPLES namespace as BASlookup1.BAS.
  2. 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
    
  3. 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
    
  4. 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
    
  5. 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
    
  6. 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
    
  7. 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
    
  8. 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
    
  9. 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
    
  10. Specify myBASlookup.BAS as the filename. Click Save As.
  11. Start Terminal, and run your routine, in the SAMPLES namespace, by typing do main^myBASlookup().