BCHMNRP ; IHS/CMI/LAB - MERGE NON-REGISTERED PATIENTS ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;
;
W !!,"This option is used to merge two Non-Registered Patients who are"
W !,"in the file as duplicates. You will be asked to select the two"
W !,"patients who are duplicates. If one patient has a data value"
W !,"such as Tribe and the other doesn't the system will use the Tribe"
W !,"value from the patient with Tribe recorded. If both patients"
W !,"have a data value and they are different you will be asked to"
W !,"choose which value to use. Values looked at are: DOB, Sex,"
W !,"SSN, Name, Tribe, Community of Residence.",!!
GETPAT1 ;
K DIC
S (BCHPAT1,BCHPAT2)=""
W !!,"Please select the first patient of the set of duplicates.",!
S DIC="^BCHRPAT(",DIC(0)="AEMQ" D ^DIC
I Y=-1 W !,"BYE" D XIT Q
S BCHPAT1=+Y
;
GETPAT2 ;
K DIC
W !!,"Please select the second patient of the set of duplicates.",!
S DIC="^BCHRPAT(",DIC(0)="AEMQ" D ^DIC
I Y=-1 W !,"BYE" D XIT Q
I +Y=BCHPAT1 W !!,"YOU CAN'T SELECT THE SAME PATIENT AS THE FIRST PATIENT!" G GETPAT2
S BCHPAT2=+Y
W !!,"You have selected the following 2 patients to merge together:"
W ! S DIC="^BCHRPAT(",DA=BCHPAT1 D EN^DIQ
W ! S DIC="^BCHRPAT(",DA=BCHPAT2 D EN^DIQ
CMM ;
K BCHDATA,BCHMAST
S BCHQUIT=0
F BCHF=".01",".02",".03",".04",".05",".06" Q:BCHQUIT D CHK
I BCHQUIT D XIT Q
W !!,"I am going to merge the following two patients together using the"
W !,"following values for the demographic data:"
W !!?5,"Patient 1: ",$$VAL^XBDIQ1(90002.11,BCHPAT1,.01)
W !?5,"Patient 2: ",$$VAL^XBDIQ1(90002.11,BCHPAT2,.01)
W !
S BCHX="" F S BCHX=$O(BCHMAST(BCHX)) Q:BCHX="" W !?8,$P(^DD(90002.11,BCHX,0),U,1),": ",BCHMAST(BCHX)
W !
CONT ;
S DIR(0)="Y",DIR("A")="Do you wish to continue" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
I 'Y D XIT Q
D MERGE
Q
XIT ;
D EN^XBVK("BCH")
Q
CHK ;
S BCHDATA(BCHPAT1,BCHF)=$$VAL^XBDIQ1(90002.11,BCHPAT1,BCHF)
S BCHDATA(BCHPAT2,BCHF)=$$VAL^XBDIQ1(90002.11,BCHPAT2,BCHF)
I BCHDATA(BCHPAT1,BCHF)]"",BCHDATA(BCHPAT2,BCHF)="" S BCHMAST(BCHF)=BCHDATA(BCHPAT1,BCHF) Q
I BCHDATA(BCHPAT1,BCHF)="",BCHDATA(BCHPAT2,BCHF)="" S BCHMAST(BCHF)=BCHDATA(BCHPAT1,BCHF) Q ;don't bother, both blank
I BCHDATA(BCHPAT1,BCHF)=BCHDATA(BCHPAT2,BCHF) S BCHMAST(BCHF)=BCHDATA(BCHPAT1,BCHF) Q
I BCHDATA(BCHPAT1,BCHF)="",BCHDATA(BCHPAT2,BCHF)]"" S BCHMAST(BCHF)=BCHDATA(BCHPAT2,BCHF) Q
;CHOOSE WHICH VALUE
W !
K DIR
S DIR(0)="S^1:"_BCHDATA(BCHPAT1,BCHF)_";2:"_BCHDATA(BCHPAT2,BCHF),DIR("A")="Which Value for "_$P(^DD(90002.11,BCHF,0),U,1)_" should be used" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S BCHQUIT=1 Q
I Y="" S BCHQUIT=1 Q
I Y=1 S BCHMAST(BCHF)=BCHDATA(BCHPAT1,BCHF)
I Y=2 S BCHMAST(BCHF)=BCHDATA(BCHPAT2,BCHF)
Q
MERGE ;
;EDIT BCHPAT1 WITH MASTER VALUES
;GET TRIBE AND COMMUNITY IENS
W !,"Hold on...this may take a few minutes.."
S BCHT=""
S BCHVC=0,BCHGC=0
I BCHMAST(".05")]"" S BCHT=$O(^AUTTTRI("B",BCHMAST(".05"),0))
S BCHTC=""
I BCHMAST(".06")]"" S BCHC=$O(^AUTTCOM("B",BCHMAST(".06"),0))
S DA=BCHPAT1,DIE="^BCHRPAT(",DR=".01///"_BCHMAST(".01")_";.02///"_BCHMAST(".02")_";.03///"_BCHMAST(".03")_";.04///"_BCHMAST(".04")_";.05////"_BCHT_";.06////"_BCHC
D ^DIE
K DA,DR,DIE
;repoint 1112 of CHR Record file
S BCHV=0 F S BCHV=$O(^BCHR("ANRP",BCHPAT1,BCHV)) Q:BCHV'=+BCHV D
.S DA=BCHV,DR="1112////"_BCHPAT1,DIE="^BCHR(" D ^DIE
.K DIE,DR,DA
.S BCHVC=BCHVC+1 W "."
;NOW DELETE BCHPAT2
S DA=BCHPAT2,DIK="^BCHRPAT(" D ^DIK
W !!,"Patients have been merged. ",BCHVC," records were re-pointed.",!
Q
BCHMNRP ; IHS/CMI/LAB - MERGE NON-REGISTERED PATIENTS ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;
+3 ;
+4 WRITE !!,"This option is used to merge two Non-Registered Patients who are"
+5 WRITE !,"in the file as duplicates. You will be asked to select the two"
+6 WRITE !,"patients who are duplicates. If one patient has a data value"
+7 WRITE !,"such as Tribe and the other doesn't the system will use the Tribe"
+8 WRITE !,"value from the patient with Tribe recorded. If both patients"
+9 WRITE !,"have a data value and they are different you will be asked to"
+10 WRITE !,"choose which value to use. Values looked at are: DOB, Sex,"
+11 WRITE !,"SSN, Name, Tribe, Community of Residence.",!!
GETPAT1 ;
+1 KILL DIC
+2 SET (BCHPAT1,BCHPAT2)=""
+3 WRITE !!,"Please select the first patient of the set of duplicates.",!
+4 SET DIC="^BCHRPAT("
SET DIC(0)="AEMQ"
DO ^DIC
+5 IF Y=-1
WRITE !,"BYE"
DO XIT
QUIT
+6 SET BCHPAT1=+Y
+7 ;
GETPAT2 ;
+1 KILL DIC
+2 WRITE !!,"Please select the second patient of the set of duplicates.",!
+3 SET DIC="^BCHRPAT("
SET DIC(0)="AEMQ"
DO ^DIC
+4 IF Y=-1
WRITE !,"BYE"
DO XIT
QUIT
+5 IF +Y=BCHPAT1
WRITE !!,"YOU CAN'T SELECT THE SAME PATIENT AS THE FIRST PATIENT!"
GOTO GETPAT2
+6 SET BCHPAT2=+Y
+7 WRITE !!,"You have selected the following 2 patients to merge together:"
+8 WRITE !
SET DIC="^BCHRPAT("
SET DA=BCHPAT1
DO EN^DIQ
+9 WRITE !
SET DIC="^BCHRPAT("
SET DA=BCHPAT2
DO EN^DIQ
CMM ;
+1 KILL BCHDATA,BCHMAST
+2 SET BCHQUIT=0
+3 FOR BCHF=".01",".02",".03",".04",".05",".06"
IF BCHQUIT
QUIT
DO CHK
+4 IF BCHQUIT
DO XIT
QUIT
+5 WRITE !!,"I am going to merge the following two patients together using the"
+6 WRITE !,"following values for the demographic data:"
+7 WRITE !!?5,"Patient 1: ",$$VAL^XBDIQ1(90002.11,BCHPAT1,.01)
+8 WRITE !?5,"Patient 2: ",$$VAL^XBDIQ1(90002.11,BCHPAT2,.01)
+9 WRITE !
+10 SET BCHX=""
FOR
SET BCHX=$ORDER(BCHMAST(BCHX))
IF BCHX=""
QUIT
WRITE !?8,$PIECE(^DD(90002.11,BCHX,0),U,1),": ",BCHMAST(BCHX)
+11 WRITE !
CONT ;
+1 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
DO XIT
QUIT
+3 IF 'Y
DO XIT
QUIT
+4 DO MERGE
+5 QUIT
XIT ;
+1 DO EN^XBVK("BCH")
+2 QUIT
CHK ;
+1 SET BCHDATA(BCHPAT1,BCHF)=$$VAL^XBDIQ1(90002.11,BCHPAT1,BCHF)
+2 SET BCHDATA(BCHPAT2,BCHF)=$$VAL^XBDIQ1(90002.11,BCHPAT2,BCHF)
+3 IF BCHDATA(BCHPAT1,BCHF)]""
IF BCHDATA(BCHPAT2,BCHF)=""
SET BCHMAST(BCHF)=BCHDATA(BCHPAT1,BCHF)
QUIT
+4 ;don't bother, both blank
IF BCHDATA(BCHPAT1,BCHF)=""
IF BCHDATA(BCHPAT2,BCHF)=""
SET BCHMAST(BCHF)=BCHDATA(BCHPAT1,BCHF)
QUIT
+5 IF BCHDATA(BCHPAT1,BCHF)=BCHDATA(BCHPAT2,BCHF)
SET BCHMAST(BCHF)=BCHDATA(BCHPAT1,BCHF)
QUIT
+6 IF BCHDATA(BCHPAT1,BCHF)=""
IF BCHDATA(BCHPAT2,BCHF)]""
SET BCHMAST(BCHF)=BCHDATA(BCHPAT2,BCHF)
QUIT
+7 ;CHOOSE WHICH VALUE
+8 WRITE !
+9 KILL DIR
+10 SET DIR(0)="S^1:"_BCHDATA(BCHPAT1,BCHF)_";2:"_BCHDATA(BCHPAT2,BCHF)
SET DIR("A")="Which Value for "_$PIECE(^DD(90002.11,BCHF,0),U,1)_" should be used"
KILL DA
DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
SET BCHQUIT=1
QUIT
+12 IF Y=""
SET BCHQUIT=1
QUIT
+13 IF Y=1
SET BCHMAST(BCHF)=BCHDATA(BCHPAT1,BCHF)
+14 IF Y=2
SET BCHMAST(BCHF)=BCHDATA(BCHPAT2,BCHF)
+15 QUIT
MERGE ;
+1 ;EDIT BCHPAT1 WITH MASTER VALUES
+2 ;GET TRIBE AND COMMUNITY IENS
+3 WRITE !,"Hold on...this may take a few minutes.."
+4 SET BCHT=""
+5 SET BCHVC=0
SET BCHGC=0
+6 IF BCHMAST(".05")]""
SET BCHT=$ORDER(^AUTTTRI("B",BCHMAST(".05"),0))
+7 SET BCHTC=""
+8 IF BCHMAST(".06")]""
SET BCHC=$ORDER(^AUTTCOM("B",BCHMAST(".06"),0))
+9 SET DA=BCHPAT1
SET DIE="^BCHRPAT("
SET DR=".01///"_BCHMAST(".01")_";.02///"_BCHMAST(".02")_";.03///"_BCHMAST(".03")_";.04///"_BCHMAST(".04")_";.05////"_BCHT_";.06////"_BCHC
+10 DO ^DIE
+11 KILL DA,DR,DIE
+12 ;repoint 1112 of CHR Record file
+13 SET BCHV=0
FOR
SET BCHV=$ORDER(^BCHR("ANRP",BCHPAT1,BCHV))
IF BCHV'=+BCHV
QUIT
Begin DoDot:1
+14 SET DA=BCHV
SET DR="1112////"_BCHPAT1
SET DIE="^BCHR("
DO ^DIE
+15 KILL DIE,DR,DA
+16 SET BCHVC=BCHVC+1
WRITE "."
End DoDot:1
+17 ;NOW DELETE BCHPAT2
+18 SET DA=BCHPAT2
SET DIK="^BCHRPAT("
DO ^DIK
+19 WRITE !!,"Patients have been merged. ",BCHVC," records were re-pointed.",!
+20 QUIT
