Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DPTNAME1

DPTNAME1.m

Go to the documentation of this file. 
  1. DPTNAME1 ;BPOIFO/KEITH - NAME STANDARDIZATION ; 12 Aug 2002@20:20
  1.  ;;5.3;Registration;**244,620,720**;Aug 13, 1993
  1.  ;
  1. NCEVAL(DGC,DGX) ;Evaluate name component entry values
  1.  ;Input: DGC=name component (e.g. FAMILY, GIVEN, etc.)
  1.  ;       DGX=input value for name
  1.  ;
  1.  Q:DGX="@"
  1.  N DGM,DGL,DGI
  1.  I DGX=""!($E(DGX)=U) Q
  1.  D CVALID(DGC,DGX,.DGM)
  1.  M DIR("?")=DGM("HELP") S DGI=$O(DIR("?",""),-1) I DGI D
  1.  .S DIR("?")=DIR("?",DGI) K DIR("?",DGI)
  1.  .Q
  1.  I "???"[DGX Q
  1.  I DGM("RESULT")="" D  Q
  1.  .S DGI="" F  S DGI=$O(DGM("ERROR",DGI)) Q:DGI=""  D
  1.  ..I DGM("ERROR",DGI)["''" S $P(DGM("ERROR",DGI),"'",2)=DGX
  1.  ..W:DGI=1 ! W !,DGM("ERROR",DGI)
  1.  ..Q
  1.  .K DGX
  1.  .Q
  1.  I DGM("RESULT")'=DGX W "   (",DGM("RESULT"),")"
  1.  S DGX=DGM("RESULT")
  1.  Q
  1.  ;
  1. FAMILY ;Family name help text
  1.  S DGM("LENGTH")="1-35"
  1.  D HTEXT("family (last) name.",DGM("LENGTH"))
  1.  S DGM("HELP",4)="Input values less than 3 characters in length must be all alpha characters."
  1.  Q
  1.  ;
  1. GIVEN ;Given name help text
  1.  S DGM("LENGTH")="1-25"
  1.  D HTEXT("given (first) name.",DGM("LENGTH"))
  1.  Q
  1.  ;
  1. MIDDLE ;Middle name help text
  1.  S DGM("LENGTH")="1-25"
  1.  D HTEXT("middle name.",DGM("LENGTH"))
  1.  S DGM("HELP",4)="Middle names of 'NMI' and 'NMN' are prohibited."
  1.  Q
  1.  ;
  1. PREFIX ;Name prefix help text
  1.  S DGM("LENGTH")="1-10"
  1.  D HTEXT("name prefix, such as MR or MS.",DGM("LENGTH"))
  1.  Q
  1.  ;
  1. SUFFIX ;Name suffix help text
  1.  S DGM("LENGTH")="1-10"
  1.  D HTEXT("suffix(es), such as JR, SR, II, or III.",DGM("LENGTH"))
  1.  Q
  1.  ;
  1. DEGREE ;Name degree help text
  1.  S DGM("LENGTH")="1-10"
  1.  D HTEXT("academic degree, such as BS, BA, MD, or PHD.",DGM("LENGTH"))
  1.  Q
  1.  ;
  1. CVALID(DGC,DGX,DGM) ;Name component validation
  1.  ; Input: DGC=name component (e.g. FAMILY, GIVEN, etc.)
  1.  ;        DGX=input value to validate
  1.  ;        DGM=array to return results and errors (pass by reference)
  1.  ;
  1.  ;Output: DGM array in the format:
  1.  ;       DGM("ERROR",n)=error text (if any) 
  1.  ;       DGM("HELP",n)=help text          
  1.  ;       DGM("LENGTH")=field length in length (e.g. 3-30) 
  1.  ;       DGM("RESULT")=transformed name value (null if invalid entry)
  1.  ; 
  1.  N DGL,DGF,DGI,DGR,DGMSG
  1.  S DGF="FAMILY^GIVEN^MIDDLE^PREFIX^SUFFIX^DEGREE"
  1.  S DGF=$P(DGF,DGC),DGF=$L(DGF,U)
  1.  D @DGC  ;Set up length and help text 
  1.  S DGL=+$P(DGM("LENGTH"),"-")_U_+$P(DGM("LENGTH"),"-",2)
  1.  D CVALID^XLFNAME8(DGC,DGX,.DGM)
  1.  Q
  1.  ;
  1. HTEXT(DGF,DGL) ;Generic help text
  1.  ;Input: DGF=field name
  1.  ;       DGL=field length
  1.  S DGM("HELP",1)="Answer with this persons "_DGF
  1.  S DGM("HELP",2)="The response must be "_DGL_" characters in length and may only contain"
  1.  S DGM("HELP",3)="uppercase alpha characters, spaces, hyphens and apostrophes."
  1.  Q
  1.  ;
  1. JUMP(DGI) ;Evaluate request to jump fields
  1.  N DGX,DGY S DGX=$P($E(X,2,99)," ")
  1.  I (U_DGCOM)'[(U_DGX) D  Q
  1.  .W !,"While editing name components, only jumping to other components is allowed!",$C(7)
  1.  .Q
  1.  I (U_DGCOM_U)[(U_DGX_U) S DGI=$O(DGC(DGX,0)) Q
  1.  S DGI=$O(DGC($O(DGC(DGX)),0))
  1.  S DGY=$P(DGCOM,U,DGI)_$P(DGCX,U,DGI) W $P(DGY,DGX,2)
  1.  Q
  1.  ;