Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BCHMNRP

BCHMNRP.m

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