midrange.com code scratchpad
Name:
Generic Message Logging
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
02/25/2010 05:25:43 pm
IP:
Logged
Description:
Captures the error message, screen layout, and writes them to a report. Writes the error information to a log file and sends an e-mail message with the error information.
Code:
  1.      H DftActGrp(*No) ActGrp(*Caller) Option(*SrcStmt:*NoDebugIO)
  2.      H BndDir('LSBIND' :'UTBIND')
  3.       //--------------------------------------------------------------------------------------------
  4.       //   Program  . . :  LOGERR                     Author . . :  Rick Chevalier
  5.       //   Date . . . . :   6/25/2008
  6.       //   Project  . . :  RM00140121
  7.       //   Purpose  . . :  Retrieve message information, program and procedure, and screen
  8.       //                   information when an error is encountered.
  9.       //
  10.       //                   Usage would be in the *PSSR of application programs.
  11.       //--------------------------------------------------------------------------------------------
  12.       //   Modifications:
  13.       //
  14.       //  Project        Date         Developer                  Description
  15.       //--------------------------------------------------------------------------------------------
  16.       // xxxxxxxxx    xx/xx/xxxx   xxxxxxxxxxxxxxx   xxxxxxxxxxxxxxxxxxxxxxxxxx
  17.       //--------------------------------------------------------------------------------------------
  18.       //
  19.       //--------------------------------------------------------------------------------------------
  20.       // File definitions
  21.       //--------------------------------------------------------------------------------------------
  22.      fErrLog    O    E             Disk    UsrOpn Rename(ERRLOG :ErrLogRec)
  23.       // Error information log file
  24.  
  25.      fLogErrLst O    E             Printer
  26.      f                                     USROPN
  27.      f                                     OFlInd(OverFlow)
  28.      f                                     IndDS(PrintIndDS)
  29.       // Error information print file
  30.  
  31.       //--------------------------------------------------------------------------------------------
  32.       // Shared field and program definitions
  33.       //--------------------------------------------------------------------------------------------
  34.       /Copy QSRCLS,LOGERRCPY
  35.  
  36.       //--------------------------------------------------------------------------------------------
  37.       // Entry parameter definition
  38.       //--------------------------------------------------------------------------------------------
  39.      d LogErrorInformation...
  40.      d                 pr                  ExtPgm('LOGERR')
  41.  
  42.       //--------------------------------------------------------------------------------------------
  43.       // External procedure prototypes
  44.       //--------------------------------------------------------------------------------------------
  45.  
  46.       // Process command (QCAPCMD) API.  Check or run a CL command.
  47.      d prccmd          pr              *
  48.      d  Command                   32702                                         Command
  49.      d  PromptType                    1    options(*nopass: *omit)              Prompt type
  50.  
  51.       // Begin add xxxxx
  52.       // Send e-mail message service program
  53.       /Include QCPYSRC,UT1010CPY
  54.  
  55.       // Wrappers for Work Management API's
  56.       /Include QCPYSRC,UT1015CPY
  57.       // End add xxxxx
  58.  
  59.       //--------------------------------------------------------------------------------------------
  60.       // Internal procedure prototypes
  61.       //--------------------------------------------------------------------------------------------
  62.  
  63.       //--------------------------------------------------------------------------------------------
  64.       // Procedure interface for program entry
  65.       //--------------------------------------------------------------------------------------------
  66.      d LogErrorInformation...
  67.      d                 pi
  68.  
  69.       //--------------------------------------------------------------------------------------------
  70.       // Data definitions
  71.       //--------------------------------------------------------------------------------------------
  72.  
  73.       // Indicators for print file
  74.      d PrintIndDS      ds
  75.      d  PrtHelpLine                    n   Dim(10)
  76.  
  77.       // Break out error message help text into print fields
  78.      d HlpText         DS
  79.      d HlpText01
  80.      d HlpText02
  81.      d HlpText03
  82.      d HlpText04
  83.      d HlpText05
  84.      d HlpText06
  85.      d HlpText07
  86.      d HlpText08
  87.      d HlpText09
  88.      d HlpText10
  89.      d HlpTextArray                  80a   Dim(10) Overlay(HlpText)
  90.  
  91.       // Break out display screen text into print fields
  92.      d ScreenIn        DS                  Inz
  93.      d Row8001                             OverLay(ScreenIn:1)
  94.      d Row8002                             OverLay(ScreenIn:*Next)
  95.      d Row8003                             OverLay(ScreenIn:*Next)
  96.      d Row8004                             OverLay(ScreenIn:*Next)
  97.      d Row8005                             OverLay(ScreenIn:*Next)
  98.      d Row8006                             OverLay(ScreenIn:*Next)
  99.      d Row8007                             OverLay(ScreenIn:*Next)
  100.      d Row8008                             OverLay(ScreenIn:*Next)
  101.      d Row8009                             OverLay(ScreenIn:*Next)
  102.      d Row8010                             OverLay(ScreenIn:*Next)
  103.      d Row8011                             OverLay(ScreenIn:*Next)
  104.      d Row8012                             OverLay(ScreenIn:*Next)
  105.      d Row8013                             OverLay(ScreenIn:*Next)
  106.      d Row8014                             OverLay(ScreenIn:*Next)
  107.      d Row8015                             OverLay(ScreenIn:*Next)
  108.      d Row8016                             OverLay(ScreenIn:*Next)
  109.      d Row8017                             OverLay(ScreenIn:*Next)
  110.      d Row8018                             OverLay(ScreenIn:*Next)
  111.      d Row8019                             OverLay(ScreenIn:*Next)
  112.      d Row8020                             OverLay(ScreenIn:*Next)
  113.      d Row8021                             OverLay(ScreenIn:*Next)
  114.      d Row8022                             OverLay(ScreenIn:*Next)
  115.      d Row8023                             OverLay(ScreenIn:*Next)
  116.      d Row8024                             OverLay(ScreenIn:*Next)
  117.      d Row13201                            OverLay(ScreenIn:1)
  118.      d Row13202                            OverLay(ScreenIn:*Next)
  119.      d Row13203                            OverLay(ScreenIn:*Next)
  120.      d Row13204                            OverLay(ScreenIn:*Next)
  121.      d Row13205                            OverLay(ScreenIn:*Next)
  122.      d Row13206                            OverLay(ScreenIn:*Next)
  123.      d Row13207                            OverLay(ScreenIn:*Next)
  124.      d Row13208                            OverLay(ScreenIn:*Next)
  125.      d Row13209                            OverLay(ScreenIn:*Next)
  126.      d Row13210                            OverLay(ScreenIn:*Next)
  127.      d Row13211                            OverLay(ScreenIn:*Next)
  128.      d Row13212                            OverLay(ScreenIn:*Next)
  129.      d Row13213                            OverLay(ScreenIn:*Next)
  130.      d Row13214                            OverLay(ScreenIn:*Next)
  131.      d Row13215                            OverLay(ScreenIn:*Next)
  132.      d Row13216                            OverLay(ScreenIn:*Next)
  133.      d Row13217                            OverLay(ScreenIn:*Next)
  134.      d Row13218                            OverLay(ScreenIn:*Next)
  135.      d Row13219                            OverLay(ScreenIn:*Next)
  136.      d Row13220                            OverLay(ScreenIn:*Next)
  137.      d Row13221                            OverLay(ScreenIn:*Next)
  138.      d Row13222                            OverLay(ScreenIn:*Next)
  139.      d Row13223                            OverLay(ScreenIn:*Next)
  140.      d Row13224                            OverLay(ScreenIn:*Next)
  141.      d Row13225                            OverLay(ScreenIn:*Next)
  142.      d Row13226                            OverLay(ScreenIn:*Next)
  143.      d Row13227                            OverLay(ScreenIn:*Next)
  144.  
  145.       // Program status information
  146.      d ProgramStatus  SDS
  147.      d NAME                          10a   Overlay(ProgramStatus:244)
  148.      d USER                          10a   Overlay(ProgramStatus:254)
  149.      d JOBNO                          6a   Overlay(ProgramStatus:264)
  150.  
  151.       // Definitions for message information API
  152.      d MsgBack         DS                  LikeDs(RCVM0300) Inz
  153.  
  154.      d InfoPtr         S               *
  155.  
  156.      d MsgInfo         DS                  LikeDs(RCVM0300SndRcvInfo)
  157.      d                                     Based(InfoPtr)
  158.  
  159.      d i               S             10I 0
  160.      d SetMsgKey       S              4    Inz(*ALLx'00')
  161.      d BufferHandle    S             10I 0
  162.      d BytesReturned   S             10I 0
  163.      d DataPtr         S               *
  164.  
  165.       // Definitions for screen capture API
  166.      d CatchScreen     DS                  LikeDS(ScreenIn)
  167.      d                                     Based(DataPtr)
  168.  
  169.       // Definitions for command to send notification e-mail
  170.       // Begin changed xxxxx
  171.      d*CmdAndType      c                   'snddst type(*lmsg)'
  172.      d*ToIntNet        c                   'tointnet((softwaresolutionssupport@-
  173.      d*                                    americredit.com))'
  174.      d LongMsg         s          32000a   Varying
  175.      d*LongMsgParm     c                   'longmsg('
  176.      d Subject         s            128a   Varying
  177.      d*SubjectParm     c                   'subject('
  178.      d LeftParen       c                   '('
  179.      d RightParen      c                   ')'
  180.      d Quote           c                   x'7D'
  181.      d*Description     c                   'dstd(''Program Error'')'
  182.      d*SndDstCommand   s          32702a
  183.       // End changed xxxxx
  184.  
  185.       // Begin add xxxxx
  186.      d ErrorCode       s              7a
  187.      d SenderAddrKey   s             32a   Inz('LOGERR')
  188.      d RecipientsKey   s             32a   Inz('LOGERR')
  189.      d AttachmentList  ds                  LikeDS(AttachmentList_t) Inz
  190.      d Interactive     c                   'I'
  191.       // End add xxxxx
  192.  
  193.       // Formatting constants
  194.       // Begin changed xxxxx
  195.      d NewLine         c                   x'0C'
  196.      d NewPar          c                   x'0C0C'
  197.       // End changed xxxxx
  198.  
  199.       // Header layout information
  200.      d TitleBar        ds
  201.      d  emDateLabel                   6a   Inz('Date:')
  202.      d  emDate                       10a
  203.      d  emSpacer1                     3a
  204.      d  emTimeLabel                   6a   Inz('Time:')
  205.      d  emTime                        8a
  206.      d  emSpacer2                     3a
  207.      d  emJobLabel                    5a   Inz('Job:')
  208.      d  emJob                        28a
  209.  
  210.       // Acceptable procedure name characters for message subject
  211.      d ValidChars      c                   ' 01234567890-
  212.      d                                     abcdefghijklmnopqrstuvwxyz-
  213.      d                                     ABCDEFGHIJKLMNOPQRSTUVWXYZ'
  214.  
  215.      d SubjectProcName...
  216.      d                 s             10a
  217.  
  218.       //--------------------------------------------------------------------------------------------
  219.       // Calculations
  220.       //--------------------------------------------------------------------------------------------
  221.  
  222.       /Free
  223.  
  224.         // Open error log print file and write header
  225.         Open LogErrLst;
  226.         Write Head;
  227.  
  228.         // Retrieve error message
  229.         ReceiveMsg(MsgBack :%size(MsgBack) :'RCVM0300' :'*' :2 :'*PRV'
  230.                   :SetMsgKey :0 :'*SAME'  :APIError);
  231.  
  232.         // If the message retrieval was successful print the message information
  233.         If MsgBack.ByteAvail > 0;
  234.           MsgText = %SubSt(MsgBack.MsgData :MsgBack.LenReplace1 + 1
  235.                           :MsgBack.LenMsgReturn);
  236.           HlpText = %SubSt(MsgBack.MsgData:
  237.           MsgBack.LenReplace1 + MsgBack.LenMsgReturn + 1:
  238.           MsgBack.LenHelpReturn);
  239.           InfoPtr = %Addr(MsgBack.MsgData) + MsgBack.LenReplace1
  240.                         + MsgBack.LenMsgReturn + MsgBack.LenHelpReturn;
  241.           Program = MsgInfo.ReceivingPgm;
  242.           Module = MsgInfo.ReceivingModule;
  243.           Procedure = MsgInfo.ReceivingProcedure;
  244.           Statement = MsgInfo.StateNosReceiving;
  245.  
  246.           // Only print message lines with text
  247.           For i = 1 to %Elem(HlpTextArray);
  248.  
  249.             If HlpTextArray(i) <> *Blanks;
  250.               PrtHelpLine(i) = *On;
  251.             EndIf;
  252.  
  253.           EndFor;
  254.  
  255.           Write Detail;
  256.  
  257.           If OverFlow;
  258.             Write Head;
  259.             OverFlow = *Off;
  260.           EndIf;
  261.  
  262.         EndIf;
  263.  
  264.         // Capture current interactive screen image
  265.         // Begin change xxxxx
  266.         // Wrapped existing code in if statement for interactive environment
  267.         If CurrentJobEnvironment() = Interactive;
  268.           BufferHandle = CreateInputBuffer(27 * 132 :*Omit :*Omit :*Omit
  269.                                           :APIError);
  270.  
  271.           If APIError.BytesAvail = 0;
  272.             BytesReturned = ReadScreen(*Omit :BufferHandle :*Omit :*Omit
  273.                                       :APIError);
  274.             DataPtr = RetrieveDataPtr(BufferHandle :*Omit :APIError);
  275.             ScreenIn = %SubSt(CatchScreen :1 :BytesReturned);
  276.  
  277.             For i = 1 to BytesReturned;
  278.  
  279.               If ((%SubSt(ScreenIn :i :1) > x'19') and
  280.                   (%SubSt(ScreenIn :i :1) < x'40')) or
  281.                  (%SubSt(ScreenIn :i :1) = x'00');
  282.                 %SubSt(ScreenIn :i :1) = *Blank;
  283.               EndIf;
  284.  
  285.             EndFor;
  286.  
  287.             If BytesReturned = 1920;
  288.               Write Screen80;
  289.             Else;
  290.               Write Screen132;
  291.             EndIf;
  292.  
  293.           EndIf;  // APIError.BytesAvail = 0
  294.  
  295.         EndIf;  // CurentJobEnvironment() = Interactive
  296.         // End change xxxxx
  297.  
  298.         // Write error log footer and close print file
  299.         Write Footer;
  300.         Close LogErrLst;
  301.  
  302.         // Write information to system error log file
  303.         Open ErrLog;
  304.         elErrDte = %Date();
  305.         elErrTme = %Time();
  306.         elJobNme = Name;
  307.         elUsrID = User;
  308.         elJobNbr = JobNo;
  309.         elProgram = Program;
  310.         elModule = Module;
  311.         elProc = MsgInfo.ReceivingProcedure;
  312.         elStmt = Statement;
  313.         elErrInf = MsgText + HlpText;
  314.         elScnInf = ScreenIn;
  315.         Write ErrLogRec;
  316.         Close ErrLog;
  317.  
  318.         // Send notification e-mail
  319.         emDate = %Char(%Date());
  320.         emTime = %Char(%Time());
  321.         emJob = JobNo + '/' + %TrimR(User) + '/' + Name;
  322.  
  323.         LongMsg = TitleBar + NewPar + 'Program: ' + %TrimR(Program) +
  324.                   NewLine + 'Module: ' + %TrimR(Module) + NewLine +
  325.                   'Procedure: ' + %TrimR(Procedure) + NewLine + 'Statement: ' +
  326.                   %TrimR(Statement) + NewPar + %TrimR(MsgText) + NewPar +
  327.                   %TrimR(HlpText);
  328.  
  329.         i = %CheckR(ValidChars :Procedure);
  330.  
  331.         If i = 0;
  332.           SubjectProcName = Procedure;
  333.         Else;
  334.           SubjectProcName = %SubSt(Procedure :i+1 :10);
  335.         EndIf;
  336.  
  337.         Subject = MsgBack.MsgID + ' received by ' +
  338.                   %TrimR(Program) + '.' +  %TrimR(Module) + '.' +
  339.                   Procedure;
  340.  
  341.         // Begin changed xxxxx
  342.         // Removed logic specific to SNDDST command and replace with call to SendAdHocmail
  343.         // If %Len(%TrimR(Subject)) > 58;
  344.         //   %SubSt(Subject :59 :2) = (Quote + RightParen);
  345.         // Else;
  346.         //   Subject = %TrimR(Subject) + Quote + RightParen;
  347.         // EndIf;
  348.  
  349.         // Send e-mail message
  350.         SendAdHocMail(ErrorCode :SenderAddrKey :RecipientsKey :*Omit :Subject
  351.                      :LongMsg :AttachmentList);
  352.  
  353.         // SndDstCommand = CmdAndType + ' ' + ToIntNet + ' ' + LongMsgParm +
  354.         //                 %TrimR(LongMsg) + ' ' + SubjectParm +  Subject +
  355.         //                 ' ' + Description;
  356.  
  357.         // Debugging
  358.         // Dump(A);
  359.  
  360.         // PrcCmd(SndDstCommand);
  361.         // End changed xxxxx
  362.  
  363.         // End program
  364.         *InLR = *On;
  365.  
  366.         //----------------------------------------------------------------------
  367.         // Program Status Subroutine to handle unexpected errors
  368.         //----------------------------------------------------------------------
  369.         BegSR *PSSR;
  370.  
  371.           Dump(A);
  372.  
  373.         EndSr '*CANCL';
  374.  
  375.       /End-Free
  376.  
  377. Source for LOGERRCPY
  378.       // Standard API Error data structure used with most APIs
  379.      D APIError        DS                  Qualified
  380.      D BytesProvided                 10I 0 inz(%size(APIError))
  381.      D BytesAvail                    10I 0 inz(0)
  382.      D MsgId                          7A
  383.      D                                1A
  384.      D MsgData                      240A
  385.  
  386.       //----------------------------------------------------------------
  387.       // Message APIs
  388.       //----------------------------------------------------------------
  389.  
  390.       // Receieve Message from Program Message Queue
  391.      D ReceiveMsg      PR                  ExtPgm('QMHRCVPM')
  392.      D MsgInfo                     3000a   Options(*VarSize)
  393.      D MsgInfoLen                    10I 0 Const
  394.      D FormatName                     8a   Const
  395.      D CallStack                     10a   Const
  396.      D CallStackCtr                  10I 0 Const
  397.      D MsgType                       10a   Const
  398.      D MsgKey                         4a   Const
  399.      D WaitTime                      10I 0 Const
  400.      D MsgAction                     10a   Const
  401.      D ErrorForAPI                         Like(APIError)
  402.  
  403.       //----------------------------------------------------------------
  404.       // Dynamic Screen Manager APIs
  405.       //----------------------------------------------------------------
  406.  
  407.       // Create Input Buffer
  408.      D CreateInputBuffer...
  409.      D                 PR            10I 0 ExtProc( 'QsnCrtInpBuf' )
  410.      D BufferSize                    10I 0 Const
  411.      D Increment                     10I 0 Const Options(*Omit)
  412.      D MaximumSize                   10I 0 Const Options(*Omit)
  413.      D BufferHandle                  10I 0 Options(*Omit)
  414.      D Error                               Like(APIError) Options(*OMIT)
  415.  
  416.       // Read Screen
  417.      D ReadScreen      PR            10I 0 ExtProc( 'QsnReadScr' )
  418.      D BytesRead                     10I 0 Options( *Omit )
  419.      D BufferHandle                  10I 0 Const Options( *Omit )
  420.      D CmdBufferhandle...
  421.      D                               10I 0 Const Options( *Omit )
  422.      D EnvironmentHandle...
  423.      D                               10I 0 Options( *Omit )
  424.      D Error                               Like(APIError) Options(*OMIT)
  425.  
  426.       // Retrieve pointer to data in input buffer
  427.      D RetrieveDataPtr...
  428.      D                 PR              *   ExtProc( 'QsnRtvDta' )
  429.      D BufferHandle                  10I 0 Const
  430.      D DataPointer                     *   Options( *Omit )
  431.      D Error                               Like(APIError) Options(*OMIT)
  432.  
  433.       //----------------------------------------------------------------
  434.       // Base Formats
  435.       //----------------------------------------------------------------
  436.      D DummyPtr        S               *
  437.  
  438.       // DS returned by QMHRCVPM for format RCVM0300
  439.      D RCVM0300        DS                  Qualified Based(DummyPtr)
  440.      D ByteReturned                  10I 0
  441.      D ByteAvail                     10I 0
  442.      D MsgSeverity                   10I 0
  443.      D MsgId                          7A
  444.      D MsgType                        2A
  445.      D MsgKey                         4A
  446.      D MsgFileName                   10A
  447.      D MsgLibSpec                    10A
  448.      D MsgLibUsed                    10A
  449.      D AlertOption                    9A
  450.      D CCSIDCnvIndText...
  451.      D                               10I 0
  452.      D CCSIDCnvIndData...
  453.      D                               10I 0
  454.      D CCSIDMsg                      10I 0
  455.      D CCSIDReplace                  10I 0
  456.      D LenReplace1                   10I 0
  457.      D LenReplace2                   10I 0
  458.      D LenMsgReturn                  10I 0
  459.      D LenMsgAvail                   10I 0
  460.      D LenHelpReturn                 10I 0
  461.      D LenHelpAvail                  10I 0
  462.      D LenSenderReturn...
  463.      D                               10I 0
  464.      D LenSenderAvail...
  465.      D                               10I 0
  466.      D MsgData                     5000A
  467.  
  468.       // Sender structure returned in RCVM0300
  469.      D RCVM0300SndRcvInfo...
  470.      D                 DS                  Qualified Based(DummyPtr)
  471.      D SendingJob                    10A
  472.      D SendIngJobProfile...
  473.      D                               10A
  474.      D SendingJobNo                   6A
  475.      D DateSent                       7A
  476.      D TimeSent                       6A
  477.      D SendingType                    1A
  478.      D ReceivingType                  1A
  479.      D SendingPgm                    12A
  480.      D SendingModule                 10A
  481.      D SendingProcedure...
  482.      D                              256A
  483.      D                                1A
  484.      D NoStateNosSending...
  485.      D                               10I 0
  486.      D StateNosSending...
  487.      D                               30A
  488.      D ReceivingPgm                  10A
  489.      D ReceivingModule...
  490.      D                               10A
  491.      D ReceivingProcedure...
  492.      D                              256A
  493.      D                               10A
  494.      D NoStateNosReceiving...
  495.      D                               10I 0
  496.      D StateNosReceiving...
  497.      D                               30A
  498.      D                                2A
  499.      D LongSendingPgmNameOffset...
  500.      D                               10I 0
  501.      D LongSendingPgmNameLength...
  502.      D                               10I 0
  503.      D LongSendingProcNameOffset...
  504.      D                               10I 0
  505.      D LongSendingProcNameLength...
  506.      D                               10I 0
  507.      D LongReceivingProcNameOffset...
  508.      D                               10I 0
  509.      D LongReceivingProcNameLength...
  510.      D                               10I 0
  511.      D MicroSeconds                   6A
  512.      D SendingUsrPrf                 10A
  513.      D Names                       4000A 
© 2004-2019 by midrange.com generated in 0.008s valid xhtml & css