source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGDRM03.m@ 836

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1RGDRM03 ;BAY/ALS-MPI/PD AWARE DUPLICATE RECORD MERGE ;03/17/00
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**6,12**;30 Apr 99
3 ;
4 ;Reference to ^DPT( supported by IA #2070
5 ;Reference to RMOVPAIR^XDRDVAL1 supported by IA #3168
6 ;
7EN(ARRAY) ; Entry point
8 F DFNFRM=0:0 S DFNFRM=$O(@ARRAY@(DFNFRM)) Q:DFNFRM'>0 D
9 . S DFNTO=$O(@ARRAY@(DFNFRM,""))
10 . S IENFRM=$O(@ARRAY@(DFNFRM,DFNTO,""))
11 . S IENTO=$O(@ARRAY@(DFNFRM,DFNTO,IENFRM,""))
12 . S RETURN=$$CKICNS^RGDRM01(DFNFRM,DFNTO)
13 . I $P(RETURN,"^",1)=1 D
14 .. D MRGTF^RGDRM02(DFNFRM,DFNTO)
15 .. D MRGSUB^RGDRM02(DFNFRM,DFNTO)
16 . I $P(RETURN,"^",1)<1 D
17 .. D START^RGHLLOG($G(HLMTIEN)),EXC^RGHLLOG(233,$P(RETURN,"^",2),DFNTO),STOP^RGHLLOG(0)
18 ..; remove pair from merge
19 .. S IEN=""
20 .. S IEN=+$G(@ARRAY@(DFNFRM,DFNTO,IENFRM,IENTO))
21 .. D RMOVPAIR^XDRDVAL1(DFNFRM,DFNTO,IEN,ARRAY)
22 ; Check to see if there are any pairs left to merge
23 K IEN,IENTO,IENFRM
24 Q
25MRGCMOR ; If the 'FROM' record has a CMOR and the 'TO' record does not, set the
26 ; field in the 'TO' record and delete the field in the 'FROM' record.
27 ; The CMOR score will be recalculated for the TO record when
28 ; merge completes.
29 L +^DPT(DFNTO):10
30 S DIE="^DPT(",DA=DFNTO,DR="991.03///^S X=CMORFRM"
31 D ^DIE K DIE,DA,DR
32 L -^DPT(DFNTO)
33DEL ; Delete field in 'FROM' record
34 L +^DPT(DFNFRM):10
35 S DIE="^DPT(",DA=DFNFRM,DR="991.03///@;991.06///@;991.07///@"
36 D ^DIE K DIE,DA,DR
37 L -^DPT(DFNFRM)
38 Q
39EXIT ;
40 Q RETURN
41GETSCR(DFN) ; Get CMOR score and calculation date given IEN (DFN) of patient file (#2)
42 Q:'DFN
43 N SCORE,SCOREDT,RETURN,SCR
44 I '$D(^DPT(DFN,"MPI")) S RETURN="-1^No MPI Node" G EXIT2
45 S DIC="^DPT(",DR="991.06;991.07",DA=DFN,DIQ="SCR",DIQ(0)="I"
46 D EN^DIQ1 K DIC,DR,DA,DIQ
47 S SCORE=$G(SCR(2,DFN,991.06,"I"))
48 S SCOREDT=$G(SCR(2,DFN,991.07,"I"))
49 S RETURN=SCORE_"^"_SCOREDT
50EXIT2 ;
51 Q RETURN
Note: See TracBrowser for help on using the repository browser.