**********************************************************************************************
      * DBG202R4: Progress meter
      * Copyright (C) 2001  Martin Rowe   <martin@dbg400.net>
      *
      * This program is free software; you can redistribute it and/or modify
      * it under the terms of the GNU General Public License as published by
      * the Free Software Foundation; either version 2 of the License, or
      * (at your option) any later version.
      *
      * This program is distributed in the hope that it will be useful,
      * but WITHOUT ANY WARRANTY; without even the implied warranty of
      * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      * GNU General Public License for more details.
      *
      * You should have received a copy of the GNU General Public License
      * along with this program; if not, write to the Free Software
      * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
      **********************************************************************************************
     H DATEDIT(*YMD) DEBUG(*YES) OPTION(*NODEBUGIO : *SRCSTMT)
      **********************************************************************************************
      * FILES:
      **********************************************************************************************
      **********************************************************************************************
      * ARRAYS:
      **********************************************************************************************
      **********************************************************************************************
      * DATA STRUCTURES:
      **********************************************************************************************
      **********************************************************************************************
      *  PROGRAM NAME
     D                SDS
     D SDS_Pgm                 1     10
      *
     D P_Error         DS
     D zBytp                         10I 0
     D zByta                         10I 0
     D zErrid                         7
     D zError                         1
     D zExdta                       240
      **********************************************************************************************
      * WORK FIELDS:
      **********************************************************************************************
     D Complete        S             50
     D Fraction        S              3  0
     D JobType         S              1
     D P_DataLength    S             10I 0
     D P_Format        S              8    INZ('JOBI0100')
     D P_IntJob        S             16
     D P_Marker        S              1
     D P_MsgData       S            512
     D P_MsgFile       S             20    INZ('QCPFMSG   *LIBL')
     D P_MsgID         S              7    INZ('CPDA0FF')
     D P_MsgKey        S              4
     D P_MsgType       S             10
     D P_Percent       S              3  0
     D P_PgmQueue      S             10
     D P_PgmStack      S             10I 0
     D P_Rcvr          S            100
     D P_RcvrLen       S             10I 0 INZ(100)
     D P_Text          S             20
     D P_ThisJob       S             26    INZ('*')
     D Progress        S             50
     D Pointer         S             50
      **********************************************************************************************
      * CONSTANTS:
      **********************************************************************************************
      **********************************************************************************************
      * ENTRY PARAMETERS:
      **********************************************************************************************
     C     *ENTRY        PLIST
     C                   PARM                    P_Percent
     C                   PARM                    P_Text
     C                   PARM                    P_Marker
      **********************************************************************************************
      * MAINLINE:
      **********************************************************************************************
      * Determine job type (interactive or batch) if first time through
B001 C                   IF        JobType = *BLANKS
     C                   CALL      'QUSRJOBI'
     C                   PARM                    P_Rcvr
     C                   PARM                    P_RcvrLen
     C                   PARM                    P_Format
     C                   PARM                    P_ThisJob
     C                   PARM                    P_IntJob
     C                   EVAL      JobType = %SUBST(P_Rcvr : 61 :1)
E001 C                   ENDIF
      * Show uncompleted work as a row of dots
     C                   EVAL      Progress = *ALL'.'
      * If an attribute below x'20' (normal green) specified, swap for yellow reverse (safer)
     C                   IF        P_Marker < X'20'
     C                   EVAL      P_Marker = X'33'
     C                   ENDIF
      * Build completion overlay for marker values of *blank and above
     C                   IF        P_Marker >= X'40'
     C     ' ':P_Marker  XLATE     Complete      Pointer
     C                   ENDIF
      * Make sure percent value is in a safe range (0-100)
B001 C                   IF        P_Percent > 100
     C                   EVAL      P_Percent = 100
E001 C                   ENDIF
B001 C                   IF        P_Percent < 0
     C                   EVAL      P_Percent = 0 - P_Percent
E001 C                   ENDIF
      * As we only have enough space for a line of fifty, halve the percentage to fit
     C                   EVAL      Fraction = P_Percent / 2
      * Replace the the dots in the completed section with the requested marker
     C                   EVAL      %SUBST(Progress : 1 : Fraction) =
     C                             %SUBST(Pointer : 1 : Fraction)
      * Format the message accoring to marker type - row of characters or solid reverse image bar
     C                   IF        P_Marker >= X'40'
     C                   EVAL      P_MsgData = P_Text + ' ' +
     C                             %EDITC(P_Percent:'Z') + '% ' + Progress
     C                   ELSE
     C                   IF        Fraction < 50
     C                   EVAL      %SUBST(Progress : Fraction + 1 : 1) = X'22'
     C                   ENDIF
     C                   EVAL      P_MsgData = P_Text + ' ' +
     C                             %EDITC(P_Percent:'Z') + '%' + P_Marker +
     C                             Progress
     C                   ENDIF

     C                   EVAL      P_DataLength = 76
     C                   EVAL      P_PgmStack = 0
     C                   EVAL      P_PgmQueue = '*EXT'
      * Send message to this program's own queue if in batch (log in job log)
B001 C                   IF        JobType = 'B'
     C                   EVAL      P_MsgType = '*INFO'
X001 C                   ELSE
      * Otherwise send status message for interactive request
     C                   EVAL      P_MsgType = '*STATUS'
E001 C                   ENDIF
      *
     C                   CALL (E)  'QMHSNDPM'
     C                   PARM                    P_MsgID
     C                   PARM                    P_MsgFile
     C                   PARM                    P_MsgData
     C                   PARM                    P_DataLength
     C                   PARM                    P_MsgType
     C                   PARM                    P_PgmQueue
     C                   PARM                    P_PgmStack
     C                   PARM                    P_MsgKey
     C                   PARM                    P_Error
      *
     C                   RETURN
      **********************************************************************************************