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

XDRMRG.m

Go to the documentation of this file.
  1. XDRMRG ;IHS/OHPRD/JCM - MERGE DUPLICATE RECORDS ;02/10/95 11:15
  1. ;;7.3;TOOLKIT;;Apr 25, 1995
  1. START ;
  1. D INIT
  1. D:XDRM("PRE-MERGE")]"" @XDRM("PRE-MERGE")
  1. G:XDRMRG("QFLG") END
  1. D @$S('$D(XDRM("DINUMS")):"SINGLE",1:"MULTI")
  1. G:XDRMRG("QFLG") END
  1. I XDRM("POST-MERGE")]"" W:'$D(XDRM("NOTALK")) !!,"I will now do any post merge action that needs to occur, this may take some time please be patient." D @XDRM("POST-MERGE")
  1. I XDRM("POST-MERGE")']"",$P(XDRM(0),U,26) D DELETE
  1. D STATUS
  1. END D EOJ
  1. Q
  1. ;
  1. INIT ;
  1. F XDRI="XDRMRGFR","XDRMRGTO" K ^TMP(XDRI,$J)
  1. S %X=XDRGL_XDRMRG("FR")_",",%Y="^TMP(""XDRMRGFR"",$J,"_XDRMRG("FR")_"," D %XY^%RCR
  1. S %X=XDRGL_XDRMRG("TO")_",",%Y="^TMP(""XDRMRGTO"",$J,"_XDRMRG("TO")_"," D %XY^%RCR
  1. K %X,%Y
  1. S (XDRQFLG,XDRMRG("QFLG"))=0
  1. I $D(XDRM("AUTO")),'$D(XDRM("NOTALK")) S (XDRM("NOTALK"),XDRM("NON-INTERACTIVE"))=""
  1. I '$D(XDRM("DINUMS")),$O(^VA(15.1,XDRFL,12,0)) F XDRI=0:0 S XDRI=$O(^(XDRI)) Q:'XDRI S XDRM("DINUMS",XDRI)=""
  1. K XDRI
  1. Q
  1. ;
  1. SINGLE ;
  1. S XDRMRGFL=XDRFL,XDRMRGL=XDRGL
  1. I '$D(XDRM("NON-INTERACTIVE")) K DITM D DITM2 G:XDRMRG("QFLG") SINGLEX I 1
  1. E D DIT0
  1. D PACKAGE
  1. D DITMGMRG
  1. SINGLEX Q
  1. ;
  1. MULTI ;
  1. S XDRMRGFL=XDRFL,XDRMRGL=XDRGL
  1. I '$D(XDRM("NON-INTERACTIVE")) K DITM D DITM2 G:XDRMRG("QFLG") MULTIX I 1
  1. E D DIT0
  1. F XDRMRGFL=0:0 S XDRMRGFL=$O(XDRM("DINUMS",XDRMRGFL)) Q:'XDRMRGFL!(XDRMRG("QFLG")) S XDRMRGL=^DIC(XDRMRGFL,0,"GL") D @$S('$D(XDRM("NON-INTERACTIVE")):"DITM2",1:"DIT0")
  1. G:XDRMRG("QFLG") MULTIX
  1. S XDRMRGFL=XDRFL,XDRMRGL=XDRGL
  1. D PACKAGE
  1. F XDRI=0:0 S XDRI=$O(XDRM("DINUMS",XDRI)) Q:'XDRI S DITMGMRG("EXCLUDE",XDRI)=""
  1. K XDRI
  1. D DITMGMRG
  1. F XDRMRGFL=0:0 S XDRMRGFL=$O(XDRM("DINUMS",XDRMRGFL)) Q:'XDRMRGFL S XDRMRGL=^DIC(XDRMRGFL,0,"GL") D DITMGMRG
  1. MULTIX Q
  1. ;
  1. DITM2 ;
  1. S:XDRMRGFL'=XDRFL X="DITM2^XDRMRG1",@^%ZOSF("TRAP") K X
  1. S:$D(XDRM("NOTALK")) DITM("NOTALK")=""
  1. S:'$D(DITM("NOTALK")) DITM("DDSP")=""
  1. S DITM("DIMERGE")=1
  1. S DITM("DFF")=XDRMRGFL,DITM("DIC")=XDRMRGL
  1. S DITM("DIT(1)")=XDRMRG("FR"),DITM("DIT(2)")=XDRMRG("TO"),DITM("DDEF")=2
  1. S DITM("PACKAGE")="",DITM("EXCLUDE",15)="",IOP=IO(0)
  1. W:'$D(XDRM("NOTALK")) !!,"I will now merge the ",$P(^DIC(XDRMRGFL,0),U,1)," file, this may take some time please be patient."
  1. D ^DITM2 K DITM,IOP
  1. D:$D(DIRUT)!($D(DMSG))!($D(DUOUT)) ASK
  1. K DIRUT,DMSG
  1. Q
  1. ;
  1. ASK ;
  1. W !!
  1. S DIR(0)="YO",DIR("A")="Do you wish to continue MERGING these records",DIR("B")="N"
  1. D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) S XDRMRG("QFLG")=1 G ASKX
  1. S:'Y XDRMRG("QFLG")=1
  1. ASKX K DIR,DA,Y
  1. Q
  1. ;
  1. DIT0 ;
  1. S:XDRMRGFL'=XDRFL X="DIT0^XDRMRG1",@^%ZOSF("TRAP") K X
  1. W:'$D(XDRM("NOTALK")) !!,"I will now merge the ",$P(^DIC(XDRMRGFL,0),U,1)," file, this may take some time please be patient."
  1. K DA
  1. S (DIT("T"),DIT("F"))=XDRMRGL
  1. S (D0,DA("T"))=XDRMRG("TO"),DA("F")=XDRMRG("FR")
  1. D EN^DIT0 K D0,DA,DIC,DIK,DIT
  1. Q
  1. ;
  1. PACKAGE ;
  1. F XDRMPKGE=0:0 S XDRMPKGE=$O(^VA(15,XDRMPDA,11,XDRMPKGE)) Q:'XDRMPKGE D:$P(^VA(15,XDRMPDA,11,XDRMPKGE,0),U,2)=1 MERGE
  1. K XDRMPKGE
  1. Q
  1. ;
  1. MERGE ;
  1. S X="MERGE^XDRMRG1",@^%ZOSF("TRAP") K X
  1. W:'$D(XDRM("NOTALK")) !!,"I will now merge all files associated with the ",$P(^DIC(9.4,XDRMPKGE,0),U,1)," package."
  1. W:'$D(XDRM("NOTALK")) !,"This may take some time, Please be patient."
  1. I $D(^DIC(9.4,XDRMPKGE,20,XDRFL,0))#2,$P(^(0),U,3)]"" S XDRMRG("PKGMRG")=U_$P(^(0),U,3) D @XDRMRG("PKGMRG")
  1. W:'$D(XDRM("NOTALK")) !!,"Completed merging all files associated with the ",$P(^DIC(9.4,XDRMPKGE,0),U,1)," package."
  1. Q
  1. DITMGMRG ;
  1. S X="DITMGMRG^XDRMRG1",@^%ZOSF("TRAP") K X
  1. W:'$D(XDRM("NOTALK")) !!,"I will now merge all files that point to the ",$P(^DIC(XDRMRGFL,0),U,1)," file that do not have a specific package merge ... This may take some time, please be patient."
  1. S DITMGMRG("FILE")=XDRMRGFL,DITMGMRG("FR")=XDRMRG("FR"),DITMGMRG("TO")=XDRMRG("TO")
  1. S DITMGMRG("EXCLUDE",15)="",DITMGMRG("PACKAGE")=""
  1. S:$D(XDRM("NOTALK")) DITMGMRG("NOTALK")=""
  1. S:$G(XDRM("TOP FILE")) DITMGMRG("TOP FILE")=XDRM("TOP FILE")
  1. D EN^DITMGMRG K DITMGMRG
  1. Q
  1. ;
  1. DELETE ;
  1. W:'$D(XDRM("NOTALK")) !!,"I will now delete the From Record from the ",$P(^DIC(XDRFL,0),U,1)," file and any files that were excluded from the repointing. This may take some time, please be patient."
  1. K XDRMRGFL,XDRMRGL
  1. I $D(XDRM("DINUMS")) F XDRMRGFL=0:0 S XDRMRGFL=$O(XDRM("DINUMS",XDRMRGFL)) Q:'XDRMRGFL S XDRMRGL=^DIC(XDRMRGFL,0,"GL") S DIK=XDRMRGL,DA=XDRMRG("FR") D DIK
  1. S DIK=XDRGL,DA=XDRMRG("FR") D DIK
  1. Q
  1. ;
  1. DIK ;
  1. S X="DIK^XDRMRG1",@^%ZOSF("TRAP") K X
  1. D ^DIK K DIK,DA
  1. Q
  1. STATUS ;
  1. S DIE="^VA(15,",DA=XDRMPDA,DR=".05////2;.08////"_DT D ^DIE K DIE,DR,DA
  1. Q
  1. EOJ ;
  1. F XDRI="XDRMRGFR","XDRMRGTO" K ^TMP(XDRI,$J)
  1. K DITM,DITMGMRG,XDRMRGFL,XDRMGL
  1. Q