| [613] | 1 | XLFNAME7 ;BPOIFO/KEITH - NAME STANDARDIZATION ; 27 Jan 2002 11:05 PM
|
|---|
| 2 | ;;8.0;KERNEL;**343**; Jul 10, 1995;
|
|---|
| 3 | ;
|
|---|
| 4 | FORMAT(XUNAME,XUMINL,XUMAXL,XUNOP,XUCOMA,XUAUDIT,XUFAM,XUDNC) ;Format name value
|
|---|
| 5 | ;Input: XUNAME=text value representing person name to transform
|
|---|
| 6 | ; XUMINL=minimum length (optional), default 3
|
|---|
| 7 | ; XUMAXL=maximum length (optional), default 30
|
|---|
| 8 | ; XUNOP=1 to standardize last name for 'NOP' x-ref
|
|---|
| 9 | ; (for the PAITNE file). (optional)
|
|---|
| 10 | ; XUCOMA=0 to not require a comma
|
|---|
| 11 | ; 1 to require a comma in the input value
|
|---|
| 12 | ; 2 to add a comma if none
|
|---|
| 13 | ; 3 to prohibit (remove) commas
|
|---|
| 14 | ; (optional) default if not specified is 1
|
|---|
| 15 | ;
|
|---|
| 16 | ; XUAUDIT=variable to return audit, pass by reference (optional),
|
|---|
| 17 | ; returned values:
|
|---|
| 18 | ; XUAUDIT=0 if no change was made
|
|---|
| 19 | ; 1 if name is changed
|
|---|
| 20 | ; 2 if name could not be converted
|
|---|
| 21 | ; XUAUDIT(1) defined if name contains no comma
|
|---|
| 22 | ; XUAUDIT(2) defined if parenthetical text is removed
|
|---|
| 23 | ; XUAUDIT(3) defined if value is unconvertible
|
|---|
| 24 | ; XUAUDIT(4) defined if characters are removed or changed
|
|---|
| 25 | ; XUFAM='1' if just the family name, '0' otherwise (optional)
|
|---|
| 26 | ; XUDNC='1' to prevent componentization (optional)
|
|---|
| 27 | ; ='2' to return components before standardize
|
|---|
| 28 | ;
|
|---|
| 29 | ;Output: XUNAME in specified format or null if length of transformed value is less than XUMINL
|
|---|
| 30 | ;
|
|---|
| 31 | N XUX,XUOX,XUOLDN,XUAX,XUI,XUNEWN
|
|---|
| 32 | ;Initialize variables
|
|---|
| 33 | K XUAUDIT
|
|---|
| 34 | S XUOLDN=XUNAME M XUX=XUNAME
|
|---|
| 35 | S XUDNC=$G(XUDNC) D COMP^XLFNAME8(.XUX,.XUDNC)
|
|---|
| 36 | S XUMINL=+$G(XUMINL) S:XUMINL<1 XUMINL=3
|
|---|
| 37 | S XUMAXL=+$G(XUMAXL) S:XUMAXL<XUMINL XUMAXL=30
|
|---|
| 38 | S XUNOP=$S($G(XUNOP)=1:"S",1:"")
|
|---|
| 39 | S:'$L($G(XUCOMA)) XUCOMA=1 S XUCOMA=+XUCOMA
|
|---|
| 40 | S XUFAM=$S($G(XUFAM)=1:"F",1:"")
|
|---|
| 41 | ;
|
|---|
| 42 | ;Check for comma
|
|---|
| 43 | I XUX'["," S XUAUDIT(1)=""
|
|---|
| 44 | I XUCOMA=1,XUX'["," S XUAUDIT=2,XUAUDIT(3)="" Q ""
|
|---|
| 45 | ;Clean input value
|
|---|
| 46 | F Q:'$$F1^XLFNAME8(.XUX,XUCOMA)
|
|---|
| 47 | I XUX'=XUOLDN S XUAUDIT(4)=""
|
|---|
| 48 | ;Add comma if necessary
|
|---|
| 49 | I XUCOMA=2,XUX'[" ",XUX'["," S XUX=XUX_","
|
|---|
| 50 | I XUX=XUOLDN K XUAUDIT(4)
|
|---|
| 51 | ;Quit if result is too short
|
|---|
| 52 | I $L(XUX)<XUMINL S XUAUDIT=2,XUAUDIT(3)="" K XUNAME Q ""
|
|---|
| 53 | S XUNAME=XUX I XUDNC'=1 D
|
|---|
| 54 | .;Parse the name
|
|---|
| 55 | .D STDNAME^XLFNAME(.XUX,XUFAM_"CP",.XUAX)
|
|---|
| 56 | .I $D(XUAX("STRIP")) S XUAUDIT(2)=""
|
|---|
| 57 | .I $D(XUAX("NM"))!$D(XUAX("PERIOD")) S XUAUDIT(4)=""
|
|---|
| 58 | .I $D(XUAX("PUNC"))!($D(XUAX("SPACE"))&'$L(XUFAM)) S XUAUDIT(4)=""
|
|---|
| 59 | .I $D(XUAX("SPACE")),$L(XUFAM),XUNAME'=$G(XUX("FAMILY")) S XUAUDIT(4)=""
|
|---|
| 60 | .;Standardize the suffix
|
|---|
| 61 | .S XUX("SUFFIX")=$$CLEANC^XLFNAME(XUX("SUFFIX"))
|
|---|
| 62 | .;Post-clean components
|
|---|
| 63 | .S XUI="" F S XUI=$O(XUX(XUI)) Q:XUI="" S XUX(XUI)=$$POSTC(XUX(XUI))
|
|---|
| 64 | .;Reconstruct name from components
|
|---|
| 65 | .S XUNAME=$$NAMEFMT^XLFNAME(.XUX,"F","CL"_XUMAXL_XUNOP)
|
|---|
| 66 | .;Adjust name for 'do not componentize'
|
|---|
| 67 | .;I XUDNC S XUNAME=XUX("FAMILY")
|
|---|
| 68 | ;Return comma for single value names
|
|---|
| 69 | I XUCOMA,XUCOMA'=3,XUNAME'["," S XUNAME=XUNAME_","
|
|---|
| 70 | ;Check length again
|
|---|
| 71 | I $L(XUNAME)<XUMINL S XUAUDIT=2,XUAUDIT(3)="" K XUNAME Q ""
|
|---|
| 72 | ;Enforce minimum 2 character last name rule
|
|---|
| 73 | ;I '$L(XUFAM),$L($P(XUNAME,","))<3,$P(XUNAME,",")'?2U D Q ""
|
|---|
| 74 | ;.S XUAUDIT=2,XUAUDIT(3)="" K XUNAME
|
|---|
| 75 | ;.Q
|
|---|
| 76 | ;Remove hyphens and apostrophes for 'NOP' x-ref
|
|---|
| 77 | S XUX=XUNAME I XUNOP="S" S XUNAME=$TR(XUNAME,"'-")
|
|---|
| 78 | I XUNAME'=XUX S XUAUDIT(4)=""
|
|---|
| 79 | I XUNAME=XUOLDN K XUAUDIT
|
|---|
| 80 | S XUAUDIT=XUNAME'=XUOLDN I XUAUDIT,$D(XUAUDIT)<10 S XUAUDIT(4)=""
|
|---|
| 81 | S XUNEWN=XUNAME M XUNAME=XUX S XUNAME=XUNEWN
|
|---|
| 82 | ;Return components before standardization if asked to
|
|---|
| 83 | I XUDNC=2 D
|
|---|
| 84 | . N XUNAMEC
|
|---|
| 85 | . S XUNAMEC=XUNAME
|
|---|
| 86 | . I XUOLDN["`" S XUOLDN=$TR(XUOLDN,"`","'")
|
|---|
| 87 | . D STDNAME^XLFNAME(.XUOLDN,"C")
|
|---|
| 88 | . M XUNAME=XUOLDN
|
|---|
| 89 | . S XUNAME=XUNAMEC
|
|---|
| 90 | Q XUNAME
|
|---|
| 91 | ;
|
|---|
| 92 | POSTC(XUX) ;Post-clean components
|
|---|
| 93 | ;Remove parenthesis if not removed by Kernel
|
|---|
| 94 | N XUI,XUXOLD
|
|---|
| 95 | S XUXOLD=XUX,XUX=$TR(XUX,"()[]{}")
|
|---|
| 96 | ;Check for numbers left behind by Kernel
|
|---|
| 97 | F XUI=0:1:9 S XUX=$TR(XUX,XUI)
|
|---|
| 98 | I XUX'=XUXOLD S XUAUDIT(4)=""
|
|---|
| 99 | Q XUX
|
|---|
| 100 | ;
|
|---|
| 101 | NOP(XUX) ;Produce 'NOP' x-ref value
|
|---|
| 102 | ;Input: XUX=name value to evaluate
|
|---|
| 103 | ;Output : Standardized name or null if the same as input value
|
|---|
| 104 | N XUNEWX
|
|---|
| 105 | S XUNEWX=$$FORMAT(XUX,3,30,1)
|
|---|
| 106 | Q $S(XUX=XUNEWX:"",1:XUNEWX)
|
|---|
| 107 | ;
|
|---|
| 108 | NARY(XU20NAME) ;Set up name array
|
|---|
| 109 | ;Input: XU20NAME=full name value
|
|---|
| 110 | ; XU20NAME(component_names)=corresponding value--if undefined,
|
|---|
| 111 | ; these will get set up
|
|---|
| 112 | ;
|
|---|
| 113 | N XUX M XUX=XU20NAME
|
|---|
| 114 | D STDNAME^XLFNAME(.XU20NAME,"FC")
|
|---|
| 115 | M XU20NAME=XUX
|
|---|
| 116 | S XU20NAME("NOTES")=$$NOTES^XLFNAME8()
|
|---|
| 117 | Q
|
|---|
| 118 | ;
|
|---|
