Does progress 4GL language support hierarchical queries? - progress-4gl

The simple question subscribed on progress site:
Does progress 4GL language support hierarchical queries like Oracle (Connect by clause) or Sql Server(CTE)?
I have the following table:
Name parent
-----------------------
Elizabeth II null
Charles Elizabeth II
Andrew Elizabeth II
Edward Elizabeth II
Harry Charles
William Chales
James Edward
George William
Is there a script in progress that will generate the following output?
Elizabeth II
|_Charles
|_William
|_George
|_Harry
|_Andrew
|_Edward
|_James

Since Progress 4GL (actually ABL since a couple years) is a complete turing complete language you can. However perhaps not in a single query...
This recursive example does it, you could do in a number of different ways. You can start with this code but you might need to have more error checks etc.
DEFINE TEMP-TABLE ttPerson NO-UNDO
FIELD PersonName AS CHARACTER FORMAT "x(20)"
FIELD PersonParent AS CHARACTER.
/* A procedure for loading example data */
PROCEDURE createPerson:
DEFINE INPUT PARAMETER pcName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcParent AS CHARACTER NO-UNDO.
CREATE ttPerson.
ASSIGN
ttPerson.personName = pcName
ttPerson.personParent = pcParent.
END.
/* Load some data */
RUN createPerson("Elizabeth II", "").
RUN createPerson("Charles", "Elizabeth II").
RUN createPerson("Andrew", "Elizabeth II").
RUN createPerson("Edward", "Elizabeth II").
RUN createPerson("Harry", "Charles").
RUN createPerson("William", "Charles").
RUN createPerson("James", "Edward").
RUN createPerson("George", "William").
/* Define a frame where the result will be displayed */
DEFINE FRAME f1 ttPerson.personName WITH 20 DOWN.
/* The recursive prodecure */
/* pcPerson - the person where to start track heritage (or perhaps it should have been lineage?*/
/* piDepth, just to format the output */
PROCEDURE trackHeritage:
DEFINE INPUT PARAMETER pcPerson AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER piDepth AS INTEGER NO-UNDO.
piDepth = piDepth + 1.
/* Find the tracked person */
FIND FIRST ttPerson NO-LOCK WHERE ttPerson.personName = pcPerson NO-ERROR.
IF AVAILABLE ttperson THEN DO:
DISPLAY FILL(" ", piDepth) + "|_" + ttPerson.personName # ttPerson.personName WITH FRAME f1.
DOWN 1 WITH FRAME f1.
/* Track all available children to the person */
FOR EACH ttPerson NO-LOCK WHERE ttPerson.personParent = pcPerson:
RUN trackHeritage(ttPerson.personName, piDepth).
END.
END.
END.
/* Start tracking */
RUN trackHeritage("Elizabeth II", 0).
MESSAGE "Done" VIEW-AS ALERT-BOX.

Related

4GL ABL Openedge loop through handle?

here is my current code
def var hbTT as handle.
for each Cust:
hbTT:buffer-create().
assign
hbTT::Name = Cust.Name
hbTT::address = Cust.Address.
end.
now what I want to do is to loop through hbtt. How can I do that?
I tried
for each hbTT:
/* Do something */
end.
the error I get is
unknown or ambiguous table hbTT. (725)
thank you
You won't be able to do a loop that way, as for each requires a static name.
Instead, try this:
DEFINE VARIABLE hQuery AS HANDLE NO-UNDO.
create query hQuery.
hQuery:set-buffers(hbtt).
hquery:query-prepare('for each tt'). /* <-- Where tt is the original buffer name */
hquery:query-open().
hquery:get-first().
do while not hquery:query-off-end:
disp hbtt::name hbtt::address .
hquery:get-next().
end.

How to get the field name dynamically and update it to main table in progress

Program:It is a just maintenance program, in this one it displays the Item Code in one frame and it prompt for the input. if you enter the item code it has to displays what are the blank fields for that record in pt_mstr and display in one frame(No need to display all blank fields, just first 4 or 5 fields enough). and also in that frame only if user want to update it update directly to main table pt_mstr.
What i tried is, i just write the code for getting blank fields using buffer handle and after that i create one temp table and displaying the fields, i strucked there itself, i am unable to update fields.
My code:
/*Sample Item master Maintenance Program*/
/* DISPLAY TITLE */
{us/mf/mfdtitle.i "3+ "}
DEFINE VARIABLE hBuffer AS HANDLE NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DEFINE VARIABLE j AS INTEGER NO-UNDO.
DEFINE VARIABLE hField AS HANDLE NO-UNDO.
define variable fldnm as character extent 10 no-undo.
define temp-table tt_temp no-undo
field tt_part like pt_part
field field1 as char extent 10.
form
pt_part colon 25
with frame a side-labels width 80.
setFrameLabels(frame a:handle).
/* DISPLAY */
view frame a.
repeat with frame a:
prompt-for pt_part
editing:
/* FIND NEXT/PREVIOUS RECORD */
{us/mf/mfnp.i pt_mstr pt_part "pt_mstr.pt_domain = global_domain and pt_part" pt_part pt_part pt_part }
if recno <> ? then
do:
display pt_part.
find pt_mstr where pt_part = input pt_part and pt_domain=global_domain no-lock no-error.
ASSIGN hBuffer = BUFFER pt_mstr:HANDLE.
empty temp-table tt_temp.
j = 1.
DO i = 1 TO 10:
ASSIGN hField = hBuffer:BUFFER-FIELD(i).
IF ((hField:BUFFER-VALUE = "" )) THEN
do:
/* message hField:NAME "test" view-as alert-box.*/
find first tt_temp where tt_part = pt_part no-lock no-error.
if not avail tt_temp then
do:
create tt_temp.
assign
tt_part = pt_part
field1[j] = hField:NAME.
j = j + 1.
end.
else do:
assign
field1[j] = hField:NAME.
j = j + 1.
end.
end.
end.
end.
for each tt_temp:
display field1[1] field1[2] field1[3] field1[4].
end.
end.
end.
Are you sure you need your temp-tables to do this? I've created an example using only the actual table (but created a fake temp-table instead). You would have to look into data error handling, data validation, transaction, locking etc before putting this into production of course.
/*First we need some fake data */
DEFINE TEMP-TABLE ttMockedData NO-UNDO
FIELD id AS INTEGER
FIELD dataName AS CHARACTER FORMAT "x(8)"
FIELD dataType AS CHARACTER FORMAT "x(8)"
FIELD dataDescrioption AS CHARACTER FORMAT "x(32)".
DEFINE VARIABLE iId AS INTEGER NO-UNDO.
DEFINE VARIABLE iSearch AS INTEGER NO-UNDO LABEL "Search".
PROCEDURE createData:
DEFINE INPUT PARAMETER pcName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcType AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcDesc AS CHARACTER NO-UNDO.
iId = iId + 1.
CREATE ttMockedData.
ASSIGN
ttMockedData.id = iId
ttMockedData.dataName = pcName
ttMockedData.dataType = pcType
ttMockedData.dataDesc = pcDesc.
END PROCEDURE.
RUN createData("Test 1", "TESTTYPE", "A TEST").
RUN createData("Test 2", "", "ANOTHER TEST").
RUN createData("", "TESTTYPE 2", "").
RUN createData("4", "", "").
/* Program starts here */
updating:
REPEAT:
UPDATE iSearch WITH FRAME x0.
IF iSearch > 0 THEN DO:
FIND FIRST ttMockedData NO-LOCK WHERE ttMockedData.id = iSearch NO-ERROR.
IF NOT AVAILABLE ttMockedData THEN DO:
MESSAGE "Not found" VIEW-AS ALERT-BOX ERROR.
RETURN ERROR.
END.
ELSE DO:
DISP ttMockedData WITH FRAME x1 1 COLUMNS SIDE-LABELS.
/* Is there an empty field? - Then we update! */
IF ttMockedData.dataName = ""
OR ttMockedData.dataType = ""
OR ttMockedData.dataDescrioption = "" THEN DO:
DISPLAY
ttMockedData.dataName
ttMockedData.DataType
ttMockedData.dataDesc
WITH FRAME x2 1 COLUMN SIDE-LABELS TITLE "Complete the data...".
/* This isn't working with temp-tables of course! */
/* Just here to make sure you handle locking! */
FIND CURRENT ttMockedData EXCLUSIVE-LOCK.
UPDATE
ttMockedData.dataName WHEN ttMockedData.dataName = ""
ttMockedData.DataType WHEN ttMockedData.DataType = ""
ttMockedData.dataDesc WHEN ttMockedData.dataDesc = ""
WITH FRAME x2.
/* This isn't working with temp-tables of course! */
/* Just here to make sure you handle locking! */
FIND CURRENT ttMockedData NO-LOCK.
END.
END.
END.
ELSE LEAVE updating.
END.

How to execute procedure from List with parameters in Progress 4gl?

I have some list like this
DEFINE VARIABLE procedurelist AS CHARACTER EXTENT 5
INITIAL [ "1.p", "2.p", "3.p", "4.p", "5.p"].
but this all procedures with input-output parameters and i want to execute this procedure, How can i do this? I have no idea how to do this.
The base of your solution is the RUN VALUE statement.
The manual states.
VALUE( extern-expression ) An expression that returns the name of the (local or remote) external procedure you want to run....
This basically means that you can input a string with the value of a program (or procedure) into your RUN statement.
If all input-output parameters are exactly the same you can do like this:
DEFINE VARIABLE procedurelist AS CHARACTER EXTENT 5 INITIAL [ "1.p", "2.p", "3.p", "4.p", "5.p"].
DEFINE VARIABLE iExtent AS INTEGER NO-UNDO.
DEFINE VARIABLE cVariable AS CHARACTER NO-UNDO.
DO iExtent = 1 TO EXTENT(procedurelist):
RUN VALUE(procedurelist[iExtent]) (INPUT-OUTPUT cVariable).
END.
If the parameters are different it gets trickier (but not impossible). The CREATE CALL and the Call Object can help you there. In this case you would need some kind of way to keep track of the different parameters as well.
Here's a basic example taken directly from the online help:
DEFINE VARIABLE hCall AS HANDLE NO-UNDO.
CREATE CALL hCall.
/* Invoke hello.p non-persistently */
hCall:CALL-NAME = "hello.p".
/* Sets CALL-TYPE to the default */
hCall:CALL-TYPE = PROCEDURE-CALL-TYPE.
hCall:NUM-PARAMETERS = 1.
hCall:SET-PARAMETER(1, "CHARACTER", "INPUT", "HELLO WORLD").
hCall:INVOKE.
/* Clean up */
DELETE OBJECT hCall.

Bracketed key value - limit OR foreach ... in OR?

Continuing my quest to convert .NET to Progress, I faced another challenge yesterday.
Our company bought time ago a .NET DLL to manage Excel document without the need to install Microsoft Excel. There is several functions that return a series of cells depending of the need.
The returned value is a class that implement IEnumerator interface in .NET.
The problem is that I cannot find a way to iterate trough the cells without getting the error:
System.ArgumentException: Row or column index is invalid or out of required range
Is there a way to in Progress to validate if X is inside of the extent range?
OR
Is there a way to iterate trough the array without knowing the upper limit of the array?
Thank you!
Sebastien
--- temporary solution ---
/* declaration */
DEFINE VARIABLE oCell AS CLASS GemBox.Spreadsheet.ExcelCell NO-UNDO.
DEFINE VARIABLE oRange AS CLASS GemBox.Spreadsheet.CellRange NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
/* load excel file */
...
/* retrieve a series of cells */
ASSIGN oRange = oWorksheet:Cells:GetSubrangeAbsolute(1,1, 2,2).
/* first cell */
ASSIGN i = 0.
ASSIGN oCell = ?.
ASSIGN oCell = oRange:Item[i] NO-ERROR.
/* validate cell is in the range */
DO WHILE NOT oCell EQ ?:
MESSAGE oCell:Value VIEW-AS ALERT-BOX.
/* next cell */
ASSIGN i = i + 1.
ASSIGN oCell = ?.
ASSIGN oCell = oRange:Item[i] NO-ERROR.
END.
I don't have access nor I can test this solution, but if it implements correctly the interface some solution like this one should work:
/* declaration */
DEFINE VARIABLE oCell AS CLASS GemBox.Spreadsheet.ExcelCell NO-UNDO.
DEFINE VARIABLE oRange AS CLASS GemBox.Spreadsheet.CellRange NO-UNDO.
DEFINE VARIABLE oEnumerator AS CLASS System.Collections.IEnumerator NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
/* load excel file */
...
/* retrieve a series of cells */
ASSIGN oRange = oWorksheet:Cells:GetSubrangeAbsolute(1,1, 2,2).
oEnumerator = oRange:getEnumerator().
DO WHILE oEnumerator:MoveNext():
oCell = CAST(oEnumerator:current,"GemBox.Spreadsheet.ExcelCell").
END.
If it doesn't work exactly like this, at least it should point you in the correct direction to use it.
From the web page I'd infer that the # of cols =
oRange:LastColumnIndex - oRange:FirstColumnIndex
and the # of rows is
oRange:LastRowIndex - oRange:FirstRowIndex
I'd think using
oCell = oRange:Item[Int32, Int32]
to get the item at the row, col position would work better instead of using a single element array element.

RC special variable in REXX?

how to assign a value to RC special variable in REXX?
/* REXX */
"LISTDS ?" /* Command that sets RC to 12 */
SAY 'RC IS' RC /* RC is 12 */
RC = X /* RC set to X */
SAY 'RC IS' RC /* RC is X */
The above works, there is nothing special about the RC variable except it will be over written by the return code from the last command.
So you can set it to whatever you want at least on a mainframe running Zos.
Maybe you need to provide more detail in your question like what type of Rexx it is (Classic or OO) and what environment you are using.
If you want to set the return value of your method you need to use the "return" commend and to get the return code with the "result", for example:
/* REXX - program A */
SAY "THIS IS PROG. A WITH RC = 4"
RETURN 4
/* REXX - PROGRAM B */
SAY "CALLING PROGRAM A..."
CALL PROG_A
RC = RESULT
SAY "RC = "RC " RETURN FROM PROGRAM A..."
As Deuian said before, RC is set by last command executed and more detail should be provided to get a precise answer (environment, goal/task, batch/interactive etc.).
A silly working way to set RC on Zos REXX is to make a buffer: RC is set to the buffer count (so if you need RC = 100 you should create 100 buffers...), see the example (I do not endorse the usage of this method, it's just a conjecture)
/* rexx */
'MAKEBUF'
say RC
'MAKEBUF'
say RC
'DROPBUF'
say RC
/* exec output */
1
2
0
***
Beware that the previous code leaves a buffer active! (another DROPBUF needed)
The SAY instructions will send screen prompts or include text in the output. If you want to set the RC to something that can be interpreted by subsequent steps in a job, try:
/* REXX */
setrc = X /* set a variable for RC to X */
exit(setrc)