Caché Basic Tutorial
Exercise 4: Add Editing Capability
[Home] [Back] 
InterSystems: The power behind what matters   
Class Reference   
Search:    

  1. The final version of the myBASlookup routine is shown below, broken into sections to help you understand it. This is also available in the SAMPLES namespace as BASlookup2.mac.
  2. The updated main section.
    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
            edit(id) ' edit the chosen person
        loop until done
    end sub
    
  3. The new edit subroutine.
    private sub edit(id as %Integer)
    ' allow user to choose, and edit their choice
        dim yn, newname, newphone, newintdob
        do
            input "Edit? (y/n): " ,yn : println
            if yn <> "y" then
                print "...no changes."
                exit sub
            end if
            ' try to lock the record
            if lock(^PersonD(id), 5) then exit do
            println "...someone else is editing this person"
        loop
        load(id)
        if reprompt(newname, newphone, newintdob) then
            input "Store? (y/n): ", yn : println
            if yn <> "y" then
                print "...no changes."
            else
                update(id, newname, newphone, newintdob)
            end if
        end if
        unlock(^PersonD(id))
    end sub
    
  4. The new load subroutine.
    private sub load(id as %Integer)
    ' load a person into local variables
        dim rec
        rec = ^PersonD(id)
        name = piece(rec, "^", 1)
        phone = piece(rec, "^", 2)
        intdob = piece(rec, "^", 3)
    end sub
    
  5. The updated display subroutine, that now calls load.
    private sub display(id As %Integer, style as %String)
    ' given an id, get data and write it
      load(id)
      if style = "line" then
        println name, space(2), phone, space(2), DateConvert(intdob, vbToExternal)
      else
        display@BASdatent2()
      end if
    end sub
    
  6. The new reprompt function.
    private function reprompt(ByRef newname As %String,_
                         ByRef newphone As %String,_
                         ByRef newintdob As %Integer) As %Boolean
    ' show current data and allow user to update it
        dim changed, newdob
        changed = False
        do
            print "Name: ", name, "=> "
            input newname : println
            if (newname = "") then
                newname = name ' default
            else
                newname = validName@BASdatent2(newname)
            end if
        loop while newname = 0
        if name <> newname then changed = True
        do
            print "Phone (617): ", phone, "=> "
            input newphone : println
            if (newphone = "") then
                newphone = phone ' default
            else
                newphone = validPhone@BASdatent2(newphone)
            end if
        loop while newphone = 0
        if phone <> newphone then changed = True
        do
            print "DOB: ", DateConvert(intdob, vbToExternal), "=> "
            input newdob : println
            if (newdob = "") then
                newdob = DateConvert(intdob, vbToExternal) ' default
                newintdob = intdob
            else
                newintdob = validDOB@BASdatent2(newdob)
            end if
        loop while newintdob = 0
        if intdob <> newintdob then changed = True
        println : println
        return changed
    end function
    
  7. The new update subroutine.
    private sub update(id As %Integer,_
                       newname As %String,_
                       newphone As %String,_
                       newintdob As %Integer)
    ' update ^PersonD and ^PersonI
        dim ln, fn, nln, nfn
        tstart ' start a transaction
        ^PersonD(id) = newname & "^" & newphone & "^" & newintdob ' store the record
        if newname <> name then ' erase old name and add new name to index
            ln = piece(name, ",", 1) : fn = piece(name, ",", 2)
            nln = piece(newname, ",", 1) : nfn = piece(newname, ",", 2)
            erase ^PersonI("Name", ln, fn, id)
            ^PersonI("Name", nln, nfn, id) = ""
        end if
        if newphone <> phone then ' erase old phone and add new phone to index
            erase ^PersonI("Phone", phone)
            ^PersonI("Phone", newphone) = id
        end if
        if newintdob <> intdob then ' erase old dob and add new dob to index
            erase ^PersonI("DOB", intdob, id)
            ^PersonI("DOB", newintdob, id) = ""
        end if
        tcommit ' commit the transaction
        println "...updated."
    end sub