open-insight/LSL2/STPROC/PRINT_ERRMSG.txt
Infineon\StieberD 7762b129af pre cutover push
2024-09-04 20:33:41 -07:00

129 lines
3.0 KiB
Plaintext

Compile Subroutine Print_ErrMsg(ErrCodes)
Declare Subroutine Msg, Set_Status
DECLARE FUNCTION Create_Dialog
$INSERT MSG_EQUATES
EQU MSGID$ TO 1 ;* First value in ErrCodes
EQU MSGPARMS$ TO 2 ;* Second value in ErrCodes
EQU MSGTITLE$ TO 1 ;* Subvalue in MSGPARM
EQU MSGTEXT$ TO 2 ;* Subvalue in MSGPARM
Equate CRLF to \0D0A\ ;* CHAR(13):CHAR(10) for multiline messages
IF NOT(ASSIGNED(ErrCodes)) THEN
ErrCodes = 'Null Parameter Passed to ErrMsg Routine!'
END
IF INDEX(ErrCodes,@VM,1) = 0 THEN ErrCodes = ErrCodes:@VM ;* Changed to an append from a prepend. 2/5/2005 JCH
IF ErrCodes[-1,1] = @FM THEN ErrCodes[-1,1] = ''
CONVERT ']' TO @SVM IN ErrCodes
ErrDispLines = ''
FOR M = 1 TO COUNT(ErrCodes,@FM) + (ErrCodes NE '')
MsgID = ErrCodes<M,MSGID$>
MsgParms = FIELD(ErrCodes<M>,@VM,MSGPARMS$,99) ;* Added to pickup up additional parameters 10/03/2005 JCH
BEGIN CASE
CASE ErrCodes<M,MSGID$> = 'STPROC'
MText = ErrCodes<M,MSGPARMS$,MSGTEXT$>
MTitle = ErrCodes<M,MSGPARMS$,MSGTITLE$>
MIcon = '!'
CASE ErrCodes<M,MSGID$> = ''
IF INDEX(MsgParms,@SVM,1) THEN
MText = ErrCodes<M,MSGPARMS$,MSGTEXT$>
MTitle = ErrCodes<M,MSGPARMS$,MSGTITLE$>
END ELSE
MText = MsgParms
MTitle = 'Application Error Message'
END
MIcon = '!'
CASE 1
* Passed in MsgID must be a system generated error message
OSREAD Reverrors FROM 'REVERROR.DAT' THEN
Pos = INDEX(Reverrors,MsgID,1)
IF Pos THEN
MText = Reverrors[Pos,CHAR(13)]
MText = Field(MText,":",2)
MText = Trim(MText)
FOR I = 1 TO COUNT(MsgParms,@VM) + (MsgParms NE '')
SWAP '%':I:'%' WITH MsgParms<1,I> IN MText
NEXT I
MText = Trim(MText)
MTitle = 'System Error Message - ':MsgID
MIcon = '!'
END ELSE
IF INDEX(MsgID,@SVM,1) THEN ;* Updated 2/5/2005 to work with system messages
MText = FIELD(MsgID,@SVM,2)
MTitle = FIELD(MsgID,@SVM,1)
END ELSE
MText = MsgID
MTitle = 'Application Message'
END
MIcon = '!'
END
END ELSE
MText = "OSREAD Error on file: REVERROR.DAT."
MTitle = 'ERRMSG routine Error.'
MIcon = 'H'
END
CASE 1
END CASE
ErrDispLines := MTitle:@VM:MText:@FM ;* Added 1/20/2010 JCH
/*
* Display the message
BEGIN CASE
CASE Len(MText) < 20 ; Msg_Len = 200
CASE Len(MText) < 30 ; Msg_Len = 260
CASE Len(MText) < 40 ; Msg_Len = 320
CASE Len(MText) < 50 ; Msg_Len = 380
CASE Len(MText) < 60 ; Msg_Len = 440
CASE 1 ; Msg_Len = 450
END CASE
TypeOver = ''
TypeOver<MTEXT$> = MText
TypeOver<MTYPE$> = 'BO'
TypeOver<MICON$> = MIcon
TypeOVer<MTEXTWIDTH$> = Msg_Len
TypeOver<MBKCOLOR$> = 192:@VM:192:@VM:192
TypeOver<MCAPTION$> = MTitle
TypeOver<MJUST$> = 'L'
Msg('',TypeOver)
*/
NEXT M
CALL Set_Status(0)
dummy = Create_Dialog('DIALOG_ERRMSG',@WINDOW,0,ErrDispLines)
RETURN