ABMDTPMR.m

ABMDTPMR ; IHS/ASDST/DMJ - MERGE POLICY HOLDER DATA ;

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;

 S U="^"

SEL W !

 K DIC S ABM("MODE")="SEL"

 S ABM("XIT")=0,DIC="^AUPN3PPH(",DIC(0)="QEAM",DIC("A")="Select POLICY HOLDER (to Search against): " D ^DIC K DIC

 G XIT:X=""

 I +Y<1 G SEL

 I '$D(^AUPN3PPH(+Y,0)) W *7 K ^AUPN3PPH("B",$P(Y,U,2),+Y) G SEL

 S ABM("X")=+Y,ABM("X0")=^AUPN3PPH(+Y,0)

 D CHK

 G XIT:ABM("XIT"),SEL

 ;

CHK W !!,"Dup-Check for: ",$P(ABM("X0"),U),!?15,$P(ABM("X0"),U,2),!?15,$P(ABM("X0"),U,3)

 W !,"================================================"

 S DIC="^AUPN3PPH(",DIC(0)="QEAM",DIC("S")="I Y'=ABM(""X""),$P(^(0),U,3)=$P(ABM(""X0""),U,3)",DIC("A")="Select (SEARCH) for Duplicate POLICY HOLDER: " D ^DIC K DIC

 I +Y<1 G CONT

 S ABM("Y")=+Y,ABM("Y0")=^AUPN3PPH(+Y,0)

 W !,"_______________________________________________________________________________"

 W !,"[1]  ",$P(ABM("X0"),U),?39,"| [2]  ",$P(ABM("Y0"),U)

 W !,"     ",$P(ABM("X0"),U,2),?39,"|      ",$P(ABM("Y0"),U,2)

 W !,"     ",$P(ABM("X0"),U,3),?39,"|      ",$P(ABM("Y0"),U,3)

 W !,"-------------------------------------------------------------------------------"

 W ! K DIR S DIR(0)="Y",DIR("A")="     Are the two POLICY HOLDERS duplicates (Y/N)" D ^DIR K DIR I Y'=1 G CONT

 W ! K DIR S DIR(0)="SO^1:"_$P(ABM("X0"),U)_";2:"_$P(ABM("Y0"),U),DIR("A")="     Which of the two is most accurate" D ^DIR K DIR I Y=1!(Y=2) G MOVE

 ;

CONT W !! K DIR S DIR(0)="Y",DIR("A")="Do you want to dup-check "_$P(ABM("X0"),U)_" any more",DIR("B")="Y" D ^DIR K DIR I Y=1 G CHK

 ;

VERF W !! K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue running this program",DIR("B")="Y" D ^DIR K DIR I Y'=1 S ABM("XIT")=1

 Q

 ;

 ;

MOVE I Y=1 S ABM=ABM("X"),ABM("X")=ABM("Y"),ABM("Y")=ABM

 D MV2 G VERF

 ;

MV1 ;merge

 M ^AUPN3PPH(ABM("Y"))=^AUPN3PPH(ABM("X"))

 S DA=ABM("Y"),DIK="^AUPN3PPH(" D IX1^DIK

 ;

MV2 S DIK="^AUPN3PPH(",DA=ABM("X") D ^DIK

 W !!,"Re-directing Pointers..."

 S DA(1)="" F ABMZ("I")=1:1 S DA(1)=$O(^AUPNPRVT("C",ABM("X"),DA(1))) Q:'DA(1)  D

 .S DA="" F ABMZ("I")=1:1 S DA=$O(^AUPNPRVT("C",ABM("X"),DA(1),DA)) Q:'DA  S DIE="^AUPNPRVT("_DA(1)_",11,",DR=".08////"_ABM("Y") D ^ABMDDIE K DR

 Q

 ;

XIT K ABM

 Q

ABMDTPMR  ; IHS/ASDST/DMJ - MERGE POLICY HOLDER DATA ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;

 +3        SET U="^"

SEL        WRITE !

 +1        KILL DIC

           SET ABM("MODE")="SEL"

 +2        SET ABM("XIT")=0

           SET DIC="^AUPN3PPH("

           SET DIC(0)="QEAM"

           SET DIC("A")="Select POLICY HOLDER (to Search against): "

           DO ^DIC

           KILL DIC

 +3        IF X=""

               GOTO XIT

 +4        IF +Y<1

               GOTO SEL

 +5        IF '$DATA(^AUPN3PPH(+Y,0))

               WRITE *7

               KILL ^AUPN3PPH("B",$PIECE(Y,U,2),+Y)

               GOTO SEL

 +6        SET ABM("X")=+Y

           SET ABM("X0")=^AUPN3PPH(+Y,0)

 +7        DO CHK

 +8        IF ABM("XIT")

               GOTO XIT

           GOTO SEL

 +9       ;

CHK        WRITE !!,"Dup-Check for: ",$PIECE(ABM("X0"),U),!?15,$PIECE(ABM("X0"),U,2),!?15,$PIECE(ABM("X0"),U,3)

 +1        WRITE !,"================================================"

 +2        SET DIC="^AUPN3PPH("

           SET DIC(0)="QEAM"

           SET DIC("S")="I Y'=ABM(""X""),$P(^(0),U,3)=$P(ABM(""X0""),U,3)"

           SET DIC("A")="Select (SEARCH) for Duplicate POLICY HOLDER: "

           DO ^DIC

           KILL DIC

 +3        IF +Y<1

               GOTO CONT

 +4        SET ABM("Y")=+Y

           SET ABM("Y0")=^AUPN3PPH(+Y,0)

 +5        WRITE !,"_______________________________________________________________________________"

 +6        WRITE !,"[1]  ",$PIECE(ABM("X0"),U),?39,"| [2]  ",$PIECE(ABM("Y0"),U)

 +7        WRITE !,"     ",$PIECE(ABM("X0"),U,2),?39,"|      ",$PIECE(ABM("Y0"),U,2)

 +8        WRITE !,"     ",$PIECE(ABM("X0"),U,3),?39,"|      ",$PIECE(ABM("Y0"),U,3)

 +9        WRITE !,"-------------------------------------------------------------------------------"

 +10       WRITE !

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="     Are the two POLICY HOLDERS duplicates (Y/N)"

           DO ^DIR

           KILL DIR

           IF Y'=1

               GOTO CONT

 +11       WRITE !

           KILL DIR

           SET DIR(0)="SO^1:"_$PIECE(ABM("X0"),U)_";2:"_$PIECE(ABM("Y0"),U)

           SET DIR("A")="     Which of the two is most accurate"

           DO ^DIR

           KILL DIR

           IF Y=1!(Y=2)

               GOTO MOVE

 +12      ;

CONT       WRITE !!

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="Do you want to dup-check "_$PIECE(ABM("X0"),U)_" any more"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF Y=1

               GOTO CHK

 +1       ;

VERF       WRITE !!

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="Do you wish to continue running this program"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF Y'=1

               SET ABM("XIT")=1

 +1        QUIT 

 +2       ;

 +3       ;

MOVE       IF Y=1

               SET ABM=ABM("X")

               SET ABM("X")=ABM("Y")

               SET ABM("Y")=ABM

 +1        DO MV2

           GOTO VERF

 +2       ;

MV1       ;merge

 +1        MERGE ^AUPN3PPH(ABM("Y"))=^AUPN3PPH(ABM("X"))

 +2        SET DA=ABM("Y")

           SET DIK="^AUPN3PPH("

           DO IX1^DIK

 +3       ;

MV2        SET DIK="^AUPN3PPH("

           SET DA=ABM("X")

           DO ^DIK

 +1        WRITE !!,"Re-directing Pointers..."

 +2        SET DA(1)=""

           FOR ABMZ("I")=1:1

               SET DA(1)=$ORDER(^AUPNPRVT("C",ABM("X"),DA(1)))

               IF 'DA(1)

                   QUIT 

               Begin DoDot:1

 +3                SET DA=""

                   FOR ABMZ("I")=1:1

                       SET DA=$ORDER(^AUPNPRVT("C",ABM("X"),DA(1),DA))

                       IF 'DA

                           QUIT 

                       SET DIE="^AUPNPRVT("_DA(1)_",11,"

                       SET DR=".08////"_ABM("Y")

                       DO ^ABMDDIE

                       KILL DR

               End DoDot:1

 +4        QUIT 

 +5       ;

XIT        KILL ABM

 +1        QUIT