Problem solve Get help with specific problems with your technologies, process and projects.

Use SQL to change files

Sometimes I use SQL to add fields to a file, or to change field attributes. It is done using the ALTER TABLE and LABEL ON sql commands.

Here is a small utility to assist with adding new fields to any file. It is far from being perfect, so if you improve on it, please post it here.


Create the ADDNEWFLD CMD member, 
Create the ADDNEWFLD REXX member, 
Create the command object: 

CRTCMD CMD(your_lib/ADDNEWFLD) 
       PGM(*REXX)                   
       SRCFILE(your_lib/QCMDSRC)      
       SRCMBR(ADDNEWFLD)            
         REXSRCFILE(your_lib/QREXSRC) 
       REPLACE(*YES)                 


  
                
                Code: /* The CMD source: ADDNEWFLD in QCMDSRC */ 
/*========================================*/ 
ADDNEWFLD:   CMD        PROMPT('Add new field to file') 
/*  Use  REXX ADDNEWFLD as CPP */ 
PARM       KWD(FILE) TYPE(FILE) MIN(1) FILE(*IN) +         
             PROMPT('Physical file to add to   ')          
FILE: QUAL       TYPE(*GENERIC) LEN(10) MIN(1) EXPR(*YES)        
QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +                
             SPCVAL((*CURLIB) (*LIBL) (*USRLIBL) +         
             (*ALL) (*SYSLIBL)) MIN(0) EXPR(*YES) +        
             PROMPT('Library')                             
                                                           
PARM       KWD(FIELD) TYPE(*NAME) MIN(1) PROMPT('Field  +  
             Name ')                                       
                                                           
PARM       KWD(TYPE) TYPE(*CHAR) LEN(7) RSTD(*YES) +       
             DFT(*CHAR) VALUES(*CHAR *ZONED *PACKED) +     
             MIN(0) EXPR(*YES) PROMPT('Data Type')         
 PARM       KWD(LENGTH) TYPE(*DEC) LEN(10) MIN(1) +    
              PROMPT('Field Length')                   
                                                       
 PARM       KWD(SCALE) TYPE(*DEC) LEN(10) MIN(0) +     
              PROMPT('Numeric Scale')                  
                                                       
 PARM       KWD(COLHDG) TYPE(*CHAR) LEN(60) MIN(0) +   
              CASE(*MIXED) PROMPT('Heading text')      
                                                       
 PARM       KWD(text) TYPE(*CHAR) LEN(50) MIN(0) +     
              CASE(*MIXED) PROMPT('Field text')        


/* ====End of command ============*/ 

/* The REXX source: ADDNEWFLD in QREXSRC */ 
parse arg 'FILE(' filelib '/' file ')' 
parse arg 'FIELD(' field_name  ')' 
parse arg 'COLHDG(' Column_Heading ')' 
parse arg 'TEXT(' Field_Text ')' 
parse arg 'TYPE(' type ')' 
parse arg 'LENGTH(' fld_len ')' 
parse arg 'SCALE(' fld_scale ')' 

 signal on error name command_error 
 signal on failure name command_error  


   ADDRESS  COMMAND 
    'CHKOBJ OBJ('filelib'/'file') OBJTYPE(*FILE) MBR(*NONE) AUT(*OBJALTER)' 

select 
  when type='*CHAR'  then fld_type='CHAR('fld_len')' 

  when type='*ZONED' then do  
                       if fld_scale ='' then fld_scale = '0' 
                       fld_type='NUMERIC('fld_len','fld_scale')' 
                       end 

  when type='*PACKED' then do 
                       if fld_scale ='' then fld_scale = '0' 
                       fld_type='DECIMAL'fld_len','fld_scale')' 
                       end 

  otherwise        fld_type='CHAR(1)' 
end 

   Column_Heading = strip(Column_Heading,'B','''') 
   Field_Text = strip(Field_Text,'B','''') 

   add_SRC = 'ALTER TABLE 'filelib'/'file' ADD COLUMN ' field_name fld_type 

   hdr_SRC = 'LABEL ON COLUMN 'filelib'/'file  , 
              ' ('field_name' IS '''Column_Heading''')' 

   txt_SRC = 'LABEL ON COLUMN 'filelib'/'file  , 
             ' ('field_name' TEXT IS '''Field_Text''')' 
ADDRESS  EXECSQL 
 'EXECSQL  SET TRANSACTION ISOLATION LEVEL NO COMMIT' 
 'EXECSQL   ' add_SRC 
 'EXECSQL   ' hdr_SRC 
 'EXECSQL   ' txt_SRC 
exit 
/********************************************************************/        
 /*  command_error : Generic ERROR & FAILURE condition trap                      */ 
/********************************************************************/ 
/* The RC variable contains the actual error message from the AS400 system */  
/* This routine can be customized for the specific implementation         */ 
 command_error:
parse source _system _start _srcmbr _srcfile _srclib 

    ADDRESS  COMMAND 
'SNDPGMMSG MSGID(cpf9899) MSGF(QCPFMSG) TOPGMQ(*PRV) MSGTYPE(*ESCAPE) ' 

exit

Dig Deeper on RPG iSeries programming

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchDataCenter

Close