source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRMAINI.m@ 1608

XDRMAINI ;SF-IRMFO/IHS/OHPRD/JCM - INITIALIZATION ROUTINE FOR XDRMAIN;   [ 10/19/92  10:25 AM ] ;1/22/97  10:48
 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
 ;;
 ;
START ;
 S XDRQFLG=0
 D:'$D(XDRFL) FILE
 G:XDRQFLG END
 I XDRMAINI="DUP" D DUP I 1
 E  D MERGE
 K XDRMAINI
END Q
 ;
FILE ;
 K DIC("B")
 S DIC("A")=$S(XDRMAINI="DUP":"Select file to be checked for duplicates: ",'$D(XDRM("NOVERIFY")):"Select file to verify potential duplicates: ",1:"Select file to merge ready to merge duplicates: ")
 S DIC="^VA(15.1,",DIC(0)="QEAZ" D ^DIC K DIC
 I Y=-1 S XDRQFLG=1 G FILEX
 S XDRFL=$P(Y(0),U,1) K Y
FILEX Q
 ;
DUP ;
 I '$D(^VA(15.1,XDRFL,0)) S XDRERR=6 D ^XDREMSG G DUPX
 S XDRD(0)=^VA(15.1,XDRFL,0)
 I $D(XDRDNSTA) D STATUS G:XDRQFLG DUPX
 S XDRCD=$S($P(^VA(15.1,XDRFL,0),U,8):$P(^VA(15.1,XDRFL,0),U,8),1:0)
 S XDRDCNT=$S($P(^VA(15.1,XDRFL,0),U,7):$P(^VA(15.1,XDRFL,0),U,7),1:0)
 S XDRGL=^DIC(XDRFL,0,"GL")
 S XDRD("COLLECTION ROUTINE")=$S($P($P(XDRD(0),U,9),"-",2)]"":$P($P(XDRD(0),U,9),"-")_"^"_$P($P(XDRD(0),U,9),"-",2),1:U_$P(XDRD(0),U,9))
 I '$D(XDRD("DMAILGRP")),$D(XDRD(0)),$P(XDRD(0),U,11),$D(^XMB(3.8,$P(XDRD(0),U,11),1,"B")) F XDRI=0:0 S XDRI=$O(^XMB(3.8,$P(XDRD(0),U,11),1,"B",XDRI)) Q:'XDRI  S XDRD("DMAILGRP",XDRI)=""
 K XDRI
 D ^XDRDSCOR ; Sets up Duplicate Test Scores
DUPX Q
 ;
STATUS ;
 I $P(XDRD(0),U,2)="c",XDRDNSTA="h" S XDRQFLG=1 G STATUSX
 K DIE,DA
 S DIE=15.1,DA=$P(XDRD(0),U,1)
 S DR=".02////"_XDRDNSTA
 I XDRDNSTA="r",'$D(XDRDPDTI) S DR=DR_";.03///"_$$NOW^XLFDT()_";.04///@" K ^XTMP("XDRERR",XDRFL) S ^XTMP("XDRERR",0)=($$FMADD^XLFDT(DT,30))_U_DT
 S $P(^VA(15.1,XDRFL,3),U)=""
 I $P(XDRD(0),U,2)="c"!($P(XDRD(0),U,2)=""),XDRDNSTA="r",'$D(XDRDPDTI) S DR=DR_";.05////"_XDRDTYPE_";.07///@;.08///@;.1///@;.12///@"
 D ^DIE K DIE,DA,D0,DR
 S:XDRDNSTA="h" XDRQFLG=1
STATUSX Q
 ;
MERGE ;
 I '$D(^VA(15.1,XDRFL,0)) S XDRERR=6 D ^XDREMSG G MERGEX
 S XDRM(0)=^VA(15.1,XDRFL,0),XDRGL=^DIC(XDRFL,0,"GL")
 I $O(^VA(15.1,XDRFL,12,0)) S XDRM("TOP FILE")=XDRFL F XDRI=0:0 S XDRI=$O(^(XDRI)) Q:'XDRI  S XDRM("DINUMS",XDRI)=""
 I '$D(XDRM("AUTO")),$P(XDRM(0),U,25) S XDRM("NON-INTERACTIVE")=""
 S:$D(XDRM("AUTO")) (XDRM("NON-INTERACTIVE"),XDRM("NOTALK"),XDRM("NOVERIFY"))=""
 S:'$D(XDRMPAIR) XDRMPAIR=0
 S XDRM("PRE-MERGE")=$S($P($P(XDRM(0),U,27),"-",2)]"":$P($P(XDRM(0),U,27),"-")_"^"_$P($P(XDRM(0),U,27),"-",2),$P(XDRM(0),U,27)]"":U_$P(XDRM(0),U,27),1:"")
 I XDRM("PRE-MERGE")]"" S X=$P(XDRM("PRE-MERGE"),U,2) D TEST I '$T S XDRERR=9 D ^XDREMSG G MERGEX
 S XDRM("POST-MERGE")=$S($P($P(XDRM(0),U,28),"-",2)]"":$P($P(XDRM(0),U,28),"-")_"^"_$P($P(XDRM(0),U,28),"-",2),$P(XDRM(0),U,28)]"":U_$P(XDRM(0),U,28),1:"")
 I XDRM("POST-MERGE")]"" S X=$P(XDRM("POST-MERGE"),U,2) D TEST I '$T S XDRERR=10 D ^XDREMSG G MERGEX
 I $P(XDRM(0),U,17)]"" S XDRM("VERIFY-MSG")=$S($P($P(XDRM(0),U,17),"-",2)]"":$P($P(XDRM(0),U,17),"-")_"^"_$P($P(XDRM(0),U,17),"-",2),1:U_$P(XDRM(0),U,17))
 I $D(XDRM("VERIFY-MSG")) S X=$P(XDRM("VERIFY-MSG"),U,2) D TEST I '$T S XDRERR=11 D ^XDREMSG G MERGEX
 I $P(XDRM(0),U,33)]"" S XDRM("MD-IT")=$S($P($P(XDRM(0),U,33),"-",2)]"":$P($P(XDRM(0),U,33),"-")_"^"_$P($P(XDRM(0),U,33),"-",2),1:U_$P(XDRM(0),U,33))
 I $D(XDRM("MD-IT")) S X=$P(XDRM("MD-IT"),U,2) D TEST I '$T S XDRERR=11 D ^XDREMSG G MERGEX
 I $P(XDRM(0),U,31)]"" S XDRM("MERGE-MSG")=$S($P($P(XDRM(0),U,31),"-",2)]"":$P($P(XDRM(0),U,31),"-")_"^"_$P($P(XDRM(0),U,31),"-",2),1:U_$P(XDRM(0),U,31)) I 1
 I $D(XDRM("MERGE-MSG")) S X=$P(XDRM("MERGE-MSG"),U,2) D TEST I '$T S XDRERR=12 D ^XDREMSG G MERGEX
 I '$D(XDRM("NOVERIFY")) S XDRM("GL")="^VA(15,""APOT"","_""""_$P(XDRGL,U,2)_""""_",XDRMPAIR)"
 I $O(^VA(15.1,XDRFL,12,0))&($P(XDRM(0),U,25)) S XDRERR=13 D ^XDREMSG G MERGEX
 D MAILGRP
MERGEX Q
 ;
TEST ;
 X ^%ZOSF("TEST") K X
 Q
 ;
MAILGRP ;
 I '$D(XDRM("VERIFY-MSG")),'$D(XDRM("VMAILGRP")),$D(XDRM(0)),$P(XDRM(0),U,16),$D(^XMB(3.8,$P(XDRM(0),U,16),1,"B")) F XDRI=0:0 S XDRI=$O(^XMB(3.8,$P(XDRM(0),U,16),1,"B",XDRI)) Q:'XDRI  S XDRM("VMAILGRP",XDRI)=""
 I '$D(XDRM("MERGE-MSG")),'$D(XDRM("MMAILGRP")),$D(XDRM(0)),$P(XDRM(0),U,29),$D(^XMB(3.8,$P(XDRM(0),U,29),1,"B")) F XDRI=0:0 S XDRI=$O(^XMB(3.8,$P(XDRM(0),U,29),1,"B",XDRI)) Q:'XDRI  S XDRM("MMAILGRP",XDRI)=""
 I '$D(XDRD("DMAILGRP")),$D(XDRM(0)),$P(XDRM(0),U,11),$D(^XMB(3.8,$P(XDRM(0),U,11),1,"B")) F XDRI=0:0 S XDRI=$O(^XMB(3.8,$P(XDRM(0),U,11),1,"B",XDRI)) Q:'XDRI  S XDRD("DMAILGRP",XDRI)=""
 K XDRI
 Q