source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XLFNAME2.m@ 1639

Last change on this file since 1639 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1XLFNAME2 ;CIOFO-SF/MKO-UPDATE ENTRY POINTS;1:07 PM 24 Apr 2003
2 ;;8.0;KERNEL;**134,211,301,343**;Jul 10, 1995
3 ;
4UPDNAME(XUFIL,XUREC,XUFLD,XUCOMP,XUFLAG) ;Update source name field
5 ;Called from "ANAME" MUMPS xref on file #20.
6 ;
7 N XUIENS,XUFDA,XUMAX,XUMSG,XUNAME,DIERR
8 I '$G(XUNOTRIG) N XUNOTRIG S XUNOTRIG=1
9 S:$G(XUFLAG)="" XUFLAG="CLS"
10 ;
11 ;Get IENS from XUREC
12 I $G(XUREC)'["," S XUIENS=$$IENS^DILF(.XUREC)
13 E S XUIENS=XUREC S:XUIENS'?.E1"," XUIENS=XUIENS_","
14 ;
15 ;Get maximum length of source field
16 I XUFLAG["L",'$P(XUFLAG,"L",2) D
17 . S XUFLAG=$TR(XUFLAG,"L")_"L"_+$$GET1^DID(XUFIL,XUFLD,"","FIELD LENGTH","","XUMSG")
18 . K DIERR,XUMSG
19 ;
20 ;Get name from components; quit if source name = new name
21 S XUNAME=$$BLDNAME^XLFNAME8(.XUCOMP,35)
22 ;S XUNAME=$$NAMEFMT^XLFNAME(.XUCOMP,"F",XUFLAG)
23 ;
24 Q:XUNAME=$$GET1^DIQ(XUFIL,XUIENS,XUFLD,"I","","XUMSG") K DIERR,XUMSG
25 ;
26 ;Call Filer to edit entry in source file
27 S XUFDA(XUFIL,XUIENS,XUFLD)=XUNAME
28 D FILE^DIE("","XUFDA","XUMSG") K DIERR,XUMSG
29 Q
30 ;
31UPDCOMP(XUFIL,XUREC,XUFLD,XUNAME,XUPTR,XUPVAL,XUFLAG) ;Update Name Components entry
32 ;Called from set logic of "ANAME" MUMPS xref of file #200,
33 ;Called from UPDATE^XLFNAME3 to update components during conversion.
34 N XUDEG,XUIEN,XUIENS,XUFDA,XUMSG,DIERR
35 I '$G(XUNOTRIG) N XUNOTRIG S XUNOTRIG=1
36 ;
37 ;Get IENS from XUREC
38 I $G(XUREC)'["," S XUIENS=$$IENS^DILF(.XUREC)
39 E S XUIENS=XUREC S:XUIENS'?.E1"," XUIENS=XUIENS_","
40 ;
41 ;Get name components from XUNAME
42 I $D(XUNAME)=1,XUNAME]"" D NAMECOMP^XLFNAME(.XUNAME)
43 ;
44 ;Call updater to add or edit entry in Name Component file
45 S XUFDA(20,"?+1,",.01)=XUFIL
46 S XUFDA(20,"?+1,",.02)=XUFLD
47 S XUFDA(20,"?+1,",.03)=XUIENS
48 S:$D(XUNAME("FAMILY"))#2 XUFDA(20,"?+1,",1)=XUNAME("FAMILY")
49 S:$D(XUNAME("GIVEN"))#2 XUFDA(20,"?+1,",2)=XUNAME("GIVEN")
50 S:$D(XUNAME("MIDDLE"))#2 XUFDA(20,"?+1,",3)=XUNAME("MIDDLE")
51 S:$D(XUNAME("PREFIX"))#2 XUFDA(20,"?+1,",4)=XUNAME("PREFIX")
52 S:$D(XUNAME("SUFFIX"))#2 XUFDA(20,"?+1,",5)=XUNAME("SUFFIX")
53 S:$D(XUNAME("DEGREE"))#2 XUFDA(20,"?+1,",6)=XUNAME("DEGREE")
54 S:$D(XUNAME("NOTES"))#2 XUFDA(20,"?+1,",11)=XUNAME("NOTES")
55 S:$D(XUFLAG)#2 XUFDA(20,"?+1,",7)=XUFLAG
56 D UPDATE^DIE("K","XUFDA","XUIEN","XUMSG") K DIERR,XUMSG
57 ;
58 ;Update pointer
59 I $G(XUPTR),$G(XUIEN(1)),$G(XUIEN(1))'=$G(XUPVAL) D
60 . S XUPVAL=XUIEN(1)
61 . S XUFDA(XUFIL,XUIENS,XUPTR)=XUPVAL
62 . D FILE^DIE("","XUFDA","XUMSG") K DIERR,XUMSG
63 Q
64 ;
65DELCOMP(XUFIL,XUREC,XUFLD,XUPTR) ;Delete Name Components entry
66 ;Called from kill logic "ANAME" MUMPS xref of file #200
67 N DA,DIK,XUFDA,XUIENS,XUMSG,XUVAL,DIERR
68 ;
69 ;Get IENS from XUREC
70 I $G(XUREC)'["," S XUIENS=$$IENS^DILF(.XUREC)
71 E S XUIENS=XUREC S:XUIENS'?.E1"," XUIENS=XUIENS_","
72 ;
73 ;Lookup entry in Name Components file
74 S XUVAL(1)=XUFIL,XUVAL(2)=XUFLD,XUVAL(3)=XUIENS
75 S DA=$$FIND1^DIC(20,"","X",.XUVAL,"BB","","XUMSG") ;8*301
76 Q:$G(DIERR)
77 ;
78 ;Delete entry from Name Components file
79 S DIK="^VA(20,"
80 D ^DIK
81 ;
82 ;Delete pointer value
83 I $G(XUPTR) D
84 . K XUFDA S XUFDA(XUFIL,XUIENS,XUPTR)=""
85 . D FILE^DIE("","XUFDA","XUMSG") K XUMSG,DIERR
86 Q
87 ;
88CHKPTR ;Make sure entry contains a valid pointer to Name Components file.
89 ;Called from the pre-action on the XUEXISTING USER form.
90 N AIEN,DEG,FDA,NAM,PTR,DIERR
91 ;
92 ;Get current pointer value
93 S PTR=+$P($G(^VA(200,DA,3.1)),U)
94 ;
95 ;If not valid, get standard name, and update the Name Components file
96 I 'PTR!($D(^VA(20,PTR,0))[0) D
97 . K PTR
98 . S NAM=$P($G(^VA(200,DA,0)),U)
99 . S DEG=$P($G(^VA(200,DA,3.1)),U,6)
100 . D STDNAME^XLFNAME(.NAM,"C")
101 . D UPDCOMP(200,DA_",",.01,.NAM,10.1)
102 Q
Note: See TracBrowser for help on using the repository browser.