Re: Basic Append Question
since the record is not deleted yet, you would need to do it after it was deleted
since the record is not deleted yet, you would need to do it after it was deleted
Alpha Software Mobile Development Tools: Alpha Anywhere | Alpha TransForm |
FUNCTION Auto_Lup AS L (fname as C,tname = "" as C) 'DESCRIPTION: Used in FRUL CanWrite field event to get next field value for primary key 'and in CanDeleteRecord record event to test if deletion is allowed. ' 'Use this function instead of FRUL calc Auto Increment so if needed in the future 'the series for a primary key can be changed using the Counter table, eg. for Invoices 'that use a new prefix to reflect the year - allows user to reset the series. ' 'Ex1: CanWrite event in DIR_ID field - Auto_Lup("DIRCODE") '-----User enters a new Directory->DIR_ID value and function gets the next DIRCODE value ' 'Ex2: CanDeleteRecord 'flag = Auto_Lup("DIRCODE") 'if .not. flag then ' cancel() 'end if 'function allows deletion of last record entered only in case of user error and restores 'the next number to its previous value so series will not be interrupted. dim lv as p = local_variables() dim commit_flag as L = .f. dim fld as p dim tc as p dim tp as p dim tpname as c = "counter" dim msg as c dim tries as n = 0 dim vmax as c tc = table.current() if tname = "" then tname = tc.name_get() end if fld = tc.field_get(fname) vmax = alltrim(tablemax(tname,".t.",fname)) If tc.mode_get() = 2 Then 'current table is in ENTER mode TRYAGAIN: If tries < 4 Then Dim newval as C commit_flag = .t. On Error goto ERRLOOP tp = table.open(tpname,FILE_RW_EXCLUSIVE) On Error goto 0 tp.index_primary_put("tblname") rec = tp.fetch_find(tname) if rec > 0 then newval = ut(tp.nextval) else msg="COUNTER record not found for table: "+ut(tname) Tln("Auto_Lup",msg) 'trace.WriteLn("Auto_Lup: "+msg) msg=crlf(2)+msg+"Please report error to Admin and cancel new record"+crlf() msgbox("Auto_Lup() Script Error",msg,16) msg = "" end if If fld.type_get() = "N" Then 'current field type should match tp.type, can use either here fld.value_put(val(newval)) Else fld.value_put(newval) End If on error goto CLOSETP tp.change_begin() If tp.type = "N" tp.lastval = val(newval) tp.preval = val(vmax) Else tp.lastval = newval tp.preval = vmax End If CLOSETP: tp.change_end(.t.) tp.close() End If Else If A_DELETING_RECORD = .T. Then 'Allow or cancel deletion of the current record in CanDeleteRecord FRUL event Auto_Lup = Del_Rec(tname,lv) EXIT FUNCTION End If Auto_Lup=commit_flag Tln(ut(tname)+"-New Record Added",ut(fname)+": "+newval) 'trace.WriteLn(ut(tname)+"-New Record Added -"fname+": "+newval) end ERRLOOP: tries = tries + 1 if tries < 4 then RESUME 0 else msg = "You do not have exclusive access to the "+ut(tname)+" table." Tln("Auto_Lup",msg) 'trace.WriteLn("Auto_Lup: "+msg) msg = crlf()+msg+"Please CANCEL the new record else check that no other users"+crlf() msg = msg+"are using the table and try again."+crlf(2) msg = msg+"If this error continues, then try one or all of the following:"+crlf() msg = msg+"1. Close all open forms"+crlf() msg = msg+"2. Exit then reopen the application"+crlf() msg = msg+"3. Contact Admin and report this error for additional options to try."+crlf(2) msg = msg+"Select OK to retry or CANCEL to cancel your new record" response = msgbox("New Record Locked: Table in Use",msg,49) msg = "" if response = 2 then 'user cancelled cancel() else tries = 1 goto TRYAGAIN end if end if END FUNCTION function Del_rec AS L (tname as c,LocVars as p) WITH LocVars dim curval as c dim oldval as c commit_flag = .f. curval = fld.value_get() on error goto ERRMSG tp = table.open(tpname,FILE_RW_EXCLUSIVE) On Error goto 0 tp.index_primary_put("tblname") tp.fetch_find(tname) oldval = tp.preval if tp.lastval = curval then commit_flag = .t. on error goto CLOSETP2 tp.change_begin() tp.lastval = oldval tp.preval = Get_Prev(oldval) CLOSETP2: tp.change_end(commit_flag) tp.close() end if if commit_flag = .f. then msg = "Auto Increment rule is in force"+crlf() msg = msg+"You may only delete the last record entered"+crlf(2) msg = msg+"If this is in error, please see Admin to correct" msgbox("Field Rule Violation",msg,16) msg = "" end if Tln(ut(tname)+"-Record Deleted-"+ut(fname)+": "+curval,commit_flag) 'Trace.WriteLn(ut(tname)+"-Record Deleted-"+ut(fname)+": "+commit_flag) 'sets the result of the calling script to test in CanDeleteRecord FRUL event Del_rec = commit_flag goto ENDIT end ERRMSG: commit_flag = .f. script_play("ERRMSG") on error goto 0 RESUME NEXT ENDIT: END WITH end function function Get_Prev AS C(vc as C) 'get the Counter->preval if deleting the current record by testing for the prefix in use 'then decrements the value portion and puts the prefix back 'my 14 tables that use this UDF use 1 of 3 different prefix styles for their primary keys dim va as c dim vn as n dim vs as n 'In counter table all values are type 'C' if .not. isdigit(left(vc,1)) then 'D0115 DIRCODE; also KO_NO,STYLE_KEY,YARN_ID,HELPID,MSG_ID. vs = len(alltrim(vc)) '5 va = left(vc,1) 'D vc = alltrim(substr(vc,2)) '0115 vs = vs-1 '4 if .not. isdigit(left(vc,2)) then 'YR-100007 REC_HDR (only exception to prefix) va = substr(vc,1,3) 'YR- vc = alltrim(substr(vc,4)) '100007 vs = vs-3 '9-3=6 end if vn = val(vc)-1 '115-1; 100007-1 vc = va+padl(alltrim(str(vn)),vs,"0")'D+0+114; YR-+100006 (no pad needed) else vn = val(alltrim(vc))-1 '165323-1 PS_NO; also SCH_NO,MACHNO,IMGNO,INV_NO,PMT_ID vc = str(vn) '165322 end if Get_Prev=vc end function
Comment