XLFNAME6.m

XLFNAME6 ;CIOFO-SF/TKW,MKO-Utilities for person name fields ;11:41 AM  14 Mar 2000

 ;;8.0;KERNEL;**134**;Jul 10, 1995

 ;

FMNAME(XUNAME,XUFLAG,XUDLM) ; Convert HL7 format name to regular name

 ; XUNAME   - HL7 string to be converted

 ; XUDLM  - Delimiter (defaults to "^")

 ; XUFLAG   [ C  : Returns name components

 ;            L# : Truncate to length of #

 ;            M  : Mixed case

 ;            S  : Standardize name

F N I,N,S,XUF

 Q:$G(XUNAME)="" ""

 S:$G(XUDLM)="" XUDLM="^"

 S XUFLAG=$G(XUFLAG)

 I XUFLAG'["C" N X S X=XUNAME N XUNAME S XUNAME=X

 ;

 S I=0 F S="FAMILY","GIVEN","MIDDLE","SUFFIX" S I=I+1 D

 . S XUNAME(S)="",N=$P(XUNAME,XUDLM,I) Q:N=""""""

 . S XUNAME(S)=N Q

 ;

 S XUF="C"_$E("M",XUFLAG["M")_$E("S",XUFLAG["S")

 S:XUFLAG["L" XUF=XUF_"L"_+$P(XUFLAG,"L",2)

 Q $$NAMEFMT^XLFNAME(.XUNAME,"F",XUF)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XLFNAME6   840     printed  Apr 09, 2024@21:11:56                                                                                                                                                                                                     Page 2

XLFNAME6  ;CIOFO-SF/TKW,MKO-Utilities for person name fields ;11:41 AM  14 Mar 2000

 +1       ;;8.0;KERNEL;**134**;Jul 10, 1995

 +2       ;

FMNAME(XUNAME,XUFLAG,XUDLM) ; Convert HL7 format name to regular name

 +1       ; XUNAME   - HL7 string to be converted

 +2       ; XUDLM  - Delimiter (defaults to "^")

 +3       ; XUFLAG   [ C  : Returns name components

 +4       ;            L# : Truncate to length of #

 +5       ;            M  : Mixed case

 +6       ;            S  : Standardize name

F          NEW I,N,S,XUF

 +1        if $GET(XUNAME)=""

               QUIT ""

 +2        if $GET(XUDLM)=""

               SET XUDLM="^"

 +3        SET XUFLAG=$GET(XUFLAG)

 +4        IF XUFLAG'["C"

               NEW X

               SET X=XUNAME

               NEW XUNAME

               SET XUNAME=X

 +5       ;

 +6        SET I=0

           FOR S="FAMILY","GIVEN","MIDDLE","SUFFIX"

               SET I=I+1

               Begin DoDot:1

 +7                SET XUNAME(S)=""

                   SET N=$PIECE(XUNAME,XUDLM,I)

                   if N=""""""

                       QUIT 

 +8                SET XUNAME(S)=N

                   QUIT 

               End DoDot:1

 +9       ;

 +10       SET XUF="C"_$EXTRACT("M",XUFLAG["M")_$EXTRACT("S",XUFLAG["S")

 +11       if XUFLAG["L"

               SET XUF=XUF_"L"_+$PIECE(XUFLAG,"L",2)

 +12       QUIT $$NAMEFMT^XLFNAME(.XUNAME,"F",XUF)