An old one but it still works fine. ;)
A+
jml
*:*********************************************************
*:
*: Procedure file: UL.PRG
*:
*: System: PROPER Function Replacement
*: Author: Susan M. Cunningham
*: Copyright (c) 1991, Susan M. Cunningham
*:
*: Procs & Fncts: UL()
*: : CAPNAME()
*: : SUFFIX()
*: : PARTNAME()
*: : CAPAFTER()
*: : MACNAME()
*: : ISUPPER()
*: : WORDS()
*: : WORDNUM()
*:
*: Documented 10/27/92 at 00:07 FoxDoc version 2.10d
*:*********************************************************
FUNCTION UL
PARAMETER thename, paramtype
IF PARAMETERS() < 2 OR paramtype < 1 OR paramtype > 4
paramtype = 0
ENDIF
* paramtype = 1 is used for people's names
* paramtype = 2 is used for trade names
* paramtype = 3 is used for address lines
* paramtype = 4 is used for cities
glUlperiod = .T.
fixname = .F.
fixshop = .F.
fixaddr = .F.
fixcity = .F.
DO CASE
CASE paramtype = 1
fixname = .T.
CASE paramtype = 2
fixshop = .T.
CASE paramtype = 3
fixaddr = .T.
CASE paramtype = 4
fixcity = .T.
OTHERWISE
fixname = .T.
fixshop = .T.
fixaddr = .T.
fixcity = .T.
ENDCASE
PUBLIC moldname
PRIVATE paramtype,fixname,fixshop,fixaddr,fixcity
PRIVATE i,k,lowname,newname,prd_stat
* Converts names (or addresses) to upper/lower case
* Goes beyond the scope of FoxPro's PROPER() function
* because it takes into account the vagaries of people's
* names, and to some extent, the items commonly found
* in addresses.
* Usage is simply: newname = UL(name)
* Any problems or suggestions for improvement would be
* sincerely appreciated by the author.
* - - - - - - > The routine uses two public logical
* - - - - - - > variables, glUlmode and glUlperiod.
* - - - - - - > If these public variables have NOT
* - - - - - - > been initialized by the user, they
* - - - - - - > will be initialized by UL. The
* - - - - - - > default for glUlmode is TRUE and the
* - - - - - - > default for glUlperiod is FALSE.
* - - - - - - > When glUlmode is TRUE, the name will be
* - - - - - - > 'properized'.
* - - - - - - > When glUlmode is FALSE, this routine is
* - - - - - - > ignored and the name returns unchanged.
IF TYPE('glUlmode') <> 'U' AND NOT glUlmode
RETURN thename
ENDIF
* - - - - - - > When glUlperiod is TRUE, this routine will
* - - - - - - > add a period to common prefixes, suffixes
* - - - - - - > or company or street abbreviations, such as
* - - - - - - > Jr., Sr., Mr., Mrs., Ms., Dr., St., Eqs.,
* - - - - - - > Prof., Capt., Co., Inc., Ave. and Rd. It
* - - - - - - > will also change PHD to Ph.D.
* - - - - - - > NOTE: Adding period can LENGTHEN your variable,
* - - - - - - > so you might want to put some checks into
* - - - - - - > your code so that you don't lose the latter
* - - - - - - > part of the passed item to be properized.
* - - - - - - > When glUlperiod is FALSE, this routine will
* - - - - - - > NOT add any periods to these abbreviations
IF TYPE('glUlperiod') = 'U'
prd_stat = 'U'
glUlperiod = .F.
ELSE
prd_stat = ''
ENDIF
* - - - - - - > return null if ALLTRIM of name is empty
IF EMPTY(ALLTRIM(thename))
RELEASE moldname
RETURN ''
ENDIF
* - - - - - - > return a single capital if ALLTRIM of
* - - - - - - > name is only 1 character long
IF LEN(ALLTRIM(thename)) = 1
RELEASE moldname
RETURN UPPER(ALLTRIM(thename))
ENDIF
* - - - - - - > get the setting of SET EXACT
exact_stat = SET('EXACT')
SET EXACT ON
* - - - - - - > count the number of 'words' in the name
k = WORDS(thename)
* - - - - - - > process each 'word' in the name
* - - - - - - > main work is done by the CAPNAME function
IF k > 1
newname = ''
FOR i = 1 TO k
moldname = WORDNUM(thename,i)
* - - - - - - > return a single capital if the length
* - - - - - - > of the 'word' moldname is 1
IF LEN(moldname) = 1
IF i = 1
newname = UPPER(moldname)
ELSE
newname = newname+' '+UPPER(moldname)
ENDIF
LOOP
ENDIF
* - - - - - - > If the word is ALL caps, 'properize'
* - - - - - - > it. Otherwise, leave capitalization
* - - - - - - > as is, because some names have mixed
* - - - - - - > case, such as LeFevre or DiSantis
IF ISUPPER(moldname)
moldname = PROPER(moldname)
ELSE
* - - - - - - > guard against a common typing error,
* - - - - - - > entering JOnes instead of Jones
IF LEN(moldname) > 1 AND ISUPPER(SUBSTR(moldname,2,1))
moldname = PROPER(moldname)
ENDIF
ENDIF
* - - - - - - > do not capitalize common articles and
* - - - - - - > prepositions unless it's the 1st word
IF i <> 1 AND fixshop && for tradenames
lowname = LOWER(moldname)
IF lowname=='a' OR lowname=='an' OR ;
lowname=='and' OR lowname=='the' OR ;
lowname=='of' OR lowname=='in' OR ;
lowname=='by' OR lowname=='for' OR ;
lowname=='nor'
newname = newname+' '+LOWER(moldname)
LOOP
ELSE
newname = newname+' '+CAPNAME(moldname)
ENDIF
ELSE
* - - - - - - > otherwise call the CAPNAME function
newname = CAPNAME(moldname)
ENDIF
ENDFOR
newname = ALLTRIM(newname)
ELSE
* - - - - - - - - - - - - - - - - - - * changed 03/06/92
* - - - - - - > Call the CAPNAME function if the name
* - - - - - - > contains only one word.
* - - - - - - > If the word is ALL caps, 'properize'
* - - - - - - > it. Otherwise, leave capitalization
* - - - - - - > as is, because some names have mixed
* - - - - - - > case, such as LeFevre or DiSantis
IF ISUPPER(thename)
thename = PROPER(thename)
ELSE
* - - - - - - > guard against a common typing error,
* - - - - - - > entering JOnes instead of Jones
IF LEN(thename) > 1 AND ISUPPER(SUBSTR(thename,2,1))
thename = PROPER(thename)
ENDIF
ENDIF
* - - - - - - - - - - - - - - - - - - * changed 03/06/92
newname = CAPNAME(thename)
ENDIF
* - - - - - - > restore the setting of EXACT
IF exact_stat = 'ON'
SET EXACT ON
ELSE
SET EXACT OFF
ENDIF
* - - - - - - > release global variables if they had
* - - - - - - > not been used by the user
IF prd_stat = 'U'
RELEASE glUlperiod
ENDIF
* - - - - - - > return the new name
RELEASE moldname
RETURN newname
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
FUNCTION capname
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
PARAMETER pname
PRIVATE pname,rname
* this is the main processing routine for the UL function
* - - - - - - > capitalize the first letter of a word
* - - - - - - > NOTE: if you want to IGNORE any upper case
* - - - - - - > characters in the original name,
* - - - - - - > substitute rname=PROPER(pname)
* - - - - - - > for the one line of code below
rname = UPPER(LEFT(pname,1))+SUBSTR(pname,2)
DO CASE
* - - - - - - > capitalize McXXXXXX names properly
CASE LEFT(rname,2) = 'Mc'
rname = 'Mc' + PROPER(SUBSTR(rname,3))
* - - - - - - > capitalize words starting with 'MAC'
* - - - - - - > IF the word is at least 5 characters long
* - - - - - - > ( won't change Macy, Mack, Macke, etc. )
CASE LEN(rname) >= 5 AND UPPER(LEFT(rname,3)) = 'MAC'
rname = MACNAME(rname)
* - - - - - - > capitalize the letter following certain
* - - - - - - > prefixes only if it was capitalized in
* - - - - - - > the original name
* - - - - - - > this WILL NOT work if the original name
* - - - - - - > was all caps
CASE LEN(rname) >= 4 AND fixname && people's names
DO CASE
CASE UPPER(LEFT(rname,2)) = 'LA'
rname = PARTNAME(rname,'La')
CASE UPPER(LEFT(rname,2)) = 'LE'
rname = PARTNAME(rname,'Le')
CASE UPPER(LEFT(rname,2)) = 'DA'
rname = PARTNAME(rname,'Da')
CASE UPPER(LEFT(rname,2)) = 'DE'
rname = PARTNAME(rname,'De')
CASE UPPER(LEFT(rname,2)) = 'DI'
rname = PARTNAME(rname,'Di')
CASE UPPER(LEFT(rname,2)) = 'DU'
rname = PARTNAME(rname,'Du')
CASE LEN(rname) >= 5 AND ;
UPPER(LEFT(rname,3)) = 'DEL'
rname = PARTNAME(rname,'Del')
CASE LEN(rname) >= 5 AND ;
UPPER(LEFT(rname,3)) = 'VAN'
rname = PARTNAME(rname,'Van')
ENDCASE
CASE LEN(rname) >= 4
DO CASE
CASE LEN(rname) >= 5 AND ;
UPPER(LEFT(rname,3)) = 'SAN'
rname = PARTNAME(rname,'San')
CASE LEN(rname) >= 7 AND ;
UPPER(LEFT(rname,5)) = 'SANTA'
rname = PARTNAME(rname,'Santa')
ENDCASE
ENDCASE
* - - - - - - > capitalize the parts of names which
* - - - - - - > follow the characters / or & or '
IF fixshop && tradenames
rname = CAPAFTER('/',rname)
ENDIF
IF fixshop && tradenames
rname = CAPAFTER('&',rname)
ENDIF
IF fixname OR fixshop OR fixaddr
rname = CAPAFTER("'",rname)
ENDIF
* - - - - - - > capitalize second part of hyphenated names
IF fixname OR fixshop && people's names, tradenames
rname = CAPAFTER('-',rname)
ENDIF
* - - - - - - > capitalize certain suffixes and optionally
* - - - - - - > put periods after the suffixes
rname = SUFFIX(rname)
RETURN (ALLTRIM(rname))
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
FUNCTION suffix
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
PARAMETER pname
* - - - - - - - - - - - - - - - - - - * changed 03/06/92
PRIVATE uname,i,j,x,mixed_name
* - - - - - - - - - - - - - - - - - - * changed 03/06/92
* this function actually capitalizes more than 'suffixes'
* to names - it capitalizes certain 'pieces' of a name or
* address which need to be treated in a special manner
rname = pname
uname = UPPER(pname)
IF fixname
IF uname=='II' OR uname=='III' OR uname=='IV' OR ;
uname=='BD' OR uname=='DB' OR uname=='DD' OR ;
uname=='JD' OR uname=='MD' OR uname=='DO' OR ;
uname=='DVM' OR uname=='VMD' OR ;
uname=='DDS'
rname = UPPER(uname)
ENDIF
ENDIF
IF fixaddr
IF uname=='NE' OR uname=='NW' OR ;
uname=='SE' OR uname=='SW' OR ;
uname=='RR' OR uname=='PO'
rname = uname
ENDIF
ENDIF
* - - - - - - > place periods after commonly
* - - - - - - > abbreviated parts of names or addresses
* - - - - - - > IF the public variable glUlperiod is .T.
IF glUlperiod
IF fixname AND ;
(uname=='JR' OR uname=='SR' OR ;
uname=='MR' OR uname=='MS' OR ;
uname=='DR' OR uname=='MRS' OR ;
uname=='ST' OR uname=='ESQ' OR ;
uname=='PROF' OR uname=='CAPT')
rname = pname+'.'
ENDIF
IF fixshop AND ;
(UPPER(uname)=='CO' OR UPPER(uname)=='INC' OR ;
UPPER(uname)=='LTD')
rname = PROPER(uname)+'.'
ENDIF
IF fixaddr AND ;
(UPPER(uname)=='AVE' OR ;
UPPER(uname)=='RD')
rname = PROPER(uname)+'.'
ENDIF
IF fixname AND UPPER(rname) = 'PHD'
rname = 'Ph.D.'
ENDIF
ENDIF
* - - - - - - > the following code is useful in addresses so
* - - - - - - > 'Suite 123-J' or 'Apt. 3-B' does not become
* - - - - - - > 'Suite 123-j' or 'Apt. 3-b'
* - - - - - - > and expressions such as 1st, 2nd, 3rd, 4th,
* - - - - - - > etc. come our properly
IF fixaddr AND LEN(rname) > 1
mixed_name = .F.
first_etc = .F.
FOR i = 1 TO LEN(rname)
IF ISDIGIT(SUBSTR(rname,i,1))
mixed_name = .T.
EXIT
ENDIF
ENDFOR
IF mixed_name
FOR j = i+1 TO LEN(rname)
IF ISALPHA(SUBSTR(rname,j,1))
x = UPPER(TRIM(SUBSTR(rname,j)))
IF x=='ST' OR x=='ND' OR ;
x=='RD' OR x=='TH'
first_etc = .T.
rname = SUBSTR(rname,1,j)+ ;
LOWER(SUBSTR(rname,j+1))
EXIT
ENDIF
ENDIF
ENDFOR
IF NOT first_etc
rname = UPPER(rname)
ENDIF
ENDIF
ENDIF
RETURN rname
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
FUNCTION partname
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
PARAMETER pname,schar
PRIVATE plen,pname,schar,rname
* capitalizes the names of foreign derivation made up of
* a particle plus a name (such as LeFevre or VanBuren)
* only when the non-first letter of the parameter name
* pname is capitalized (so that lefton does not become
* LeFton but leFevre becomes LeFevre)
plen = LEN(schar)
IF ISUPPER(SUBSTR(pname,plen+1,1))
* - - - - - - - - - - - - - - - - - - * changed 03/06/92
rname = schar + PROPER(SUBSTR(pname,plen+1))
* - - - - - - - - - - - - - - - - - - * changed 03/06/92
ELSE
rname = pname
ENDIF
RETURN rname
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
FUNCTION capafter
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
PARAMETER schar,pname
PRIVATE schar,pname,rname,i,spos,skount
* looks for the occurrence of the 'search' character
* character 'schar' in the word 'pname' and capitalizes
* the character following schar. This is the function
* which converts Jones-smith to Jones-Smith and
* O'brien to O'Brien
rname = pname
skount = OCCURS(schar,pname)
FOR i = 1 TO m.skount
spos = AT(schar,pname,i)
IF spos > 0 AND spos < LEN(pname)
* - - - - - - > make sure we get Joe's, not Joe'S
IF UPPER(TRIM(SUBSTR(pname,spos+1))) <> 'S'
* - - - - - - - - - - - - - - - - - - * changed 03/06/92
rname = LEFT(pname,spos) + ;
UPPER(SUBSTR(pname,spos+1,1))
IF LEN(pname) > spos+1
rname = rname + SUBSTR(pname,spos+2)
ENDIF
* - - - - - - - - - - - - - - - - - - * changed 03/06/92
ENDIF
ENDIF
ENDFOR
RETURN rname
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
FUNCTION macname
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
PARAMETER pname
PRIVATE pname, plen, test, scotch, x
* Users who are curious or who have an inordinant number
* of 'Scotch' or 'Irish' names in their data bases may want
* to add to the specifically coded name fragments herein.
* The author is a mathematician, not a linguist, and does
* not profess to be an authority on surnames of the British Isles
scotch = .F.
plen = LEN(pname)
IF plen >= 8 AND LEFT(pname,7) = 'MACADAM'
scotch = .T.
ENDIF
IF plen >= 7
test = UPPER(LEFT(pname,7))
scotch = INLIST(test,'MACCAFF','MACCARL','MACCLOS', ;
'MACCONN','MACCRAC','MACCULL','MACHENR', ;
'MACLANE','MACLEAN','MACLEOD','MACLAUG')
ENDIF
IF plen >= 6 AND NOT scotch
test = UPPER(LEFT(pname,6))
scotch = INLIST(test,'MACART','MACAFF','MACINT', ;
'MACIVE','MACKAY','MACKEN','MACRAE','MACWIL')
ENDIF
IF plen >= 5 AND NOT scotch
test = UPPER(LEFT(pname,4))
scotch = INLIST(test,'MACB','MACD','MACF','MACG', ;
'MACM','MACN','MACP','MACT','MACV')
ENDIF
IF scotch
x = PROPER(LEFT(pname,3))+PROPER(SUBSTR(pname,4))
ELSE
x = pname
ENDIF
RETURN x
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
FUNCTION isupper
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
PARAMETER pname
PRIVATE pname
RETURN IIF(pname = UPPER(pname),.T.,.F.)
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
FUNCTION words
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
PARAMETERS pname,spacer
PRIVATE pname,spacer
* determines the number of words in pname
DO CASE
CASE PARAMETERS() = 0
RETURN ''
CASE PARAMETERS() = 1
spacer = '.,'
ENDCASE
pname = CHRTRAN(pname,spacer,SPACE(LEN(spacer)))
pname = ALLTRIM(pname)
DO WHILE AT(' ',pname) > 0
pname = STRTRAN(pname,' ',' ')
ENDDO
RETURN (OCCURS(' ',pname)+1)
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
FUNCTION wordnum
* - - - - - - - - - - - - - - - - - - - - - - - - - - - *
PARAMETERS pname,n
PRIVATE pname,mname,rname,n,spacer,spos
* determines the nth word of the character string pname
spacer = '.,'
mname = ALLTRIM(CHRTRAN(pname,spacer,' '))
* - - - - - - > 'squeeze' the name so that only ONE blank
* - - - - - - > appears between the 'words' of a name
DO WHILE AT(' ',mname) > 0
mname = STRTRAN(mname,' ',' ')
ENDDO
DO CASE
CASE n > 1
DO CASE
CASE AT(' ',mname,n-1) = 0
rname = ''
CASE AT(' ',mname,n) = 0
rname = SUBSTR(mname,AT(' ',mname,n-1)+1)
OTHERWISE
spos = AT(' ',mname,n-1)
rname = SUBSTR(mname,spos,AT(' ',mname,n)+1-spos)
ENDCASE
CASE n = 1
IF AT(' ',mname) > 0
rname = SUBSTR(mname,1,AT(' ',mname)-1)
ELSE
rname = mname
ENDIF
ENDCASE
rname = ALLTRIM(rname)
IF glUlperiod
IF LEN(rname) = 1 AND ISALPHA(rname)
rname = rname+'.'
ENDIF
ENDIF
RETURN rname
On Wed, Mar 14, 2012 at 1:27 PM, Jeff Johnson <[email protected]> wrote:
> Anyone ever do a Proper() that capitalizes names like McDonald?
>
> --
> Jeff
_______________________________________________
Post Messages to: [email protected]
Subscription Maintenance: http://leafe.com/mailman/listinfo/profox
OT-free version of this list: http://leafe.com/mailman/listinfo/profoxtech
Searchable Archive: http://leafe.com/archives/search/profox
This message:
http://leafe.com/archives/byMID/profox/CAPqLOBxLUSCVUKVA3WMoiR7EWqP1iaHHfX5cQ6BsiypQ6F3j=g...@mail.gmail.com
** All postings, unless explicitly stated otherwise, are the opinions of the
author, and do not constitute legal or medical advice. This statement is added
to the messages for those lawyers who are too stupid to see the obvious.
