Function SET185A - Display Message Queue

LANSA

previous page next page
Function SET185A - Display Message Queue
FUNCTION OPTIONS(*DIRECT *DBOPTIMISE);
********** COMMENT(-----------------);
********** COMMENT(Local definitions);
********** COMMENT(-----------------);
EXCHANGE FIELDS(#S_185QUE) OPTION(*ALWAYS);
DEFINE FIELD(#S_185RPY) TYPE(*CHAR) LENGTH(001) DESC('') COLHDG('') INPUT_ATR(RED) OUTPUT_ATR(RED);
DEFINE FIELD(#S_185URP) TYPE(*CHAR) LENGTH(050) DESC('Reply') INPUT_ATR(LC);
OVERRIDE FIELD(#S_185LV1S) LENGTH(076) TO_OVERLAY(#S_185LVL1 001);
DEFINE FIELD(#S_185LV1T) LENGTH(050) REFFLD(#S_185LVL1) LABEL('Message') TO_OVERLAY(#S_185LVL1 001);
OVERRIDE FIELD(#S_185QUE) DEFAULT(QSYSOPR);
DEFINE FIELD(#X_185QUE) REFFLD(#S_185QUE);
DEFINE FIELD(#S_185SEL) REFFLD(#STD_NUM) DESC('Selected entry');
DEF_LIST NAME(#S_185LIST) FIELDS((#S_185RPY)(#S_185LV1S)(#S_185MSGN *HIDDEN)) SEL_ENTRY(#S_185SEL);
********** COMMENT(------------------);
********** COMMENT(Program main logic);
********** COMMENT(------------------);
********** COMMENT(Initialize display with last queue named);
EXECUTE SUBROUTINE(REFRESH);
********** COMMENT(Now loop on queue display until terminated);
BEGIN_LOOP;
********** COMMENT(Show the queue);
CHANGE FIELD(#X_185QUE) TO(#S_185QUE);
REQUEST FIELDS(#S_185QUE) BROWSELIST(#S_185LIST) EXIT_KEY(*NO) MENU_KEY(*YES *NEXT) USER_KEYS((05 'Refresh' *NEXT *NONE)(11 'Remove' *NEXT *NONE)(13 'Reply' *NEXT *NONE)(16 'Rmv All' *NEXT *NONE)(17 'Rmv Old'));
********** COMMENT(If queue name has changed thn refresh unconditionally);
IF COND('#X_185QUE *ne #S_185QUE');
EXECUTE SUBROUTINE(REFRESH);
********** COMMENT(Else handle the function key used (if any));
ELSE;
CASE OF_FIELD(#IO$KEY);
********** COMMENT(Handle cancel request);
WHEN VALUE_IS('= ''12''');
DELETE FROM_FILE(SETOMQ) WITH_KEY(#S_185SESI);
MENU;
********** COMMENT(Handle Refreh Request);
WHEN VALUE_IS('= ''05''');
EXECUTE SUBROUTINE(REFRESH);
********** COMMENT(Handle Remove Request);
WHEN VALUE_IS('= ''11''');
EXECUTE SUBROUTINE(REMOVE);
********** COMMENT(Handle Reply Request);
WHEN VALUE_IS('= ''13''');
EXECUTE SUBROUTINE(REPLY);
********** COMMENT(Handle remove all (except unanswered));
WHEN VALUE_IS('= ''16''');
EXECUTE SUBROUTINE(RMVALL);
********** COMMENT(Handle remove old);
WHEN VALUE_IS('= ''17''');
EXECUTE SUBROUTINE(RMVOLD);
********** COMMENT();
ENDCASE;
ENDIF;
********** COMMENT(Loop back to main display);
END_LOOP;
********** COMMENT(==========================================);
********** COMMENT(Refresh : Reload the message queue details);
********** COMMENT(==========================================);
SUBROUTINE NAME(REFRESH);
********** COMMENT(Call SET185B to refresh details of queue);
EXCHANGE FIELDS(#S_185SESI);
CALL PROCESS(*DIRECT) FUNCTION(SET185B);
********** COMMENT(Read details and add to displayed browse list);
********** COMMENT(Type 05 message are inquires that may get a reply);
CLR_LIST NAMED(#S_185LIST);
SELECT FIELDS(*ALL) FROM_FILE(SETOMQ) WITH_KEY(#S_185SESI);
IF COND('#S_185RTNT = ''05''');
CHANGE FIELD(#S_185RPY) TO(R);
ELSE;
CHANGE FIELD(#S_185RPY) TO(*NULL);
ENDIF;
ADD_ENTRY TO_LIST(#S_185LIST);
ENDSELECT;
********** COMMENT(Finished);
ENDROUTINE;
********** COMMENT(==========================================);
********** COMMENT(Remove : Remove a message);
********** COMMENT(==========================================);
SUBROUTINE NAME(REMOVE);
********** COMMENT(Handle invalid cursor location);
IF_NULL FIELD(#S_185SEL);
MESSAGE MSGTXT('Cursor must be positioned over a messge to remove it');
********** COMMENT(Else get browselist entry and use SET185C to remove);
ELSE;
GET_ENTRY NUMBER(#S_185SEL) FROM_LIST(#S_185LIST);
EXCHANGE FIELDS(#S_185SESI #S_185MSGN);
CALL PROCESS(*DIRECT) FUNCTION(SET185C);
EXECUTE SUBROUTINE(REFRESH);
ENDIF;
********** COMMENT(Finished);
ENDROUTINE;
********** COMMENT(==========================================);
********** COMMENT(Reply : Reply to a message);
********** COMMENT(==========================================);
SUBROUTINE NAME(REPLY);
********** COMMENT(Handle invalid cursor location);
IF_NULL FIELD(#S_185SEL);
MESSAGE MSGTXT('Cursor must be positioned over the message you wish to reply to');
********** COMMENT(Else get browse list entry);
ELSE;
GET_ENTRY NUMBER(#S_185SEL) FROM_LIST(#S_185LIST);
********** COMMENT(handle message does not actually require a reply);
IF COND('#S_185RPY *NE R');
MESSAGE MSGTXT('Message selected does not require a reply');
********** COMMENT(Loop until a reply is specified and reply to sender);
********** COMMENT(by using SET185D);
ELSE;
CHANGE FIELD(#S_185URP) TO(*BLANKS);
DOUNTIL COND('#S_185URP *ne *blanks');
POP_UP FIELDS((#S_185LV1T *L3 *P2 *OUTPUT)(#S_185URP *L4 *P2 *INPUT)) DESIGN(*DOWN) DOWN_SEP(001) ACROSS_SEP(001) AT_LOC(007 004) WITH_SIZE(070 008) EXIT_KEY(*NO) MENU_KEY(*YES *RETURN) PROMPT_KEY(*NO);
IF_NULL FIELD(#S_185URP);
MESSAGE MSGTXT('You must specify a reply to this message');
ENDIF;
ENDUNTIL;
CHANGE FIELD(#S_185LVL1) TO(#S_185URP);
EXCHANGE FIELDS(#S_185SESI #S_185QUE #S_185MSGN #S_185LVL1);
CALL PROCESS(*DIRECT) FUNCTION(SET185D);
EXECUTE SUBROUTINE(REFRESH);
ENDIF;
ENDIF;
ENDROUTINE;
********** COMMENT(==========================================);
********** COMMENT(RmvAll : Remove all (except unanswered));
********** COMMENT(==========================================);
SUBROUTINE NAME(RMVALL);
EXCHANGE FIELDS(#S_185SESI #S_185MSGN);
CALL PROCESS(*DIRECT) FUNCTION(SET185E);
EXECUTE SUBROUTINE(REFRESH);
ENDROUTINE;
********** COMMENT(==========================================);
********** COMMENT(RmvOld : Remove old);
********** COMMENT(==========================================);
SUBROUTINE NAME(RMVOLD);
EXCHANGE FIELDS(#S_185SESI #S_185MSGN);
CALL PROCESS(*DIRECT) FUNCTION(SET185F);
EXECUTE SUBROUTINE(REFRESH);
ENDROUTINE;


previous page start next page