DPTDZCMD.m

DPTDZCMD ; IHS/TUCSON/JCM - Check merge direction ;

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

 ;

 ;this routine is executed after the user selects a merge direction

 ;for the pair of duplicate records.  It is IHS specific.

START ;

 Q:$D(ZTQUEUED)  ;quit if in background

 Q:$D(XDRM("AUTO"))  ;quit if automatic merge is on

 Q:'$D(XDRFL)  ;quit it file variable does not exist

 Q:XDRFL'=2  ;quit if file not VA PATIENT

 S DPTDZCMD("X")=X

 I $G(XDRCD)]"" S DPTDZCMD("TO")=$S(X=2:XDRCD,1:XDRCD2),DPTDZCMD("FROM")=$S(X=2:XDRCD2,1:XDRCD)

 I $G(XDRMCD)]"" S DPTDZCMD("TO")=$S(X=2:XDRMCD,1:XDRMCD2),DPTDZCMD("FROM")=$S(X=2:XDRMCD2,1:XDRMCD)

 S DPTDZCMD("RPMS SITE")=+^AUTTSITE(1,0)

 I '$D(^AUPNPAT(DPTDZCMD("TO"),41,DPTDZCMD("RPMS SITE"))),$D(^AUPNPAT(DPTDZCMD("FROM"),41,DPTDZCMD("RPMS SITE"))) D

 .W !!,$C(7),$C(7),"The FROM patient you have selected has a chart at ",$P(^DIC(4,DPTDZCMD("RPMS SITE"),0),U)

 .W !,"and the TO or TARGET patient does not.  The general rule is that when one",!,"patient has a chart at your site and the other does not, that you merge into",!,"the patient with a chart at your site."

 .S DPTDZCMD("WARNING")=""

 .Q

 I $D(^AUPNPAT(DPTDZCMD("TO"),41,DPTDZCMD("RPMS SITE"),0)),'$E($P(^AUPNPAT(DPTDZCMD("TO"),41,DPTDZCMD("RPMS SITE"),0),U,2)) D

 .W !!,$C(7),$C(7),"The TO or TARGET patient has a Temporary chart number!!","The general rule is to merge FROM a patient with a temporary number.",!

 .S DPTDZCMD("WARNING")=""

 I $D(DPTDZCMD("WARNING")) D CONFIRM

EOJ ;

 K DPTDZCMD

 Q

CONFIRM ;

 W !!,"Are you sure you have selected the correct merge direction (Y/N) N//" R DPTDZCMD("ANS"):DTIME E  S DPTDZCMD("ANS")="N"

 S:DPTDZCMD("ANS")="" DPTDZCMD("ANS")="N"

 I "YyNn"'[$E(DPTDZCMD("ANS")) W "  Please re-enter a Y or N",$C(7) G CONFIRM

 Q:"Yy"[$E(DPTDZCMD("ANS"))

 K X,Y

 Q

DPTDZCMD  ; IHS/TUCSON/JCM - Check merge direction ;

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

 +2       ;

 +3       ;this routine is executed after the user selects a merge direction

 +4       ;for the pair of duplicate records.  It is IHS specific.

START     ;

 +1       ;quit if in background

           IF $DATA(ZTQUEUED)

               QUIT 

 +2       ;quit if automatic merge is on

           IF $DATA(XDRM("AUTO"))

               QUIT 

 +3       ;quit it file variable does not exist

           IF '$DATA(XDRFL)

               QUIT 

 +4       ;quit if file not VA PATIENT

           IF XDRFL'=2

               QUIT 

 +5        SET DPTDZCMD("X")=X

 +6        IF $GET(XDRCD)]""

               SET DPTDZCMD("TO")=$SELECT(X=2:XDRCD,1:XDRCD2)

               SET DPTDZCMD("FROM")=$SELECT(X=2:XDRCD2,1:XDRCD)

 +7        IF $GET(XDRMCD)]""

               SET DPTDZCMD("TO")=$SELECT(X=2:XDRMCD,1:XDRMCD2)

               SET DPTDZCMD("FROM")=$SELECT(X=2:XDRMCD2,1:XDRMCD)

 +8        SET DPTDZCMD("RPMS SITE")=+^AUTTSITE(1,0)

 +9        IF '$DATA(^AUPNPAT(DPTDZCMD("TO"),41,DPTDZCMD("RPMS SITE")))

               IF $DATA(^AUPNPAT(DPTDZCMD("FROM"),41,DPTDZCMD("RPMS SITE")))

                   Begin DoDot:1

 +10                   WRITE !!,$CHAR(7),$CHAR(7),"The FROM patient you have selected has a chart at ",$PIECE(^DIC(4,DPTDZCMD("RPMS SITE"),0),U)

 +11                   WRITE !,"and the TO or TARGET patient does not.  The general rule is that when one",!,"patient has a chart at your site and the other does not, that you merge into",!,"the patient with a chart at your site."

 +12                   SET DPTDZCMD("WARNING")=""

 +13                   QUIT 

                   End DoDot:1

 +14       IF $DATA(^AUPNPAT(DPTDZCMD("TO"),41,DPTDZCMD("RPMS SITE"),0))

               IF '$EXTRACT($PIECE(^AUPNPAT(DPTDZCMD("TO"),41,DPTDZCMD("RPMS SITE"),0),U,2))

                   Begin DoDot:1

 +15                   WRITE !!,$CHAR(7),$CHAR(7),"The TO or TARGET patient has a Temporary chart number!!","The general rule is to merge FROM a patient with a temporary number.",!

 +16                   SET DPTDZCMD("WARNING")=""

                   End DoDot:1

 +17       IF $DATA(DPTDZCMD("WARNING"))

               DO CONFIRM

EOJ       ;

 +1        KILL DPTDZCMD

 +2        QUIT 

CONFIRM   ;

 +1        WRITE !!,"Are you sure you have selected the correct merge direction (Y/N) N//"

           READ DPTDZCMD("ANS"):DTIME

          IF '$TEST

               SET DPTDZCMD("ANS")="N"

 +2        IF DPTDZCMD("ANS")=""

               SET DPTDZCMD("ANS")="N"

 +3        IF "YyNn"'[$EXTRACT(DPTDZCMD("ANS"))

               WRITE "  Please re-enter a Y or N",$CHAR(7)

               GOTO CONFIRM

 +4        IF "Yy"[$EXTRACT(DPTDZCMD("ANS"))

               QUIT 

 +5        KILL X,Y

 +6        QUIT