/*---------------------------------------------------------------*/
/* 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)
/*---------------------------------------------------------------*/