198 lines
9.2 KiB
Mathematica
198 lines
9.2 KiB
Mathematica
EASXDR1 ;ALB/BRM/PHH - CHECK RELATIONS DURING XDR PATIENT MERGE; ; 5/30/03 12:29pm
|
|
;;1.0;ENROLLMENT APPLICATION SYSTEM;**10,26**;Mar 15, 2001
|
|
;
|
|
CHKRELAT(DFNFR,DFNTO,SILENT) ;can the relations on these 2 records be merged?
|
|
;
|
|
;INPUT:
|
|
; DFNFR : the patient file ien of the merge from record
|
|
; DFNTO : the patient file ien of the merge to record
|
|
; SILENT: (optional) used to prevent screen writes and user
|
|
; interaction during the merge process
|
|
;
|
|
; Note: DFNFR and DFNTO can both be the same if this process is
|
|
; to clean-up patient relation file entries within the same
|
|
; patient
|
|
;
|
|
Q:'$G(DFNFR) "0^From DFN not passed"
|
|
Q:'$G(DFNTO) "0^To DFN not passed"
|
|
Q:'$D(^DGPR(408.12,"B",DFNFR)) "0^This patient did not have any relation entries that needed to be merged."
|
|
Q:'$D(^DGPR(408.12,"B",DFNTO)) "0^This patient did not have any relation entries that needed to be merged."
|
|
N ARYNAM2,REL,RELAT,NOMRGMSG,REASON,ARYNAM,X,ERR,NAMFIL
|
|
N ERROR,DIC,FRDATA,MRGFRIEN,MRGTOIEN,MSG,NAME,RELPNTR
|
|
N ACTOK,RELATE,EFFDT,SUBIEN,UPDMSG,MRGARY,MRGROOT,OK,IEN12TO
|
|
N ACTIVFR,ACTIVTO,SUBIENFR,SUBIENTO,ERRNUM,NAMIEN,IEN12FR
|
|
S MRGROOT="^TMP($J,""EASXDR1"",""B"")"
|
|
K ^TMP($J,"EASXDR1"),^TMP($J,"EASXDR")
|
|
S ^XTMP("EASXDR1",0)=$$FMADD^XLFDT($$NOW^XLFDT(),45)_U_$$NOW^XLFDT()_U_"EASXDR1 - DUPLICATE PATIENT RELATION MERGE"
|
|
; find 408.12 entries for FROM and TO records
|
|
F X="IEN12FR","IEN12TO" D
|
|
.S REL="DFN"_$E(X,6,7),@X=""
|
|
.S ARYNAM="^TMP($J,""EASXDR1"","""_$E(X,6,7)_""")"
|
|
.S ARYNAM2="^TMP($J,""EASXDR1"",""B"","""_$E(X,6,7)_""")"
|
|
.F S @X=$O(^DGPR(408.12,"B",@REL,@X)) Q:'@X D
|
|
..I '$D(^DGPR(408.12,@X)) S @ARYNAM@(@X)=(@REL)_"^NO 408.12 RECORD" Q
|
|
..M @ARYNAM@((@X))=^DGPR(408.12,@X)
|
|
..S RELPNTR=$P($G(@ARYNAM@(@X,0)),"^",3)
|
|
..S NAMIEN=$P(RELPNTR,";")_",",NAMFIL=$P(RELPNTR,";",2)
|
|
..I NAMFIL="DPT(" S NAMFIL=2
|
|
..E S NAMFIL=$TR($P(NAMFIL,"(",2),",")
|
|
..K NAME
|
|
..I NAMIEN,NAMFIL S NAME=$$GET1^DIQ(NAMFIL,NAMIEN,.01)
|
|
..S @ARYNAM@(@X,"NAME")=$G(NAME)
|
|
..S RELAT=$P($G(^DGPR(408.12,@X,0)),"^",2)
|
|
..S @ARYNAM2@(RELAT,@X)=""
|
|
; merge duplicate records (if they exist)
|
|
S RELATE="",OK=0,ERRNUM=0
|
|
F S RELATE=$O(@MRGROOT@("TO",RELATE)) Q:'RELATE D
|
|
.S MRGTOIEN=""
|
|
.F S MRGTOIEN=$O(@MRGROOT@("TO",RELATE,MRGTOIEN)) Q:'MRGTOIEN D LOOP
|
|
Q +$G(OK)
|
|
LOOP ;
|
|
M ^TMP($J,"EASXDR","MRGTO",MRGTOIEN)=^DGPR(408.12,MRGTOIEN)
|
|
S MRGFRIEN=""
|
|
F S MRGFRIEN=$O(@MRGROOT@("FR",RELATE,MRGFRIEN)) Q:'MRGFRIEN D
|
|
.Q:MRGFRIEN=MRGTOIEN ;do not update if FROM and TO iens are the same
|
|
.K ERROR
|
|
.I RELATE'=1 D Q:$D(ERROR)
|
|
..I '$$MRGOTHR(MRGFRIEN,MRGTOIEN) S ERROR(MRGFRIEN)="DEPENDENT NAMES DO NOT MATCH" K @MRGROOT@("FR",RELATE,MRGTOIEN) Q
|
|
..I '$$SSNMATCH(MRGFRIEN,MRGTOIEN) D Q:$D(ERROR)
|
|
...Q:$P($G(^DGPR(408.12,MRGFRIEN,0)),"^",2)'=$P($G(^DGPR(408.12,MRGTOIEN,0)),"^",2)
|
|
...S ERROR(MRGFRIEN)="DEPENDENT SSNS DO NOT MATCH"
|
|
...D:'$G(SILENT) FAILED(MRGFRIEN,MRGTOIEN,$G(ERROR(MRGFRIEN)))
|
|
...K @MRGROOT@("FR",RELATE,MRGTOIEN)
|
|
.M ^TMP($J,"EASXDR","MRGFR",MRGFRIEN)=^DGPR(408.12,MRGFRIEN)
|
|
.S EFFDT=""
|
|
.F S EFFDT=$O(^TMP($J,"EASXDR","MRGFR",MRGFRIEN,"E","B",EFFDT)) Q:'EFFDT D
|
|
..I $D(^DGPR(408.12,MRGTOIEN,"E","B",EFFDT)) D Q
|
|
...S ACTOK=$$CHKACT()
|
|
..S SUBIEN=+$O(^TMP($J,"EASXDR","MRGFR",MRGFRIEN,"E","B",EFFDT,""))
|
|
..Q:('SUBIEN)!('$D(^TMP($J,"EASXDR","MRGFR",MRGFRIEN,"E",SUBIEN)))
|
|
..S FRDATA=$G(^TMP($J,"EASXDR","MRGFR",MRGFRIEN,"E",SUBIEN,0))
|
|
..S UPDMSG=$$UPDATE(MRGTOIEN,FRDATA,MRGFRIEN)
|
|
..I 'UPDMSG D Q
|
|
...S ERROR(MRGFRIEN,SUBIEN)=$P(UPDMSG,"^",2),ERRNUM=ERRNUM+1
|
|
...Q:$P(UPDMSG,"^",2)="The entry does not exist."
|
|
...S ^XTMP("EASXDR1","DATA",DFNFR,"ERROR - NOT MERGED",MRGFRIEN,SUBIEN)=$P(UPDMSG,"^",2)
|
|
.I '$D(ERROR),$$REMOVE(MRGFRIEN,MRGTOIEN) D ;
|
|
..S OK=OK+1
|
|
..D:'$G(SILENT) SUCCESS(MRGFRIEN,MRGTOIEN)
|
|
..K @MRGROOT@("FR",RELATE,MRGFRIEN)
|
|
..K @MRGROOT@("TO",RELATE,MRGFRIEN)
|
|
..I $D(@MRGROOT@("TO",RELATE,MRGFRIEN)) K @MRGROOT@("TO",RELATE,MRGFRIEN)
|
|
..K ^TMP($J,"EASXDR")
|
|
..M ^TMP($J,"EASXDR","MRGFR",MRGFRIEN)=^DGPR(408.12,MRGFRIEN)
|
|
..M ^TMP($J,"EASXDR","MRGTO",MRGTOIEN)=^DGPR(408.12,MRGTOIEN)
|
|
Q
|
|
CHKACT() ; ensure both records contain the same active flag for eff. date
|
|
N OK
|
|
S OK=1
|
|
S SUBIENFR=+$O(^TMP($J,"EASXDR","MRGFR",MRGFRIEN,"E","B",EFFDT,""))
|
|
S SUBIENTO=+$O(^TMP($J,"EASXDR","MRGTO",MRGTOIEN,"E","B",EFFDT,""))
|
|
S ACTIVFR=$P($G(^TMP($J,"EASXDR","MRGFR",MRGFRIEN,"E",SUBIENFR,0)),"^",2)
|
|
S ACTIVTO=$P($G(^TMP($J,"EASXDR","MRGTO",MRGTOIEN,"E",SUBIENTO,0)),"^",2)
|
|
I ACTIVFR'=ACTIVTO D Q OK
|
|
.S OK=0
|
|
.S ERROR(MRGFRIEN,SUBIENFR)="'Active' flag does not match for effective date: "_$$FMTE^XLFDT(EFFDT),ERRNUM=ERRNUM+1
|
|
.S ^XTMP("EASXDR1","DATA",DFNFR,408.12,"ERROR - NOT MERGED",MRGFRIEN,SUBIENFR)=ERROR(MRGFRIEN,SUBIENFR)
|
|
.D:'$G(SILENT) FAILED(MRGFRIEN,MRGTOIEN,$G(ERROR(MRGFRIEN,SUBIENFR)))
|
|
.I '$D(ERROR) S OK=1
|
|
Q OK
|
|
UPDATE(MRGTOIEN,FRDATA,MRGFRIEN) ;
|
|
Q:('MRGTOIEN)!(FRDATA="") "0^RECORD NOT UPDATED - BAD INPUT DATA"
|
|
N DIERR,IENS,FDA,MSGROOT,IENROOT,NAMEFR,NAMETO
|
|
S IENS="+1,"_MRGTOIEN_","
|
|
S FDA(408.1275,IENS,.01)=$P(FRDATA,"^")
|
|
S FDA(408.1275,IENS,.02)=$P(FRDATA,"^",2)
|
|
S FDA(408.1275,IENS,.03)=$P(FRDATA,"^",3)
|
|
S FDA(408.1275,IENS,.04)=$P(FRDATA,"^",4)
|
|
S NAMEFR=$G(^TMP($J,"EASXDR1","FR",MRGFRIEN,"NAME"))
|
|
I NAMEFR="" S NAMEFR=$$GET1^DIQ(408.12,MRGFRIEN_",",.03,"E")
|
|
S NAMETO=$G(^TMP($J,"EASXDR1","TO",MRGTOIEN,"NAME"))
|
|
I NAMETO="" S NAMEFR=$$GET1^DIQ(408.12,MRGTOIEN_",",.03,"E")
|
|
D UPDATE^DIE("","FDA","IENROOT","MSGROOT")
|
|
I '$D(DIERR) D Q "1^UPDATED "_$G(IENROOT)
|
|
.K @MRGROOT@("FR",RELATE,MRGFRIEN)
|
|
.K @MRGROOT@("TO",RELATE,MRGFRIEN)
|
|
.I $D(@MRGROOT@("TO",RELATE,MRGFRIEN)) K @MRGROOT@("TO",RELATE,MRGFRIEN)
|
|
.K ^TMP($J,"EASXDR")
|
|
.M ^TMP($J,"EASXDR","MRGFR",MRGFRIEN)=^DGPR(408.12,MRGFRIEN)
|
|
.M ^TMP($J,"EASXDR","MRGTO",MRGTOIEN)=^DGPR(408.12,MRGTOIEN)
|
|
Q "0^"_$G(MSGROOT("DIERR",1,"TEXT",1))
|
|
DEL(ROOT,IEN) ;delete entries
|
|
Q:'IEN "1^INVALID INPUT PARAMETER"
|
|
N DA,DIK,MSG,X,Y,FILE
|
|
S FILE=$TR($P(ROOT,"(",2),",")
|
|
S MSG="1^DELETE ERROR "_ROOT_IEN ;default to error condition
|
|
M ^XTMP("EASXDR1","DATA",DFNFR,FILE,IEN)=@(ROOT_IEN_")")
|
|
S DA=IEN,DIK=ROOT D ^DIK,IX^DIK S MSG="0^RECORD DELETED"
|
|
Q MSG
|
|
MRGOTHR(MRGFRIEN,MRGTOIEN) ;
|
|
Q:('MRGFRIEN)!('MRGTOIEN) 0
|
|
N NAMEFR,NAMETO
|
|
S NAMEFR=$G(^TMP($J,"EASXDR1","FR",MRGFRIEN,"NAME"))
|
|
S NAMETO=$G(^TMP($J,"EASXDR1","TO",MRGTOIEN,"NAME"))
|
|
I NAMEFR=NAMETO Q 1 ;ok to proceed with dependent merge
|
|
Q 0 ;different dependent - do not merge entries.
|
|
SUCCESS(MRGFRIEN,MRGTOIEN) ;display message when merge is successful
|
|
Q:('$D(MRGFRIEN))!('$D(MRGTOIEN))
|
|
S NAMEFR=$G(^TMP($J,"EASXDR1","FR",MRGFRIEN,"NAME"))
|
|
I NAMEFR="" S NAMEFR=$$GET1^DIQ(408.12,MRGFRIEN_",",.03,"E")
|
|
S NAMETO=$G(^TMP($J,"EASXDR1","TO",MRGTOIEN,"NAME"))
|
|
I NAMETO="" S NAMEFR=$$GET1^DIQ(408.12,MRGTOIEN_",",.03,"E")
|
|
W !!?2,MRGFRIEN," ",NAMEFR," was merged into ",MRGTOIEN," ",NAMETO
|
|
Q
|
|
FAILED(MRGFRIEN,MRGTOIEN,MSG) ;display message when merge fails
|
|
Q:('$D(MRGFRIEN))!('$D(MRGTOIEN))!('$D(MSG))
|
|
N EFFDT1
|
|
S NAMEFR=$G(^TMP($J,"EASXDR1","FR",+MRGFRIEN,"NAME"))
|
|
I NAMEFR="" S NAMEFR=$$GET1^DIQ(408.12,MRGFRIEN_",",.03,"E")
|
|
S NAMETO=$G(^TMP($J,"EASXDR1","TO",+MRGTOIEN,"NAME"))
|
|
I NAMETO="" S NAMEFR=$$GET1^DIQ(408.12,MRGTOIEN_",",.03,"E")
|
|
W !!?2,MRGFRIEN," ",NAMEFR," could not be merged into ",MRGTOIEN," ",NAMETO,"."
|
|
W !?2,"Reason: ",$G(MSG)
|
|
S EFFDT1=$G(EFFDT)
|
|
I MSG["'Active' flag does not match" D
|
|
.D CHGACT^EASXDR(MRGFRIEN,MRGTOIEN,$G(EFFDT))
|
|
.S EFFDT=EFFDT1
|
|
.K ^TMP($J,"EASXDR1","FR",RELATE,MRGTOIEN)
|
|
Q
|
|
REMOVE(MRGFRIEN,MRGTOIEN) ;delete and/or repoint "old" entries
|
|
Q:('MRGFRIEN) "0^RECORD NOT DELETED - BAD INPUT DATA"
|
|
I '$D(MRGTOIEN) N MRGTOIEN S MRGTOIEN="***DELETE***"
|
|
I '$D(DFNFR) N DFNFR S DFNFR="DELETE" ;from DFN is not present
|
|
N VARPNT,MSG22,MSG21,ERROR,IEN40821,IEN40822,IEN40812,IEN40813
|
|
N MSG12,MSG13,VARPNT2
|
|
S IEN40812=MRGFRIEN
|
|
S IEN40821=""
|
|
S ^XTMP("EASXDR1","DATA",DFNFR,408.12,MRGFRIEN)=$S(MRGTOIEN:"RECORD MERGED INTO 408.12 IEN # "_MRGTOIEN,1:"RECORD DELETED")
|
|
F S IEN40821=$O(^DGMT(408.21,"C",IEN40812,IEN40821)) Q:'IEN40821!($G(ERROR)) D
|
|
.S IEN40822=""
|
|
.F S IEN40822=$O(^DGMT(408.22,"AIND",IEN40821,IEN40822)) Q:'IEN40822!($G(ERROR)) D
|
|
..S MSG22=$$DEL("^DGMT(408.22,",IEN40822)
|
|
..I MSG22 S ERROR="1^"_IEN40822_"^"_$P(MSG22,"^",2)_"^408.22 DELETE" Q
|
|
..I DFNFR="DELETE" S ^XTMP("EASXDR1","DATA",DFNFR,408.12,MRGFRIEN,"SEE 408.22",IEN40822)=""
|
|
.Q:$G(ERROR)
|
|
.S MSG21=$$DEL("^DGMT(408.21,",IEN40821)
|
|
.I MSG21 S ERROR="1^"_IEN40821_"^"_$P(MSG21,"^",2)_"^408.21 DELETE" Q
|
|
.I DFNFR="DELETE" S ^XTMP("EASXDR1","DATA",DFNFR,408.12,MRGFRIEN,"SEE 408.21",IEN40821)=""
|
|
Q:$G(ERROR) "0^"_$P(ERROR,"^",2,4)
|
|
S VARPNT=$P($G(^DGPR(408.12,IEN40812,0)),"^",3)
|
|
S IEN40813="" S:VARPNT["DGPR" IEN40813=$P(VARPNT,";")
|
|
S MSG12=$$DEL("^DGPR(408.12,",IEN40812)
|
|
I MSG12 Q "0^"_IEN40812_"^"_$P(MSG12,"^",2)_"^408.12 DELETE"
|
|
Q:'IEN40813 "1^"_MRGFRIEN_" DELETED"
|
|
S VARPNT2=""
|
|
;ensure that the new record is not pointing to the same relation
|
|
S:MRGTOIEN VARPNT2=$P($G(^DGPR(408.12,MRGTOIEN,0)),"^",3)
|
|
Q:VARPNT=VARPNT2 "1^"_MRGFRIEN_" DELETED"
|
|
S MSG13=$$DEL("^DGPR(408.13,",IEN40813)
|
|
I DFNFR="DELETE" S ^XTMP("EASXDR1","DATA",DFNFR,408.12,MRGFRIEN,"SEE 408.13",IEN40813)=""
|
|
Q:MSG13 "0^"_$P(MSG13,"^",2)
|
|
Q "1^"_MRGFRIEN_" DELETED"
|
|
SSNMATCH(FRIEN,TOIEN) ;
|
|
N SSNFR,SSNTO
|
|
D FINDSSN^EASXDR(FRIEN,.SSNFR),FINDSSN^EASXDR(TOIEN,.SSNTO)
|
|
Q:SSNFR=SSNTO 1 ;SSNs match
|
|
Q:(SSNFR="UNKNOWN")!(SSNFR="") 1 ;use SSN of the 'merge to' record
|
|
Q 0
|