/* REXX */                                                                      
/*                           */                                                 
/* AUTHOR: Mark Zelden       */                                                 
/*                           */                                                 
/* Last Updated 10/07/2013   */                                                 
/*                           */                                                 
help_start = HELP_INCL()                                                        
/*********************************************************************/         
/*                                                                   */         
/* This EDIT macro totals numbers in a specified column range.       */         
/* An optional parameter of "HEX", "ZONE", "PACK", or "BIN" is       */         
/* needed to add hexadecimal, zoned decimal, packed decimal, or      */         
/* binary data. "DEC" is the default addition type.                  */         
/*                                                                   */         
/* Hexadecimal numbers to be added may be represented with or        */         
/* without an "X". In other words, x'1E' and 1E can both be          */         
/* processed and are treated the same.                               */         
/*                                                                   */         
/* The result is displayed as an ISPF short message in the top       */         
/* right hand corner in the same format as the addition type         */         
/* (decimal or hexadecimal). If extended help is chosen after        */         
/* the result is displayed (normally PF1), then the result is        */         
/* displayed in both decimal and hexadecimal and the average         */         
/* is also displayed.                                                */         
/*                                                                   */         
/* Line range labels can be used, and excluded lines are always      */         
/* omitted.                                                          */         
/*                                                                   */         
/*********************************************************************/         
/* COMMAND SYNTAX AND USAGE NOTES:                                   */         
/*                                                                   */         
/* COLADD begcol endcol <DEC | HEX | ZONE | PACK | BIN> (.L1) (.L2)  */         
/*                    ** DEC is the default                          */         
/*                                                                   */         
/*  ** NOTE 1: If you execute COLADD with no parms or with a parm    */         
/*             of "?", the comment section of this code with syntax  */         
/*             and usage notes will be displayed as "help" note      */         
/*             lines. Use the "RESET" command to remove them.        */         
/*                                                                   */         
/*  ** NOTE 2: If using line range labels then DEC, HEX, ZONE,       */         
/*             PACK, or BIN must be specified as the 3rd positional  */         
/*             parameter.                                            */         
/*                                                                   */         
/*  ** NOTE 3: Excluded lines are ALWAYS omitted.                    */         
/*                                                                   */         
/*  ** NOTE 4: DEC, HEX, ZONE, PACK, and BIN may be abbreviated by   */         
/*             using one or more of their characters. HEX may also   */         
/*             be abbreviated as "X".                                */         
/*                                                                   */         
/*********************************************************************/         
/*  EXAMPLES:                                                        */         
/*                                                                   */         
/*         COLADD 10 25                                              */         
/*         COLADD 33 40 HEX                                          */         
/*         COLADD 25 30 DEC .A .B                                    */         
/*         COLADD 10 29 ZONE                                         */         
/*         COLADD 10 16 PACK                                         */         
/*         COLADD 40 44 BIN                                          */         
/*         COLADD 44 57 X .FROM .TO                                  */         
/*********************************************************************/         
help_end = HELP_INCL()                                                          
/* TRACE ?R */                                                                  
Address ISREDIT                                                                 
"MACRO (begcol endcol type label1 label2)"                                      
 /* Address ISPEXEC "CONTROL ERRORS RETURN"  */                                 
/***********************************************/                               
/*   VERIFY INPUT PARAMETERS                   */                               
/***********************************************/                               
begcol = Translate(begcol) /* chage to upper case if alpha */                   
"(width) = DATA_WIDTH "   /* length of line       */                            
width = Format(width)     /* remove leading zeros */                            
If begcol = '?' then do                                                         
  Call HELP_NOTELINES                                                           
  Exit 1  /* return cursor to command line */                                   
End                                                                             
If begcol = '' then do                                                          
  zedsmsg = 'MISSING PARAMETER'                                                 
  zedlmsg = 'A BEGINNING COLUMN NUMBER',                                        
            'MUST BE SPECIFIED.'                                                
  Address ISPEXEC "SETMSG MSG(ISRZ001)"  /* msg - with alarm */                 
  Call HELP_NOTELINES                                                           
  Exit 4                                                                        
End                                                                             
Select                                                                          
  When Datatype(begcol,Number) = 1 & endcol = '' then do                        
    zedsmsg = 'NO ENDING COLUMN'                                                
    zedlmsg = 'AN ENDING COLUMN NUMBER',                                        
              'MUST BE SPECIFIED.'                                              
    Address ISPEXEC "SETMSG MSG(ISRZ001)"        /* msg - with alarm */         
    Exit 12                                                                     
  End /* when */                                                                
  When Datatype(begcol,Number) <> 1 | ,                                         
       Datatype(endcol,Number) <> 1 then do                                     
    zedsmsg = 'COL NUMBER NOT NUMERIC'                                          
    zedlmsg = 'THE BEGINNING AND ENDING COLUMN NUMBERS',                        
              'MUST BE NUMERIC.'                                                
    Address ISPEXEC "SETMSG MSG(ISRZ001)"        /* msg - with alarm */         
    Exit 12                                                                     
  End /* when */                                                                
  When Datatype(begcol,Number) =1 & Datatype(endcol,Number) =1 then do          
    If endcol < begcol then do                                                  
      zedsmsg = 'END COL < START COL'                                           
      zedlmsg = 'THE ENDING COLUMN MUST BE GREATER THAN OR',                    
                'EQUAL TO THE STARTING COLUMN.'                                 
      Address ISPEXEC "SETMSG MSG(ISRZ001)"      /* msg - with alarm */         
      Exit 12                                                                   
    End                                                                         
    If type = '' then type = 'DEC'        /* default add type is DEC */         
    else do                                                                     
      type = Translate(type)              /* change to upper case    */         
      If Abbrev('DECIMAL',type,1) = 0 & ,                                       
         Abbrev('HEXADECIMAL',type,1) = 0 & ,                                   
         Abbrev('ZONE',type,1) = 0 & ,                                          
         Abbrev('PACK',type,1) = 0 & ,                                          
         Abbrev('BIN',type,1) = 0 & ,                                           
         type <> 'X' then do                                                    
        zedsmsg = 'INVALID ADDITION TYPE'                                       
        zedlmsg = 'ADDITION TYPE MUST BE "DEC", "HEX",' ,                       
                  '"ZONE", "PACK", or "BIN".'                                   
        Address ISPEXEC "SETMSG MSG(ISRZ001)"    /* msg - with alarm */         
        Exit 12                                                                 
      End                                                                       
    End /* else do */                                                           
    If begcol < 1 | endcol < 1 then do                                          
      zedsmsg = 'INVALID COLUMN NUMBER'                                         
      zedlmsg = 'ALL COLUMN SPECIFICATIONS MUST BE' ,                           
                'BETWEEN 1 AND' width                                           
      Address ISPEXEC "SETMSG MSG(ISRZ001)"      /* msg - with alarm */         
      Exit 12                                                                   
    End                                                                         
    If begcol > width | endcol > width then do                                  
      zedsmsg = 'INVALID COLUMN NUMBER'                                         
      zedlmsg = 'ALL COLUMN SPECIFICATIONS MUST BE' ,                           
                'BETWEEN 1 AND' width                                           
      Address ISPEXEC "SETMSG MSG(ISRZ001)"      /* msg - with alarm */         
      Exit 12                                                                   
    End                                                                         
  End /* when */                                                                
End /* select */                                                                
/***********************************************/                               
/*   FIND OUT IF LABELS ARE BEING USED         */                               
/***********************************************/                               
Call FIND_LABELS                                                                
/***************************************************/                           
/* INITIALIZE VARIABLES NEEDED IN PROCESSING LOOP  */                           
/***************************************************/                           
Numeric digits 15                    /* default of 9 not enough      */         
count        = 0                     /* count of added lines         */         
not_counted  = 0                     /* count of "not counted" lines */         
total        = 0                     /* total of numbers added       */         
tgtlen       = endcol-begcol+1       /* length of mumbers to add     */         
/*********************************************************************/         
/*   Begin column addition loop                                      */         
/*********************************************************************/         
Do until lastln = firstln-1                                                     
  /* copy the data in the current line to variable 'data1' */                   
  "(data1) = LINE "firstln                                                      
  "ISREDIT (chkexcl) = XSTATUS" firstln                                         
  If chkexcl = "NX" then do       /* only process non-excluded lines */         
    add_data = Substr(data1,begcol,tgtlen) /* find data              */         
    If add_data = '' then do       /* no data within cols specified  */         
      warnmsg = "'*** WARNING - NEXT LINE WAS NOT COUNTED ***'"                 
      "ISREDIT LINE_BEFORE" firstln "= NOTELINE " warnmsg                       
      not_counted = not_counted + 1 /* bump up "not counted" counter */         
      firstln = firstln + 1        /* bump up line counter           */         
      iterate                      /* get next record                */         
    End /* if add_data = '' */                                                  
    count = count + 1             /* add one to line count           */         
    Signal on SYNTAX /* trap errors */                                          
    /*****************************************************************/         
    /*   Binary data                                                 */         
    /*****************************************************************/         
    If Abbrev('BIN',type,1) <> 0 then ,          /* add bin numbers  */         
      add_data = C2d(add_data)                   /* convert to dec   */         
    /*****************************************************************/         
    /*   Packed decimal data                                         */         
    /*****************************************************************/         
    If Abbrev('PACK',type,1) <> 0 then do /* add packed dec numbers  */         
      add_data = Strip(add_data)                   /* remove blanks  */         
      add_data = C2x(add_data)                     /* convert to hex */         
      len_add_data = Length(add_data)              /* length of data */         
      sign     = Substr(add_data,len_add_data,1)   /* sign portion   */         
      If Verify(sign,'CFD') <> 0 then do           /* valid sign?    */         
        warnmsg = "'*** ERROR - NEXT LINE HAS BAD SIGN ***'"                    
        "ISREDIT LINE_BEFORE" firstln "= NOTELINE " warnmsg                     
        zedsmsg = 'CAN''T ADD LINE' firstln                                     
        zedlmsg = 'ERROR - THE DATA TO ADD ON LINE' firstln 'IS NOT',           
                  'VALID PACKED DECIMAL - BAD SIGN.'                            
        Address ISPEXEC "SETMSG MSG(ISRZ001)"  /* msg - with alarm   */         
        Exit 12                                                                 
      End  /* If Verify(sign */                                                 
      add_data = Left(add_data,len_add_data-1)     /* remove sign    */         
      If sign = 'D' then add_data = '-' || add_data /* negative num  */         
    End /* If Abbrev('PACK' */                                                  
    /*****************************************************************/         
    /*   Zoned decimal data                                          */         
    /*****************************************************************/         
    If Abbrev('ZONE',type,1) <> 0 then do /* add zone dec. numbers   */         
      add_data = Strip(add_data)                   /* remove blanks  */         
      len_add_data = Length(add_data)              /* length of data */         
      zone     = Substr(add_data,len_add_data,1)   /* zone portion   */         
      add_data = Substr(add_data,1,len_add_data-1) /* non-zone part  */         
      If Datatype(add_data,N) <> 1 then ,          /* valid number?  */         
        call SYNTAX                        /* no, call error routine */         
      zonedtab = '0123456789ABCDEFGHIJKLMNOPQR{}'                               
      If Verify(zone,zonedtab) <> 0 then do      /* valid zone?      */         
        warnmsg = "'*** ERROR - NEXT LINE HAS BAD ZONE ***'"                    
        "ISREDIT LINE_BEFORE" firstln "= NOTELINE " warnmsg                     
        zedsmsg = 'CAN''T ADD LINE' firstln                                     
        zedlmsg = 'ERROR - THE DATA TO ADD ON LINE' firstln 'IS NOT',           
                  'VALID ZONED DECIMAL - BAD ZONE.'                             
        Address ISPEXEC "SETMSG MSG(ISRZ001)"  /* msg - with alarm   */         
        Exit 12                                                                 
      End  /* If Verify(zone */                                                 
      outxtab   = '012345678912345678912345678900'                              
      add_xzone = Translate(zone,outxtab,zonedtab)                              
      If Verify(zone,'JKLMNOPQR}') <> 0 then ,                                  
        add_data  = add_data ||  add_xzone       /* concat zone      */         
      Else                                                                      
        add_data  = '-' || add_data || add_xzone /* concat zone (neg)*/         
    End  /* If Abbrev('ZONE' */                                                 
    /*****************************************************************/         
    /*   Hexadecimal data                                            */         
    /*****************************************************************/         
    If Abbrev('HEXADECIMAL',type,1) <> 0 | ,     /* add              */         
       type = 'X' then do                        /*     hex numbers  */         
      add_data = Translate(add_data,"","xX'") /* remove hex notation */         
      add_data = Strip(add_data)              /* remove blanks       */         
      add_data = X2d(add_data)                /* translate to dec.   */         
    End /* If Abbrev('HEXADECIMAL' */                                           
    /*****************************************************************/         
    /*   Decimal data                                                */         
    /*****************************************************************/         
    total = total + add_data                /* add to prev. total    */         
  End /* of chkexcl */                                                          
  firstln = firstln + 1                     /* bump up line counter  */         
End /* do until   */                                                            
/*********************************************************************/         
/*   End column addition loop                                        */         
/*********************************************************************/         
If not_counted = 0 then do /* all lines counted */                              
  endmsg = 'ISRZ000'  /* message - no alarm     */                              
  endrc  = 0          /* RC=0                   */                              
End                                                                             
Else do               /* some lines not counted */                              
  endmsg = 'ISRZ001'  /* message - with alarm   */                              
  endrc  = 4          /* RC=4                   */                              
End                                                                             
If Abbrev('HEXADECIMAL',type,1) <> 0 | type = 'X' then do                       
  zedsmsg = "Total = x'"D2x(total)"'"                                           
  zedlmsg = "Total = x'"D2x(total)"' ("total" decimal," ,                       
               "Avg ="  Format(total / count,,5) / 1 || ")." ,                  
            count "lines were counted (" || ,                                   
            not_counted "not counted)."                                         
  Address ISPEXEC "SETMSG MSG("|| endmsg ||")"                                  
  Exit endrc                                                                    
End /* If abbrev */                                                             
Else do                                                                         
  total   = total / 1   /* remove trailing zeros  */                            
  zedsmsg = "Total =" total                                                     
  If total >= 0 & total <  999999999999999 & ,                                  
     total=Trunc(total,0) then ,                                                
    zedlmsg = "Total =" total "(x'"D2x(total)"' hex)," ,                        
               "Avg =" Format(total / count,,5) / 1 || "." ,                    
               count "lines were counted (" || ,                                
               not_counted "not counted)."                                      
  Else ,                                                                        
    zedlmsg = "Total =" total "(hex not available)," ,                          
               "Avg =" Format(total / count,,5) / 1 || "." ,                    
               count "lines were counted (" || ,                                
               not_counted "not counted)."                                      
  Address ISPEXEC "SETMSG MSG("|| endmsg ||")"                                  
  Exit endrc                                                                    
End /* else do */                                                               
/*********************************/                                             
/*  HELP SUB-ROUTINES            */                                             
/*********************************/                                             
HELP_INCL:                                                                      
Return SIGL                                                                     
HELP_NOTELINES:                                                                 
"(helpln) = DISPLAY_LINES"                                                      
Do hlp = help_end-1 to help_start+1 by -1                                       
  hline = Sourceline(hlp)                                                       
  "ISREDIT LINE_AFTER " helpln " = NOTELINE (hline)"                            
End                                                                             
hline2 = '==================='                                                  
hline3 = '===   H E L P   ==='                                                  
"ISREDIT LINE_AFTER " helpln " = NOTELINE (hline2)"                             
"ISREDIT LINE_AFTER " helpln " = NOTELINE (hline3)"                             
"ISREDIT LINE_AFTER " helpln " = NOTELINE (hline2)"                             
Return                                                                          
/*********************************/                                             
/*  Sub-routine to find labels   */                                             
/*********************************/                                             
FIND_LABELS:                                                                    
Address ISPEXEC "CONTROL ERRORS RETURN"                                         
If label1 = '' then do                                                          
  firstln  = 1                                                                  
  "(lastln) = LINENUM .ZLAST"                                                   
End                                                                             
Else do                                                                         
  If label2 = '' then label2 = label1                                           
  "(firstsv)  = LINENUM" label1                                                 
  If RC >= 8 then do                                                            
    zedsmsg = 'RANGE LABEL ERROR'                                               
    zedlmsg = 'THE SPECIFIED RANGE LABEL "' || label1 '" WAS',                  
              'NOT FOUND'                                                       
    Address ISPEXEC "SETMSG MSG(ISRZ001)"  /* msg - with alarm */               
    Exit 12                                                                     
  End                                                                           
  "(lastsv)   = LINENUM" label2                                                 
  If RC >= 8 then do                                                            
    zedsmsg = 'RANGE LABEL ERROR'                                               
    zedlmsg = 'THE SPECIFIED RANGE LABEL "' || label2 '" WAS',                  
              'NOT FOUND'                                                       
    Address ISPEXEC "SETMSG MSG(ISRZ001)"  /* msg - with alarm */               
    Exit 12                                                                     
  End                                                                           
  firstln = Min(firstsv,lastsv)                                                 
  lastln  = Max(firstsv,lastsv)                                                 
Address ISPEXEC "CONTROL ERRORS"                                                
End /* else do */                                                               
Return                                                                          
/*********************************/                                             
/*  error sub-routine            */                                             
/*********************************/                                             
SYNTAX:                                                                         
warnmsg = "'*** ERROR - NEXT LINE HAS BAD DATA ***'"                            
"ISREDIT LINE_BEFORE" firstln "= NOTELINE " warnmsg                             
zedsmsg = 'CAN''T ADD LINE' firstln                                             
zedlmsg = 'ERROR - THE DATA TO ADD ON LINE' firstln 'IS NOT',                   
          'VALID FOR THE ADDITION TYPE.'                                        
Address ISPEXEC "SETMSG MSG(ISRZ001)"    /* msg - with alarm */                 
Exit 12