Compile Subroutine ErrLog(ErrCodes) DECLARE SUBROUTINE Set_Status $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 = @VM:ErrCodes ;* Allows passing of a straight text message IF ErrCodes[-1,1] = @FM THEN ErrCodes[-1,1] = '' CONVERT ']' TO @SVM IN ErrCodes ErrRecord = '' FOR M = 1 TO COUNT(ErrCodes,@FM) + (ErrCodes NE '') MsgID = ErrCodes MsgParms = ErrCodes BEGIN CASE CASE ErrCodes = 'STPROC' MText = ErrCodes MTitle = ErrCodes CASE ErrCodes = '' IF INDEX(MsgParms,@SVM,1) THEN MText = ErrCodes MTitle = ErrCodes END ELSE MText = MsgParms MTitle = 'Application Error Message' END 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) END ELSE MText = MsgID END END ELSE MText = "OSREAD Error on file: REVERROR.DAT." END MTitle ='System Error Message' END CASE * Display the message SWAP @SVM WITH ', ' IN MText ErrLogLine = MTitle:' - ':MText CDt = OCONV(Date(),'D4/') CTm = OCONV(Time(),'MTS') ErrRecord<1,-1> = CDt:' ':CTm:' - ':ErrLogLine NEXT M Set_Status(0) OPEN 'SYSLISTS' TO ListsFile THEN READ ErrFile FROM ListsFile,'VISION_COMM_ERROR' ELSE ErrFile = '' NewLineCnt = COUNT(ErrRecord,@FM) + (ErrRecord NE '') FileLineCnt = COUNT(ErrFile,@FM) + (ErrFile NE '') IF FileLineCnt > 500 THEN FOR I = FileLineCnt TO (FileLineCnt - NewLineCnt) STEP -1 ErrFile = DELETE(ErrFile,1,I,0) NEXT I END ErrFile = INSERT(ErrFile,1,1,0,ErrRecord) WRITE ErrFile ON ListsFile,'VISION_COMM_ERROR' ELSE NULL END RETURN