DPTDPO.m

DPTDPO ; IHS/TUCSON/JCM - PATIENT POST-MERGE ROUTINE ; [ 02/03/94  7:28 AM ]

 ;;1.0;PATIENT MERGE;;FEB 02, 1994

 ;

 ; Calls: DIC,DIK

 ;

START ;

 D INIT

 D RESET

END D EOJ

 Q

 ;

INIT ;

 K DPTDPO

 S DPTDPO("FR NAME")=$P(^DPT(XDRMRG("FR"),0),U,1)

 I DPTDPO("FR NAME")'=$P(^DPT(XDRMRG("TO"),0),U,1) D OTHER

 Q

 ;

OTHER ;

 S DIC="^DPT("_XDRMRG("TO")_",.01,",DIC(0)="FL"

 S DIC("P")=$P(^DD(2,1,0),U,2),DA(1)=XDRMRG("TO"),X=DPTDPO("FR NAME")

 D ^DIC K DA,DIC,DIE

 Q

 ;

RESET ;

 S DIK="^DPT(",DA=XDRMRG("FR") D ^DIK K DA,DIK

 S ^DPT(XDRMRG("FR"),0)="*"_$E(DPTDPO("FR NAME"),1,28)_"*",$P(^(0),U,19)=XDRMRG("TO")

 S ^DPT("B","*"_$E(DPTDPO("FR NAME"),1,28)_"*",XDRMRG("FR"))=""

 L +^DPT(0):0 S $P(^(0),U,4)=($P(^DPT(0),U,4)+1) L -^DPT(0):0

 Q

 ;

EOJ ;

 K DPTDPO

 Q

DPTDPO    ; IHS/TUCSON/JCM - PATIENT POST-MERGE ROUTINE ; [ 02/03/94  7:28 AM ]

 +1       ;;1.0;PATIENT MERGE;;FEB 02, 1994

 +2       ;

 +3       ; Calls: DIC,DIK

 +4       ;

START     ;

 +1        DO INIT

 +2        DO RESET

END        DO EOJ

 +1        QUIT 

 +2       ;

INIT      ;

 +1        KILL DPTDPO

 +2        SET DPTDPO("FR NAME")=$PIECE(^DPT(XDRMRG("FR"),0),U,1)

 +3        IF DPTDPO("FR NAME")'=$PIECE(^DPT(XDRMRG("TO"),0),U,1)

               DO OTHER

 +4        QUIT 

 +5       ;

OTHER     ;

 +1        SET DIC="^DPT("_XDRMRG("TO")_",.01,"

           SET DIC(0)="FL"

 +2        SET DIC("P")=$PIECE(^DD(2,1,0),U,2)

           SET DA(1)=XDRMRG("TO")

           SET X=DPTDPO("FR NAME")

 +3        DO ^DIC

           KILL DA,DIC,DIE

 +4        QUIT 

 +5       ;

RESET     ;

 +1        SET DIK="^DPT("

           SET DA=XDRMRG("FR")

           DO ^DIK

           KILL DA,DIK

 +2        SET ^DPT(XDRMRG("FR"),0)="*"_$EXTRACT(DPTDPO("FR NAME"),1,28)_"*"

           SET $PIECE(^(0),U,19)=XDRMRG("TO")

 +3        SET ^DPT("B","*"_$EXTRACT(DPTDPO("FR NAME"),1,28)_"*",XDRMRG("FR"))=""

 +4        LOCK +^DPT(0):0

           SET $PIECE(^(0),U,4)=($PIECE(^DPT(0),U,4)+1)

           LOCK -^DPT(0):0

 +5        QUIT 

 +6       ;

EOJ       ;

 +1        KILL DPTDPO

 +2        QUIT