source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRMAIN.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1XDRMAIN ;SF-IRMFO/IHS/OHPRD/JCM - MAIN DRIVER FOR DUPLICATE MERGE SOFTWARE; [ 08/13/92 09:50 AM ]
2 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
3 ;;
4START ;
5 S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG END
6 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
7END D EOJ
8 Q
9 ;
10MAIN ;
11 S XDRMCD=$P(XDRMPAIR,U,1),XDRMCD2=$P(XDRMPAIR,U,2)
12 S XDRMRG("LCK")="+" D LOCK^XDRU1 K XDRMRG("LCK") I $D(XDRMLOCK) G MAINX
13 I '$D(XDRM("NOVERIFY")) S XDRMRG=0 D ^XDRMVFY G:'XDRMRG!(XDRQFLG) MAINX
14 S (XDRMRG("FR"),XDRMAIN("FR"))=$S($P(^VA(15,XDRMPDA,0),U,4)=2:XDRMCD2,1:XDRMCD)
15 S (XDRMRG("TO"),XDRMAIN("TO"))=$S(XDRMRG("FR")=XDRMCD2:XDRMCD,1:XDRMCD2)
16 D ^XDRMPACK
17 I '$P(^VA(15,XDRMPDA,0),U,5),'$D(XDRM("NOVERIFY")) S XDRMSG="VERIFY" D ^XDRMSG I 1
18 E D ^XDRMRG I $P(^VA(15,XDRMPDA,0),U,5)=2 S XDRMSG="MERGED" D ^XDRMSG
19MAINX S XDRMRG("LCK")="-" D LOCK^XDRU1 K XDRMRG("LCK"),XDRMLOCK
20 Q
21 ;
22EN Q ; EP - Entry Point for Automatic Merge, Called by XDRDADD,XDRMADD
23 I '$D(XDRMPDA) G ENX
24 I '$D(XDRMPAIR) S XDRMPAIR=+$P(^VA(15,XDRMPDA,0),U,1)_U_+$P(^(0),U,2)
25 S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG ENX
26 D MAIN
27ENX D EOJ
28 Q
29 ;
30EN1 Q ; EP - Entry point for looping through Verified ready to merge duplicates
31 S:'$D(XDRM("NOVERIFY")) XDRM("NOVERIFY")=""
32 S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG EN1X
33 I $D(XDRM("NON-INTERACTIVE")) S DIE="^VA(15.1,",DA=XDRFL,DR=".32///@" D ^DIE K DA,DR,DIE
34 S XDRMPDA=0
35 S XDRM("GL")="^VA(15,""AMRG"","_""""_$P(XDRGL,U,2)_""""_",1,XDRMPDA)"
36 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
37EN1X D EOJ
38 Q
39 ;
40ASK ;
41 S XDRQFLG=0
42 G:$D(XDRMLOCK) ASKX
43 W !!
44 S DIR(0)="YO",DIR("A")="Do you wish to continue with the next pair of records",DIR("B")="Y"
45 D ^DIR
46 I $D(DTOUT)!($D(DUOUT)) S XDRQFLG=1 G ASKX
47 I 'Y S XDRQFLG=1
48ASKX K DIR,DA,Y,XDRMLOCK
49 Q
50 ;
51EN2 Q ; EP - Entry point to select Verified Ready to Merge Duplicate Pair
52 S:'$D(XDRM("NOVERIFY")) XDRM("NOVERIFY")=""
53 S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG EN2X
54 I '$D(XDRM("NOTALK")),$D(XDRM("NON-INTERACTIVE")) S XDRM("NOTALK")=""
55 S:$P(XDRM(0),U,25) (XDRM("NON-INTERACTIVE"),XDRM("NOTALK"))=""
56 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"
57 S DIC="^VA(15,",DIC(0)="QEAM"
58 D ^DIC K DIC,DA I U[X S XDRQFLG=1 G EN2X
59 S XDRMPDA=+Y,XDRMPAIR=+$P(^VA(15,XDRMPDA,0),U,1)_U_+$P(^(0),U,2)
60 D MAIN
61 I $D(XDRMLOCK) W !!,"Records currently busy, Please try again later.",!! K XDRMLOCK
62EN2X D EOJ
63 Q
64 ;
65EN3 Q ; EP - Entry point to select Unverified Potential Duplicate Pair
66 S XDRMAINI="MERGE" D ^XDRMAINI G:XDRQFLG EN3X
67 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"""
68 S DIC="^VA(15,",DIC(0)="QEAM"
69 D ^DIC K DIC,DA I U[X S XDRQFLG=1 G EN3X
70 S XDRMPDA=+Y,XDRMPAIR=+$P(^VA(15,XDRMPDA,0),U,1)_U_+$P(^(0),U,2)
71 D MAIN
72 I $D(XDRMLOCK) W !!,"Records currently busy, Please try again later.",!! K XDRMLOCK
73EN3X D EOJ
74 Q
75 ;
76EOJ ;
77 K:'$D(XDRDADD) XDRFL,XDRGL,XDRD
78 K XDRM,XDRMAIN,XDRM("DEVICE"),XDRMPAIR,XDRMI1,XDRMCD,XDRMCD2
79 K XDRMPDA,XDRM("POST-MERGE"),XDRM("PRE-MERGE"),XDRQFLG,XDRMRG,XDRM("VERIFYMSG"),XDRM("MERGEMSG")
80 Q
Note: See TracBrowser for help on using the repository browser.