Function SET015C: Export/Import Path Prompt/Maintain
* =======================================================
* Process ........: SET_015
* Function .......: SET015C
* Created on .....: 03/03/00 at 13:00:02
* Description ....: Partition Combinatn Prompt & Maintain
* Full Description: The purpose of this function is to
* maintain and allow prompting of the file of valid
* partition combinations used by export import function
* SET015A
*
* Disclaimer: The following material is supplied as
* sample material only. No warranty concerning the
* material or its use in any way whatsoever is
* expressed or implied.
*
* Minimum LANSA release: 8.0
*
* =======================================================
Function Options(*DEFERWRITE *DIRECT *CLOSE_DISPLAY)
* Options, work variables, conditions and working lists
Def_List Name(#S_LSTCMB) Fields(#S_PARTFRM #S_PARTTO1 #S_PARTTO2 #S_EXIMDES) Sel_Entry(#LISTENTRY)
* =======================================================
* PROGRAM MAINLINE
* =======================================================
Def_Cond Name(*AS400) Cond('*CPUTYPE = AS400')
If Cond(*AS400)
Else
Message Msgtxt('Not available on PC')
Menu
Endif
Begin_Loop
* Build list for display in window
Set_Mode To(*DISPLAY)
Clr_List Named(#S_LSTCMB)
Select Fields(#S_LSTCMB) From_File(SETEXP)
Add_Entry To_List(#S_LSTCMB)
Endselect
* Display window until CANCEL or entry selected
Pop_Up Design(*DOWN) Down_Sep(001) Across_Sep(001) At_Loc(003 003) With_Size(075 013) Panel_Titl('Partition Combinations Prompt') Browselist(#S_LSTCMB) Exit_Key(*NO) Add_Key(*YES) Prompt_Key(*NO) User_Keys((21 'Change' *NEXT *NONE)(22 'Delete')) Cursor_Loc(*ATFIELD #S_PART)
If Cond('(#LISTENTRY *GT 0) *OR (#IO$key *EQ ''06'')')
If Cond('#LISTENTRY *GT 0')
Get_Entry Number(#LISTENTRY) From_List(#S_LSTCMB)
Endif
*
Case Of_Field(#IO$KEY)
* When the ADD key is used
When Value_Is('= ''06''')
Execute Subroutine(ADD$DATA)
* When the CHANGE key is used
When Value_Is('= ''21''')
Execute Subroutine(WORK$DATA) With_Parms(CHG)
* When the DELETE key is used
When Value_Is('= ''22''')
Execute Subroutine(WORK$DATA) With_Parms(DLT)
* When the user selects an entry and presses enter
When Value_Is('= RA')
Change Field(#S_PRTPF1) To(#S_PARTFRM)
Change Field(#S_PRTPT1) To(#S_PARTTO1)
Change Field(#S_PRTPT2) To(#S_PARTTO2)
Exchange Fields(#S_PRTPF1 #S_PRTPT1 #S_PRTPT2)
Menu
Endcase
Endif
End_Loop
* =======================================================
* Subroutine ....: ADD$DATA
* Description ...: Add a new record to SETEXP
* =======================================================
Subroutine Name(ADD$DATA)
* Groups used in this subroutine
Group_By Name(#ADD$DATA) Fields(#S_PARTFRM #S_PARTTO1 #S_PARTTO2 #S_EXIMDES)
* Set up and display the ADD screen
Message Msgid(DCU0010) Msgf(DC@M01) Msgdta('Export/Import')
Change Field(#ADD$DATA) To(*DEFAULT)
Set_Mode To(*ADD)
* Do data entry until user exits with CANCEL key
Begin_Loop
Pop_Up Fields(#ADD$DATA) Design(*DOWN) Down_Sep(001) Across_Sep(001) At_Loc(006 016) With_Size(060 009) Panel_Titl('Create New Export/Import') Exit_Key(*NO) Menu_Key(*YES *RETURN) Cursor_Loc(*ATFIELD #S_PARTFRM)
Insert Fields(#ADD$DATA) To_File(SETEXP)
Change Field(#ADD$DATA) To(*DEFAULT)
Message Msgid(DCU0011) Msgf(DC@M01) Msgdta('Export/Import')
End_Loop
Endroutine
* =======================================================
* Subroutine ....: WORK$DATA
* Description ...: Work with detailed data from SETEXP
* =======================================================
Subroutine Name(WORK$DATA) Parms(#WORK$OPT)
* Groups and work fields used in this subroutine
Define Field(#WORK$OPT) Type(*CHAR) Length(003)
Group_By Name(#WORK$DATA) Fields(#S_EXIMDES (#S_PARTFRM *OUT) (#S_PARTTO1 *OUT) (#S_PARTTO2 *OUT))
* Fetch full record details from file SETEXP
Change Field(#WORK$DATA) To(*NAVAIL)
Get_Entry Number(#LISTENTRY) From_List(#S_LSTCMB)
Fetch Fields(#WORK$DATA) From_File(SETEXP) With_Key(#S_PARTFRM #S_PARTTO1 #S_PARTTO2)
If_Status Is_Not(*OKAY)
Message Msgid(DCU0016) Msgf(DC@M01) Msgdta('Export/Import')
Return
Endif
* Set screen to the correct mode
Case Of_Field(#WORK$OPT)
When Value_Is('= CHG')
Set_Mode To(*CHANGE)
When Value_Is('= DLT')
Set_Mode To(*DELETE)
Message Msgid(DCU0015) Msgf(DC@M01) Msgdta('Export/Import')
Otherwise
Return
Endcase
* Display full record details
Pop_Up Fields(#WORK$DATA) Design(*DOWN) Down_Sep(001) Across_Sep(001) At_Loc(008 017) With_Size(060 009) Panel_Titl('Maintain Export/Imports') Exit_Key(*NO) Menu_Key(*YES *RETURN) Cursor_Loc(*ATFIELD #S_EXIMDES)
If_Mode Is(*CHANGE)
Update Fields(#WORK$DATA) In_File(SETEXP)
Endif
If_Mode Is(*DELETE)
Delete From_File(SETEXP)
Endif
Endroutine
* =======================================================
* Process ........: SET_015
* Function .......: SET015C
* Created on .....: 03/03/00 at 13:00:02
* Description ....: Partition Combinatn Prompt & Maintain
* Full Description: The purpose of this function is to
* maintain and allow prompting of the file of valid
* partition combinations used by export import function
* SET015A
*
* Disclaimer: The following material is supplied as
* sample material only. No warranty concerning the
* material or its use in any way whatsoever is
* expressed or implied.
*
* Minimum LANSA release: 8.0
*
* =======================================================
Function Options(*DEFERWRITE *DIRECT *CLOSE_DISPLAY)
* Options, work variables, conditions and working lists
Def_List Name(#S_LSTCMB) Fields(#S_PARTFRM #S_PARTTO1 #S_PARTTO2 #S_EXIMDES) Sel_Entry(#LISTENTRY)
* =======================================================
* PROGRAM MAINLINE
* =======================================================
Def_Cond Name(*AS400) Cond('*CPUTYPE = AS400')
If Cond(*AS400)
Else
Message Msgtxt('Not available on PC')
Menu
Endif
Begin_Loop
* Build list for display in window
Set_Mode To(*DISPLAY)
Clr_List Named(#S_LSTCMB)
Select Fields(#S_LSTCMB) From_File(SETEXP)
Add_Entry To_List(#S_LSTCMB)
Endselect
* Display window until CANCEL or entry selected
Pop_Up Design(*DOWN) Down_Sep(001) Across_Sep(001) At_Loc(003 003) With_Size(075 013) Panel_Titl('Partition Combinations Prompt') Browselist(#S_LSTCMB) Exit_Key(*NO) Add_Key(*YES) Prompt_Key(*NO) User_Keys((21 'Change' *NEXT *NONE)(22 'Delete')) Cursor_Loc(*ATFIELD #S_PART)
If Cond('(#LISTENTRY *GT 0) *OR (#IO$key *EQ ''06'')')
If Cond('#LISTENTRY *GT 0')
Get_Entry Number(#LISTENTRY) From_List(#S_LSTCMB)
Endif
*
Case Of_Field(#IO$KEY)
* When the ADD key is used
When Value_Is('= ''06''')
Execute Subroutine(ADD$DATA)
* When the CHANGE key is used
When Value_Is('= ''21''')
Execute Subroutine(WORK$DATA) With_Parms(CHG)
* When the DELETE key is used
When Value_Is('= ''22''')
Execute Subroutine(WORK$DATA) With_Parms(DLT)
* When the user selects an entry and presses enter
When Value_Is('= RA')
Change Field(#S_PRTPF1) To(#S_PARTFRM)
Change Field(#S_PRTPT1) To(#S_PARTTO1)
Change Field(#S_PRTPT2) To(#S_PARTTO2)
Exchange Fields(#S_PRTPF1 #S_PRTPT1 #S_PRTPT2)
Menu
Endcase
Endif
End_Loop
* =======================================================
* Subroutine ....: ADD$DATA
* Description ...: Add a new record to SETEXP
* =======================================================
Subroutine Name(ADD$DATA)
* Groups used in this subroutine
Group_By Name(#ADD$DATA) Fields(#S_PARTFRM #S_PARTTO1 #S_PARTTO2 #S_EXIMDES)
* Set up and display the ADD screen
Message Msgid(DCU0010) Msgf(DC@M01) Msgdta('Export/Import')
Change Field(#ADD$DATA) To(*DEFAULT)
Set_Mode To(*ADD)
* Do data entry until user exits with CANCEL key
Begin_Loop
Pop_Up Fields(#ADD$DATA) Design(*DOWN) Down_Sep(001) Across_Sep(001) At_Loc(006 016) With_Size(060 009) Panel_Titl('Create New Export/Import') Exit_Key(*NO) Menu_Key(*YES *RETURN) Cursor_Loc(*ATFIELD #S_PARTFRM)
Insert Fields(#ADD$DATA) To_File(SETEXP)
Change Field(#ADD$DATA) To(*DEFAULT)
Message Msgid(DCU0011) Msgf(DC@M01) Msgdta('Export/Import')
End_Loop
Endroutine
* =======================================================
* Subroutine ....: WORK$DATA
* Description ...: Work with detailed data from SETEXP
* =======================================================
Subroutine Name(WORK$DATA) Parms(#WORK$OPT)
* Groups and work fields used in this subroutine
Define Field(#WORK$OPT) Type(*CHAR) Length(003)
Group_By Name(#WORK$DATA) Fields(#S_EXIMDES (#S_PARTFRM *OUT) (#S_PARTTO1 *OUT) (#S_PARTTO2 *OUT))
* Fetch full record details from file SETEXP
Change Field(#WORK$DATA) To(*NAVAIL)
Get_Entry Number(#LISTENTRY) From_List(#S_LSTCMB)
Fetch Fields(#WORK$DATA) From_File(SETEXP) With_Key(#S_PARTFRM #S_PARTTO1 #S_PARTTO2)
If_Status Is_Not(*OKAY)
Message Msgid(DCU0016) Msgf(DC@M01) Msgdta('Export/Import')
Return
Endif
* Set screen to the correct mode
Case Of_Field(#WORK$OPT)
When Value_Is('= CHG')
Set_Mode To(*CHANGE)
When Value_Is('= DLT')
Set_Mode To(*DELETE)
Message Msgid(DCU0015) Msgf(DC@M01) Msgdta('Export/Import')
Otherwise
Return
Endcase
* Display full record details
Pop_Up Fields(#WORK$DATA) Design(*DOWN) Down_Sep(001) Across_Sep(001) At_Loc(008 017) With_Size(060 009) Panel_Titl('Maintain Export/Imports') Exit_Key(*NO) Menu_Key(*YES *RETURN) Cursor_Loc(*ATFIELD #S_EXIMDES)
If_Mode Is(*CHANGE)
Update Fields(#WORK$DATA) In_File(SETEXP)
Endif
If_Mode Is(*DELETE)
Delete From_File(SETEXP)
Endif
Endroutine