ibmi-brunch-learn

Announcement

Collapse
No announcement yet.

How to call a legacy program in Free form

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • How to call a legacy program in Free form

    My objective is to call a legacy program in free form and return a value.

    This code snippet is a classic example of RPG III technique to call a program using a parm list;
    ...
    Call 'ECM901B'
    Parm wBatchParm
    Parm wParmList
    Parm wSelList
    ...

    The wSelList returns a value.

    Can this be accomplished in RPG/LE free form without modifying the ECM901b program?

    If so, how?


    Here is what I have tried in free from, but get error message :

    *RNF5407 20 3 More parameters were passed in the prototyped call than are allowed.

    ...
    d* Program's Entry List
    D ECM901B Pr ExtPgm('ECM901B')
    D eBatchParm S 1A
    D eParmList S 256A
    D eSelList S 256A
    ...
    ECM901B(wBatchParm:wParmList:wSelList) ;

    Thank you for any help!
    EMSS

  • #2
    I figured it out.

    In the Prototype, I erroneously used stand alone fields. These effectively told the Prototype end-of-Parms.

    Once I removed the S type for each field, the free form call

    ECM901B(wBatchParm:wParmList:wSelList) ;

    the called program ran as expected and returned a value as needed.
    EMSS

    Comment


    • #3
      Could you post a snippet

      EMSS -

      Great


      Can you post the post more of the source for a complete example? (new D specs)


      By the way Welcome
      PHP Code:
            * --------------------------------------------------
            * 
      Program ARRAY01
            
      Purpose arrays examples
            
      Written -
            * 
      Author  -
            *
            * 
      PROGRAM DESCRIPTION
            
      *   work with arrays
            
      *
            *
            * 
      INPUT PARAMETERS
            
      *   Description        Type  Size    How Used
            
      *   -----------        ----  ----    --------
            *   
      InInvoice          dec      7 0  Invoice Number
            
      *
            *
            * 
      INDICATOR USAGE
            
      *   xx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
            
      *---------------------------------------------------

           
      d ARRAY01         PR                  extpgm('ARRAY01')
           
      d   InMessage#                  15  5
           
      d   Indynamic                    1
           d   InNoDups                     1

           d ARRAY01         PI
           d   InMessage
      #                  15  5
           
      d   Indynamic                    1
           d   InNoDups                     1
            
      *
            * 
      Procedure calls
            
      *
           
      d $Command        pr                  EXTPGM('QCMDEXC')
           
      d  CmdString                   256
           d  CmdLength                    15  5


           d 
      #Loaded         s             10i 0
           
      #Random         s             10i 0
           
      d ArrayLine       s             10    Dim(50)
           
      d AX              s             04  0
           d CmdLength       s             15  5
           d CmdString       s            256
           d count           s              3  0
           d count2          s              3  0
           d data            s             40
           d lastchar        s              1
           d letters         c                   
      CONST('AEIOUBCDFGHJKLMNPQRSTVWXYZ')
           
      d numbers         c                   CONST('0123456789')
           
      d nx1             s              3  0
           d nx2             s              3  0
           d msg
      #            s              3  0
           
      d outmessage      s             40
           d random          s              2  0
           d reply           s             01

           dfilefbk          ds
           d FileRRN               397    400I 0

           d message         s             40    DIM
      (05CTDATA PERRCD(1)

           
      d                 ds
           d dyno1                         40a   Dim
      (6Ascend
           d  First10                      10a   Overlay
      (dyno1)
           
      d  Second10                     10a   Overlay(dyno1:*Next)
           
      d  Third10                      10a   Overlay(dyno1:*Next)
           
      d  Fourth10                     10a   Overlay(dyno1:*Next)

           
      d dyno2                          1  0 Dim(5)

           
      d Nodups                         1  0 Dim(100)
            /
      free

                
      // look at parameters to tell what to do

              
      select;
                
      when %parms >= 3;
                
      //exsr $lookup;
                
      when %parms >= 2;
                  
      exsr $dynamic;
                
      when %parms >= 1;
                  
      exsr $messages;
              
      endsl;


                *
      inlr = *on;

             
      //=========================================
             //  $message - use compile time array
             //=========================================

               
      begsr $messages;

                 
      msg# = inmessage#;
                   
      monitor;
                     
      outmessage message(msg#);
                     
      dsply outmessage reply;
                   
      on-error;
                     
      dsply 'Invalid message #'  reply;
                   
      endmon;

               
      endsr;

             
      //=========================================
             //  $dynamic - use dynamic array
             //=========================================

               
      begsr $dynamic;
                 
      #random = 26;
                 
      for count 1 to 5;

                   
      clear data;
                   
      dou %len(%trim(data)) = 40;

                     
      dou random <> *zeros;
                       
      exsr $getRandom;
                     
      enddo;

                     
      lastchar = %subst(letters:Random:1);
                     
      data = %trim(data) + lastchar;
                   
      enddo;
                   
      dyno1(count) = data;
                 endfor;

                   
      // when sorting array #loaded = number of elements in array.
                   // sort entire array dyno1 by the second10 characters.
                   // this would be great for ..sorting a subfile.


                // %elem will give you all the elements in the array
                // this would include the blank ones.

                 #loaded = %elem(dyno1);


                 #loaded = 5;
                 
      SortA %SubArr(second10:1:#Loaded);
                   
      for count 1 to 5;
                     
      dsply second10(countreply;
                   endfor;


                 
      //example of %xfoot

                 #random = 10;
                 
      for count 1 to 5;

                   
      dou random <> *zeros;
                     
      exsr $getRandom;
                   
      enddo;

                   
      dyno2(count) = random;

                 endfor;

                   
      clear outmessage;
                   for 
      count21 to 5;
                     
      outmessage = %trim(outmessage) +
                                  %
      editc(dyno2(count2):'X');
                     if 
      count2 and count2 5;
                     
      outmessage = %trim(outmessage) + '@+@';
                     endif;

                   endfor;
                   
      outmessage = %trim(outmessage) +  '@=@'  +
                                %
      editc(%xfoot(dyno2):'X');
                   
      outmessage = %xlate('@' ' 'outmessage);

                 
      dsply outmessage reply;

               
      endsr;


             
      //=========================================
             //  $nodups - no duplicates in array
             //=========================================

               
      begsr $nodups;

                 
      #random = 10;
                 
      for count 1 to 100;


                     
      dou random <> *zeros;
                       
      exsr $getRandom;
                     
      enddo;

                   
      dyno1(count) = data;
                 endfor;

               
      endsr;

             
      //=========================================
             // $getRandom - Generate random number
             //=========================================

                   
      begsr $getRandom;

                        
      clear  Random;
            /
      end-free

           c
      /Exec SQL
           c
      Select Rand() * :#random Into :Random
           
      cFrom SYSIBM/SYSDUMMY1
           c
      /End-Exec

            
      /free


                   endsr
      ;


             
      //=========================================
             //  *inzsr - Initial one time subroutine
             //=========================================

               
      begsr *inzsr;


               
      cmdstring 'addlible jamielib *last';
               
      cmdlength = %len(%trim(cmdstring));
               
      monitor;
                
      $command(cmdstring cmdlength);
               
      on-error;
                
      dsply 'Library error!'     reply;
               
      endmon;

               
      endsr;

            /
      end-free

      ** messages                            >*
         
      This is message #1                   1
         
      This is message #2                   2
         
      This is message #3                   3
         
      This is message #4                   4
         
      This is message #5                   5



      Thanks
      Jamie
      All my answers were extracted from the "Big Dummy's Guide to the As400"
      and I take no responsibility for any of them.

      www.code400.com

      Comment

      Working...
      X