I've been working on an application for data manipulation and correction, patient demographics to be exact. It allows patient names dates of births and ID's to be compared to reference data, and the reference data to be used to correct the patient demographics.
For maximum flexibility numerous dialogs allow the end user to use Xbasic expressions to set the different values. If you are interested in this approach, the xDialog Genie allows you to place the Xbasic expression builder in your Dialogs.
Some of these expressions end up becoming quite long and unmanageable. So I ended up writing global functions for use in the expression builder. However this is not an option for the user of the application with Alpha5 runtime, or least I though it wasn't. As it turns out, Alpha5 has methods for editing and creating functions, that also work in the runtime.
Using these methods, I was able to create a script that presents the end user with a Dialog that allows User Defined Functions to be Created Edited Renamed and Deleted. This script ensures that all functions created by the end user are preffixed with UDF_ This prevents the end user from messing with functions that are part of the appplication. This Dialog also works in the runtime version of Alpha5.
The script also shows how the Alpha5 Data Dictionary can be directly manipulated.
UDF-edit.png
For maximum flexibility numerous dialogs allow the end user to use Xbasic expressions to set the different values. If you are interested in this approach, the xDialog Genie allows you to place the Xbasic expression builder in your Dialogs.
Some of these expressions end up becoming quite long and unmanageable. So I ended up writing global functions for use in the expression builder. However this is not an option for the user of the application with Alpha5 runtime, or least I though it wasn't. As it turns out, Alpha5 has methods for editing and creating functions, that also work in the runtime.
Using these methods, I was able to create a script that presents the end user with a Dialog that allows User Defined Functions to be Created Edited Renamed and Deleted. This script ensures that all functions created by the end user are preffixed with UDF_ This prevents the end user from messing with functions that are part of the appplication. This Dialog also works in the runtime version of Alpha5.
The script also shows how the Alpha5 Data Dictionary can be directly manipulated.
UDF-edit.png
Code:
'Date Created: 28-May-2016 01:09:51 PM 'Last Updated: 30-May-2016 07:20:20 AM 'Created By : verboopa2 'Updated By : verboopa2 '-------- 'UDF-Edit '-------- 'Edit User Defined Functions 'These are functions with the UDF_ prefix 'A5 provides the following statements that allows basic script editoring. 'these function work in the runtime version as well. 'a5_modeless_code_editor("UDF_ExtractSecID","Function") 'a5_script_create_new("UDF_ExtractSECcb","function","xbasic","hello") '--------------------- '// Set Debug Flags -- '--------------------- DIM DialogTtl as C = "User Defined Functions (UDF-Edit)" DIM Debug as C = "" 'use following statement to check for debug flag: if ("m" $ Debug) 'DbgSet(type::xbasicmodule.get_current(),Debug) 'set debug values in deployed enviroments 'c - make standard DBF copy for database dictionary 'r - trace contents of data dictionary found '----------------------------- '// Opening Data Dictionary -- '----------------------------- 'Data Dictionary can be opened with dictionary.open() function. 'As documented by default this opens the current data dictionary in read only mode 'However you can specify a different data dictionary and a read write mode 'by providing parameters. This allows the data dictionary to be edited directly ' 'The data dictionary name must include the appropreate dictionary extension ' .DDD for dictionaries used for Tables and Sets ' .ALB for data base dictionaries. contain information used by more then one table 'Dictionaries have a single index that can be used to lookup objects ' tagName: Type_Name ' Order: Type + Name ' 'Fields located in the data dictionary are ' Name,C,24 Name of the object as displayed in the Control Panel ' Type,C,4 Object type one of the following type not all types are found in both dictionary types ' append -ALB ' bitmap -ALB ' browse -DDD ' copy -ALB ' export -ALB ' form -DDD ' import -ALB ' join -ALB ' label ' letter ' mark ' menu -ALB ' post -ALB ' query ' report ' summarize ' toolbar -ALB ' update -ALB ' xtab ' script -ALB ' function -ALB ' Contents_C,C,64 Contents of the obect if it later short seems to be mainly used for version flags ' Contents_M,M,10 Contents of the object if it is strictly text ' Vendor,M,10 Contents of object if it is binary and thus proprietary to the vendor of Alpha5 IF ("c" $ Debug) 'copy dictionary to standard DBF for debugging DIM SrcName as C 'get base name of tables without extensions DIM DestName as C SrcName = file.filename_parse(a5.Get_Name(),"dpn") DestName = file.filename_parse(a5.Get_Name(),"dpn") + "_DICT" file.copy(SrcName + ".ALB",DestName + ".DBF") file.copy(SrcName + ".ALM",DestName + ".FPT") file.copy(SrcName + ".ALX",DestName + ".CDX") file_add_to_db(Destname + ".DBF") end if '---------------------- '// Setup for Dialog -- '---------------------- DIM List as C 'List of all functions DIM UDFList as C 'Functions with the prefic UDF_ List = A5.UDF_enum(2) 'Get a list of all functions and FOR EACH Line IN List 'Build list of User defined Functions IF *FIRST(Line.value,"UDF_") UDFList = *concat_lines(UDFList,Line.Value) end if NEXT UDFlist = SORTSUBSTR(UDFlist,crlf()) 'List of return types and character types DIM ParaType as C 'this is subset of A5 types ParaType =<<%txt% Character Numeric Logical Date Time %txt% '----------------- '// User Dialog -- '----------------- DIM UDFselected as C DIM UDFnew as C DIM ReturnType as C DIM P1 as C DIM PT1 as C DIM Result as C DIM ptext as p 'The User Defined Function has name restrictions DIM ptext.text as c 'These variables used for editing this value DIM ptext.object as p 'allow direct manipulation of cursor in editer Dialog =<<%dlg% {can_exit=exit} {region} {region} {blueframe=1,1:Existing UDFs} [.25,18UDFselected^#UDFlist]{space=1} {endregion} |{sp=1}| {region} {blueframe=2,13:Create new User Defined Function} {cellspillover=on} A prefix of UDF_ will be added to name.; Underscore is only permitted Non AlphaNumeric.; {cellspillover=off} Function Name:|[%;%20.24ptext!change]; Return Type:|[%v%.17ReturnType^=ParaType]; {lf}; {cellspillover=on} Optional arguments taken by this function; {cellspillover=off} Name|Type; [.20A1]|{Sp}[%v%.15AT1^=ParaType]; [.20A2]|{Sp}[%v%.15AT2^=ParaType]; [.20A3]|{Sp}[%v%.15AT3^=ParaType]; [.20A4]|{Sp}[%v%.15AT4^=ParaType]; [.20A5]|{Sp}[%v%.15AT5^=ParaType]; {endregion}; {endregion}; {line=1,0}; {region} <*10&Refresh!refresh> <*10&Edit!edit> <10&Delete!delete> <10&Rename!rename> <10&Create!create> <Exit!exit> {endregion}; %dlg% Code =<<%code% DIM errspot as C = "" 'flag for error handler that record alter is under way DIM Commit_flag as L 'Can record be commited set to False if Error incountered DIM Commit_error as C 'Text error message detected during record entry ON ERROR GOTO ERRORHANDLER DIM Mess as C 'Message to give user Mess = "" if a_dlg_button = "exit" then 'Event handlers for Dialog ui_modeless_dlg_close(DialogTtl) 'Used to cancel out of dialog end end if if a_dlg_button = "edit" then 'Used to proceed after dialog IF isnull(UDFselected) Mess = *concat_lines(Mess,"Select UDF to edit first") ELSE a5_modeless_code_editor(UDFselected,"Function") end if a_dlg_button = "" 'keep us from continously processing this button press end if IF a_dlg_button = "refresh" 'Refresh List of UDF functions use function built for this UDFlist = UDFlistBld() a_dlg_button = "" end if if a_dlg_button = "create" DIM RT as C 'Single letter return type for the function DIM Arguments as C 'Arguments to send to the function DIM FuncTemp as C 'Help users by building a template for the function FuncTemp =<<%txt% FUNCTION {UDFnew} AS {RT} ({Arguments}) 'Write your custome code in here using xbasic 'You can use the variables passed into the function as Arguments in the first line 'A value is returned by assigning it to variable with the same name as the function {UDFnew} = 'Assign your return value here END FUNCTION %txt% RT = LEFT(ReturnType + "C",1) 'Set the function return type C is the default and added in case none was selected FOR x = 1 to 5 'up too 5 arguments can be defined build the function parameters from them Para = eval("A"+x) 'Is a argument name given in this slot IF Para 'if so add it and add variable type using character as default 'add a space seperator if we already have a parameter Arguments = Arguments + IIF(isnull(Arguments),"",", ") + Para + " AS " + LEFT(eval("AT"+x)+"C",1) end if NEXT UDFnew = ptext.text 'get the file name user wanted to use Mess = VerifyName(UDFnew) IF isnull(Mess) a5_script_create_new(UDFnew,"function","xbasic",evaluate_string(FuncTemp)) end if UDFlist = UDFlistBld() a_dlg_button = "" 'keep us from continously processing this button press end if IF a_dlg_button = "delete" .OR. a_dlg_button = "rename" then While .T. 'Not a real loop just easy way to exit block of code IF isnull(UDFselected) Mess = *concat_lines(Mess,"Select UDF to alter first") exit while end if DIM DictName as C 'Determine the name of the dictionary file DictName = file.filename_parse(a5.Get_Name(),"dpn") + ".ALB" DIM DebugList as C = "" 'list of what was found in dictionary for debugging DIM Tbl as P DIM FndRec as N = 0 'record number of found browse definition Tbl = dictionary.open(DictName,FILE_RW_SHARED) 'open the dictionary in shared read write mode go to first Tbl.fetch_first() 'we should not can not build queries in on dictionary while .NOT. Tbl.fetch_eof() 'so loop through records looking for the function of interest DebugList = *concat_Lines(DebugList,Tbl.Name + " " + Tbl.Type) IF rtrim(Tbl.Name) = UDFselected .AND. rtrim(Tbl.Type) = "GUDF" 'Is this a match to the Global User Defined Function we want to alter FndRec = Tbl.recno() 'record record number so we can find it again end if 'we read through each record so we can see all Tbl.fetch_next() 'for when function definition can't be found wend IF ("r" $ Debug) 'debug output what we found in dictionary zTraceStamp(type::xbasicmodule.get_current()) Trace.WriteLn("Database Dictionary: " + DictName) Trace.WriteLn("Function: " + UDFselected) Trace.WriteLn("Function Defination " + IF(FndRec > 0,"Found","NOT Found")) Trace.WriteLn("--- START Data Dictionary Entries ---") Trace.Write(DebugList) Trace.WriteLn("--- END Data Dictionary Entries ---") end if IF FndRec = 0 'error if we can't find the UDF Mess = *concat_lines(Mess,"Unable to locate selected UDF in dictionary: " + UDFselected) Tbl.close() exit while end if Tbl.fetch_goto(FndRec) 'Return to the found record errspot = "CommitRec" commit_flag = .T. Tbl.change_begin(.F.) 'Start Change mode If Tbl.mode_get() <> 1 'Optional check for chnage mode enterred errspot = "" 'catches table lock conflicts Mess = "Unable to place database dictionary in change mode" exit while end if IF a_dlg_button = "delete" 'Confirm deletion using name from actual record IF ui_msg_box(DialogTtl,"Delete Function: " + alltrim(Tbl.Name),UI_YES_NO) = UI_YES_SELECTED Tbl.delete() end if a_dlg_button = "" 'keep us from continously processing this button press ELSEIF a_dlg_button = "rename" UDFnew = ptext.text Mess = VerifyName(UDFnew) 'Verify new name is valid IF isnull(Mess) 'If it is change the name Tbl.Name = UDFNew end if a_dlg_button = "" 'keep us from continously processing this button press end if Tbl.change_end(commit_flag) 'complete the change errspot = "" 'do record entry/change error processing If .NOT. commit_flag THEN 'can only be FALSE if error entering record Mess = *concat_lines("Unable to update database dictionary",Commit_Error) end if Tbl.close() UDFlist = UDFlistBld() exit while wend end if IF a_dlg_button = "change" 'Live correction of function name DIM ip as N 'insertion point of cursor DIM tp as N 'test point character to test in name DIM Char as C 'Character to test in function name a_dlg_button = "" 'list of chacaters to be removed ip = ptext.object.get_cursor() 'insertion point of cursor IF .NOT. (*first("UDF_",ptext.text) .OR. *first(ptext.text,"UDF_")) ptext.text = "UDF_" + ptext.text 'add prefic to name if it is not there of partialially there ip = ip + 4 'partial check allows user to enter it ptext.text = left(ptext.text,24) 'in case file table name gets to long ip = min(ip,24) end if oldlen = len(ptext.text) 'get orginal length of string so we can reposition cursor tp = 1 'starting position for testing characters in function name While tp <= len(ptext.text) 'any more characters to test loop Char = substr(ptext.text,tp,1) 'is next character to test allowed IF isalpha(Char) .OR. isdigit(Char) .OR. Char = "_" tp = tp + 1 'character ok mve on to next ELSE 'character not Ok so remove it ptext.text = stuff(ptext.text,tp,1,"") 'everything moves left next character is in same spot end if WEND ip = ip - (oldlen - len(ptext.text)) 'reset insertion point to adjust for characters removed ptext.object.set_cursor(ip) end if IF Mess ui_msg_box(DialogTtl,Mess,UI_ATTENTION_SYMBOL+UI_OK) end if end '------------------- '// ERROR Handler -- '------------------- ERRORHANDLER: IF errspot = "CommitRec" 'Trap things that can go wrong during data entry Commit_flag = .F. 'Set flag so change/entry is not completed and record error for later Commit_error = *concat_lines(Commit_error,error_text_get() + " Line: " + TrimNum(error_line_number_get())) resume next 'Return to code so Record Entry/Change can be completed taking End if 'table out of change entry mode. ON ERROR GOTO 0 'No more special error traps that continue the code Mess2 =<<%txt% ERROR: {error_text_get()} Script: {error_script_get()} Line: {error_line_number_get()} %txt% Mess = *concat_lines(Mess,evaluate_string(Mess2)) ui_msg_box(DialogTtl,Mess,UI_ATTENTION_SYMBOL+UI_OK) END '--------------------------------- '// In Dialog Support Functions -- '--------------------------------- FUNCTION UDFlistBld AS C () 'Build list of UDF_ prefixxed functions controlpanel.refresh() 'Refresh control panel from Databasr dictionary DIM UDFlist AS C = "" 'Functions are enumerated from control panel List = A5.UDF_enum(2) 'at users request or FOR EACH Line IN List 'before creating new so we don't overwrite IF *FIRST(Line.value,"UDF_") 'one just created UDFList = *concat_lines(UDFList,Line.Value) end if NEXT UDFlistBld = SORTSUBSTR(UDFlist,crlf()) END FUNCTION FUNCTION VerifyName AS c(NewName) 'Verify new function name is unique and fits requirements DIM Mess AS C = "" IF isnull(NewName) Mess = *concat_lines(Mess,"New name required.") a_dlg_button = "" 'prevent any other functions from happening ELSEIF NewName = "UDF_" Mess = *concat_lines(Mess,"Full name required for new name.") a_dlg_button = "" ELSEIF .NOT. *FIRST(NewName,"UDF_") Mess = *concat_lines(Mess,"Name must have prefix UDF_") a_dlg_button = "" ELSEIF word_exists(UDFlistBld(),NewName,crlf()) Mess = *concat_lines(Mess,"Function already exist with this name.") end if VerifyName = Mess END FUNCTION %code% ui_modeless_dlg_box(DialogTtl,Dialog,Code) 'Last thing script does all required code must be in event handlers
Comment