RGDRM03.m

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 ---RGDRM03   1851     printed  Apr 23, 2025@17:55:59                                                                                                                                                                                                     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