source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRXDRPT.m@ 724

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1IMRXDRPT ;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
3EN(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
46NIL(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
Note: See TracBrowser for help on using the repository browser.