Routine: AGTMGMRG

AGTMGMRG ; IHS/ASDS/EFG - MERGE GROUP INSURANCE PLAN DATA ;

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 S U="^"

SEL W !

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

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

 G XIT:X=""

 I +Y<1 G SEL

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

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

 D CHK

 G XIT:AG("XIT"),SEL

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

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

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

 I +Y<1 G CONT

 S AG("Y")=+Y,AG("Y0")=^AUTNEGRP(+Y,0)

 W !,"_______________________________________________________________________________"

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

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

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

 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(AG("X0"),U)_";2:"_$P(AG("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(AG("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 AG("XIT")=1

MOVE ;

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

 D MV2 G VERF

MV1 S %X="^AUTNEGRP("_AG("X")_","

 S %Y="^AUTNEGRP("_AG("Y")_","

 D %XY^%RCR

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

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

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

 S DA="" F AGZ("I")=1:1 S DA=$O(^AUPN3PPH("AG",AG("X"),DA)) Q:'+DA  S DIE="^AUPN3PPH(",DR=".06////"_AG("Y") D ^DIE K DR

XIT K AG

AGTMGMRG  ; IHS/ASDS/EFG - MERGE GROUP INSURANCE PLAN DATA ;

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2       ;

 +3        SET U="^"

SEL        WRITE !

 +1        KILL DIC

           SET AG("MODE")="SEL"

 +2        SET AG("XIT")=0

           SET DIC="^AUTNEGRP("

           SET DIC(0)="QEAM"

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

           DO ^DIC

           KILL DIC

 +3        IF X=""

               GOTO XIT

 +4        IF +Y<1

               GOTO SEL

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

               WRITE *7

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

               GOTO SEL

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

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

 +7        DO CHK

 +8        IF AG("XIT")

               GOTO XIT

           GOTO SEL

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

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

 +2        SET DIC="^AUTNEGRP("

           SET DIC(0)="QEAM"

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

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

           DO ^DIC

           KILL DIC

 +3        IF +Y<1

               GOTO CONT

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

           SET AG("Y0")=^AUTNEGRP(+Y,0)

 +5        WRITE !,"_______________________________________________________________________________"

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

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

 +8        WRITE !,"-------------------------------------------------------------------------------"

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

 +10       WRITE !

           KILL DIR

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

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

           DO ^DIR

           KILL DIR

           IF Y=1!(Y=2)

               GOTO MOVE

CONT       WRITE !!

           KILL DIR

           SET DIR(0)="Y"

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

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF Y=1

               GOTO CHK

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 AG("XIT")=1

 +1        QUIT

MOVE      ;

 +1        IF Y=1

               SET AG=AG("X")

               SET AG("X")=AG("Y")

               SET AG("Y")=AG

 +2        DO MV2

           GOTO VERF

MV1        SET %X="^AUTNEGRP("_AG("X")_","

 +1        SET %Y="^AUTNEGRP("_AG("Y")_","

 +2        DO %XY^%RCR

 +3        SET DA=AG("Y")

           SET DIK="^AUTNEGRP("

           DO IX1^DIK

MV2        SET DIK="^AUTNEGRP("

           SET DA=AG("X")

           DO ^DIK

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

 +2        SET DA=""

           FOR AGZ("I")=1:1

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

               IF '+DA

                   QUIT

               SET DIE="^AUPN3PPH("

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

               DO ^DIE

               KILL DR

 +3        QUIT

XIT        KILL AG

 +1        QUIT

AGTMGMRG.m