DataSetMessage

DEFINE VARIABLE hBuf         AS HANDLE  NO-UNDO.
DEFINE VARIABLE hds2         AS HANDLE  NO-UNDO.
DEFINE VARIABLE hMesg        AS HANDLE  NO-UNDO.
DEFINE VARIABLE hMsgConsumer AS HANDLE  NO-UNDO.
DEFINE VARIABLE hq           AS HANDLE  NO-UNDO.
DEFINE VARIABLE hrel         AS HANDLE  NO-UNDO.
DEFINE VARIABLE hSession     AS HANDLE  NO-UNDO.
DEFINE VARIABLE ix           AS INTEGER NO-UNDO.
DEFINE VARIABLE jx           AS INTEGER NO-UNDO.
DEFINE VARIABLE numRecsRead  AS INTEGER NO-UNDO.
DEFINE VARIABLE ptp          AS LOGICAL NO-UNDO INITIAL TRUE.
DEFINE VARIABLE ret          AS LOGICAL NO-UNDO.
DEFINE VARIABLE stillWaiting AS LOGICAL NO-UNDO INITIAL TRUE.
IF ptp THEN
  RUN jms/ptpsession.p PERSISTENT SET hSession ("-SMQConnect").
ELSE
  RUN jms/pubsubsession.p PERSISTENT SET hSession ("-SMQConnect").
RUN setBrokerURL IN hSession ("localhost:2506").
RUN beginSession IN hSession.
RUN createMessageConsumer IN hSession
  (THIS-PROCEDURE, /* this procedure will handle it */
   "messageHandler",  /* name of internal procedure */
    OUTPUT hMsgConsumer).
IF ptp THEN
  RUN receiveFromQueue IN hSession ("SampleQ1", ?, hMsgConsumer).
ELSE
  RUN subscribe IN hSession
    ("TestTopic",
     ?,    /* durable subscription */
     ?,    /* no message selector */
     TRUE, /* want to get my own publications */
     hMsgConsumer).
RUN startReceiveMessages IN hSession.
RUN waitForMessages IN hSession ("inWait", THIS-PROCEDURE, ?).
RUN deleteSession IN hSession.
MESSAGE "Number of records processed: " + STRING(numRecsRead).
PROCEDURE messageHandler:
  DEFINE INPUT PARAMETER hMessage         AS HANDLE NO-UNDO.
  DEFINE INPUT PARAMETER hMessageConsumer AS HANDLE NO-UNDO.
  /* hAutoReply is not used in this example */
  DEFINE OUTPUT PARAMETER hAutoReply      AS HANDLE NO-UNDO.
  DEFINE VARIABLE ttH1 AS HANDLE NO-UNDO.
  DEFINE VARIABLE bh1  AS HANDLE NO-UNDO.
  DEFINE VARIABLE bh2  AS HANDLE NO-UNDO.
  DEFINE VARIABLE qh1  AS HANDLE NO-UNDO.
  IF DYNAMIC-FUNCTION("getMessageType" in hMessage) =
    "DatasetMessage" THEN DO:
    ASSIGN
      hds2        = DYNAMIC-FUNCTION("getDataset" IN hMessage, ?, ?, ?)
      numRecsRead = numRecsRead + 1.
MESSAGE
      "num-buffers: " hds2:NUM-BUFFERS "name: " hds2:NAME SKIP
      "nspace-info: " hds2:NAMESPACE-URI hds2:NAMESPACE-PREFIX SKIP
      "num-relations: " hds2:NUM-RELATIONS
      VIEW-AS ALERT-BOX.
DO ix = 1 TO hds2:NUM-RELATIONS:
      hrel = hds2:GET-RELATION(ix).
      MESSAGE
        "rel name: " hrel:NAME SKIP
        "reposition: " hrel:REPOSITION SKIP
        "nested: " hrel:NESTED SKIP
        "where-str: " hrel:WHERE-STRING SKIP
        "parent: " hrel:PARENT-BUFFER:NAME SKIP
        "child: " hrel:CHILD-BUFFER:NAME SKIP
        "rel-fields: " hrel:RELATION-FIELDS
        VIEW-AS ALERT-BOX.
END.
DO jx = 1 TO hds2:NUM-BUFFERS:
      hBuf = hds2:GET-BUFFER-HANDLE(jx).
      MESSAGE "buf name: " hBuf:NAME VIEW-AS ALERT-BOX.
      DO ix = 1 TO hBuf:NUM-FIELDS:
        MESSAGE
          "name: " hBuf:BUFFER-FIELD(ix):NAME skip
          "type: " hBuf:BUFFER-FIELD(ix):DATA-TYPE skip
          "extent: " hBuf:BUFFER-FIELD(ix):EXTENT skip
          "decimals: " hBuf:BUFFER-FIELD(ix):DECIMALS skip
          "xmltype: " hBuf:BUFFER-FIELD(ix):XML-DATA-TYPE skip
          "xmlnodetype: " hBuf:BUFFER-FIELD(ix):XML-NODE-TYPE skip
          "initial: " hBuf:BUFFER-FIELD(ix):INITIAL skip
          "format: " hBuf:BUFFER-FIELD(ix):FORMAT skip
          "help: " hBuf:BUFFER-FIELD(ix):HELP skip
          VIEW-AS ALERT-BOX.
      END.
    END.
    CREATE QUERY hq.

DO jx = 1 TO hds2:NUM-BUFFERS:
      hBuf = hds2:GET-BUFFER-HANDLE(jx).
      MESSAGE "buf name: " hBuf:NAME VIEW-AS ALERT-BOX.
      hq:SET-BUFFERS(hBuf).
      hq:QUERY-PREPARE("FOR EACH " + hBuf:NAME).
      hq:QUERY-OPEN.

      DO WHILE hq:GET-NEXT():
        DO ix = 1 TO hBuf:NUM-FIELDS:
          MESSAGE
            "name: " hBuf:BUFFER-FIELD(ix):NAME SKIP
            "value: "
            IF hBuf:BUFFER-FIELD(ix):EXTENT > 0 THEN
              hBuf:BUFFER-FIELD(ix):BUFFER-VALUE[1]
            ELSE
              hBuf:BUFFER-FIELD(ix):BUFFER-VALUE
            VIEW-AS ALERT-BOX.
        END.
      END.
    END.
    DELETE OBJECT hq.
    DELETE OBJECT hds2.
  END.
  ELSE
    stillWaiting = FALSE.
  RUN deleteMessage IN hMessage.
END PROCEDURE.
FUNCTION inWait RETURNS LOGICAL:
  RETURN stillWaiting.
END.