演習 4 ：編集機能の追加

以下は、最終的な myBASlookup ルーチンです。わかりやすいように、セクションを分割して表示しています。このルーチンも BASlookup2.mac として SAMPLES ネームスペースで利用できます。

以下は、変更した main セクションです。


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

以下は、新規の edit サブルーチンです。


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

以下は、新規の load サブルーチンです。


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

以下は更新した display サブルーチンで、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

以下は、新規の reprompt 関数です。


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

以下は、新規の update サブルーチンです。


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

演習 4 ： 編集機能の追加

演習 4 ：編集機能の追加