XLFNAME2 ;CIOFO-SF/MKO-UPDATE ENTRY POINTS ;21 Aug 2019 12:15 PM
;;8.0;KERNEL;**134,211,301,343,710**;Jul 10, 1995;Build 2
;
UPDNAME(XUFIL,XUREC,XUFLD,XUCOMP,XUFLAG) ;Update source name field
;Called from "ANAME" MUMPS xref on file #20.
;
N XUIENS,XUFDA,XULEN,XUMAX,XUMSG,XUNAME,DIERR
I '$G(XUNOTRIG) N XUNOTRIG S XUNOTRIG=1
S:$G(XUFLAG)="" XUFLAG="CLS"
;
;Get IENS from XUREC
I $G(XUREC)'["," S XUIENS=$$IENS^DILF(.XUREC)
E S XUIENS=XUREC S:XUIENS'?.E1"," XUIENS=XUIENS_","
;
;Get maximum length of source field; **710,Story 1102755 (mko): Make sure length doesn't exceed this length
S XUMAX=+$$GET1^DID(XUFIL,XUFLD,"","FIELD LENGTH","","XUMSG") K DIERR,XUMSG
S XULEN=+$P($G(XUFLAG),"L",2)
I 'XULEN!(XULEN>XUMAX) S XULEN=XUMAX
;
;Get name from components; quit if source name = new name
S XUNAME=$$BLDNAME^XLFNAME8(.XUCOMP,XULEN) ;**710,Story 1102755 (mko): Pass the specified length or max field length
;S XUNAME=$$NAMEFMT^XLFNAME(.XUCOMP,"F",XUFLAG)
;
Q:XUNAME=$$GET1^DIQ(XUFIL,XUIENS,XUFLD,"I","","XUMSG") K DIERR,XUMSG
;
;Call Filer to edit entry in source file
S XUFDA(XUFIL,XUIENS,XUFLD)=XUNAME
D FILE^DIE("","XUFDA","XUMSG") K DIERR,XUMSG
Q
;
UPDCOMP(XUFIL,XUREC,XUFLD,XUNAME,XUPTR,XUPVAL,XUFLAG) ;Update Name Components entry
;Called from set logic of "ANAME" MUMPS xref of file #200,
;Called from UPDATE^XLFNAME3 to update components during conversion.
N XUDEG,XUIEN,XUIENS,XUFDA,XUMSG,DIERR
I '$G(XUNOTRIG) N XUNOTRIG S XUNOTRIG=1
;
;Get IENS from XUREC
I $G(XUREC)'["," S XUIENS=$$IENS^DILF(.XUREC)
E S XUIENS=XUREC S:XUIENS'?.E1"," XUIENS=XUIENS_","
;
;Get name components from XUNAME
I $D(XUNAME)=1,XUNAME]"" D NAMECOMP^XLFNAME(.XUNAME)
;
;Call updater to add or edit entry in Name Component file
S XUFDA(20,"?+1,",.01)=XUFIL
S XUFDA(20,"?+1,",.02)=XUFLD
S XUFDA(20,"?+1,",.03)=XUIENS
S:$D(XUNAME("FAMILY"))#2 XUFDA(20,"?+1,",1)=XUNAME("FAMILY")
S:$D(XUNAME("GIVEN"))#2 XUFDA(20,"?+1,",2)=XUNAME("GIVEN")
S:$D(XUNAME("MIDDLE"))#2 XUFDA(20,"?+1,",3)=XUNAME("MIDDLE")
S:$D(XUNAME("PREFIX"))#2 XUFDA(20,"?+1,",4)=XUNAME("PREFIX")
S:$D(XUNAME("SUFFIX"))#2 XUFDA(20,"?+1,",5)=XUNAME("SUFFIX")
S:$D(XUNAME("DEGREE"))#2 XUFDA(20,"?+1,",6)=XUNAME("DEGREE")
S:$D(XUNAME("NOTES"))#2 XUFDA(20,"?+1,",11)=XUNAME("NOTES")
S:$D(XUFLAG)#2 XUFDA(20,"?+1,",7)=XUFLAG
D UPDATE^DIE("K","XUFDA","XUIEN","XUMSG") K DIERR,XUMSG
;
;Update pointer
I $G(XUPTR),$G(XUIEN(1)),$G(XUIEN(1))'=$G(XUPVAL) D
. S XUPVAL=XUIEN(1)
. S XUFDA(XUFIL,XUIENS,XUPTR)=XUPVAL
. D FILE^DIE("","XUFDA","XUMSG") K DIERR,XUMSG
Q
;
DELCOMP(XUFIL,XUREC,XUFLD,XUPTR) ;Delete Name Components entry
;Called from kill logic "ANAME" MUMPS xref of file #200
N DA,DIK,XUFDA,XUIENS,XUMSG,XUVAL,DIERR
;
;Get IENS from XUREC
I $G(XUREC)'["," S XUIENS=$$IENS^DILF(.XUREC)
E S XUIENS=XUREC S:XUIENS'?.E1"," XUIENS=XUIENS_","
;
;Lookup entry in Name Components file
S XUVAL(1)=XUFIL,XUVAL(2)=XUFLD,XUVAL(3)=XUIENS
S DA=$$FIND1^DIC(20,"","X",.XUVAL,"BB","","XUMSG") ;8*301
Q:$G(DIERR)
;
;Delete entry from Name Components file
S DIK="^VA(20,"
D ^DIK
;
;Delete pointer value
I $G(XUPTR) D
. K XUFDA S XUFDA(XUFIL,XUIENS,XUPTR)=""
. D FILE^DIE("","XUFDA","XUMSG") K XUMSG,DIERR
Q
;
CHKPTR ;Make sure entry contains a valid pointer to Name Components file.
;Called from the pre-action on the XUEXISTING USER form.
N AIEN,DEG,FDA,NAM,PTR,DIERR
;
;Get current pointer value
S PTR=+$P($G(^VA(200,DA,3.1)),U)
;
;If not valid, get standard name, and update the Name Components file
I 'PTR!($D(^VA(20,PTR,0))[0) D
. K PTR
. S NAM=$P($G(^VA(200,DA,0)),U)
. S DEG=$P($G(^VA(200,DA,3.1)),U,6)
. D STDNAME^XLFNAME(.NAM,"C")
. D UPDCOMP(200,DA_",",.01,.NAM,10.1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXLFNAME2 3806 printed Dec 13, 2024@02:02:54 Page 2
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
+2 ;
UPDNAME(XUFIL,XUREC,XUFLD,XUCOMP,XUFLAG) ;Update source name field
+1 ;Called from "ANAME" MUMPS xref on file #20.
+2 ;
+3 NEW XUIENS,XUFDA,XULEN,XUMAX,XUMSG,XUNAME,DIERR
+4 IF '$GET(XUNOTRIG)
NEW XUNOTRIG
SET XUNOTRIG=1
+5 if $GET(XUFLAG)=""
SET XUFLAG="CLS"
+6 ;
+7 ;Get IENS from XUREC
+8 IF $GET(XUREC)'[","
SET XUIENS=$$IENS^DILF(.XUREC)
+9 IF '$TEST
SET XUIENS=XUREC
if XUIENS'?.E1","
SET XUIENS=XUIENS_","
+10 ;
+11 ;Get maximum length of source field; **710,Story 1102755 (mko): Make sure length doesn't exceed this length
+12 SET XUMAX=+$$GET1^DID(XUFIL,XUFLD,"","FIELD LENGTH","","XUMSG")
KILL DIERR,XUMSG
+13 SET XULEN=+$PIECE($GET(XUFLAG),"L",2)
+14 IF 'XULEN!(XULEN>XUMAX)
SET XULEN=XUMAX
+15 ;
+16 ;Get name from components; quit if source name = new name
+17 ;**710,Story 1102755 (mko): Pass the specified length or max field length
SET XUNAME=$$BLDNAME^XLFNAME8(.XUCOMP,XULEN)
+18 ;S XUNAME=$$NAMEFMT^XLFNAME(.XUCOMP,"F",XUFLAG)
+19 ;
+20 if XUNAME=$$GET1^DIQ(XUFIL,XUIENS,XUFLD,"I","","XUMSG")
QUIT
KILL DIERR,XUMSG
+21 ;
+22 ;Call Filer to edit entry in source file
+23 SET XUFDA(XUFIL,XUIENS,XUFLD)=XUNAME
+24 DO FILE^DIE("","XUFDA","XUMSG")
KILL DIERR,XUMSG
+25 QUIT
+26 ;
UPDCOMP(XUFIL,XUREC,XUFLD,XUNAME,XUPTR,XUPVAL,XUFLAG) ;Update Name Components entry
+1 ;Called from set logic of "ANAME" MUMPS xref of file #200,
+2 ;Called from UPDATE^XLFNAME3 to update components during conversion.
+3 NEW XUDEG,XUIEN,XUIENS,XUFDA,XUMSG,DIERR
+4 IF '$GET(XUNOTRIG)
NEW XUNOTRIG
SET XUNOTRIG=1
+5 ;
+6 ;Get IENS from XUREC
+7 IF $GET(XUREC)'[","
SET XUIENS=$$IENS^DILF(.XUREC)
+8 IF '$TEST
SET XUIENS=XUREC
if XUIENS'?.E1","
SET XUIENS=XUIENS_","
+9 ;
+10 ;Get name components from XUNAME
+11 IF $DATA(XUNAME)=1
IF XUNAME]""
DO NAMECOMP^XLFNAME(.XUNAME)
+12 ;
+13 ;Call updater to add or edit entry in Name Component file
+14 SET XUFDA(20,"?+1,",.01)=XUFIL
+15 SET XUFDA(20,"?+1,",.02)=XUFLD
+16 SET XUFDA(20,"?+1,",.03)=XUIENS
+17 if $DATA(XUNAME("FAMILY"))#2
SET XUFDA(20,"?+1,",1)=XUNAME("FAMILY")
+18 if $DATA(XUNAME("GIVEN"))#2
SET XUFDA(20,"?+1,",2)=XUNAME("GIVEN")
+19 if $DATA(XUNAME("MIDDLE"))#2
SET XUFDA(20,"?+1,",3)=XUNAME("MIDDLE")
+20 if $DATA(XUNAME("PREFIX"))#2
SET XUFDA(20,"?+1,",4)=XUNAME("PREFIX")
+21 if $DATA(XUNAME("SUFFIX"))#2
SET XUFDA(20,"?+1,",5)=XUNAME("SUFFIX")
+22 if $DATA(XUNAME("DEGREE"))#2
SET XUFDA(20,"?+1,",6)=XUNAME("DEGREE")
+23 if $DATA(XUNAME("NOTES"))#2
SET XUFDA(20,"?+1,",11)=XUNAME("NOTES")
+24 if $DATA(XUFLAG)#2
SET XUFDA(20,"?+1,",7)=XUFLAG
+25 DO UPDATE^DIE("K","XUFDA","XUIEN","XUMSG")
KILL DIERR,XUMSG
+26 ;
+27 ;Update pointer
+28 IF $GET(XUPTR)
IF $GET(XUIEN(1))
IF $GET(XUIEN(1))'=$GET(XUPVAL)
Begin DoDot:1
+29 SET XUPVAL=XUIEN(1)
+30 SET XUFDA(XUFIL,XUIENS,XUPTR)=XUPVAL
+31 DO FILE^DIE("","XUFDA","XUMSG")
KILL DIERR,XUMSG
End DoDot:1
+32 QUIT
+33 ;
DELCOMP(XUFIL,XUREC,XUFLD,XUPTR) ;Delete Name Components entry
+1 ;Called from kill logic "ANAME" MUMPS xref of file #200
+2 NEW DA,DIK,XUFDA,XUIENS,XUMSG,XUVAL,DIERR
+3 ;
+4 ;Get IENS from XUREC
+5 IF $GET(XUREC)'[","
SET XUIENS=$$IENS^DILF(.XUREC)
+6 IF '$TEST
SET XUIENS=XUREC
if XUIENS'?.E1","
SET XUIENS=XUIENS_","
+7 ;
+8 ;Lookup entry in Name Components file
+9 SET XUVAL(1)=XUFIL
SET XUVAL(2)=XUFLD
SET XUVAL(3)=XUIENS
+10 ;8*301
SET DA=$$FIND1^DIC(20,"","X",.XUVAL,"BB","","XUMSG")
+11 if $GET(DIERR)
QUIT
+12 ;
+13 ;Delete entry from Name Components file
+14 SET DIK="^VA(20,"
+15 DO ^DIK
+16 ;
+17 ;Delete pointer value
+18 IF $GET(XUPTR)
Begin DoDot:1
+19 KILL XUFDA
SET XUFDA(XUFIL,XUIENS,XUPTR)=""
+20 DO FILE^DIE("","XUFDA","XUMSG")
KILL XUMSG,DIERR
End DoDot:1
+21 QUIT
+22 ;
CHKPTR ;Make sure entry contains a valid pointer to Name Components file.
+1 ;Called from the pre-action on the XUEXISTING USER form.
+2 NEW AIEN,DEG,FDA,NAM,PTR,DIERR
+3 ;
+4 ;Get current pointer value
+5 SET PTR=+$PIECE($GET(^VA(200,DA,3.1)),U)
+6 ;
+7 ;If not valid, get standard name, and update the Name Components file
+8 IF 'PTR!($DATA(^VA(20,PTR,0))[0)
Begin DoDot:1
+9 KILL PTR
+10 SET NAM=$PIECE($GET(^VA(200,DA,0)),U)
+11 SET DEG=$PIECE($GET(^VA(200,DA,3.1)),U,6)
+12 DO STDNAME^XLFNAME(.NAM,"C")
+13 DO UPDCOMP(200,DA_",",.01,.NAM,10.1)
End DoDot:1
+14 QUIT
