XDRMAIN ;SF-IRMFO/IHS/OHPRD/JCM - MAIN DRIVER FOR DUPLICATE MERGE SOFTWARE; [ 08/13/92 09:50 AM ]
;;7.3;TOOLKIT;**23**;Apr 25, 1995
;;
START ;
S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG END
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
END D EOJ
Q
;
MAIN ;
S XDRMCD=$P(XDRMPAIR,U,1),XDRMCD2=$P(XDRMPAIR,U,2)
S XDRMRG("LCK")="+" D LOCK^XDRU1 K XDRMRG("LCK") I $D(XDRMLOCK) G MAINX
I '$D(XDRM("NOVERIFY")) S XDRMRG=0 D ^XDRMVFY G:'XDRMRG!(XDRQFLG) MAINX
S (XDRMRG("FR"),XDRMAIN("FR"))=$S($P(^VA(15,XDRMPDA,0),U,4)=2:XDRMCD2,1:XDRMCD)
S (XDRMRG("TO"),XDRMAIN("TO"))=$S(XDRMRG("FR")=XDRMCD2:XDRMCD,1:XDRMCD2)
D ^XDRMPACK
I '$P(^VA(15,XDRMPDA,0),U,5),'$D(XDRM("NOVERIFY")) S XDRMSG="VERIFY" D ^XDRMSG I 1
E D ^XDRMRG I $P(^VA(15,XDRMPDA,0),U,5)=2 S XDRMSG="MERGED" D ^XDRMSG
MAINX S XDRMRG("LCK")="-" D LOCK^XDRU1 K XDRMRG("LCK"),XDRMLOCK
Q
;
EN Q ; EP - Entry Point for Automatic Merge, Called by XDRDADD,XDRMADD
I '$D(XDRMPDA) G ENX
I '$D(XDRMPAIR) S XDRMPAIR=+$P(^VA(15,XDRMPDA,0),U,1)_U_+$P(^(0),U,2)
S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG ENX
D MAIN
ENX D EOJ
Q
;
EN1 Q ; EP - Entry point for looping through Verified ready to merge duplicates
S:'$D(XDRM("NOVERIFY")) XDRM("NOVERIFY")=""
S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG EN1X
I $D(XDRM("NON-INTERACTIVE")) S DIE="^VA(15.1,",DA=XDRFL,DR=".32///@" D ^DIE K DA,DR,DIE
S XDRMPDA=0
S XDRM("GL")="^VA(15,""AMRG"","_""""_$P(XDRGL,U,2)_""""_",1,XDRMPDA)"
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
EN1X D EOJ
Q
;
ASK ;
S XDRQFLG=0
G:$D(XDRMLOCK) ASKX
W !!
S DIR(0)="YO",DIR("A")="Do you wish to continue with the next pair of records",DIR("B")="Y"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) S XDRQFLG=1 G ASKX
I 'Y S XDRQFLG=1
ASKX K DIR,DA,Y,XDRMLOCK
Q
;
EN2 Q ; EP - Entry point to select Verified Ready to Merge Duplicate Pair
S:'$D(XDRM("NOVERIFY")) XDRM("NOVERIFY")=""
S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG EN2X
I '$D(XDRM("NOTALK")),$D(XDRM("NON-INTERACTIVE")) S XDRM("NOTALK")=""
S:$P(XDRM(0),U,25) (XDRM("NON-INTERACTIVE"),XDRM("NOTALK"))=""
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"
S DIC="^VA(15,",DIC(0)="QEAM"
D ^DIC K DIC,DA I U[X S XDRQFLG=1 G EN2X
S XDRMPDA=+Y,XDRMPAIR=+$P(^VA(15,XDRMPDA,0),U,1)_U_+$P(^(0),U,2)
D MAIN
I $D(XDRMLOCK) W !!,"Records currently busy, Please try again later.",!! K XDRMLOCK
EN2X D EOJ
Q
;
EN3 Q ; EP - Entry point to select Unverified Potential Duplicate Pair
S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG EN3X
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"""
S DIC="^VA(15,",DIC(0)="QEAM"
D ^DIC K DIC,DA I U[X S XDRQFLG=1 G EN3X
S XDRMPDA=+Y,XDRMPAIR=+$P(^VA(15,XDRMPDA,0),U,1)_U_+$P(^(0),U,2)
D MAIN
I $D(XDRMLOCK) W !!,"Records currently busy, Please try again later.",!! K XDRMLOCK
EN3X D EOJ
Q
;
EOJ ;
K:'$D(XDRDADD) XDRFL,XDRGL,XDRD
K XDRM,XDRMAIN,XDRM("DEVICE"),XDRMPAIR,XDRMI1,XDRMCD,XDRMCD2
K XDRMPDA,XDRM("POST-MERGE"),XDRM("PRE-MERGE"),XDRQFLG,XDRMRG,XDRM("VERIFYMSG"),XDRM("MERGEMSG")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRMAIN 3431 printed Apr 09, 2024@21:41:22 Page 2
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
+2 ;;
START ;
+1 SET XDRMAINI="MERGE"
DO ^XDRMAINI
if XDRQFLG
GOTO END
+2 FOR XDRMI1=0:0
SET XDRMPAIR=$ORDER(@XDRM("GL"))
if 'XDRMPAIR!(XDRQFLG)
QUIT
SET XDRMPDA="^VA(15,""APOT"","_""""_$PIECE(XDRGL,U,2)_""""_",XDRMPAIR,0)"
SET XDRMPDA=$ORDER(@XDRMPDA)
DO MAIN
if '$DATA(XDRM("NOTALK"))
DO ASK
END DO EOJ
+1 QUIT
+2 ;
MAIN ;
+1 SET XDRMCD=$PIECE(XDRMPAIR,U,1)
SET XDRMCD2=$PIECE(XDRMPAIR,U,2)
+2 SET XDRMRG("LCK")="+"
DO LOCK^XDRU1
KILL XDRMRG("LCK")
IF $DATA(XDRMLOCK)
GOTO MAINX
+3 IF '$DATA(XDRM("NOVERIFY"))
SET XDRMRG=0
DO ^XDRMVFY
if 'XDRMRG!(XDRQFLG)
GOTO MAINX
+4 SET (XDRMRG("FR"),XDRMAIN("FR"))=$SELECT($PIECE(^VA(15,XDRMPDA,0),U,4)=2:XDRMCD2,1:XDRMCD)
+5 SET (XDRMRG("TO"),XDRMAIN("TO"))=$SELECT(XDRMRG("FR")=XDRMCD2:XDRMCD,1:XDRMCD2)
+6 DO ^XDRMPACK
+7 IF '$PIECE(^VA(15,XDRMPDA,0),U,5)
IF '$DATA(XDRM("NOVERIFY"))
SET XDRMSG="VERIFY"
DO ^XDRMSG
IF 1
+8 IF '$TEST
DO ^XDRMRG
IF $PIECE(^VA(15,XDRMPDA,0),U,5)=2
SET XDRMSG="MERGED"
DO ^XDRMSG
MAINX SET XDRMRG("LCK")="-"
DO LOCK^XDRU1
KILL XDRMRG("LCK"),XDRMLOCK
+1 QUIT
+2 ;
EN ; EP - Entry Point for Automatic Merge, Called by XDRDADD,XDRMADD
QUIT
+1 IF '$DATA(XDRMPDA)
GOTO ENX
+2 IF '$DATA(XDRMPAIR)
SET XDRMPAIR=+$PIECE(^VA(15,XDRMPDA,0),U,1)_U_+$PIECE(^(0),U,2)
+3 SET XDRMAINI="MERGE"
DO ^XDRMAINI
if XDRQFLG
GOTO ENX
+4 DO MAIN
ENX DO EOJ
+1 QUIT
+2 ;
EN1 ; EP - Entry point for looping through Verified ready to merge duplicates
QUIT
+1 if '$DATA(XDRM("NOVERIFY"))
SET XDRM("NOVERIFY")=""
+2 SET XDRMAINI="MERGE"
DO ^XDRMAINI
if XDRQFLG
GOTO EN1X
+3 IF $DATA(XDRM("NON-INTERACTIVE"))
SET DIE="^VA(15.1,"
SET DA=XDRFL
SET DR=".32///@"
DO ^DIE
KILL DA,DR,DIE
+4 SET XDRMPDA=0
+5 SET XDRM("GL")="^VA(15,""AMRG"","_""""_$PIECE(XDRGL,U,2)_""""_",1,XDRMPDA)"
+6 FOR XDRMI1=0:0
SET XDRMPDA=$ORDER(@XDRM("GL"))
if 'XDRMPDA!(XDRQFLG)!($DATA(XDRM("NON-INTERACTIVE"))&($PIECE(^VA(15.1,XDRFL,0),U,32)))
QUIT
SET XDRMPAIR=+$PIECE(^VA(15,XDRMPDA,0),U,1)_U_+$PIECE(^VA(15,XDRMPDA,0),U,2)
DO MAIN
if '$DATA(XDRM("NOTALK"))
DO ASK
EN1X DO EOJ
+1 QUIT
+2 ;
ASK ;
+1 SET XDRQFLG=0
+2 if $DATA(XDRMLOCK)
GOTO ASKX
+3 WRITE !!
+4 SET DIR(0)="YO"
SET DIR("A")="Do you wish to continue with the next pair of records"
SET DIR("B")="Y"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!($DATA(DUOUT))
SET XDRQFLG=1
GOTO ASKX
+7 IF 'Y
SET XDRQFLG=1
ASKX KILL DIR,DA,Y,XDRMLOCK
+1 QUIT
+2 ;
EN2 ; EP - Entry point to select Verified Ready to Merge Duplicate Pair
QUIT
+1 if '$DATA(XDRM("NOVERIFY"))
SET XDRM("NOVERIFY")=""
+2 SET XDRMAINI="MERGE"
DO ^XDRMAINI
if XDRQFLG
GOTO EN2X
+3 IF '$DATA(XDRM("NOTALK"))
IF $DATA(XDRM("NON-INTERACTIVE"))
SET XDRM("NOTALK")=""
+4 if $PIECE(XDRM(0),U,25)
SET (XDRM("NON-INTERACTIVE"),XDRM("NOTALK"))=""
+5 SET DIC("S")="I $P($P(^VA(15,Y,0),U,1),"";"",2)=$P(XDRGL,U,2),$P(^VA(15,Y,0),U,5)=1"
+6 SET DIC="^VA(15,"
SET DIC(0)="QEAM"
+7 DO ^DIC
KILL DIC,DA
IF U[X
SET XDRQFLG=1
GOTO EN2X
+8 SET XDRMPDA=+Y
SET XDRMPAIR=+$PIECE(^VA(15,XDRMPDA,0),U,1)_U_+$PIECE(^(0),U,2)
+9 DO MAIN
+10 IF $DATA(XDRMLOCK)
WRITE !!,"Records currently busy, Please try again later.",!!
KILL XDRMLOCK
EN2X DO EOJ
+1 QUIT
+2 ;
EN3 ; EP - Entry point to select Unverified Potential Duplicate Pair
QUIT
+1 SET XDRMAINI="MERGE"
DO ^XDRMAINI
if XDRQFLG
GOTO EN3X
+2 SET DIC("S")="I $P($P(^VA(15,Y,0),U,1),"";"",2)=$P(XDRGL,U,2),$P(^VA(15,Y,0),U,3)=""P"""
+3 SET DIC="^VA(15,"
SET DIC(0)="QEAM"
+4 DO ^DIC
KILL DIC,DA
IF U[X
SET XDRQFLG=1
GOTO EN3X
+5 SET XDRMPDA=+Y
SET XDRMPAIR=+$PIECE(^VA(15,XDRMPDA,0),U,1)_U_+$PIECE(^(0),U,2)
+6 DO MAIN
+7 IF $DATA(XDRMLOCK)
WRITE !!,"Records currently busy, Please try again later.",!!
KILL XDRMLOCK
EN3X DO EOJ
+1 QUIT
+2 ;
EOJ ;
+1 if '$DATA(XDRDADD)
KILL XDRFL,XDRGL,XDRD
+2 KILL XDRM,XDRMAIN,XDRM("DEVICE"),XDRMPAIR,XDRMI1,XDRMCD,XDRMCD2
+3 KILL XDRMPDA,XDRM("POST-MERGE"),XDRM("PRE-MERGE"),XDRQFLG,XDRMRG,XDRM("VERIFYMSG"),XDRM("MERGEMSG")
+4 QUIT
