111 lines
4.1 KiB
Mathematica
111 lines
4.1 KiB
Mathematica
XDRDMAIN ;SF-IRMFO/IHS/OHPRD/JCM - MAIN DRIVER FOR DUPLICATE CHECKING SOFTWARE ;1/5/98 13:27
|
|
;;7.3;TOOLKIT;**23**;Apr 25, 1995
|
|
;;
|
|
START ;
|
|
S XDRQFLG=0
|
|
S XDRMAINI="DUP" D ^XDRMAINI G:XDRQFLG END
|
|
I $$NEWERR^%ZTER() N $ETRAP,$ESTACK S $ETRAP="D ERR^XDRDMAIN"
|
|
E S X="ERR^XDRDMAIN",@^%ZOSF("TRAP")
|
|
K ^XTMP("XDRERR",XDRFL) S ^XTMP("XDRERR",0)=($$FMADD^XLFDT(DT,30))_U_DT
|
|
I $D(^VA(15.1,XDRFL,"APDTI")) D ^XDRDPDTI,COMPLETE G END
|
|
D:$D(XDRDTYPE) @XDRDTYPE
|
|
D COMPLETE ;I $P(^VA(15.1,XDRFL,0),U,2)="r" D COMPLETE
|
|
END D EOJ
|
|
Q
|
|
ERR ;
|
|
S XDRQERR=1
|
|
S XDREMSG=$ZE
|
|
S XDRQERR=1
|
|
D ^%ZTER
|
|
D COMPLETE
|
|
G UNWIND^%ZTER
|
|
;
|
|
BASIC ;
|
|
S XDRD("GL")=XDRGL_"XDRCD)"
|
|
I $P(XDRD(0),U,6)]"" S XDRD("NEW GL")=XDRGL_""""_$P(XDRD(0),U,6)_""""_",XDRCD)"
|
|
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")
|
|
I $P(^VA(15.1,XDRFL,0),U,2)="h" S XDRQFLG=1
|
|
K XDRDI1
|
|
Q
|
|
NEW ;
|
|
;I $P(XDRD(0),U,6)="" S XDRERR=17 D ^XDREMSG Q ; COMMENTED OUT 1/5/98 JLI
|
|
;S XDRD("GL")=XDRGL_""""_$P(XDRD(0),U,6)_""""_",XDRCD)" ; COMMENTED OUT 1/5/98 JLI
|
|
;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
|
|
; ABOVE LINES USE A SPECIAL CROSS REFERENCE FOR NEW SEARCH, INSTEAD THE
|
|
; FOLLOWING LINES USE THE HIGHEST NUMBER PREVIOUSLY FOUND AS A POTENTIAL
|
|
; DUPLICATE AS THE STARTING POINT FOR THE NEW SEARCH.
|
|
S XDRD("GL")=XDRGL_",XDRCD)" D ; ADDED 1/5/98 JLI
|
|
. N I,X,XGL
|
|
. S XGL=$E(XDRGL,2,$L(XDRGL))
|
|
. S I="",X=0
|
|
. F S I=$O(^VA(15,"B",I)) Q:I="" I $P(I,";",2)=XGL,I>X S X=+I
|
|
. S XDRCD=X
|
|
G BASIC
|
|
;I $P(^VA(15.1,XDRFL,0),U,2)="h" S XDRQFLG=1 ; COMMENTED OUT 1/5/98
|
|
;K XDRDI1 ; COMMENTED OUT 1/5/98
|
|
Q
|
|
POSDUPS ;
|
|
K ^TMP("XDRD",$J,XDRFL)
|
|
G:$D(^VA(15,"AFR",$P(XDRGL,U,2),XDRCD)) POSDUPSX
|
|
; *** Above I check to see if the record has already been merged. I
|
|
; would have preferred to check some node within the file being
|
|
; checked since the Duplicate Record file may be purged, Fileman at
|
|
; some point in the future will provide a merged node.
|
|
; ***
|
|
; We will pass the variable XDRCD for them to then get the candidates
|
|
; Expect the routine to send back the possibles in
|
|
; ^TMP("XDRD",$J,XDRFL
|
|
;
|
|
I '$D(@(XDRGL_XDRCD_",0)")) G POSDUPSX
|
|
S X=$P(XDRD("COLLECTION ROUTINE"),U,2) X ^%ZOSF("TEST") K X I '$T S XDRERR=2 D ^XDREMSG G POSDUPSX
|
|
D @XDRD("COLLECTION ROUTINE")
|
|
POSDUPSX Q
|
|
;
|
|
BCHECK ;
|
|
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
|
|
K ^TMP("XDRD",$J,XDRFL) F %=0:0 S %=$O(XDRCD(0)) Q:'% K XDRCD(%)
|
|
K %
|
|
Q
|
|
;
|
|
NCHECK ;
|
|
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
|
|
K ^TMP("XDRD",$J,XDRFL) F %=0:0 S %=$O(XDRCD(0)) Q:'% K XDRCD(%)
|
|
K %,XDRD("GL2")
|
|
Q
|
|
CHECK ;
|
|
S XDRDMAIN("DUPFLG")=0
|
|
I $D(^VA(15,"AFR",$P(XDRGL,U,2),XDRCD2)) G CHECKX
|
|
S XDRDPAIR=$S(XDRCD<XDRCD2:XDRCD_U_XDRCD2,1:XDRCD2_U_XDRCD)
|
|
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
|
|
K XDRDI,XDRDPAIR
|
|
D:'XDRDMAIN("DUPFLG") ^XDRDUP
|
|
CHECKX ;
|
|
Q
|
|
DIK ;
|
|
; If a new search type deletes any verified non-duplicates or potential
|
|
; duplicate entries involving the two records.
|
|
S DA=$O(^VA(15,XDRDI,$P(XDRGL,U,2),XDRDPAIR,0)),DIK="^VA(15,"
|
|
D ^DIK K DIK,DA
|
|
Q
|
|
COUNT ;
|
|
S XDRDCNT=XDRDCNT+1
|
|
S DIE="^VA(15.1,",DA=XDRFL,DR=".07////"_XDRDCNT_";.08////"_XDRCD
|
|
D ^DIE K DIE,DR,DA,D0
|
|
Q
|
|
COMPLETE ;
|
|
N DIE,DA,DR,%,X,Y
|
|
S DIE="^VA(15.1,",DA=XDRFL
|
|
S DR=$S($D(XDRQERR):".02////e",XDRQFLG:".02////h",1:".02////c")
|
|
D NOW^%DTC
|
|
S DR=DR_";.04////"_%
|
|
S DR=DR_";.1////"_($P(^VA(15.1,XDRFL,0),U,10)+$$FMDIFF^XLFDT(%,$P(^(0),U,3),2))
|
|
D ^DIE
|
|
S $P(^VA(15.1,XDRFL,3),U)=""
|
|
I $D(XDREMSG) S ^XTMP("XDRERR",XDRFL)=XDREMSG
|
|
Q
|
|
EOJ ;
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
K XDRDSCOR,XDRDTEST,XDRDMAIN,XDRD,XDRDCNT,XDRCD,XDRCD2,XDRDTYPE
|
|
K XDRFL,XDRGL,XDRDPDTI,XDRDPAIR,XDRQFLG,XDRDTYPE,XDRDNSTA
|
|
Q
|