/* AN MVI EXEC */
trace o
PARSE ARG LOWSTRING
SYS=ADDRESS()
IF SYS = 'TSO' | SYS = 'MVS' | SYS = 'ISREDIT' THEN TSO = 1; ELSE TSO = 0
IF SYS = 'DOS' | SYS = 'KEDIT' | SYS = 'CMD' THEN DOS = 1; ELSE DOS = 0
IF SYS = 'CMS' | SYS = 'XEDIT' | SYS = 'REXX' THEN CMS = 1; ELSE CMS = 0
IF SYS = 'CMD' | SYS = 'PMREXX' THEN OS2 = 1; ELSE OS2 = 0
IF SYS = 'ISREDIT' THEN ADDRESS TSO
If OS2 then If lodrxutl() then exit 001
IF SYS = 'REXX' THEN ADDRESS CMS
ISP = 0; IF TSO THEN DO; "SUBCOM ISPEXEC"; IF RC = 0 THEN ISP = 1; END
IF OS2 | DOS THEN !USERID = 'PCUSERID'; ELSE !USERID = USERID()
PARSE ARG LOWSTRING; ARGSTRING = TRANSLATE(LOWSTRING)
DEBUG = ''; X = (FIND(ARGSTRING,'*DEBUG'))
IF X \= 0 THEN DO
    TRACE I
    LOWSTRING = DELWORD(LOWSTRING,X,1)
    ARGSTRING = TRANSLATE(LOWSTRING)
    DEBUG = '*DEBUG'; END
IF (FIND(ARGSTRING,'?')) = 1 THEN SIGNAL DOC
CONTUSE = 0; X = FIND(ARGSTRING,'*CONTUSE')
IF X \= 0 THEN DO
    LOWSTRING = DELWORD(LOWSTRING,X,1)
    ARGSTRING = TRANSLATE(LOWSTRING)
    CONTUSE = 1
    END
BLANKSON = 0; X = FIND(ARGSTRING,'*BLANKSON')
IF X \= 0 THEN DO
    LOWSTRING = DELWORD(LOWSTRING,X,1)
    ARGSTRING = TRANSLATE(LOWSTRING)
    BLANKSON = 1    /* TRANSLATE UNDER_BARS TO BLANKS */
    END
SRCHOPT = 'LOCATE'; X = FIND(ARGSTRING,'*LOCATE')
IF X \= 0 THEN DO
    LOWSTRING = DELWORD(LOWSTRING,X,1) 'LOCATE'
    ARGSTRING = TRANSLATE(LOWSTRING)
    SRCHOPT = 'LOCATE'   /* SET OPTION TO FMT THAT WORKS WITH THIS LGC*/
    END
X = FIND(ARGSTRING,'*FIND')
IF X \= 0 THEN DO
    LOWSTRING = DELWORD(LOWSTRING,X,1) 'FIND'
    ARGSTRING = TRANSLATE(LOWSTRING)
    SRCHOPT = 'FIND'
    END
READONLY = 0; X = FIND(ARGSTRING,'*READONLY')
IF X \= 0 THEN DO  /* STEAM LINE READONLY & RWOPTION WHEN LOGIC STABLE */
    LOWSTRING = DELWORD(LOWSTRING,X,1)
    ARGSTRING = TRANSLATE(LOWSTRING)
    READONLY = 1    /* DON'T ISSUE READ COMMAND WITH UPDATE OPTION */
    END
RWOPTION = 0; X = FIND(ARGSTRING,'*RWOPTION')
IF X \= 0 THEN DO
    LOWSTRING = DELWORD(LOWSTRING,X,1)
    ARGSTRING = TRANSLATE(LOWSTRING)
    RWOPTION = 1    /* DON'T ISSUE READ COMMAND WITH UPDATE OPTION */
    END
FINIS = 0; X = FIND(ARGSTRING,'*FINIS')
IF X \= 0 THEN DO
    LOWSTRING = DELWORD(LOWSTRING,X,1)
    ARGSTRING = TRANSLATE(LOWSTRING)
    FINIS = 1
    END
DROPEND = 0; X = FIND(ARGSTRING,'*DROPEND')
IF X \= 0 THEN DO
    LOWSTRING = DELWORD(LOWSTRING,X,1)
    ARGSTRING = TRANSLATE(LOWSTRING)
    DROPEND = 1
    END
XIFO = 'LIFO'; X = FIND(ARGSTRING,'*FIFO')
IF X \= 0 THEN DO
    LOWSTRING = DELWORD(LOWSTRING,X,1)
    ARGSTRING = TRANSLATE(LOWSTRING)
    XIFO = 'FIFO'
    END
RECEND = ''; X = POS('*RECEND(',ARGSTRING) /* SRCH FOR RECEND VALUE */
IF X \= 0 THEN DO      /* IS THE *RECEND() OPTION USED? */
    Y = POS(')',ARGSTRING,X)    /* FIND THE END OF THE INPUT PARM */
    ZS = X + 8; ZL = Y - X - 8  /* CALC START & LENGTH OF IP PARM */
    RECEND = SUBSTR(ARGSTRING,ZS,ZL) /* SET THE RECEND VALUE */
    /*ALLOW BLANKS VIA UNDERBAR*/
    IF BLANKSON THEN RECEND = TRANSLATE(RECEND,' ','_')
    ZL = Y - X + 1              /* CALC LENGTH OF IP PARM TO DROP */
    LOWSTRING = DELSTR(LOWSTRING,X,ZL) /* DROP THE INPUT PARM FLD */
    ARGSTRING = TRANSLATE(LOWSTRING)
    END
BFRSIZ = 1024; X = POS('*BFRSIZ(',ARGSTRING) /*SRCH FOR BFRSIZ VALUE*/
IF X \= 0 THEN DO      /* IS THE *BFRSIZ() OPTION USED? */
    Y = POS(')',ARGSTRING,X)    /* FIND THE END OF THE INPUT PARM */
    ZS = X + 8; ZL = Y - X - 8  /* CALC START & LENGTH OF IP PARM */
    BFRSIZ = SUBSTR(ARGSTRING,ZS,ZL) /* SET THE BFRSIZ VALUE */
    IF DATATYPE(BFRSIZ) \= 'NUM' THEN SIGNAL ERR170
    ZL = Y - X + 1              /* CALC LENGTH OF IP PARM TO DROP */
    LOWSTRING = DELSTR(LOWSTRING,X,ZL) /* DROP THE INPUT PARM FLD */
    ARGSTRING = TRANSLATE(LOWSTRING)
    END
STKSIZ = 001; X = POS('*STKSIZ(',ARGSTRING) /*SRCH FOR STKSIZ VALUE*/
/* NUMBER OF RECORDS TO READ AND PUT IN THE STACK FOR HOST PGM. */
IF X \= 0 THEN DO      /* IS THE *STKSIZ() OPTION USED? */
    Y = POS(')',ARGSTRING,X)    /* FIND THE END OF THE INPUT PARM */
    ZS = X + 8; ZL = Y - X - 8  /* CALC START & LENGTH OF IP PARM */
    STKSIZ = SUBSTR(ARGSTRING,ZS,ZL) /* SET THE BFRSIZ VALUE */
    IF DATATYPE(STKSIZ) \= 'NUM' THEN SIGNAL ERR172
    ZL = Y - X + 1              /* CALC LENGTH OF IP PARM TO DROP */
    LOWSTRING = DELSTR(LOWSTRING,X,ZL) /* DROP THE INPUT PARM FLD */
    ARGSTRING = TRANSLATE(LOWSTRING)
    END
ADDDLM = ''; X = POS('*ADDDLM(',ARGSTRING) /*SRCH FOR ADDDLM VALUE*/
IF X \= 0 THEN DO      /* IS THE *ADDDLM() OPTION USED? */
    Y = POS(')',ARGSTRING,X)    /* FIND THE END OF THE INPUT PARM */
    ZS = X + 8; ZL = Y - X - 8  /* CALC START & LENGTH OF IP PARM */
    ADDDLM = SUBSTR(ARGSTRING,ZS,ZL) /* SET THE ADDDLM VALUE */
    /*ALLOW BLANKS USING UNDERBAR*/
    IF BLANKSON THEN ADDDLM = TRANSLATE(ADDDLM,' ','_')
    ZL = Y - X + 1              /* CALC LENGTH OF IP PARM TO DROP */
    LOWSTRING = DELSTR(LOWSTRING,X,ZL) /* DROP THE INPUT PARM FLD */
    ARGSTRING = TRANSLATE(LOWSTRING)
    END
CONTREC = ''; X = POS('*CONTREC(',ARGSTRING) /*SRCH FOR CONTREC VALUE*/
IF X \= 0 THEN DO      /* IS THE *CONTREC() OPTION USED? */
    Y = POS(')',ARGSTRING,X)    /* FIND THE END OF THE INPUT PARM */
    ZS = X + 9; ZL = Y - X - 9  /* CALC START & LENGTH OF IP PARM */
    CONTREC = SUBSTR(ARGSTRING,ZS,ZL) /* SET THE CONTREC VALUE */
    /*ALLOW BLANKS USING UNDERBAR*/
    IF BLANKSON THEN CONTREC = TRANSLATE(CONTREC,' ','_')
    ZL = Y - X + 1              /* CALC LENGTH OF IP PARM TO DROP */
    LOWSTRING = DELSTR(LOWSTRING,X,ZL) /* DROP THE INPUT PARM FLD */
    ARGSTRING = TRANSLATE(LOWSTRING)
    END
CC = ''; X = POS('*CC(',ARGSTRING) /* SRCH FOR CC PARM*/
IF X \= 0 THEN DO                /* IS THE *CC() OPTION USED? */
    Y = POS(')',ARGSTRING,X)    /* FIND THE END OF THE INPUT PARM */
    ZS = X + 4; ZL = Y - X - 4  /* CALC START & LENGTH OF IP PARM */
    CC = SUBSTR(ARGSTRING,ZS,ZL) /* SET THE CC PARM VALS  */
    IF DATATYPE(SPACE(CC,0),'NUM') = 0 THEN SIGNAL ERR150
    ZL = Y - X + 1              /* CALC LENGTH OF IP PARM TO DROP */
    LOWSTRING = DELSTR(LOWSTRING,X,ZL) /* DROP THE INPUT PARM FLD */
    ARGSTRING = TRANSLATE(LOWSTRING)
    END
SC = ''; SCP = 1; SCL = ''
X = POS('*SC(',ARGSTRING) /* SRCH AT SPECIFIC COLUMN SC PARM*/
IF X \= 0 THEN DO                /* IS THE *SC() OPTION USED? */
    Y = POS(')',ARGSTRING,X)    /* FIND THE END OF THE INPUT PARM */
    ZS = X + 4; ZL = Y - X - 4  /* CALC START & LENGTH OF IP PARM */
    PARSE VALUE SUBSTR(ARGSTRING,ZS,ZL) WITH SCP SCL .
    SC = SCP SCL
    IF DATATYPE(SPACE(SC,0),'NUM') = 0 THEN SIGNAL ERR155
    ZL = Y - X + 1              /* CALC LENGTH OF IP PARM TO DROP */
    LOWSTRING = DELSTR(LOWSTRING,X,ZL) /* DROP THE INPUT PARM FLD */
    ARGSTRING = TRANSLATE(LOWSTRING)
    END
WT = ''; X = POS('*WT(',ARGSTRING) /* SRCH FOR WORD TOKEN PARM*/
IF X \= 0 THEN DO                /* IS THE *WT() OPTION USED? */
    Y = POS(')',ARGSTRING,X)    /* FIND THE END OF THE INPUT PARM */
    ZS = X + 4; ZL = Y - X - 4  /* CALC START & LENGTH OF IP PARM */
    WT = SUBSTR(ARGSTRING,ZS,ZL) /* SET THE WT PARM VALS  */
    IF DATATYPE(SPACE(WT,0),'NUM') = 0 THEN SIGNAL ERR150
    ZL = Y - X + 1              /* CALC LENGTH OF IP PARM TO DROP */
    LOWSTRING = DELSTR(LOWSTRING,X,ZL) /* DROP THE INPUT PARM FLD */
    ARGSTRING = TRANSLATE(LOWSTRING)
    END
BEGIN:
IF STKSIZ \= 1
   THEN IF \(RECEND = '' & ADDDLM = '' & CONTREC = '') THEN STKSIZ = 1
VKEY = ''; IPREC = ''; VN = 0; DATAIDON = 0
READMODE = 'DISKR'
IF RWOPTION THEN READMODE = 'DISKRU'
LOWSTRING = STRIP(LOWSTRING)
ARGSTRING = TRANSLATE(LOWSTRING)
X = LEFT(WORD(LOWSTRING,1),1)
IF TSO
   THEN DO
    LOWSTRING = CMSTOTSO(LOWSTRING)
    ARGSTRING = TRANSLATE(LOWSTRING)
    END
IF OS2 | DOS
   THEN IF WORD(ARGSTRING,1) \= '$DSN' &,
   POS('.',SUBWORD(ARGSTRING,1,3)) = 0 &,
   POS('\',SUBWORD(ARGSTRING,1,3)) = 0
   THEN DO
    LOWSTRING = CMSTODOS(LOWSTRING)
    ARGSTRING = TRANSLATE(LOWSTRING)
    END
IF OS2 | DOS
   THEN IF WORD(ARGSTRING,1) \= '$DSN' &,
   DATATYPE(WORD(LOWSTRING,2)) = 'NUM' &,
   (POS('\',WORD(ARGSTRING,1)) \= 0 |,
   POS('.',WORD(ARGSTRING,1)) \= 0)
   THEN DO
    LOWSTRING = '$DSN' WORD(LOWSTRING,1) 'A' SUBWORD(LOWSTRING,2)
    ARGSTRING = TRANSLATE(LOWSTRING)
    END
IF LEFT(WORD(LOWSTRING,4),1) = '*'
   THEN X = SUBSTR(WORD(LOWSTRING,4),2)
   ELSE X = WORD(LOWSTRING,4)
IF DATATYPE(X) \= 'NUM'
   THEN DO
    LOWSTRING = SUBWORD(LOWSTRING,1,3) 0 SUBWORD(LOWSTRING,4)
    ARGSTRING = TRANSLATE(LOWSTRING)
    END
IF TSO | CMS | LEFT(WORD(ARGSTRING,1),1) = '$'
   THEN DO
    PARSE VALUE ARGSTRING WITH V1 V2 V3 V4 U5 U6 .
    PARSE VALUE LOWSTRING WITH .  .  .  .  V5 V6 .
    END
   ELSE DO
    PARSE VALUE ARGSTRING WITH V2 V4 U5 U6 .
    PARSE VALUE LOWSTRING WITH .  .  V5 V6 .
    V1 = '$DSN'; V3 = 'A'
    END
VINDEX = WORDS(ARGSTRING)
IF WORDS(ARGSTRING) < 3 THEN SIGNAL ERR008 /* TOO FEW IMPUT PARAMETERS.*/
IF TSO & V1 = '$DSN' & POS(LEFT(V2,1),"'(") = 0
   THEN V2 = "'"!USERID"."V2"'"
CALL 'STATE' V1 V2 V3
IF RESULT = 0,
   THEN DO
    IF CMS THEN CALL 'CMSQ' 'REXXFST' V1 V2 V3 DEBUG
    IF TSO THEN CALL 'CMSQ' 'REXXFST' V1 V2 V3 DEBUG
    IF OS2 THEN CALL 'REXXFST' V1 V2 V3 DEBUG
    END
IF RESULT \= 0 THEN SIGNAL ERR120
PULL VRECCNT VZ
IF \TSO THEN IF V4 > VRECCNT THEN SIGNAL EOF
IF TSO THEN IF VRECCNT \= 0 & V4 > VRECCNT THEN SIGNAL EOF
VSEQ = V4
IF VSEQ = 0 THEN VFINIS = ''
IF FINIS & VFINIS = '' THEN VFINIS = 'FINIS' /*FORCE EOF AFTER @ CALL*/
IF VSEQ \= 0 THEN VFINIS = 'FINIS'
IF VINDEX < 4 THEN SIGNAL ERR100
VX = SUBSTR(V4,1,1)
IF VX = '*' THEN VSEQ = SUBSTR(V4,2,7)
IF U6 = '' THEN DO
    U6 = 'LOCATE'; V6 = U6
    END
IF U6 \= 'LOCATE' & U6 \= 'FIND' THEN SIGNAL ERR140
DSN = ''; MEM = ''
IF TSO & POS('(',V2) \= 0
   THEN DO
    PARSE VAR V2 DSN '(' MEM ')' Q .
    IF Q = "'" | Q = '"' THEN DSN = DSN||Q
    END
IF TSO & DSN = '' & POS('.',V2) \= 0 & POS('(',V2) = 0 & LEFT(V2,1) = "'"
   THEN DSN = V2
IF TSO & DSN = '' & POS('.',V2) = 0 & POS('(',V2) = 0 & LENGTH(V2) < 9
   THEN MEM = V2
IF TSO & DSN \= ''
   THEN DO ALLOC = 1 FOR 1
    IF V3 = '*' THEN V3 = '$RXRDR'
    IF VSEQ = 0 | VSEQ = 1
       THEN DO 1
        X = LISTDSI(V3 'FILE')
        IF X > 4 THEN LEAVE
        IF "'"SYSDSNAME"'" = DSN THEN LEAVE ALLOC
        "FREE DDNAME("V3")"
        IF RC \= 0 THEN SIGNAL ERR190
        END
    'ALLOCATE DDNAME('V3') DSNAME('V2') SHR REUSE'
    IF RC \= 0 THEN SIGNAL ERR123  /* LOGIC NEEDED FOR DEALLOC ON ERR */
    END
IF VINDEX > 4 THEN SIGNAL KEYFMT
IF CMS
   THEN 'EXECIO' STKSIZ 'DISKR' V1 V2 V3 VSEQ '(' XIFO VFINIS
IF OS2
   THEN RC = EXECPC(STKSIZ 'DISKR' V1 V2 V3 VSEQ '(' XIFO VFINIS)
/* TSO REQ'S 1ST I/O BE DISKRU TO SUBSEQUENTLY DO REC UPDATING */
IF TSO
   THEN DO
    IF \(DSN = '' & MEM \= '') /* WAS ONLY A MEMBER NAME ENTERED? */
       THEN 'EXECIO' STKSIZ READMODE V3 VSEQ '(' XIFO VFINIS
       /*EXECIO CAN'T READ VIA DDNAME POINTING AT CONCAT DSNS*/
       ELSE RC = ISPFREAD(MEM)  /* USE THIS LOGIC WHEN DSNAME UNKNOWN */
    END
IF RC = 0 & RECEND \= '' THEN CALL ENDRECS
IF RC = 0 & CONTREC \= '' & RECEND = '' THEN CALL CONTREC
SIGNAL RCSET
KEYFMT:
/* IF BLANKS ON THEN TRANSLATE UNDER_BARS TO BLANKS */
IF BLANKSON THEN V5 = TRANSLATE(V5,' ','_')
IF \CMS THEN VKEY = V5
IF CMS THEN VKEY = '›'V5'›'
KEYRREAD:  /*COME BACK HERE WHEN READING REXX CODE AND TAG WONT MATCH*/
ZONE = ''
IF CC \= '' & U6 = 'LOCATE'  /* DEFINE WHERE KEY SHOULD BE IN RECORD. */
   THEN ZONE = 'ZONE' WORD(CC,1) (WORD(CC,1) + WORD(CC,2) - 1)
IF TSO
   THEN IF VSEQ = 0 THEN VSEQ = 1 /* ELIMINATE THE AMBIGUITY OF 1 OR 0 */
IF CMS
   THEN 'EXECIO * DISKR' V1 V2 V3 VSEQ '( LIFO' VFINIS U6 VKEY ZONE
VON = ''
IF OS2
   THEN DO
    IF BLANKSON THEN DO
        VKEY = TRANSLATE(VKEY,'_',' ')
        VON = 'BLANKSON'
        END
    RC = EXECPC('* DISKR' V1 V2 V3 VSEQ '( LIFO' VON VFINIS U6 VKEY ZONE)
    END
IF TSO
   THEN DO XSEQ = VSEQ BY 0
    IF BFRSIZ = 0 THEN LEAVE  /* WILL BE ZERO AFTER EOF REACHED */
    IF \(DSN = '' & MEM \= '')
       THEN 'EXECIO' BFRSIZ READMODE V3 XSEQ '( STEM BFR.' VFINIS
       ELSE RC = ISPFREAD(MEM)
    IF RC > 2 THEN LEAVE   /* IOERR */
    IF RC = 2 THEN BFRSIZ = 0   /* EOF REACHED */
    DO CNT = 1 FOR BFR.0
        IPREC = BFR.CNT; CKPCE = IPREC
        /* CHECK PART OF RECORD DEFINED BY CC FOR KEY */
        IF ZONE \= '' THEN CKPCE = SUBSTR(IPREC,WORD(CC,1),WORD(CC,2))
        IF DEBUG = '*DEBUG' THEN TRACE O
        IF SC = '' | SCL = '' THEN SCL = LENGTH(CKPCE)
        IF U6 = 'LOCATE'/*LOCATE TO SCAN WHOLE REC, FIND SCANS 1ST FLD*/
           /* READ NXT REC IN FILE*/
           THEN IF POS(VKEY,SUBSTR(CKPCE,SCP,SCL)) = 0
               THEN ITERATE
               ELSE NOP
           ELSE IF LEFT(IPREC,LENGTH(VKEY)) \= VKEY THEN ITERATE
        IF DEBUG = '*DEBUG' THEN TRACE I
        /* MATCH FOUND */
        PUSH IPREC   /* PUSHES ARE LIFO */
        IPREC = ''; RC = 0
        IF XSEQ = 0 | XSEQ = 1
           THEN PUSH CNT CNT
           ELSE PUSH ((XSEQ+CNT)-VSEQ) (XSEQ+CNT-1)
        LEAVE XSEQ
        END
    XSEQ = XSEQ + BFR.0    /* START SEARCH AT NEXT GROUP */
    END
IF RC = 0 & RECEND \= '' THEN CALL ENDRECS
IF RC = 0 & CONTREC \= '' & RECEND = '' THEN CALL CONTREC
RCSET:
IF CONTREC \= '' | RECEND \= '' THEN DO
    QUEUE VSEQ VSEQ+VN      /* START SEQ. AND LAST REC TO READ */
    DO WHILE LENGTH(IPREC) > 250
        QUEUE LEFT(IPREC,250)'@'
        IPREC = SUBSTR(IPREC,251)
        END
    QUEUE IPREC
    END
IF RC < 0 THEN SIGNAL EXIT
IF RC = 2 THEN QUEUE EOF   /* QUEUE NEEDED SO EOF IS LAST IN STACK */
IF \TSO
   THEN DO
    VX = RC + 100000
    /* EXECIO 0 DISKR V1 V2 V3 ( FINIS*/
    VCONDCOD = SUBSTR(VX,5,2)
    IF VCONDCOD < 3 THEN VCONDCOD = 0
    RC = VCONDCOD
    END
   ELSE IF VFINIS = 'FINIS' THEN DO
    VCONDCOD = RC
    IF \(DSN = '' & MEM \= '')
       THEN DO
        'EXECIO 0 DISKR' V3 '0 ( FINIS' /* CLOSE ACCESSED FILE... */
        'FREE DDNAME('V3')'
        END
       ELSE DO
        ADDRESS 'ISPEXEC'
        'LMCLOSE DATAID('VALUE(V3)')'
        IF RC \= 0 THEN SIGNAL ERR200
        'LMFREE DATAID('VALUE(V3)')'
        IF RC \= 0 THEN SIGNAL ERR210
        ADDRESS 'TSO'
        END
    RC = VCONDCOD
    END
IF SYS = 'ISREDIT' THEN ADDRESS ISREDIT
EXIT RC
ISPFREAD:
IF \ISP THEN SIGNAL ERR180
ADDRESS 'ISPEXEC'
'CONTROL ERRORS RETURN'
IF DATAIDON THEN SIGNAL ISPNEXT
/* DATAID CAN'T BE LESS THAN FOUR CHARACTERS */
'LMINIT DATAID('V3') DDNAME('V3') ENQ(SHR)'
IF RC \= 0 THEN SIGNAL ERR230
'LMOPEN DATAID('VALUE(V3)') ORG(PO) OPTION(INPUT)'
IF RC \= 0 THEN SIGNAL ERR240
'LMMFIND DATAID('VALUE(V3)') MEMBER('MEM') STATS(YES)'
IF RC \= 0 THEN SIGNAL ERR250
DATAIDON = 1  /* SWITCH THAT PREVENTS REEXECUTION OF LMINIT LOGIC */
SEQ = 0
ISPNEXT:
SEQ = SEQ + 1
'LMGET DATAID('VALUE(V3)') MODE(INVAR) DATALOC(GETREC) DATALEN(GETLEN)',
        'MAXLEN(250)'
IF RC > 8 | (RC > 0 & RC < 8) THEN SIGNAL ERR260
IF RC = 8 THEN SIGNAL ISPEOF
IF VSEQ <= SEQ | VSEQ = 0 THEN SIGNAL ISPSTK
SIGNAL ISPNEXT
ISPSTK:
RC = 0; IF VKEY = ''
   THEN DO   /* W/STKSZ PUT A BUNCH OF TSO RECS INTO RDR TO SAVE TIME */
    PUSH GETREC
    IF STKSIZ > 1
       THEN DO CNT = 2 UNTIL CNT >= STKSIZ
        SEQ = SEQ + 1
        'LMGET DATAID('VALUE(V3)') MODE(INVAR) DATALOC(GETREC)',
                'DATALEN(GETLEN) MAXLEN(250)'
        IF RC > 8 | (RC > 0 & RC < 8) THEN SIGNAL ERR262
        IF RC = 8 THEN SIGNAL ISPEOF
        IF XIFO = 'LIFO' THEN PUSH GETREC; ELSE QUEUE GETREC
        END
    END
   ELSE DO    /* LOGIC WILL FILL BFR.N */
    CNT = 1; BFR.0 = 1; BFR.1 = GETREC
    DO CNT = 2 UNTIL CNT >= BFRSIZ | BFRSIZ = 0
        SEQ = SEQ + 1
        'LMGET DATAID('VALUE(V3)') MODE(INVAR) DATALOC(GETREC)',
                'DATALEN(GETLEN) MAXLEN(250)'
        IF RC > 8 | (RC > 0 & RC < 8) THEN SIGNAL ERR260
        IF RC = 8 THEN SIGNAL ISPEOF
        BFR.0 = BFR.0 + 1
        BFR.CNT = GETREC
        END
    END
SIGNAL ISPEXIT
ISPEOF:
RC = 2
ISPEXIT:
RETURN RC
EOF:
PUSH EOF
RC = 002
EXIT:
IF TSO & VFINIS = 'FINIS' THEN DO
    VCONDCOD = RC
    IF \(DSN = '' & MEM \= '')
       THEN DO
        'EXECIO 0 DISKR' V3 '0 ( FINIS'  /* CLOSE ACCESSED FILE */
        'FREE DDNAME('V3')'
        END
       ELSE DO
        'LMCLOSE DATAID('VALUE(V3)')'
        'LMFREE DATAID('VALUE(V3)')'
        END
    RC = VCONDCOD
    END
IF SYS = 'ISREDIT' THEN ADDRESS ISREDIT
EXIT RC
CONTREC:   /* CONTINUATION CHECKING TURNED ON COME HERE */
DO VX = 1 FOR 1
    IF IPREC = '' THEN DO
        IF VKEY \= ''
           THEN DO
            PULL IPSEQ
            VSEQ = WORD(IPSEQ,2)      /* SEQ OF RECORD JUST READ... */
            END
        PARSE PULL IPREC
        IF VN = 0 THEN VN = 1      /* PUSH UP TO READ NEXT REC... */
        IF CC \= '' THEN IPREC = CCSELECT(IPREC)
        IF WT \= '' THEN IPREC = WTSELECT(IPREC)
        END
    VP = LASTPOS(CONTREC,IPREC)
    IF VP = 0 THEN LEAVE VX
    IF VP > 0 & WORDS(SUBSTR(IPREC,VP+1)) = 0 THEN DO VN=VN WHILE VP\=0
        IF CMS /*STEM VAR USED BECAUSE ITS COMMON OVER MVS DOS & CMS*/
           THEN 'EXECIO 1 DISKR' V1 V2 V3 VSEQ+VN '( STEM PCE.' VFINIS
        IF OS2 /*STEM VAR USED BECAUSE ITS COMMON OVER MVS DOS & CMS*/
           THEN RC = EXECPC('1 DISKR' V1 V2 V3 VSEQ+VN '( STEM PCE.' VFINIS)
        IF TSO
           THEN IF \(DSN = '' & MEM \= '')
              THEN 'EXECIO 1 DISKR' V3 VSEQ+VN '( STEM PCE.' VFINIS
              ELSE DO
               SEQ = SEQ + 1
               'LMGET DATAID('VALUE(V3)') MODE(INVAR) DATALOC(GETREC)',
                       'DATALEN(GETLEN) MAXLEN(250)'
               IF RC > 8 | (RC > 0 & RC < 8) THEN SIGNAL ERR260
               IF RC = 8 THEN RC = 2; ELSE RC = 0
               PCE.1 = LEFT(GETREC,GETLEN)
               END
        PCE = PCE.1
        IF RC = 0             /* IF RC NOT 0 THEN TREAT LIKE EOF */
           THEN DO
            IF CC \= '' THEN PCE = CCSELECT(PCE)
            IF WT \= '' THEN PCE = WTSELECT(PCE)
            END
           ELSE DO            /* ENTER HERE AT EOF OR IO ERR */
            IF RECEND = ''
               THEN PCE = ''
               ELSE PCE = RECEND /* PROBABLY EOF SO END THE INPUT REC */
            END
        IPREC=SUBSTR(IPREC,1,VP-TRANSLATE(CONTUSE,'01','10')) STRIP(PCE)
        IF PCE \= '' THEN VP = LASTPOS(CONTREC,IPREC); ELSE VP = 0
        IF VP = 0 THEN LEAVE VX /* NO MORE CONTINUATIONS TO READ */
        IF VP > 0 & WORDS(SUBSTR(IPREC,VP+1)) = 0,
           THEN ITERATE
           ELSE LEAVE VX        /* NO MORE CONTINUATIONS TO READ */
        END
       ELSE LEAVE VX
    END
/*
IF RC = 0 & RECEND \= '' THEN X = LASTPOS(RECEND,PCE); ELSE VP = 0
IF X = 0 & RECEND \= '' THEN DO
    VN = VN + 1
    CALL ENDRECS
    END
*/
RETURN
ENDRECS:   /* RECORD END CHECKING TURNED ON COME HERE */
DO VX = 1 FOR 1
    IF IPREC = '' THEN DO
        IF VKEY \= ''
           THEN DO
            PULL IPSEQ
            VSEQ = WORD(IPSEQ,2)      /* SEQ OF RECORD JUST READ... */
            END
        PARSE PULL IPREC
        /* FOLLOWING LOGIC IS FOR LOOKING UP REXX TAGS: */
        IF RECEND = ':' & VKEY \= '' THEN DO
            PARSE VAR IPREC VY ':'
            IF TRANSLATE(STRIP(VY))':' \= TRANSLATE(V5) THEN DO
                VSEQ = VSEQ + 1
                IPREC = ''
                SIGNAL KEYRREAD   /* CANCEL ALL PRESENT LGC AND REREAD*/
                END
            END
        IF CC \= '' THEN IPREC = CCSELECT(IPREC)
        IF WT \= '' THEN IPREC = WTSELECT(IPREC)
        END
    /* DON'T CHK FOR RECEND ON THE FIRST RECORD IF COLON USED. */
    IF RECEND \= ':' THEN VP = LASTPOS(RECEND,IPREC); ELSE VP = 0
    IF VP \= 0 THEN LEAVE VX
    IF CONTREC \= '' THEN DO
        VP = LASTPOS(CONTREC,IPREC)
        IF VP > 0 & WORDS(SUBSTR(IPREC,VP+1)) = 0
           THEN DO
            VN = VN + 1      /* PUSH UP TO READ NEXT RECORD. */
            CALL CONTREC
            SIGNAL ENDRECS   /* GO BACK AND RECHECK CURRENT REC */
            END
        END
    IF VP = 0 THEN DO VN = VN+1 WHILE VP = 0
        IF VSEQ+VN <= VRECCNT | (TSO & VRECCNT = 0)
           THEN DO
            IF CMS
               THEN 'EXECIO 1 DISKR' V1 V2 V3 VSEQ+VN '(STEM PCE.' VFINIS
            IF OS2
               THEN RC = EXECIO('1 DISKR' V1 V2 V3 VSEQ+VN '(STEM PCE.' VFINIS )
            IF TSO
               THEN IF \(DSN = '' & MEM \= '')
                  THEN 'EXECIO 1 DISKR' V3 VSEQ+VN '( STEM PCE.' VFINIS
                  ELSE DO
                   SEQ = SEQ + 1
                   'LMGET DATAID('VALUE(V3)') MODE(INVAR)',
                           'DATALOC(GETREC) DATALEN(GETLEN) MAXLEN(250)'
                   IF RC > 8 | (RC > 0 & RC < 8) THEN SIGNAL ERR260
                   IF RC = 8 THEN RC = 2; ELSE RC = 0
                   PCE.1 = LEFT(GETREC,GETLEN)
                   END
            PCE = PCE.1
            IF RC = 0             /* IF RC NOT 0 THEN TREAT LIKE EOF */
               THEN DO
                IF CC \= '' THEN PCE = CCSELECT(PCE)
                IF WT \= '' THEN PCE = WTSELECT(PCE)
                END
               ELSE PCE = RECEND /* PROBABLY EOF SO END THE INPUT REC */
            END
           ELSE PCE = RECEND     /* DON'T TRY TO READ PAST EOF */
        VP = LASTPOS(RECEND,PCE) /*WHAT'S ON PRIOR READS DOESN'T COUNT*/
        /* IF RECEND REC WANTED THEN DROP MIDDLE BLANKS AND CAT PCE */
        IF DROPEND & VP \= 0
           THEN NOP
           ELSE IF PCE\='' THEN IPREC=STRIP(IPREC,'T')||ADDDLM STRIP(PCE)
        IF VP = 0 & CONTREC \= '' THEN DO
            X = LASTPOS(CONTREC,IPREC)
            IF X > 0 & WORDS(SUBSTR(IPREC,X+1)) = 0
               THEN DO
                VN = VN + 1
                VPSAVE = VP
                CALL CONTREC
                VP = VPSAVE
                END
            END
        IF VP = 0,
           THEN ITERATE
           ELSE LEAVE VX        /* NO MORE CONTINUATIONS TO READ */
        END
       ELSE LEAVE VX
    END
RETURN
CCSELECT: PROCEDURE EXPOSE CC
PARSE ARG IPREC
Z = IPREC; IPREC = ''
DO X = 1 BY 2 WHILE WORD(CC,X) \= ''
    Y = X + 1
    IF WORD(CC,Y) =  '' THEN IPREC=IPREC||SUBSTR(Z,WORD(CC,X))
    IF WORD(CC,Y) \= '' THEN IPREC=IPREC||SUBSTR(Z,WORD(CC,X),WORD(CC,Y))
    END
RETURN IPREC
WTSELECT: PROCEDURE EXPOSE WT
PARSE ARG IPREC
Z = IPREC; IPREC = ''
DO X = 1 BY 2 WHILE WORD(WT,X) \= ''
    Y = X + 1
    IF WORD(WT,Y) =  '' | WORD(WT,Y) = 0,
       THEN IPREC=IPREC||SUBWORD(Z,WORD(WT,X))' '
    IF WORD(WT,Y) \= '',
       THEN IPREC=IPREC||SUBWORD(Z,WORD(WT,X),WORD(WT,Y))' '
    END
RETURN IPREC
/* CMSTODOS - CODE PROTOTYPE TO CHANGE VM FILE NAMES INTO PC FILESET NAMES. */
CMSTODOS: PROCEDURE EXPOSE TSO OS2 !USERID
PARSE UPPER ARG ARGSTRING
IF \OS2 THEN SIGNAL CMSTODOX     /* LEAVE WITH I/P UNCHANGED IF ^ TSO */
IF ARGSTRING = '' THEN SIGNAL CMSTODOX
FN = WORD(ARGSTRING,1)
FT = WORD(ARGSTRING,2)
FM = WORD(ARGSTRING,3)
REST = SUBWORD(ARGSTRING,4)
IF FM = '' THEN FM = 'A'
IF FT = '' THEN SIGNAL CMSTODOX
FMS = 'A A1 A2 * B C D E F G H I J K L M N'
IF WORDPOS(FM,FMS) = 0 THEN SIGNAL CMSTODOX
ARGSTRING = '$DSN' FN'.'FT FM REST
CMSTODOX:
RETURN ARGSTRING
/****************************************************************************/
/* CMSTOTSO - CODE PROTOTYPE TO CHANGE VM FILE NAMES INTO OS DATASET NAMES. */
/****************************************************************************/
CMSTOTSO: PROCEDURE EXPOSE TSO !USERID
PARSE ARG ARGSTRING
IF \TSO THEN SIGNAL CMSTOTSX     /* LEAVE WITH I/P UNCHANGED IF \ TSO */
FMS = 'A A1 A2 * B C D E F G H I J K L M N'
IF SYMBOL('!USERID') \= 'VAR' THEN !USERID = USERID()
IF WORDS(ARGSTRING) = 2 &,
   POS(X,"$'(") = 0
   THEN ARGSTRING = ARGSTRING '*'
IF POS(X,"$'(") = 0 & WORDS(ARGSTRING) = 1
   THEN ARGSTRING = "$DSN '"!USERID"."WORD(ARGSTRING,1)"' FDD"
X = LEFT(WORD(ARGSTRING,1),1)
IF POS(X,"$'(") = 0 & WORDS(ARGSTRING) > 1
   THEN DO
    IF FIND(FMS,TRANSLATE(WORD(ARGSTRING,3))) = 0 |,
       POS('DD',WORD(ARGSTRING,3)) \= 0
       THEN DO
        IF LEFT(WORD(ARGSTRING,1),1) \= '$' &,
           POS('DD',WORD(ARGSTRING,3)) \= 0
           THEN DO
            Z = "'"!USERID"."WORD(ARGSTRING,2),
                ||"."WORD(ARGSTRING,1)"'"
            RC = LISTDSN(Z)
            IF  RC > 4 THEN,
            Z = "'"!USERID"."WORD(ARGSTRING,2)"(",
                ||WORD(ARGSTRING,1)")'"
            RC = LISTDSN(Z)
            IF  RC > 4 THEN,
            Z = "'"!USERID"."WORD(ARGSTRING,1)"(",
                ||WORD(ARGSTRING,2)")'"
            RC = LISTDSN(Z)
            IF  RC > 1 THEN,
            Z = "'"!USERID"."WORD(ARGSTRING,1),
                ||"."WORD(ARGSTRING,2)"'"
            RC = LISTDSN(Z)
            IF  RC > 1 THEN SIGNAL ERR012
            ARGSTRING = "$DSN" Z SUBWORD(ARGSTRING,3)
            END
           ELSE DO
            ARGSTRING = "$DSN '"!USERID"."WORD(ARGSTRING,1)"' ZDD",
                SUBWORD(ARGSTRING,2)
            END
        END
       ELSE DO
        Z = "'"!USERID"."WORD(ARGSTRING,2)".",
            ||WORD(ARGSTRING,1)"'"
        RC = LISTDSN(Z)
        IF  RC > 1 THEN,
        Z = "'"!USERID"."WORD(ARGSTRING,1)"(",
            ||WORD(ARGSTRING,2)")'"
        RC = LISTDSN(Z)
        IF  RC > 1 THEN,
        Z = "'"!USERID"."WORD(ARGSTRING,2)"(",
            ||WORD(ARGSTRING,1)")'"
        RC = LISTDSN(Z)
        IF  RC > 1 THEN,
        Z = "'"!USERID"."WORD(ARGSTRING,1),
            ||"."WORD(ARGSTRING,2)"'"
        ARGSTRING = "$DSN" Z "XDD" SUBWORD(ARGSTRING,4)
        END
    END
IF X = '('
   THEN ARGSTRING = "$DSN" WORD(ARGSTRING,1) "SYSEXEC",
        SUBWORD(ARGSTRING,2)
IF X = "'"
   THEN ARGSTRING = "$DSN" WORD(ARGSTRING,1) "YDD",
        SUBWORD(ARGSTRING,2)
PARSE VAR ARGSTRING FN FT FM .
/* USE ADDRESS() TO DETERMINE ENVIRONMENT, IE. DOS, CMS, OR TSO. */
CMSTOTSX:
RETURN ARGSTRING
LISTDSN: PROCEDURE EXPOSE RC
PARSE ARG N
IF N = '' THEN SIGNAL LISTDSNX
RC = LISTDSI(N)
IF RC \= 0 THEN SIGNAL LISTDSNX
X = SYSDSN(N)
IF X = 'OK' THEN RC = 0
IF FIND('PO PS',SYSDSORG) = 0
   THEN DO
    RC = 12
    SIGNAL LISTDSNX
    END
IF SYSDSORG = 'PO'
   THEN IF POS('(',N) = 0  /* WAS A MEMBER NAME SPECIFIED FOR LIB */
       THEN RC = 4         /* NO MEMBER NAME ENTERED */
       ELSE IF X = 'MEMBER NOT FOUND'
           THEN RC = 1
           ELSE IF X \= 'OK' THEN RC = 5
IF SYSDSORG = 'PS'
   THEN IF POS('(',N) \= 0   /* MEMBER NAME ON A SEQ FILE. */
       THEN RC = 3
       ELSE IF X \= 'OK' THEN RC = 8
LISTDSNX:
RETURN RC
LISTDSN: PROCEDURE EXPOSE RC
PARSE ARG N
IF N = '' THEN SIGNAL LISTDSNX
RC = LISTDSI(N)
IF RC \= 0 THEN SIGNAL LISTDSNX
X = SYSDSN(N)
IF X = 'OK' THEN SIGNAL LISTDSNX
IF SYSDSORG = 'PO'
   THEN IF POS('(',N) = 0
       THEN RC = 8
       ELSE IF X = 'MEMBER NOT FOUND'
           THEN RC = 1
           ELSE RC = 5
IF SYSDSORG = 'PS'
   THEN IF POS('(',N) \= 0   /* MEMBER NAME ON A SEQ FILE. */
       THEN RC = 3
       ELSE RC = 8
LISTDSNX:
RETURN RC
/**------------------------------------------------------------------**/
/* OS2 EXECIO SIMULATION.    (NOT NEWEST VERSION OF EXECPC IE BLANKSON*/
/**------------------------------------------------------------------**/
EXECPC: PROCEDURE EXPOSE PCIONAMS PCIO. TXT. OPBFR. PCE. /* ENTER STEMS HERE */
IF SYMBOL('PCIONAMS') \= 'VAR' THEN PCIONAMS = ''
PARSE ARG ARGSTR 1 . . FMT .
IF FMT = '$DSN'
   THEN PARSE VAR ARGSTR LMT TYP . NAM . SEQ OPTS
   ELSE PARSE VAR ARGSTR LMT TYP NAM SEQ OPTS
IF SEQ = '' | SEQ = '(' THEN SEQ = 0
TYP = TRANSLATE(TYP)   /* MAKE IT UPPERCASE */
IF LMT = '*' THEN LMT = 999999
ORIGSEQ = SEQ
IF SEQ = 0 THEN SEQ = 1
X = FIND(PCIONAMS,NAM)
/* IF X = 0 THEN FILE HAS NOT BEEN READ INTO STEM STORAGE... */
IF X = 0 THEN DO
    PCIONAMS = PCIONAMS NAM
    PTR = WORDS(PCIONAMS)
    PCIO.PTR.0 = 0    /* SIGNAL THAT FILE BFR IS EMPTY */
    END
XNAM = NAM
IF POS(':',NAM) = 0 & POS('\',NAM) = 0
   THEN DO  /* FIGURE OUT WHERE THE FILE IS BECAUSE THE LINES CMD WON'T */
    RC = WHEREIS(NAM '*STACK *QUIET')
    PULL XNAM .
    IF XNAM = '' THEN XNAM = NAM
    END
IF X = 0 THEN DO CNT = 1 WHILE LINES(XNAM) \= 0
    IF CNT = 1 THEN DO
        RC = LINEIN(XNAM,1,0) /* JUST OPEN THE FILE. */
        PTR = FIND(PCIONAMS,NAM)
        END
    PCIO.PTR.CNT = LINEIN(XNAM)
    PCIO.PTR.0 = CNT     /* KEEP TRACK OF RECS IN FILE */
    END
IF X = 0 THEN RC = STREAM(XNAM,'C','CLOSE')  /* ISSUE A CLOSE */
PTR = FIND(PCIONAMS,NAM)
BFR = PCIO.PTR.0
FIFO = 1; LIFO = 0; FINIS = 0; LOCATE = 0; FIND = 1
RC = 0; UPD = 0; INS = 0; DEL = 0; AFT = 0
STRING = ''; KEY = ''; STEM = ''; DLM = ''; CASE = ''; BLANKSON = ''
IF OPTS \= '' THEN DO    /* PARSE THE OPTS */
    IF POS('(',OPTS) \= 0 THEN PARSE VAR OPTS '(' OPTS
    X = FIND(TRANSLATE(OPTS),'STRING')
    IF X \= 0 THEN DO
        STRING = SUBWORD(OPTS,X+1)
        OPTS = SUBWORD(OPTS,1,X-1)
        END
    OPTS = TRANSLATE(OPTS)  /* NOW IT'S SAFE TO TRANS TO UPCASE */
    IF FIND(OPTS,'LIFO') \= 0 THEN DO
        PARSE VAR OPTS X 'LIFO' Y; OPTS = X Y
        LIFO = 1; FIFO = 0
        END
    IF FIND(OPTS,'FIFO') \= 0 THEN DO
        PARSE VAR OPTS X 'FIFO' Y; OPTS = X Y
        FIFO = 1; LIFO = 0
        END
    IF FIND(OPTS,'FINIS') \= 0 THEN DO
        PARSE VAR OPTS X 'FINIS' Y; OPTS = X Y
        FINIS = 1
        END
    IF FIND(OPTS,'BLANKSON') \= 0 THEN DO
        PARSE VAR OPTS X 'BLANKSON' Y; OPTS = X Y
        BLANKSON = '_'
        END
    IF FIND(OPTS,'UPDATE') \= 0 THEN DO
        PARSE VAR OPTS X 'UPDATE' Y; OPTS = X Y
        UPD = 1
        END
    IF FIND(OPTS,'INSERT') \= 0 THEN DO
        PARSE VAR OPTS X 'INSERT' Y; OPTS = X Y
        INS = 1
        END
    IF FIND(OPTS,'DELETE') \= 0 THEN DO
        PARSE VAR OPTS X 'DELETE' Y; OPTS = X Y
        DEL = 1
        END
    IF (INS | DEL) & FIND(OPTS,'AFTER') \= 0 THEN DO
        PARSE VAR OPTS X 'AFTER' Y; OPTS = X Y
        AFT = 1
        END
    IF FIND(OPTS,'STEM') \= 0 THEN DO
        PARSE VAR OPTS X 'STEM' STEM Y; OPTS = X Y
        LIFO = 0; FIFO = 0  /* NOT VALID WITH STEM VAR LOGIC */
        END
    IF FIND(OPTS,'STRDLM') \= 0 THEN DO
        PARSE VAR OPTS X 'STRDLM' DLM Y; OPTS = X Y
        DLM = STRIP(DLM)  /* STRING DELIMITER IS SET */
        END
    IF FIND(OPTS,'CASE') \= 0 THEN DO
        PARSE VAR OPTS X 'CASE' CASE Y; OPTS = X Y
        CASE = STRIP(CASE)  /* STRING DELIMITER IS SET */
        END
    IF FIND(OPTS,'LOCATE') \= 0 THEN DO
        PARSE VAR OPTS X 'LOCATE' KEY; OPTS = X
        KEY = STRIP(KEY)
        LOCATE = 1; FIND = 0
        END
    IF FIND(OPTS,'FIND') \= 0 THEN DO
        PARSE VAR OPTS X 'FIND' KEY; OPTS = X
        KEY = STRIP(KEY)
        FIND = 1; LOCATE = 0
        END
    IF KEY \= '' & BLANKSON \= '' THEN KEY = TRANSLATE(KEY,' ',BLANKSON)
    IF \INS & \DEL & \UPD THEN UPD = 1
    END
IF TYP = 'DISKR' THEN DO
  IF KEY = '' & BFR < SEQ THEN DO  /* SEQ NO. NOT IN FILE */
      RC = 3
      IF FIFO THEN QUEUE 'EOF'
      IF LIFO THEN PUSH 'EOF'
      SIGNAL EXECPCX       /* NO RECORDS IN FILE */
      END
  IF KEY = '' THEN DO CNT = SEQ FOR BFR-(SEQ-1)
      IF LMT <= 0 THEN LEAVE
      LMT = LMT - 1        /* DECREMENT DOWN TO LIMIT. */
      IF SYMBOL('PCIO.PTR.CNT') = 'VAR'
         THEN DO
          IF STEM \= ''  /* IS READ DATA TO BE PUT INTO STEM VARS? */
             THEN DO
              NDX = CNT - (SEQ-1)
              INTERPRET STEM||NDX '= PCIO.PTR.CNT'
              INTERPRET STEM||0   '=' NDX
              END
             ELSE DO
              IF FIFO THEN QUEUE PCIO.PTR.CNT
              IF LIFO THEN PUSH PCIO.PTR.CNT
              END
          END
      IF SYMBOL('PCIO.PTR.CNT') \= 'VAR'
         THEN DO
          IF STEM \= ''
             THEN DO
              NDX = CNT - (SEQ-0)
              INTERPRET STEM||0 '=' NDX
              END
             ELSE DO
              IF FIFO THEN QUEUE 'EOF'
              IF LIFO THEN PUSH 'EOF'
              END
          RC = 1      /*    */
          LEAVE CNT   /* CONSIDER IT AN EOF CONDITION. */
          END
      END
   IF KEY \= '' & BFR < SEQ THEN DO
      IF LIFO THEN PUSH 'EOF'
      IF FIFO THEN QUEUE 'EOF'
      IF STEM \= '' THEN INTERPRET STEM||0 '= 0' /* NO RECS */
      RC = 2    /* MEANS RECORD NOT FOUND */
      SIGNAL EXECPCX
      END
  IF KEY \= '' THEN DO CNT = SEQ FOR BFR-(SEQ-1)
      IF CNT = SEQ THEN RC = 3  /* IT GETS SET TO ZERO IF MATCH FND */
      IF LMT <= 0 THEN LEAVE
      LMT = LMT - 1        /* DECREMENT DOWN TO LIMIT. */
      IF SYMBOL('PCIO.PTR.CNT') = 'VAR'
         THEN DO
          REC = PCIO.PTR.CNT
          IF LOCATE
             THEN IF POS(KEY,TRANSLATE(REC)) = 0
                 THEN ITERATE
                 ELSE NOP
          IF FIND
             THEN IF TRANSLATE(LEFT(STRIP(REC,L),LENGTH(KEY))) \= KEY
                 THEN ITERATE
                 ELSE NOP
          RC = 0    /* SWITCH SAYS ITS FOUND. */
          IF FIFO THEN DO
              QUEUE CNT-(SEQ-1) CNT
              QUEUE REC
              END
          IF LIFO THEN DO
              PUSH REC
              PUSH CNT-(SEQ-1) CNT
              END
          IF STEM \= '' THEN DO
              INTERPRET STEM||0 '= 2' /* TWO RECORDS */
              INTERPRET STEM||1 '= REC'
              INTERPRET STEM||2 '=' CNT-(SEQ-1) CNT
              END
          LEAVE CNT
          END
         ELSE DO
          IF LIFO THEN PUSH 'EOF'
          IF FIFO THEN QUEUE 'EOF'
          IF STEM \= '' THEN INTERPRET STEM||0 '= 0' /* NO RECS */
          RC = 2    /* MEANS RECORD NOT FOUND */
          LEAVE CNT
          END
      END
  END
IF TYP = 'DISKW' THEN DO
  IF STRING == '' & STEM = ''
     THEN DO  /* PULL DATA OUT OF THE STACK */
      STEM = 'STK.'
      IF QUEUED() < LMT THEN STKCNT = QUEUED(); ELSE STKCNT = LMT
      DO CNT = 1 FOR STKCNT
          IF CASE = 'U'
             THEN PARSE UPPER PULL STK.STKCNT
             ELSE PARSE PULL STK.STKCNT
          STK.0 = STKCNT      /* KEEP IN SYNC FOR REC COUNT */
          END
      END
  IF STRING \= '' & STEM = ''
     THEN DO
      STEM = 'STR.'
      IF CASE = 'U' & STRING \= ''
         THEN STRING = TRANSLATE(STRING)
      IF DLM = ''
         THEN DO
          STR.1 = STRING
          STR.0 = 1
          END
         ELSE DO CNT = 1 WHILE STRING \== ''
          PARSE VAR STRING STR (DLM) STRING
          STR.CNT = STR
          STR.0 = CNT
          END
      END
  /* WRITE O/P RECS INTO THE I/O BUFFER AREA */
  NDX = 1
  IF STEM \= '' THEN DO 1
      INTERPRET 'TIL =' STEM||0
      IF DATATYPE(TIL) = 'NUM' THEN LEAVE
      /* CALCULATE THE EOB */
      DO CNT = 1 UNTIL DATATYPE(TIL) = 'NUM'
          INTERPRET 'X =' STEM||CNT
          IF X == '' THEN TIL = CNT - 1
          IF 'X'||X = 'X'||STEM||CNT THEN TIL = CNT - 1
          END
      END
  IF STEM \= '' & UPD THEN DO CNT = SEQ FOR TIL
      IF CNT = SEQ & ORIGSEQ = 0 THEN CNT = PCIO.PTR.0 + 1
      IF LMT <= 0 THEN LEAVE
      LMT = LMT - 1
      INTERPRET 'PCIO.PTR.CNT =' STEM||NDX
      NDX = NDX + 1
      IF PCIO.PTR.0 < CNT THEN PCIO.PTR.0 = CNT
      END
  IF STEM \= '' & INS THEN DO 1  /* NOTE, INSERTS GO BEFORE THE SEQ PTR */
      IF AFT THEN LOC = SEQ + 1; ELSE LOC = SEQ
      /* FIRST MOVE THE TIL AMT OF RECS TO END OF STEM SET. */
      QUE = PCIO.PTR.0  /* POINT AT LAST RECORD IN STEM VAR */
      DO CNT = TIL + PCIO.PTR.0 BY -1 FOR (PCIO.PTR.0 - LOC) + 1
          PCIO.PTR.CNT = PCIO.PTR.QUE
          QUE = QUE - 1
          END
      PCIO.PTR.0 = TIL + PCIO.PTR.0   /* SET NEW CNT OF RECS IN FILE. */
      /* NOW FILL THE HOLE THAT WAS JUST MADE */
      QUE = 1
      DO CNT = LOC FOR TIL
          INTERPRET 'PCIO.PTR.CNT =' STEM||QUE
          QUE = QUE + 1
          END
      END
  IF STEM \= '' & DEL THEN DO 1  /* NOTE, DELETES START AT SEQ PTR FOR LMT */
      IF AFT THEN LOC = SEQ + 1; ELSE LOC = SEQ
      /* USE FIRST MOVE THE TIL AMT OF RECS TO END OF STEM SET. */
      QUE = (LOC + LMT)
      DO CNT = LOC FOR PCIO.PTR.0
          IF QUE <= PCIO.PTR.0
             THEN PCIO.PTR.CNT = PCIO.PTR.QUE
          IF QUE > PCIO.PTR.0
             THEN IF CNT > 0 THEN CNT = CNT - 1
          QUE = QUE + 1
          IF QUE > PCIO.PTR.0 THEN DO
              PCIO.PTR.0 = CNT
              LEAVE CNT
              END
          END
      END
  IF FINIS THEN DO  /* REWRITE THE FILE. */
      X = LINEOUT(XNAM,,1)   /* OPEN FILE FOR O/P */
      DO CNT = 1 FOR PCIO.PTR.0  /* FOR NUMBER OF RECS IN BFR */
          X = LINEOUT(XNAM,PCIO.PTR.CNT)
          END
      X = LINEOUT(XNAM)      /* CLOSE O/P FILE */
      X = STREAM(XNAM,'C','CLOSE')
      END
  END
IF FINIS THEN DO  /* CHANGE THE FILENAME TO NULL */
    X = ''; Y = ''
    X = LINEIN(XNAM,1,0) /* JUST RESET FILE POINTER. */
    X = STREAM(XNAM,'C','CLOSE')
    IF PTR > 1 THEN X = SUBWORD(PCIONAMS,1,PTR-1)
    IF PTR < WORDS(PCIONAMS) THEN Y = SUBWORD(PCIONAMS,PTR+1)
    PCIONAMS = X '*'NAM Y
    END
EXECPCX:
RETURN RC
/*
IF SYMBOL('PCIONAMS') \= 'VAR' THEN PCIONAMS = ''
PARSE ARG ARGSTR 1 . . FMT .
IF FMT = '$DSN'
   THEN PARSE VAR ARGSTR LMT TYP . NAM . SEQ OPTS
   ELSE PARSE VAR ARGSTR LMT TYP NAM SEQ OPTS
IF SEQ = '' | SEQ = '(' THEN SEQ = 0
TYP = TRANSLATE(TYP)   /* MAKE IT UPPERCASE */
IF LMT = '*' THEN LMT = 999999
ORIGSEQ = SEQ
IF SEQ = 0 THEN SEQ = 1
X = FIND(PCIONAMS,NAM)
/* IF X = 0 THEN FILE HAS NOT BEEN READ INTO STEM STORAGE... */
IF X = 0 THEN DO
    PCIONAMS = PCIONAMS NAM
    PTR = WORDS(PCIONAMS)
    PCIO.PTR.0 = 0    /* SIGNAL THAT FILE BFR IS EMPTY */
    END
XNAM = NAM
IF POS(':',NAM) = 0 & POS('\',NAM) = 0
   THEN DO  /* FIGURE OUT WHERE THE FILE IS BECAUSE THE LINES CMD WON'T */
    RC = WHEREIS(NAM '*STACK *QUIET')
    PULL XNAM .
    IF XNAM = '' THEN XNAM = NAM
    END
IF X = 0 THEN DO CNT = 1 WHILE LINES(XNAM) \= 0
    IF CNT = 1 THEN DO
        RC = LINEIN(XNAM,1,0) /* JUST OPEN THE FILE. */
        PTR = FIND(PCIONAMS,NAM)
        END
    PCIO.PTR.CNT = LINEIN(XNAM)
    PCIO.PTR.0 = CNT     /* KEEP TRACK OF RECS IN FILE */
    END
IF X = 0 THEN RC = STREAM(XNAM,'C','CLOSE')  /* ISSUE A CLOSE */
PTR = FIND(PCIONAMS,NAM)
BFR = PCIO.PTR.0
FIFO = 1; LIFO = 0; FINIS = 0; LOCATE = 0; FIND = 1
RC = 0; UPD = 0; INS = 0; DEL = 0; AFT = 0
STRING = ''; KEY = ''; STEM = ''; DLM = ''; CASE = ''
IF OPTS \= '' THEN DO    /* PARSE THE OPTS */
    IF POS('(',OPTS) \= 0 THEN PARSE VAR OPTS '(' OPTS
    X = FIND(TRANSLATE(OPTS),'STRING')
    IF X \= 0 THEN DO
        STRING = SUBWORD(OPTS,X+1)
        OPTS = SUBWORD(OPTS,1,X-1)
        END
    OPTS = TRANSLATE(OPTS)  /* NOW IT'S SAFE TO TRANS TO UPCASE */
    IF FIND(OPTS,'LIFO') \= 0 THEN DO
        PARSE VAR OPTS X 'LIFO' Y; OPTS = X Y
        LIFO = 1; FIFO = 0
        END
    IF FIND(OPTS,'FIFO') \= 0 THEN DO
        PARSE VAR OPTS X 'FIFO' Y; OPTS = X Y
        FIFO = 1; LIFO = 0
        END
    IF FIND(OPTS,'FINIS') \= 0 THEN DO
        PARSE VAR OPTS X 'FINIS' Y; OPTS = X Y
        FINIS = 1
        END
    IF FIND(OPTS,'UPDATE') \= 0 THEN DO
        PARSE VAR OPTS X 'UPDATE' Y; OPTS = X Y
        UPD = 1
        END
    IF FIND(OPTS,'INSERT') \= 0 THEN DO
        PARSE VAR OPTS X 'INSERT' Y; OPTS = X Y
        INS = 1
        END
    IF FIND(OPTS,'DELETE') \= 0 THEN DO
        PARSE VAR OPTS X 'DELETE' Y; OPTS = X Y
        DEL = 1
        END
    IF (INS | DEL) & FIND(OPTS,'AFTER') \= 0 THEN DO
        PARSE VAR OPTS X 'AFTER' Y; OPTS = X Y
        AFT = 1
        END
    IF FIND(OPTS,'STEM') \= 0 THEN DO
        PARSE VAR OPTS X 'STEM' STEM Y; OPTS = X Y
        LIFO = 0; FIFO = 0  /* NOT VALID WITH STEM VAR LOGIC */
        END
    IF FIND(OPTS,'STRDLM') \= 0 THEN DO
        PARSE VAR OPTS X 'STRDLM' DLM Y; OPTS = X Y
        DLM = STRIP(DLM)  /* STRING DELIMITER IS SET */
        END
    IF FIND(OPTS,'CASE') \= 0 THEN DO
        PARSE VAR OPTS X 'CASE' CASE Y; OPTS = X Y
        CASE = STRIP(CASE)  /* STRING DELIMITER IS SET */
        END
    IF FIND(OPTS,'LOCATE') \= 0 THEN DO
        PARSE VAR OPTS X 'LOCATE' KEY; OPTS = X
        KEY = STRIP(KEY)
        LOCATE = 1; FIND = 0
        END
    IF FIND(OPTS,'FIND') \= 0 THEN DO
        PARSE VAR OPTS X 'FIND' KEY; OPTS = X
        KEY = STRIP(KEY)
        FIND = 1; LOCATE = 0
        END
    IF \INS & \DEL & \UPD THEN UPD = 1
    END
IF TYP = 'DISKR' THEN DO
  IF KEY = '' & BFR < SEQ THEN DO  /* SEQ NO. NOT IN FILE */
      RC = 3
      IF FIFO THEN QUEUE 'EOF'
      IF LIFO THEN PUSH 'EOF'
      SIGNAL EXECPCX       /* NO RECORDS IN FILE */
      END
  IF KEY = '' THEN DO CNT = SEQ FOR BFR-(SEQ-1)
      IF LMT <= 0 THEN LEAVE
      LMT = LMT - 1        /* DECREMENT DOWN TO LIMIT. */
      IF SYMBOL('PCIO.PTR.CNT') = 'VAR'
         THEN DO
          IF STEM \= ''  /* IS READ DATA TO BE PUT INTO STEM VARS? */
             THEN DO
              NDX = CNT - (SEQ-1)
              INTERPRET STEM||NDX '= PCIO.PTR.CNT'
              INTERPRET STEM||0   '=' NDX
              END
             ELSE DO
              IF FIFO THEN QUEUE PCIO.PTR.CNT
              IF LIFO THEN PUSH PCIO.PTR.CNT
              END
          END
      IF SYMBOL('PCIO.PTR.CNT') \= 'VAR'
         THEN DO
          IF STEM \= ''
             THEN DO
              NDX = CNT - (SEQ-0)
              INTERPRET STEM||0 '=' NDX
              END
             ELSE DO
              IF FIFO THEN QUEUE 'EOF'
              IF LIFO THEN PUSH 'EOF'
              END
          RC = 1      /*    */
          LEAVE CNT   /* CONSIDER IT AN EOF CONDITION. */
          END
      END
   IF KEY \= '' & BFR < SEQ THEN DO
      IF LIFO THEN PUSH 'EOF'
      IF FIFO THEN QUEUE 'EOF'
      IF STEM \= '' THEN INTERPRET STEM||0 '= 0' /* NO RECS */
      RC = 2    /* MEANS RECORD NOT FOUND */
      SIGNAL EXECPCX
      END
  IF KEY \= '' THEN DO CNT = SEQ FOR BFR-(SEQ-1)
      IF CNT = SEQ THEN RC = 3  /* IT GETS SET TO ZERO IF MATCH FND */
      IF LMT <= 0 THEN LEAVE
      LMT = LMT - 1        /* DECREMENT DOWN TO LIMIT. */
      IF SYMBOL('PCIO.PTR.CNT') = 'VAR'
         THEN DO
          REC = PCIO.PTR.CNT
          IF LOCATE
             THEN IF POS(KEY,TRANSLATE(REC)) = 0
                 THEN ITERATE
                 ELSE NOP
          IF FIND
             THEN IF TRANSLATE(LEFT(STRIP(REC,L),LENGTH(KEY))) \= KEY
                 THEN ITERATE
                 ELSE NOP
          RC = 0    /* SWITCH SAYS ITS FOUND. */
          IF FIFO THEN DO
              QUEUE CNT-(SEQ-1) CNT
              QUEUE REC
              END
          IF LIFO THEN DO
              PUSH REC
              PUSH CNT-(SEQ-1) CNT
              END
          IF STEM \= '' THEN DO
              INTERPRET STEM||0 '= 2' /* TWO RECORDS */
              INTERPRET STEM||1 '= REC'
              INTERPRET STEM||2 '=' CNT-(SEQ-1) CNT
              END
          LEAVE CNT
          END
         ELSE DO
          IF LIFO THEN PUSH 'EOF'
          IF FIFO THEN QUEUE 'EOF'
          IF STEM \= '' THEN INTERPRET STEM||0 '= 0' /* NO RECS */
          RC = 2    /* MEANS RECORD NOT FOUND */
          LEAVE CNT
          END
      END
  END
IF TYP = 'DISKW' THEN DO
  IF STRING == '' & STEM = ''
     THEN DO  /* PULL DATA OUT OF THE STACK */
      STEM = 'STK.'
      IF QUEUED() < LMT THEN STKCNT = QUEUED(); ELSE STKCNT = LMT
      DO CNT = 1 FOR STKCNT
          IF CASE = 'U'
             THEN PARSE UPPER PULL STK.STKCNT
             ELSE PARSE PULL STK.STKCNT
          STK.0 = STKCNT      /* KEEP IN SYNC FOR REC COUNT */
          END
      END
  IF STRING \= '' & STEM = ''
     THEN DO
      STEM = 'STR.'
      IF CASE = 'U' & STRING \= ''
         THEN STRING = TRANSLATE(STRING)
      IF DLM = ''
         THEN DO
          STR.1 = STRING
          STR.0 = 1
          END
         ELSE DO CNT = 1 WHILE STRING \== ''
          PARSE VAR STRING STR (DLM) STRING
          STR.CNT = STR
          STR.0 = CNT
          END
      END
  /* WRITE O/P RECS INTO THE I/O BUFFER AREA */
  NDX = 1
  IF STEM \= '' THEN DO 1
      INTERPRET 'TIL =' STEM||0
      IF DATATYPE(TIL) = 'NUM' THEN LEAVE
      /* CALCULATE THE EOB */
      DO CNT = 1 UNTIL DATATYPE(TIL) = 'NUM'
          INTERPRET 'X =' STEM||CNT
          IF X == '' THEN TIL = CNT - 1
          IF 'X'||X = 'X'||STEM||CNT THEN TIL = CNT - 1
          END
      END
  IF STEM \= '' & UPD THEN DO CNT = SEQ FOR TIL
      IF CNT = SEQ & ORIGSEQ = 0 THEN CNT = PCIO.PTR.0 + 1
      IF LMT <= 0 THEN LEAVE
      LMT = LMT - 1
      INTERPRET 'PCIO.PTR.CNT =' STEM||NDX
      NDX = NDX + 1
      IF PCIO.PTR.0 < CNT THEN PCIO.PTR.0 = CNT
      END
  IF STEM \= '' & INS THEN DO 1  /* NOTE, INSERTS GO BEFORE THE SEQ PTR */
      IF AFT THEN LOC = SEQ + 1; ELSE LOC = SEQ
      /* FIRST MOVE THE TIL AMT OF RECS TO END OF STEM SET. */
      QUE = PCIO.PTR.0  /* POINT AT LAST RECORD IN STEM VAR */
      DO CNT = TIL + PCIO.PTR.0 BY -1 FOR (PCIO.PTR.0 - LOC) + 1
          PCIO.PTR.CNT = PCIO.PTR.QUE
          QUE = QUE - 1
          END
      PCIO.PTR.0 = TIL + PCIO.PTR.0   /* SET NEW CNT OF RECS IN FILE. */
      /* NOW FILL THE HOLE THAT WAS JUST MADE */
      QUE = 1
      DO CNT = LOC FOR TIL
          INTERPRET 'PCIO.PTR.CNT =' STEM||QUE
          QUE = QUE + 1
          END
      END
  IF STEM \= '' & DEL THEN DO 1  /* NOTE, DELETES START AT SEQ PTR FOR LMT */
      IF AFT THEN LOC = SEQ + 1; ELSE LOC = SEQ
      /* USE FIRST MOVE THE TIL AMT OF RECS TO END OF STEM SET. */
      QUE = (LOC + LMT)
      DO CNT = LOC FOR PCIO.PTR.0
          IF QUE <= PCIO.PTR.0
             THEN PCIO.PTR.CNT = PCIO.PTR.QUE
          IF QUE > PCIO.PTR.0
             THEN IF CNT > 0 THEN CNT = CNT - 1
          QUE = QUE + 1
          IF QUE > PCIO.PTR.0 THEN DO
              PCIO.PTR.0 = CNT
              LEAVE CNT
              END
          END
      END
  IF FINIS THEN DO  /* REWRITE THE FILE. */
      X = LINEOUT(XNAM,,1)   /* OPEN FILE FOR O/P */
      DO CNT = 1 FOR PCIO.PTR.0  /* FOR NUMBER OF RECS IN BFR */
          X = LINEOUT(XNAM,PCIO.PTR.CNT)
          END
      X = LINEOUT(XNAM)      /* CLOSE O/P FILE */
      X = STREAM(XNAM,'C','CLOSE')
      END
  END
IF FINIS THEN DO  /* CHANGE THE FILENAME TO NULL */
    X = ''; Y = ''
    X = LINEIN(XNAM,1,0) /* JUST RESET FILE POINTER. */
    X = STREAM(XNAM,'C','CLOSE')
    IF PTR > 1 THEN X = SUBWORD(PCIONAMS,1,PTR-1)
    IF PTR < WORDS(PCIONAMS) THEN Y = SUBWORD(PCIONAMS,PTR+1)
    PCIONAMS = X '*'NAM Y
    END
EXECPCX:
RETURN RC
*/
FIND: PROCEDURE
PARSE UPPER ARG STR,FND
POS = WORDPOS(FND,STR)
RETURN POS
/*BEGTYPE
PGMNAME:     REXXRDR

FUNCTION:    Randomly read named dataset using a supplied index, and
             an optional search keyword.

DESCRIPTION: This EXEC when invoked will read named file using EXECIO at
             the indicated location and create a stack entry for record.
             If optional keyword is entered an additional stack entry
             will be made defining the sequence of next record to resume
             reading at.

EXEC FORMAT:
             Enter command in the format shown below for CMS:
 REXXRDR  VFNAM VFTYP VFMOD VRECSEQ < VKEYWORD <LOCATE|FIND> > < VOPTS >
             Enter command in the format shown below for TSO datasets:
 REXXRDR  $DSN  VFDSN VFDD  VRECSEQ < VKEYWORD <LOCATE|FIND> > < VOPTS >
             For already allocated DDs that refer to PO datasets enter:
 REXXRDR  $DSN  VMEM VMEMDD VRECSEQ < VKEYWORD <LOCATE|FIND> > < VOPTS >

                <   > -Means fields within are optional.
                  |   -Means select for entry one or the other, not both.
                VFNAM -Enter name of file to read.  EX... cobolpgm
                VFTYP -Enter type of file to read.  EX... cobol
                VFMOD -Enter mode of file to read.  EX... A
              VRECSEQ -Enter seq. of rec. to read.  EX... 001
                       In CMS the file is closed after each request.
                 $DSN -Enter exactly as shown.        EX... $DSN
                VFDSN -Enter name of dataset to read. EX... 'REX.PO(TBL)'
                       Follow TSO's standard dataset
                       naming conventions. For instance,
                       dataset names not within quotes
                       will be prefixed with a TSO ID.
                 VMEM -If the file wanted is a member EX... (REXXTBL)
                       in a PO dataset(s) already allocated
                       to a DD name you may enter only the
                       the member name enclosed in perens.
                       For more info refer to 'VMEMDD' below.
                VFDD  -Enter DD name for allocate.    EX... TBLDD
              VMEMDD  -Enter DD name of an already    EX... SYSEXEC
                       allocated DD for a PO dataset.
                       For example, many PO DDs are set
                       when ISPF is initialized.  DDs such
                       'SYSEXEC' for REXX or 'ISPPLIB' can
                       can be used to read members in their
                       respective libraries.
              VRECSEQ -Enter seq. of rec. to read.    EX... 001
                       Use zero to read the dataset sequentially, and
                       use the "*finis" keyword to close the file.
             VKEYWORD -Optional, and when used will cause pgm to
                       scan each input record until a match is found.
                       The matched record will be stacked,
                       and preceeded by a second stack entry defining
                       the sequence of the next record in the file.
                       If the keyword is not found the return code is 3.
                       Note, centsign(›) is an invalid keyword search
                       character for CMS read requests.
          LOCATE|FIND -Optional... Tells where to search for VKEYWORD.
                       LOCATE says look everywhere for the search field.
                       FIND, look only at fields starting in column 1.
                       The default is LOCATE.
                VOPTS -Optional keywords are available.  They are defined
                       below:
                     *CONTUSE - When the CONTREC() does a continuation
                                the continuation character is dropped.
                                If this keyword is entered the contin-
                                uation character becomes part of the
                                output record.
                    *BLANKSON - When CONTREC(), ADDDLM(), RECEND(), or
                                search keys are entered containing
                                under_bar characters under_bars are
                                changed to blanks when this keyword
                                is found.
                       *FINIS - TSO only.  Use this option to request
                                that the file be closed when the
                                read process is completed.  This should
                                be used when the last record is read.
                   *CONTREC() - When multiple records that contain cont-
                                inuations should be read as one record
                                this keyword is used.  Just put the
                                desired continuation character within
                                perens(). For example, CONTREC(,).
                                Note, whenever the continuation option
                                is set the sequence of the last record
                                read is stacked before the data record.
                    *RECEND() - When multiple records are to be read
                                until a specific set of characters
                                are found on a record, use this option.
                                For example, RECEND(::) will keep reading
                                records concatinating them together
                                until one of the records contains the
                                characters ::.
                     *DROPEND - Used in conjunction with the '*RECEND()'
                                option it means to not concatinate the
                                record containing the record ending
                                character(s).  For example, if the
                                following records were being read using
                                the values:
                           REXXRDR $DSN IDLST LDD NUY *RECEND(:) *DROPEND
                                    USERINFO: USER MOLVANNI 10504
                                                PW TRUSTME
                                    USERINFO: USER NUY      30102
                                                PW ROSEBUD
                                    USERINFO: USER OSCAR    ETC...
                                the record below would get stacked.
                                USERINFO: USER NUY      30102 PW ROSEBUD
                    *ADDDLM() - Used in conjunction with the '*RECEND()'
                                option it specifies a character or string
                                that will be inserted between record
                                segments.  For example, if the following
                                records were being read using:
                           REXXRDR $DSN IDLST LDD *RECEND(.) *ADDDLM(,)
                                    USERINFO: USER MOLVANNI 10504
                                                PW TOPPER.
                                the record below would get stacked.
                                USERINFO: USER MOLVANNI 10504, PW TOPPER.
                        *CC() - Use this to select portions of the input
                                record.  Enter any number of position
                                and length pairs.  For example,
                                *CC(1 71) will read an input file and
                                ignore continuation or sequence fields
                                starting in position 72.
                        *SC() - Use this to search a portion of the input
                                record for an input key look-up value
                                via a position and length specification.
                                *SC(73 8) will look for the search value
                                in the last 8 bytes of 80 byte records.
                        *WT() - Use this to select word tokens from input
                                record.  Enter any number of position
                                and number pairs.  For example,
                                *WT(2 1 1 1 3) will rearrange the input
                                fields so that field2 precedes field1.
                                When the number parameter is missing from
                                the pair all remaining fields are used.
                    *BFRSIZ() - TSO only.  In CMS there is a commonly
                                used EXECIO option that does keyword
                                searches.  In TSO the EXECIO does not
                                have a keyword search option.  Keyword
                                searches in TSO, therefore, require
                                reading the file until the key is found.
                                This number specifies the number of
                                records to read (per IO) at a time
                                before scanning them for the wanted key.
                                The default is 128 records per EXECIO.

OUTPUT:      PUSH  (VM formatted record)
                       VM formatting means each field of card must
                       be 8 bytes or less for CMS to process it.
                       Only 250 bytes can be stacked.  Therefore, bigger
                       records will be sent in 250 byte segments, and
                       a record segment is recognized by it having an
                       '@' as its 251st byte.
             PUSH  nnnnn  sssss
                       This is passed as first stack entry when keyword
                       is used, or the CONTREC() or RECEND() option set.
                       nnnnn is the number records between the key and
                             the starting sequence for the scan.
                             For CONTREC or RECEND options it is the
                             sequence of the first record in the set.
                       sssss is the sequence number of the record having
                             the key.  For CONTREC or RECEND options it
                             is the sequence of the last record in set.

             PUSH  EOF
                       This is passed back at end of file.  rc = 2.

EXAMPLES: The following shows fourth record of a file being read.

     'REXXRDR COMMAND FILE A 0004'
     IF RC \= 0 THEN EXIT RC
     PULL VCMD VOP1 VOP2 VOP3 VOP4
     /* NEXT LINE WOULD EXECUTE THE COMMAND READ FROM FILE */
     INTERPRET VCMD VOP1 VOP2 VOP3 VOP4
     EXIT 000

         To lookup a CICS user ID definition in an assembler macro like
         table, with commas for continuation, and continuation and
         sequence fields in columns 72 to 80 enter:

     "REXXRDR DFHSNT ASSEMBLE A 0 CICSUID *CONTREC(,) *CC(1 71) *CONTUSE"
     IF RC \= 0 THEN SIGNAL NOTFOUND
     PULL SEQINFO; PULL USERDEF
     IF WORD(USERDEF,1) = 'EOF' THEN SIGNAL NOTFOUND
     IF POS('TYPE=ENTRY',USERDEF) > 0,
        THEN PARSE VAR USERDEF 1 "OPNAME='" !USERID "'",
                               1 "OPIDENT=" OPID ",",
                               1 "PASSWRD=" PASSWORD ",",
                               1 "TIMEOUT=" +8 TIMEOUT +2
      INPUT
     SAMPLE: ABOVE EXAMPLE WOULD SEARCH A FILE WITH DATA LIKE BELOW.
         DFHSNT TYPE=INITIAL
*
*  ADEL              GEORGE       A  54524     11  M51
*
         DFHSNT TYPE=ENTRY,OPIDENT=M51,OPNAME='ADEL',                  X
               OPCLASS=2,PASSWRD=SHOWER,SCTYKEY=(1,2,3,24),            X
               TIMEOUT=60
*
ENDTYPE*/
/*************************************************************************/
DOC:
TEXT=''  /* BUT DOCUMENTATION DOES NOT HAVE TO BE IT THE BEGINNING.      */
SOURCECNT = SOURCELINE()         /* REDUCES NUMBER OF CALLS TO SOURCELINE*/
DO SEQ = 1301,
   UNTIL POS('-*/',TEXT)>0 | POS('ENDTYPE*/',TEXT)>0 | SEQ>SOURCECNT
    SOURCEREC = SOURCELINE(SEQ)  /* REDUCES NUMBER OF CALLS TO SOURCELINE*/
    IF SOURCEREC == '' THEN SOURCEREC = ' ' /* PC PASSES NULLS NOT BLANKS*/
    IF TEXT == ''
       THEN IF POS('/*-',WORD(SOURCEREC,1))=0 &,
           POS('/*BEGTYPE',WORD(SOURCEREC,1))=0
           THEN ITERATE
    TEXT = SOURCEREC
    IF POS('/*BEGTYPE',WORD(TEXT,1))>0 | POS('ENDTYPE*/',WORD(TEXT,1))>0
       THEN ITERATE
    SAY TEXT
    END
EXIT 000
ERR008:
SAY 'REXXRDR - TO FEW INPUT PARAMETERS TO CONTINUE.  SEE DOC IN EXEC.'
EXIT 008
ERR012:
SAY 'REXXRDR - FILE ('SUBWORD(ARGSTRING,1,3),
    ") CAN'T BE FOUND VIA CMS INFERENCE LOGIC."
EXIT 012
ERR100:
SAY 'REXXRDR - AT LEAST FOUR INPUT FIELDS ARE NEEDED.  SEE DOC IN EXEC.'
EXIT 100
ERR120:
SAY 'REXXRDR - FILE ('V1 V2 V3") CAN'T BE FOUND VIA STATE COMMAND."
EXIT 120
ERR123:
SAY 'REXXRDR - FILE ('V1 V2 V3") CAN'T BE FOUND BY ALLOCATE COMMAND."
EXIT 123
ERR130:
SAY 'REXXRDR - FILE SEQUENCE' V4 'IS OUTSIDE THE FILES LIMITS.'
EXIT 130
ERR140:
SAY 'REXXRDR - THE VALID SCAN OPTIONS ARE LOCATE OR FIND, BUT FOUND' V6
EXIT 140
ERR150:
SAY 'REXXRDR - INVALID *CC() PARAMETERS ENTERED.  FOUND *CC('CC').'
EXIT 150
ERR155:
SAY 'REXXRDR - NON-NUMERIC *SC() PARAMETERS ENTERED.  FOUND *SC('SC').'
EXIT 155
ERR160:
SAY 'REXXRDR - CONTINUED RECORD IS OVER 250 BYTES LONG. CAN NOT STACK.'
RC = 160
SIGNAL EXIT
ERR170:
SAY 'REXXRDR - NON-NUMERIC BUFFER SIZE SET. FOUND BFRSIZ('BFRSIZ').'
RC = 170
SIGNAL EXIT
ERR172:
SAY 'REXXRDR - NON-NUMERIC O/P STACK SIZE SET. FOUND STKSIZ('STKSIZ').'
RC = 172
SIGNAL EXIT
ERR180:
SAY 'REXXRDR - ISPF REQUIRED FOR READ REQUEST, ISPF IS NOT AVAILABLE.'
RC = 180
SIGNAL EXIT
ERR190:
SAY 'REXXRDR - FILE ('V1 V2 V3") HAS DDNAME CONFLICT WITH" SYSDSNAME"."
EXIT 190
ERR200:
SAY 'REXXRDR - ERROR CLOSING INPUT FILE.'
EXIT 200
ERR210:
SAY 'REXXRDR - ERROR FREEING INPUT FILE.'
EXIT 230
ERR230:
SAY 'REXXRDR - LMINIT FAILED FOR DD' V3'.'
EXIT 230
ERR240:
SAY 'REXXRDR - LMOPEN FAILED FOR DD' V3'.'
EXIT 240
ERR250:
SAY 'REXXRDR - LMMFIND FAILED FOR DD' V3' FOR MEMBER' MEM'.'
EXIT 250
ERR260:
SAY 'REXXRDR - LMGET FAILED FOR DD' V3' ON MEMBER' MEM'.'
EXIT 260
ERR262:
SAY 'REXXRDR - LMGET FAILED ON DD' V3' FOR MEMBER' MEM'.'
EXIT 262