RDML for SET218A

LANSA

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
*