XLFNAME4 ;CIOFO-SF/MKO-PRINT INFORMATION IN ^XTMP ;11:35 AM  23 Mar 2000
 ;;8.0;KERNEL;**134**;Jul 10, 1995
 ;
PRINT N XUCD,XUCDX,XUFD,XUFDTXT,XUFL,XUHLIN,XUPG,XUREC
 N DIROUT,DIRUT,DTOUT,DUOUT,POP,X,Y
 D INTRO
 ;
 ;Get file number
 ;S XUFL=$$READ("Select a file or subfile number","ALL","HLPFIL") Q:XUFL=""
 S XUFL=200
 ;
 ;Get field number
 ;I XUFL="ALL" S XUFD="ALL"
 ;E  S XUFD=$$READ("Select a field number","ALL","HLPFLD") Q:XUFD=""
 S XUFD=.01
 ;
 ;Get list of codes
 S XUCD=$$READ("Enter a list of codes to print","ALL","HLPCOD","Enter a list of codes separated by commas, 'ALL', or '??' for more help.")
 Q:U[XUCD
 S:XUCD="ALL" XUCD=""
 I XUCD]"" S XUCD=$$UP^XLFSTR($TR(XUCD," "))
 ;
 ;Get list of codes to exclude
 S XUCDX=$$READ("Enter a list of codes to exclude","","HLPCODX","Enter a list of codes separated by commas, or '??' for more help.")
 Q:XUCDX=U
 I XUCDX]"" S XUCDX=$$UP^XLFSTR($TR(XUCDX," "))
 ;
 ;Prompt for device
 S %ZIS="Q" W ! D ^%ZIS Q:$G(POP)
 I $D(IO("Q")),$D(^%ZTSK) D QUEUE G END
 U IO
 ;
MAIN ;TaskMan entry point
 D INIT,HDR,CODTAB
 ;
 I XUFL="ALL" D
 . S XUFL=0
 . F  S XUFL=$O(^XTMP("XLFNAME",XUFL)) Q:'XUFL  D PFIL(XUFL,XUCD,XUCDX) Q:$D(DIRUT)
 E  I XUFD="ALL" D
 . D PFIL(XUFL,XUCD,XUCDX)
 E  D PFLD(XUFL,XUFD,XUCD,XUCDX)
 ;
 D END
 Q
 ;
PFIL(XUFL,XUCD,XUCDX) ;Print information for a specific file
 S XUFD=0
 F  S XUFD=$O(^XTMP("XLFNAME",XUFL,XUFD)) Q:'XUFD  D PFLD(XUFL,XUFD,XUCD,XUCDX) Q:$D(DIRUT)
 Q
 ;
PFLD(XUFL,XUFD,XUCD,XUCDX) ;Print info for a specific field
 D HINFO(XUFL,XUFD),EOP Q:$D(DIRUT)  D HDR,SUBHDR
 S XUREC="" F  S XUREC=$O(^XTMP("XLFNAME",XUFL,XUFD,XUREC)) Q:XUREC=""  D PREC(XUFL,XUFD,XUREC,XUCD,XUCDX) Q:$D(DIRUT)
 Q
 ;
PREC(XUFL,XUFD,XUREC,XUCD,XUCDX) ;Print info for a specific record
 N C,I,XUOLD,XUNEW,XUCOD,XULN,XUMAT,XUMATX,XUNC
 ;
 ;Get old and new name, and Name Components ien
 S XULN=^XTMP("XLFNAME",XUFL,XUFD,XUREC)
 S XUOLD=$P(XULN,U),XUNEW=$P(XULN,U,2)
 ;
 ;Get note codes
 S XUCOD="" S XUMAT=$G(XUCD)="",(XUMATX,XUNC)=0
 S I=0 F  S I=$O(^XTMP("XLFNAME",XUFL,XUFD,XUREC,I)) Q:I=""  D  Q:XUMATX
 . I I="MIDDLE"!(I="SUFFIX") S XUNC=1
 . S C=$E(I,1,"NPS"[$E(I)+1)
 . I 'XUMAT,","_XUCD_","[(","_C_",") S XUMAT=1
 . I $G(XUCDX)]"",'XUMATX,","_XUCDX_","[(","_C_",") S XUMATX=1
 . S XUCOD=XUCOD_C_","
 Q:'XUMAT!XUMATX
 S:XUCOD?.E1"," XUCOD=$E(XUCOD,1,$L(XUCOD)-1)
 ;
 D W(XUREC) Q:$D(DIRUT)  W ?15,"Old: "_XUOLD,?60,XUCOD
 D W("New: "_XUNEW,15) Q:$D(DIRUT)
 I XUNC D
 . D W(" Given: "_$P(XULN,U,3),22)
 . D W("Middle: "_$P(XULN,U,4),22)
 . D W("Family: "_$P(XULN,U,5),22)
 . D W("Suffix: "_$P(XULN,U,6),22)
 D W() Q:$D(DIRUT)
 Q
 ;
W(XUSTR,XUCOL,XUFLG) ;Write line feed and string XUSTR in column XUCOL
 I $Y+3'<IOSL D EOP Q:$D(DIRUT)  D HDR D:'$G(XUFLG) SUBHDR
 W !?+$G(XUCOL),$G(XUSTR)
 Q
 ;
EOP ;EOP
 I $E(IOST,1,2)="C-",'$D(ZTQUEUED) D
 . N DIR,X,Y
 . S DIR(0)="E" W ! D ^DIR
 E  I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DIRUT)=1
 W @IOF
 Q
 ;
HDR ;Print header
 S XUPG=$G(XUPG)+1,$X=0
 W "^XTMP(""XLFNAME"") LISTING",?(IOM-$L(XUHLIN)-$L(XUPG)-1),XUHLIN_XUPG
 W !,$TR($J("",IOM-1)," ","-")
 Q
 ;
SUBHDR ;Print subheader
 W !,"File: #"_XUFL,", Field: "_XUFDTXT
 W:XUCD]"" !,"Entries that contain any of the following codes: ",XUCD
 W:XUCDX]"" !,"Excluding entries that contain any of the following codes: ",XUCDX
 W !!,"Record",?15,"Name",?60,"Codes"
 W !,"------",?15,$TR($J("",40)," ","-"),?60,"-----"
 Q
 ;
HINFO(XUFL,XUFD) ;Get XUFDTXT for subheader
 N XULAB
 D FIELD^DID(XUFL,XUFD,"","LABEL","XULAB")
 S XUFDTXT=XULAB("LABEL")_" (#"_XUFD_")"
 Q
 ;
READ(PROMPT,DEF,XHELP,HELP) ;Read X, default is ALL
 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
 S DIR(0)="FO^1:30"
 S:$G(PROMPT)]"" DIR("A")=PROMPT
 S DIR("?")=$S($G(HELP)]"":HELP,1:"Enter a number or the word 'ALL'. Enter '??' for more help.")
 S:$G(XHELP)]"" DIR("??")="^D "_XHELP_"^XLFNAME4"
 S:$G(DEF)]"" DIR("B")=DEF
 D ^DIR Q:$D(DUOUT)!$D(DTOUT) U
 Q Y
 ;
HLPFIL ;Execute help for file prompt
 N I
 W !,"Enter 'ALL' to select all files, or select one of the following:",!
 S I=0 F  S I=$O(^XTMP("XLFNAME",I)) Q:'I  W:$X>70 ! W I_"  "_$J("",10-$L(I))
 Q
 ;
HLPFLD ;Execute help for field prompt
 N I
 W !,"Enter 'ALL' to select all fields, or select one of the following:",!
 S I=0 F  S I=$O(^XTMP("XLFNAME",XUFL,I)) Q:'I  W:$X>70 ! W I_"  "_$J("",10-$L(I))
 Q
 ;
HLPCOD ;Executable help for codes prompt
 N I,T
 F I=1:1 S T=$P($T(CODTAB+I),";;",2,999) Q:T="$$END"  W !,T
 W !!,"To include entries with specific codes, enter those codes separated by commas,"
 W !,"or enter 'ALL' to select entries with any code,"
 Q
 ;
HLPCODX ;Executable help for codes prompt
 N I,T
 F I=1:1 S T=$P($T(CODTAB+I),";;",2,999) Q:T="$$END"  W !,T
 W !!,"To exclude entries with specific codes, enter those codes separated by commas,"
 W !,"or press <RET> to exclude no entries."
 W !!,"This list overrides the list of codes to include."
 Q
 ;
QUEUE ;Queue the report
 N I,ZTSK
 ;
 S ZTRTN="MAIN^XLFNAME4"
 S ZTDESC="Report of ^XTMP(""XLFNAME"")"
 F I="XUFL","XUFD","XUCD","XUCDX" S ZTSAVE(I)=""
 D ^%ZTLOAD
 ;
 I $D(ZTSK)#2 W !,"Report queued!",!,"Task number: "_$G(ZTSK),!
 E  W !,"Report canceled!",!
 ;
 D HOME^%ZIS
 Q
 ;
INIT ;Set XUHLIN to Date/time/page for header
 N %,%H,X,Y
 S %H=$H D YX^%DTC
 S XUHLIN=$P(Y,"@")_"  "_$P($P(Y,"@",2),":",1,2)_"    PAGE "
 W:$E(IOST,1,2)="C-" @IOF
 Q
 ;
END ;Finish up
 I $D(ZTQUEUED) S ZTREQ="@"
 E  D ^%ZISC
 Q
 ;
INTRO ;Introductory text
 ;;This entry point prints a report of the information stored in
 ;;^XTMP("XLFNAME").
 ;;
 ;;The New Person Name Standardization conversion is run automatically during
 ;;the installation of patch XU*8.0*134, as part of the POST-INSTALL ROUTINE
 ;;(POST^XLFNAME). The conversion records in ^XTMP("XLFNAME") information
 ;;about each Name that had to be changed to convert it to standard form, or
 ;;for which assumptions had to be made in breaking the Name into its
 ;;component parts for storage in the new NAME COMPONENTS file (#20).
 ;;
 ;;You can use this report to determine whether any names were standardized
 ;;or parsed incorrectly. To correct a name or its component parts, go to the
 ;;"Systems Manager Menu" [EVE], select "User Management" [XUSER], and then
 ;;"Edit an Existing User" [XUSEREDIT]. From there you can edit the NAME
 ;;field (#.01) of the NEW PERSON file (#200), as well as the component parts
 ;;of the Name as they are stored in the NAME COMPONENTS file (#20).
 ;;
 ;;$$END
 N I,T
 F I=1:1 S T=$P($T(INTRO+I),";;",2,999) Q:T="$$END"  W !,T
 Q
 ;
CODTAB ;Code Table
 ;;Explanation of Codes:
 ;;--------------------
 ;;  D  : The standard name is different from the original name.
 ;;  F  : The Family Name starts with ST<period>. The period and
 ;;         following space, if any, were removed.
 ;;  G  : There is no Given Name.
 ;;  M  : Assumption: There is more than one Given and only one Middle Name.
 ;;  NM : NMI or NMN was used as the Middle Name.
 ;;  NU : A name part contains a number.
 ;;  PE : Periods were removed.
 ;;  PU : Punctuation was removed.
 ;;  SP : Spaces were removed from the Family Name.
 ;;  ST : Text in parentheses was stripped from the name.
 ;;  SU : One or more of the following situations was encountered relating
 ;;       to suffixes:
 ;;       - Suffixes were found immediate to left of the first comma.
 ;;       - I, V, or X was interpreted as a Middle Name.
 ;;       - A name part was interpreted as a Suffix, not a Middle Name.
 ;;       - M.D. or M D was NOT interpreted as a Suffix.
 ;;       - A name part with no vowels was interpreted as a Suffix.
 ;;       - A Suffix was found between commas immediately after the Family Name.
 ;;  T  : The standard name was truncated.
 ;;$$END
 N I,T
 F I=1:1 S T=$P($T(CODTAB+I),";;",2,999) Q:T="$$END"  D W(T,0,1)
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXLFNAME4   7943     printed  Sep 23, 2025@19:39:01                                                                                                                                                                                                    Page 2
XLFNAME4  ;CIOFO-SF/MKO-PRINT INFORMATION IN ^XTMP ;11:35 AM  23 Mar 2000
 +1       ;;8.0;KERNEL;**134**;Jul 10, 1995
 +2       ;
PRINT      NEW XUCD,XUCDX,XUFD,XUFDTXT,XUFL,XUHLIN,XUPG,XUREC
 +1        NEW DIROUT,DIRUT,DTOUT,DUOUT,POP,X,Y
 +2        DO INTRO
 +3       ;
 +4       ;Get file number
 +5       ;S XUFL=$$READ("Select a file or subfile number","ALL","HLPFIL") Q:XUFL=""
 +6        SET XUFL=200
 +7       ;
 +8       ;Get field number
 +9       ;I XUFL="ALL" S XUFD="ALL"
 +10      ;E  S XUFD=$$READ("Select a field number","ALL","HLPFLD") Q:XUFD=""
 +11       SET XUFD=.01
 +12      ;
 +13      ;Get list of codes
 +14       SET XUCD=$$READ("Enter a list of codes to print","ALL","HLPCOD","Enter a list of codes separated by commas, 'ALL', or '??' for more help.")
 +15       if U[XUCD
               QUIT 
 +16       if XUCD="ALL"
               SET XUCD=""
 +17       IF XUCD]""
               SET XUCD=$$UP^XLFSTR($TRANSLATE(XUCD," "))
 +18      ;
 +19      ;Get list of codes to exclude
 +20       SET XUCDX=$$READ("Enter a list of codes to exclude","","HLPCODX","Enter a list of codes separated by commas, or '??' for more help.")
 +21       if XUCDX=U
               QUIT 
 +22       IF XUCDX]""
               SET XUCDX=$$UP^XLFSTR($TRANSLATE(XUCDX," "))
 +23      ;
 +24      ;Prompt for device
 +25       SET %ZIS="Q"
           WRITE !
           DO ^%ZIS
           if $GET(POP)
               QUIT 
 +26       IF $DATA(IO("Q"))
               IF $DATA(^%ZTSK)
                   DO QUEUE
                   GOTO END
 +27       USE IO
 +28      ;
MAIN      ;TaskMan entry point
 +1        DO INIT
           DO HDR
           DO CODTAB
 +2       ;
 +3        IF XUFL="ALL"
               Begin DoDot:1
 +4                SET XUFL=0
 +5                FOR 
                       SET XUFL=$ORDER(^XTMP("XLFNAME",XUFL))
                       if 'XUFL
                           QUIT 
                       DO PFIL(XUFL,XUCD,XUCDX)
                       if $DATA(DIRUT)
                           QUIT 
               End DoDot:1
 +6       IF '$TEST
               IF XUFD="ALL"
                   Begin DoDot:1
 +7                    DO PFIL(XUFL,XUCD,XUCDX)
                   End DoDot:1
 +8       IF '$TEST
               DO PFLD(XUFL,XUFD,XUCD,XUCDX)
 +9       ;
 +10       DO END
 +11       QUIT 
 +12      ;
PFIL(XUFL,XUCD,XUCDX) ;Print information for a specific file
 +1        SET XUFD=0
 +2        FOR 
               SET XUFD=$ORDER(^XTMP("XLFNAME",XUFL,XUFD))
               if 'XUFD
                   QUIT 
               DO PFLD(XUFL,XUFD,XUCD,XUCDX)
               if $DATA(DIRUT)
                   QUIT 
 +3        QUIT 
 +4       ;
PFLD(XUFL,XUFD,XUCD,XUCDX) ;Print info for a specific field
 +1        DO HINFO(XUFL,XUFD)
           DO EOP
           if $DATA(DIRUT)
               QUIT 
           DO HDR
           DO SUBHDR
 +2        SET XUREC=""
           FOR 
               SET XUREC=$ORDER(^XTMP("XLFNAME",XUFL,XUFD,XUREC))
               if XUREC=""
                   QUIT 
               DO PREC(XUFL,XUFD,XUREC,XUCD,XUCDX)
               if $DATA(DIRUT)
                   QUIT 
 +3        QUIT 
 +4       ;
PREC(XUFL,XUFD,XUREC,XUCD,XUCDX) ;Print info for a specific record
 +1        NEW C,I,XUOLD,XUNEW,XUCOD,XULN,XUMAT,XUMATX,XUNC
 +2       ;
 +3       ;Get old and new name, and Name Components ien
 +4        SET XULN=^XTMP("XLFNAME",XUFL,XUFD,XUREC)
 +5        SET XUOLD=$PIECE(XULN,U)
           SET XUNEW=$PIECE(XULN,U,2)
 +6       ;
 +7       ;Get note codes
 +8        SET XUCOD=""
           SET XUMAT=$GET(XUCD)=""
           SET (XUMATX,XUNC)=0
 +9        SET I=0
           FOR 
               SET I=$ORDER(^XTMP("XLFNAME",XUFL,XUFD,XUREC,I))
               if I=""
                   QUIT 
               Begin DoDot:1
 +10               IF I="MIDDLE"!(I="SUFFIX")
                       SET XUNC=1
 +11               SET C=$EXTRACT(I,1,"NPS"[$EXTRACT(I)+1)
 +12               IF 'XUMAT
                       IF ","_XUCD_","[(","_C_",")
                           SET XUMAT=1
 +13               IF $GET(XUCDX)]""
                       IF 'XUMATX
                           IF ","_XUCDX_","[(","_C_",")
                               SET XUMATX=1
 +14               SET XUCOD=XUCOD_C_","
               End DoDot:1
               if XUMATX
                   QUIT 
 +15       if 'XUMAT!XUMATX
               QUIT 
 +16       if XUCOD?.E1","
               SET XUCOD=$EXTRACT(XUCOD,1,$LENGTH(XUCOD)-1)
 +17      ;
 +18       DO W(XUREC)
           if $DATA(DIRUT)
               QUIT 
           WRITE ?15,"Old: "_XUOLD,?60,XUCOD
 +19       DO W("New: "_XUNEW,15)
           if $DATA(DIRUT)
               QUIT 
 +20       IF XUNC
               Begin DoDot:1
 +21               DO W(" Given: "_$PIECE(XULN,U,3),22)
 +22               DO W("Middle: "_$PIECE(XULN,U,4),22)
 +23               DO W("Family: "_$PIECE(XULN,U,5),22)
 +24               DO W("Suffix: "_$PIECE(XULN,U,6),22)
               End DoDot:1
 +25       DO W()
           if $DATA(DIRUT)
               QUIT 
 +26       QUIT 
 +27      ;
W(XUSTR,XUCOL,XUFLG) ;Write line feed and string XUSTR in column XUCOL
 +1        IF $Y+3'<IOSL
               DO EOP
               if $DATA(DIRUT)
                   QUIT 
               DO HDR
               if '$GET(XUFLG)
                   DO SUBHDR
 +2        WRITE !?+$GET(XUCOL),$GET(XUSTR)
 +3        QUIT 
 +4       ;
EOP       ;EOP
 +1        IF $EXTRACT(IOST,1,2)="C-"
               IF '$DATA(ZTQUEUED)
                   Begin DoDot:1
 +2                    NEW DIR,X,Y
 +3                    SET DIR(0)="E"
                       WRITE !
                       DO ^DIR
                   End DoDot:1
 +4       IF '$TEST
               IF $DATA(ZTQUEUED)
                   IF $$S^%ZTLOAD
                       SET (ZTSTOP,DIRUT)=1
 +5        WRITE @IOF
 +6        QUIT 
 +7       ;
HDR       ;Print header
 +1        SET XUPG=$GET(XUPG)+1
           SET $X=0
 +2        WRITE "^XTMP(""XLFNAME"") LISTING",?(IOM-$LENGTH(XUHLIN)-$LENGTH(XUPG)-1),XUHLIN_XUPG
 +3        WRITE !,$TRANSLATE($JUSTIFY("",IOM-1)," ","-")
 +4        QUIT 
 +5       ;
SUBHDR    ;Print subheader
 +1        WRITE !,"File: #"_XUFL,", Field: "_XUFDTXT
 +2        if XUCD]""
               WRITE !,"Entries that contain any of the following codes: ",XUCD
 +3        if XUCDX]""
               WRITE !,"Excluding entries that contain any of the following codes: ",XUCDX
 +4        WRITE !!,"Record",?15,"Name",?60,"Codes"
 +5        WRITE !,"------",?15,$TRANSLATE($JUSTIFY("",40)," ","-"),?60,"-----"
 +6        QUIT 
 +7       ;
HINFO(XUFL,XUFD) ;Get XUFDTXT for subheader
 +1        NEW XULAB
 +2        DO FIELD^DID(XUFL,XUFD,"","LABEL","XULAB")
 +3        SET XUFDTXT=XULAB("LABEL")_" (#"_XUFD_")"
 +4        QUIT 
 +5       ;
READ(PROMPT,DEF,XHELP,HELP) ;Read X, default is ALL
 +1        NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
 +2        SET DIR(0)="FO^1:30"
 +3        if $GET(PROMPT)]""
               SET DIR("A")=PROMPT
 +4        SET DIR("?")=$SELECT($GET(HELP)]"":HELP,1:"Enter a number or the word 'ALL'. Enter '??' for more help.")
 +5        if $GET(XHELP)]""
               SET DIR("??")="^D "_XHELP_"^XLFNAME4"
 +6        if $GET(DEF)]""
               SET DIR("B")=DEF
 +7        DO ^DIR
           if $DATA(DUOUT)!$DATA(DTOUT)
               QUIT U
 +8        QUIT Y
 +9       ;
HLPFIL    ;Execute help for file prompt
 +1        NEW I
 +2        WRITE !,"Enter 'ALL' to select all files, or select one of the following:",!
 +3        SET I=0
           FOR 
               SET I=$ORDER(^XTMP("XLFNAME",I))
               if 'I
                   QUIT 
               if $X>70
                   WRITE !
               WRITE I_"  "_$JUSTIFY("",10-$LENGTH(I))
 +4        QUIT 
 +5       ;
HLPFLD    ;Execute help for field prompt
 +1        NEW I
 +2        WRITE !,"Enter 'ALL' to select all fields, or select one of the following:",!
 +3        SET I=0
           FOR 
               SET I=$ORDER(^XTMP("XLFNAME",XUFL,I))
               if 'I
                   QUIT 
               if $X>70
                   WRITE !
               WRITE I_"  "_$JUSTIFY("",10-$LENGTH(I))
 +4        QUIT 
 +5       ;
HLPCOD    ;Executable help for codes prompt
 +1        NEW I,T
 +2        FOR I=1:1
               SET T=$PIECE($TEXT(CODTAB+I),";;",2,999)
               if T="$$END"
                   QUIT 
               WRITE !,T
 +3        WRITE !!,"To include entries with specific codes, enter those codes separated by commas,"
 +4        WRITE !,"or enter 'ALL' to select entries with any code,"
 +5        QUIT 
 +6       ;
HLPCODX   ;Executable help for codes prompt
 +1        NEW I,T
 +2        FOR I=1:1
               SET T=$PIECE($TEXT(CODTAB+I),";;",2,999)
               if T="$$END"
                   QUIT 
               WRITE !,T
 +3        WRITE !!,"To exclude entries with specific codes, enter those codes separated by commas,"
 +4        WRITE !,"or press <RET> to exclude no entries."
 +5        WRITE !!,"This list overrides the list of codes to include."
 +6        QUIT 
 +7       ;
QUEUE     ;Queue the report
 +1        NEW I,ZTSK
 +2       ;
 +3        SET ZTRTN="MAIN^XLFNAME4"
 +4        SET ZTDESC="Report of ^XTMP(""XLFNAME"")"
 +5        FOR I="XUFL","XUFD","XUCD","XUCDX"
               SET ZTSAVE(I)=""
 +6        DO ^%ZTLOAD
 +7       ;
 +8        IF $DATA(ZTSK)#2
               WRITE !,"Report queued!",!,"Task number: "_$GET(ZTSK),!
 +9       IF '$TEST
               WRITE !,"Report canceled!",!
 +10      ;
 +11       DO HOME^%ZIS
 +12       QUIT 
 +13      ;
INIT      ;Set XUHLIN to Date/time/page for header
 +1        NEW %,%H,X,Y
 +2        SET %H=$HOROLOG
           DO YX^%DTC
 +3        SET XUHLIN=$PIECE(Y,"@")_"  "_$PIECE($PIECE(Y,"@",2),":",1,2)_"    PAGE "
 +4        if $EXTRACT(IOST,1,2)="C-"
               WRITE @IOF
 +5        QUIT 
 +6       ;
END       ;Finish up
 +1        IF $DATA(ZTQUEUED)
               SET ZTREQ="@"
 +2       IF '$TEST
               DO ^%ZISC
 +3        QUIT 
 +4       ;
INTRO     ;Introductory text
 +1       ;;This entry point prints a report of the information stored in
 +2       ;;^XTMP("XLFNAME").
 +3       ;;
 +4       ;;The New Person Name Standardization conversion is run automatically during
 +5       ;;the installation of patch XU*8.0*134, as part of the POST-INSTALL ROUTINE
 +6       ;;(POST^XLFNAME). The conversion records in ^XTMP("XLFNAME") information
 +7       ;;about each Name that had to be changed to convert it to standard form, or
 +8       ;;for which assumptions had to be made in breaking the Name into its
 +9       ;;component parts for storage in the new NAME COMPONENTS file (#20).
 +10      ;;
 +11      ;;You can use this report to determine whether any names were standardized
 +12      ;;or parsed incorrectly. To correct a name or its component parts, go to the
 +13      ;;"Systems Manager Menu" [EVE], select "User Management" [XUSER], and then
 +14      ;;"Edit an Existing User" [XUSEREDIT]. From there you can edit the NAME
 +15      ;;field (#.01) of the NEW PERSON file (#200), as well as the component parts
 +16      ;;of the Name as they are stored in the NAME COMPONENTS file (#20).
 +17      ;;
 +18      ;;$$END
 +19       NEW I,T
 +20       FOR I=1:1
               SET T=$PIECE($TEXT(INTRO+I),";;",2,999)
               if T="$$END"
                   QUIT 
               WRITE !,T
 +21       QUIT 
 +22      ;
CODTAB    ;Code Table
 +1       ;;Explanation of Codes:
 +2       ;;--------------------
 +3       ;;  D  : The standard name is different from the original name.
 +4       ;;  F  : The Family Name starts with ST<period>. The period and
 +5       ;;         following space, if any, were removed.
 +6       ;;  G  : There is no Given Name.
 +7       ;;  M  : Assumption: There is more than one Given and only one Middle Name.
 +8       ;;  NM : NMI or NMN was used as the Middle Name.
 +9       ;;  NU : A name part contains a number.
 +10      ;;  PE : Periods were removed.
 +11      ;;  PU : Punctuation was removed.
 +12      ;;  SP : Spaces were removed from the Family Name.
 +13      ;;  ST : Text in parentheses was stripped from the name.
 +14      ;;  SU : One or more of the following situations was encountered relating
 +15      ;;       to suffixes:
 +16      ;;       - Suffixes were found immediate to left of the first comma.
 +17      ;;       - I, V, or X was interpreted as a Middle Name.
 +18      ;;       - A name part was interpreted as a Suffix, not a Middle Name.
 +19      ;;       - M.D. or M D was NOT interpreted as a Suffix.
 +20      ;;       - A name part with no vowels was interpreted as a Suffix.
 +21      ;;       - A Suffix was found between commas immediately after the Family Name.
 +22      ;;  T  : The standard name was truncated.
 +23      ;;$$END
 +24       NEW I,T
 +25       FOR I=1:1
               SET T=$PIECE($TEXT(CODTAB+I),";;",2,999)
               if T="$$END"
                   QUIT 
               DO W(T,0,1)
 +26       QUIT