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

DG53244U.m

Go to the documentation of this file. 
  1. DG53244U ;ALB/JDS,BPOIFO/KEITH - Patient Name Standardization ; 27 Jan 2002 11:55 PM
  1.  ;;5.3;Registration;**244,620,1015**;Aug 13, 1993;Build 21
  1.  ;Adapted from XLFNAME3 MKO
  1. RUN(DGFLAG) ;Convert PATIENT file names;
  1.  ;In: DGFLAG [ "U"  : Quit, use existing global
  1.  ;           [ "K"  : Kill ^XTMP. generate global 
  1.  ;           [ "P"  : Kill ^XTMP, update names, generate global
  1.  ;
  1.  ;Use existing global to print
  1.  Q:DGFLAG="U"
  1.  ;
  1.  N DGIENS,DGNAM,DGNMSP,DGPVAL,DPTINV,DGQ,DGTOTAL,DGOUT,DGNCMG,DGNOFDEL
  1.  N DGA,DGI,DPTFIL,DPTFLD,DPTIENS,DGFIELD,DGTYPE,DPTA,DPTI,VAFHCA08,DGZ
  1.  N DPTVALUE,DGTEXT,VAFCA08,VAFCNO,DGENUPLD,DPTFN,DGPRUN,DGXRARY,DGMPI
  1.  N DGICN
  1.  ;Initialize variables
  1.  S DGNMSP="DPTNAME",DGQ="""",DGOUT=0
  1.  F DGI=1:1 S DGA=$T(FIELD+DGI) Q:(DGA'[";;")  D
  1.  .S DGFIELD(DGI,$P($P(DGA,";;",2),U,3))=$P(DGA,";;",2) Q
  1.  D XRARY^DG53244V
  1.  ;Set up ^XTMP
  1.  I '$G(^XTMP(DGNMSP,0,0)) D
  1.  .K ^XTMP(DGNMSP)
  1.  .S ^XTMP(DGNMSP,0)=$$FMADD^XLFDT(DT,90)_"^"_DT
  1.  .I DGFLAG="P" D
  1.  ..S ^XTMP(DGNMSP,0,0)=$$NOW^XLFDT(),$P(^XTMP(DGNMSP,0),U,4)=0
  1.  ..S $P(^XTMP(DGNMSP,0),U,3)="Perform Name Conversion"
  1.  ..Q
  1.  .I DGFLAG="K" S $P(^XTMP(DGNMSP,0),U,3)="Generate Report Data"
  1.  .I '$D(^XTMP(DGNMSP,"STATS")) D
  1.  ..S $P(^XTMP(DGNMSP,"STATS",2,.01),U,7)="Patient name"
  1.  ..S $P(^XTMP(DGNMSP,"STATS",2,.211),U,7)="Primary NOK name"
  1.  ..S $P(^XTMP(DGNMSP,"STATS",2,.2191),U,7)="Secondary NOK name"
  1.  ..S $P(^XTMP(DGNMSP,"STATS",2,.2401),U,7)="Father's name"
  1.  ..S $P(^XTMP(DGNMSP,"STATS",2,.2402),U,7)="Mother's name"
  1.  ..S $P(^XTMP(DGNMSP,"STATS",2,.2403),U,7)="Mother's maiden name"
  1.  ..S $P(^XTMP(DGNMSP,"STATS",2,.331),U,7)="Prim. E-contact name"
  1.  ..S $P(^XTMP(DGNMSP,"STATS",2,.3311),U,7)="2nd E-contact name"
  1.  ..S $P(^XTMP(DGNMSP,"STATS",2,.341),U,7)="Designee name"
  1.  ..S $P(^XTMP(DGNMSP,"STATS",2.01,.01),U,7)="Alias name"
  1.  ..S $P(^XTMP(DGNMSP,"STATS",2.101,30),U,7)="Attorney's name"
  1.  I DGFLAG="P" D
  1.  .S $P(^XTMP(DGNMSP,0),U)=$$FMADD^XLFDT(DT,90)
  1.  .S $P(^XTMP(DGNMSP,0),U,5)="RUN"
  1.  .S DGPRUN=$O(^XTMP(DGNMSP,0,""),-1)+1
  1.  .S ^XTMP(DGNMSP,0,DGPRUN)=$$NOW^XLFDT()_"^^"_+$P($G(^XTMP(DGNMSP,"STATS")),U)
  1.  .D MGOUT^DG53244T(.DGNCMG)  ;Remove name change mail group
  1.  .Q
  1.  ;
  1.  ;Prevent messages to HEC
  1.  S DGENUPLD="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS"
  1.  S VAFCNO=1  ;Prevent MPI messages
  1.  S (VAFCA08,VAFHCA08)=1  ;Prevent PIMS Generic Messaging
  1.  S DGNOFDEL=1  ;Prevent deletion of contact address fields
  1.  ;
  1. LOOP ;Loop through Patient file
  1.  S DGIEN=+$P(^XTMP(DGNMSP,0),U,4)
  1.  F  S DGIEN=$O(^DPT(DGIEN)) Q:'DGIEN!$$LAST()  D
  1.  .;Skip merging patients
  1.  .Q:$P($G(^DPT(DGIEN,0)),U)["MERGING INTO"
  1.  .;Skip patients that have been merged to another record
  1.  .Q:$D(^DPT(DGIEN,-9))
  1.  .;Evaluate field values
  1.  .S DGIENS=DGIEN_",",DGMPI=0
  1.  .S DGZ=0 F  S DGZ=$O(DGFIELD(DGZ)) Q:'DGZ  D
  1.  ..S DPTA=""  F  S DPTA=$O(DGFIELD(DGZ,DPTA)) Q:DPTA=""  D
  1.  ...Q:'$D(^DPT(DGIEN,$P(DPTA,";")))
  1.  ...S DGTYPE=DGFIELD(DGZ,DPTA),DPTFLD=$P(DGTYPE,U,2)
  1.  ...S DPTMAX=$P(DGTYPE,U,5) S:'DPTMAX DPTMAX=35
  1.  ...I $L(DPTA,";")=3 D  Q
  1.  ....F DPTI=0:0 S DPTI=$O(^DPT(DGIEN,$P(DPTA,";"),DPTI)) Q:'DPTI  D
  1.  .....S DPTIENS=DGIEN_","_DPTI_",",DPTFIL=$P(DGTYPE,U,6)
  1.  .....S DPTVALUE=$P($G(^DPT(DGIEN,$P(DPTA,";"),DPTI,$P(DPTA,";",2))),U,$P(DPTA,";",3))
  1.  .....Q:'$L(DPTVALUE)
  1.  .....D UPDATE(DGFLAG,DPTFIL,DPTIENS,DPTFLD,DPTVALUE,DGNMSP,DPTMAX,DPTA)
  1.  ...S DPTIENS=DGIEN_",",DPTFIL=2
  1.  ...S DPTVALUE=$P($G(^DPT(DGIEN,$P(DPTA,";"))),U,$P(DPTA,";",2))
  1.  ...Q:'$L(DPTVALUE)
  1.  ...D UPDATE(DGFLAG,DPTFIL,DPTIENS,DPTFLD,DPTVALUE,DGNMSP,DPTMAX,DPTA,.DGMPI)
  1.  ..S $P(^XTMP(DGNMSP,0),U,4)=DGIEN
  1.  .I DGMPI D  ;Send MPI message
  1.  ..D RMPI(1) S DGICN=$$GETICN^MPIF001(DGIEN)
  1.  ..;No ICN, don't send message
  1.  ..I +DGICN=-1 S DGICN=0 D RMPI(2)
  1.  ..;Local ICN, don't send message
  1.  ..I $P($$SITE^VASITE(),"^",3)=$E(DGICN,1,3) S DGICN=0 D RMPI(3)
  1.  ..I DGICN'=0 N X S X="MPIFA31B" X ^%ZOSF("TEST") D RMPI(4) I $T S DGMPI=$$A31^MPIFA31B(DGIEN) D RMPI(5,DGMPI)
  1.  ..;Log exception to MPI if problem generating ICN
  1.  ..I +DGMPI=-1 D RMPI(6),START^RGHLLOG(),EXC^RGHLLOG(220,"Problem generating A31 "_$P(DGMPI,"^",2),DGIEN),STOP^RGHLLOG()
  1.  ;Send notification message
  1.  Q:DGFLAG'="P"
  1.  D MGIN^DG53244T(DGNCMG)  ;Replace name change mail group
  1.  I 'DGIEN,'DGOUT S $P(^XTMP(DGNMSP,0,0),U,2)=$$NOW^XLFDT()
  1.  S $P(^XTMP(DGNMSP,0,DGPRUN),U,2)=$$NOW^XLFDT()
  1.  S $P(^XTMP(DGNMSP,0,DGPRUN),U,4)=+$P(^XTMP(DGNMSP,"STATS"),U)
  1.  S $P(^XTMP(DGNMSP,0),U,5)="STOP"
  1. MSG K DGTEXT
  1.  N XMY,XMTEXT,XMDUN,XMDUZ,XMSUB,XMZ,DGLINE
  1.  S DGLINE="",$P(DGLINE,"-",80)=""
  1.  S XMSUB="Patient Name Conversion Process"
  1.  S XMY("G.PMSTRACK@FORUM.VA.GOV")=""
  1.  S XMY(+$G(DUZ))="",(XMDUN,XMDUZ)="Patch DG*5.3*244"
  1.  S DGTEXT(1,0)="The Patient Name Standardization conversion has completed" S DGTEXT=1
  1.  I DGOUT D
  1.  .S DGTEXT(1,0)="The Patient Name Standardization was Stopped"
  1.  .S DGTEXT(2,0)="Please remember to complete the patient name conversion in the future."
  1.  .S DGTEXT=2
  1.  S DGOUT=0 D STATS^DG53244V(.DGTEXT)
  1.  S XMTEXT="DGTEXT("
  1.  D ^XMD
  1.  Q
  1.  ;
  1. UPDATE(DGFLAG,DGFIL,DGIENS,DGFLD,DGNAM,DGNMSP,DPTMAX,DPTA,DGMPI) ;Process name field
  1.  ;
  1.  N DGAUD,DGFDA,DGMSG,DIERR,DGOLD
  1.  ;Total names evaluated
  1.  S $P(^XTMP(DGNMSP,"STATS"),U)=$P($G(^XTMP(DGNMSP,"STATS")),U)+1
  1.  ;Total evaluated by field
  1.  S $P(^XTMP(DGNMSP,"STATS",DGFIL,DGFLD),U)=$P($G(^XTMP(DGNMSP,"STATS",DGFIL,DGFLD)),U)+1
  1.  ;Format name
  1.  S DGOLD=$G(DGNAM)
  1.  S DGNAM=$$FORMAT^XLFNAME7(.DGNAM,3,DPTMAX,,2,.DGAUD,$S(DGFLD=.2403:1,1:0))
  1.  D:(DGAUD'=0) RECORD(DGFIL,DGFLD,DGIENS,DGNAM,.DGAUD,DGNMSP,DGIEN,DGOLD)
  1.  Q:DGFLAG'="P"  ;Processing only
  1.  Q:DGAUD=2  ;Unconvertible
  1.  ;Update components if name is not changed
  1.  I DGAUD=0 D  Q
  1.  .N DGI,DA,X,DG20NAME,XUNOTRIG
  1.  .F DGI=2.1,1.1 D
  1.  ..S:(DGFIL=2) DA=DGIEN S:(DGFIL'=2) DA(1)=DGIEN,DA=$P(DGIENS,",",2)
  1.  ..S X=DGNAM X DGXRARY($P(DGFIELD(DGZ,DPTA),U,7),DGI)
  1.  ..Q
  1.  .Q
  1.  ;Update source name if different
  1.  S DPTINV=$TR($$INV(DGIENS),":",",")_","
  1.  S DGFDA(DGFIL,DPTINV,DGFLD)=DGNAM
  1.  D FILE^DIE("","DGFDA","DGMSG") K DIERR,DGMSG
  1.  ;Changes of interest to MPI
  1.  I DGAUD=1,DGFIL=2 D
  1.  .I DGFLD=.01 S DGMPI=1
  1.  .I DGFLD=.2403,DGOLD_","'=DGNAM S DGMPI=1
  1.  Q
  1.  ;
  1. LAST() ;Check stop point
  1.  I $P(^XTMP(DGNMSP,0),U,5)="STOP" S DGOUT=1 Q DGOUT
  1.  I $G(DGLIM)="SR",DGIEN>DGLIM(DGLIM) S DGOUT=1 Q DGOUT
  1.  I DGIEN#100=0 D
  1.  .I $G(DGLIM)="SD",$$NOW^XLFDT()>DGLIM(DGLIM) S DGOUT=1 Q
  1.  .D STOP^DG53244V
  1.  Q DGOUT
  1.  ;
  1. RECORD(DGFIL,DGFLD,DGREC,DGNAM,DGAUD,DGNMSP,DGIEN,DGOLD) ;file changes in ^XTMP
  1.  ;^XTMP global format:
  1.  ;^XTMP("DPTNAME",0)=purge_date^date_created^process^last_ien^
  1.  ;                   stop_flag^name_change_mail_group
  1.  ;^XTMP("DPTNAME",0,0)=conversion_start^conversion_end
  1.  ;^XTMP("DPTNAME",0,n)=conversion_start^conversion_end^
  1.  ;                     pts_evaluated_start^pts_evaluated_end
  1.  ;^XTMP("DPTNAME",DFN,FILE,IFN,FIELD)=old_value^new_value^change_types
  1.  ;^XTMP("DPTNAME",DFN,"MPI")=1^1^1^1^1^1 (status of MPI messaging)
  1.  ;^XTMP("DPTNAME",DFN,"MPI","A31")=the result of call to $$A31^MPIFA31B
  1.  ;^XTMP("DPTNAME","STATS")=names_evaluated^pts_w/changes^total_changes^
  1.  ;                         type1_changes^type2_changes^type3_changes^
  1.  ;                         type4_changes
  1.  ;^XTMP("DPTNAME","STATS",FILE,FIELD)=total_evaluated^total_changed^
  1.  ;                               type1_changes^type2_changes^
  1.  ;                               type3_changes^type4_changes
  1.  ;^XTMP("DPTNAME","B",NAME)=dfn
  1.  ;
  1.  ;Data change types: 1=name contains no comma
  1.  ;                   2=parenthetical text is removed
  1.  ;                   3=value could not be converted
  1.  ;                   4=characters are removed or changed
  1.  ;
  1.  N DGIENS,DGIEN2,DGTSTR,DGI,DGN S DGTSTR=""
  1.  S DGIEN2=$S($P(DGREC,",",2):$P(DGREC,",",2),1:DGIEN)
  1.  ;Record values
  1.  F DGI=1:1:4 I $D(DGAUD(DGI)) D
  1.  .S DGTSTR=DGTSTR_DGI
  1.  .;Field changes by type
  1.  .S $P(^XTMP(DGNMSP,"STATS",DGFIL,DGFLD),U,(DGI+2))=$P($G(^XTMP(DGNMSP,"STATS",DGFIL,DGFLD)),U,(DGI+2))+1
  1.  .;Total changes by type
  1.  .S $P(^XTMP(DGNMSP,"STATS"),U,(DGI+3))=$P($G(^XTMP(DGNMSP,"STATS")),U,(DGI+3))+1
  1.  .Q
  1.  ;Total patients with changes
  1.  I '$D(^XTMP(DGNMSP,DGIEN)) S $P(^XTMP(DGNMSP,"STATS"),U,2)=$P($G(^XTMP(DGNMSP,"STATS")),U,2)+1
  1.  ;Total fields with changes
  1.  S $P(^XTMP(DGNMSP,"STATS"),U,3)=$P($G(^XTMP(DGNMSP,"STATS")),U,3)+1
  1.  ;Total changes by field
  1.  S $P(^XTMP(DGNMSP,"STATS",DGFIL,DGFLD),U,2)=$P($G(^XTMP(DGNMSP,"STATS",DGFIL,DGFLD)),U,2)+1
  1.  ;PATIENT field name change and types
  1.  S ^XTMP(DGNMSP,DGIEN,DGFIL,DGIEN2,DGFLD)=DGOLD_U_DGNAM_U_DGTSTR
  1.  ;Name x-ref
  1.  S DGN=$P($G(^DPT(DGIEN,0)),U) S:DGN="" DGN=" "
  1.  S ^XTMP(DGNMSP,"B",DGN,DGIEN)=""
  1.  Q
  1.  ;
  1. RMPI(DGP,DGMPI) ;Record MPI notification status
  1.  S $P(^XTMP("DPTNAME",DGIEN,"MPI"),U,DGP)=1
  1.  Q:'$D(DGMPI)  S ^XTMP("DPTNAME",DGIEN,"MPI","A31")=DGMPI
  1.  Q
  1.  ;
  1. INV(DGIENS) ;Invert the IENS
  1.  N DGI,DGX
  1.  Q:DGIENS?."," ""
  1.  S:DGIENS'?.E1"," DGIENS=DGIENS_","
  1.  S DGX="" F DGI=$L(DGIENS,",")-1:-1:1 S DGX=DGX_$P(DGIENS,",",DGI)_":"
  1.  S:DGX?.E1":" DGX=$E(DGX,1,$L(DGX)-1)
  1.  Q DGX
  1.  ;
  1. FIELD ;;
  1.  ;;NAME^.01^0;1^1.01^30^^ANAM01
  1.  ;;K-NAME^.211^.21;1^1.02^^^ANAM211
  1.  ;;K2-NAME^.2191^.211;1^1.03^^^ANAM2191
  1.  ;;FATHER'S NAME^.2401^.24;1^1.04^^^ANAM2401
  1.  ;;MOTHER'S NAME^.2402^.24;2^1.05^^^ANAM2402
  1.  ;;MOTHER'S MAIDEN^.2403^.24;3^1.06^^^ANAM2403
  1.  ;;E-NAME^.331^.33;1^1.07^^^ANAM331
  1.  ;;E2-NAME^.3311^.331;1^1.08^^^ANAM3311
  1.  ;;D NAME^.341^.34;1^1.09^^^ANAM341
  1.  ;;ALIAS^.01^.01;0;1^100.03^30^2.01^ANAM201
  1.  ;;ATTORNEY^30^DIS;3;1^100.21^30^2.101^ANAM1001