- 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 Feb 19, 2025@00:05:24 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 ;