Function VSAM141 : Existing Application (Browse/Maintain/Add Employees)
Name: VSAM141
Description: The following RDML function represents an existing application.
********** COMMENT(=======================================================);
********** COMMENT(Function ......: VSAM141 );
********** COMMENT(Created by ....: QOTHPRDOWN );
********** COMMENT(Created on ....: 25/11/99 at 14:58:44 );
********** COMMENT(Description ...: Update Employee );
********** COMMENT(=======================================================);
********** COMMENT(Options, work variables, conditions and browselists);
********** COMMENT(=======================================================);
FUNCTION OPTIONS(*NOMESSAGES *DEFERWRITE *DIRECT);
DEFINE FIELD(#ALLOWADD) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#ALLOWCHG) REFFLD(#ALLOWADD);
DEFINE FIELD(#ALLOWDLT) REFFLD(#ALLOWADD);
DEF_COND NAME(*ALLOWADD) COND('#ALLOWADD *EQ Y');
DEF_COND NAME(*ALLOWCHG) COND('#ALLOWCHG *EQ Y');
DEF_COND NAME(*ALLOWDLT) COND('#ALLOWDLT *EQ Y');
********** COMMENT(=======================================================);
********** COMMENT(PROGRAM MAINLINE);
********** COMMENT(=======================================================);
********** COMMENT(Determine if the user can maintain the file);
USE BUILTIN(CHECK_AUTHORITY) WITH_ARGS(PSLMST '*LIBL' FD AD) TO_GET(#ALLOWADD);
USE BUILTIN(CHECK_AUTHORITY) WITH_ARGS(PSLMST '*LIBL' FD CH) TO_GET(#ALLOWCHG);
USE BUILTIN(CHECK_AUTHORITY) WITH_ARGS(PSLMST '*LIBL' FD DL) TO_GET(#ALLOWDLT);
EXECUTE SUBROUTINE(OBJ_BROWSE);
********** COMMENT(Perform the loop that handles the command keys used);
DOWHILE COND('#IO$KEY *NE ''12''');
CASE OF_FIELD(#IO$KEY);
********** COMMENT(When the ADD key is used);
WHEN VALUE_IS('= ''06''');
EXECUTE SUBROUTINE(ADD$DATA);
********** COMMENT(When the Batch key is used);
WHEN VALUE_IS('= ''07''');
SUBMIT PROCESS(#PROCESS) FUNCTION(VSAM142);
********** COMMENT(When maintenance is required);
WHEN VALUE_IS('= RA');
IF COND('#LISTENTRY *GT *ZERO');
EXECUTE SUBROUTINE(WORK$DATA);
ENDIF;
ENDCASE;
********** COMMENT(Select and display a list of records);
EXECUTE SUBROUTINE(OBJ_BROWSE);
ENDWHILE;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: OBJ_BROWSE);
********** COMMENT(Description ...: Browse from PSLMST (page at a time));
********** COMMENT(=======================================================);
SUBROUTINE NAME(OBJ_BROWSE);
********** COMMENT(Work fields and lists used in this subroutine);
DEF_LIST NAME(#OBJLIST) FIELDS(#EMPNO #SURNAME #GIVENAME (#PRIFILRRN *HIDDEN)) COUNTER(#LISTCOUNT) PAGE_SIZE(#LISTPAGE) TOP_ENTRY(#LISTTOP) SEL_ENTRY(#LISTENTRY) SCROLL_TXT(#LISTPOS);
DEF_LIST NAME(#LASTREQ) FIELDS(#EMPNO) TYPE(*WORKING) ENTRYS(1);
GROUP_BY NAME(#CLRLIST) FIELDS(#SURNAME #GIVENAME #ADDRESS1 #ADDRESS2 #ADDRESS3 #POSTCODE #PHONEHME #PHONEBUS #DEPTMENT #SECTION #SALARY #STARTDTE #TERMDATE (#EMPNO *OUT));
********** COMMENT(Repeat until records found and selection made);
DOUNTIL COND('((#LISTENTRY *GT 0) *AND (#IO$KEY *EQ RA)) *OR ((#IO$KEY *EQ ''06'') *OR (#IO$KEY *EQ ''07'') *OR (#IO$KEY *EQ ''12''))');
IF COND('#LISTCOUNT *GT 0');
CHANGE FIELD(#LISTTOP) TO('#LISTTOP - #LISTPAGE');
GET_ENTRY NUMBER(#LISTTOP) FROM_LIST(#OBJLIST);
CLR_LIST NAMED(#LASTREQ);
ADD_ENTRY TO_LIST(#LASTREQ);
CHANGE FIELD(#CLRLIST) TO(*DEFAULT);
GET_ENTRY NUMBER(1) FROM_LIST(#LASTREQ);
ENDIF;
CLR_LIST NAMED(#OBJLIST);
CHANGE FIELD(#CLRLIST) TO(*NAVAIL);
CHANGE FIELD(#EMPNO) TO(*NULL);
********** COMMENT(Display list of selected records a page at a time);
CHANGE FIELD(#IO$KEY) TO(UP);
SELECT FIELDS(#OBJLIST) FROM_FILE(PSLMST) WHERE('#IO$KEY *EQ UP') WITH_KEY(#EMPNO) NBR_KEYS(*COMPUTE) RETURN_RRN(#PRIFILRRN) OPTIONS(*ENDWHERE *STARTKEY);
EXECUTE SUBROUTINE(OBJDISP) WITH_PARMS('More...');
IF COND('#IO$KEY *EQ ''12''');
RETURN;
ENDIF;
ADD_ENTRY TO_LIST(#OBJLIST) WITH_MODE(*DISPLAY);
CHANGE FIELD(#CLRLIST) TO(*NAVAIL);
ENDSELECT;
********** COMMENT(When there are no more records to be read . . . .);
IF COND('(#IO$KEY = UP)');
IF COND('(#LISTCOUNT *EQ 0)');
EXECUTE SUBROUTINE(SHOWLIST);
ELSE;
EXECUTE SUBROUTINE(OBJDISP) WITH_PARMS('Bottom');
ENDIF;
ENDIF;
ENDUNTIL;
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: OBJDISP);
********** COMMENT(Description ...: Browse from PSLMST (page at a time));
********** COMMENT(Parameters ...: Name Typ Len Description);
********** COMMENT( ---- --- --- -----------);
********** COMMENT( #LISTPOS A 7 Browse position);
********** COMMENT(=======================================================);
SUBROUTINE NAME(OBJDISP) PARMS(#LISTPOS);
********** COMMENT(Display if at bottom of list or on a page boundary);
CHANGE FIELD(#LISTREMN) TO('#LISTCOUNT / #LISTPAGE');
IF COND('(#IO$KEY *EQ UP) *AND ((#LISTPOS *EQ ''Bottom'') *OR ((#LISTREMN *EQ 0) *AND (#LISTCOUNT *GT 0)))');
EXECUTE SUBROUTINE(SHOWLIST);
DOWHILE COND('((#IO$KEY *EQ RA) *AND (#LISTENTRY *EQ 0)) *OR ((#LISTPOS *EQ ''Bottom'') *AND (#IO$KEY *EQ UP))');
EXECUTE SUBROUTINE(SHOWLIST);
ENDWHILE;
********** COMMENT(Set up the top of the next page);
CHANGE FIELD(#LISTTOP) TO('#LISTTOP + #LISTPAGE');
ENDIF;
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: ADD$DATA);
********** COMMENT(Description ...: Add new data to PSLMST);
********** COMMENT(=======================================================);
SUBROUTINE NAME(ADD$DATA);
********** COMMENT(Groups used in this subroutine);
GROUP_BY NAME(#ADD$DATA) FIELDS(#EMPNO #SURNAME #GIVENAME #ADDRESS1 #ADDRESS2 #ADDRESS3 #POSTCODE #PHONEHME #PHONEBUS #DEPTMENT #SECTION #SALARY #STARTDTE #TERMDATE);
********** COMMENT(Issue initial data entry display, prepare display);
MESSAGE MSGID(DCU0010) MSGF(DC@M01) MSGDTA('Employee');
CHANGE FIELD(#ADD$DATA) TO(*DEFAULT);
SET_MODE TO(*ADD);
********** COMMENT(Display the screen to ADD records);
POP_UP FIELDS(#ADD$DATA) DESIGN(*DOWN) IDENTIFY(*LABEL) AT_LOC(4 4) PANEL_TITL('Create New Employee') EXIT_KEY(*NO) MENU_KEY(*YES *RETURN) CURSOR_LOC(*ATFIELD #EMPNO);
INSERT FIELDS(#ADD$DATA) TO_FILE(PSLMST);
CHANGE FIELD(#ADD$DATA) TO(*DEFAULT);
MESSAGE MSGTXT('Employee successfully added');
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: WORK$DATA);
********** COMMENT(Description ...: Work with detailed data from PSLMST);
********** COMMENT(=======================================================);
SUBROUTINE NAME(WORK$DATA);
********** COMMENT(Groups and work fields used in this subroutine);
GROUP_BY NAME(#WORK$DATA) FIELDS(#SURNAME #GIVENAME #ADDRESS1 #ADDRESS2 #ADDRESS3 #POSTCODE #PHONEHME #PHONEBUS #DEPTMENT #SECTION #SALARY #STARTDTE #TERMDATE (#EMPNO *OUT));
********** COMMENT(Fetch full record details from file PSLMST);
CHANGE FIELD(#WORK$DATA) TO(*NAVAIL);
GET_ENTRY NUMBER(#LISTENTRY) FROM_LIST(#OBJLIST);
FETCH FIELDS(#WORK$DATA) FROM_FILE(PSLMST) WITH_RRN(#PRIFILRRN);
IF_STATUS IS_NOT(*OKAY);
MESSAGE MSGID(DCU0016) MSGF(DC@M01) MSGDTA('Employee');
RETURN;
ENDIF;
SET_MODE TO(*DISPLAY);
********** COMMENT(Display full record details);
POP_UP FIELDS(#WORK$DATA) DESIGN(*DOWN) IDENTIFY(*LABEL) AT_LOC(4 4) PANEL_TITL('Maintain Employees') EXIT_KEY(*NO) MENU_KEY(*YES *RETURN) CHANGE_KEY(*YES *NEXT *ALLOWCHG) DELETE_KEY(*YES *NEXT *ALLOWDLT) CURSOR_LOC(*ATFIELD #EMPNO);
IF_MODE IS(*CHANGE);
UPDATE FIELDS(#WORK$DATA) IN_FILE(PSLMST);
ENDIF;
IF_MODE IS(*DELETE);
DELETE FROM_FILE(PSLMST);
ENDIF;
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: SHOWLIST);
********** COMMENT(Description ...: Display the browselist);
********** COMMENT(=======================================================);
SUBROUTINE NAME(SHOWLIST);
IF COND('(#LISTCOUNT = 0)');
MESSAGE MSGTXT('No records found in file PSLMST. Use F6 to ADD.');
ELSE;
MESSAGE MSGTXT('Select section to review/change/delete or ADD key to add a new Employee');
ENDIF;
REQUEST BROWSELIST(#OBJLIST) ADD_KEY(*YES *NEXT *ALLOWADD) USER_KEYS((07 'BatchJob')) PANEL_TITL('Choose Employees');
ENDROUTINE;
Name: VSAM141
Description: The following RDML function represents an existing application.
********** COMMENT(=======================================================);
********** COMMENT(Function ......: VSAM141 );
********** COMMENT(Created by ....: QOTHPRDOWN );
********** COMMENT(Created on ....: 25/11/99 at 14:58:44 );
********** COMMENT(Description ...: Update Employee );
********** COMMENT(=======================================================);
********** COMMENT(Options, work variables, conditions and browselists);
********** COMMENT(=======================================================);
FUNCTION OPTIONS(*NOMESSAGES *DEFERWRITE *DIRECT);
DEFINE FIELD(#ALLOWADD) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#ALLOWCHG) REFFLD(#ALLOWADD);
DEFINE FIELD(#ALLOWDLT) REFFLD(#ALLOWADD);
DEF_COND NAME(*ALLOWADD) COND('#ALLOWADD *EQ Y');
DEF_COND NAME(*ALLOWCHG) COND('#ALLOWCHG *EQ Y');
DEF_COND NAME(*ALLOWDLT) COND('#ALLOWDLT *EQ Y');
********** COMMENT(=======================================================);
********** COMMENT(PROGRAM MAINLINE);
********** COMMENT(=======================================================);
********** COMMENT(Determine if the user can maintain the file);
USE BUILTIN(CHECK_AUTHORITY) WITH_ARGS(PSLMST '*LIBL' FD AD) TO_GET(#ALLOWADD);
USE BUILTIN(CHECK_AUTHORITY) WITH_ARGS(PSLMST '*LIBL' FD CH) TO_GET(#ALLOWCHG);
USE BUILTIN(CHECK_AUTHORITY) WITH_ARGS(PSLMST '*LIBL' FD DL) TO_GET(#ALLOWDLT);
EXECUTE SUBROUTINE(OBJ_BROWSE);
********** COMMENT(Perform the loop that handles the command keys used);
DOWHILE COND('#IO$KEY *NE ''12''');
CASE OF_FIELD(#IO$KEY);
********** COMMENT(When the ADD key is used);
WHEN VALUE_IS('= ''06''');
EXECUTE SUBROUTINE(ADD$DATA);
********** COMMENT(When the Batch key is used);
WHEN VALUE_IS('= ''07''');
SUBMIT PROCESS(#PROCESS) FUNCTION(VSAM142);
********** COMMENT(When maintenance is required);
WHEN VALUE_IS('= RA');
IF COND('#LISTENTRY *GT *ZERO');
EXECUTE SUBROUTINE(WORK$DATA);
ENDIF;
ENDCASE;
********** COMMENT(Select and display a list of records);
EXECUTE SUBROUTINE(OBJ_BROWSE);
ENDWHILE;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: OBJ_BROWSE);
********** COMMENT(Description ...: Browse from PSLMST (page at a time));
********** COMMENT(=======================================================);
SUBROUTINE NAME(OBJ_BROWSE);
********** COMMENT(Work fields and lists used in this subroutine);
DEF_LIST NAME(#OBJLIST) FIELDS(#EMPNO #SURNAME #GIVENAME (#PRIFILRRN *HIDDEN)) COUNTER(#LISTCOUNT) PAGE_SIZE(#LISTPAGE) TOP_ENTRY(#LISTTOP) SEL_ENTRY(#LISTENTRY) SCROLL_TXT(#LISTPOS);
DEF_LIST NAME(#LASTREQ) FIELDS(#EMPNO) TYPE(*WORKING) ENTRYS(1);
GROUP_BY NAME(#CLRLIST) FIELDS(#SURNAME #GIVENAME #ADDRESS1 #ADDRESS2 #ADDRESS3 #POSTCODE #PHONEHME #PHONEBUS #DEPTMENT #SECTION #SALARY #STARTDTE #TERMDATE (#EMPNO *OUT));
********** COMMENT(Repeat until records found and selection made);
DOUNTIL COND('((#LISTENTRY *GT 0) *AND (#IO$KEY *EQ RA)) *OR ((#IO$KEY *EQ ''06'') *OR (#IO$KEY *EQ ''07'') *OR (#IO$KEY *EQ ''12''))');
IF COND('#LISTCOUNT *GT 0');
CHANGE FIELD(#LISTTOP) TO('#LISTTOP - #LISTPAGE');
GET_ENTRY NUMBER(#LISTTOP) FROM_LIST(#OBJLIST);
CLR_LIST NAMED(#LASTREQ);
ADD_ENTRY TO_LIST(#LASTREQ);
CHANGE FIELD(#CLRLIST) TO(*DEFAULT);
GET_ENTRY NUMBER(1) FROM_LIST(#LASTREQ);
ENDIF;
CLR_LIST NAMED(#OBJLIST);
CHANGE FIELD(#CLRLIST) TO(*NAVAIL);
CHANGE FIELD(#EMPNO) TO(*NULL);
********** COMMENT(Display list of selected records a page at a time);
CHANGE FIELD(#IO$KEY) TO(UP);
SELECT FIELDS(#OBJLIST) FROM_FILE(PSLMST) WHERE('#IO$KEY *EQ UP') WITH_KEY(#EMPNO) NBR_KEYS(*COMPUTE) RETURN_RRN(#PRIFILRRN) OPTIONS(*ENDWHERE *STARTKEY);
EXECUTE SUBROUTINE(OBJDISP) WITH_PARMS('More...');
IF COND('#IO$KEY *EQ ''12''');
RETURN;
ENDIF;
ADD_ENTRY TO_LIST(#OBJLIST) WITH_MODE(*DISPLAY);
CHANGE FIELD(#CLRLIST) TO(*NAVAIL);
ENDSELECT;
********** COMMENT(When there are no more records to be read . . . .);
IF COND('(#IO$KEY = UP)');
IF COND('(#LISTCOUNT *EQ 0)');
EXECUTE SUBROUTINE(SHOWLIST);
ELSE;
EXECUTE SUBROUTINE(OBJDISP) WITH_PARMS('Bottom');
ENDIF;
ENDIF;
ENDUNTIL;
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: OBJDISP);
********** COMMENT(Description ...: Browse from PSLMST (page at a time));
********** COMMENT(Parameters ...: Name Typ Len Description);
********** COMMENT( ---- --- --- -----------);
********** COMMENT( #LISTPOS A 7 Browse position);
********** COMMENT(=======================================================);
SUBROUTINE NAME(OBJDISP) PARMS(#LISTPOS);
********** COMMENT(Display if at bottom of list or on a page boundary);
CHANGE FIELD(#LISTREMN) TO('#LISTCOUNT / #LISTPAGE');
IF COND('(#IO$KEY *EQ UP) *AND ((#LISTPOS *EQ ''Bottom'') *OR ((#LISTREMN *EQ 0) *AND (#LISTCOUNT *GT 0)))');
EXECUTE SUBROUTINE(SHOWLIST);
DOWHILE COND('((#IO$KEY *EQ RA) *AND (#LISTENTRY *EQ 0)) *OR ((#LISTPOS *EQ ''Bottom'') *AND (#IO$KEY *EQ UP))');
EXECUTE SUBROUTINE(SHOWLIST);
ENDWHILE;
********** COMMENT(Set up the top of the next page);
CHANGE FIELD(#LISTTOP) TO('#LISTTOP + #LISTPAGE');
ENDIF;
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: ADD$DATA);
********** COMMENT(Description ...: Add new data to PSLMST);
********** COMMENT(=======================================================);
SUBROUTINE NAME(ADD$DATA);
********** COMMENT(Groups used in this subroutine);
GROUP_BY NAME(#ADD$DATA) FIELDS(#EMPNO #SURNAME #GIVENAME #ADDRESS1 #ADDRESS2 #ADDRESS3 #POSTCODE #PHONEHME #PHONEBUS #DEPTMENT #SECTION #SALARY #STARTDTE #TERMDATE);
********** COMMENT(Issue initial data entry display, prepare display);
MESSAGE MSGID(DCU0010) MSGF(DC@M01) MSGDTA('Employee');
CHANGE FIELD(#ADD$DATA) TO(*DEFAULT);
SET_MODE TO(*ADD);
********** COMMENT(Display the screen to ADD records);
POP_UP FIELDS(#ADD$DATA) DESIGN(*DOWN) IDENTIFY(*LABEL) AT_LOC(4 4) PANEL_TITL('Create New Employee') EXIT_KEY(*NO) MENU_KEY(*YES *RETURN) CURSOR_LOC(*ATFIELD #EMPNO);
INSERT FIELDS(#ADD$DATA) TO_FILE(PSLMST);
CHANGE FIELD(#ADD$DATA) TO(*DEFAULT);
MESSAGE MSGTXT('Employee successfully added');
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: WORK$DATA);
********** COMMENT(Description ...: Work with detailed data from PSLMST);
********** COMMENT(=======================================================);
SUBROUTINE NAME(WORK$DATA);
********** COMMENT(Groups and work fields used in this subroutine);
GROUP_BY NAME(#WORK$DATA) FIELDS(#SURNAME #GIVENAME #ADDRESS1 #ADDRESS2 #ADDRESS3 #POSTCODE #PHONEHME #PHONEBUS #DEPTMENT #SECTION #SALARY #STARTDTE #TERMDATE (#EMPNO *OUT));
********** COMMENT(Fetch full record details from file PSLMST);
CHANGE FIELD(#WORK$DATA) TO(*NAVAIL);
GET_ENTRY NUMBER(#LISTENTRY) FROM_LIST(#OBJLIST);
FETCH FIELDS(#WORK$DATA) FROM_FILE(PSLMST) WITH_RRN(#PRIFILRRN);
IF_STATUS IS_NOT(*OKAY);
MESSAGE MSGID(DCU0016) MSGF(DC@M01) MSGDTA('Employee');
RETURN;
ENDIF;
SET_MODE TO(*DISPLAY);
********** COMMENT(Display full record details);
POP_UP FIELDS(#WORK$DATA) DESIGN(*DOWN) IDENTIFY(*LABEL) AT_LOC(4 4) PANEL_TITL('Maintain Employees') EXIT_KEY(*NO) MENU_KEY(*YES *RETURN) CHANGE_KEY(*YES *NEXT *ALLOWCHG) DELETE_KEY(*YES *NEXT *ALLOWDLT) CURSOR_LOC(*ATFIELD #EMPNO);
IF_MODE IS(*CHANGE);
UPDATE FIELDS(#WORK$DATA) IN_FILE(PSLMST);
ENDIF;
IF_MODE IS(*DELETE);
DELETE FROM_FILE(PSLMST);
ENDIF;
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Subroutine ....: SHOWLIST);
********** COMMENT(Description ...: Display the browselist);
********** COMMENT(=======================================================);
SUBROUTINE NAME(SHOWLIST);
IF COND('(#LISTCOUNT = 0)');
MESSAGE MSGTXT('No records found in file PSLMST. Use F6 to ADD.');
ELSE;
MESSAGE MSGTXT('Select section to review/change/delete or ADD key to add a new Employee');
ENDIF;
REQUEST BROWSELIST(#OBJLIST) ADD_KEY(*YES *NEXT *ALLOWADD) USER_KEYS((07 'BatchJob')) PANEL_TITL('Choose Employees');
ENDROUTINE;