Making multiple AS/400 files known to LANSA automatically

Date:Archived
Product/Release:LANSA for the AS/400
Abstract:A handy tool to import multiple non-LANSA files into the LANSA Repository
Submitted By:LANSA Technical Support

A handy tool to import multiple non-LANSA files into the LANSA Repository in one go!

This is of great interest to the growing number of LANSA Client and LANSA/Server users who would otherwise have to do this file by file.

* ********* Beginning of RDML commands **********
* ********* Copyright .....: (C)  Aspect Computing
* ********* Process .......: ASPUTIL
* ********* Function ......: ASPU003
* ********* Created by ....: Lis Kleijn
* ********* Created on ....: 15/01/96 at 08:08:59
* ********* Description ...: Load OTHER files  
* ********* ========================================
* ********* Working fields, lists and groups
* ********* =======================================
DEFINE     FIELD(#W_LIBN) TYPE(*CHAR) LENGTH(10) LABEL('Library name :') 
     DESC('Library name') COLHDG('Library')
             DEFAULT('QGPL')
DEFINE     FIELD(#W_LSTN) TYPE(*CHAR)
     LENGTH(10) LABEL('List name:')
     DESC('Saved list name')
DEFINE     FIELD(#W_CMD) TYPE(*CHAR)
     LENGTH(256) LABEL('Command line  :')
     DESC('Command') COLHDG('Command')
DEFINE     FIELD(#W_OPTN) TYPE(*CHAR)
     LENGTH(1) LABEL('Option') DESC('Option')
     COLHDG('Opt.')
DEFINE     FIELD(#W_FILN) TYPE(*CHAR)
     LENGTH(10) LABEL('File Name')
     DESC('File Name') COLHDG('File name')
     TO_OVERLAY(#ASPT01 24)
DEFINE     FIELD(#W_FTYP) TYPE(*CHAR)
     LENGTH( 2) LABEL('File Type')
     DESC('File Type') COLHDG('File type')
     TO_OVERLAY(#ASPT01 42)
DEFINE     FIELD(#W_FDES) TYPE(*CHAR)
     LENGTH(40) LABEL('File Desc.')
     DESC('File Description') COLHDG('File
     Description') TO_OVERLAY(#ASPT01 59)
* *********
* *********
=======================================================
* ********* Screen Panel Groups and Lists
* *********
=======================================================
DEF_LIST   NAME(#BL_FILLST) FIELDS((#W_OPTN
     *SELECT) (#W_FILN *OUT)(#W_FDES *OUT))
     COUNTER(#LISTCOUNT)
DEF_LIST   NAME(#WL_FILLST) FIELDS((#W_FILN)
     (#W_FDES)) COUNTER(#LISTENTRY)
     TYPE(*WORKING) ENTRYS(2000)
* *********
=======================================================
********** Program Mainline : ASPU003
**********
=======================================================
FUNCTION   OPTIONS(*DIRECT *DEFERWRITE
* ********* ...............................BATCH MODE
IF          COND('*JOBMODE = B')
EXECUTE     SUBROUTINE(AB_WRK_LST)
RETURN 
ENDIF 
* ********* ...............................INTERACTIVE
BEGIN_LOOP 
CHANGE     FIELD(#W_LIBN) TO(*DEFAULT)
* ********* Request library name
REQUEST    FIELDS((#W_LIBN *L5 *P20))
     DESIGN(*ACROSS) IDENTIFY(*LABEL)
BEGINCHECK
* ********* No library name - use existing
     workfile
IF_NULL    FIELD(#W_LIBN)
ELSE
* ********* Extract all filenames from
     selected library
USE         BUILTIN(CONCAT) WITH_ARGS('DSPOBJD
     OBJ(' #W_LIBN) TO_GET(#W_CMD)
USE         BUILTIN(TCONCAT) WITH_ARGS(#W_CMD
     '/*ALL) OBJTYPE(*FILE) OUTPUT(*OUTFILE)
     OUTFILE(QTEMP/FILELIST)')
     TO_GET(#W_CMD)
EXEC_OS400 COMMAND(#W_CMD) IF_ERROR(ER1)
* ********* Copy details to LANSA workfile
EXEC_OS400 COMMAND('CPYF FROMFILE(QTEMP/FILELIST)
  TOFILE(ASPWRKF)MBROPT(*REPLACE)
  INCREL((*IF ODOBAT *EQ PF)) FMTOPT(*NOCHK)')
  IF_ERROR(ER1)
GOTO        LABEL(NX1)
ER1   SET_ERROR  FOR_FIELD(#W_LIBN) MSGTXT('Library
     name not found. Try again')
ENDIF 
NX1   ENDCHECK 
* ********* Process LANSA workfile &
     build browse list 
OPEN        FILE(ASPWRKF) USE_OPTION(*IMMEDIATE)
CLR_LIST   NAMED(#BL_FILLST) 
SELECT      FIELDS((#ASPT01))FROM_FILE(ASPWRKF)
* ********* Ignore files with no description
IF_NULL    FIELD(#W_FDES)
ELSE
ADD_ENTRY  TO_LIST(#BL_FILLST)
ENDIF
ENDSELECT
* ********* Clear AS/400 messages such
     as number records copied etc
USE         BUILTIN(CLR_MESSAGES)
* ********* If entries in list - display
     else return to request
IF_NULL    FIELD(#LISTCOUNT)
MESSAGE    MSGTXT('No files found')
ELSE 
EXECUTE     SUBROUTINE(AA_DSP_LST) 
ENDIF  
END_LOOP  
* *********
=======================================================
* ********* Subroutine ....: AA_DSP_LST
* ********* Description....: Display
     list of files 
* *********
=======================================================
SUBROUTINE NAME(AA_DSP_LST) 
* ********* 
DISPLAY    FIELDS((#W_LIBN *OUT))
     BROWSELIST(#BL_FILLST) EXIT_KEY(*NO)
     MENU_KEY(*YES *RETURN) PROMPT_KEY(*NO)
     PANEL_ID(*NONE) PANEL_TITL('Select required
     files')
* ********* Initialize working list 
CLR_LIST   NAMED(#WL_FILLST)   
* ********* Move all selected filenames
     to working list  
BEGINCHECK  
SELECTLIST NAMED(#BL_FILLST)
     GET_ENTRYS(*SELECT)
ADD_ENTRY  TO_LIST(#WL_FILLST)
ENDSELECT 
* ********* If no names selected, display
     error message 
IF_NULL    FIELD(#LISTENTRY)  
SET_ERROR  FOR_FIELD(#W_OPTN) MSGTXT('No
     Entries have been selected')
ELSE 
* ********* Write working list to disk
     and start batch job 
USE         BUILTIN(SAVE_LIST)
     WITH_ARGS(#WL_FILLST 50 T 1)
     TO_GET(#W_LSTN)
SUBMIT      PROCESS(#PROCESS)
     FUNCTION(#FUNCTION)EXCHANGE(#W_LSTN #W_LIBN)
     OUTQ(*USRPRF)
ENDIF 
ENDCHECK
* ********* Clear AS/400 messages such
     as number records copied etc
USE         BUILTIN(CLR_MESSAGES) 
ENDROUTINE  
* *********
=======================================================
* ********* Subroutine ....: AB_WRK_LST
* ********* Description....: Process
     details in the list            
* *********
=======================================================
SUBROUTINE NAME(AB_WRK_LST)
* *********
USE         BUILTIN(RESTORE_SAVED_LIST)
      WITH_ARGS(#W_LSTN) TO_GET(#WL_FILLST)
SELECTLIST NAMED(#WL_FILLST)
USE         BUILTIN(START_FILE_EDIT)
      WITH_ARGS(#W_FILN #W_LIBN 'ASP' #W_FDES)
      TO_GET(#IO$STS)
IF_STATUS  IS_NOT(*OKAY)
EXECUTE     SUBROUTINE(BA_PRT_ERR)
ELSE
USE         BUILTIN(LOAD_OTHER_FILE)
      WITH_ARGS(20) TO_GET(#IO$STS)
IF_STATUS  IS_NOT(*OKAY)
EXECUTE     SUBROUTINE(BA_PRT_ERR)
ELSE  
USE         BUILTIN(END_FILE_EDIT)
      WITH_ARGS(Y)TO_GET(#IO£STS) 
IF_STATUS  IS_NOT(*OKAY) 
EXECUTE     SUBROUTINE(BA_PRT_ERR) 
ELSE  
USE         BUILTIN(MAKE_FILE_OPERATIONL)
      WITH_ARGS(#W_FILN #W_LIBN)
      TO_GET(#IO$STS)
ENDIF 
ENDIF  
ENDIF 
ENDSELECT  
* ********* List has been processed
      - delete   
USE         BUILTIN(DELETE_SAVED_LIST)
      WITH_ARGS(#W_LSTN) 
ENDROUTINE
* *********
======================================================
* ********* Subroutine ....:BA_PRT_ERR
* ********* Description....: Print errors
      from program queue
* *********
=======================================================
SUBROUTINE NAME(BA_PRT_ERR)
DEFINE      FIELD(#W_TEXT) TYPE(*CHAR)
      LENGTH(100) LABEL('Error :') 
DEF_LINE   NAME(#DL_ERR) FIELDS((#W_TEXT))
      IDENTIFY(*LABEL)
USE         BUILTIN(GET_MESSAGE) TO_GET(#IO$STS
      #W_TEXT)
DOWHILE    COND('#IO$STS *EQ OK')
PRINT       LINE(#DL_ERR)
USE         BUILTIN(GET_MESSAGE) TO_GET(#IO$STS
      #W_TEXT)
ENDWHILE 
USE         BUILTIN(CLR_MESSAGES)
ENDROUTINE 
****** End of RDML commands ******