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

XDRRMRG1.m

Go to the documentation of this file.
  1. XDRRMRG1 ;SF-IRMFO.SEA/JLI - DUP VERIFICATION FOR ANCILLARY SERVICES ;10/21/2010
  1. ;;7.3;TOOLKIT;**23,29,46,47,49,126**;Apr 25, 1995;Build 2
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. EN ;
  1. I '$D(XQADATA) Q
  1. N OVERWRIT,XDRDA,DFNFR,DFNTO,DFNFRX,DFNTOX,REVIEW,XDRGL,PRIFILE ; MODIFIED 03/28/00
  1. S REVIEW=0
  1. S XDRGL=$P($P($G(^VA(15,+XQADATA,0)),U),";",2) Q:XDRGL="" S XDRGL=U_XDRGL S PRIFILE=+$P(@(XDRGL_"0)"),U,2) ; MODIFIED 03/28/00
  1. S XDRDA=$P(XQADATA,U)
  1. S DFNFR=$P(XQADATA,U,2)
  1. S (DFNTOX,DFNTO)=$P(DFNFR,";",2)
  1. S (DFNFRX,DFNFR)=$P(DFNFR,";")
  1. S PACKAGE=$P(XQADATA,U,3)
  1. S SUBFILES=$P(XQADATA,U,5)
  1. S SUBNAMES=$P(XQADATA,U,6)
  1. S XDRFILE=$P(XQADATA,U,4)
  1. S FILEDIC=^DIC(XDRFILE,0,"GL")_"DFN)"
  1. I XDRGL="^DPT(" D
  1. . S DFN=DFNFR D ^VADPT M DFNFR=VADM K VA,VADM
  1. . S DFN=DFNTO D ^VADPT M DFNTO=VADM K VA,VADM
  1. I XDRFILE=63 D
  1. . S DFNFR=$G(^DPT(DFNFR,"LR"))
  1. . S DFNTO=$G(^DPT(DFNTO,"LR"))
  1. I DFNFR'>0!(DFNTO'>0) W !,$C(7),"NO DATA TO REVIEW....",!! Q
  1. LDATE F XDRI=1,2 S DFN=$S(XDRI=1:DFNFR,1:DFNTO) S DFNNAM=$S(XDRI=1:"DFNFR",1:"DFNTO") D
  1. . S I=5 F S I=$O(@DFNNAM@(I)) Q:I="" K @DFNNAM@(I)
  1. . F ISUBS=1:1 S SUBSCR=$P(SUBFILES,";",ISUBS) Q:SUBSCR="" D
  1. . . S XX=$G(^DD(XDRFILE,SUBSCR,0))
  1. . . I $P(XX,U,2)'["D" Q
  1. . . I $P($P(XX,U,4),";",2)'=0 Q
  1. . . S SUBSCR=$P($P(XX,U,4),";")
  1. . . N XDAT1 S XDAT1=0
  1. . . I DFN>0 F I=0:0 S I=$O(@FILEDIC@(SUBSCR,I)) Q:I'>0 D
  1. . . . S X=$P($G(@FILEDIC@(SUBSCR,I,0)),U)
  1. . . . I X<DT,X>XDAT1 S XDAT1=X
  1. . . S LASTNAM="LAST "_$P(SUBNAMES,";",ISUBS)
  1. . . S @DFNNAM@(LASTNAM)=""
  1. . . I XDAT1>0 S @DFNNAM@(LASTNAM)=$$FMTE^XLFDT(XDAT1\1)
  1. . I @DFNNAM'="",'$D(@FILEDIC) S @DFNNAM=""
  1. D SHOW
  1. S:XDRFILE'=63 DFNFR=DFNFRX,DFNTO=DFNTOX ;REM - LAB is handled differently
  1. I IOST'["C-" Q
  1. D CHK
  1. Q
  1. ;
  1. SHOW ;
  1. N NAMIEN1,NAMIEN2
  1. S N1=$$COUNT^XDRRMRG2(XDRFILE,DFNFRX,DFNTOX)
  1. W @IOF I N1>0,PACKAGE="PRIMARY" W !," RECORD"_N1_" contains fewer data elements, usually this would indicate",!," that this record would be merged INTO the other."
  1. ;S LABEL(1)="NAME",LABEL(2)="SSN",LABEL(3)="BIRTH DATE"
  1. ;S LABEL(4)="AGE",LABEL(5)="SEX",LABEL("LASTDAT")="LAST DATE"
  1. W !!,"Determine if these entries ARE or ARE NOT duplicates."
  1. W !
  1. ;REM - Modified next three lines to include IENs by patient name.
  1. I XDRFILE=63 S NAMIEN1=$$LABIEN^XDRRMRG2(XDRFILE,DFNFR),NAMIEN2=$$LABIEN^XDRRMRG2(XDRFILE,DFNTO)
  1. ;W !,?20,$S(PACKAGE="PRIMARY":"RECORD1 [#"_DFNFR_"]",PACKAGE="LABORATORY":"MERGE FROM [#"_NAMIEN1_"]",1:"MERGE FROM [#"_DFNFR_"]")
  1. ;W ?45,$S(PACKAGE="PRIMARY":"RECORD2 [#"_DFNTO_"]",PACKAGE="LABORATORY":"MERGE TO [#"_NAMIEN2_"]",1:"MERGE TO [#"_DFNTO_"]")
  1. ;S I="" F S I=$O(DFNFR(I)) Q:I="" D
  1. ;. I DFNFR(I)=""&(DFNTO(I)="") Q
  1. ;. S DFNFR(I)=$S($P(DFNFR(I),U,2)'="":$P(DFNFR(I),U,2),1:$P(DFNFR(I),U))
  1. ;. S DFNTO(I)=$S($P(DFNTO(I),U,2)'="":$P(DFNTO(I),U,2),1:$P(DFNTO(I),U))
  1. ;. W !,$S($D(LABEL(I)):LABEL(I),1:I),?20,$E(DFNFR(I),1,20),?45,$E(DFNTO(I),1,20)
  1. ;. I I=1!(I=5) W !
  1. ;I DFNFR=""!(DFNTO="") D
  1. ;. I DFNFR=""&(DFNTO="") W !!,"There is NO DATA in the "_PACKAGE_" file for either entry." Q
  1. ;. I DFNFR="" W !!,"There is NO DATA in the "_PACKAGE_" file for (",DFNFRX,") ",DFNFR(1)," ",DFNFR(2)
  1. ;. I DFNTO="" W !!,"There is NO DATA in the "_PACKAGE_" file for (",DFNTOX,") ",DFNTO(1)," ",DFNTO(2)
  1. ;S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT)
  1. ;I DFNFR=""!(DFNTO="") Q
  1. ;S DIT(1)=DFNFR,DIT(2)=DFNTO,IOP=IO(0),DFF=XDRFILE,DIC=XDRFILE
  1. D SHOW^XDRDSHOW(XDRFILE,DFNFR,DFNTO,.OVERWRIT,REVIEW) ;D EN^DITC K IOP
  1. Q
  1. ;
  1. CHK ;
  1. N DIR
  1. CHK1 K DIR
  1. S DIR(0)="S^V:VERIFIED DUPLICATE;N:VERIFIED, NOT A DUPLICATE;U:UNABLE TO DETERMINE;H:HEALTH SUMMARY;R:REVIEW DATA AGAIN;S:SELECT/REVIEW OVERWRITES",DIR("A")="Select Action",DIR("B")="HEALTH SUMMARY"
  1. D ^DIR K DIR S XDRY=Y I $D(DIRUT) K XQAKILL Q
  1. I XDRY="R" S REVIEW=0 D SHOW G CHK1
  1. I XDRY="S" S REVIEW=1 D SHOW G CHK1
  1. I XDRY'="H" D Q
  1. . K XQAKILL
  1. . I XDRY'="^" D
  1. . . S XQAKILL=$S(XDRY'="U":0,1:1)
  1. . . S XDRDIR=""
  1. . . I XDRY="V" D VERWARN ;p126-REM
  1. . . I XDRY="V",PACKAGE="PRIMARY" D
  1. . . . S DIR=0 F DFN=DFNFRX,DFNTOX I $D(@FILEDIC) S DIR=DIR+1
  1. . . . I DIR'>1 K DIR Q ; DON'T NEED TO SELECT DIRECTION UNLESS DATA IN BOTH ENTRIES
  1. . . . S DIR("B")=$$COUNT^XDRRMRG2(XDRFILE,DFNFRX,DFNTOX)
  1. . . . S DIR("B")=$S(DIR("B")'>1:"RECORD1 INTO RECORD2",1:"RECORD2 INTO RECORD1")
  1. . . . I DIR("B")=0 K DIR("B")
  1. . . . S DIR(0)="S^1:RECORD1 INTO RECORD2;2:RECORD2 INTO RECORD1"
  1. . . . W !!!,?20,"RECORD1 [#"_DFNFR_"]",?45,"RECORD2 [#"_DFNTO_"]"
  1. . . . W !,?20,DFNFR(1),?45,DFNTO(1)
  1. . . . S DIR("A")="Which record (1 or 2) should be MERGED INTO the other record"
  1. . . . D ^DIR K DIR I Y>0 S XDRDIR=+Y
  1. . . . I $D(DIRUT) S XDRY="^" W !!!,$C(7),"VERIFICATION ABORTED!",! Q
  1. . . . I DFNFRX'=+^VA(15,XDRDA,0) S XDRDIR=$S(XDRDIR'>0:2,XDRDIR=1:2,1:1)
  1. . . N XDRFDA,XDRDA1
  1. . . S XDRDA1=$$FIND1^DIC(15.02,","_XDRDA_",","X",PACKAGE)
  1. . . S XDRDA1=$S(XDRDA1>0:XDRDA1_",",1:"+1,")_XDRDA_","
  1. . . S XDRFDA(15.02,XDRDA1,.01)=PACKAGE
  1. . . S XDRFDA(15.02,XDRDA1,.02)=XDRY
  1. . . S XDRFDA(15.02,XDRDA1,.03)=DUZ
  1. . . S XDRFDA(15.02,XDRDA1,.04)=$$NOW^XLFDT()
  1. . . I XDRDIR'="" S XDRFDA(15.02,XDRDA1,.05)=XDRDIR
  1. . . D UPDATE^DIE("S","XDRFDA")
  1. . . ;
  1. . . I $D(OVERWRIT)!(XDRDIR=2&(PACKAGE'="PRIMARY")) D
  1. . . . N I
  1. . . . S XDRDA1=$$FIND1^DIC(15.03,","_XDRDA_",","X",XDRFILE)
  1. . . . I XDRDA1'>0 D
  1. . . . . S XDRDA1="+1,"_XDRDA_","
  1. . . . . K XDRFDA,XDRDAX
  1. . . . . S XDRDAX(1)=XDRFILE
  1. . . . . S XDRFDA(15.03,XDRDA1,.01)=XDRFILE
  1. . . . . I XDRDIR=2,PACKAGE'="PRIMARY" D
  1. . . . . . S XDRFDA(15.03,XDRDA1,.02)=2
  1. . . . . D UPDATE^DIE("S","XDRFDA","XDRDAX")
  1. . . . . S XDRDA1=XDRDAX(1)
  1. . . . S XDRDA1="+1,"_XDRDA1_","_XDRDA_","
  1. . . . F I=0:0 S I=$O(OVERWRIT(I)) Q:I'>0 D
  1. . . . . K XDRFDA,XDRDAX
  1. . . . . S XDRDAX(1)=I
  1. . . . . S XDRFDA(15.031,XDRDA1,.01)=I
  1. . . . . D UPDATE^DIE("S","XDRFDA","XDRDAX")
  1. . I XDRY="V" D
  1. . . D CHEKVER
  1. . I XDRY="N" D
  1. . . S XDRAID=$G(XQAID) N XQAID,I
  1. . . F I=0:0 S I=$O(^VA(15.1,PRIFILE,2,I)) Q:I'>0 D ; MODIFIED 03/28/00
  1. . . . S XQAID=$P(XDRAID,",",1,2)_","_I
  1. . . . S XQAKILL=0
  1. . . . D DELETEA^XQALERT
  1. . . N XDRFDA
  1. . . S XDRFDA(15,XDRDA_",",.03)="N"
  1. . . S XDRFDA(15,XDRDA_",",.07)=$$NOW^XLFDT()
  1. . . S XDRFDA(15,XDRDA_",",.11)=DUZ
  1. . . D UPDATE^DIE("S","XDRFDA")
  1. S ABORT=0 D ASK^XDRRMRG2(.QLIST,.ABORT) ;REM -Reset ABORT to 0
  1. ;
  1. ;For health summary, user has the option of using the Browser to view
  1. ;both records or use may select any other device for each record.
  1. ;
  1. I '$G(ABORT) D PRINT2^XDRRMRG2
  1. D HOME^%ZIS
  1. G CHK1
  1. Q
  1. ;
  1. CHEKVER ;
  1. N R
  1. S XVER=1
  1. F I=0:0 S I=$O(^VA(15.1,PRIFILE,2,I)) Q:I'>0 D Q:'XVER ; MODIFIED 03/28/00
  1. . S X1=+$P(^VA(15.1,PRIFILE,2,I,0),U,2) ; MODIFIED 03/28/00
  1. . S XN=$P(^VA(15.1,PRIFILE,2,I,0),U) ; MODIFIED 03/28/00
  1. . I X1>0 D
  1. . . F R=1,5,6,7,0 I $O(^XMB(3.8,X1,R,0))>0 Q ;REM -changed I to R in FOR loop
  1. . . I R'>0 S X1=0
  1. . I X1'>0,$O(^VA(15.1,PRIFILE,2,I,1,0))'>0 Q ; MODIFIED 03/28/00
  1. . S X1=$$FIND1^DIC(15.02,","_XDRDA_",","X",XN)
  1. . S XVER=$S(X1'>0:0,$P(^VA(15,XDRDA,2,X1,0),U,2)="V":1,$P(^(0),U,2)="D":1,1:0)
  1. I XVER D FINALVER^XDRVCHEK(XDRDA)
  1. Q
  1. ;
  1. SETUP(XDRDA) ;
  1. N XDRGRPN,XDRSSN,XDRFILE
  1. S X=^VA(15,XDRDA,0)
  1. I $P($G(^VA(15,XDRDA,2,1,0)),U,5)=2 S DFNTO=+X,DFNFR=+$P(X,U,2)
  1. E S DFNFR=+X,DFNTO=+$P(X,U,2)
  1. S XDRFILE=$P($P(X,U),";",2),XDRFILE=+$P(@(U_XDRFILE_"0)"),U,2)
  1. F XDRAID=0:0 S XDRAID=$O(^VA(15.1,PRIFILE,2,XDRAID)) Q:XDRAID'>0 D ; MODIFIED 03/28/00
  1. . S XDRNODE=^VA(15.1,PRIFILE,2,XDRAID,0) ; MODIFIED 03/28/00
  1. . S XDRNOD2=$G(^VA(15.1,PRIFILE,2,XDRAID,2)) ; MODIFIED 03/28/00
  1. . S XDRNAME=$P(XDRNODE,U)
  1. . S XDRGRP=$P(XDRNODE,U,2)
  1. . S:XDRGRP>0 XDRGRPN=$$GET1^DIQ(3.8,XDRGRP,.01) ;REM -8/2/96 Get the name of mail group
  1. . S XDRGRP=$S(XDRGRP>0:"G."_XDRGRPN,1:"")
  1. . S XDRFILE=$P(XDRNODE,U,3) D Q:'$D(XDRNODE)
  1. . . N XDRDIC,XDRFR,XDRTO
  1. . . S XDRDIC=^DIC(XDRFILE,0,"GL")
  1. . . S XDRFR=$S(XDRFILE'=63:DFNFR,1:$G(^DPT(DFNFR,"LR")))
  1. . . S XDRTO=$S(XDRFILE'=63:DFNTO,1:$G(^DPT(DFNTO,"LR")))
  1. . . I XDRFR'>0!(XDRTO'>0) K XDRNODE
  1. . . I $D(XDRNODE),'$D(@(XDRDIC_XDRFR_",0)"))!'$D(@(XDRDIC_XDRTO_",0)")) K XDRNODE
  1. . . I '$D(XDRNODE) D
  1. . . . N XDRARR I $$FIND1^DIC(15.02,","_XDRDA_",","X",XDRNAME)>0 Q
  1. . . . S XDRARR(15.02,"+1,"_XDRDA_",",.01)=XDRNAME
  1. . . . S XDRARR(15.02,"+1,"_XDRDA_",",.02)="D"
  1. . . . D UPDATE^DIE("","XDRARR")
  1. . S XQADATA=XDRDA_U_DFNFR_";"_DFNTO_U_XDRNAME_U_XDRFILE_U_$P(XDRNOD2,U)_U_$P(XDRNOD2,U,2)
  1. . ;S R(1)=XDRDA_U_DFNFR_";"_DFNTO_U_XDRNAME_U_XDRFILE_U_$P(XDRNOD2,U)_U_$P(XDRNOD2,U,2)
  1. . D SETARY^XDRRMRG0 S XMTEXT="R("
  1. . S:XDRGRP'="" XMY(XDRGRP)=""
  1. . F I=0:0 S I=$O(^VA(15.1,PRIFILE,2,XDRAID,1,I)) Q:I'>0 S X=^(I,0) D
  1. . . S XQA(X)=""
  1. . D SEND^XDRRMRG0 K R
  1. Q
  1. VERWARN ;Warning message when ready to Verified Dupicates; p126-REM
  1. W !!,"*** WARNING!!! You have verified these two records are the SAME"
  1. W !,"patient. Once these records are merged, there is no automated way to"
  1. W !,"""un-do"" the merge. If you are not certain these are the same patient,"
  1. W !,"edit the status back to 'Potential Duplicate, Unverified' and repeat the"
  1. W !,"verification process. For additional assistance, please log a NOIS/Remedy"
  1. W !,"ticket. ***"
  1. W !!
  1. Q