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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1XDRDQUE ;SF-IRMFO/IHS/OHPRD/JCM - START AND STOP DUPLICATE CHECKER SEARCH ;08/03/2000 07:29
2 ;;7.3;TOOLKIT;**23,47**;Apr 25, 1995
3 ;;
4START ;
5 S XDRQFLG=0
6 ;*** following commented line to be removed from Toolkit ver after 7.3
7 ;S XDRDQUE("TASKMAN STATUS")=$P(@$Q(^%ZTSCH("STATUS","")),U,2) I XDRDQUE("TASKMAN STATUS")'="RUN" W !!,"Taskman does not seem to be running properly, Please notify your site manager.",!! G END
8 S XDRDQUE("TASKMAN STATUS")=$$TM^%ZTLOAD
9 I 'XDRDQUE("TASKMAN STATUS") W !!,"Taskman does not seem to be running properly, Please notify your site manager.",!! G END
10 D FILE G:XDRQFLG END ; Asks user which file to check for dups
11 D CHECK^XDRU1 G:XDRQFLG END ; Checks the Duplicate Resolution file
12 D ASK G:XDRQFLG END ; Asks user what action and type of search
13 D QUEUE G:XDRQFLG END ; Queues search
14 I XDRDNSTA="r" D ASK3 D:'XDRQFLG QUEUE
15END D EOJ ; Clean up variables
16 Q
17 ;
18FILE ; EP - Called by XDRDCOMP,XDRDLIST,XDRDSCOR,XDRMADD,XDRCNT
19 K DIC("B")
20 K X S:$D(XDRFL) X=XDRFL
21 S DIC(0)=$S($D(X):"Z",1:"QEAZ")
22 S:'$D(DIC("A")) DIC("A")="Select file to be checked for duplicates: "
23 S DIC="^VA(15.1," D ^DIC K DIC,X
24 I Y=-1 S XDRQFLG=1 G FILEX
25 S XDRD(0)=Y(0),XDRD(0,0)=Y(0,0),XDRFL=$P(Y(0),U),PRIFILE=XDRFL K Y
26 W:'$D(ZTQUEUED) !!
27FILEX Q
28 ;
29ASK ;
30 D DISP
31 D ASK1 G:XDRQFLG ASKX
32 I XDRDSTA="c"&($D(^VA(15.1,XDRFL,"APDTI"))) S XDRDPDTI="" W !!,"Since the Potential Duplicate Threshold has been raised",!,"I will only go through the Potential Duplicates and see if they",!,"meet the new threshold." G ASKX
33 D:XDRDSTA="c"&('XDRQFLG) ASK2
34ASKX ;
35 Q
36DISP ;
37 D DISP^XDRDSTAT
38 S XDRDSTA=$P(XDRD(0),U,2)
39 S XDRDTYPE=$P(XDRD(0),U,5)
40 Q
41ASK1 ;
42 S:XDRDSTA']"" XDRDSTA="c"
43 S DIR(0)="Y",DIR("A")="Do You wish to "_$S(XDRDSTA="h":"CONTINUE",XDRDSTA="e":"CONTINUE",XDRDSTA="r":"HALT",1:"RUN")_" "_$S(XDRDSTA="r":"this",XDRDSTA="h":"this",XDRDSTA="e":"this",1:"a")_" search (Y/N)"
44 D ^DIR K DIR D OUT
45 I 'XDRQFLG,'Y,$S(XDRDSTA="r":0,XDRDSTA="c":0,1:1) D S Y=0
46 . S DIR(0)="Y",DIR("A")="Do you wish to mark this run COMPLETED (Y/N)",DIR("B")="NO" D ^DIR K DIR D OUT
47 . I Y,'XDRQFLG S DIE="^VA(15.1,",DA=XDRFL,DR=".02////c" D ^DIE K DA,DIE,DR
48 S:'Y XDRQFLG=1
49 K XDRDNSTA
50 S:'XDRQFLG XDRDNSTA=$S(XDRDSTA="h":"r",XDRDSTA="r":"h",1:"r")
51 Q
52ASK2 ;
53 K XDRDTYPE
54 S DIR(0)="15.1,.05A",DIR("A")="Which type of Search do you wish to run ? (BASIC/NEW) "
55 S DIR("B")="BASIC",DIR("?")="A 'BASIC' search starts at the beginning of the file. A 'NEW' search uses a cross-reference you specify to determine which entries to test."
56 D ^DIR K DIR D OUT
57 S XDRDTYPE=$S(Y="b":"BASIC",1:"NEW")
58 I XDRDTYPE="BASIC" D
59 . N DIR S DIR(0)="Y"
60 . S DIR("A",1)="This process will take a **LONG** time (known to exceed 100 hours),"
61 . S DIR("A",2)="but you CAN stop and restart the process when you want using"
62 . S DIR("A")="the options OK"
63 . D ^DIR S:Y'>0 XDRQFLG=1
64 . Q
65 Q
66 ;
67ASK3 ;
68 W !
69 S DIR(0)="Y",DIR("A")="Do You wish to schedule a time to HALT this search (Y/N)"
70 D ^DIR K DIR D OUT
71 S:'Y XDRQFLG=1
72 G:XDRQFLG ASK3X
73 S XDRDNSTA="h"
74ASK3X Q
75 ;
76QUEUE ;
77 S ZTRTN="XDRDMAIN",ZTIO="",ZTDESC="Duplicate "_XDRD(0,0)_" Search"
78 S:XDRDNSTA="h" ZTDESC="Halt "_ZTDESC
79 S ZTSAVE("XDRFL")="" S:$D(XDRDPDTI) ZTSAVE("XDRDPDTI")=""
80 S ZTSAVE("XDRDTYPE")="",ZTSAVE("XDRDNSTA")=""
81 D ^%ZTLOAD
82 S:'$D(ZTQUEUED) XDRQFLG=1
83 K ZTSK
84QUEUEX Q
85 ;
86OUT ;
87 ; Common point to take care of DIR,DIC, and DIE calls
88 I ($D(DTOUT))!($D(DUOUT))!($D(DIRUT)) K DTOUT,DUOUT,DIRUT S XDRQFLG=1
89 Q
90EOJ ;
91 K X,Y,XDRFL,XDRDNSTA,XDRDSTA,XDRQFLG,XDRD,XDRDPDTI,XDRDQUE
92 Q
Note: See TracBrowser for help on using the repository browser.