midrange.com code scratchpad
Name:
Retrieve activation group of programs.
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
11/04/2015 04:27:44 pm
IP:
Logged
Description:
Example of retrieving activation group of programs.
Code:
  1. Pieces of CHECKILE rpgle program.
  2.  *    Create outfiles in QTEMP                                            
  3.                                                                           
  4. C                   eval      RtnErr = ExcCmd('DSPOBJD OBJ(' + %trim(lib1)
  5. C                                                                         
  6. C                             + '/*ALL) OBJTYPE(*PGM) OUTPUT(*OUTFILE) '  
  7. C                             + 'OUTFILE(QTEMP/DSPOBJD1)'                 
  8. C                             :ErrMsgID:ErrMsg)                           
  9.                                                                           
  10. C                   Call      'RTVPGMINF'          
  11. C                   Parm                    Odobnm 
  12. C                   Parm                    Odlbnm 
  13. C                   Parm      *Blanks       Actgrp 
  14. C                   Parm                    Errid  
  15. C                   If        Actgrp <> 'QILE'     
  16. C                   except    ile                  
  17. C                   Endif                          
  18.  
  19. RTVPGMINF CLLE program
  20.  
  21.            PGM        PARM(&PGMNAME &LIBNAME &ACTGRP &ERRORID)
  22.                                                               
  23. /* VARIABLES */                                               
  24.                                                               
  25.              DCL        VAR(&RECEIVER) TYPE(*CHAR) LEN(399)   
  26.              DCL        VAR(&RCVLEN) TYPE(*CHAR) LEN(4)       
  27.              DCL        VAR(&FORMAT) TYPE(*CHAR) LEN(8)       
  28.                                                               
  29.              /* TOTAL LENGHT ERROR STRUCTURE     */           
  30.              DCL        VAR(&ERROR) TYPE(*CHAR) LEN(96)       
  31.                                                               
  32.              DCL        VAR(&LENGTH) TYPE(*DEC) LEN(15 0)     
  33.              DCL        VAR(&LENGTHA) TYPE(*CHAR) LEN(4)      
  34.                                                               
  35.              DCL        VAR(&PGMNAME) TYPE(*CHAR) LEN(10)     
  36.              DCL        VAR(&LIBNAME) TYPE(*CHAR) LEN(10)     
  37.              DCL        VAR(&QUALPGMNME) TYPE(*CHAR) LEN(20)  
  38.                                                               
  39.              DCL        VAR(&ACTGRP) TYPE(*CHAR) LEN(30)      
  40.              DCL        VAR(&ERRORID) TYPE(*CHAR) LEN(7)        
  41. /* SET VARIABLES */                                             
  42.              CHGVAR     VAR(&QUALPGMNME) VALUE(&PGMNAME *CAT +  
  43.                           &LIBNAME)                             
  44.                                                                 
  45.              CHGVAR     VAR(&LENGTH) VALUE(399)                 
  46.              CHGVAR     VAR(%BIN(&RCVLEN)) VALUE(&LENGTH)       
  47.                                                                 
  48.              CHGVAR     VAR(&FORMAT) VALUE('PGMI0100')          
  49.                                                                 
  50.              /* ERROR STRUCTURE AVAILABLE LENGTH   */           
  51.              CHGVAR     VAR(&LENGTH) VALUE(88)                  
  52.              CHGVAR     VAR(%BIN(&LENGTHA)) VALUE(&LENGTH)      
  53.              CHGVAR     VAR(%SST(&ERROR 1 4)) VALUE(&LENGTHA)   
  54.                                                                 
  55.              /* THE VALID ERROR LENGTH WILL BE SET BY THE API */
  56.              CHGVAR     VAR(&LENGTH) VALUE(0)                   
  57.              CHGVAR     VAR(%BIN(&LENGTHA)) VALUE(&LENGTH)      
  58.              CHGVAR     VAR(%SST(&ERROR 5 4)) VALUE(&LENGTHA)   
  59.              CALL       PGM(QCLRPGMI) PARM(&RECEIVER &RCVLEN &FORMAT +   
  60.                           &QUALPGMNME &ERROR)                            
  61.              MONMSG     MSGID(CPF0000)                                   
  62.                                                                          
  63.           /* DUE TO FACT THAT THE FIELDS DESCRIBED IN THE          */    
  64.           /* DOCUMENT BEGIN AT POSITION ZERO YOU HAVE TO ADD +1 TO */    
  65.           /* THE GIVEN POSITION TO GET THE DATA CORRECTLY          */    
  66.              CHGVAR     VAR(&ACTGRP) VALUE(%SST(&RECEIVER 369 30))       
  67.              CHGVAR     VAR(&ERRORID) VALUE(%SST(&ERROR 9 7))            
  68.                                                                          
  69.  ENDE:       RETURN                                                      
  70.                                                                          
  71.              ENDPGM                                                                                                                    
© 2004-2019 by midrange.com generated in 0.006s valid xhtml & css