close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRDMAIN.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

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

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

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
1XDRDMAIN ;SF-IRMFO/IHS/OHPRD/JCM - MAIN DRIVER FOR DUPLICATE CHECKING SOFTWARE ;1/5/98 13:27
2 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
3 ;;
4START ;
5 S XDRQFLG=0
6 S XDRMAINI="DUP" D ^XDRMAINI G:XDRQFLG END
7 I $$NEWERR^%ZTER() N $ETRAP,$ESTACK S $ETRAP="D ERR^XDRDMAIN"
8 E S X="ERR^XDRDMAIN",@^%ZOSF("TRAP")
9 K ^XTMP("XDRERR",XDRFL) S ^XTMP("XDRERR",0)=($$FMADD^XLFDT(DT,30))_U_DT
10 I $D(^VA(15.1,XDRFL,"APDTI")) D ^XDRDPDTI,COMPLETE G END
11 D:$D(XDRDTYPE) @XDRDTYPE
12 D COMPLETE ;I $P(^VA(15.1,XDRFL,0),U,2)="r" D COMPLETE
13END D EOJ
14 Q
15ERR ;
16 S XDRQERR=1
17 S XDREMSG=$ZE
18 S XDRQERR=1
19 D ^%ZTER
20 D COMPLETE
21 G UNWIND^%ZTER
22 ;
23BASIC ;
24 S XDRD("GL")=XDRGL_"XDRCD)"
25 I $P(XDRD(0),U,6)]"" S XDRD("NEW GL")=XDRGL_""""_$P(XDRD(0),U,6)_""""_",XDRCD)"
26 F XDRDI1=0:0 S $P(^VA(15.1,XDRFL,3),U)=$$NOW^XLFDT() S XDRCD=$O(@XDRD("GL")) Q:'XDRCD!($P(^VA(15.1,XDRFL,0),U,2)="h")!(XDRQFLG) D POSDUPS D:$D(^TMP("XDRD",$J,XDRFL)) BCHECK D COUNT K:$D(XDRD("NEW GL")) @XDRD("NEW GL")
27 I $P(^VA(15.1,XDRFL,0),U,2)="h" S XDRQFLG=1
28 K XDRDI1
29 Q
30NEW ;
31 ;I $P(XDRD(0),U,6)="" S XDRERR=17 D ^XDREMSG Q ; COMMENTED OUT 1/5/98 JLI
32 ;S XDRD("GL")=XDRGL_""""_$P(XDRD(0),U,6)_""""_",XDRCD)" ; COMMENTED OUT 1/5/98 JLI
33 ;F XDRDI1=0:0 S $P(^VA(15.1,XDRFL,3),U)=$$NOW^XLFDT() S XDRCD=$O(@XDRD("GL")) Q:'XDRCD!($P(^VA(15.1,XDRFL,0),U,2)="h")!(XDRQFLG) D POSDUPS D:$D(^TMP("XDRD",$J,XDRFL)) NCHECK K @XDRD("GL") D COUNT ; COMMENTED OUT 1/5/98 JLI
34 ; ABOVE LINES USE A SPECIAL CROSS REFERENCE FOR NEW SEARCH, INSTEAD THE
35 ; FOLLOWING LINES USE THE HIGHEST NUMBER PREVIOUSLY FOUND AS A POTENTIAL
36 ; DUPLICATE AS THE STARTING POINT FOR THE NEW SEARCH.
37 S XDRD("GL")=XDRGL_",XDRCD)" D ; ADDED 1/5/98 JLI
38 . N I,X,XGL
39 . S XGL=$E(XDRGL,2,$L(XDRGL))
40 . S I="",X=0
41 . F S I=$O(^VA(15,"B",I)) Q:I="" I $P(I,";",2)=XGL,I>X S X=+I
42 . S XDRCD=X
43 G BASIC
44 ;I $P(^VA(15.1,XDRFL,0),U,2)="h" S XDRQFLG=1 ; COMMENTED OUT 1/5/98
45 ;K XDRDI1 ; COMMENTED OUT 1/5/98
46 Q
47POSDUPS ;
48 K ^TMP("XDRD",$J,XDRFL)
49 G:$D(^VA(15,"AFR",$P(XDRGL,U,2),XDRCD)) POSDUPSX
50 ; *** Above I check to see if the record has already been merged. I
51 ; would have preferred to check some node within the file being
52 ; checked since the Duplicate Record file may be purged, Fileman at
53 ; some point in the future will provide a merged node.
54 ; ***
55 ; We will pass the variable XDRCD for them to then get the candidates
56 ; Expect the routine to send back the possibles in
57 ; ^TMP("XDRD",$J,XDRFL
58 ;
59 I '$D(@(XDRGL_XDRCD_",0)")) G POSDUPSX
60 S X=$P(XDRD("COLLECTION ROUTINE"),U,2) X ^%ZOSF("TEST") K X I '$T S XDRERR=2 D ^XDREMSG G POSDUPSX
61 D @XDRD("COLLECTION ROUTINE")
62POSDUPSX Q
63 ;
64BCHECK ;
65 F XDRCD2=0:0 S XDRCD2=$O(^TMP("XDRD",$J,XDRFL,XDRCD2)) Q:'XDRCD2!(XDRQFLG) I $S(XDRDTYPE="BASIC":XDRCD2>XDRCD,1:1) D CHECK ; MODIFIED 1/5/98 JLI
66 K ^TMP("XDRD",$J,XDRFL) F %=0:0 S %=$O(XDRCD(0)) Q:'% K XDRCD(%)
67 K %
68 Q
69 ;
70NCHECK ;
71 F XDRCD2=0:0 S XDRCD2=$O(^TMP("XDRD",$J,XDRFL,XDRCD2)) Q:'XDRCD2!(XDRQFLG) S XDRD("GL2")=XDRGL_""""_$P(XDRD(0),U,6)_""""_",XDRCD2)" D:'$D(@XDRD("GL2")) CHECK
72 K ^TMP("XDRD",$J,XDRFL) F %=0:0 S %=$O(XDRCD(0)) Q:'% K XDRCD(%)
73 K %,XDRD("GL2")
74 Q
75CHECK ;
76 S XDRDMAIN("DUPFLG")=0
77 I $D(^VA(15,"AFR",$P(XDRGL,U,2),XDRCD2)) G CHECKX
78 S XDRDPAIR=$S(XDRCD<XDRCD2:XDRCD_U_XDRCD2,1:XDRCD2_U_XDRCD)
79 F XDRDI="APOT","ANOT","AVDUP" I $D(^VA(15,XDRDI,$P(XDRGL,U,2),XDRDPAIR)) S:XDRDTYPE'="NEW" XDRDMAIN("DUPFLG")=1 D:XDRDTYPE="NEW" DIK
80 K XDRDI,XDRDPAIR
81 D:'XDRDMAIN("DUPFLG") ^XDRDUP
82CHECKX ;
83 Q
84DIK ;
85 ; If a new search type deletes any verified non-duplicates or potential
86 ; duplicate entries involving the two records.
87 S DA=$O(^VA(15,XDRDI,$P(XDRGL,U,2),XDRDPAIR,0)),DIK="^VA(15,"
88 D ^DIK K DIK,DA
89 Q
90COUNT ;
91 S XDRDCNT=XDRDCNT+1
92 S DIE="^VA(15.1,",DA=XDRFL,DR=".07////"_XDRDCNT_";.08////"_XDRCD
93 D ^DIE K DIE,DR,DA,D0
94 Q
95COMPLETE ;
96 N DIE,DA,DR,%,X,Y
97 S DIE="^VA(15.1,",DA=XDRFL
98 S DR=$S($D(XDRQERR):".02////e",XDRQFLG:".02////h",1:".02////c")
99 D NOW^%DTC
100 S DR=DR_";.04////"_%
101 S DR=DR_";.1////"_($P(^VA(15.1,XDRFL,0),U,10)+$$FMDIFF^XLFDT(%,$P(^(0),U,3),2))
102 D ^DIE
103 S $P(^VA(15.1,XDRFL,3),U)=""
104 I $D(XDREMSG) S ^XTMP("XDRERR",XDRFL)=XDREMSG
105 Q
106EOJ ;
107 S:$D(ZTQUEUED) ZTREQ="@"
108 K XDRDSCOR,XDRDTEST,XDRDMAIN,XDRD,XDRDCNT,XDRCD,XDRCD2,XDRDTYPE
109 K XDRFL,XDRGL,XDRDPDTI,XDRDPAIR,XDRQFLG,XDRDTYPE,XDRDNSTA
110 Q
Note: See TracBrowser for help on using the repository browser.