You must be logged in to use the copy button.

        
**Free
Ctl-Opt
  Copyright('Copyright JAS, Inc.')
  NoMain
  Option(*SrcStmt : *NoDebugIO)
  CCSID(*CHAR:*JOBRUN)
  DecEdit(*Jobrun)
  ALWNULL(*USRCTL);

//**********************************************************************
// Description: To Clear and send to the program SFL message queue
//              an order.
// Purpose    : Bound code to do the above
// CRTSRVPGM SRVPGM(*CURLIB/jsSflMsg) EXPORT(*ALL) ACTGRP(*CALLER)
//**********************************************************************

dcl-ds QUsec qualified;
  QUSBPRV int(10) inz(256);  // Bytes Provided
  QUSBAVL int(10);           // Bytes Available
  QUSEI   char(7);           // Exception Id
  QUSERVED char(1);          // Reserved
  ExceptionId char(256);
end-ds;

//**********************************************************************
// Prototype declarations for QMHRMVPM and QMHSNDPM APIs
//**********************************************************************
dcl-pr QMHRMVPM extpgm('QMHRMVPM');
  StkMsgQueue  char(10) const;
  StackCount   int(10)  const;
  MessageKey   char(4)  const;
  MessageRemove char(10) const;
  QUsec        likeds(QUsec);
end-pr;

dcl-pr QMHSNDPM extpgm('QMHSNDPM');
  MessageId      char(7)  const;
  MessageFileNm  char(20) const;
  MessageData    char(256) const;
  MsgSize        int(10)  const;
  MessageType    char(10) const;
  StkMsgQueue    char(10) const;
  StackCount     int(10)  const;
  MessageKey     char(4);
  QUsec          likeds(QUsec);
end-pr;

//*****************************************************************
// Include necessary prototype declarations
//*****************************************************************
/Define ClrSFLMsg$_pr
/Define ClrSFLMsg$_flds
/Include qProtoSrc,jsSflMsg

/Define SndSFLMsg$_pr
/Define SndSFLMsg$_flds
/Include qProtoSrc,jsSflMsg

//*****************************************************************
// Call API to Clear Message Subfile
//*****************************************************************
dcl-proc ClrSFLMsg$ export;

/Define ClrSFLMsg$_pi
/Define ClrSFLMsg$_flds
/Include qProtoSrc,jsSflMsg

  dcl-s StackCount    int(10);
  dcl-s MessageKey    char(4) inz(' ');
  dcl-s StkMsgQueue   char(10) inz(' ');
  dcl-s MessageRemove char(10) inz('*ALL');

  // Set the message queue
  StkMsgQueue = PMessageQueue;

  // Call API to remove messages from the message queue
  clear QUsec;
  callp(e) QMHRMVPM(StkMsgQueue: StackCount: MessageKey: MessageRemove: QUsec);

  return;
end-proc;

//*****************************************************************
// Call API to Send Message to Subfile
//*****************************************************************
dcl-proc SndSFLMsg$ export;

/Define SndSFLMsg$_pi
/Define SndSFLMsg$_flds
/Include qProtoSrc,jsSflMsg

  dcl-s MsgSize        int(10);
  dcl-s StackCount     int(10);
  dcl-s MessageId      char(7) inz(' ');
  dcl-s MessageFileNm  char(20) inz(' ');
  dcl-s MessageData    char(256) inz(' ');
  dcl-s MessageType    char(10) inz('*INFO');
  dcl-s MessageKey     char(4) inz(' ');
  dcl-s StkMsgQueue    char(10) inz(' ');

  // Set the message queue
  StkMsgQueue = PMessageQueue;

  // Determine length of the message
  MsgSize = %len(%trimr(PMessage));
  if MsgSize > 0;
    MessageData = %subst(PMessage: 1: MsgSize);
  else;
    MessageData = ' ';
  endif;

  // Set message ID and file name
  if %parms >= 3;
    if PMessageId > *blanks;
      MessageId = PMessageId;
    endif;
    if PMessageFile > *blanks;
      MessageFileNm = PMessageFile;
      %subst(MessageFileNm: 11: 10) = '*LIBL';
    endif;
    if %parms >= 5;
      if PMessageLib > *blanks;
        %subst(MessageFileNm: 11: 10) = PMessageLib;
      else;
        %subst(MessageFileNm: 11: 10) = '*LIBL';
      endif;
    endif;
  endif;

  // Call API to send the message
  clear QUsec;
  callp(e) QMHSNDPM(MessageId: MessageFileNm: MessageData: MsgSize:
                    MessageType: StkMsgQueue: StackCount: MessageKey: QUsec);

  return;
end-proc;