midrange.com code scratchpad
Name:
Rick Chevalier
Scriptlanguage:
Plain Text
Tabwidth:
2
Date:
05/28/2009 12:35:15 pm
IP:
Logged
Description:
Capture program information on error. Based on example from the redbook 'RPG Error and Exception Handling.' http://www.redbooks.ibm.com/Redbooks.nsf/RedbookAbstracts/redp4321.html?Open
Code:
  1.      H DftActGrp(*No) ActGrp(*Caller) Option(*SrcStmt:*NoDebugIO)
  2.      H BndDir('LSBIND')
  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   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
  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.       //--------------------------------------------------------------------------------------------
  52.       // Internal procedure prototypes
  53.       //--------------------------------------------------------------------------------------------
  54.  
  55.       //--------------------------------------------------------------------------------------------
  56.       // Procedure interface for program entry
  57.       //--------------------------------------------------------------------------------------------
  58.      d LogErrorInformation...
  59.      d                 pi
  60.  
  61.       //--------------------------------------------------------------------------------------------
  62.       // Data definitions
  63.       //--------------------------------------------------------------------------------------------
  64.  
  65.       // Indicators for print file
  66.      d PrintIndDS      ds
  67.      d  PrtHelpLine                    n   Dim(10)
  68.  
  69.       // Break out error message help text into print fields
  70.      d HlpText         DS
  71.      d HlpText01
  72.      d HlpText02
  73.      d HlpText03
  74.      d HlpText04
  75.      d HlpText05
  76.      d HlpText06
  77.      d HlpText07
  78.      d HlpText08
  79.      d HlpText09
  80.      d HlpText10
  81.      d HlpTextArray                  80a   Dim(10) Overlay(HlpText)
  82.  
  83.       // Break out display screen text into print fields
  84.      d ScreenIn        DS                  Inz
  85.      d Row8001                             OverLay(ScreenIn:1)
  86.      d Row8002                             OverLay(ScreenIn:*Next)
  87.      d Row8003                             OverLay(ScreenIn:*Next)
  88.      d Row8004                             OverLay(ScreenIn:*Next)
  89.      d Row8005                             OverLay(ScreenIn:*Next)
  90.      d Row8006                             OverLay(ScreenIn:*Next)
  91.      d Row8007                             OverLay(ScreenIn:*Next)
  92.      d Row8008                             OverLay(ScreenIn:*Next)
  93.      d Row8009                             OverLay(ScreenIn:*Next)
  94.      d Row8010                             OverLay(ScreenIn:*Next)
  95.      d Row8011                             OverLay(ScreenIn:*Next)
  96.      d Row8012                             OverLay(ScreenIn:*Next)
  97.      d Row8013                             OverLay(ScreenIn:*Next)
  98.      d Row8014                             OverLay(ScreenIn:*Next)
  99.      d Row8015                             OverLay(ScreenIn:*Next)
  100.      d Row8016                             OverLay(ScreenIn:*Next)
  101.      d Row8017                             OverLay(ScreenIn:*Next)
  102.      d Row8018                             OverLay(ScreenIn:*Next)
  103.      d Row8019                             OverLay(ScreenIn:*Next)
  104.      d Row8020                             OverLay(ScreenIn:*Next)
  105.      d Row8021                             OverLay(ScreenIn:*Next)
  106.      d Row8022                             OverLay(ScreenIn:*Next)
  107.      d Row8023                             OverLay(ScreenIn:*Next)
  108.      d Row8024                             OverLay(ScreenIn:*Next)
  109.      d Row13201                            OverLay(ScreenIn:1)
  110.      d Row13202                            OverLay(ScreenIn:*Next)
  111.      d Row13203                            OverLay(ScreenIn:*Next)
  112.      d Row13204                            OverLay(ScreenIn:*Next)
  113.      d Row13205                            OverLay(ScreenIn:*Next)
  114.      d Row13206                            OverLay(ScreenIn:*Next)
  115.      d Row13207                            OverLay(ScreenIn:*Next)
  116.      d Row13208                            OverLay(ScreenIn:*Next)
  117.      d Row13209                            OverLay(ScreenIn:*Next)
  118.      d Row13210                            OverLay(ScreenIn:*Next)
  119.      d Row13211                            OverLay(ScreenIn:*Next)
  120.      d Row13212                            OverLay(ScreenIn:*Next)
  121.      d Row13213                            OverLay(ScreenIn:*Next)
  122.      d Row13214                            OverLay(ScreenIn:*Next)
  123.      d Row13215                            OverLay(ScreenIn:*Next)
  124.      d Row13216                            OverLay(ScreenIn:*Next)
  125.      d Row13217                            OverLay(ScreenIn:*Next)
  126.      d Row13218                            OverLay(ScreenIn:*Next)
  127.      d Row13219                            OverLay(ScreenIn:*Next)
  128.      d Row13220                            OverLay(ScreenIn:*Next)
  129.      d Row13221                            OverLay(ScreenIn:*Next)
  130.      d Row13222                            OverLay(ScreenIn:*Next)
  131.      d Row13223                            OverLay(ScreenIn:*Next)
  132.      d Row13224                            OverLay(ScreenIn:*Next)
  133.      d Row13225                            OverLay(ScreenIn:*Next)
  134.      d Row13226                            OverLay(ScreenIn:*Next)
  135.      d Row13227                            OverLay(ScreenIn:*Next)
  136.  
  137.       // Program status information
  138.      d ProgramStatus  SDS
  139.      d NAME                          10a   Overlay(ProgramStatus:244)
  140.      d USER                          10a   Overlay(ProgramStatus:254)
  141.      d JOBNO                          6a   Overlay(ProgramStatus:264)
  142.  
  143.       // Definitions for message information API
  144.      d MsgBack         DS                  LikeDs(RCVM0300) Inz
  145.  
  146.      d InfoPtr         S               *
  147.  
  148.      d MsgInfo         DS                  LikeDs(RCVM0300SndRcvInfo)
  149.      d                                     Based(InfoPtr)
  150.  
  151.      d i               S             10I 0
  152.      d SetMsgKey       S              4    Inz(*ALLx'00')
  153.      d BufferHandle    S             10I 0
  154.      d BytesReturned   S             10I 0
  155.      d DataPtr         S               *
  156.  
  157.       // Definitions for screen capture API
  158.      d CatchScreen     DS                  LikeDS(ScreenIn)
  159.      d                                     Based(DataPtr)
  160.  
  161.       // Definitions for command to send notification e-mail
  162.      d CmdAndType      c                   'snddst type(*lmsg)'
  163.      d ToIntNet        c                   'tointnet((softwaresolutionssupport@-
  164.      d                                     americredit.com))'
  165.      d LongMsg         s           5000a
  166.      d LongMsgParm     c                   'longmsg('
  167.      d Subject         s             60a
  168.      d SubjectParm     c                   'subject('
  169.      d LeftParen       c                   '('
  170.      d RightParen      c                   ')'
  171.      d Quote           c                   x'7D'
  172.      d Description     c                   'dstd(''Program Error'')'
  173.      d SndDstCommand   s          32702a
  174.  
  175.       // Formatting constants
  176.      d NewLine         c                   ':/N'
  177.      d NewPar          c                   ':/P'
  178.  
  179.       // Header layout information
  180.      d TitleBar        ds
  181.      d  emDateLabel                   6a   Inz('Date:')
  182.      d  emDate                       10a
  183.      d  emSpacer1                     3a
  184.      d  emTimeLabel                   6a   Inz('Time:')
  185.      d  emTime                        8a
  186.      d  emSpacer2                     3a
  187.      d  emJobLabel                    5a   Inz('Job:')
  188.      d  emJob                        28a
  189.  
  190.       // Acceptable procedure name characters for message subject
  191.      d ValidChars      c                   ' 01234567890-
  192.      d                                     abcdefghijklmnopqrstuvwxyz-
  193.      d                                     ABCDEFGHIJKLMNOPQRSTUVWXYZ'
  194.  
  195.      d SubjectProcName...
  196.      d                 s             10a
  197.  
  198.       //--------------------------------------------------------------------------------------------
  199.       // Calculations
  200.       //--------------------------------------------------------------------------------------------
  201.  
  202.       /Free
  203.  
  204.         // Open error log print file and write header
  205.         Open LogErrLst;
  206.         Write Head;
  207.  
  208.         // Retrieve error message
  209.         ReceiveMsg(MsgBack :%size(MsgBack) :'RCVM0300' :'*' :2 :'*PRV'
  210.                   :SetMsgKey :0 :'*SAME'  :APIError);
  211.  
  212.         // If the message retrieval was successful print the message information
  213.         If MsgBack.ByteAvail > 0;
  214.           MsgText = %SubSt(MsgBack.MsgData :MsgBack.LenReplace1 + 1
  215.                           :MsgBack.LenMsgReturn);
  216.           HlpText = %SubSt(MsgBack.MsgData:
  217.           MsgBack.LenReplace1 + MsgBack.LenMsgReturn + 1:
  218.           MsgBack.LenHelpReturn);
  219.           InfoPtr = %Addr(MsgBack.MsgData) + MsgBack.LenReplace1
  220.                         + MsgBack.LenMsgReturn + MsgBack.LenHelpReturn;
  221.           Program = MsgInfo.ReceivingPgm;
  222.           Module = MsgInfo.ReceivingModule;
  223.           Procedure = MsgInfo.ReceivingProcedure;
  224.           Statement = MsgInfo.StateNosReceiving;
  225.  
  226.           // Only print message lines with text
  227.           For i = 1 to %Elem(HlpTextArray);
  228.  
  229.             If HlpTextArray(i) <> *Blanks;
  230.               PrtHelpLine(i) = *On;
  231.             EndIf;
  232.  
  233.           EndFor;
  234.  
  235.           Write Detail;
  236.  
  237.           If OverFlow;
  238.             Write Head;
  239.             OverFlow = *Off;
  240.           EndIf;
  241.  
  242.         EndIf;
  243.  
  244.         // Capture current interactive screen image
  245.         BufferHandle = CreateInputBuffer(27 * 132 :*Omit :*Omit :*Omit
  246.                                         :APIError);
  247.  
  248.         If APIError.BytesAvail = 0;
  249.           BytesReturned = ReadScreen(*Omit :BufferHandle :*Omit :*Omit
  250.                                     :APIError);
  251.           DataPtr = RetrieveDataPtr(BufferHandle :*Omit :APIError);
  252.           ScreenIn = %SubSt(CatchScreen :1 :BytesReturned);
  253.  
  254.           For i = 1 to BytesReturned;
  255.  
  256.             If ((%SubSt(ScreenIn :i :1) > x'19') and
  257.                 (%SubSt(ScreenIn :i :1) < x'40')) or
  258.                (%SubSt(ScreenIn :i :1) = x'00');
  259.               %SubSt(ScreenIn :i :1) = *Blank;
  260.             EndIf;
  261.  
  262.           EndFor;
  263.  
  264.           If BytesReturned = 1920;
  265.             Write Screen80;
  266.           Else;
  267.             Write Screen132;
  268.           EndIf;
  269.  
  270.         EndIf;
  271.  
  272.         // Write error log footer and close print file
  273.         Write Footer;
  274.         Close LogErrLst;
  275.  
  276.         // Write information to system error log file
  277.         Open ErrLog;
  278.         elErrDte = %Date();
  279.         elErrTme = %Time();
  280.         elJobNme = Name;
  281.         elUsrID = User;
  282.         elJobNbr = JobNo;
  283.         elProgram = Program;
  284.         elModule = Module;
  285.         elProc = MsgInfo.ReceivingProcedure;
  286.         elStmt = Statement;
  287.         elErrInf = MsgText + HlpText;
  288.         elScnInf = ScreenIn;
  289.         Write ErrLogRec;
  290.         Close ErrLog;
  291.  
  292.         // Send notification e-mail
  293.         emDate = %Char(%Date());
  294.         emTime = %Char(%Time());
  295.         emJob = JobNo + '/' + %TrimR(User) + '/' + Name;
  296.  
  297.         LongMsg = Quote + TitleBar + NewPar + 'Program: ' + %TrimR(Program) +
  298.                   NewLine + 'Module: ' + %TrimR(Module) + NewLine +
  299.                   'Procedure: ' + %TrimR(Procedure) + NewLine + 'Statement: ' +
  300.                   %TrimR(Statement) + NewPar + %TrimR(MsgText) + NewPar +
  301.                   %TrimR(HlpText) + Quote + RightParen;
  302.  
  303.         i = %CheckR(ValidChars :Procedure);
  304.  
  305.         If i = 0;
  306.           SubjectProcName = Procedure;
  307.         Else;
  308.           SubjectProcName = %SubSt(Procedure :i+1 :10);
  309.         EndIf;
  310.  
  311.         Subject = Quote + MsgBack.MsgID + ' received by ' +
  312.                   %TrimR(Program) + '.' +  %TrimR(Module) + '.' +
  313.                   Procedure;
  314.         //        SubjectProcName;
  315.  
  316.         If %Len(%TrimR(Subject)) > 58;
  317.           %SubSt(Subject :59 :2) = (Quote + RightParen);
  318.         Else;
  319.           Subject = %TrimR(Subject) + Quote + RightParen;
  320.         EndIf;
  321.  
  322.         SndDstCommand = CmdAndType + ' ' + ToIntNet + ' ' + LongMsgParm +
  323.                         %TrimR(LongMsg) + ' ' + SubjectParm +  Subject +
  324.                         ' ' + Description;
  325.  
  326.         // Debugging
  327.         Dump(A);
  328.  
  329.         PrcCmd(SndDstCommand);
  330.  
  331.         // End program
  332.         *InLR = *On;
  333.  
  334.         //----------------------------------------------------------------------
  335.         // Program Status Subroutine to handle unexpected errors
  336.         //----------------------------------------------------------------------
  337.         BegSR *PSSR;
  338.  
  339.           Dump(A);
  340.  
  341.         EndSr '*CANCL';
  342.  
  343.       /End-Free 
© 2004-2019 by midrange.com generated in 0.009s valid xhtml & css