Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XLFNAME7

XLFNAME7.m

Go to the documentation of this file.
  1. XLFNAME7 ;BPOIFO/KEITH - NAME STANDARDIZATION ; 27 Jan 2002 11:05 PM
  1. ;;8.0;KERNEL;**343**; Jul 10, 1995;
  1. ;
  1. FORMAT(XUNAME,XUMINL,XUMAXL,XUNOP,XUCOMA,XUAUDIT,XUFAM,XUDNC) ;Format name value
  1. ;Input: XUNAME=text value representing person name to transform
  1. ; XUMINL=minimum length (optional), default 3
  1. ; XUMAXL=maximum length (optional), default 30
  1. ; XUNOP=1 to standardize last name for 'NOP' x-ref
  1. ; (for the PAITNE file). (optional)
  1. ; XUCOMA=0 to not require a comma
  1. ; 1 to require a comma in the input value
  1. ; 2 to add a comma if none
  1. ; 3 to prohibit (remove) commas
  1. ; (optional) default if not specified is 1
  1. ;
  1. ; XUAUDIT=variable to return audit, pass by reference (optional),
  1. ; returned values:
  1. ; XUAUDIT=0 if no change was made
  1. ; 1 if name is changed
  1. ; 2 if name could not be converted
  1. ; XUAUDIT(1) defined if name contains no comma
  1. ; XUAUDIT(2) defined if parenthetical text is removed
  1. ; XUAUDIT(3) defined if value is unconvertible
  1. ; XUAUDIT(4) defined if characters are removed or changed
  1. ; XUFAM='1' if just the family name, '0' otherwise (optional)
  1. ; XUDNC='1' to prevent componentization (optional)
  1. ; ='2' to return components before standardize
  1. ;
  1. ;Output: XUNAME in specified format or null if length of transformed value is less than XUMINL
  1. ;
  1. N XUX,XUOX,XUOLDN,XUAX,XUI,XUNEWN
  1. ;Initialize variables
  1. K XUAUDIT
  1. S XUOLDN=XUNAME M XUX=XUNAME
  1. S XUDNC=$G(XUDNC) D COMP^XLFNAME8(.XUX,.XUDNC)
  1. S XUMINL=+$G(XUMINL) S:XUMINL<1 XUMINL=3
  1. S XUMAXL=+$G(XUMAXL) S:XUMAXL<XUMINL XUMAXL=30
  1. S XUNOP=$S($G(XUNOP)=1:"S",1:"")
  1. S:'$L($G(XUCOMA)) XUCOMA=1 S XUCOMA=+XUCOMA
  1. S XUFAM=$S($G(XUFAM)=1:"F",1:"")
  1. ;
  1. ;Check for comma
  1. I XUX'["," S XUAUDIT(1)=""
  1. I XUCOMA=1,XUX'["," S XUAUDIT=2,XUAUDIT(3)="" Q ""
  1. ;Clean input value
  1. F Q:'$$F1^XLFNAME8(.XUX,XUCOMA)
  1. I XUX'=XUOLDN S XUAUDIT(4)=""
  1. ;Add comma if necessary
  1. I XUCOMA=2,XUX'[" ",XUX'["," S XUX=XUX_","
  1. I XUX=XUOLDN K XUAUDIT(4)
  1. ;Quit if result is too short
  1. I $L(XUX)<XUMINL S XUAUDIT=2,XUAUDIT(3)="" K XUNAME Q ""
  1. S XUNAME=XUX I XUDNC'=1 D
  1. .;Parse the name
  1. .D STDNAME^XLFNAME(.XUX,XUFAM_"CP",.XUAX)
  1. .I $D(XUAX("STRIP")) S XUAUDIT(2)=""
  1. .I $D(XUAX("NM"))!$D(XUAX("PERIOD")) S XUAUDIT(4)=""
  1. .I $D(XUAX("PUNC"))!($D(XUAX("SPACE"))&'$L(XUFAM)) S XUAUDIT(4)=""
  1. .I $D(XUAX("SPACE")),$L(XUFAM),XUNAME'=$G(XUX("FAMILY")) S XUAUDIT(4)=""
  1. .;Standardize the suffix
  1. .S XUX("SUFFIX")=$$CLEANC^XLFNAME(XUX("SUFFIX"))
  1. .;Post-clean components
  1. .S XUI="" F S XUI=$O(XUX(XUI)) Q:XUI="" S XUX(XUI)=$$POSTC(XUX(XUI))
  1. .;Reconstruct name from components
  1. .S XUNAME=$$NAMEFMT^XLFNAME(.XUX,"F","CL"_XUMAXL_XUNOP)
  1. .;Adjust name for 'do not componentize'
  1. .;I XUDNC S XUNAME=XUX("FAMILY")
  1. ;Return comma for single value names
  1. I XUCOMA,XUCOMA'=3,XUNAME'["," S XUNAME=XUNAME_","
  1. ;Check length again
  1. I $L(XUNAME)<XUMINL S XUAUDIT=2,XUAUDIT(3)="" K XUNAME Q ""
  1. ;Enforce minimum 2 character last name rule
  1. ;I '$L(XUFAM),$L($P(XUNAME,","))<3,$P(XUNAME,",")'?2U D Q ""
  1. ;.S XUAUDIT=2,XUAUDIT(3)="" K XUNAME
  1. ;.Q
  1. ;Remove hyphens and apostrophes for 'NOP' x-ref
  1. S XUX=XUNAME I XUNOP="S" S XUNAME=$TR(XUNAME,"'-")
  1. I XUNAME'=XUX S XUAUDIT(4)=""
  1. I XUNAME=XUOLDN K XUAUDIT
  1. S XUAUDIT=XUNAME'=XUOLDN I XUAUDIT,$D(XUAUDIT)<10 S XUAUDIT(4)=""
  1. S XUNEWN=XUNAME M XUNAME=XUX S XUNAME=XUNEWN
  1. ;Return components before standardization if asked to
  1. I XUDNC=2 D
  1. . N XUNAMEC
  1. . S XUNAMEC=XUNAME
  1. . I XUOLDN["`" S XUOLDN=$TR(XUOLDN,"`","'")
  1. . D STDNAME^XLFNAME(.XUOLDN,"C")
  1. . M XUNAME=XUOLDN
  1. . S XUNAME=XUNAMEC
  1. Q XUNAME
  1. ;
  1. POSTC(XUX) ;Post-clean components
  1. ;Remove parenthesis if not removed by Kernel
  1. N XUI,XUXOLD
  1. S XUXOLD=XUX,XUX=$TR(XUX,"()[]{}")
  1. ;Check for numbers left behind by Kernel
  1. F XUI=0:1:9 S XUX=$TR(XUX,XUI)
  1. I XUX'=XUXOLD S XUAUDIT(4)=""
  1. Q XUX
  1. ;
  1. NOP(XUX) ;Produce 'NOP' x-ref value
  1. ;Input: XUX=name value to evaluate
  1. ;Output : Standardized name or null if the same as input value
  1. N XUNEWX
  1. S XUNEWX=$$FORMAT(XUX,3,30,1)
  1. Q $S(XUX=XUNEWX:"",1:XUNEWX)
  1. ;
  1. NARY(XU20NAME) ;Set up name array
  1. ;Input: XU20NAME=full name value
  1. ; XU20NAME(component_names)=corresponding value--if undefined,
  1. ; these will get set up
  1. ;
  1. N XUX M XUX=XU20NAME
  1. D STDNAME^XLFNAME(.XU20NAME,"FC")
  1. M XU20NAME=XUX
  1. S XU20NAME("NOTES")=$$NOTES^XLFNAME8()
  1. Q
  1. ;