| 
*===================================================================== * Message Queue Procedures * * Copyright (C) Julian Monypenny 1997 *===================================================================== H NoMain *--------------------------------------------------------------------- * Global definitions *--------------------------------------------------------------------- /Copy ToolkitCpy,ApiErrH /Copy ToolkitCpy,MsgQueH /Copy ToolkitCpy,StdTypH *===================================================================== P ClearMsgQue B Export *===================================================================== D Pi Like( LglTyp ) D MsgStk_O Like( IntTyp ) Value D Options( *NoPass ) D MsgQue_O Like( NamTyp ) Value D Options( *NoPass ) D MsgAct S Like( NamTyp ) Inz( '*ALL' ) D MsgKey S 4 D MsgQue S Like( NamTyp ) D MsgStk S Like( IntTyp ) C Reset ApiErrDs C If %Parms < 1 C Eval MsgStk = CurrMsgStk + 1 C Else C Eval MsgStk = MsgStk_O + 1 C EndIf C If %Parms < 2 C Eval MsgQue = CurrMsgQue C Else C Eval MsgQue = MsgQue_O C EndIf C Call 'QMHRMVPM' C Parm MsgQue |
|
C Parm MsgStk C Parm MsgKey C Parm MsgAct C Parm ApiErrDs C Return ( ApiErrLen = 0 ) P E *===================================================================== P GetMsgFrmQue B Export *===================================================================== D Pi Like( LglTyp ) D MsgTyp Like( NamTyp ) Value D MsgQueDta Like( MsgQueDtaDs ) D MsgAct_O Like( NamTyp ) Value D Options( *NoPass ) D MsgStk_O Like( IntTyp ) Value D Options( *NoPass ) D MsgQue_O Like( NamTyp ) Value D Options( *NoPass ) D DtaFmt S Like( ApiFmtTyp ) D Inz( 'RCVM0200') D MsgAct S Like( NamTyp ) D MsgKey S 4 D MsgQue S Like( NamTyp ) D MsgStk S Like( IntTyp ) D MsgWait S Like( IntTyp ) C Reset ApiErrDs C Reset MsgQueDtaDs C Eval MsgQDtaSiz = %Size( MsgQueDtaDs ) C If %Parms < 3 C Eval MsgAct = SameMsgAct C Else C Eval MsgAct = MsgAct_O C EndIf C If %Parms < 4 C Eval MsgStk = CurrMsgStk + 1 C Else C Eval MsgStk = MsgStk_O + 1 |
|
C EndIf C If %Parms < 5 C Eval MsgQue = CurrMsgQue C Else C Eval MsgQue = MsgQue_O C EndIf C Call 'QMHRCVPM' C Parm MsgQueDtaDs C Parm MsgQDtaSiz C Parm DtaFmt C Parm MsgQue C Parm MsgStk C Parm MsgTyp C Parm MsgKey C Parm MsgWait C Parm MsgAct C Parm ApiErrDs C If MsgQDtaSiz = 0 C Eval MsgQRplLen = 0 C Eval MsgQMsgLen = 0 C Eval MsgQHlpLen = 0 C EndIf C If ApiErrLen = 0 C Eval MsgQRplPos = 1 C Eval MsgQMsgPos = MsgQRplPos + MsgQRplLen C Eval MsgQHlpPos = MsgQMsgPos + MsgQMsgLen C Eval MsgQueDta = MsgQueDtaDs C EndIf C Return ( ApiErrLen = 0 ) P E *===================================================================== P PutMsgOnQue B Export *===================================================================== D Pi Like( LglTyp ) D MsgFil Like( NamTyp ) Value D MsgLib Like( NamTyp ) Value D MsgId Like( MsgIdTyp ) Value |
|
D MsgTyp Like( NamTyp ) Value D MsgTxt_O Like( StrTyp ) Value D Options( *NoPass ) D MsgStk_O Like( IntTyp ) Value D Options( *NoPass ) D MsgQue_O Like( NamTyp ) Value D Options( *NoPass ) D QMsgFil S Like( QNamTyp ) D MsgKey S 4 D MsgQue S Like( NamTyp ) D MsgStk S Like( IntTyp ) D MsgTxt S Like( StrTyp ) D MsgTxtLen S Like( IntTyp ) C Reset ApiErrDs C Eval QMsgFil = MsgFil + MsgLib C If %Parms < 5 C Eval MsgTxt = *Blank C Eval MsgTxtLen = 0 C Else C Eval MsgTxt = MsgTxt_O C Eval MsgTxtLen = %Size( MsgTxt ) C EndIf C If %Parms < 6 C Eval MsgStk = CurrMsgStk + 1 C Else C Eval MsgStk = MsgStk_O + 1 C EndIf C If %Parms < 7 C Eval MsgQue = CurrMsgQue C Else C Eval MsgQue = MsgQue_O C EndIf C Call 'QMHSNDPM' C Parm MsgId C Parm QMsgFil C Parm MsgTxt C Parm MsgTxtLen C Parm MsgTyp |
|
C Parm MsgQue C Parm MsgStk C Parm MsgKey C Parm ApiErrDs C Return ( ApiErrLen = 0 ) P E |
