Function SET015B: Export/Import Partition Prompt/Maintain
* =======================================================
* Process ........: SET_015
* Function .......: SET015B
* Created on .....: 03/03/00 at 13:00:02
* Description ....: Partition Prompt & Maintain
* Full Description: The purpose of this function is to
* maintain and allow prompting of the file of partitions
* 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_LSTPRT) Fields(#S_PART #S_PARTDES) 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_LSTPRT)
Select Fields(#S_LSTPRT) From_File(SETPRT)
Add_Entry To_List(#S_LSTPRT)
Endselect
* Display window until CANCEL or entry selected
Pop_Up Design(*DOWN) Down_Sep(001) Across_Sep(001) At_Loc(004 003) With_Size(075 011) Panel_Titl('Partition Prompt') Browselist(#S_LSTPRT) 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_LSTPRT)
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')
Exchange Fields(#S_PART)
Menu
Endcase
Endif
End_Loop
* =======================================================
* Subroutine ....: ADD$DATA
* Description ...: Add a new record to SETPRT
* =======================================================
Subroutine Name(ADD$DATA)
* Groups used in this subroutine
Group_By Name(#ADD$DATA) Fields(#S_PART #S_PARTDES)
* Set up and display the ADD screen
Message Msgid(DCU0010) Msgf(DC@M01) Msgdta('Partition')
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) Identify(*DESC) At_Loc(009 006) Panel_Titl('Create New Partition') Exit_Key(*NO) Menu_Key(*YES *RETURN) Prompt_Key(*NO) Cursor_Loc(*ATFIELD #S_PART)
Insert Fields(#ADD$DATA) To_File(SETPRT)
Change Field(#ADD$DATA) To(*DEFAULT)
Message Msgid(DCU0011) Msgf(DC@M01) Msgdta('Partition')
End_Loop
Endroutine
* =======================================================
* Subroutine ....: WORK$DATA
* Description ...: Work with detailed data from SETPRT
* =======================================================
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_PARTDES (#S_PART *OUT))
* Fetch full record details from file SETPRT
Change Field(#WORK$DATA) To(*NAVAIL)
Get_Entry Number(#LISTENTRY) From_List(#S_LSTPRT)
Fetch Fields(#WORK$DATA) From_File(SETPRT) With_Key(#S_PART)
If_Status Is_Not(*OKAY)
Message Msgid(DCU0016) Msgf(DC@M01) Msgdta('Partition')
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('Partition')
Otherwise
Return
Endcase
* Display full record details
Pop_Up Fields(#WORK$DATA) Design(*DOWN) Identify(*DESC) At_Loc(009 006) Panel_Titl('Maintain Partitions') Exit_Key(*NO) Menu_Key(*YES *RETURN) Prompt_Key(*NO) Cursor_Loc(*ATFIELD #S_PARTDES)
If_Mode Is(*CHANGE)
Update Fields(#WORK$DATA) In_File(SETPRT)
Endif
If_Mode Is(*DELETE)
Delete From_File(SETPRT)
Endif
Endroutine
* =======================================================
* Process ........: SET_015
* Function .......: SET015B
* Created on .....: 03/03/00 at 13:00:02
* Description ....: Partition Prompt & Maintain
* Full Description: The purpose of this function is to
* maintain and allow prompting of the file of partitions
* 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_LSTPRT) Fields(#S_PART #S_PARTDES) 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_LSTPRT)
Select Fields(#S_LSTPRT) From_File(SETPRT)
Add_Entry To_List(#S_LSTPRT)
Endselect
* Display window until CANCEL or entry selected
Pop_Up Design(*DOWN) Down_Sep(001) Across_Sep(001) At_Loc(004 003) With_Size(075 011) Panel_Titl('Partition Prompt') Browselist(#S_LSTPRT) 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_LSTPRT)
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')
Exchange Fields(#S_PART)
Menu
Endcase
Endif
End_Loop
* =======================================================
* Subroutine ....: ADD$DATA
* Description ...: Add a new record to SETPRT
* =======================================================
Subroutine Name(ADD$DATA)
* Groups used in this subroutine
Group_By Name(#ADD$DATA) Fields(#S_PART #S_PARTDES)
* Set up and display the ADD screen
Message Msgid(DCU0010) Msgf(DC@M01) Msgdta('Partition')
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) Identify(*DESC) At_Loc(009 006) Panel_Titl('Create New Partition') Exit_Key(*NO) Menu_Key(*YES *RETURN) Prompt_Key(*NO) Cursor_Loc(*ATFIELD #S_PART)
Insert Fields(#ADD$DATA) To_File(SETPRT)
Change Field(#ADD$DATA) To(*DEFAULT)
Message Msgid(DCU0011) Msgf(DC@M01) Msgdta('Partition')
End_Loop
Endroutine
* =======================================================
* Subroutine ....: WORK$DATA
* Description ...: Work with detailed data from SETPRT
* =======================================================
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_PARTDES (#S_PART *OUT))
* Fetch full record details from file SETPRT
Change Field(#WORK$DATA) To(*NAVAIL)
Get_Entry Number(#LISTENTRY) From_List(#S_LSTPRT)
Fetch Fields(#WORK$DATA) From_File(SETPRT) With_Key(#S_PART)
If_Status Is_Not(*OKAY)
Message Msgid(DCU0016) Msgf(DC@M01) Msgdta('Partition')
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('Partition')
Otherwise
Return
Endcase
* Display full record details
Pop_Up Fields(#WORK$DATA) Design(*DOWN) Identify(*DESC) At_Loc(009 006) Panel_Titl('Maintain Partitions') Exit_Key(*NO) Menu_Key(*YES *RETURN) Prompt_Key(*NO) Cursor_Loc(*ATFIELD #S_PARTDES)
If_Mode Is(*CHANGE)
Update Fields(#WORK$DATA) In_File(SETPRT)
Endif
If_Mode Is(*DELETE)
Delete From_File(SETPRT)
Endif
Endroutine