Query-prepare

[Luc Lessard]

Hi,

Progress 9.1C

In my program i receive 5 arguments.

{1} = db-name-1
{2} = db-name-2
{3} = table-name
{4} = field-name-1
{5} = field-name-2

DEFINE VARIABLE i AS INTEGER.
DEFINE VARIABLE qh AS WIDGET-HANDLE.
DEFINE VARIABLE bh AS WIDGET-HANDLE.
DEFINE VARIABLE fh AS WIDGET-HANDLE EXTENT 100.

CREATE BUFFER bh FOR TABLE "{1}.{3}".
CREATE QUERY qh.

qh:SET-BUFFERS(bh).
qh:QUERY-PREPARE("FOR EACH " + "{1}.{3} NO-LOCK").
qh:QUERY-OPEN.
qh:GET-FIRST.

DISPL bh:NAME. /* table name, not the label */

DO WHILE NOT qh:QUERY-OFF-END.

REPEAT i = 1 TO bh:NUM-FIELDS /* number of field in the table */.

fh = bh:BUFFER-FIELD(i). /* filed handle */

/* need this to displ some label on a report
but dont know wish one, i'm gone use buffer-compare */

FIND _file WHERE _file._file-name = bh:NAME NO-LOCK.
FIND _field WHERE _field._file-recid = RECID(_file)
AND _field._field-name = fh:NAME NO-LOCK.

PUT _file._file-label /* Table label */.

PUT fh:NAME /* Field name */
_field._label /* Field label */
STRING(fh:BUFFER-VALUE) SKIP. /* data in the field */

END.

qh:GET-NEXT.
END.

DELETE WIDGET bh.

Question:
How can i do a find of the same record in the other database in
my query loop ?

Find first {2}.{3} where ????

I cannot prepare my query with for each, first i have do know
if the record is available in the other database, for the report.

This is a old stuff that i used before but is it possible to do the same with the query prepare ?

FOR EACH {1}.{3} NO-LOCK:
FIND FIRST {2}.{3} WHERE {2}.{3}.{4} = {1}.{3}.{4}
AND {2}.{3}.{5} = {1}.{3}.{5} NO-LOCK NO-ERROR.
IF NOT AVAIL {2}.{3} THEN
PUT UNFORMATTED "not avail" SKIP.
ELSE DO:
BUFFER-COMPARE {1}.{3} EXCEPT {deamon\other\excl-{3}.i } TO {2}.{3} SAVE RESULT IN v_result.
IF v_result <> "" THEN
PUT UNFORMATTED {1}.{3}.{4} " " {1}.{3}.{5} " " v_result SKIP.
END.
END.

TIA.

 

[jongpau]

Hi Luc,

Nice question (fun to look into)! I have tried to sort of create what you are trying to do. It's up to you to test it (looks like it runs OK on my dbs, but it may need some tweaking) and change it some more so you get the outcome you are looking for.

/* Replaced runtime parameters with input parameters so the */
/* procedure can be compiled to a .r                        */
DEF INPUT PARAMETER IPDBOne  AS CHAR NO-UNDO.
DEF INPUT PARAMETER IPDBTwo  AS CHAR NO-UNDO.
DEF INPUT PARAMETER IPTable  AS CHAR NO-UNDO.
DEF INPUT PARAMETER IPField1 AS CHAR NO-UNDO.
DEF INPUT PARAMETER IPField2 AS CHAR NO-UNDO.

/* Added some new variables we use lateron */
DEF VAR i   AS INT    NO-UNDO.
DEF VAR ext AS INT    NO-UNDO.
DEF VAR qh  AS HANDLE NO-UNDO.
DEF VAR bh  AS HANDLE NO-UNDO.
DEF VAR fh  AS HANDLE NO-UNDO.
DEF VAR fh1 AS HANDLE NO-UNDO.
DEF VAR fh2 AS HANDLE NO-UNDO.
DEF VAR qh1 AS HANDLE NO-UNDO.
DEF VAR bh1 AS HANDLE NO-UNDO.
DEF VAR qry AS CHAR   NO-UNDO.

/* Create a buffer for the first table and test if it exists */
CREATE BUFFER bh FOR TABLE IPDBOne + ".":U + IPTable NO-ERROR.
IF NOT VALID-HANDLE(bh) 
THEN RETURN.

/* Create a buffer for the second table and test if it exists */
CREATE BUFFER bh1 FOR TABLE IPDBTwo + ".":U + IPTable NO-ERROR.
IF NOT VALID-HANDLE(bh1) 
THEN DO:
  RUN IPCleanUp.
  RETURN.
END.

/* Assign some fields so we can use them to build a query */
ASSIGN fh1 = bh:BUFFER-FIELD(IPField1)
       fh2 = bh:BUFFER-FIELD(IPField2).

/* Create the queries and assign the buffers */
CREATE QUERY qh.
CREATE QUERY qh1.
qh:ADD-BUFFER(bh).
qh1:ADD-BUFFER(bh1).

/* Prepare and open the first (outer) query */
qh:QUERY-PREPARE("FOR EACH ":U 
               + IPDBOne
               + ".":U
               + IPTable
               + " NO-LOCK":U).
qh:QUERY-OPEN.
qh:GET-FIRST.

DISPL bh:NAME. /* table name, not the label */

/* Only need to do this once because the buffer does not */
/* change within the procedure                           */
FIND _file NO-LOCK WHERE
     _file._file-name EQ IPTable
     NO-ERROR.
/* Loop through our outer query */
DO WHILE NOT qh:QUERY-OFF-END.
  /* Build a query string to find record(s) in the second database */
  /* NOTE: This may need some tweaking in case a field contains    */
  /* an unknown value (?), in which case the whole query will get  */
  /* an unknown value too (causing errors)                         */
  qry = "FOR EACH ":U
      + IPDBTwo
      + ".":U
      + IPTable
      + " NO-LOCK WHERE ":U
      + IPDBTwo
      + ".":U
      + IPTable
      + ".":U
      + IPField1
      + " EQ ":U
      + (IF fh1: DATA-TYPE BEGINS "CH":U
         THEN "'":U
         ELSE "":U)
      + fh1:BUFFER-VALUE
      + (IF fh1: DATA-TYPE BEGINS "CH":U
         THEN "'":U
         ELSE "":U)
      + " AND ":U
      + IPDBTwo
      + ".":U
      + IPTable
      + ".":U
      + IPField2
      + " EQ ":U
      + (IF fh2: DATA-TYPE BEGINS "CH":U
         THEN "'":U
         ELSE "":U)
      + fh2:BUFFER-VALUE
      + (IF fh2: DATA-TYPE BEGINS "CH":U
         THEN "'":U
         ELSE "":U).
  /* Prepare and open the second (inner) query */
  IF qh1:IS-OPEN
  THEN qh1:QUERY-CLOSE.
  qh1:QUERY-PREPARE(qry).
  qh1:QUERY-OPEN.
  qh1:GET-FIRST.

  /* No record available */
  IF qh1:QUERY-OFF-END
  THEN PUT "Not available":L SKIP.
  /* Record available, do buffer-compare */
  ELSE DO:
    /* Records are different, loop through the fields */
    IF NOT bh:BUFFER-COMPARE(bh1)
    THEN DO i = 1 TO bh:NUM-FIELDS /* number of field in the table */.
      fh = bh:BUFFER-FIELD(i).
      /* need this to displ some label on a report            */
      /* but dont know which one, i'm gone use buffer-compare */
    
      /* Check if the field has an extent, handle appropriately */
      IF fh:EXTENT EQ 0
      THEN PUT _file._file-label       /* Table label       */
               fh:NAME                 /* Field name        */ 
               fh:LABEL                /* Field label       */
               STRING(fh:BUFFER-VALUE) /* data in the field */
               SKIP. 
      ELSE DO ext = 1 TO fh:EXTENT:
        PUT _file._file-label            /* Table label       */
            fh:NAME                      /* Field name        */ 
            fh:LABEL                     /* Field label       */
            STRING(fh:BUFFER-VALUE(ext)) /* data in the field */
            SKIP.     
      END. /* extent field (do ext = 1 to fh:extent) */
      /* NOTE: You can also use fh:STRING-VALUE instead of the */
      /* STRING(fh:BUFFER-VALUE) construction                  */
    END. /* not buffer-compare (do i = 1 to bh:num-fields) */
  END. /* record found */
  qh:GET-NEXT.
END. /* do while not qh:query-off-end */
RUN IPCleanUp.

PROCEDURE IPCleanUp:
  /* Close and cleanup dynamically created objects */
  IF VALID-HANDLE(qh)
  THEN DO:
    IF qh:IS-OPEN
    THEN qh:QUERY-CLOSE.
    DELETE OBJECT qh.
  END. /* valid-handle(qh) */

  IF VALID-HANDLE(qh1)
  THEN DO:
    IF qh1:IS-OPEN
    THEN qh1:QUERY-CLOSE.
    DELETE OBJECT qh1.
  END. /* valid-handle(qh1) */

  IF VALID-HANDLE(bh)
  THEN DELETE OBJECT bh.
  
  IF VALID-HANDLE(bh1)
  THEN DELETE OBJECT bh1.

END PROCEDURE. /* ipcleanup */

To Run use:

RUN procedurename.p (INPUT "dbname1":U,
                     INPUT "dbname2":U,
                     INPUT "tablename":U,
                     INPUT "fieldname1":U,
                     INPUT "fieldname2":U).

HTH

 

[Luc Lessard]

Thanks Paul,

I had a look at your code it seems that it is gone a work,
but i don't have the time today to test it.

But when i'm back from my vacation (yahoo!!), i will use
your exemple.

Thank again.