/*  REXX: SHIFTNX RIGHT|LEFT Cols                                    */
/*  Title:   SHIFTNX Cols                                            */
/*  Users:   SCRIPT/VS users or other ISPF edit users                */
/*  Entry:   Used as an edit macro within ISPF edit                  */
/*  Contributed: 1986/04/21 David McRitchie "The REXX Macros Toolbox" */
/*  conversion to REXX 1993/09/02 David McRitchie                    */
/*                                                                   */
/*  examples:                                                        */
/*           ===> shiftnx left 8                                     */
/*           ===> shiftnx left 3 force                               */
/*  options:                                                         */
/*      lbl-range       (optional)  label range,                     */
/*                                  defaults to .zfirst .zlast       */
/*      X NX | NX | X   (optional)  restrict to  non-excluded,       */
/*                                  or excluded lines default is NX  */
/*      RIGHT | LEFT    (required)  direction                        */
/*      scnt            (required)  number of Columns to be shifted */
/*      FORCE           (optional)  allows loss due to shifting      */
/*      VALIDNX         (optional)  do but only for lines which      */
/*                         would not need to be forced (FORCE).      */
/*  Requirements:                                                    */
/*   on a SHIFTNX LEFT no data is to be lost, unless FORCE           */
/*   on a SHIFTNX RIGHT no data is to be lost, unless FORCE          */
/*********************************************************************/
Address "ISREDIT";"MACRO (TOKEN)"
"LINE_BEFORE .ZFIRST = NOTELINE """,
      ||TIME('N') 'SHIFTNX' TOKEN""""
TOKEN = " "TRANSLATE(TOKEN)" "
i=POS(' HELP ',token); if i\=0 then do ;
    Address "TSO" "pdsdd sysproc @SCRIPT";RETURN; end ;

x=''; nx=''; right=''; left=''; scnt=0; FORCE=''
labf='';labl='';remain="";validnx=""
    date1 = left(date('s'),4)"/"substr(date('s'),5,2)"/"right(date('s'),2)
 do iii = 1 to 12;
   subtoken = word(token,iii)
   if subtoken = '' then leave
   subtoken = translate(subtoken); subtokenx = ' '||subtoken||' '
   j = pos(subtokenx,' X NX RIGHT LEFT FORCE VALIDNX')
   if j \= 0 then do;
      string = subtoken ' = '''subtoken''''
      interpret  string
      iterate iii
   end;
   if substr(subtoken,1,1) = '.' then do
      select
         when labf = '' then labf = subtoken
         when labl = '' then labl = subtoken
         otherwise
            zedsmsg = '.LABEL RC=8'
            zedlmsg = 'too many labels --' labf labl subtoken
            /*Address*/ "ISPEXEC" " SETMSG MSG(ISRZ000)"
            return 8
      end /* select */
      iterate iii
   end
   remain = remain subtoken
   remain = strip(remain)
 end iii
 if datatype(remain,'n') then scnt = remain
 else do
   zedsmsg = 'AMT'
   zedlmsg = 'Missing number of columns to be shifted "'remain'"'
   /*Address*/ "ISPEXEC" "SETMSG MSG(ISRZ000)"
   return 8
 end
 fini0: nop

 if labf  = '' then do;
    labf = '.zfirst'; labl='.zlast'
 end;
 if labl = '' then do
   zedsmsg = 'labels'
   zedlmsg = 'Exactly two labels can be specified (default -- .zf .zl)'
   /*Address*/ "ISPEXEC" "SETMSG MSG(ISRZ000)"
   return 1
 end

/* Process collected parameters */
 '(LNOlabf) = LINENUM' labf
 '(LNOlabl) = LINENUM' labl
 if LNOlabf = 0 | LNOlabl = 0 then do
   zedsmsg = 'labels invalid'
   zedlmsg = 'labels supplied' labf labl 'are invalid'
   /*Address*/ "ISPEXEC" "SETMSG MSG(ISRZ000)"
   return 1
end
if datatype(scnt,'N') = 0 then do
   zedsmsg = 'not numeric'
   zedlmsg = token '-- Cols to shift right/left not numeric'
   /*Address*/ "ISPEXEC" "SETMSG MSG(ISRZ000)"
   return 1
 end
/* End of processing collected parameters **************************/
Address "ISREDIT" "(DWIDTH) = DATA_WIDTH"
Address "ISREDIT" "(LBOUND,RBOUND) = BOUNDS"
IF RBOUND = '' THEN  RBOUND = dwidth

/* Begin Code for  SHIFTNX  macro *********************************/
/*   Preliminary test for validity columns to be moved around *****/
IF X = '' then if nx = '' then   NX = "NX"  /* DEFAULT */
IF X = "X" then if NX = "NX" then do; x = ''; nx=''; end;
IF VALIDNX =  "VALIDNX" then if NX = ''      THEN DO
    ZEDSMSG = 'X VALIDNX'
    ZEDLMSG = 'VALIDNX requires "NX" ONLY NOT "X" -- ',
             'VALIDNX will cause EXCLUDE'
    /*Address*/ "ISPEXEC" " SETMSG MSG(ISRZ000)"
    RETURN 12
 END
 SLEFT =  LEFT||RIGHT
 IF SLEFT = "" |  sleft = "LEFTRIGHT" then do
    ZEDSMSG = 'LEFT | RIGHT'
    ZEDLMSG = 'Direction required, supply either "LEFT" or "RIGHT"'
    /*Address*/ "ISPEXEC" " SETMSG MSG(ISRZ000)"
    RETURN 12
 END
 IF scnt = '' THEN DO
    ZEDSMSG = 'Shift Amount'
    ZEDLMSG = 'Must specify the number of columns to be shifted'
    /*Address*/ "ISPEXEC" " SETMSG MSG(ISRZ000)"
    RETURN 12
 END
 /******** Begin processing having complete parameter processing */
col1r = rbound + 1 - scnt; col2r = rbound
col1l = lbound;  col2l = lbound + scnt - 1
IF SLEFT = "LEFT" THEN DO
   IF VALIDNX = "VALIDNX" THEN
   Address "ISREDIT" " EXCLUDE P'^'" labf labl ALL  lbound col2l
   Address "ISREDIT" " SEEK P'^'"    labf labl X NX lbound col2l
   IF RC = 0 THEN       DO
      ZEDSMSG = 'Can''t SHIFT left'
      ZEDLMSG = LABF "THRU" labl x||nx "Cols" lbound"-",
      ||col2l "NOT BLANK -- VALIDNX NOT SPECIFIED",
        "bounds("lbound rbound")"
      /*Address*/ "ISPEXEC" " SETMSG MSG(ISRZ000)"
      IF FORCE = "FORCE" THEN DO
         ZEDSMSG = 'Data forced out'
         ZEDLMSG = LABF "THRU" labl x||nx "Cols" lbound"-",
         ||SCNT "NOT BLANK -- FORCE Requested"
      END
      ELSE RETURN 12
   END
END
IF SLEFT = "RIGHT" THEN DO
   IF VALIDNX = "VALIDNX" THEN
      Address "ISREDIT" "EXCLUDE P'^'" labf labl ALL col1r rbound
   Address "ISREDIT" " SEEK P'^'"   labf labl X NX col1r rbound
   IF RC = 0 THEN       DO
      ZEDSMSG = 'Can''t SHIFT right'
      ZEDLMSG = 'Cols' col1r rbound 'NOT BLANK -- SHIFT RIGHT',
               'NOT PERFORMED, bounds('lbound rbound")"
      /*Address*/ "ISPEXEC" " SETMSG MSG(ISRZ000)"
      IF FORCE = "FORCE" THEN DO
         ZEDSMSG = 'Data FORCEd out'
         ZEDLMSG = 'Cols' col1r rbound 'NOT BLANK -- Force Requested'
         /*Address*/ "ISPEXEC" " SETMSG MSG(ISRZ000)"
      END
      ELSE RETURN 12
   END
END
IF LNOlabl < LNOlabf then do
    ZEDSMSG = 'LABEL for .LABF/L'
    ZEDLMSG = 'LABF MUST APPEAR EARLIER THAN labl'
    /*Address*/ "ISPEXEC" " SETMSG MSG(ISRZ000)"
    RETURN 12
END
/**************************************************/
I =  LNOlabF
DO i = LNOlabf to LNOlabL
   Address "ISREDIT" "(VAR075) = XSTATUS" I
   IF  VAR075 =  NX |   VAR075 =  X  | X||NX  = '' THEN DO
     IF SLEFT = "LEFT" THEN
        Address "ISREDIT" "SHIFT (" I scnt
     IF SLEFT = "RIGHT" THEN
        Address "ISREDIT" "SHIFT )" I scnt
   END
END
ZEDSMSG = 'COMPLETED'
ZEDLMSG = 'Finished edit macro ===> SHIFTNX',
         LABF LABL X NX SLEFT SCNT
Address "ISPEXEC" " SETMSG MSG(ISRZ000)"
Address "ISREDIT" ,
"LINE_BEFORE .ZCSR = NOTELINE """TIME('N') ,
   " ===> SHIFTNX --completed RC="RC  date1""""
exit