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
