- AGTMEMRG ; IHS/ASDS/EFG - MERGE EMPLOYER DATA ;
- ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- ;
- S U="^"
- SEL W !
- K DIC S AG("MODE")="SEL"
- S AG("XIT")=0,DIC="^AUTNEMPL(",DIC(0)="QEAM",DIC("A")="Select EMPLOYER (to Search against): " D ^DIC K DIC
- G XIT:X=""
- I +Y<1 G SEL
- I '$D(^AUTNEMPL(+Y,0)) W *7 K ^AUTNEMPL("B",$P(Y,U,2),+Y) G SEL
- S AG("X")=+Y,AG("X0")=^AUTNEMPL(+Y,0)
- D CHK
- G XIT:AG("XIT"),SEL
- CHK W !!,"Dup-Check for: ",$P(AG("X0"),U),!?15,$P(AG("X0"),U,2)
- I $P(AG("X0"),U,3)]"",$P(AG("X0"),U,4)]"" W !?15,$P(AG("X0"),U,3),", "
- I W $P(^DIC(5,$P(AG("X0"),U,4),0),U,2)," ",$P(AG("X0"),U,5)
- W !,"================================================"
- S DIC="^AUTNEMPL(",DIC(0)="QEAM",DIC("S")="I Y'=AG(""X"")",DIC("A")="Select (SEARCH) for Duplicate EMPLOYER: " D ^DIC K DIC
- I +Y<1 G CONT
- S AG("Y")=+Y,AG("Y0")=^AUTNEMPL(+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 ! I $P(AG("X0"),U,3)]"",$P(AG("X0"),U,4)]"" W " ",$P(AG("X0"),U,3),", "
- I W $P(^DIC(5,$P(AG("X0"),U,4),0),U,2)," ",$P(AG("X0"),U,5)
- W ?39,"| " I $P(AG("Y0"),U,3)]"",$P(AG("Y0"),U,4)]"" W $P(AG("Y0"),U,3),", ",$P(^DIC(5,$P(AG("Y0"),U,4),0),U,2)," ",$P(AG("Y0"),U,5)
- W !,"-------------------------------------------------------------------------------"
- W ! K DIR S DIR(0)="Y",DIR("A")=" Are the two Employers 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
- Q
- MOVE W !,"OK, MERGING.." ;X TO Y
- I Y=1 S AG=AG("X"),AG("X")=AG("Y"),AG("Y")=AG
- D MV2 G VERF
- MV1 S %X="^AUTNEMPL("_AG("X")_","
- S %Y="^AUTNEMPL("_AG("Y")_","
- D %XY^%RCR
- S DA=AG("Y"),DIK="^AUTNEMPL(" D IX1^DIK
- MV2 S DIK="^AUTNEMPL(",DA=AG("X") D ^DIK
- W !!,"Re-directing Pointers..."
- S DA="" F AGZ("I")=1:1 S DA=$O(^AUPNPAT("AF",AG("X"),DA)) Q:'+DA S DIE="^AUPNPAT(",DR=".19////"_AG("Y") D ^DIE K DR
- S DA="" F AGZ("I")=1:1 S DA=$O(^AUPNPAT("AG",AG("X"),DA)) Q:'+DA S DIE="^AUPNPAT(",DR=".22////"_AG("Y") D ^DIE K DR
- S DA="" F AGZ("I")=1:1 S DA=$O(^AUPN3PPH("AE",AG("X"),DA)) Q:'+DA S DIE="^AUPNPAT(",DR=".16////"_AG("Y") D ^DIE K DR
- Q
- XIT K AG
- Q
- AGTMEMRG ; IHS/ASDS/EFG - MERGE EMPLOYER 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="^AUTNEMPL("
- SET DIC(0)="QEAM"
- SET DIC("A")="Select EMPLOYER (to Search against): "
- DO ^DIC
- KILL DIC
- +3 IF X=""
- GOTO XIT
- +4 IF +Y<1
- GOTO SEL
- +5 IF '$DATA(^AUTNEMPL(+Y,0))
- WRITE *7
- KILL ^AUTNEMPL("B",$PIECE(Y,U,2),+Y)
- GOTO SEL
- +6 SET AG("X")=+Y
- SET AG("X0")=^AUTNEMPL(+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 IF $PIECE(AG("X0"),U,3)]""
- IF $PIECE(AG("X0"),U,4)]""
- WRITE !?15,$PIECE(AG("X0"),U,3),", "
- +2 IF $TEST
- WRITE $PIECE(^DIC(5,$PIECE(AG("X0"),U,4),0),U,2)," ",$PIECE(AG("X0"),U,5)
- +3 WRITE !,"================================================"
- +4 SET DIC="^AUTNEMPL("
- SET DIC(0)="QEAM"
- SET DIC("S")="I Y'=AG(""X"")"
- SET DIC("A")="Select (SEARCH) for Duplicate EMPLOYER: "
- DO ^DIC
- KILL DIC
- +5 IF +Y<1
- GOTO CONT
- +6 SET AG("Y")=+Y
- SET AG("Y0")=^AUTNEMPL(+Y,0)
- +7 WRITE !,"_______________________________________________________________________________"
- +8 WRITE !,"[1] ",$PIECE(AG("X0"),U),?39,"| [2] ",$PIECE(AG("Y0"),U)
- +9 WRITE !," ",$PIECE(AG("X0"),U,2),?39,"| ",$PIECE(AG("Y0"),U,2)
- +10 WRITE !
- IF $PIECE(AG("X0"),U,3)]""
- IF $PIECE(AG("X0"),U,4)]""
- WRITE " ",$PIECE(AG("X0"),U,3),", "
- +11 IF $TEST
- WRITE $PIECE(^DIC(5,$PIECE(AG("X0"),U,4),0),U,2)," ",$PIECE(AG("X0"),U,5)
- +12 WRITE ?39,"| "
- IF $PIECE(AG("Y0"),U,3)]""
- IF $PIECE(AG("Y0"),U,4)]""
- WRITE $PIECE(AG("Y0"),U,3),", ",$PIECE(^DIC(5,$PIECE(AG("Y0"),U,4),0),U,2)," ",$PIECE(AG("Y0"),U,5)
- +13 WRITE !,"-------------------------------------------------------------------------------"
- +14 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")=" Are the two Employers duplicates (Y/N)"
- DO ^DIR
- KILL DIR
- IF Y'=1
- GOTO CONT
- +15 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 ;X TO Y
- WRITE !,"OK, MERGING.."
- +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="^AUTNEMPL("_AG("X")_","
- +1 SET %Y="^AUTNEMPL("_AG("Y")_","
- +2 DO %XY^%RCR
- +3 SET DA=AG("Y")
- SET DIK="^AUTNEMPL("
- DO IX1^DIK
- MV2 SET DIK="^AUTNEMPL("
- SET DA=AG("X")
- DO ^DIK
- +1 WRITE !!,"Re-directing Pointers..."
- +2 SET DA=""
- FOR AGZ("I")=1:1
- SET DA=$ORDER(^AUPNPAT("AF",AG("X"),DA))
- IF '+DA
- QUIT
- SET DIE="^AUPNPAT("
- SET DR=".19////"_AG("Y")
- DO ^DIE
- KILL DR
- +3 SET DA=""
- FOR AGZ("I")=1:1
- SET DA=$ORDER(^AUPNPAT("AG",AG("X"),DA))
- IF '+DA
- QUIT
- SET DIE="^AUPNPAT("
- SET DR=".22////"_AG("Y")
- DO ^DIE
- KILL DR
- +4 SET DA=""
- FOR AGZ("I")=1:1
- SET DA=$ORDER(^AUPN3PPH("AE",AG("X"),DA))
- IF '+DA
- QUIT
- SET DIE="^AUPNPAT("
- SET DR=".16////"_AG("Y")
- DO ^DIE
- KILL DR
- +5 QUIT
- XIT KILL AG
- +1 QUIT
