RDML for SET218A
* =======================================================
* Process ........: SET_218
* Function .......: SET218A
* Created on .....: 19/10/01 at 11:41:13
* Description ....: Function Skeleton
* Version.........: 1
*
* This function uses the FTP Client service
* to transfer files between AS/400s. It receives
* the list of files from either SET218G or SET218W and
* fields with user id, password and FTP Server info.
*
* Disclaimer: The following material is supplied as an
* example only. No warranty is expressed or implied.
*
* ======================================================*
Function Options(*DIRECT) Rcv_List(#FTP_FILES #FILNOTSNT)
*
Define Field(#KEYWORD) Reffld(#STD_TEXT)
Define Field(#KEYW_VAL1) Reffld(#STD_TEXTL)
Define Field(#KEYW_VAL2) Reffld(#STD_TEXTL)
*
Define Field(#MSGDTA) Type(*CHAR) Length(132)
Def_List Name(#FTP_FILES) Fields(#S_218ACTN #S_218FROM #S_218TO) Type(*WORKING)
*
Define Field(#FIL_ERROR) Reffld(#MSGDTA)
Define Field(#F_NOT_SNT) Reffld(#S_218FROM)
Def_List Name(#FILNOTSNT) Fields(#F_NOT_SNT #FIL_ERROR) Type(*WORKING)
*
Def_Cond Name(*FROMFILE) Cond('#s_218to = ''*FROMFILE''')
Group_By Name(#FTP_FIELD) Fields(#S_JSMSTS #S_JSMMSG #S_218USER #S_218PSWD #S_218FROM #S_218TO #S_218HOST)
*
Begin_Loop
* Load FTPCLIENT service
Execute Subroutine(START_CMD) With_Parms('SERVICE_LOAD')
Execute Subroutine(KEYWRD) With_Parms('SERVICE' 'FTPCLIENT' *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
Leave If('#s_jsmsts *ne OK')
*
* Connect to Host
Execute Subroutine(START_CMD) With_Parms('CONNECT')
Execute Subroutine(KEYWRD) With_Parms('HOST' #S_218HOST *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
Leave If('#s_jsmsts *ne OK')
*
* Login
Execute Subroutine(START_CMD) With_Parms('LOGIN')
Execute Subroutine(KEYWRD) With_Parms('USER' #S_218USER *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('PASSWORD' #S_218PSWD *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
Leave If('#s_jsmsts *ne OK')
*
* Change mode to binary
Execute Subroutine(START_CMD) With_Parms('BINARY')
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
Leave If('#s_jsmsts *ne OK')
*
* Put file (s)
Execute Subroutine(PUTGET_FIL)
*
Leave If('#s_jsmsts *ne OK')
*
* Quit
Execute Subroutine(START_CMD) With_Parms('QUIT')
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
Leave If('#s_jsmsts *ne OK')
*
* Unload service
Execute Subroutine(START_CMD) With_Parms('SERVICE_UNLOAD')
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
Leave
End_Loop
*
Exchange Fields(#FTP_FIELD #FTP_FILES #FILNOTSNT)
Return
*
* SUB ROUTINES
*
Subroutine Name(PUTGET_FIL)
*
Clr_List Named(#FILNOTSNT)
*
Selectlist Named(#FTP_FILES)
If Cond(*FROMFILE)
Change Field(#S_218TO) To(#S_218FROM)
Endif
*
Execute Subroutine(START_CMD) With_Parms(#S_218ACTN)
Execute Subroutine(KEYWRD) With_Parms('FROM' #S_218FROM *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('TO' #S_218TO *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
If Cond('#s_jsmsts *ne OK')
Change Field(#F_NOT_SNT) To(#S_218FROM)
Change Field(#FIL_ERROR) To(#S_JSMMSG)
Add_Entry To_List(#FILNOTSNT)
Change Field(#S_JSMSTS) To(OK)
Endif
Endselect
*
Endroutine
*
Subroutine Name(START_CMD) Parms((#STD_TEXTS *RECEIVED))
Change Field(#S_JSMCMD) To(#STD_TEXTS)
Endroutine
*
Subroutine Name(KEYWRD) Parms(#KEYWORD #KEYW_VAL1 #KEYW_VAL2)
Use Builtin(BCONCAT) With_Args(#S_JSMCMD #KEYWORD) To_Get(#S_JSMCMD)
Use Builtin(TCONCAT) With_Args(#S_JSMCMD '(' #KEYW_VAL1 #KEYW_VAL2 ')') To_Get(#S_JSMCMD)
Endroutine
*
* =======================================================
* Process ........: SET_218
* Function .......: SET218A
* Created on .....: 19/10/01 at 11:41:13
* Description ....: Function Skeleton
* Version.........: 1
*
* This function uses the FTP Client service
* to transfer files between AS/400s. It receives
* the list of files from either SET218G or SET218W and
* fields with user id, password and FTP Server info.
*
* Disclaimer: The following material is supplied as an
* example only. No warranty is expressed or implied.
*
* ======================================================*
Function Options(*DIRECT) Rcv_List(#FTP_FILES #FILNOTSNT)
*
Define Field(#KEYWORD) Reffld(#STD_TEXT)
Define Field(#KEYW_VAL1) Reffld(#STD_TEXTL)
Define Field(#KEYW_VAL2) Reffld(#STD_TEXTL)
*
Define Field(#MSGDTA) Type(*CHAR) Length(132)
Def_List Name(#FTP_FILES) Fields(#S_218ACTN #S_218FROM #S_218TO) Type(*WORKING)
*
Define Field(#FIL_ERROR) Reffld(#MSGDTA)
Define Field(#F_NOT_SNT) Reffld(#S_218FROM)
Def_List Name(#FILNOTSNT) Fields(#F_NOT_SNT #FIL_ERROR) Type(*WORKING)
*
Def_Cond Name(*FROMFILE) Cond('#s_218to = ''*FROMFILE''')
Group_By Name(#FTP_FIELD) Fields(#S_JSMSTS #S_JSMMSG #S_218USER #S_218PSWD #S_218FROM #S_218TO #S_218HOST)
*
Begin_Loop
* Load FTPCLIENT service
Execute Subroutine(START_CMD) With_Parms('SERVICE_LOAD')
Execute Subroutine(KEYWRD) With_Parms('SERVICE' 'FTPCLIENT' *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
Leave If('#s_jsmsts *ne OK')
*
* Connect to Host
Execute Subroutine(START_CMD) With_Parms('CONNECT')
Execute Subroutine(KEYWRD) With_Parms('HOST' #S_218HOST *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
Leave If('#s_jsmsts *ne OK')
*
* Login
Execute Subroutine(START_CMD) With_Parms('LOGIN')
Execute Subroutine(KEYWRD) With_Parms('USER' #S_218USER *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('PASSWORD' #S_218PSWD *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
Leave If('#s_jsmsts *ne OK')
*
* Change mode to binary
Execute Subroutine(START_CMD) With_Parms('BINARY')
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
Leave If('#s_jsmsts *ne OK')
*
* Put file (s)
Execute Subroutine(PUTGET_FIL)
*
Leave If('#s_jsmsts *ne OK')
*
* Quit
Execute Subroutine(START_CMD) With_Parms('QUIT')
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
Leave If('#s_jsmsts *ne OK')
*
* Unload service
Execute Subroutine(START_CMD) With_Parms('SERVICE_UNLOAD')
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
Leave
End_Loop
*
Exchange Fields(#FTP_FIELD #FTP_FILES #FILNOTSNT)
Return
*
* SUB ROUTINES
*
Subroutine Name(PUTGET_FIL)
*
Clr_List Named(#FILNOTSNT)
*
Selectlist Named(#FTP_FILES)
If Cond(*FROMFILE)
Change Field(#S_218TO) To(#S_218FROM)
Endif
*
Execute Subroutine(START_CMD) With_Parms(#S_218ACTN)
Execute Subroutine(KEYWRD) With_Parms('FROM' #S_218FROM *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('TO' #S_218TO *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
*
If Cond('#s_jsmsts *ne OK')
Change Field(#F_NOT_SNT) To(#S_218FROM)
Change Field(#FIL_ERROR) To(#S_JSMMSG)
Add_Entry To_List(#FILNOTSNT)
Change Field(#S_JSMSTS) To(OK)
Endif
Endselect
*
Endroutine
*
Subroutine Name(START_CMD) Parms((#STD_TEXTS *RECEIVED))
Change Field(#S_JSMCMD) To(#STD_TEXTS)
Endroutine
*
Subroutine Name(KEYWRD) Parms(#KEYWORD #KEYW_VAL1 #KEYW_VAL2)
Use Builtin(BCONCAT) With_Args(#S_JSMCMD #KEYWORD) To_Get(#S_JSMCMD)
Use Builtin(TCONCAT) With_Args(#S_JSMCMD '(' #KEYW_VAL1 #KEYW_VAL2 ')') To_Get(#S_JSMCMD)
Endroutine
*