XDRDADDS ;SF-IRMFO/TKW - SILENT API TO ADD POTENTIAL DUPLICATE PAIR TO FILE 15 ;9/22/08 11:27
;;7.3;TOOLKIT;**113,124**;Apr 25, 1995;Build 8
;;Per VHA Directive 2004-038, this routine should not be modified
ADD(XDRSLT,XDRFL,XDRFR,XDRTO) ; Add a pair to the DUPLICATE RECORD file (#15)
; Called from REMOTE PROCEDURE - XDR ADD POTENTIAL PATIENT DUPS
; XDRSLT = OUTPUT results.
; set to DFN in file 15 if add was successful, -1^ERRMSG if error
; XDRFL = File number where duplicate records reside. If not passed, defaults to PATIENT file.
; XDRFR = From entry IEN (DFN if PATIENT file entry)
; XDRTO = To entry IEN (DFN if PATIENT file entry)
;
K XDRSLT
N XDRGBL,XDRPN1,XDRPN2,XDRI,XDRREC1,XDRREC2,XDRFDA,XDRIEN,XDRPN1,XDRPN2
N XDRSSN1,XDRSSN2,X,X1,X2,X3,I
; Default file is PATIENT file.
S XDRFL=+$G(XDRFL)
S:'XDRFL XDRFL=2
S XDRGBL=$G(^DIC(XDRFL,0,"GL"))
I (XDRGBL="")!($G(^VA(15.1,XDRFL,0))="") D Q
. S XDRSLT="-1^File number parameter missing or invalid" Q
; Check IENs to make sure they're valid
S XDRFR=+$G(XDRFR),XDRTO=+$G(XDRTO)
S XDRPN1=$P($G(@(XDRGBL_XDRFR_",0)")),U)
I XDRPN1="" D Q
. S XDRSLT="-1^First IEN input parameter invalid" Q
S XDRPN2=$P($G(@(XDRGBL_XDRTO_",0)")),U)
I XDRPN2="" D Q
. S XDRSLT="-1^Second IEN input parameter invalid" Q
; If From and To Record pair are already on the Duplicate Record File save IEN and quit.
S XDRSLT=0
S XDRREC1=XDRFR_";"_$P(XDRGBL,U,2)
S XDRREC2=XDRTO_";"_$P(XDRGBL,U,2)
S X1=XDRREC1_U_XDRREC2,X2=XDRREC2_U_XDRREC1
F I=0:0 S I=$O(^VA(15,"B",XDRREC1,I)) Q:I'>0 D Q:XDRSLT
. S X3=$P($G(^VA(15,I,0)),U,1,2)
. I X3'=X1,X3'=X2 Q
. S XDRSLT=I
. Q
Q:XDRSLT
; If patients, get SSN
S (XDRSSN1,XDRSSN2)=""
I XDRFL=2 D
. S X=$$GET1^DIQ(2,XDRFR_",",.09) S:X]"" XDRSSN1=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10)
. S X=$$GET1^DIQ(2,XDRTO_",",.09) S:X]"" XDRSSN2=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10)
. Q
; Add new record to DUPLICATE RECORD file.
K XDRFDA,XDRIEN
S XDRFDA(15,"+1,",.01)=XDRREC1
S XDRFDA(15,"+1,",.02)=XDRREC2
S XDRFDA(15,"+1,",.03)="P"
S XDRFDA(15,"+1,",.06)=DT
S XDRFDA(15,"+1,",.09)=.5
F I=.15,.16,.17,.18,.19 S XDRFDA(15,"+1,",I)=0
D UPDATE^DIE("","XDRFDA","XDRIEN")
S I=+$O(XDRIEN(0)),I=$G(XDRIEN(I))
I 'I D Q
. S XDRSLT="-1^Error adding record to DUPLICATE RECORD file" Q
S XDRSLT=I
; Send a notice to the DUPLICATE MANAGER MAIL GROUP if the
; SEND NEW DUP REC EMAIL field is not set to 1 (suppress). (XT*7.3*113)
S X=$$GET1^DIQ(15.1,XDRFL_",",99,"I")
Q:X=1
D SENDMSG(XDRFL,XDRFR,XDRPN1,XDRSSN1,XDRTO,XDRPN2,XDRSSN2,XDRSLT)
Q
;
SENDMSG(XDRFL,XDRFR,XDRPN1,XDRSSN1,XDRTO,XDRPN2,XDRSSN2,XDRNEWR) ; Send email message
N XDRGRP,XDRGRPN,XMY,XMTEXT,XMSUB,XMDUZ,XMDUN,XMZ,X,R
; Find DUPLICATE MANAGER MAIL GROUP on DUPLICATE RESOLUTION file.
S XDRGRP=$$GET1^DIQ(15.1,"2,",.11,"I")
S XDRGRPN=""
S:XDRGRP>0 XDRGRPN=$$GET1^DIQ(3.8,XDRGRP,.01)
I XDRGRPN]"" S XMY("G."_XDRGRPN)=""
E S XMY(.5)="" ;If no mail grp found, send msg to postmaster
S X="PATIENT" S:XDRFL'=2 X=$P($G(^DIC(XDRFL,0)),U)
; Build mail message
S R(1)="The following two "_X_" records have been found to be potential duplicates"
S R(2)="by the MPI matching algorithm. These records have been added to the local"
S R(3)="DUPLICATE RECORD file and assigned record number "_XDRNEWR_"."
S R(4)="Please review these records to verify whether they are duplicates"
S R(5)="and if so merge using the DUPLICATE RECORD MERGE software."
S R(6)=""
S R(7)=" "_X_" 1: "_XDRPN1_" "_XDRSSN1_" (IEN #"_XDRFR_")"
S R(8)=" "_X_" 2: "_XDRPN2_" "_XDRSSN2_" (IEN #"_XDRTO_")"
S XMTEXT="R(",XMSUB="Potential Duplicate "_X_" records found by MPI",XMDUZ=.5
D ^XMD
Q
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRDADDS 3756 printed Apr 09, 2024@21:43:39 Page 2
XDRDADDS ;SF-IRMFO/TKW - SILENT API TO ADD POTENTIAL DUPLICATE PAIR TO FILE 15 ;9/22/08 11:27
+1 ;;7.3;TOOLKIT;**113,124**;Apr 25, 1995;Build 8
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
ADD(XDRSLT,XDRFL,XDRFR,XDRTO) ; Add a pair to the DUPLICATE RECORD file (#15)
+1 ; Called from REMOTE PROCEDURE - XDR ADD POTENTIAL PATIENT DUPS
+2 ; XDRSLT = OUTPUT results.
+3 ; set to DFN in file 15 if add was successful, -1^ERRMSG if error
+4 ; XDRFL = File number where duplicate records reside. If not passed, defaults to PATIENT file.
+5 ; XDRFR = From entry IEN (DFN if PATIENT file entry)
+6 ; XDRTO = To entry IEN (DFN if PATIENT file entry)
+7 ;
+8 KILL XDRSLT
+9 NEW XDRGBL,XDRPN1,XDRPN2,XDRI,XDRREC1,XDRREC2,XDRFDA,XDRIEN,XDRPN1,XDRPN2
+10 NEW XDRSSN1,XDRSSN2,X,X1,X2,X3,I
+11 ; Default file is PATIENT file.
+12 SET XDRFL=+$GET(XDRFL)
+13 if 'XDRFL
SET XDRFL=2
+14 SET XDRGBL=$GET(^DIC(XDRFL,0,"GL"))
+15 IF (XDRGBL="")!($GET(^VA(15.1,XDRFL,0))="")
Begin DoDot:1
+16 SET XDRSLT="-1^File number parameter missing or invalid"
QUIT
End DoDot:1
QUIT
+17 ; Check IENs to make sure they're valid
+18 SET XDRFR=+$GET(XDRFR)
SET XDRTO=+$GET(XDRTO)
+19 SET XDRPN1=$PIECE($GET(@(XDRGBL_XDRFR_",0)")),U)
+20 IF XDRPN1=""
Begin DoDot:1
+21 SET XDRSLT="-1^First IEN input parameter invalid"
QUIT
End DoDot:1
QUIT
+22 SET XDRPN2=$PIECE($GET(@(XDRGBL_XDRTO_",0)")),U)
+23 IF XDRPN2=""
Begin DoDot:1
+24 SET XDRSLT="-1^Second IEN input parameter invalid"
QUIT
End DoDot:1
QUIT
+25 ; If From and To Record pair are already on the Duplicate Record File save IEN and quit.
+26 SET XDRSLT=0
+27 SET XDRREC1=XDRFR_";"_$PIECE(XDRGBL,U,2)
+28 SET XDRREC2=XDRTO_";"_$PIECE(XDRGBL,U,2)
+29 SET X1=XDRREC1_U_XDRREC2
SET X2=XDRREC2_U_XDRREC1
+30 FOR I=0:0
SET I=$ORDER(^VA(15,"B",XDRREC1,I))
if I'>0
QUIT
Begin DoDot:1
+31 SET X3=$PIECE($GET(^VA(15,I,0)),U,1,2)
+32 IF X3'=X1
IF X3'=X2
QUIT
+33 SET XDRSLT=I
+34 QUIT
End DoDot:1
if XDRSLT
QUIT
+35 if XDRSLT
QUIT
+36 ; If patients, get SSN
+37 SET (XDRSSN1,XDRSSN2)=""
+38 IF XDRFL=2
Begin DoDot:1
+39 SET X=$$GET1^DIQ(2,XDRFR_",",.09)
if X]""
SET XDRSSN1=$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,10)
+40 SET X=$$GET1^DIQ(2,XDRTO_",",.09)
if X]""
SET XDRSSN2=$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,10)
+41 QUIT
End DoDot:1
+42 ; Add new record to DUPLICATE RECORD file.
+43 KILL XDRFDA,XDRIEN
+44 SET XDRFDA(15,"+1,",.01)=XDRREC1
+45 SET XDRFDA(15,"+1,",.02)=XDRREC2
+46 SET XDRFDA(15,"+1,",.03)="P"
+47 SET XDRFDA(15,"+1,",.06)=DT
+48 SET XDRFDA(15,"+1,",.09)=.5
+49 FOR I=.15,.16,.17,.18,.19
SET XDRFDA(15,"+1,",I)=0
+50 DO UPDATE^DIE("","XDRFDA","XDRIEN")
+51 SET I=+$ORDER(XDRIEN(0))
SET I=$GET(XDRIEN(I))
+52 IF 'I
Begin DoDot:1
+53 SET XDRSLT="-1^Error adding record to DUPLICATE RECORD file"
QUIT
End DoDot:1
QUIT
+54 SET XDRSLT=I
+55 ; Send a notice to the DUPLICATE MANAGER MAIL GROUP if the
+56 ; SEND NEW DUP REC EMAIL field is not set to 1 (suppress). (XT*7.3*113)
+57 SET X=$$GET1^DIQ(15.1,XDRFL_",",99,"I")
+58 if X=1
QUIT
+59 DO SENDMSG(XDRFL,XDRFR,XDRPN1,XDRSSN1,XDRTO,XDRPN2,XDRSSN2,XDRSLT)
+60 QUIT
+61 ;
SENDMSG(XDRFL,XDRFR,XDRPN1,XDRSSN1,XDRTO,XDRPN2,XDRSSN2,XDRNEWR) ; Send email message
+1 NEW XDRGRP,XDRGRPN,XMY,XMTEXT,XMSUB,XMDUZ,XMDUN,XMZ,X,R
+2 ; Find DUPLICATE MANAGER MAIL GROUP on DUPLICATE RESOLUTION file.
+3 SET XDRGRP=$$GET1^DIQ(15.1,"2,",.11,"I")
+4 SET XDRGRPN=""
+5 if XDRGRP>0
SET XDRGRPN=$$GET1^DIQ(3.8,XDRGRP,.01)
+6 IF XDRGRPN]""
SET XMY("G."_XDRGRPN)=""
+7 ;If no mail grp found, send msg to postmaster
IF '$TEST
SET XMY(.5)=""
+8 SET X="PATIENT"
if XDRFL'=2
SET X=$PIECE($GET(^DIC(XDRFL,0)),U)
+9 ; Build mail message
+10 SET R(1)="The following two "_X_" records have been found to be potential duplicates"
+11 SET R(2)="by the MPI matching algorithm. These records have been added to the local"
+12 SET R(3)="DUPLICATE RECORD file and assigned record number "_XDRNEWR_"."
+13 SET R(4)="Please review these records to verify whether they are duplicates"
+14 SET R(5)="and if so merge using the DUPLICATE RECORD MERGE software."
+15 SET R(6)=""
+16 SET R(7)=" "_X_" 1: "_XDRPN1_" "_XDRSSN1_" (IEN #"_XDRFR_")"
+17 SET R(8)=" "_X_" 2: "_XDRPN2_" "_XDRSSN2_" (IEN #"_XDRTO_")"
+18 SET XMTEXT="R("
SET XMSUB="Potential Duplicate "_X_" records found by MPI"
SET XMDUZ=.5
+19 DO ^XMD
+20 QUIT
+21 ;
+22 ;
