Exercise 7: Lookup Routine, final version

1. 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.

2. 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

   

3. So that main can use id, add id to the list of public variables for getsubmit.

4. 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
       }

   

5. The 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)
       }

   

6. The 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()
           }
       }

   

7. The 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 !!
       }

   

8. The 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."
       }