Function SET178U Prompt (& maintain) Sub-Type
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_178);
********** COMMENT(Function .......: SET178V);
********** COMMENT(Created on .....: 03/03/00 at 13:00:02);
********** COMMENT(Description ....: Sub-Type Prompt & Maintain);
********** COMMENT(Full Description: The purpose of this function is to);
********** COMMENT(maintain and allow prompting of the Sub-Type file used);
********** COMMENT(in the static page computer products example);
********** COMMENT();
********** COMMENT(Disclaimer: The following material is supplied as);
********** COMMENT(sample material only. No warranty concerning the);
********** COMMENT(material or its use in any way whatsoever is);
********** COMMENT(expressed or implied.);
********** COMMENT();
********** COMMENT(Minimum LANSA release: 8.0);
********** COMMENT();
********** COMMENT(=======================================================);
FUNCTION OPTIONS(*DEFERWRITE *DIRECT *CLOSE_DISPLAY);
********** COMMENT(Options, work variables, conditions and working lists);
DEF_LIST NAME(#S_LSTSUBT) FIELDS((#S_178DVTP)(#S_178SBTP)) SEL_ENTRY(#LISTENTRY);
********** COMMENT(=======================================================);
********** COMMENT(PROGRAM MAINLINE);
********** COMMENT(=======================================================);
DEF_COND NAME(*AS400) COND('*CPUTYPE = AS400');
IF COND(*AS400);
ELSE;
MESSAGE MSGTXT('Not available on PC');
MENU;
ENDIF;
BEGIN_LOOP;
********** COMMENT(Build list for display in window);
SET_MODE TO(*DISPLAY);
CLR_LIST NAMED(#S_LSTSUBT);
SELECT FIELDS(#S_LSTSUBT) FROM_FILE(SETSUB);
ADD_ENTRY TO_LIST(#S_LSTSUBT);
ENDSELECT;
********** COMMENT(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('SUBTYPE Prompt') BROWSELIST(#S_LSTSUBT) EXIT_KEY(*NO) ADD_KEY(*YES) PROMPT_KEY(*NO) USER_KEYS((21 'Change' *NEXT *NONE)(22 'Delete')) CURSOR_LOC(*ATFIELD #S_178DVTP);
********** COMMENT();
IF COND('(#LISTENTRY *GT 0) *OR (#IO$KEY *EQ ''06'')');
IF COND('#LISTENTRY *GT 0');
GET_ENTRY NUMBER(#LISTENTRY) FROM_LIST(#S_LSTSUBT);
ENDIF;
********** COMMENT();
CASE OF_FIELD(#IO$KEY);
********** COMMENT(When the ADD key is used);
WHEN VALUE_IS('= ''06''');
EXECUTE SUBROUTINE(ADD$DATA);
********** COMMENT(When the CHANGE key is used);
WHEN VALUE_IS('= ''21''');
EXECUTE SUBROUTINE(WORK$DATA) WITH_PARMS(CHG);
********** COMMENT(When the DELETE key is used);
WHEN VALUE_IS('= ''22''');
EXECUTE SUBROUTINE(WORK$DATA) WITH_PARMS(DLT);
********** COMMENT(When the user selects an entry and presses enter);
WHEN VALUE_IS('= RA');
EXCHANGE FIELDS(#S_178DVTP #S_178SBTP);
MENU;
ENDCASE;
ENDIF;
END_LOOP;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: ADD$DATA);
********** COMMENT(Description ...: Add a new record to SETSUB);
********** COMMENT(=======================================================);
SUBROUTINE NAME(ADD$DATA);
********** COMMENT(Groups used in this subroutine);
GROUP_BY NAME(#ADD$DATA) FIELDS((#S_178DVTP)(#S_178SBTP)(#S_178SBPG));
********** COMMENT(Set up and display the ADD screen);
MESSAGE MSGID(DCU0010) MSGF(DC@M01) MSGDTA('SUBTYPE');
CHANGE FIELD(#ADD$DATA) TO(*DEFAULT);
SET_MODE TO(*ADD);
********** COMMENT(Do data entry until user exits with CANCEL key);
BEGIN_LOOP;
POP_UP FIELDS(#ADD$DATA) DESIGN(*DOWN) IDENTIFY(*DESC) AT_LOC(009 006) WITH_SIZE(*AUTO) PANEL_TITL('Create New SUBTYPE') EXIT_KEY(*NO) MENU_KEY(*YES *RETURN) PROMPT_KEY(*NO) CURSOR_LOC(*ATFIELD #S_178DVTP);
INSERT FIELDS(#ADD$DATA) TO_FILE(SETSUB);
CHANGE FIELD(#ADD$DATA) TO(*DEFAULT);
MESSAGE MSGID(DCU0011) MSGF(DC@M01) MSGDTA('SUBTYPE');
END_LOOP;
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: WORK$DATA);
********** COMMENT(Description ...: Work with detailed data from SETSUB);
********** COMMENT(=======================================================);
SUBROUTINE NAME(WORK$DATA) PARMS((#WORK$OPT));
********** COMMENT(Groups and work fields used in this subroutine);
DEFINE FIELD(#WORK$OPT) TYPE(*CHAR) LENGTH(003);
GROUP_BY NAME(#WORK$DATA) FIELDS((#S_178DVTP *OUT)(#S_178SBTP)(#S_178SBPG));
********** COMMENT(Fetch full record details from file SETSUB);
CHANGE FIELD(#WORK$DATA) TO(*NAVAIL);
GET_ENTRY NUMBER(#LISTENTRY) FROM_LIST(#S_LSTSUBT);
FETCH FIELDS(#WORK$DATA) FROM_FILE(SETSUB) WITH_KEY(#S_178DVTP #S_178SBTP);
IF_STATUS IS_NOT(*OKAY);
MESSAGE MSGID(DCU0016) MSGF(DC@M01) MSGDTA('SUBTYPE');
RETURN;
ENDIF;
********** COMMENT(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('SUBTYPE');
OTHERWISE;
RETURN;
ENDCASE;
********** COMMENT(Display full record details);
POP_UP FIELDS(#WORK$DATA) DESIGN(*DOWN) IDENTIFY(*DESC) AT_LOC(009 006) WITH_SIZE(*AUTO) PANEL_TITL('Maintain SUBTYPEs') EXIT_KEY(*NO) MENU_KEY(*YES *RETURN) PROMPT_KEY(*NO) CURSOR_LOC(*ATFIELD #S_178SBPG);
IF_MODE IS(*CHANGE);
UPDATE FIELDS(#WORK$DATA) IN_FILE(SETSUB);
ENDIF;
IF_MODE IS(*DELETE);
DELETE FROM_FILE(SETSUB);
ENDIF;
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_178);
********** COMMENT(Function .......: SET178V);
********** COMMENT(Created on .....: 03/03/00 at 13:00:02);
********** COMMENT(Description ....: Sub-Type Prompt & Maintain);
********** COMMENT(Full Description: The purpose of this function is to);
********** COMMENT(maintain and allow prompting of the Sub-Type file used);
********** COMMENT(in the static page computer products example);
********** COMMENT();
********** COMMENT(Disclaimer: The following material is supplied as);
********** COMMENT(sample material only. No warranty concerning the);
********** COMMENT(material or its use in any way whatsoever is);
********** COMMENT(expressed or implied.);
********** COMMENT();
********** COMMENT(Minimum LANSA release: 8.0);
********** COMMENT();
********** COMMENT(=======================================================);
FUNCTION OPTIONS(*DEFERWRITE *DIRECT *CLOSE_DISPLAY);
********** COMMENT(Options, work variables, conditions and working lists);
DEF_LIST NAME(#S_LSTSUBT) FIELDS((#S_178DVTP)(#S_178SBTP)) SEL_ENTRY(#LISTENTRY);
********** COMMENT(=======================================================);
********** COMMENT(PROGRAM MAINLINE);
********** COMMENT(=======================================================);
DEF_COND NAME(*AS400) COND('*CPUTYPE = AS400');
IF COND(*AS400);
ELSE;
MESSAGE MSGTXT('Not available on PC');
MENU;
ENDIF;
BEGIN_LOOP;
********** COMMENT(Build list for display in window);
SET_MODE TO(*DISPLAY);
CLR_LIST NAMED(#S_LSTSUBT);
SELECT FIELDS(#S_LSTSUBT) FROM_FILE(SETSUB);
ADD_ENTRY TO_LIST(#S_LSTSUBT);
ENDSELECT;
********** COMMENT(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('SUBTYPE Prompt') BROWSELIST(#S_LSTSUBT) EXIT_KEY(*NO) ADD_KEY(*YES) PROMPT_KEY(*NO) USER_KEYS((21 'Change' *NEXT *NONE)(22 'Delete')) CURSOR_LOC(*ATFIELD #S_178DVTP);
********** COMMENT();
IF COND('(#LISTENTRY *GT 0) *OR (#IO$KEY *EQ ''06'')');
IF COND('#LISTENTRY *GT 0');
GET_ENTRY NUMBER(#LISTENTRY) FROM_LIST(#S_LSTSUBT);
ENDIF;
********** COMMENT();
CASE OF_FIELD(#IO$KEY);
********** COMMENT(When the ADD key is used);
WHEN VALUE_IS('= ''06''');
EXECUTE SUBROUTINE(ADD$DATA);
********** COMMENT(When the CHANGE key is used);
WHEN VALUE_IS('= ''21''');
EXECUTE SUBROUTINE(WORK$DATA) WITH_PARMS(CHG);
********** COMMENT(When the DELETE key is used);
WHEN VALUE_IS('= ''22''');
EXECUTE SUBROUTINE(WORK$DATA) WITH_PARMS(DLT);
********** COMMENT(When the user selects an entry and presses enter);
WHEN VALUE_IS('= RA');
EXCHANGE FIELDS(#S_178DVTP #S_178SBTP);
MENU;
ENDCASE;
ENDIF;
END_LOOP;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: ADD$DATA);
********** COMMENT(Description ...: Add a new record to SETSUB);
********** COMMENT(=======================================================);
SUBROUTINE NAME(ADD$DATA);
********** COMMENT(Groups used in this subroutine);
GROUP_BY NAME(#ADD$DATA) FIELDS((#S_178DVTP)(#S_178SBTP)(#S_178SBPG));
********** COMMENT(Set up and display the ADD screen);
MESSAGE MSGID(DCU0010) MSGF(DC@M01) MSGDTA('SUBTYPE');
CHANGE FIELD(#ADD$DATA) TO(*DEFAULT);
SET_MODE TO(*ADD);
********** COMMENT(Do data entry until user exits with CANCEL key);
BEGIN_LOOP;
POP_UP FIELDS(#ADD$DATA) DESIGN(*DOWN) IDENTIFY(*DESC) AT_LOC(009 006) WITH_SIZE(*AUTO) PANEL_TITL('Create New SUBTYPE') EXIT_KEY(*NO) MENU_KEY(*YES *RETURN) PROMPT_KEY(*NO) CURSOR_LOC(*ATFIELD #S_178DVTP);
INSERT FIELDS(#ADD$DATA) TO_FILE(SETSUB);
CHANGE FIELD(#ADD$DATA) TO(*DEFAULT);
MESSAGE MSGID(DCU0011) MSGF(DC@M01) MSGDTA('SUBTYPE');
END_LOOP;
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: WORK$DATA);
********** COMMENT(Description ...: Work with detailed data from SETSUB);
********** COMMENT(=======================================================);
SUBROUTINE NAME(WORK$DATA) PARMS((#WORK$OPT));
********** COMMENT(Groups and work fields used in this subroutine);
DEFINE FIELD(#WORK$OPT) TYPE(*CHAR) LENGTH(003);
GROUP_BY NAME(#WORK$DATA) FIELDS((#S_178DVTP *OUT)(#S_178SBTP)(#S_178SBPG));
********** COMMENT(Fetch full record details from file SETSUB);
CHANGE FIELD(#WORK$DATA) TO(*NAVAIL);
GET_ENTRY NUMBER(#LISTENTRY) FROM_LIST(#S_LSTSUBT);
FETCH FIELDS(#WORK$DATA) FROM_FILE(SETSUB) WITH_KEY(#S_178DVTP #S_178SBTP);
IF_STATUS IS_NOT(*OKAY);
MESSAGE MSGID(DCU0016) MSGF(DC@M01) MSGDTA('SUBTYPE');
RETURN;
ENDIF;
********** COMMENT(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('SUBTYPE');
OTHERWISE;
RETURN;
ENDCASE;
********** COMMENT(Display full record details);
POP_UP FIELDS(#WORK$DATA) DESIGN(*DOWN) IDENTIFY(*DESC) AT_LOC(009 006) WITH_SIZE(*AUTO) PANEL_TITL('Maintain SUBTYPEs') EXIT_KEY(*NO) MENU_KEY(*YES *RETURN) PROMPT_KEY(*NO) CURSOR_LOC(*ATFIELD #S_178SBPG);
IF_MODE IS(*CHANGE);
UPDATE FIELDS(#WORK$DATA) IN_FILE(SETSUB);
ENDIF;
IF_MODE IS(*DELETE);
DELETE FROM_FILE(SETSUB);
ENDIF;
ENDROUTINE;