Exercise 7: Lookup Routine, final version
The final version of the lookup routine is shown below, broken into sections to help you understand it. This is also available in the SAMPLES namespace as lookup.mac.
Add this code to the main section, after the following line: do getsubmit ; let user submit a string for lookup
quit:(submit = "") do:(id '= 0) edit( id ) ; edit the chosen person
Copy code to clipboardSo that main can use id, add id to the list of public variables for getsubmit.
The new edit procedure.
edit(id) ; allow user to choose, and edit their choice { for { read !, "Edit? (y/n): " ,yn if yn '= "y" { write "...no changes." quit } ; try to lock the record lock +^PersonD( id ):5 if $test { ; the lock was successful quit } else { write "...someone else is editing this person" } } quit:(yn '= "y") do load( id ) do reprompt() read !, "Store? (y/n): ", yn if yn '= "y" { write "...no changes." lock -^PersonD( id ) ; unlock the record quit } do update( id ) lock -^PersonD( id ) ; unlock the record }
Copy code to clipboardThe new load procedure.
load(id) [rec, name, phone, intdob] ; load a person into local variables { set rec = ^PersonD(id) set name = $piece(rec, "^", 1) set phone = $piece(rec, "^", 2) set intdob = $piece(rec, "^", 3) }
Copy code to clipboardThe updated display procedure, that now calls load.
display(id, style) [name, phone, intdob] ; given an ID, get data and write it { do load( id ) if style = "line" { write name, ?20, phone, ?35, $zdate(intdob, 2) } else { write # ; clear screen do display^datent() } }
Copy code to clipboardThe new reprompt procedure.
reprompt() [name, phone, intdob, newname, newphone, newintdob] ; show current data and allow user to update it { do { write !, "Name: ", name, "=> " read newname set:(newname = "") newname = name ; default set newname = $$validName^datent( newname ) } while newname = 0 do { write !, "Phone (617): ", phone, "=> " read newphone set:(newphone = "") newphone = phone ; default set newphone = $$validPhone^datent( newphone ) } while newphone = 0 do { write !, "DOB: ", $zdate(intdob, 2), "=> " read newdob set:(newdob = "") newdob = $zdate(intdob, 2) ; default set newintdob = $$validDOB^datent( newdob ) } while newintdob = 0 write !! }
Copy code to clipboardThe new update procedure.
update(id) [rec, name, phone, intdob, newname, newphone, newintdob] ; update ^PersonD and ^PersonI { ; concatenate the data into a record set newrec = newname _ "^" _ newphone _ "^" _ newintdob if rec = newrec { write "...no changes made." quit } tstart ; start a transaction set ^PersonD( id ) = newrec ; store the record if newname '= name { ; kill old name and add new name to index set ln = $piece(name, ",", 1), fn = $piece(name, ",", 2) set nln = $piece(newname, ",", 1), nfn = $piece(newname, ",", 2) kill ^PersonI("Name", ln, fn, id) set ^PersonI("Name", nln, nfn, id) = "" } if newphone '= phone { ; kill old phone and add new phone to index kill ^PersonI("Phone", phone) set ^PersonI("Phone", newphone) = id } if newintdob '= intdob { ; kill old dob and add new dob to index kill ^PersonI("DOB", intdob, id) set ^PersonI("DOB", newintdob, id) = "" } tcommit ; commit the transaction write "...updated." }
Copy code to clipboard