RGDRM03 ;BAY/ALS-MPI/PD AWARE DUPLICATE RECORD MERGE ;03/17/00
;;1.0;CLINICAL INFO RESOURCE NETWORK;**6,12**;30 Apr 99
;
;Reference to ^DPT( supported by IA #2070
;Reference to RMOVPAIR^XDRDVAL1 supported by IA #3168
;
EN(ARRAY) ; Entry point
F DFNFRM=0:0 S DFNFRM=$O(@ARRAY@(DFNFRM)) Q:DFNFRM'>0 D
. S DFNTO=$O(@ARRAY@(DFNFRM,""))
. S IENFRM=$O(@ARRAY@(DFNFRM,DFNTO,""))
. S IENTO=$O(@ARRAY@(DFNFRM,DFNTO,IENFRM,""))
. S RETURN=$$CKICNS^RGDRM01(DFNFRM,DFNTO)
. I $P(RETURN,"^",1)=1 D
.. D MRGTF^RGDRM02(DFNFRM,DFNTO)
.. D MRGSUB^RGDRM02(DFNFRM,DFNTO)
. I $P(RETURN,"^",1)<1 D
.. D START^RGHLLOG($G(HLMTIEN)),EXC^RGHLLOG(233,$P(RETURN,"^",2),DFNTO),STOP^RGHLLOG(0)
..; remove pair from merge
.. S IEN=""
.. S IEN=+$G(@ARRAY@(DFNFRM,DFNTO,IENFRM,IENTO))
.. D RMOVPAIR^XDRDVAL1(DFNFRM,DFNTO,IEN,ARRAY)
; Check to see if there are any pairs left to merge
K IEN,IENTO,IENFRM
Q
MRGCMOR ; If the 'FROM' record has a CMOR and the 'TO' record does not, set the
; field in the 'TO' record and delete the field in the 'FROM' record.
; The CMOR score will be recalculated for the TO record when
; merge completes.
L +^DPT(DFNTO):10
S DIE="^DPT(",DA=DFNTO,DR="991.03///^S X=CMORFRM"
D ^DIE K DIE,DA,DR
L -^DPT(DFNTO)
DEL ; Delete field in 'FROM' record
L +^DPT(DFNFRM):10
S DIE="^DPT(",DA=DFNFRM,DR="991.03///@;991.06///@;991.07///@"
D ^DIE K DIE,DA,DR
L -^DPT(DFNFRM)
Q
EXIT ;
Q RETURN
GETSCR(DFN) ; Get CMOR score and calculation date given IEN (DFN) of patient file (#2)
Q:'DFN
N SCORE,SCOREDT,RETURN,SCR
I '$D(^DPT(DFN,"MPI")) S RETURN="-1^No MPI Node" G EXIT2
S DIC="^DPT(",DR="991.06;991.07",DA=DFN,DIQ="SCR",DIQ(0)="I"
D EN^DIQ1 K DIC,DR,DA,DIQ
S SCORE=$G(SCR(2,DFN,991.06,"I"))
S SCOREDT=$G(SCR(2,DFN,991.07,"I"))
S RETURN=SCORE_"^"_SCOREDT
EXIT2 ;
Q RETURN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGDRM03 1851 printed Sep 23, 2025@19:17:32 Page 2
RGDRM03 ;BAY/ALS-MPI/PD AWARE DUPLICATE RECORD MERGE ;03/17/00
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**6,12**;30 Apr 99
+2 ;
+3 ;Reference to ^DPT( supported by IA #2070
+4 ;Reference to RMOVPAIR^XDRDVAL1 supported by IA #3168
+5 ;
EN(ARRAY) ; Entry point
+1 FOR DFNFRM=0:0
SET DFNFRM=$ORDER(@ARRAY@(DFNFRM))
if DFNFRM'>0
QUIT
Begin DoDot:1
+2 SET DFNTO=$ORDER(@ARRAY@(DFNFRM,""))
+3 SET IENFRM=$ORDER(@ARRAY@(DFNFRM,DFNTO,""))
+4 SET IENTO=$ORDER(@ARRAY@(DFNFRM,DFNTO,IENFRM,""))
+5 SET RETURN=$$CKICNS^RGDRM01(DFNFRM,DFNTO)
+6 IF $PIECE(RETURN,"^",1)=1
Begin DoDot:2
+7 DO MRGTF^RGDRM02(DFNFRM,DFNTO)
+8 DO MRGSUB^RGDRM02(DFNFRM,DFNTO)
End DoDot:2
+9 IF $PIECE(RETURN,"^",1)<1
Begin DoDot:2
+10 DO START^RGHLLOG($GET(HLMTIEN))
DO EXC^RGHLLOG(233,$PIECE(RETURN,"^",2),DFNTO)
DO STOP^RGHLLOG(0)
+11 ; remove pair from merge
+12 SET IEN=""
+13 SET IEN=+$GET(@ARRAY@(DFNFRM,DFNTO,IENFRM,IENTO))
+14 DO RMOVPAIR^XDRDVAL1(DFNFRM,DFNTO,IEN,ARRAY)
End DoDot:2
End DoDot:1
+15 ; Check to see if there are any pairs left to merge
+16 KILL IEN,IENTO,IENFRM
+17 QUIT
MRGCMOR ; If the 'FROM' record has a CMOR and the 'TO' record does not, set the
+1 ; field in the 'TO' record and delete the field in the 'FROM' record.
+2 ; The CMOR score will be recalculated for the TO record when
+3 ; merge completes.
+4 LOCK +^DPT(DFNTO):10
+5 SET DIE="^DPT("
SET DA=DFNTO
SET DR="991.03///^S X=CMORFRM"
+6 DO ^DIE
KILL DIE,DA,DR
+7 LOCK -^DPT(DFNTO)
DEL ; Delete field in 'FROM' record
+1 LOCK +^DPT(DFNFRM):10
+2 SET DIE="^DPT("
SET DA=DFNFRM
SET DR="991.03///@;991.06///@;991.07///@"
+3 DO ^DIE
KILL DIE,DA,DR
+4 LOCK -^DPT(DFNFRM)
+5 QUIT
EXIT ;
+1 QUIT RETURN
GETSCR(DFN) ; Get CMOR score and calculation date given IEN (DFN) of patient file (#2)
+1 if 'DFN
QUIT
+2 NEW SCORE,SCOREDT,RETURN,SCR
+3 IF '$DATA(^DPT(DFN,"MPI"))
SET RETURN="-1^No MPI Node"
GOTO EXIT2
+4 SET DIC="^DPT("
SET DR="991.06;991.07"
SET DA=DFN
SET DIQ="SCR"
SET DIQ(0)="I"
+5 DO EN^DIQ1
KILL DIC,DR,DA,DIQ
+6 SET SCORE=$GET(SCR(2,DFN,991.06,"I"))
+7 SET SCOREDT=$GET(SCR(2,DFN,991.07,"I"))
+8 SET RETURN=SCORE_"^"_SCOREDT
EXIT2 ;
+1 QUIT RETURN
