| 1 | XDRLRFIX ;SF-CIOFO/JLI - FIX TO SET UP MERGE PROCESS CONTAINING PAIRS EXCLUDED BY LAB POINTER PROBLEMS ;05/10/99 13:53
|
|---|
| 2 | ;;7.3;TOOLKIT;**36**;Mar 24, 1999
|
|---|
| 3 | ; new routine to be called by XT*7.3*36 post-init
|
|---|
| 4 | ; two entry points, LAB and CLEANUP
|
|---|
| 5 | ; LAB will build a merge process if previous merge process
|
|---|
| 6 | ; have problems in LAB.
|
|---|
| 7 | ; CLEANUP will $order thru file 15 to ensure statuses of
|
|---|
| 8 | ; merged records are accurate.
|
|---|
| 9 | EN ;
|
|---|
| 10 | D CLEANUP
|
|---|
| 11 | D LAB
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | CLEANUP ;
|
|---|
| 15 | N I,X,XS,XD,XM,XF,XN
|
|---|
| 16 | F I=0:0 S I=$O(^VA(15,I)) Q:I'>0 D
|
|---|
| 17 | . S X=^VA(15,I,0),XS=$P(X,U,3),XD=$P(X,U,4),XM=$P(X,U,5)
|
|---|
| 18 | . I XS="V",$P($P(X,U),";",2)="DPT(" D
|
|---|
| 19 | . . S XF=+$P(X,U,+XD),XN=$P($G(^DPT(XF,0)),U)
|
|---|
| 20 | . . I $D(^DPT(XF,-9)) D
|
|---|
| 21 | . . . I XN["MERGING INTO" S XN=$P($P(XN,"(",2),")",1),$P(^DPT(XF,0),U,1)=XN
|
|---|
| 22 | . . . I XM'=2 S $P(^VA(15,I,0),U,5)=2
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | LAB ;
|
|---|
| 26 | N I,X,DFN,XARRAY
|
|---|
| 27 | S XARRAY=$NA(^TMP("XDRLRFIX",$J))
|
|---|
| 28 | K @XARRAY
|
|---|
| 29 | 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
|
|---|
| 30 | . I $P(X,U,4)'>0 N PROCES S PROCES=$P(X,U,20) I PROCES>0 D
|
|---|
| 31 | . . I $O(^VA(15.2,PROCES,2,+X,0))>0 S $P(X,U,4)=1
|
|---|
| 32 | . . I $O(^VA(15.2,PROCES,2,+$P(X,U,2),0))>0 S $P(X,U,4)=2
|
|---|
| 33 | . . Q
|
|---|
| 34 | . I $P(X,U,4)'>0 Q
|
|---|
| 35 | . S DFN=+$P(X,U,$P(X,U,4)) I '$D(^DPT(DFN,-9)) D
|
|---|
| 36 | . . S @XARRAY@(DFN,+$P(X,U,$S($P(X,U,4)=1:2,1:1)))=I
|
|---|
| 37 | . . Q
|
|---|
| 38 | . Q
|
|---|
| 39 | I $D(@XARRAY) D
|
|---|
| 40 | . N XDRXX,XDRYY,XDRMA,XDRFDA,XDRFDA
|
|---|
| 41 | . S XDRXX(15.2,"+1,",.01)="LR FIX PROCESS"
|
|---|
| 42 | . S XDRXX(15.2,"+1,",.02)=2
|
|---|
| 43 | . S XDRXX(15.2,"+1,",.04)="U"
|
|---|
| 44 | . S XDRXX(15.2,"+1,",.09)=1
|
|---|
| 45 | . D UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
|
|---|
| 46 | . S XDRFDA=$G(XDRYY(1))
|
|---|
| 47 | . ;
|
|---|
| 48 | . ; NOW MOVE LIST OF DUPLICATES TO BE PROCESSED INTO THIS ENTRY
|
|---|
| 49 | . S XDRIENS="+1,"_XDRFDA_","
|
|---|
| 50 | . F XDRI=0:0 S XDRI=$O(@XARRAY@(XDRI)) Q:XDRI'>0 D
|
|---|
| 51 | . . S XDRJ=$O(@XARRAY@(XDRI,0))
|
|---|
| 52 | . . S XDRK=@XARRAY@(XDRI,XDRJ)
|
|---|
| 53 | . . K XDRXX,XDRYY
|
|---|
| 54 | . . S XDRXX(15.22,XDRIENS,.01)=XDRI ; IEN1
|
|---|
| 55 | . . S XDRXX(15.22,XDRIENS,.02)=XDRJ ; IEN2
|
|---|
| 56 | . . S XDRXX(15.22,XDRIENS,.03)=XDRK ; ENTRY # IN FILE 15
|
|---|
| 57 | . . D UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
|
|---|
| 58 | . . K XDRXX,XDRYY,XDRMA
|
|---|
| 59 | . . ; AND MARK THEM AS IN THIS MERGE PROCESS IN FILE 15
|
|---|
| 60 | . . S XDRXX(15,XDRK_",",.2)=XDRFDA
|
|---|
| 61 | . . D FILE^DIE("","XDRXX")
|
|---|
| 62 | . . Q
|
|---|
| 63 | . Q
|
|---|
| 64 | Q
|
|---|
