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 ******