source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRLRFIX.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: 2.1 KB
Line 
1XDRLRFIX ;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.
9EN ;
10 D CLEANUP
11 D LAB
12 Q
13 ;
14CLEANUP ;
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 ;
25LAB ;
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
Note: See TracBrowser for help on using the repository browser.