source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DPTNAME.m@ 1499

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

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1DPTNAME ;BPOIFO/KEITH - NAME STANDARDIZATION ; 27 Jan 2002 11:05 PM
2 ;;5.3;Registration;**244,620**;Aug 13, 1993
3 ;
4NCEDIT(DFN,DGHDR,DG20NAME) ;Edit name components
5 ;Input: DFN=patient ifn
6 ; DGHDR=1 to write components header (optional)
7 ; DG20NAME=array of name components (optional)
8 ;Output: formatted name and DG20NAME components array if the user
9 ; specifies filing, DG20NAME=null otherwise
10 ;
11 N DIR,X,Y,DGCOMP,DGC,DGI,DGX,DGY,DGCOM
12 N DGCL,DGCX,DGOUT,DGEDIT,%,DIE,DR,DA
13 ;Initialize variables
14START S DFN=+DFN,(DGOUT,DGEDIT)=0,DGCOMP=$D(DG20NAME)>9
15 S DGCOM="FAMILY^GIVEN^MIDDLE^PREFIX^SUFFIX^DEGREE"
16 S DGCX=" (LAST) NAME^ (FIRST) NAME^ NAME"
17 S DGCL="1:35^1:25^1:25^1:10^1:10^1:10"
18 ;Get patient name
19 S DGX=$P($G(^DPT(DFN,0)),U) Q:DGX=""
20 ;Get name component values from file #20
21 I 'DGCOMP S DGCOMP=+$G(^DPT(DFN,"NAME"))_"," I DGCOMP D
22 .D GETS^DIQ(20,DGCOMP,"1:6",,"DGCOMP")
23 .I '$D(DGCOMP(20,DGCOMP)) S DGCOMP=0 Q
24 .F DGI=1:1:6 S DGX($P(DGCOM,U,DGI))=DGCOMP(20,DGCOMP,DGI)
25 .Q
26 ;Parse name components from name value
27 I 'DGCOMP D
28 .D STDNAME^XLFNAME(.DGX,"C") S DGEDIT=1
29 .S DGX("SUFFIX")=$$CLEANC^XLFNAME(DGX("SUFFIX"))
30 .Q
31 ;Prompt for name component edits
32 N DTOUT,DUOUT,DIRUT,DGCOUT
33 S DGCOUT=0 M DG20NAME=DGX
34 S DIR("PRE")="D:X'=""@"" NCEVAL^DPTNAME1(DGCOMP,.X)"
35 I $G(DGHDR) W !,"Patient name components--"
36 F DGI=1:1:6 S DGC($P(DGCOM,U,DGI),DGI)=""
37 F DGI=1:1:6 Q:DGOUT D
38AGAIN .S DGCOMP=$P(DGCOM,U,DGI)
39 .S DIR("A")=DGCOMP_$P(DGCX,U,DGI)
40 .S DIR(0)="FO^"_$P(DGCL,U,DGI)
41 .S DIR("PRE")="D NCEVAL^DPTNAME1(DGCOMP,.X)"
42 .S DIR("B")=$S($D(DG20NAME(DGCOMP)):DG20NAME(DGCOMP),1:$G(DGX(DGCOMP)))
43 .K:'$L(DIR("B")) DIR("B")
44ASK .D ^DIR I $D(DTOUT)!(X=U) S:(X=U) DGCOUT=1 S DGOUT=1 Q
45 .I $A(X)=94 D JUMP^DPTNAME1(.DGI) G AGAIN
46 .I X="@",DGI=1 W !,$C(7),"Family name cannot be deleted!" G ASK
47 .I X="@" D Q
48 ..W " (deletion indicated)" S DG20NAME(DGCOMP)=""
49 ..S:DG20NAME(DGCOMP)'=$G(DGX(DGCOMP)) DGEDIT=1
50 ..Q
51 .Q:'$L(X)
52 .S DG20NAME=X
53 .I DGCOMP="SUFFIX" S DG20NAME=$$CLEANC^XLFNAME(DG20NAME)
54 .S DG20NAME=$$FORMAT^XLFNAME7(DG20NAME,1,35,,3,,1,1)
55 .I '$L(DG20NAME) W " ??",$C(7) G ASK
56 .W:DG20NAME'=X " (",DG20NAME,")" S DG20NAME(DGCOMP)=DG20NAME
57 .S:DG20NAME(DGCOMP)'=$G(DGX(DGCOMP)) DGEDIT=1
58 .Q
59 Q:'DGEDIT ""
60 Q:DGOUT&'DGCOUT ""
61 ;Reconstruct name
62 S DG20NAME=$$NAMEFMT^XLFNAME(.DG20NAME,"F","CFL30")
63 ;Format the .01 value
64 M DGY=DG20NAME
65 S DG20NAME=$$FORMAT^XLFNAME7(.DGY,3,30,,2)
66 ;Check the length
67 I $L(DG20NAME)<3 D G START
68 .W !,"Invalid values to file, full name must be at least 3 characters!",$C(7)
69 .K DG20NAME,DGX,DGCOMP Q
70 ;File new name value
71CONF W !,"Ok to file '",DG20NAME,"' and its name components"
72 S %=1 D YN^DICN
73 I '% W !,"Indicate if the edits to the name and its components should be filed." G CONF
74 I %'=1 K DG20NAME S DG20NAME="" Q DG20NAME
75 I '$$CONF1(DG20NAME) K DG20NAME S DG20NAME=""
76 Q DG20NAME
77 ;
78CONF1(DPTX) ;Confirm if single name value is ok.
79 ;Input: DPTX=name value
80 N %
81 Q:$E($P(DPTX,",",2))?1U 1
82 W !!?5,$C(7),"WARNING: Do not enter single name values for patients (no given or"
83 W !?5," first name) unless this is actually their legal name!!!",$C(7)
84RC W !!,"Are you sure you want to enter the patient name in this manner"
85 S %=2 D YN^DICN S %=$S(%<0!(%=2):-1,%=1:1,1:0) I '% W !?6,"Specify 'YES' to enter a single name value, or 'NO' to discontinue." G RC
86 W !
87 Q %=1
Note: See TracBrowser for help on using the repository browser.