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

XLFNAME4.m

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