00001000            CONTROL ASIS
00001111 /*  TITLE:       FEVERY  -- FIND EVERY LINE CONTAINING EACH */
00001211 /*                              SPECIFIED STRING            */
00001411 /*  USERS:       SCRIPT USERS                               */
00001611 /*  ENTRY:       USED AS AN EDIT CLIST WITHIN ISPF EDIT     */
00001811 /*              ===> FEVERY   'A' 'B' C                     */
00001911 /*  CONTRIBUTED: 1986/04/28 DAVID MCRITCHIE                 */
00002011 /*      "THE REXX MACROS TOOLBOX" -- SYSTECH                */
00002111 /*                                                          */
00002311 /*  EXAMPLE:     FEVERY .ZFIRST .ZLAST NX 'STRING1' "STRING2" */
00002411 /*                                 STRING3 STRING4 'STRING5' */
00002511 /*  OPTIONS:                                                 */
00002711 /*      LBL-RANGE    (REQUIRED)  LABEL  RANGE               */
00002911 /*      NX | X       (OPTIONAL)  LIMIT TO NON-EXCLUDED, OR EXCLUDED */
00003011 /*                    EXCLUDED LINES                                */
00003111 /*      <LIST>       (REQUIRED)  STRING OPERAND SUITABLE FOR A FIND */
00004011 /*                     COMMAND                                      */
00006011 /*                                                                 */
00181011ISREDIT     MACRO (TOK1,TOK2,TOK3,TOK4,TOK5,TOK6,TOK7,TOK8,TOK9,TOK10,+
00181111          TOK11,TOK12,TOK13,+
00182011          TOK14,TOK15,TOK16,TOK17,TOK18,TOK19,TOK20,TOK21,TOK22,TOK23,+
00182111          TOK24,TOK25,TOK26,+
00183011          TOK27,TOK28,TOK29,TOK30,TOK31,TOK32,TOK33,TOK34,TOK35,TOK36,+
00183111          TOK37,TOK38,TOK39,+
00184000          TOK40,TOK41,TOK42,TOK43,TOK44,TOK45,TOK46,TOK47,TOK48)
00185010        ISREDIT (IMAC) = IMACRO
00291000        SET R  = 0
00292009        SET SETX  = 0
00293009        SET SETNX  = 0
00300000        SET I = 0
00311000        /*********
00312000        SET I = 1
00313000       DO WHILE &I <= 48
00313100        SET TOKEN = &&TOK&I
00313200        SET TOKEN = &STR(&SYSCAPS(&TOKEN))
00313400        IF &STR(&TOKEN) = &STR() THEN GOTO END_TOK
00313511        IF ALL = &STR(&TOKEN) | NEXT = &STR(&TOKEN) | FIRST = +
00313611          &STR(&TOKEN) | LAST = &STR(&TOKEN) | PREV = &STR(&TOKEN) +
00313711            THEN DO
00313900          SET &ZEDSMSG = &STR(&TOKEN INVALID)
00314011          SET &ZEDLMSG = &STR("&TOKEN" NOT PROVIDED FOR NOR ARE NEXT +
00314111            ALL FIRST LAST PREV)
00314200          ISPEXEC   SETMSG MSG(ISRZ000)
00314300          EXIT CODE(12)
00314400        END
00314511        IF &SUBSTR(1:6,&STR(&TOKEN)       ) = &STR(BEGIN&STR(&LP))  +
00314611          THEN DO
00315011           SET BEGIN = &SUBSTR(7:&EVAL(&LENGTH(&STR(&TOKEN))-1),+
00315111             &STR(&TOKEN)         )
00316000           GOTO NXT_TOK
00317000        END
00319900        IF &STR(&TOKEN) = NX THEN DO
00320000           SET NX = NX
00320100           GOTO NXT_TOK
00320200        END
00320300        IF &STR(&TOKEN) = X THEN DO
00320400           SET X = X
00320500           GOTO NXT_TOK
00320600        END
00320711        IF &STR(&TOKEN) = WORD | &STR(&TOKEN) = CHAR | &STR(&TOKEN) = +
00320811          CHARS -
00321007        | &STR(&TOKEN) = PREFIX | &STR(&TOKEN) = SUFFIX THEN DO
00321107           IF &STR(&WORD) ^= &STR() THEN DO
00321207              SET &ZEDSMSG = &STR(INCONSISTENT PARAMETERS)
00321311              SET &ZEDLMSG = &STR('&WORD' AND '&TOKEN' CANNOT BOTH BE +
00321411                SPECIFIED FOR XEVERY CMD.)
00321507              ISPEXEC     SETMSG MSG(ISRZ000)
00321607           END
00321709           SET WORD = &STR( &TOKEN.)
00321807           GOTO NXT_TOK
00321907        END
00322000        IF &STR(&TOKEN) = LEFT THEN DO /* LEFT | RIGHT */
00322100           SET LEFT = LEFT
00322200           GOTO NXT_TOK
00322300        END
00322400        IF &STR(&TOKEN) = RIGHT THEN DO
00322500           SET RIGHT = RIGHT
00322600           GOTO NXT_TOK
00322700        END
00322800        IF &SUBSTR(1,&TOKEN) = &STR(.) THEN DO
00322900           IF &LABF = &STR() THEN DO
00323000              SET LABF = &STR(&TOKEN)
00323100              GOTO NXT_TOK
00323200           END
00323300           IF &STR(&LABL) = &STR() THEN DO
00323400              SET LABL = &STR(&TOKEN)
00323500              GOTO NXT_TOK
00323600           END
00323700          SET &ZEDSMSG = &STR(LABEL &STR(&TOKEN))
00323811          SET &ZEDLMSG = &STR(EXACTLY TWO LABELS ARE REQUIRED FOUND   +
00323911            "&LABF", "&LABL" AND  "&STR(&TOKEN)")
00324100          ISPEXEC   SETMSG MSG(ISRZ000)
00324200          EXIT CODE(12)
00324300        END
00324400        IF &STR(&TOKEN) = &STR()) THEN DO
00324500           SET &ZEDSMSG = &STR(LOST PARENTHESIS)
00324611           SET &ZEDLMSG = BLANKS SEPARATE ALL OPERANDS; THEREFORE +
00324711             INVALID IN FROM() TO() COL() BEGIN()
00324800           ISPEXEC SETMSG MSG(ISRZ000)
00324900           EXIT CODE(12)
00325000        END
00325100        SET REMAIN = &STR(&REMAIN &STR(&TOKEN))
00325200        SET R = &R + 1
00325300        SET FIND&R = &STR(&TOKEN)
00325400 NXT_TOK: -
00325500        SET I = &I + 1
00325600      END
00325700 END_TOK: SET I = &I
00325800      /*****************************************************************
00325911        /*************************************************************+
00326011          ****
00326100        SET RMAX = &R
00326203        IF &STR(&FIND1) = &STR() THEN DO
00326302                   SET &ZEDSMSG = &STR(FIND STRINGS)
00327002                   SET &ZEDLMSG = &STR(&ZEDSMSG ARE MISSING)
00327102                   ISPEXEC     SETMSG MSG(ISRZ000)
00327202                   EXIT CODE(12)
00327302        END
00327404        IF &LABL = &STR() AND &LABF ^= &STR() THEN DO
00327604           SET &ZEDSMSG = &STR(LABEL MISSING)
00327704           SET &ZEDLMSG = &STR(TWO LABELS MUST BE INDICATED FOR A RANGE)
00327904           ISPEXEC     SETMSG MSG(ISRZ000)
00328004        END
00328700        IF &LABF = &STR() THEN SET LABF = &STR(.ZFIRST)
00328804        IF &LABL = &STR() THEN SET LABL = &STR(.ZLAST)
00330000        ISREDIT (#LABF) = LINENUM &LABF
00331002        IF &LASTCC ^= 0 THEN DO
00331102                   SET &ZEDSMSG = &STR(&LABF. LABEL)
00331202                   SET &ZEDLMSG = &STR(&ZEDSMSG DOES NOT EXIST)
00331302                   ISPEXEC     SETMSG MSG(ISRZ000)
00331402                   EXIT CODE(12)
00331502        END
00331600        ISREDIT (#LABL) = LINENUM &LABL
00331700        IF &LASTCC ^= 0 THEN DO
00331800                   SET &ZEDSMSG = &STR(&LABL. LABEL)
00331900                   SET &ZEDLMSG = &STR(&ZEDSMSG DOES NOT EXIST)
00332000                   ISPEXEC     SETMSG MSG(ISRZ000)
00332100                   EXIT CODE(12)
00332200        END
00332311        /********************************** END OF LABEL REQUIREMENTS +
00332411          **********************/
00332600        ISREDIT (DWIDTH) = DATA_WIDTH
00332711        SET DWIDTH2 = &DWIDTH + &DWIDTH
00332811        /*   /* CAN BE USED TO FORCE AN ERROR */
00332900        ISREDIT (LBOUND,RBOUND) = BOUNDS
00333000        /****************************/
00333100        ISREDIT (VAR057) = RECFM
00333200        ISREDIT (VAR049,VAR050) = NUMBER
00333300        SET LLBOUND = &LBOUND
00333400        SET LLADJ = 0
00333500        IF &VAR057 = V AND &VAR049 = ON THEN DO
00333600           SET LLADJ = 8
00333700           SET LLBOUND = &LBOUND + 8
00333800        END
00333900        /****************************/
00334011        /************************************** CODE FOR  FEVERY +
00334111          COMMANDS ***************/
00334211        /************************************** CODE FOR  FEVERY +
00334311          COMMANDS ***************/
00335011        /************************************** CODE FOR  FEVERY +
00335111          COMMANDS ***************/
01530000            /******** BEGIN OF INTERFACE TO COMMON PATTERN CLIST  *****/
01540000            IF &X = X AND &NX = NX THEN DO
01550000               SET X =
01560000               SET NX =
01570000            END
01780000            /******** END   OF INTERFACE TO COMMON PATTERN CLIST  *****/
02100000            IF &EVAL(&#LABL.) < &EVAL(&#LABF.) THEN DO
02110000                SET &ZEDSMSG = &STR(LABEL ERR .LABF/L)
02120011                SET &ZEDLMSG = &STR(&LABF MUST APPEAR EARLIER THAN +
02120111                  &LABL)
02130000    ISPEXEC     SETMSG MSG(ISRZ000)
02140000                EXIT CODE(12)
02150000            END
02160000    /* **************************************************
02161008     /*   ISREDIT SEEK &LABF. &LABL. &NX&X FIRST &FIND1
02162008     /*   IF &LASTCC = 0 THEN GOTO NONE
02170000          SET I = &#LABF
02180000          DO WHILE &I <= &#LABL
02190000             ISREDIT (VAR075) = XSTATUS &I
02200011             IF &VAR075 = &NX OR &VAR075 = &X OR  &STR(&X&NX) = +
02200111               &STR() THEN DO
02201000                SET R = 1
02202000                DO WHILE &R <= &RMAX
02203000                   ISREDIT LABEL &I = .POINT
02204000                   SET TOKEN = &STR(&&FIND&R)
02204100                   SET TOKEN = &STR(&TOKEN)
02205008                   ISREDIT SEEK .POINT .POINT &TOKEN. &WORD. ALL
02206000                   IF &LASTCC > 0 THEN GOTO NFOUND
02210000                   SET R = &R + 1
02220000                END
02231008                IF &VAR075 = X THEN DO
02231108                   SET SETNX = 0&SETNX + 1
02231208                   ISREDIT XSTATUS .POINT = NX
02232008                END
02233008                GOTO NXTT_I
02240000               NFOUND: -
02241000                ISREDIT EXCLUDE .POINT .POINT ALL
02242008                IF &VAR075 = NX THEN SET SETX = 0&SETX + 1
02250000             END
02251000   NXTT_I: -
02260000             SET I = &I. + 1
02270000          END
02273008   NONE: -
02280000          SET &ZEDSMSG = &STR(COMPLETED)
02281008          SET XXX = &STR()
02282011          IF &EVAL(&SETX)  ^= &EVAL(0) THEN SET XXX = &STR(&SETX. +
02282111            NX->X, )
02283011          IF &EVAL(&SETNX) ^= &EVAL(0) THEN SET XXX = +
02283111            &STR(&XXX.&SETNX. X->NX, )
02284011          IF &EVAL(&SETX) = &EVAL(0) AND &EVAL(&SETNX) = &EVAL(0) +
02284111            THEN DO
02285009             SET XXX = &STR(DISPLAY NOT CHANGED BY )
02286009             SET &ZEDSMSG = &STR(NO CHANGE)
02287009          END
02287109          ELSE DO
02288009             ISREDIT F FIRST NX &LABF &LABL ' '
02289010             IF &STR(&IMAC) = NONE THEN ISREDIT UP 1
02289109          END
02290008          SET &ZEDLMSG = &STR(&XXX. -
02291011===> FEVERY &LABF &LABL &X.&NX.&WORD. &FIND1 &FIND2 &FIND3 &FIND4 +
02291111  &FIND5 &FIND6 &FIND7.)
02300000          ISPEXEC     SETMSG MSG(ISRZ000)