ABMDTIMR.m

ABMDTIMR ; IHS/ASDST/DMJ - INSURER MERGE ; 

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

 ;

 ; IHS/SD/SDR - v2.5 p9 - IM17864

 ;   Remove merge changes to 3P Bill file

 ;

SEL W !

 S ABM("MODE")="SEL"

 S ABM("XIT")=0,DIC="^AUTNINS(",DIC(0)="QEAM",DIC("A")="Select INSURER (to Search against): " S DIC("S")="I $D(^(1)),$P(^(1),U,7)'=0,$D(^(2)),""DRN""'[$P(^(2),U)"

 D ^DIC

 I X="" G XIT

 I +Y<1 G SEL

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

 D CHK

 G XIT:ABM("XIT"),SEL

 ;

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

 I $P(ABM("X0"),U,3)]"",$P(ABM("X0"),U,4)]"" W !?15,$P(ABM("X0"),U,3),", "

 I  W $P(^DIC(5,$P(ABM("X0"),U,4),0),U,2)," ",$P(ABM("X0"),U,5)

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

 S DIC="^AUTNINS(",DIC(0)="QEAM",DIC("S")="I Y'=ABM(""X""),$D(^(1)),$P(^(1),U,7)'=0,$D(^(2)),""DNR""'[$P(^(2),U)",DIC("A")="Select (SEARCH) for Duplicate INSURER: " D ^DIC

 I +Y<1 G CONT

 S ABM("Y")=+Y,ABM("Y0")=^AUTNINS(+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 ! I $P(ABM("X0"),U,3)]"",$P(ABM("X0"),U,4)]"" W "     ",$P(ABM("X0"),U,3),", "

 I  W $P(^DIC(5,$P(ABM("X0"),U,4),0),U,2)," ",$P(ABM("X0"),U,5)

 W ?39,"|      " I $P(ABM("Y0"),U,3)]"",$P(ABM("Y0"),U,4)]"" W $P(ABM("Y0"),U,3),", ",$P(^DIC(5,$P(ABM("Y0"),U,4),0),U,2)," ",$P(ABM("Y0"),U,5)

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

 W ! K DIR S DIR(0)="Y",DIR("A")="     Are the two Insurers 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 S ABM("XIT")=0 Q

 ;

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 K ABM("ADD")

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

 W !,"OK, MERGING.." D PTR G VERF ;X TO Y

 ;

 I $D(^AUTNINS(ABM("X"),1)),$P(^(1),U)]"",$P(^(1),U,2)]"",$P(^(1),U,3)]"",$P(^(1),U,4)]"",$P(^(1),U,5)]"" G MV1

 I $P(^AUTNINS(ABM("X"),0),U,2)]"",$P(^(0),U,3)]"",$P(^(0),U,4)]"",$P(^(0),U,5)]"" F ABM("I")=1:1:5 S ABM("ADD",ABM("I"))=$P(^(0),U,ABM("I"))

 ;

MV1 ;merge

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

 I $D(ABM("ADD")) F ABM("I")=1:1:5 Q:'$D(ABM("ADD",ABM("I")))  S $P(^AUTNINS(ABM("Y"),1),U,ABM("I"))=ABM("ADD",ABM("I"))

 S DA=ABM("X"),DIK="^AUTNINS(" D IX1^DIK

 ;

PTR S DIE="^AUTNINS(",DA=ABM("X"),DR=".17////0;.27////"_ABM("Y")_";.41////MERGED TO DFN"_ABM("Y") D ^ABMDDIE K DR

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

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

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

 S DA="" F  S DA=$O(^AUPN3PPH("E",ABM("X"),DA)) Q:'DA  S DIE="^AUPN3PPH(",DR=".03////"_ABM("Y") D ^ABMDDIE K DR

 S DA="" F  S DA=$O(^AUTTPIC("C",ABM("X"),DA)) Q:'DA  S DIE="^AUTTPIC(",DR=".02////"_ABM("Y") D ^ABMDDIE K DR

 S DA="" F  S DA=$O(^AUTNEMPL("AI",ABM("X"),DA)) Q:'DA  S DIE="^AUTNEMPL(",DR=".08////"_ABM("Y") D ^ABMDDIE K DR

 S DA="" F  S DA=$O(^ABPVFAC("I",ABM("X"),DA)) Q:'DA  S DIE="^ABPVFAC(",DR="7////"_ABM("Y") D ^ABMDDIE K DR

 S DA(1)="" F  S DA(1)=$O(^ABMDERR("AB",ABM("X"),DA(1))) Q:'DA(1)  D

 .S (DIC,DIK)="^ABMDERR("_DA(1)_",11,",DA=ABM("X") D ^DIK

 .S (DINUM,X)=ABM("Y"),DIC(0)="LE" K DD,D0 D FILE^DICN

 Q

 ;

XIT K ABM

 Q

ABMDTIMR  ; IHS/ASDST/DMJ - INSURER MERGE ; 

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

 +2       ;

 +3       ; IHS/SD/SDR - v2.5 p9 - IM17864

 +4       ;   Remove merge changes to 3P Bill file

 +5       ;

SEL        WRITE !

 +1        SET ABM("MODE")="SEL"

 +2        SET ABM("XIT")=0

           SET DIC="^AUTNINS("

           SET DIC(0)="QEAM"

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

           SET DIC("S")="I $D(^(1)),$P(^(1),U,7)'=0,$D(^(2)),""DRN""'[$P(^(2),U)"

 +3        DO ^DIC

 +4        IF X=""

               GOTO XIT

 +5        IF +Y<1

               GOTO SEL

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

           SET ABM("X0")=^AUTNINS(+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)

 +1        IF $PIECE(ABM("X0"),U,3)]""

               IF $PIECE(ABM("X0"),U,4)]""

                   WRITE !?15,$PIECE(ABM("X0"),U,3),", "

 +2       IF $TEST

               WRITE $PIECE(^DIC(5,$PIECE(ABM("X0"),U,4),0),U,2)," ",$PIECE(ABM("X0"),U,5)

 +3        WRITE !,"================================================"

 +4        SET DIC="^AUTNINS("

           SET DIC(0)="QEAM"

           SET DIC("S")="I Y'=ABM(""X""),$D(^(1)),$P(^(1),U,7)'=0,$D(^(2)),""DNR""'[$P(^(2),U)"

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

           DO ^DIC

 +5        IF +Y<1

               GOTO CONT

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

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

 +7        WRITE !,"_______________________________________________________________________________"

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

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

 +10       WRITE !

           IF $PIECE(ABM("X0"),U,3)]""

               IF $PIECE(ABM("X0"),U,4)]""

                   WRITE "     ",$PIECE(ABM("X0"),U,3),", "

 +11      IF $TEST

               WRITE $PIECE(^DIC(5,$PIECE(ABM("X0"),U,4),0),U,2)," ",$PIECE(ABM("X0"),U,5)

 +12       WRITE ?39,"|      "

           IF $PIECE(ABM("Y0"),U,3)]""

               IF $PIECE(ABM("Y0"),U,4)]""

                   WRITE $PIECE(ABM("Y0"),U,3),", ",$PIECE(^DIC(5,$PIECE(ABM("Y0"),U,4),0),U,2)," ",$PIECE(ABM("Y0"),U,5)

 +13       WRITE !,"-------------------------------------------------------------------------------"

 +14       WRITE !

           KILL DIR

           SET DIR(0)="Y"

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

           DO ^DIR

           KILL DIR

           IF Y'=1

               GOTO CONT

 +15       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

 +16       IF Y=1!(Y=2)

               GOTO MOVE

 +17      ;

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

               SET ABM("XIT")=0

               QUIT 

 +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       ;

MOVE       KILL ABM("ADD")

 +1        IF Y=1

               SET ABM=ABM("X")

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

               SET ABM("Y")=ABM

 +2       ;X TO Y

           WRITE !,"OK, MERGING.."

           DO PTR

           GOTO VERF

 +3       ;

 +4        IF $DATA(^AUTNINS(ABM("X"),1))

               IF $PIECE(^(1),U)]""

                   IF $PIECE(^(1),U,2)]""

                       IF $PIECE(^(1),U,3)]""

                           IF $PIECE(^(1),U,4)]""

                               IF $PIECE(^(1),U,5)]""

                                   GOTO MV1

 +5        IF $PIECE(^AUTNINS(ABM("X"),0),U,2)]""

               IF $PIECE(^(0),U,3)]""

                   IF $PIECE(^(0),U,4)]""

                       IF $PIECE(^(0),U,5)]""

                           FOR ABM("I")=1:1:5

                               SET ABM("ADD",ABM("I"))=$PIECE(^(0),U,ABM("I"))

 +6       ;

MV1       ;merge

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

 +2        IF $DATA(ABM("ADD"))

               FOR ABM("I")=1:1:5

                   IF '$DATA(ABM("ADD",ABM("I")))

                       QUIT 

                   SET $PIECE(^AUTNINS(ABM("Y"),1),U,ABM("I"))=ABM("ADD",ABM("I"))

 +3        SET DA=ABM("X")

           SET DIK="^AUTNINS("

           DO IX1^DIK

 +4       ;

PTR        SET DIE="^AUTNINS("

           SET DA=ABM("X")

           SET DR=".17////0;.27////"_ABM("Y")_";.41////MERGED TO DFN"_ABM("Y")

           DO ^ABMDDIE

           KILL DR

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

 +2        SET DA(1)=""

           FOR 

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

               IF 'DA(1)

                   QUIT 

               Begin DoDot:1

 +3                SET DA=""

                   FOR 

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

                       IF 'DA

                           QUIT 

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

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

                       DO ^ABMDDIE

                       KILL DR

               End DoDot:1

 +4        SET DA=""

           FOR 

               SET DA=$ORDER(^AUPN3PPH("E",ABM("X"),DA))

               IF 'DA

                   QUIT 

               SET DIE="^AUPN3PPH("

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

               DO ^ABMDDIE

               KILL DR

 +5        SET DA=""

           FOR 

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

               IF 'DA

                   QUIT 

               SET DIE="^AUTTPIC("

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

               DO ^ABMDDIE

               KILL DR

 +6        SET DA=""

           FOR 

               SET DA=$ORDER(^AUTNEMPL("AI",ABM("X"),DA))

               IF 'DA

                   QUIT 

               SET DIE="^AUTNEMPL("

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

               DO ^ABMDDIE

               KILL DR

 +7        SET DA=""

           FOR 

               SET DA=$ORDER(^ABPVFAC("I",ABM("X"),DA))

               IF 'DA

                   QUIT 

               SET DIE="^ABPVFAC("

               SET DR="7////"_ABM("Y")

               DO ^ABMDDIE

               KILL DR

 +8        SET DA(1)=""

           FOR 

               SET DA(1)=$ORDER(^ABMDERR("AB",ABM("X"),DA(1)))

               IF 'DA(1)

                   QUIT 

               Begin DoDot:1

 +9                SET (DIC,DIK)="^ABMDERR("_DA(1)_",11,"

                   SET DA=ABM("X")

                   DO ^DIK

 +10               SET (DINUM,X)=ABM("Y")

                   SET DIC(0)="LE"

                   KILL DD,D0

                   DO FILE^DICN

               End DoDot:1

 +11       QUIT 

 +12      ;

XIT        KILL ABM

 +1        QUIT