- 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
