/*REXX*/
/*       'ISREDIT MACRO(PARMS)'   */
T = XGETFILESINDIRFILEINFO("H:\U\SPFPC40\MACROS\","")
SAY T
PARSE PULL Z
  EXIT
/*---------------------------------------------------------------
------------------------------------------------------------------*/
  XSEEKINFILE: PROCEDURE
    PARSE ARG FILENAME,RECN
    RBA = 0
    LRECL = 0
    LRECL = WORD(FILENAME,2)
    SAY "'"LRECL"'"
    RBA = ((LRECL * RECN) - LRECL) + 1
  RETURN (RBA)
/*---------------------------------------------------------------
   Opens Mark's Flat File Data Base - Default Extension is .mdb
   FILENAME = E:\TEST\FILES\MARK.MDB
   Returns String Where:
   WORD 1 = e:\data\test\file.mdb
     FILENAME = FILENAME' 'LRECL' 'NRECS' 'SK' 'P
   WORD 2 = LRECL
   WORD 3 = NRECS
   WORD 4 = SORT FIELD #
   WORD N = STARTCOLUM LENGTH ...
------------------------------------------------------------------*/
   XMDBOPEN: PROCEDURE
    ARG FILENAME
/*  --- Build DFD File Name ---*/
    HPATH = XFILESPEC("H",FILENAME)
    BFS = XFILESPEC("F",FILENAME)
    DFDFN = HPATH''BFS'.DFD'
/*  --- Load Data File Definition ---*/
     DFDFB = FREEFILE
/*   --- Primary Sort Field of Data Base ---*/
     T = ''
     T = LINEIN(DFDFN)
     SK = 0
     SK = WORD(T,2)
/*   --- Get Field Start/End Positions ---*/
     LRECL = 0
     NRECS = 0
     CNT = 0
     SC = 1
     P = ''
     DO WHILE LINES(DFDFN) > 0
       CNT = CNT + 1
       T = LINEIN(DFDFN)
       L = WORD(T,2)
       P = P''WORD(T,1)''SC''L''WORD(T,3)
       SC = SC + L
     END
     T = LINEOUT(DFDFN)
/*   --- Determine LRECL ---*/
     LRECL = SC - 1
/*   --- Determine # Records in Data Base ---*/
     NRECS = LINES(FILENAME)
     T = LINEOUT(FILENAME)
/*   --- Build Return String ---*/
     FILENAME = FILENAME' 'LRECL' 'NRECS' 'SK' 'P
   RETURN (FILENAME)
/*---------------------------------------------------------------*/
/* XMKCAP                                                        */
/*---------------------------------------------------------------*/
  XCAP: PROCEDURE
   ARG X
    X = TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
    XR = ''
    DO CNT = 1 TO WORDS(X)
       XR = XR""TRANSLATE(LEFT(WORD(X,CNT),1))""RIGHT(WORD(X,CNT),LENGTH(WORD(X,CNT))-1)" "
    END
  RETURN XR
/*---------------------------------------------------------------*/
/* XMKLOWER Returns Lower Case String                            */
/*---------------------------------------------------------------*/
  XMKLOWER: PROCEDURE
   ARG X
    XR = TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  RETURN XR
/*---------------------------------------------------------------*/
/* XDOSVAR(VAR)                                                     */
/*  In XP the REXX VALUE does not work in ISREDIT                */
/*  After Screwing around with it forever I gave up and wrote    */
/*  this routine to replace the part where I need to know the    */
/*  value of the DOS environement variable                       */
/*  If VAR is not found '' or null is returned                   */
/*---------------------------------------------------------------*/
  XDOSVAR: PROCEDURE
   ARG X
   X = TRANSLATE(X)
/* --- Build Semi-Unique Result File Name ---*/
   RESULT = 'C:\TEMP\'SUBSTR(DATE('J'),3,3," ")''TIME('S')
   TBAT = RESULT'.BAT'
   RESULT = RESULT'.TXT'
/* --- Build/Execute Temp BAT File ---*/
   T = LINEOUT(TBAT,'SET > 'RESULT)
   T = LINEOUT(TBAT,'EXIT')
   T = LINEOUT(TBAT)
   'ISREDIT DOS 'TBAT
/* --- Find VAR ---*/
   DO WHILE LINES(RESULT) > 0
     T = TRANSLATE(LINEIN(RESULT))
     T = TRANSLATE(T," ","=")
     IF WORD(T,1) = X THEN
       DO
         RETURN WORD(T,2)
       END
   END
   XR = ""
  RETURN XR
/*---------------------------------------------------------------*/
/* Retrieve Path/File Name of Source File C:\DATA\FILENAME.EXT   */
/*  Option Returns                                               */
/*    D      D:                                                  */
/*    P      \PATH1\PATH2\                                       */
/*    N      FILESPEC.EXT                                        */
/*    F      FILESPEC                                            */
/*    E      EXT                                                 */
/*    H      D:\PATH1\PATH2\                                     */
/*    M      D:\PATH1\PATH2\FILESPEC                             */
/*    W      D: \PATH1\PATH2\ FILESPEC EXT                       */
/*    C      D:,\PATH1\PATH2\,FILESPEC,EXT                       */
/*    A      D:\PATH1\PATH2\FILESPEC,EXT                         */
/* Uses XFILESPEC                                                */
/*---------------------------------------------------------------*/
  XSPFILESPEC: PROCEDURE
    PARSE ARG X
    'ISREDIT (FILENAME) = DATASET'
    FILENAME = TRANSLATE(FILENAME)
    IF X <> 'A' THEN
      FILENAME = XFILESPEC(X,FILENAME)
  RETURN  (FILENAME)
/*---------------------------------------------------------------*/
/* If source has not been saved, save it SPF                     */
/*---------------------------------------------------------------*/
  XSAVEFILE:
       'ISREDIT (MODIFIED) = DATA_CHANGED'
       IF (MODIFIED=YES) THEN
         'ISREDIT SAVE'
  RETURN
/*---------------------------------------------------------------*/
/*  XGETFILES: Retrieves Files in Specified Directory            */
/*---------------------------------------------------------------*/
  XGETFILESINDIR: PROCEDURE
    PARSE ARG XP,P1
    IF P1 = "" THEN P1 = "*.*"
    PL = XWORD(P1,1,".")
    PR = XWORD(P1,2,".")
  SAY PL PR
    XR = ' '
    TR = XMKFILESPEC()
    TBAT = XP''TR'.BAT'
    TRET = XP''TR'.TMP'
    T = LINEOUT(TBAT,' DIR 'XP'  >  'TRET)
    T = LINEOUT(TBAT)
    ADDRESS CMD TBAT
    DO WHILE LINES(TRET) > 0
      T = LINEIN(TRET)
      PARSE VAR T TOSS TOSS TOSS TOSS RFILE'.'REXT
  SAY RFILE'  'REXT
  SAY XISLIKE(PL,RFILE) PL RFILE
  SAY XISLIKE(PR,REXT) PR REXT
      IF XISLIKE(PL,RFILE) > 0 | XISLIKE(PR,REXT) > 0 THEN XR = XR" "RFILE"."REXT
    END
  RETURN (XR)
/*---------------------------------------------------------------*/
/*  XGETDIRS: Retrieves directories under specified path         */
/*  XGETDIRS("d:\data")                                          */
/*  Returns data in space delimited words                        */
/*---------------------------------------------------------------*/
   XGETDIRS: PROCEDURE
     PARSE ARG XP
     XR = ' '
     TR = XMKFILESPEC()
     TBAT = XP''TR'.BAT'
     TRET = XP''TR'.TMP'
     T = LINEOUT(TBAT,' DIR 'XP'  >  'TRET)
     T = LINEOUT(TBAT)
     ADDRESS CMD TBAT
     DO WHILE LINES(TRET) > 0
       T = LINEIN(TRET)
       IF POS("DIR",T,1) > 0 THEN
         DO
           XR = XR' 'WORD(T,5)
         END
     END
     T = LINEOUT(TRET)
     T = XDELFILE(TBAT)
     T = XDELFILE(TRET)
   RETURN (XR)
/*---------------------------------------------------------------*/
/*--- Build Semi-Unique Result File Name ---*/
   XMKFILESPEC: PROCEDURE
     XR = SUBSTR(DATE('J'),3,3," ")''TIME('S')
   RETURN (XR)
/*---------------------------------------------------------------*/
   XFIXADDRESS:  PROCEDURE
     PARSE ARG X
     CNT = 0
     NWRDS = 0
     XR = ""
     T = ""
     TT = ""
     S = 0
     T = XPROPER(STRIP(TRANSLATE(X,"",".")))
     NWRDS = WORDS(T)
     DO CNT = 1 TO NWRDS
/*     --- Period? ---*/
/*     IF POS(".",T,1) > 1 THEN T = LEFT(T,POS(".",T,1)-1)  */
/*     --- Incorrect Postal Abbriviation? ---*/
       TT = WORD(T,CNT)
       IF TRANSLATE(TT) = "AV" | TRANSLATE(TT) =  "AVENUE" THEN TT = "Ave"
       IF TRANSLATE(TT) = "CR" | TRANSLATE(TT) =  "CIRCLE" THEN TT = "Cir"
       IF TRANSLATE(TT) = "STREET" THEN TT = "St"
       IF TRANSLATE(TT) = "COURT" THEN TT = "Ct"
       IF TRANSLATE(TT) = "WY" THEN TT = "Way"
       IF TRANSLATE(TT) = "PLACE" THEN TT = "Pl"
       IF TRANSLATE(TT) = "BOULEVARD" THEN TT = "Blvd"
       IF TRANSLATE(TT) = "PARKWAY" THEN TT = "Pkwy"
       IF TRANSLATE(TT) = "DRIVE" THEN TT = "Dr"
       IF TRANSLATE(TT) = "ROAD" THEN TT = "Rd"
       IF TRANSLATE(TT) = "EAST" THEN TT = "E"
       IF TRANSLATE(TT) = "WEST" THEN TT = "W"
       IF TRANSLATE(TT) = "NORTH" THEN TT = "N"
       IF TRANSLATE(TT) = "SOUTH" THEN TT = "S"
       IF TRANSLATE(TT) = "SO" THEN TT = "S"
       IF TRANSLATE(TT) = "NO" THEN TT = "N"
       IF TRANSLATE(TT) = "P O BOX" THEN TT = "PO Box"
/*     --- Accumulate Words ---*/
       XR = XR""TT" "
     END
     XR = LEFT(XR,LENGTH(XR)-1)
   RETURN (XR)
/*---------------------------------------------------------------*/
/* XPROPER(string)                                               */
/*   Returns a string with 1st character upper and rest lower    */
/*   Words will be delimited by one space                        */
/*   Returned string will be striped                             */
/*---------------------------------------------------------------*/
   XPROPER:  PROCEDURE
     PARSE ARG X
     NWRDS = 0
     CNT = 0
     XR = ""
     T = ""
     NWRDS = WORDS(X)
     DO CNT = 1 TO NWRDS
       T = WORD(X,CNT)
       T = TRANSLATE(T,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
       XR = XR""TRANSLATE(LEFT(T,1))""RIGHT(T,LENGTH(T)-1)" "
     END
     XR = LEFT(XR,LENGTH(XR)-1)
   RETURN (XR)
/*---------------------------------------------------------------*/
   XFILEINFO:  PROCEDURE
     PARSE ARG X
     XR = STREAM(X,C,'QUERY SIZE')
     XR = XR' 'STREAM(X,C,'QUERY DATETIME')
   RETURN (XR)
/*---------------------------------------------------------------*/
/* XISLIKE(P,S)                                                  */
/* Returns 1 if the pattern in S matches the pattern in P.       */
/* wild card rules apply (?*).                                   */
/* * = stop compare here                                         */
/* ? = any character allowed here but must be present (not nu    */
/* # = must be a number here (0123456789)                        */
/* % = must be a character here (A-Z case ignored)               */
/* ANY other characters in pattern P will be used as required    */
/* characters for that position.                                 */
/* EXAMPLE: T = XISLIKE("??E??T","HRESST")  1                    */
/*          T = XISLIKE("??E??T","HRESST")  1                    */
/*          T = XISLIKE("??E?#T","HRES1T")  1                    */
/*          T = XISLIKE("??E?#T","HRESST")  0                    */
/*          T = XISLIKE("(###)###-####","(a12)373-5794")    0    */
/*---------------------------------------------------------------*/
  XISLIKE: PROCEDURE
    PARSE ARG P,S
    XRC = 0
    IF SUBSTR(P,1,1) = "*" THEN RETURN (1)
    OKF = 1
    DO CNT = 1 TO LENGTH(P)
/*    --- Wildcard? ---*/
      IF SUBSTR(P,CNT,1) = "*" THEN LEAVE
/*    --- Any Character? ---*/
      IF SUBSTR(P,CNT,1) = "?" THEN ITERATE
/*    --- Alpha Only? ---*/
      IF SUBSTR(P,CNT,1) = "%" THEN
        DO
          IF POS(TRANSLATE(SUBSTR(S,CNT,1)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ",1) > 0 THEN
            ITERATE
          ELSE DO
              XRC = 0
              LEAVE
            END
        END
/*    --- Numeric Only? ---*/
      IF SUBSTR(P,CNT,1) = "#" THEN
        DO
          IF POS(SUBSTR(S,CNT,1),"0123456789",1) > 0 THEN
            ITERATE
          ELSE DO
              XRC = 0
              LEAVE
            END                                                      \
      END
/*    --- Exact Match? ---*/
      IF SUBSTR(P,CNT,1) <> SUBSTR(S,CNT,1) THEN
        DO
          XRC = 0
          LEAVE
        END
    END
   RETURN (XRC)
/*---------------------------------------------------------------*/
/*  Breaks Variable Down into Drive:\Path\filespec.ext components*/
/*  T = "D:\PATH1\PATH2\FILESPEC.EXT"                            */
/*  R = XFILESPEC(OPTION,T)                                      */
/*  Option Returns                                               */
/*    D      D:                                                  */
/*    P      \PATH1\PATH2\                                       */
/*    N      FILESPEC.EXT                                        */
/*    F      FILESPEC                                            */
/*    E      EXT                                                 */
/*    H      D:\PATH1\PATH2\                                     */
/*    M      D:\PATH1\PATH2\FILESPEC                             */
/*    W      D: \PATH1\PATH2\ FILESPEC EXT                       */
/*    C      D:,\PATH1\PATH2\,FILESPEC,EXT                       */
/*   Uses XTRIML                                                 */
/*---------------------------------------------------------------*/
  XFILESPEC:  PROCEDURE
    PARSE ARG OPT,X
    XR = ""
    XDRV = ""
    XPATH = ""
    XNAME = ""
    XSPEC = ""
    XEXT = ""
/*  --- Drive Letter Present? ---*/
    IF POS(":",X,1) > 0 THEN
      DO
        XDRV = LEFT(X,2)
/*      --- Remove Drive Letter: ---*/
        X = XTRIML(X,2)
      END
/*  --- Path Present? ---*/
    IF POS("\",X,1) > 0 THEN
      DO
        SP = POS("\",X,1)
        EP = LASTPOS("\",X)
        IF SP <> EP THEN XPATH = SUBSTR(X,SP,EP-SP+1)
        IF SP = EP THEN XPATH = "\"
/*      --- Remove Path ---*/
        X = XTRIML(X,EP)
      END
/*  --- Get File Spec ---*/
    XNAME = X
    SP = POS(".",X,1)
    IF SP > 0 THEN
      DO
        XSPEC = LEFT(X,SP-1)
        X = XTRIML(X,SP)
        XEXT = X
      END
    IF OPT = "D" THEN XR = STRIP(XDRV)
    IF OPT = "P" THEN XR = STRIP(XPATH)
    IF OPT = "N" THEN XR = STRIP(XNAME)
    IF OPT = "F" THEN XR = STRIP(XSPEC)
    IF OPT = "E" THEN XR = STRIP(XEXT)
    IF OPT = "H" THEN XR = STRIP(XDRV""XPATH)
    IF OPT = "M" THEN XR = STRIP(XDRV""XPATH""XSPEC)
    IF OPT = "W" THEN XR = STRIP(XDRV" "XPATH" "XSPEC" "XEXT)
    IF OPT = "C" THEN XR = STRIP(XDRV","XPATH","XSPEC","XEXT)
  RETURN (XR)
/*---------------------------------------------------------------*/
/* Get parm attached to keyword/switch within variable           */
/* T = "OPAL TESTING GOBBLE'123   456' TEST2"   = '123   456'    */
/*---------------------------------------------------------------*/
  XGETPARM:  PROCEDURE
    PARSE ARG N,H
    XR = ""
    SP = POS(TRANSLATE(N),TRANSLATE(H),1)
    IF SPF > 0 THEN
      DO
        L = LENGTH(N)
        EP = POS("'",H,SP+L+1)
        XR = SUBSTR(H,SP+L+1,EP-SP-L-1)
      END
  RETURN (XR)
/*---------------------------------------------------------------*/
/* Swap Text Around Comma, Removes Comma, Fixes Spacing          */
/* T = XFLIP("MCDONALD, MARK")  returns "Mark McDonald"          */
/*---------------------------------------------------------------*/
  XFLIP:   PROCEDURE
    PARSE ARG X
    X = STRIP(X)
    X = SPACE(X,1," ")
    T = POS(",",X,1)
    IF T > 0 THEN X = SUBSTR(X,T+1)" "LEFT(X,T-1)
    XR = STRIP(X)
  RETURN (XR)
/*---------------------------------------------------------------*/
/* Removes Rightmost n characters                                */
/* T = XTRIMR("one--",2)   returns "one"                         */
/*---------------------------------------------------------------*/
  XTRIMR:  PROCEDURE
    PARSE ARG X, N
    IF LENGTH(X) - 1 >= N THEN
      XR = LEFT(X,LENGTH(X) - N)
    ELSE
      XR = X
  RETURN (XR)
/*---------------------------------------------------------------*/
/* Removes Leftmost n characters                                 */
/* T = XTRIML("--ONE",2)   returns "ONE"                         */
/*---------------------------------------------------------------*/
  XTRIML:  PROCEDURE
    PARSE ARG X, N
    IF LENGTH(X) - 1 >= N THEN
      XR = RIGHT(X,LENGTH(X) - N)
    ELSE
      XR = X
  RETURN (XR)
/*---------------------------------------------------------------*/
/*  DELETES FILE Z                                               */
/*---------------------------------------------------------------*/
  XDELFILE: PROCEDURE
    PARSE ARG Z
    'ISREDIT DOS DEL 'Z
  RETURN (RC)
/*---------------------------------------------------------------*/
/*  RETURNS 1 IF FILE EXISTS 0 IF NOT                            */
/*---------------------------------------------------------------*/
  XEXIST: PROCEDURE
    PARSE ARG X
    XRC = 0
    INPATH = STREAM(X,'C','QUERY EXIST')
    IF INPATH <> "" THEN XRC = 1
  RETURN (XRC)
/*---------------------------------------------------------------*/
  XWORDLENGTH: PROCEDURE
    PARSE ARG X, N, XDL
    IF N > XWORDS(X,XDL) THEN RETURN (0)
    X = XLATE(X,XDL)
    WL = WORDLENGTH(X,N)
  RETURN (WL)
/*---------------------------------------------------------------*/
  XWORDINDEX: PROCEDURE
    PARSE ARG X, N, XDL
    RP = 0
    IF N > XWORDS(X,XDL) THEN RETURN (0)
    X = XLATE(X,XDL)
    RP = WORDINDEX(X,N)
  RETURN (RP)
/*---------------------------------------------------------------*/
   XWORDS: PROCEDURE
     PARSE ARG X, XDL
     X = XLATE(X,XDL)
     NWRDS = WORDS(X)
   RETURN (NWRDS)
/*---------------------------------------------------------------*/
   XWORD: PROCEDURE
     PARSE ARG X, N ,XDL
     IF N > XWORDS(X,XDL) THEN RETURN ("")
     X = XLATE(X,XDL)
     X = WORD(X,N)
     X = XUNLATE(X)
   RETURN (X)
/*---------------------------------------------------------------*/
   XLATE: PROCEDURE
     PARSE ARG X, XDL
     X = TRANSLATE(X,D2C(253)," ")
     X = TRANSLATE(X," ",XDL)
   RETURN (X)
/*---------------------------------------------------------------*/
   XUNLATE: PROCEDURE
     PARSE ARG X
     X = TRANSLATE(X," ",D2C(253))
   RETURN (X)
/*---------------------------------------------------------------*/
   XFINDPARM: PROCEDURE
     PARSE ARG X XWANTED
      RF = 0
      IF POS(TRANSLATE(XWANTED),TRANSLATE(X)) > 0 THEN RF = 1
   RETURN (RF)
/*---------------------------------------------------------------*/