Remove non-alphabetic characters from a string

H/TITLE Remove non-alphabetic characters from string H OPTION(*NOSHOWCPY:*NOEXPDDS:*NODEBUGIO:*SRCSTMT:*SECLVL) H DFTACTGRP(*NO) ACTGRP(*NEW) CCSID(*CHAR : *JOBRUN) H BNDDIR('QC2LE') * Optional parameters * AlphaYN - Y = Only Allow Alphabetic Characters (a-z, A-Z) (Default) * AlphaYN - N = Allow AlphaNumeric Characters (a-z, A-Z, 0-9) * UpLow - L = Convert String to Lower Case * UpLow - U = Convert String to Upper Case D ALPHACHAR PR ExtPgm('ALPHACHAR') D TextIn 100 D AlphaYN 1 D UpLow 1 D AlphaChar PI D TextIn 100 D AlphaYN 1 D UpLow 1 D okChars C 'abcdefghijklmnopqrst- D uvwxyz- D ABCDEFGHIJKLMNOPQRST- D UVWXYZ' D okCharsNum C 'abcdefghijklmnopqrst- D uvwxyz- D ABCDEFGHIJKLMNOPQRST- D UVWXYZ0123456789' D I s 3U 0 D J s 3U 0 D WorkText s 100 D AlphaOnly s 1 Inz('Y') D up c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' D lo c 'abcdefghijklmnopqrstuvwxyz' /free I = %Len(%trim(textIn)); If I <= 0; Return; Endif; workText = %trim(textIn); If %parms() > 1; If AlphaYN = 'N'; // User selected Alpha-Numeric Mode. AlphaOnly = 'N'; EndIf; EndIf; If %parms() > 2; Select; When UpLow = 'L'; // Convert entire name string to lower case. workText = %xlate(up:lo:workText); When UpLow = 'U'; // Convert entire name string to upper case. workText = %xlate(lo:up:workText); Other; Endsl; EndIf; // Alphabetic Characters only If AlphaOnly = 'Y'; Monitor ; I = 1 ; DoW I <= %Len(%trim(workText)); If %Scan(%Subst(workText: I: 1): okChars) > *Zero ; // Character was in the 'valid' list, so skip it I += 1 ; Else ; // Character was not in the 'valid' list. Remove it. worktext = %Replace('': workText: I: 1) ; EndIF ; EndDO ; On-error *All ; // If anything goes wrong, return original value. workText = %trim(textIn); EndMON ; EndIf; // AlphaNumeric Characters allowed If AlphaOnly = 'N'; Monitor ; I = 1 ; DoW I <= %Len(%trim(workText)); If %Scan(%Subst(workText: I: 1): okCharsNum) > *Zero ; // Character was in the 'valid' list, so skip it I += 1 ; Else ; // Character was not in the 'valid' list. Remove it. worktext = %Replace('': workText: I: 1) ; EndIF ; EndDO ; On-error *All ; // If anything goes wrong, return original value. workText = %trim(textIn); EndMON ; EndIf; textIn = %trim(workText); *Inlr = *On; /end-free

[report a broken link by clicking here]