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

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1DPTNAME1 ;BPOIFO/KEITH - NAME STANDARDIZATION ; 12 Aug 2002@20:20
2 ;;5.3;Registration;**244,620,720**;Aug 13, 1993
3 ;
4NCEVAL(DGC,DGX) ;Evaluate name component entry values
5 ;Input: DGC=name component (e.g. FAMILY, GIVEN, etc.)
6 ; DGX=input value for name
7 ;
8 Q:DGX="@"
9 N DGM,DGL,DGI
10 I DGX=""!($E(DGX)=U) Q
11 D CVALID(DGC,DGX,.DGM)
12 M DIR("?")=DGM("HELP") S DGI=$O(DIR("?",""),-1) I DGI D
13 .S DIR("?")=DIR("?",DGI) K DIR("?",DGI)
14 .Q
15 I "???"[DGX Q
16 I DGM("RESULT")="" D Q
17 .S DGI="" F S DGI=$O(DGM("ERROR",DGI)) Q:DGI="" D
18 ..I DGM("ERROR",DGI)["''" S $P(DGM("ERROR",DGI),"'",2)=DGX
19 ..W:DGI=1 ! W !,DGM("ERROR",DGI)
20 ..Q
21 .K DGX
22 .Q
23 I DGM("RESULT")'=DGX W " (",DGM("RESULT"),")"
24 S DGX=DGM("RESULT")
25 Q
26 ;
27FAMILY ;Family name help text
28 S DGM("LENGTH")="1-35"
29 D HTEXT("family (last) name.",DGM("LENGTH"))
30 S DGM("HELP",4)="Input values less than 3 characters in length must be all alpha characters."
31 Q
32 ;
33GIVEN ;Given name help text
34 S DGM("LENGTH")="1-25"
35 D HTEXT("given (first) name.",DGM("LENGTH"))
36 Q
37 ;
38MIDDLE ;Middle name help text
39 S DGM("LENGTH")="1-25"
40 D HTEXT("middle name.",DGM("LENGTH"))
41 S DGM("HELP",4)="Middle names of 'NMI' and 'NMN' are prohibited."
42 Q
43 ;
44PREFIX ;Name prefix help text
45 S DGM("LENGTH")="1-10"
46 D HTEXT("name prefix, such as MR or MS.",DGM("LENGTH"))
47 Q
48 ;
49SUFFIX ;Name suffix help text
50 S DGM("LENGTH")="1-10"
51 D HTEXT("suffix(es), such as JR, SR, II, or III.",DGM("LENGTH"))
52 Q
53 ;
54DEGREE ;Name degree help text
55 S DGM("LENGTH")="1-10"
56 D HTEXT("academic degree, such as BS, BA, MD, or PHD.",DGM("LENGTH"))
57 Q
58 ;
59CVALID(DGC,DGX,DGM) ;Name component validation
60 ; Input: DGC=name component (e.g. FAMILY, GIVEN, etc.)
61 ; DGX=input value to validate
62 ; DGM=array to return results and errors (pass by reference)
63 ;
64 ;Output: DGM array in the format:
65 ; DGM("ERROR",n)=error text (if any)
66 ; DGM("HELP",n)=help text
67 ; DGM("LENGTH")=field length in length (e.g. 3-30)
68 ; DGM("RESULT")=transformed name value (null if invalid entry)
69 ;
70 N DGL,DGF,DGI,DGR,DGMSG
71 S DGF="FAMILY^GIVEN^MIDDLE^PREFIX^SUFFIX^DEGREE"
72 S DGF=$P(DGF,DGC),DGF=$L(DGF,U)
73 D @DGC ;Set up length and help text
74 S DGL=+$P(DGM("LENGTH"),"-")_U_+$P(DGM("LENGTH"),"-",2)
75 D CVALID^XLFNAME8(DGC,DGX,.DGM)
76 Q
77 ;
78HTEXT(DGF,DGL) ;Generic help text
79 ;Input: DGF=field name
80 ; DGL=field length
81 S DGM("HELP",1)="Answer with this persons "_DGF
82 S DGM("HELP",2)="The response must be "_DGL_" characters in length and may only contain"
83 S DGM("HELP",3)="uppercase alpha characters, spaces, hyphens and apostrophes."
84 Q
85 ;
86JUMP(DGI) ;Evaluate request to jump fields
87 N DGX,DGY S DGX=$P($E(X,2,99)," ")
88 I (U_DGCOM)'[(U_DGX) D Q
89 .W !,"While editing name components, only jumping to other components is allowed!",$C(7)
90 .Q
91 I (U_DGCOM_U)[(U_DGX_U) S DGI=$O(DGC(DGX,0)) Q
92 S DGI=$O(DGC($O(DGC(DGX)),0))
93 S DGY=$P(DGCOM,U,DGI)_$P(DGCX,U,DGI) W $P(DGY,DGX,2)
94 Q
95 ;
Note: See TracBrowser for help on using the repository browser.