Exercise 6: Lookup Routine, version 2
-
The new, longer version of the lookup routine is shown below, broken into sections to help you understand it. This routine is also available in the SAMPLES namespace as lookup2.mac.
-
The modified getsubmit procedure is as follows. Since $$validDOB^datent writes an error message, it should be at the end of the If construct, so it won't write its message too early.
getsubmit() [submit] ; ask user what to search for, and take appropriate action { set id = 0 read !, "Lookup: ", submit quit:(submit = "") ; user entered nothing ; figure out what user entered if (submit = "?") { ; display help do help() quit } elseif submit?3n.1(1"-"3n.1(1"-"4n)) { ; allow full or partial phone numbers write "...finding phone number" do phone( .id ) quit:(id = 0) do display(id, "table") ; display the chosen person } elseif $$NameFormat( .submit )?1u.l.1(1","1u.l) { ; verify the name write "...finding name" do name( .id ) quit:(id = 0) do display(id, "table") ; display the chosen person } elseif $$validDOB^datent( submit ) { ; use validDOB^datent to verify the DOB write "...finding birthday" do dob( .id ) quit:(id = 0) do display(id, "table") ; display the chosen person quit } else { ; else it's an error; add this to what $$validDOB writes write ", name, or phone" } }
-
The modified dob procedure:
dob(id) [submit, list] ; perform dob lookup ; no partial matches ; if user picks a name from the list, ID is returned to the caller { kill list set intdob = $$validDOB^datent( submit ) ; convert dob ; is the date of birth in the index? if '$data( ^PersonI("DOB", intdob) ) { ; determine if there are any matches write "...no matches" quit } set loopid = "" ; loop through IDs, and number them for count = 1 : 1 { set loopid = $order( ^PersonI("DOB", intdob, loopid) ) quit:(loopid = "") set list( count ) = loopid write !, count, ") " do display(loopid, "line") } do select( .id ) }
-
The phone procedure is as follows. The bug mentioned in the description for the Hands-On Exercise occurs when the user specifies a 3-digit area code for lookup. $Order interprets this as a number (no “-” character), so the first $Order below won't return the right result. The solution is in the line that precedes the first $Order: appending a “-” to the area code.
phone(id) [submit, list] ; perform phone lookup ; if user picks a name from the list, ID is returned to the caller { kill list set count = 0 ; assume no matches set origph = submit set:(origph?3n) origph = origph _ "-" ; change to a string instead of a number ; origph may be an exact match, so find preceding phone set ph = $order( ^PersonI("Phone", origph), -1) /* loop through phone numbers, and number them, quit as soon as phone doesn't match original loopid holds the ONE ID per phone number */ for count = 1 : 1 { set ph = $order( ^PersonI("Phone", ph), 1, loopid) quit:( $extract(ph, 1, $length(origph)) '= origph ) set list( count ) = loopid write !, count, ") " do display(loopid, "line") } if '$data( list ) { ; were there matches? write "...no matches" quit } do select( .id ) }
-
The name procedure:
name(id) [submit, list] ; perform name lookup ; if user picks a name from the list, ID is returned to the caller { kill list set count = 0 ; assume no matches set origln = $piece(submit, ",", 1), origfn = $piece(submit, ",", 2) ; origln may be an exact match, so find preceding last name set ln = $order( ^PersonI("Name", origln), -1) ; loop through last names, quit as soon as last name doesn't match original for { set ln = $order( ^PersonI("Name", ln)) quit:($extract(ln, 1, $length(origln)) '= origln) ; origfn may be "". Otherwise, it may be an exact match, so find preceding first name if (origfn = "") { set fn = "" } else { set fn = $order( ^PersonI("Name", ln, origfn), -1) } ; loop through first names, quit as soon as first name doesn't match original, or is "" for { set fn = $order( ^PersonI("Name", ln, fn)) quit:(($extract(fn, 1, $length(origfn)) '= origfn) || (fn = "")) set loopid = "" ; loop through IDs for { set loopid = $order( ^PersonI("Name", ln, fn, loopid)) quit:( loopid = "" ) set count = count + 1 set list( count ) = loopid write !, count, ") " do display(loopid, "line") } } } if '$data( list ) { ; were there matches? write "...no matches" quit } do select( .id ) }
-
The $$NameFormat, $$up, and $$low functions:
NameFormat(name) ; change user's entry into proper name format ; SMITH,JOHN and smith,john -> Smith,John ; if name is passed-by-reference, it will be changed { set ln = $piece(name, ",", 1), fn = $piece(name, ",", 2) set ln = $$up($extract(ln)) _ $$low($extract(ln, 2, $length(ln))) if fn = "" { ; return last name only set name = ln quit name } set fn = $$up($extract(fn)) _ $$low($extract(fn, 2, $length(fn))) set name=ln _ "," _ fn ; return full name quit name } up(text) ; translate text to uppercase { quit $translate(text, "abcdefghijklmnopqrstuvwxyz", "ABCDEFGHIJKLMNOPQRSTUVWXYZ") } low(text) ; translate text to lowercase { quit $translate(text, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz") }
-
The modified help procedure:
help() ; display different types of lookups { write !, "You can enter:" write !?10, "* full name: Smith,John", !?10, "* last name: Smith" write !?10, "* partial name: Sm,J or Smith,J or Sm,John" write !?10, "* phone number with area code: 617-621-0600" write !?10, "* partial phone numbers: 617 or 617-621" write !?10, "* date of birth", !! }
-
The modified display procedure:
display(id, style) [name, phone, intdob] ; given an ID, get data and write it { set rec = ^PersonD( id ) set name = $piece(rec, "^", 1) set phone = $piece(rec, "^", 2) set intdob = $piece(rec, "^", 3) if style = "line" { write name, ?20, phone, ?35, $zdate(intdob, 2) } else { write # ; clear screen do display^datent() } }
-
The select procedure:
select(id) [list] ; 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 { for { read !!, "Choose by number: ", choice quit:( choice = "" ) set id = $get(list( choice ), 0) quit:(id '= 0) ; valid choice write !,"Invalid choice" } }
