ABMDTGMR.m

ABMDTGMR ; IHS/ASDST/DMJ - MERGE GROUP INSURANCE PLAN DATA ;

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

 ;

 S U="^"

SEL W !

 K DUOUT,DTOUT

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

 S ABM("XIT")=0,DIC="^AUTNEGRP(",DIC(0)="QEAM",DIC("A")="Select GROUP PLAN (to Search against): " D ^DIC K DIC

 G XIT:X=""!$D(DUOUT)!$D(DTOUT)

 I +Y<1 G SEL

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

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

 D CHK

 G XIT:ABM("XIT"),SEL

 ;

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

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

 S DIC="^AUTNEGRP(",DIC(0)="QEAM",DIC("S")="I Y'=ABM(""X"")",DIC("A")="Select (SEARCH) for Duplicate GROUP PLAN: " D ^DIC K DIC

 I +Y<1 G CONT

 S ABM("Y")=+Y,ABM("Y0")=^AUTNEGRP(+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 !,"-------------------------------------------------------------------------------"

 K DUOUT,DTOUT

 W ! K DIR S DIR(0)="Y",DIR("A")="     Are the two GROUP PLANS 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 Q:$D(DUOUT)!$D(DTOUT)

 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

 Q:$D(DUOUT)!$D(DTOUT)

 ;

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 ;W !,"OK, MERGING.." ;X TO Y

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

 D MV2 G VERF

 ;

MV1 ;merge

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

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

 ;

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

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

 S DA="" F ABMZ("I")=1:1 S DA=$O(^AUPN3PPH("AG",ABM("X"),DA)) Q:'DA  S DIE="^AUPN3PPH(",DR=".06////"_ABM("Y") D ^ABMDDIE K DR

 S DA="" F ABMZ("I")=1:1 S DA=$O(^AUTNEMPL("AG",ABM("X"),DA)) Q:'DA  S DIE="^AUTNEMPL(",DR=".09////"_ABM("Y") D ^ABMDDIE K DR

 Q

 ;

XIT K ABM

 Q

ABMDTGMR  ; IHS/ASDST/DMJ - MERGE GROUP INSURANCE PLAN DATA ;

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

 +2       ;

 +3        SET U="^"

SEL        WRITE !

 +1        KILL DUOUT,DTOUT

 +2        KILL DIC

           SET ABM("MODE")="SEL"

 +3        SET ABM("XIT")=0

           SET DIC="^AUTNEGRP("

           SET DIC(0)="QEAM"

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

           DO ^DIC

           KILL DIC

 +4        IF X=""!$DATA(DUOUT)!$DATA(DTOUT)

               GOTO XIT

 +5        IF +Y<1

               GOTO SEL

 +6        IF '$DATA(^AUTNEGRP(+Y,0))

               WRITE *7

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

               GOTO SEL

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

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

 +8        DO CHK

 +9        IF ABM("XIT")

               GOTO XIT

           GOTO SEL

 +10      ;

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

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

 +2        SET DIC="^AUTNEGRP("

           SET DIC(0)="QEAM"

           SET DIC("S")="I Y'=ABM(""X"")"

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

           DO ^DIC

           KILL DIC

 +3        IF +Y<1

               GOTO CONT

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

           SET ABM("Y0")=^AUTNEGRP(+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 !,"-------------------------------------------------------------------------------"

 +9        KILL DUOUT,DTOUT

 +10       WRITE !

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="     Are the two GROUP PLANS 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       IF $DATA(DUOUT)!$DATA(DTOUT)

               QUIT 

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

 +2        IF $DATA(DUOUT)!$DATA(DTOUT)

               QUIT 

 +3       ;

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      ;W !,"OK, MERGING.." ;X TO Y

 +1        IF Y=1

               SET ABM=ABM("X")

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

               SET ABM("Y")=ABM

 +2        DO MV2

           GOTO VERF

 +3       ;

MV1       ;merge

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

 +2        SET DA=ABM("Y")

           SET DIK="^AUTNEGRP("

           DO IX1^DIK

 +3       ;

MV2        SET DIK="^AUTNEGRP("

           SET DA=ABM("X")

           DO ^DIK

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

 +2        SET DA=""

           FOR ABMZ("I")=1:1

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

               IF 'DA

                   QUIT 

               SET DIE="^AUPN3PPH("

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

               DO ^ABMDDIE

               KILL DR

 +3        SET DA=""

           FOR ABMZ("I")=1:1

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

               IF 'DA

                   QUIT 

               SET DIE="^AUTNEMPL("

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

               DO ^ABMDDIE

               KILL DR

 +4        QUIT 

 +5       ;

XIT        KILL ABM

 +1        QUIT