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

XDRMAIN.m

Go to the documentation of this file. 
  1. XDRMAIN ;SF-IRMFO/IHS/OHPRD/JCM - MAIN DRIVER FOR DUPLICATE MERGE SOFTWARE;    [ 08/13/92  09:50 AM ]
  1.  ;;7.3;TOOLKIT;**23**;Apr 25, 1995
  1.  ;;
  1. START ;
  1.  S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG END
  1.  F XDRMI1=0:0 S XDRMPAIR=$O(@XDRM("GL")) Q:'XDRMPAIR!(XDRQFLG)  S XDRMPDA="^VA(15,""APOT"","_""""_$P(XDRGL,U,2)_""""_",XDRMPAIR,0)" S XDRMPDA=$O(@XDRMPDA) D MAIN D:'$D(XDRM("NOTALK")) ASK
  1. END D EOJ
  1.  Q
  1.  ;
  1. MAIN ;
  1.  S XDRMCD=$P(XDRMPAIR,U,1),XDRMCD2=$P(XDRMPAIR,U,2)
  1.  S XDRMRG("LCK")="+" D LOCK^XDRU1 K XDRMRG("LCK") I $D(XDRMLOCK) G MAINX
  1.  I '$D(XDRM("NOVERIFY")) S XDRMRG=0 D ^XDRMVFY G:'XDRMRG!(XDRQFLG) MAINX
  1.  S (XDRMRG("FR"),XDRMAIN("FR"))=$S($P(^VA(15,XDRMPDA,0),U,4)=2:XDRMCD2,1:XDRMCD)
  1.  S (XDRMRG("TO"),XDRMAIN("TO"))=$S(XDRMRG("FR")=XDRMCD2:XDRMCD,1:XDRMCD2)
  1.  D ^XDRMPACK
  1.  I '$P(^VA(15,XDRMPDA,0),U,5),'$D(XDRM("NOVERIFY")) S XDRMSG="VERIFY" D ^XDRMSG I 1
  1.  E  D ^XDRMRG I $P(^VA(15,XDRMPDA,0),U,5)=2 S XDRMSG="MERGED" D ^XDRMSG
  1. MAINX S XDRMRG("LCK")="-" D LOCK^XDRU1 K XDRMRG("LCK"),XDRMLOCK
  1.  Q
  1.  ;
  1. EN Q  ; EP - Entry Point for Automatic Merge, Called by XDRDADD,XDRMADD
  1.  I '$D(XDRMPDA) G ENX
  1.  I '$D(XDRMPAIR) S XDRMPAIR=+$P(^VA(15,XDRMPDA,0),U,1)_U_+$P(^(0),U,2)
  1.  S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG ENX
  1.  D MAIN
  1. ENX D EOJ
  1.  Q
  1.  ;
  1. EN1 Q  ; EP - Entry point for looping through Verified ready to merge duplicates
  1.  S:'$D(XDRM("NOVERIFY")) XDRM("NOVERIFY")=""
  1.  S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG EN1X
  1.  I $D(XDRM("NON-INTERACTIVE")) S DIE="^VA(15.1,",DA=XDRFL,DR=".32///@" D ^DIE K DA,DR,DIE
  1.  S XDRMPDA=0
  1.  S XDRM("GL")="^VA(15,""AMRG"","_""""_$P(XDRGL,U,2)_""""_",1,XDRMPDA)"
  1.  F XDRMI1=0:0 S XDRMPDA=$O(@XDRM("GL")) Q:'XDRMPDA!(XDRQFLG)!($D(XDRM("NON-INTERACTIVE"))&($P(^VA(15.1,XDRFL,0),U,32)))  S XDRMPAIR=+$P(^VA(15,XDRMPDA,0),U,1)_U_+$P(^VA(15,XDRMPDA,0),U,2) D MAIN D:'$D(XDRM("NOTALK")) ASK
  1. EN1X D EOJ
  1.  Q
  1.  ;
  1. ASK ;
  1.  S XDRQFLG=0
  1.  G:$D(XDRMLOCK) ASKX
  1.  W !!
  1.  S DIR(0)="YO",DIR("A")="Do you wish to continue with the next pair of records",DIR("B")="Y"
  1.  D ^DIR
  1.  I $D(DTOUT)!($D(DUOUT)) S XDRQFLG=1 G ASKX
  1.  I 'Y S XDRQFLG=1
  1. ASKX K DIR,DA,Y,XDRMLOCK
  1.  Q
  1.  ;
  1. EN2 Q  ; EP - Entry point to select Verified Ready to Merge Duplicate Pair
  1.  S:'$D(XDRM("NOVERIFY")) XDRM("NOVERIFY")=""
  1.  S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG EN2X
  1.  I '$D(XDRM("NOTALK")),$D(XDRM("NON-INTERACTIVE")) S XDRM("NOTALK")=""
  1.  S:$P(XDRM(0),U,25) (XDRM("NON-INTERACTIVE"),XDRM("NOTALK"))=""
  1.  S DIC("S")="I $P($P(^VA(15,Y,0),U,1),"";"",2)=$P(XDRGL,U,2),$P(^VA(15,Y,0),U,5)=1"
  1.  S DIC="^VA(15,",DIC(0)="QEAM"
  1.  D ^DIC K DIC,DA I U[X S XDRQFLG=1 G EN2X
  1.  S XDRMPDA=+Y,XDRMPAIR=+$P(^VA(15,XDRMPDA,0),U,1)_U_+$P(^(0),U,2)
  1.  D MAIN
  1.  I $D(XDRMLOCK) W !!,"Records currently busy, Please try again later.",!! K XDRMLOCK
  1. EN2X D EOJ
  1.  Q
  1.  ;
  1. EN3 Q  ; EP - Entry point to select Unverified Potential Duplicate Pair
  1.  S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG EN3X
  1.  S DIC("S")="I $P($P(^VA(15,Y,0),U,1),"";"",2)=$P(XDRGL,U,2),$P(^VA(15,Y,0),U,3)=""P"""
  1.  S DIC="^VA(15,",DIC(0)="QEAM"
  1.  D ^DIC K DIC,DA I U[X S XDRQFLG=1 G EN3X
  1.  S XDRMPDA=+Y,XDRMPAIR=+$P(^VA(15,XDRMPDA,0),U,1)_U_+$P(^(0),U,2)
  1.  D MAIN
  1.  I $D(XDRMLOCK) W !!,"Records currently busy, Please try again later.",!! K XDRMLOCK
  1. EN3X D EOJ
  1.  Q
  1.  ;
  1. EOJ ;
  1.  K:'$D(XDRDADD) XDRFL,XDRGL,XDRD
  1.  K XDRM,XDRMAIN,XDRM("DEVICE"),XDRMPAIR,XDRMI1,XDRMCD,XDRMCD2
  1.  K XDRMPDA,XDRM("POST-MERGE"),XDRM("PRE-MERGE"),XDRQFLG,XDRMRG,XDRM("VERIFYMSG"),XDRM("MERGEMSG")
  1.  Q