| [613] | 1 | IMRXDRPT ;SF-IRMFO.SEA/JLI,HCIOFO/DDA - ROUTINE TO MERGE ENTRIES IN ICR FILE FOR PATIENT MERGE ;5/19/98 08:55
|
|---|
| 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;**2**;Feb 09,1998
|
|---|
| 3 | EN(ARRAY) ; Entry point for merging. Array is the NAME of array in which from and to entries are indicated.
|
|---|
| 4 | ;
|
|---|
| 5 | N FROMX,TO,X,FROMXA,TOA,ARRAY1,FRX,TOX,FROM
|
|---|
| 6 | S ARRAY1=$NA(^TMP($J,"IMRMRG1"))
|
|---|
| 7 | K @ARRAY1
|
|---|
| 8 | S FROM=ARRAY1
|
|---|
| 9 | F FROMX=0:0 S FROMX=$O(@ARRAY@(FROMX)) Q:FROMX'>0 D
|
|---|
| 10 | . S TO=$O(@ARRAY@(FROMX,0))
|
|---|
| 11 | . S FRX=$O(@ARRAY@(FROMX,TO,""))
|
|---|
| 12 | . S TOX=$O(@ARRAY@(FROMX,TO,FRX,""))
|
|---|
| 13 | . S X=FROMX D XOR^IMRXOR S FROMXA=+$O(^IMR(158,"B",X,""))
|
|---|
| 14 | . S X=TO D XOR^IMRXOR S TOA=+$O(^IMR(158,"B",X,""))
|
|---|
| 15 | . ; Quit if there are no equivalent IMR records.
|
|---|
| 16 | . Q:(FROMXA'>0)&(TOA'>0)
|
|---|
| 17 | . ; If there is only a 'to' IMR record, nil tracking dates and quit
|
|---|
| 18 | . I FROMXA'>0 D NIL(TOA) Q
|
|---|
| 19 | . ; If there is only a 'from' IMR record, create one to merge 'to'
|
|---|
| 20 | . I TOA'>0 D
|
|---|
| 21 | .. N IMRFDA,IMRIEN
|
|---|
| 22 | .. S X=TO D XOR^IMRXOR
|
|---|
| 23 | .. S IMRFDA(158,"+1,",.01)=X
|
|---|
| 24 | .. D UPDATE^DIE("","IMRFDA","IMRIEN","")
|
|---|
| 25 | .. S TOA=IMRIEN(1)
|
|---|
| 26 | .. Q
|
|---|
| 27 | . S @ARRAY1@(FROMXA,TOA,FRX,TOX)=""
|
|---|
| 28 | . Q
|
|---|
| 29 | D EN^XDRMERG(158,ARRAY1)
|
|---|
| 30 | I '$D(XDRERR) D
|
|---|
| 31 | . S FR158IEN=0
|
|---|
| 32 | . F S FR158IEN=$O(@ARRAY1@(FR158IEN)) Q:FR158IEN'>0 D
|
|---|
| 33 | ..;Reset merged-to entry tracking dates to nil, insuring accurate
|
|---|
| 34 | ..; roll-up of data to the national data set.
|
|---|
| 35 | .. S TO158IEN=$O(@ARRAY1@(FR158IEN,0))
|
|---|
| 36 | .. D NIL(TO158IEN)
|
|---|
| 37 | ..;Call logic to safely DELETE Immunology record. This also sends a
|
|---|
| 38 | ..; delete request to the national data set.
|
|---|
| 39 | .. S FROMDFN=+$O(@ARRAY1@(FR158IEN,TO158IEN,""))
|
|---|
| 40 | .. D EN^IMRDEL(FR158IEN,FROMDFN)
|
|---|
| 41 | .. Q
|
|---|
| 42 | . K FR158IEN,FROMDFN,TO158IEN
|
|---|
| 43 | . Q
|
|---|
| 44 | K @ARRAY1
|
|---|
| 45 | Q
|
|---|
| 46 | NIL(DA) S DIE="^IMR(158,"
|
|---|
| 47 | S DR="101.01///@;101.02///@;101.03///@;101.04///@;101.05///@;101.06///@;101.07///@;101.08///@;101.09///@;101.1///@;101.11///@;101.12///@;101.13///@;101.14///@;101.15///@;101.16///@;101.17///@"
|
|---|
| 48 | L +^IMR(158,DA) D ^DIE L -^IMR(158,DA)
|
|---|
| 49 | K DA,DIE,DR,DTOUT
|
|---|
