XLFNAME4 ;CIOFO-SF/MKO-PRINT INFORMATION IN ^XTMP ;11:35 AM 23 Mar 2000 [ 04/02/2003 8:29 AM ]
;;;;8.0;KERNEL;**1007**;APR 1, 2003
;;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
XLFNAME4 ;CIOFO-SF/MKO-PRINT INFORMATION IN ^XTMP ;11:35 AM 23 Mar 2000 [ 04/02/2003 8:29 AM ]
+1 ;;;;8.0;KERNEL;**1007**;APR 1, 2003
+2 ;;8.0;KERNEL;**134**;Jul 10, 1995
+3 ;
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
