65 lines
2.1 KiB
Mathematica
65 lines
2.1 KiB
Mathematica
XDRLRFIX ;SF-CIOFO/JLI - FIX TO SET UP MERGE PROCESS CONTAINING PAIRS EXCLUDED BY LAB POINTER PROBLEMS ;05/10/99 13:53
|
|
;;7.3;TOOLKIT;**36**;Mar 24, 1999
|
|
; new routine to be called by XT*7.3*36 post-init
|
|
; two entry points, LAB and CLEANUP
|
|
; LAB will build a merge process if previous merge process
|
|
; have problems in LAB.
|
|
; CLEANUP will $order thru file 15 to ensure statuses of
|
|
; merged records are accurate.
|
|
EN ;
|
|
D CLEANUP
|
|
D LAB
|
|
Q
|
|
;
|
|
CLEANUP ;
|
|
N I,X,XS,XD,XM,XF,XN
|
|
F I=0:0 S I=$O(^VA(15,I)) Q:I'>0 D
|
|
. S X=^VA(15,I,0),XS=$P(X,U,3),XD=$P(X,U,4),XM=$P(X,U,5)
|
|
. I XS="V",$P($P(X,U),";",2)="DPT(" D
|
|
. . S XF=+$P(X,U,+XD),XN=$P($G(^DPT(XF,0)),U)
|
|
. . I $D(^DPT(XF,-9)) D
|
|
. . . I XN["MERGING INTO" S XN=$P($P(XN,"(",2),")",1),$P(^DPT(XF,0),U,1)=XN
|
|
. . . I XM'=2 S $P(^VA(15,I,0),U,5)=2
|
|
Q
|
|
;
|
|
LAB ;
|
|
N I,X,DFN,XARRAY
|
|
S XARRAY=$NA(^TMP("XDRLRFIX",$J))
|
|
K @XARRAY
|
|
F I=0:0 S I=$O(^VA(15,I)) Q:I'>0 S X=^(I,0) I $P($P(X,U),";",2)="DPT(",$P(X,U,5)=2 D
|
|
. I $P(X,U,4)'>0 N PROCES S PROCES=$P(X,U,20) I PROCES>0 D
|
|
. . I $O(^VA(15.2,PROCES,2,+X,0))>0 S $P(X,U,4)=1
|
|
. . I $O(^VA(15.2,PROCES,2,+$P(X,U,2),0))>0 S $P(X,U,4)=2
|
|
. . Q
|
|
. I $P(X,U,4)'>0 Q
|
|
. S DFN=+$P(X,U,$P(X,U,4)) I '$D(^DPT(DFN,-9)) D
|
|
. . S @XARRAY@(DFN,+$P(X,U,$S($P(X,U,4)=1:2,1:1)))=I
|
|
. . Q
|
|
. Q
|
|
I $D(@XARRAY) D
|
|
. N XDRXX,XDRYY,XDRMA,XDRFDA,XDRFDA
|
|
. S XDRXX(15.2,"+1,",.01)="LR FIX PROCESS"
|
|
. S XDRXX(15.2,"+1,",.02)=2
|
|
. S XDRXX(15.2,"+1,",.04)="U"
|
|
. S XDRXX(15.2,"+1,",.09)=1
|
|
. D UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
|
|
. S XDRFDA=$G(XDRYY(1))
|
|
. ;
|
|
. ; NOW MOVE LIST OF DUPLICATES TO BE PROCESSED INTO THIS ENTRY
|
|
. S XDRIENS="+1,"_XDRFDA_","
|
|
. F XDRI=0:0 S XDRI=$O(@XARRAY@(XDRI)) Q:XDRI'>0 D
|
|
. . S XDRJ=$O(@XARRAY@(XDRI,0))
|
|
. . S XDRK=@XARRAY@(XDRI,XDRJ)
|
|
. . K XDRXX,XDRYY
|
|
. . S XDRXX(15.22,XDRIENS,.01)=XDRI ; IEN1
|
|
. . S XDRXX(15.22,XDRIENS,.02)=XDRJ ; IEN2
|
|
. . S XDRXX(15.22,XDRIENS,.03)=XDRK ; ENTRY # IN FILE 15
|
|
. . D UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
|
|
. . K XDRXX,XDRYY,XDRMA
|
|
. . ; AND MARK THEM AS IN THIS MERGE PROCESS IN FILE 15
|
|
. . S XDRXX(15,XDRK_",",.2)=XDRFDA
|
|
. . D FILE^DIE("","XDRXX")
|
|
. . Q
|
|
. Q
|
|
Q
|