How to return a multidimensional ds in a procedure called in a different main program

Question

Here i have defined the procedure which is returning a OrderDs of dim(256). In debug its getting the right value but when called in the main program, only the first row is printed 256 times.

Module in which procedure is defined--

**Free

dcl-proc getOrderDetails export;

   dcl-ds OrderDs dim(256) Qualified;
     ORDNO   zoned(5) inz;
     ORDDATE zoned(8) inz;
     LINNO   zoned(3) inz;
     ITMNO   zoned(5) inz;
     ITMQTY  zoned(5) inz;
   end-ds;

   dcl-pi *n likeds(OrderDs) dim(256);
     iCusNo zoned(5);
     iFrmDate zoned(8);
     iToDate zoned(8);
   end-pi;

   dcl-s sqlQuery2 varchar(1000);
   dcl-s v_RowsFetched Int(5) inz(0);

   sqlQuery2 = ' Select ORDS101A.ORDNO, ' +
               ' ORDS101A.ORDDATE, ' +
               ' ORDS102A.LINNO, ' +
               ' ORDS102A.ITMNO, ' +
               'ORDS102A.ITMQTY ' +
               'AS ITMQTY FROM ' +
               'ORDS101A JOIN ORDS102A ' +
               ' ON ORDS101A.ORDNO = ORDS102A.ORDNO ' +
               'WHERE ORDS101A.ORDDATE  '+
               'BETWEEN ? and ?' +
               ' and (ORDS101A.CUSNO = ?) ' +
              'order by ORDS101A.ORDNO,ORDS102A.LINNO';

     exec sql Prepare stmt2 from :sqlQuery2;
     exec sql declare OrdCursor scroll cursor for stmt2;
     exec sql open OrdCursor using  :iFrmDate, :iToDate, :iCusNo;

     Exec Sql fetch next from OrdCUrsor for 5 rows into :OrderDs;
     v_RowsFetched = sqlerrd(3);
     exec sql close OrdCursor ;

    return OrderDs ;
end-proc;

Different Main Program in which procedure is called--

   HDFTACTGRP(\*NO) BNDDIR('MYBNDDIR1')

   FQSYSPRT   O    F  132        PRINTER

   **Free

    dcl-f ord101fm workstn;

    //**********************Variables Declaration********************//
    dcl-s iCusNo   zoned(5);
    dcl-s iFrmDate zoned(8);
    dcl-s iToDate  zoned(8);

    dcl-s pCusNam   char(30) inz;
    dcl-s pOrdNo    zoned(5) inz;
    dcl-s pOrdDate  zoned(8) inz;
    dcl-s pLinno    zoned(3) inz;
    dcl-s pItmno    zoned(5) inz;
    dcl-s pItmQty   zoned(5) inz;
    dcl-s Index     zoned(5) inz(1);
    dcl-s Sqlrows   Int(5)   inz(100);


    //dcl-s iToDate  zoned(8);

    //*******************Procedures Declaration*******************  *//


    dcl-ds OrderDs dim(256) Qualified;
      ORDNO   zoned(5) inz;
      ORDDATE zoned(8) inz;
      LINNO   zoned(3) inz;
      ITMNO   zoned(5) inz;
      ITMQTY  zoned(5) inz;
    end-ds;


    dcl-pr getOrderDetails likeDs(OrderDs) extproc('GETORDERDETAILS');
      iCusNo zoned(5);
      iFrmDate zoned(8);
      iToDate zoned(8);
    end-pr;
   
    iCusNo= 1234;
    iFrmDate=20010912;
    iToDate=20030912;
    
    Clear OrderDs;
    OrderDs= getOrderDetails(iCusNo:iFrmDate:iToDate);

    EXCEPT HEADER;

    for index=1 to %elem(OrderDs);


      if OrderDs(Index).Ordno <> 0;
        index +=1;

        pCusNam    =  CustomerDs.oCusNam;
        pOrdNO     =  OrderDs(Index).ORDNO;
        pOrdDate   =  OrderDs(Index).ORDDATE;
        pLinno     =  OrderDs(Index).LINNO;
        pItmno     =  OrderDs(Index).ITMNO;
        pItmQty    =  OrderDs(Index).ITMQTY;

        EXCEPT Detail;
      endif;
    endfor;
   *Inlr=*On;

 //Printer File//
 OQSYSPRT   E            HEADER
 O
 O                                           30 'ORDER DETAILS REPORT'
 O          E            HEADER      1
 O                                           20 'Customer Name'
 O                                           35 'Order No'
 O                                           45 'Order Date'
 O                                           50 'Order Line'
 O                                           60 'Item Num'
 O                                           70 'Item Quantity'
 O                                          100 'Customer Number'
 O                                          120 'Price'
 O                                          130 'Total'
 O          E            Detail      1
 O                       pCusNam             30
 O                       pOrdNo              35
 O                       pOrdDate            45
 O                       pLinno              50
 O                       pItmno              60
 O                       pItmQty             70
 O                       iCusNo             100

Here in this Line ---- OrderDs= getOrderDetails(iCusNo:iFrmDate:iToDate); OrderDs is only repeating for the first row data 256 times.

Tried using for loop also still not working , does anyone have an idea on how can I return a multidimensional data structure in other program?

jmarkmurphy · Accepted Answer · 2024-12-03 21:11:20Z

You have a number of errors in your code, one is procedural (how you assemble the parts), some are of a nature that I would expect to prevent compilation. So Let's look at the most egregious first.

In your main procedure you have a combination of fixed and free format code with a **Free tag. First problem is that the **Free tag is not on the first line of your program. This tag must be the only thing on the first line of your source member. Otherwise it is meaningless. It appears that you have a fixed format header spec, and a file spec ahead of it. That just won't work the way you seem to intend. The other thing about the **Free tag is that it tells the compiler that there is no fixed format code in the source file, and the line number area, the spec column, and the comment area of the lines are not present. The entire line is code. You should remove the **Free line from your code, or remove all the fixed format code. My preference would be to remove the fixed format code, though you are using the EXCEPT op code which would not work without O specs, and I don't know of a way to define those in **Free mode.

NOTE: You can combine **Free source and fixed format source using copy books, so that must be the way to use EXCEPT in a **Free program.

Next, there is a mismatch between your prototypes in the main procedure and the procedure interface in the sub-procedure. The best way to deal with this is to use a copy book to define the prototype, and use the same prototype everywhere you call the procedure, and in the procedure module. That way the compiler will notify you that there is a problem between your prototype, procedure interface, and procedure call. This mismatch is likely the issue in your case.

Note: there is a way to use compile directives to allow defining prototypes in the same source with your procedure, but that adds more complexity than using a copy book IMHO. I guess it is a balance between additional source files, vs. additional complexity. I choose the extra source files. Just choose one and stick to it.

You can use naming conventions to help you keep things sorted. I keep prototypes in a source file named QPROTOSRC, and I name them identically to the source file where the procedures being prototyped are defined. This answer is not getting a bit off topic, so I will stop. Just check your prototype and procedure interface, they should be the same, including DIM().

Sure I'll use a copybook for protypes and can i use /Free and /End-free to write in a mixed format
/Free and /End-free have not been required since sometime around v6.1. Just remove the **Free.

Collectives™ on Stack Overflow

How to return a multidimensional ds in a procedure called in a different main program

1 Answer 1

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related