/* REXX -- converted to REXX on 1994/06/03 */
ADDRESS "ISREDIT"
/*********************************************************************/
/*  PIR       AUTHOR: DAVID MCRITCHIE, CREATED 1986/09/11 IS03       */
/*            AT "The REXX Macros Toolbox", DMcRitchie@hotmail.com */
/*            UPDATED 1992/02/22 20:48 IS03                          */
/*********************************************************************/
/*  TITLE:       PIR     "PUT INDEX ROTATION" FOR SCRIPT DOCUMENTS   */
/*  USERS:       TSO ISPF EDIT USERS   | SCRIPT USERS                */
/*  CONTRIBUTED: 1986/09/11 DAVID MCRITCHIE                          */
/*  DOCUMENTED:  IS03.SHARE.TEXT(PIR)                                */
/*                                                                   */
/*   SUGGEST USE OF PIR CLIST AFTER USE OF  PINX CLIST               */
/*                                                                   */
/*   EXAMPLES -- WARNING SEQUENCE NUMBERS COULD FOUL YOU UP          */
/*      001 :H2.HALON EXTINGUISHERS SET CURSOR                       */
/*                    _                    PKF SET TO   PIR AT       */
/*      001 .PI ºEXTINGUISHERS             <-- RESULT                */
/*      ********************************************************     */
/*      002 .PI ºHALON FIRE EXTINGUISHER                             */
/*                          _              PKF SET TO   PIR          */
/*      002 .PI ºEXTINGUISHERºHALON FIRE   <-- RESULT                */
/*      002 .PI ºEXTINGUISHER, HALON FIRE   <-- MIGHT CHANGE TO      */
/*      ********************************************************     */
/*                                                                   */
/*  OPTIONS:                                                         */
/*            SUGGEST PF13  PIR AT                                   */
/*            SUGGEST PF14  PIR                                      */
/*            SUGGEST PF16  PIR S                                    */
/*  PIR AT --  MAKE A ".PI " FROM THIS POINT OF LINE,                */
/*  PIR    --<<DEFAULT>>  ROTATE THE ".PI " AT THE CURSOR            */
/*  PIR R  --<<DEFAULT>>  ROTATE THE ".PI " AT THE CURSOR            */
/*  PIR S  -- SWAP FIRST TWO NODES    OF ".PI "                      */
/*                                                                   */
/*  INTERNAL ASPECTS:                                                */
/*    Continues to use EDIT instructions instead of manipulating     */
/*      within the REXX language, because directly converted from    */
/*      a clist macro where it would have been very difficult to     */
/*      manipulate strings within a clist.                           */
/*                                                                   */
/*  SUGGESTED IMPLEMENTATION AFTER USE OF CLIST  PINX                */
/*    C ALL '.*--PI ' '.PI ' NX                                      */
/*    X ALL                                                          */
/*    F '.PI /'                                                      */
/*    C ALL NX '/' 'º'                                               */
/*                                                                   */
/*    KEYS                                                           */
/*     13  PIR AT          CREATES A ".PI " FROM POS. CURSOR IS AT   */
/*     14  PIR             ROTATES ".PI " FROM POS. OF CURSOR        */
/*     15  * ***pfk15***   WARNING THAT PFKEYS ARE CHANGED (not PF3) */
/*     16  PIR S           SWAP FIRST TWO NODES OF ".PI"             */
/*     17  FIND 7 80 'º' NX;PIR S;F .PI;F .PI                        */
/*                                                                   */
/*                                                                   */
/*  THIS CLIST CANNOT HANDLE ARITHMETIC OPERATORS WITHIN DATA        */
/*  USED TO CREATE A NEW ".PI ".    E.G.   / * - ,                   */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
    "MACRO (tokens)"
    help=""; debug=""; s=""; AT=""; entire=""; remain=""
    A1="";A2="";a3="";a4="";ln1="";ln2="";d1=""
    BLANKS = "                          "
    N0 = 20
    N = 0
    I = 0
    L = 0
    /*********                                                  */
    I = 1
    tokens=translate(tokens)
    DO i = 1 to words(tokens)
       token = word(tokens,i)
       IF TOKEN = "" THEN  iterate i /* should not happen*/
       IF pos(" "token" ", " NEXT FIRST LAST PREV ") > 0 then do
          zedsmsg = token "invalid"
          zedlmsg = token "not provided ",
          "for nor are next all first last prev"
          call note "PIR" time("n") zedlmsg
          Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
          Exit 12
       END
       if token = "AT"     then do; AT="AT";        iterate i; end
       if token = "R"      then iterate i;   /* this is the default*/
       if token = "S"      then do; S="S";          iterate i; end
       if token = "DEBUG"  then do; DEBUG="DEBUG";  iterate i; end
       if token = "ENTIRE" then do; ENTIRE="ENTIRE"; iterate i; end
       if token = "HELP"   then do; HELP="HELP";    iterate i; end
         /*(*/
       IF TOKEN = ")" THEN  DO
          ZEDSMSG = "LOST PARENTHESIS"
          ZEDLMSG = "BLANKS"  SEPARATE ALL ,
          OPERANDS; THEREFORE INVALID IN FROM() TO() COL() BEGIN()
          call note "PIR" time("n") zedlmsg
          Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
          Exit 12
       END
       REMAIN = REMAIN token
    end i
    if remain \= "" then do
         ZEDSMSG = REMAIN "--?"
         ZEDLMSG = ZEDSMSG "invalid parameter(s) for PIR"
          call note "PIR" time("n") zedlmsg
         Address "ISPEXEC" "SETMSG MSG(ISRZ001)"
         exit 1
    end
    /**************** UNIQUE CODE FOR PIR *************************/
    /**************** UNIQUE CODE FOR PIR *************************/
    /**************** UNIQUE CODE FOR PIR *************************/
    /**************** UNIQUE CODE FOR PIR *************************/
    /* DEBUG = "DEBUG" */
    if debug = "DEBUG" then do
        "reset" /* during testing*/
        "reset label" /* during testing*/
        call note "DEBUG option in effect"
    end
    "(CP11,CP12) = CURSOR"
    "LABEL .ZCSR = .PIRX 0"
    IF pcs2 = 0 then do
      IF S \= "S" THEN  DO
         SAY "CURSOR HAS NOT BEEN POSITIONED FOR USE OF  PIR S"
         ZEDSMSG = "REPOSITION CURSOR"
         ZEDLMSG = ZEDSMSG. -- TO CREATE A ".PI º" CARD
          call note "PIR" time("n") zedlmsg
         Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
         Exit 0
      END
    END
    "(LN1) = LINE .ZCSR"
    ln1=strip(ln1,"T")
    "(VAR013,VAR014) = CURSOR"
    /* ----------------------- PIR AT ----------------------------- */
    IF AT = "AT" THEN  DO
       "LABEL .ZCSR = .PIRA 0"
       "LINE_AFTER .ZCSR = DATALINE (ln1)"
       "LABEL" EVAL(VAR013 + 1) "= .PIRNW 0"
       IF  CP12 > 1 then
          "SHIFT ( .PIRNW" Eval(CP12  - 1)
       "SHIFT ) .PIRNW 5"
       "CHANGE .PIRNW .PIRNW 1 '     ' '.PI º'"
       "CHANGE ALL .PIRNW .PIRNW 1 4 P'>' P'<'"
       "CHANGE ALL .PIRNW .PIRNW P'$GT##$' 'º'"
       "CHANGE ALL .PIRNW .PIRNW P'$H#$' 'º'"
       "CHANGE ALL .PIRNW .PIRNW P'$HP#$' 'º'"
       "CHANGE ALL .PIRNW .PIRNW P'$HP##$' 'º'"
       "CHANGE ALL .PIRNW .PIRNW P'$EGT##$' 'º'"
       "CHANGE ALL .PIRNW .PIRNW P'$EHP#$' 'º'"
       "CHANGE ALL .PIRNW .PIRNW P'$EHP##$' 'º'"
       "CHANGE ALL .PIRNW .PIRNW P'$EPR##$' 'º'"
       "CHANGE ALL .PIRNW .PIRNW P'$PR##$' 'º'"
       "CHANGE ALL .PIRNW .PIRNW P'$SK $$' 'º'"
       "CHANGE ALL .PIRNW .PIRNW P'$SP $$' 'º'"
       "CHANGE ALL .PIRNW .PIRNW  ':P ' ''"
       "CHANGE ALL .PIRNW .PIRNW  ':P.' ''"
       "CHANGE ALL .PIRNW .PIRNW ';'  'º'"
       "CHANGE ALL .PIRNW .PIRNW '.º' 'º'"
       "CHANGE ALL .PIRNW .PIRNW 'º.' 'º'"
       "CHANGE ALL .PIRNW .PIRNW 'º, ' 'º'"
       "CHANGE ALL .PIRNW .PIRNW 'ºººººº' 'º'"
       "CHANGE ALL .PIRNW .PIRNW 'ººº' 'º'"
       "CHANGE ALL .PIRNW .PIRNW 'ºº' 'º'"
       "CHANGE ALL .PIRNW .PIRNW 'ºº' 'º'"
       "CHANGE ALL .PIRNW .PIRNW 'ºº' 'º'"
       "CHANGE ALL .PIRNW .PIRNW 'ºº' 'º'"
       "RESET CHANGE .PIRNW .PIRNW"
       "CURSOR =" CP11   CP12
       Exit 0
    END
    /* ------- Common to    PIR R   (default)    ------------------ */
    /* -------    and to    PIR S   (swap first two nodes) -------- */
    "SEEK FIRST NX .ZCSR .ZCSR '.PI'"
    IF RC \= 0 THEN do
          zedsmsg = token ".PI required"
          zedlmsg = token "PIR R, and PIR S only work on .PI lines"
          Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
        Exit 4
    end
    "(CP21,CP22) = CURSOR"
    "LABEL .ZCSR = .PIRR 0"
    "LINE_AFTER .ZCSR = DATALINE (LN1)"
    "LABEL" Eval(CP21 + 1) "= .PIRNW 0"
    CS11 = CP21  + 1
    CS12 = CP22
    "CURSOR =" CS11 CS12
    "(LN1) = LINE .PIRNW"
    L = LENGTH(ln1)
    /* ------- PIR S ----------------------------- PIR S ---------- */
    IF S = "S" THEN  DO
       "LABEL" CP21 "= .PIRS 0"
       D1 = SUBSTR(ln1,CS12 + 4,1)
       call note 'd1='d1 'in S-------'
       "SEEK NEXT  NX .ZCSR .ZCSR" d1
       "(CS21,CS22) = CURSOR"
       "SEEK NEXT  NX .ZCSR .ZCSR" d1
       IF RC \= 0 THEN        Exit 0
       "(CS31,CS32) = CURSOR"
       "SEEK NEXT  NX .ZCSR .ZCSR" d1
       IF RC = 0 THEN "(CS41,CS42) = CURSOR"
       ELSE CS42 = L+1
       A1 =  Substr(LN1,1, CS12 + 3 + 1 - 1)
                                   /* .PI (BLANK)           */
       A2 = strip( Substr(LN1, CS22, Eval(CS32 -1 + 1 - CS22)) )
                                           /* ºSTANDARDS            */
       A3 = strip( Substr(LN1, CS32, Eval(CS42 -1 + 1 - CS32)) )
                                           /* ºPOLICY               */
       L = L  + 1
       IF A3 = D1 THEN  DO
          "DEL .PIRNW .PIRNW"
          "CURSOR =" cp21 cp22
          "LABEL .ZCSR = .ONE 0"
          Exit 4
       END
       A4 = strip(Substr(ln1, cs42, L + 1 - CS42) )
                                           /* ºXXXXXXXXXX           */
       LN2 = strip( A1||A3||A2||A4 )
                                        /* .PI ºPOLICYºSTANDARDSºXXX*/
       ZEDSMSG = "PIR S"
       ZEDLMSG = "PIR S -- SWAP FIRST TWO NODES  .PIRS"
       call note "PIR" time("n") zedlmsg
       Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
       signal FINISR
    END
    /******* DEFAULT ----------- PIR R ---------------------------- */
    A1 = Substr(LN1,1, Eval(CP22 + 4 + 1 - 1))
                                           /* .PI º                 */
    A2 = strip( Substr(LN1,  CP12,  L + 1 - CP12) )
                                           /* STANDARDS POLICY      */
    A3 = strip( Substr(LN1, CP22 + 5,  CP12 -1 + 1 - CP22 - 5) )
    LN2 = strip( A1||A2"º"||A3 )
    ZEDSMSG = "PIR R"
    ZEDLMSG = "LABEL .PIRR LINE ",
        "ROTATED AT .ZCSR -- NEXT LINE IS RESULT"
       call note "PIR" time("n") zedlmsg
    Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
FINISR:
    if debug = "DEBUG" then do
       call note "ln1="ln1
       call note "   "left(' ',cp12)"-"
       call note "a1="a1"<---"
       call note "a2="a2"<---"
       call note "a3="a3"<---"
       call note "a4="a4"<---"
       call note "ln2="ln2
       call note "d1="d1"<--- which is  x'"c2x(d1)"'"
       x=""
       do i = 1 to length(ln2)
          x = x substr(ln2,i,1)
       end
       call note "ln2="||x
       call note "ln2="c2x(ln2)
       "up max"
    end
    "LINE_AFTER .ZCSR = DATALINE (LN2)"
    "DEL .PIRNW .PIRNW"
    "LABEL" Eval(CP21 + 1) "= .PIRNW 0"
    "CHANGE .PIRNW .PIRNW   'ºº' 'º' ALL"
    "CHANGE .PIRNW .PIRNW   'º' 'º' ALL"
    "CURSOR =" cp21 CP22
    "RESET CHANGE .PIRNW .PIRNW"
    "RESET LABEL  .PIRNW .PIRNW"
    Exit 0
/*********************************************************************/
/*   REALISTIC INDEX ENTRIES                                         */
/*     THIS IS A BRIEF EXCERPT FROM DOCUMENTATION OF THIS CLIST.     */
/*                                                                   */
/*      *****GENERATION OF CICS TABLES AND STARTUP JCL************   */
/*      .PI |TABLES|CICS|GENERATION OF, AND STARTUP JCL              */
/*      .PI |CICS|TABLES|GENERATION OF, AND STARTUP JCL              */
/*   NOTE THE COMMA INDICATES SOMETHING REARRANGED AT THAT POINT.    */
/*                                                                   */
/*   SIMILAR TO                                                      */
/*                                                                   */
/*           DR. ALLEN NEWHOUSE III, DDS                             */
/*           NEWHOUSE III, ALLEN, DDS, DR.                           */
/*                                                                   */
/*           CLISTS THAT MODIFY TEXT                                 */
/*           THAT MODIFY TEXT, CLISTS                                */
/*           MODIFY TEXT, CLISTS THAT                                */
/*           TEXT, CLISTS THAT MODIFY                                */
/*           CLISTS THAT MODIFY TEXT                                 */
/*********************************************************************/
 return
EVAL: procedure   /* simplify some of clist conversion*/
  arg arg
  interpret "x = arg"
  return x

note:  parse arg arg
    "LINE_BEFORE .ZFIRST = NOTELINE (arg)"
  return