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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1XDRMAINI ;SF-IRMFO/IHS/OHPRD/JCM - INITIALIZATION ROUTINE FOR XDRMAIN; [ 10/19/92 10:25 AM ] ;1/22/97 10:48
2 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
3 ;;
4 ;
5START ;
6 S XDRQFLG=0
7 D:'$D(XDRFL) FILE
8 G:XDRQFLG END
9 I XDRMAINI="DUP" D DUP I 1
10 E D MERGE
11 K XDRMAINI
12END Q
13 ;
14FILE ;
15 K DIC("B")
16 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: ")
17 S DIC="^VA(15.1,",DIC(0)="QEAZ" D ^DIC K DIC
18 I Y=-1 S XDRQFLG=1 G FILEX
19 S XDRFL=$P(Y(0),U,1) K Y
20FILEX Q
21 ;
22DUP ;
23 I '$D(^VA(15.1,XDRFL,0)) S XDRERR=6 D ^XDREMSG G DUPX
24 S XDRD(0)=^VA(15.1,XDRFL,0)
25 I $D(XDRDNSTA) D STATUS G:XDRQFLG DUPX
26 S XDRCD=$S($P(^VA(15.1,XDRFL,0),U,8):$P(^VA(15.1,XDRFL,0),U,8),1:0)
27 S XDRDCNT=$S($P(^VA(15.1,XDRFL,0),U,7):$P(^VA(15.1,XDRFL,0),U,7),1:0)
28 S XDRGL=^DIC(XDRFL,0,"GL")
29 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))
30 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)=""
31 K XDRI
32 D ^XDRDSCOR ; Sets up Duplicate Test Scores
33DUPX Q
34 ;
35STATUS ;
36 I $P(XDRD(0),U,2)="c",XDRDNSTA="h" S XDRQFLG=1 G STATUSX
37 K DIE,DA
38 S DIE=15.1,DA=$P(XDRD(0),U,1)
39 S DR=".02////"_XDRDNSTA
40 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
41 S $P(^VA(15.1,XDRFL,3),U)=""
42 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///@"
43 D ^DIE K DIE,DA,D0,DR
44 S:XDRDNSTA="h" XDRQFLG=1
45STATUSX Q
46 ;
47MERGE ;
48 I '$D(^VA(15.1,XDRFL,0)) S XDRERR=6 D ^XDREMSG G MERGEX
49 S XDRM(0)=^VA(15.1,XDRFL,0),XDRGL=^DIC(XDRFL,0,"GL")
50 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)=""
51 I '$D(XDRM("AUTO")),$P(XDRM(0),U,25) S XDRM("NON-INTERACTIVE")=""
52 S:$D(XDRM("AUTO")) (XDRM("NON-INTERACTIVE"),XDRM("NOTALK"),XDRM("NOVERIFY"))=""
53 S:'$D(XDRMPAIR) XDRMPAIR=0
54 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:"")
55 I XDRM("PRE-MERGE")]"" S X=$P(XDRM("PRE-MERGE"),U,2) D TEST I '$T S XDRERR=9 D ^XDREMSG G MERGEX
56 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:"")
57 I XDRM("POST-MERGE")]"" S X=$P(XDRM("POST-MERGE"),U,2) D TEST I '$T S XDRERR=10 D ^XDREMSG G MERGEX
58 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))
59 I $D(XDRM("VERIFY-MSG")) S X=$P(XDRM("VERIFY-MSG"),U,2) D TEST I '$T S XDRERR=11 D ^XDREMSG G MERGEX
60 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))
61 I $D(XDRM("MD-IT")) S X=$P(XDRM("MD-IT"),U,2) D TEST I '$T S XDRERR=11 D ^XDREMSG G MERGEX
62 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
63 I $D(XDRM("MERGE-MSG")) S X=$P(XDRM("MERGE-MSG"),U,2) D TEST I '$T S XDRERR=12 D ^XDREMSG G MERGEX
64 I '$D(XDRM("NOVERIFY")) S XDRM("GL")="^VA(15,""APOT"","_""""_$P(XDRGL,U,2)_""""_",XDRMPAIR)"
65 I $O(^VA(15.1,XDRFL,12,0))&($P(XDRM(0),U,25)) S XDRERR=13 D ^XDREMSG G MERGEX
66 D MAILGRP
67MERGEX Q
68 ;
69TEST ;
70 X ^%ZOSF("TEST") K X
71 Q
72 ;
73MAILGRP ;
74 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)=""
75 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)=""
76 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)=""
77 K XDRI
78 Q
Note: See TracBrowser for help on using the repository browser.