RDML for SET218G
* =======================================================
* Process ........: SET_218
* Function .......: SET218G
* Created on .....: 19/10/01 at 11:41:13
* Description ....: Function Skeleton
* Version.........: 1
*
* This is a 5250 green screen User Interface
* to the FTP transfer files example SET218A.
*
* Disclaimer: The following material is supplied as an
* example only. No warranty is expressed or implied.
*
* ======================================================*
Function Options(*DIRECT)
*
Define Field(#MSGDTA) Type(*CHAR) Length(132)
Define Field(#FIL_ERROR) Reffld(#MSGDTA)
*
* Exchanged fields
Group_By Name(#FTP_FIELD) Fields(#S_JSMSTS #S_JSMMSG #S_218USER #S_218PSWD #S_218FROM #S_218TO #S_218HOST)
*
Group_By Name(#PANELDATA) Fields((#STD_INSTR *OUTPUT *NOID) (#STD_INST2 *NOID *OUTPUT) #S_218USER #S_218PSWD #S_218HOST)
*
Override Field(#S_218FROM) Label('From')
Override Field(#S_218TO) Label('To')
Define Field(#F_NOT_SNT) Reffld(#S_218FROM)
Group_By Name(#DFT_FIELD) Fields(#S_218TO)
Define Field(#FILECOUNT) Reffld(#LISTCOUNT)
*
* Browselist to type in the fully qualified paths of the
* files to transfer
Def_List Name(#S_218FTPF) Fields((#S_218ACTN *P2) (#S_218FROM *P13) (#S_218TO *P7))
* Working list with file paths specified in S_218FTPF
Def_List Name(#FTP_FILES) Fields(#S_218ACTN #S_218FROM #S_218TO) Counter(#FILECOUNT) Type(*WORKING)
Def_List Name(#FILNOTSNT) Fields(#F_NOT_SNT #FIL_ERROR) Type(*WORKING)
*
Def_Cond Name(*VAL_ERROR) Cond('(#S_218HOST = *BLANKS) OR (#S_218USER = *BLANKS) OR (#S_218PSWD = *BLANKS) OR (#FILECOUNT = *ZEROS)')
*
Def_Cond Name(*FTP_ERROR) Cond('#S_JSMSTS *NE OK')
*
Change Field(#STD_INSTR) To('''Type in FTP Server, User and Password and fully qualified path of the files to transfer.''')
Change Field(#STD_INST2) To('''You can PUT or GET filres. *FROMFILE means put the files in the same place as the From File.''')
*
* Change the host field to the value of the SET system
* variable S_HOSTURL. This variable is used across the
* SET collection to hold the value of the host location.
* Depending on whether you have executed other SET
* examples, this variable might or might not have a value
* If it has a value, concatenate it with the host port
* value held in a system variable with the same
* functionality as S_HOSTURL
Execute Subroutine(SET_HOST)
*
Change Field(#S_218TO) To(*DEFAULT)
Change Field(#S_218ACTN) To(PUT)
Inz_List Named(#S_218FTPF) Num_Entrys(0000003) With_Mode(*ADD)
*
* Call SETJSMO to open JSM
Execute Subroutine(OP_CL_JSM) With_Parms(OPEN)
*
* Loop until F12
Begin_Loop
*
Request Fields(#PANELDATA) Browselist(#S_218FTPF) Prompt_Key(*NO)
*
Use Builtin(CLR_MESSAGES) With_Args(Y)
*
Execute Subroutine(VAL_INPUT)
*
If Cond(*VAL_ERROR)
Message Msgtxt('One or more required entries left blank.')
Else
*
* Call SET218A to perform the file transfer
Execute Subroutine(SEND_FILE)
*
If Cond(*FTP_ERROR)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#S_JSMMSG)
Else
Message Msgtxt('File(s) successfully sent')
Endif
* Close JSM
Endif
End_Loop
*
CLS: Execute Subroutine(OP_CL_JSM) With_Parms(CLOSE)
*
*
Subroutine Name(VAL_INPUT)
Selectlist Named(#S_218FTPF)
Continue If('#S_218FROM = *BLANKS')
Add_Entry To_List(#FTP_FILES)
Endselect
Endroutine
*
Subroutine Name(SEND_FILE)
Exchange Fields(#FTP_FIELD)
Call Process(*DIRECT) Function(SET218A) Exit_Used(*NEXT) Menu_Used(*NEXT) Pass_Lst(#FTP_FILES #FILNOTSNT)
*
Selectlist Named(#FILNOTSNT)
Use Builtin(BCONCAT) With_Args(#F_NOT_SNT 'not sent.') To_Get(#MSGDTA)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#MSGDTA)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#FIL_ERROR)
Endselect
Endroutine
*
Subroutine Name(SET_HOST)
Change Field(#S_218HOST) To(*S_HOSTURL)
If Cond('#S_218HOST *NE *BLANKS')
Use Builtin(TCONCAT) With_Args(#S_214HOST ':' *S_HOSTPORT) To_Get(#S_214HOST)
Endif
Endroutine
*
Subroutine Name(OP_CL_JSM) Parms((#W_ACTION *RECEIVED))
Define Field(#W_ACTION) Type(*CHAR) Length(005)
Group_By Name(#S_EXCHFLD) Fields(#S_JSMSTS #S_JSMMSG #W_ACTION)
Exchange Fields(#S_EXCHFLD)
Call Process(*DIRECT) Function(SETJSMO) Exit_Used(*NEXT) Menu_Used(*NEXT)
Endroutine
*
* =======================================================
* Process ........: SET_218
* Function .......: SET218G
* Created on .....: 19/10/01 at 11:41:13
* Description ....: Function Skeleton
* Version.........: 1
*
* This is a 5250 green screen User Interface
* to the FTP transfer files example SET218A.
*
* Disclaimer: The following material is supplied as an
* example only. No warranty is expressed or implied.
*
* ======================================================*
Function Options(*DIRECT)
*
Define Field(#MSGDTA) Type(*CHAR) Length(132)
Define Field(#FIL_ERROR) Reffld(#MSGDTA)
*
* Exchanged fields
Group_By Name(#FTP_FIELD) Fields(#S_JSMSTS #S_JSMMSG #S_218USER #S_218PSWD #S_218FROM #S_218TO #S_218HOST)
*
Group_By Name(#PANELDATA) Fields((#STD_INSTR *OUTPUT *NOID) (#STD_INST2 *NOID *OUTPUT) #S_218USER #S_218PSWD #S_218HOST)
*
Override Field(#S_218FROM) Label('From')
Override Field(#S_218TO) Label('To')
Define Field(#F_NOT_SNT) Reffld(#S_218FROM)
Group_By Name(#DFT_FIELD) Fields(#S_218TO)
Define Field(#FILECOUNT) Reffld(#LISTCOUNT)
*
* Browselist to type in the fully qualified paths of the
* files to transfer
Def_List Name(#S_218FTPF) Fields((#S_218ACTN *P2) (#S_218FROM *P13) (#S_218TO *P7))
* Working list with file paths specified in S_218FTPF
Def_List Name(#FTP_FILES) Fields(#S_218ACTN #S_218FROM #S_218TO) Counter(#FILECOUNT) Type(*WORKING)
Def_List Name(#FILNOTSNT) Fields(#F_NOT_SNT #FIL_ERROR) Type(*WORKING)
*
Def_Cond Name(*VAL_ERROR) Cond('(#S_218HOST = *BLANKS) OR (#S_218USER = *BLANKS) OR (#S_218PSWD = *BLANKS) OR (#FILECOUNT = *ZEROS)')
*
Def_Cond Name(*FTP_ERROR) Cond('#S_JSMSTS *NE OK')
*
Change Field(#STD_INSTR) To('''Type in FTP Server, User and Password and fully qualified path of the files to transfer.''')
Change Field(#STD_INST2) To('''You can PUT or GET filres. *FROMFILE means put the files in the same place as the From File.''')
*
* Change the host field to the value of the SET system
* variable S_HOSTURL. This variable is used across the
* SET collection to hold the value of the host location.
* Depending on whether you have executed other SET
* examples, this variable might or might not have a value
* If it has a value, concatenate it with the host port
* value held in a system variable with the same
* functionality as S_HOSTURL
Execute Subroutine(SET_HOST)
*
Change Field(#S_218TO) To(*DEFAULT)
Change Field(#S_218ACTN) To(PUT)
Inz_List Named(#S_218FTPF) Num_Entrys(0000003) With_Mode(*ADD)
*
* Call SETJSMO to open JSM
Execute Subroutine(OP_CL_JSM) With_Parms(OPEN)
*
* Loop until F12
Begin_Loop
*
Request Fields(#PANELDATA) Browselist(#S_218FTPF) Prompt_Key(*NO)
*
Use Builtin(CLR_MESSAGES) With_Args(Y)
*
Execute Subroutine(VAL_INPUT)
*
If Cond(*VAL_ERROR)
Message Msgtxt('One or more required entries left blank.')
Else
*
* Call SET218A to perform the file transfer
Execute Subroutine(SEND_FILE)
*
If Cond(*FTP_ERROR)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#S_JSMMSG)
Else
Message Msgtxt('File(s) successfully sent')
Endif
* Close JSM
Endif
End_Loop
*
CLS: Execute Subroutine(OP_CL_JSM) With_Parms(CLOSE)
*
*
Subroutine Name(VAL_INPUT)
Selectlist Named(#S_218FTPF)
Continue If('#S_218FROM = *BLANKS')
Add_Entry To_List(#FTP_FILES)
Endselect
Endroutine
*
Subroutine Name(SEND_FILE)
Exchange Fields(#FTP_FIELD)
Call Process(*DIRECT) Function(SET218A) Exit_Used(*NEXT) Menu_Used(*NEXT) Pass_Lst(#FTP_FILES #FILNOTSNT)
*
Selectlist Named(#FILNOTSNT)
Use Builtin(BCONCAT) With_Args(#F_NOT_SNT 'not sent.') To_Get(#MSGDTA)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#MSGDTA)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#FIL_ERROR)
Endselect
Endroutine
*
Subroutine Name(SET_HOST)
Change Field(#S_218HOST) To(*S_HOSTURL)
If Cond('#S_218HOST *NE *BLANKS')
Use Builtin(TCONCAT) With_Args(#S_214HOST ':' *S_HOSTPORT) To_Get(#S_214HOST)
Endif
Endroutine
*
Subroutine Name(OP_CL_JSM) Parms((#W_ACTION *RECEIVED))
Define Field(#W_ACTION) Type(*CHAR) Length(005)
Group_By Name(#S_EXCHFLD) Fields(#S_JSMSTS #S_JSMMSG #W_ACTION)
Exchange Fields(#S_EXCHFLD)
Call Process(*DIRECT) Function(SETJSMO) Exit_Used(*NEXT) Menu_Used(*NEXT)
Endroutine
*