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

XDRDADDS.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 2004-038, this routine should not be modified
  1. ADD(XDRSLT,XDRFL,XDRFR,XDRTO) ; Add a pair to the DUPLICATE RECORD file (#15)
  1. ; Called from REMOTE PROCEDURE - XDR ADD POTENTIAL PATIENT DUPS
  1. ; XDRSLT = OUTPUT results.
  1. ; set to DFN in file 15 if add was successful, -1^ERRMSG if error
  1. ; XDRFL = File number where duplicate records reside. If not passed, defaults to PATIENT file.
  1. ; XDRFR = From entry IEN (DFN if PATIENT file entry)
  1. ; XDRTO = To entry IEN (DFN if PATIENT file entry)
  1. ;
  1. K XDRSLT
  1. N XDRGBL,XDRPN1,XDRPN2,XDRI,XDRREC1,XDRREC2,XDRFDA,XDRIEN,XDRPN1,XDRPN2
  1. N XDRSSN1,XDRSSN2,X,X1,X2,X3,I
  1. ; Default file is PATIENT file.
  1. S XDRFL=+$G(XDRFL)
  1. S:'XDRFL XDRFL=2
  1. S XDRGBL=$G(^DIC(XDRFL,0,"GL"))
  1. I (XDRGBL="")!($G(^VA(15.1,XDRFL,0))="") D Q
  1. . S XDRSLT="-1^File number parameter missing or invalid" Q
  1. ; Check IENs to make sure they're valid
  1. S XDRFR=+$G(XDRFR),XDRTO=+$G(XDRTO)
  1. S XDRPN1=$P($G(@(XDRGBL_XDRFR_",0)")),U)
  1. I XDRPN1="" D Q
  1. . S XDRSLT="-1^First IEN input parameter invalid" Q
  1. S XDRPN2=$P($G(@(XDRGBL_XDRTO_",0)")),U)
  1. I XDRPN2="" D Q
  1. . S XDRSLT="-1^Second IEN input parameter invalid" Q
  1. ; If From and To Record pair are already on the Duplicate Record File save IEN and quit.
  1. S XDRSLT=0
  1. S XDRREC1=XDRFR_";"_$P(XDRGBL,U,2)
  1. S XDRREC2=XDRTO_";"_$P(XDRGBL,U,2)
  1. S X1=XDRREC1_U_XDRREC2,X2=XDRREC2_U_XDRREC1
  1. F I=0:0 S I=$O(^VA(15,"B",XDRREC1,I)) Q:I'>0 D Q:XDRSLT
  1. . S X3=$P($G(^VA(15,I,0)),U,1,2)
  1. . I X3'=X1,X3'=X2 Q
  1. . S XDRSLT=I
  1. . Q
  1. Q:XDRSLT
  1. ; If patients, get SSN
  1. S (XDRSSN1,XDRSSN2)=""
  1. I XDRFL=2 D
  1. . S X=$$GET1^DIQ(2,XDRFR_",",.09) S:X]"" XDRSSN1=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10)
  1. . S X=$$GET1^DIQ(2,XDRTO_",",.09) S:X]"" XDRSSN2=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10)
  1. . Q
  1. ; Add new record to DUPLICATE RECORD file.
  1. K XDRFDA,XDRIEN
  1. S XDRFDA(15,"+1,",.01)=XDRREC1
  1. S XDRFDA(15,"+1,",.02)=XDRREC2
  1. S XDRFDA(15,"+1,",.03)="P"
  1. S XDRFDA(15,"+1,",.06)=DT
  1. S XDRFDA(15,"+1,",.09)=.5
  1. F I=.15,.16,.17,.18,.19 S XDRFDA(15,"+1,",I)=0
  1. D UPDATE^DIE("","XDRFDA","XDRIEN")
  1. S I=+$O(XDRIEN(0)),I=$G(XDRIEN(I))
  1. I 'I D Q
  1. . S XDRSLT="-1^Error adding record to DUPLICATE RECORD file" Q
  1. S XDRSLT=I
  1. ; Send a notice to the DUPLICATE MANAGER MAIL GROUP if the
  1. ; SEND NEW DUP REC EMAIL field is not set to 1 (suppress). (XT*7.3*113)
  1. S X=$$GET1^DIQ(15.1,XDRFL_",",99,"I")
  1. Q:X=1
  1. D SENDMSG(XDRFL,XDRFR,XDRPN1,XDRSSN1,XDRTO,XDRPN2,XDRSSN2,XDRSLT)
  1. Q
  1. ;
  1. SENDMSG(XDRFL,XDRFR,XDRPN1,XDRSSN1,XDRTO,XDRPN2,XDRSSN2,XDRNEWR) ; Send email message
  1. N XDRGRP,XDRGRPN,XMY,XMTEXT,XMSUB,XMDUZ,XMDUN,XMZ,X,R
  1. ; Find DUPLICATE MANAGER MAIL GROUP on DUPLICATE RESOLUTION file.
  1. S XDRGRP=$$GET1^DIQ(15.1,"2,",.11,"I")
  1. S XDRGRPN=""
  1. S:XDRGRP>0 XDRGRPN=$$GET1^DIQ(3.8,XDRGRP,.01)
  1. I XDRGRPN]"" S XMY("G."_XDRGRPN)=""
  1. E S XMY(.5)="" ;If no mail grp found, send msg to postmaster
  1. S X="PATIENT" S:XDRFL'=2 X=$P($G(^DIC(XDRFL,0)),U)
  1. ; Build mail message
  1. S R(1)="The following two "_X_" records have been found to be potential duplicates"
  1. S R(2)="by the MPI matching algorithm. These records have been added to the local"
  1. S R(3)="DUPLICATE RECORD file and assigned record number "_XDRNEWR_"."
  1. S R(4)="Please review these records to verify whether they are duplicates"
  1. S R(5)="and if so merge using the DUPLICATE RECORD MERGE software."
  1. S R(6)=""
  1. S R(7)=" "_X_" 1: "_XDRPN1_" "_XDRSSN1_" (IEN #"_XDRFR_")"
  1. S R(8)=" "_X_" 2: "_XDRPN2_" "_XDRSSN2_" (IEN #"_XDRTO_")"
  1. S XMTEXT="R(",XMSUB="Potential Duplicate "_X_" records found by MPI",XMDUZ=.5
  1. D ^XMD
  1. Q
  1. ;
  1. ;