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

XLFNAME2.m

Go to the documentation of this file.
  1. XLFNAME2 ;CIOFO-SF/MKO-UPDATE ENTRY POINTS ;21 Aug 2019 12:15 PM
  1. ;;8.0;KERNEL;**134,211,301,343,710**;Jul 10, 1995;Build 2
  1. ;
  1. UPDNAME(XUFIL,XUREC,XUFLD,XUCOMP,XUFLAG) ;Update source name field
  1. ;Called from "ANAME" MUMPS xref on file #20.
  1. ;
  1. N XUIENS,XUFDA,XULEN,XUMAX,XUMSG,XUNAME,DIERR
  1. I '$G(XUNOTRIG) N XUNOTRIG S XUNOTRIG=1
  1. S:$G(XUFLAG)="" XUFLAG="CLS"
  1. ;
  1. ;Get IENS from XUREC
  1. I $G(XUREC)'["," S XUIENS=$$IENS^DILF(.XUREC)
  1. E S XUIENS=XUREC S:XUIENS'?.E1"," XUIENS=XUIENS_","
  1. ;
  1. ;Get maximum length of source field; **710,Story 1102755 (mko): Make sure length doesn't exceed this length
  1. S XUMAX=+$$GET1^DID(XUFIL,XUFLD,"","FIELD LENGTH","","XUMSG") K DIERR,XUMSG
  1. S XULEN=+$P($G(XUFLAG),"L",2)
  1. I 'XULEN!(XULEN>XUMAX) S XULEN=XUMAX
  1. ;
  1. ;Get name from components; quit if source name = new name
  1. S XUNAME=$$BLDNAME^XLFNAME8(.XUCOMP,XULEN) ;**710,Story 1102755 (mko): Pass the specified length or max field length
  1. ;S XUNAME=$$NAMEFMT^XLFNAME(.XUCOMP,"F",XUFLAG)
  1. ;
  1. Q:XUNAME=$$GET1^DIQ(XUFIL,XUIENS,XUFLD,"I","","XUMSG") K DIERR,XUMSG
  1. ;
  1. ;Call Filer to edit entry in source file
  1. S XUFDA(XUFIL,XUIENS,XUFLD)=XUNAME
  1. D FILE^DIE("","XUFDA","XUMSG") K DIERR,XUMSG
  1. Q
  1. ;
  1. UPDCOMP(XUFIL,XUREC,XUFLD,XUNAME,XUPTR,XUPVAL,XUFLAG) ;Update Name Components entry
  1. ;Called from set logic of "ANAME" MUMPS xref of file #200,
  1. ;Called from UPDATE^XLFNAME3 to update components during conversion.
  1. N XUDEG,XUIEN,XUIENS,XUFDA,XUMSG,DIERR
  1. I '$G(XUNOTRIG) N XUNOTRIG S XUNOTRIG=1
  1. ;
  1. ;Get IENS from XUREC
  1. I $G(XUREC)'["," S XUIENS=$$IENS^DILF(.XUREC)
  1. E S XUIENS=XUREC S:XUIENS'?.E1"," XUIENS=XUIENS_","
  1. ;
  1. ;Get name components from XUNAME
  1. I $D(XUNAME)=1,XUNAME]"" D NAMECOMP^XLFNAME(.XUNAME)
  1. ;
  1. ;Call updater to add or edit entry in Name Component file
  1. S XUFDA(20,"?+1,",.01)=XUFIL
  1. S XUFDA(20,"?+1,",.02)=XUFLD
  1. S XUFDA(20,"?+1,",.03)=XUIENS
  1. S:$D(XUNAME("FAMILY"))#2 XUFDA(20,"?+1,",1)=XUNAME("FAMILY")
  1. S:$D(XUNAME("GIVEN"))#2 XUFDA(20,"?+1,",2)=XUNAME("GIVEN")
  1. S:$D(XUNAME("MIDDLE"))#2 XUFDA(20,"?+1,",3)=XUNAME("MIDDLE")
  1. S:$D(XUNAME("PREFIX"))#2 XUFDA(20,"?+1,",4)=XUNAME("PREFIX")
  1. S:$D(XUNAME("SUFFIX"))#2 XUFDA(20,"?+1,",5)=XUNAME("SUFFIX")
  1. S:$D(XUNAME("DEGREE"))#2 XUFDA(20,"?+1,",6)=XUNAME("DEGREE")
  1. S:$D(XUNAME("NOTES"))#2 XUFDA(20,"?+1,",11)=XUNAME("NOTES")
  1. S:$D(XUFLAG)#2 XUFDA(20,"?+1,",7)=XUFLAG
  1. D UPDATE^DIE("K","XUFDA","XUIEN","XUMSG") K DIERR,XUMSG
  1. ;
  1. ;Update pointer
  1. I $G(XUPTR),$G(XUIEN(1)),$G(XUIEN(1))'=$G(XUPVAL) D
  1. . S XUPVAL=XUIEN(1)
  1. . S XUFDA(XUFIL,XUIENS,XUPTR)=XUPVAL
  1. . D FILE^DIE("","XUFDA","XUMSG") K DIERR,XUMSG
  1. Q
  1. ;
  1. DELCOMP(XUFIL,XUREC,XUFLD,XUPTR) ;Delete Name Components entry
  1. ;Called from kill logic "ANAME" MUMPS xref of file #200
  1. N DA,DIK,XUFDA,XUIENS,XUMSG,XUVAL,DIERR
  1. ;
  1. ;Get IENS from XUREC
  1. I $G(XUREC)'["," S XUIENS=$$IENS^DILF(.XUREC)
  1. E S XUIENS=XUREC S:XUIENS'?.E1"," XUIENS=XUIENS_","
  1. ;
  1. ;Lookup entry in Name Components file
  1. S XUVAL(1)=XUFIL,XUVAL(2)=XUFLD,XUVAL(3)=XUIENS
  1. S DA=$$FIND1^DIC(20,"","X",.XUVAL,"BB","","XUMSG") ;8*301
  1. Q:$G(DIERR)
  1. ;
  1. ;Delete entry from Name Components file
  1. S DIK="^VA(20,"
  1. D ^DIK
  1. ;
  1. ;Delete pointer value
  1. I $G(XUPTR) D
  1. . K XUFDA S XUFDA(XUFIL,XUIENS,XUPTR)=""
  1. . D FILE^DIE("","XUFDA","XUMSG") K XUMSG,DIERR
  1. Q
  1. ;
  1. CHKPTR ;Make sure entry contains a valid pointer to Name Components file.
  1. ;Called from the pre-action on the XUEXISTING USER form.
  1. N AIEN,DEG,FDA,NAM,PTR,DIERR
  1. ;
  1. ;Get current pointer value
  1. S PTR=+$P($G(^VA(200,DA,3.1)),U)
  1. ;
  1. ;If not valid, get standard name, and update the Name Components file
  1. I 'PTR!($D(^VA(20,PTR,0))[0) D
  1. . K PTR
  1. . S NAM=$P($G(^VA(200,DA,0)),U)
  1. . S DEG=$P($G(^VA(200,DA,3.1)),U,6)
  1. . D STDNAME^XLFNAME(.NAM,"C")
  1. . D UPDCOMP(200,DA_",",.01,.NAM,10.1)
  1. Q