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