source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRXDRPT.m@ 1123

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1LRXDRPT ;SF-IRMFO.SEA/JLI/DALISC/FHS - HANDLE MERGE OF ENTRIES IN FILE 63 RELATED TO PATIENT MERGE ;10/30/97 11:50
2 ;;5.2;LAB SERVICE;**205**;Sep 27, 1994
3 ;;
4 ;;
5EN(LRRAY) ; Entry point for merging. Array is the NAME of array in which the FROM IEN and the TO IEN are indicated, as @LRRAY@(LRFROMX,LRTO).
6 ;IEN are IENs from ^DPT( to be merged
7 ;example LRX(IEN_FROM,IEN_TO,"IEN_FROM;DPT(",IEN_TO;DPT(")=""
8 N LRFROMX,LRTO,LRRAY1,LRFROMXA,LRTOA,LRZZZ,LRFRX,LRTOX,FROM
9 S LRRAY1=$NA(^TMP($J,"LRMERG1"))
10 K @LRRAY1
11 S FROM=LRRAY1
12 F LRFROMX=0:0 S LRFROMX=$O(@LRRAY@(LRFROMX)) Q:LRFROMX'>0 D
13 . S LRFROMXA=+$G(^DPT(LRFROMX,"LR"))
14 . I LRFROMXA,$S($P($G(^LR(LRFROMXA,0)),U,2)'=2:1,$P($G(^(0)),U,3)'=LRFROMX:1,1:0) D Q
15 . . ;W !,"Pointer between ^LR("_LRFROMXA_") and ^DPT("_LRFROMX_",LR) don't match."
16 . . ;W !!?10,"Laboratory Patient merge terminated",!
17 . . K @LRRAY@(LRFROMX)
18 . S LRTO=$O(@LRRAY@(LRFROMX,0))
19 . S LRTOA=+$G(^DPT(LRTO,"LR"))
20 . I LRTOA,$S($P($G(^LR(LRTOA,0)),U,2)'=2:1,$P($G(^(0)),U,3)'=LRTO:1,1:0) D Q
21 . . ;W !,"Pointer between ^LR("_LRTOA_",0) and ^DPT("_LRTO_",""LR"") don't match"
22 . . K @LRRAY@(LRFROMX,LRTO)
23 . I LRFROMXA'="",LRFROMXA=LRTOA Q ; ALREADY MERGED
24 . S LRFROMXA=$S(LRFROMXA>0:LRFROMXA,1:0),LRTOA=$S(LRTOA>0:LRTOA,1:0)
25 . S LRFRX=$O(@LRRAY@(LRFROMX,LRTO,"")),LRTOX=$O(@LRRAY@(LRFROMX,LRTO,LRFRX,""))
26 . S @LRRAY1@(LRFROMXA,LRTOA,LRFRX,LRTOX)=LRFROMX
27 . I LRFROMXA=0 D Q
28 . . I LRTOA>0 D SAVEMERG^XDRMERGB(63,LRFROMXA,LRTOA)
29 . . K @LRRAY1@(LRFROMXA,LRTOA)
30 . I LRTOA=0 D Q
31 . . D SAVEMERG^XDRMERGB(63,LRFROMXA,LRTOA)
32 . . K @LRRAY1@(LRFROMXA,LRTOA)
33 . . S ^DPT(LRTO,"LR")=LRFROMXA
34 . . S LRZZZ(63,LRFROMXA_",",.03)=LRTO
35 . . D UPDATE^DIE("","LRZZZ")
36 I $D(@LRRAY1) D
37 . S LRFROMXA="" F S LRFROMXA=$O(@LRRAY1@(LRFROMXA)) Q:LRFROMXA="" I $D(^LR(LRFROMXA,"T")) D
38 . . S LRTOA=$O(@LRRAY1@(LRFROMXA,""))
39 . . M ^LR(LRTOA,"T")=^LR(LRFROMXA,"T")
40 . D EN^XDRMERG(63,LRRAY1)
41 F LRFROMXA=0:0 S LRFROMXA=$O(@LRRAY1@(LRFROMXA)) Q:LRFROMXA'>0 D
42 . S LRTOA=$O(@LRRAY1@(LRFROMXA,0))
43 . S LRFRX=$O(@LRRAY1@(LRFROMXA,LRTOA,""))
44 . S LRTOX=$O(@LRRAY1@(LRFROMXA,LRTOA,LRFRX,""))
45 . S LRFROMX=@LRRAY1@(LRFROMXA,LRTOA,LRFRX,LRTOX)
46 . S ^DPT(LRFROMX,"LR")=LRTOA
47 . K ^LR(LRFROMXA)
48 K @LRRAY1
49 Q
Note: See TracBrowser for help on using the repository browser.