- 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 Feb 18, 2025@23:29:19 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