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

MPIFA24.m

Go to the documentation of this file.
  1. MPIFA24 ;BPOFO/CMC-A24 PROCESSING ROUTINE ; 5/4/20 10:58am
  1. ;;1.0;MASTER PATIENT INDEX VISTA;**22,24,27,31,25,41,39,48,52,59,75**;30 Apr 99;Build 1
  1. ;
  1. ; Integration Agreements Utilized:
  1. ; START, EXC, STOP^RGHLLOG - #2796
  1. ; BLDEVN, BLDPD1, BLDPID^VAFCQRY - #3630
  1. ; ^DPT("AICN" - #2070
  1. ; DELETETF^VAFCTFU, FILE^VAFCTFU - #2988
  1. ;
  1. ;PROCESS A24 RESULTING FROM A28 ADD TO MPI MESSAGE OR FROM A40 MERGE
  1. A24 ;
  1. N MPII,MPIJ,ARRY,SEG,CNT,ERR,SITE,MSG,DFN,IEN,LIST,RARRY
  1. S (CNT,ERR,FIRST)=1
  1. F MPII=1:1 X HLNEXT Q:HLQUIT'>0 S MSG=HLNODE D
  1. .S MPIJ=0 F S MPIJ=$O(HLNODE(MPIJ)) Q:'MPIJ S MSG(MPIJ)=HLNODE(MPIJ)
  1. .S SEG=$E(HLNODE,1,3)
  1. .I SEG="MSH" D MSH(.ARRY,.MSG) Q
  1. .I SEG="EVN" D EVN(.ARRY,.MSG) Q
  1. .I SEG="PID" D PID(.ARRY,.MSG,FIRST) D:FIRST=1 S FIRST=2 Q
  1. ..;preserve the retained ICN values 991.01 and 991.02
  1. .. S RARRY(991.01)=ARRY(991.01),RARRY(991.02)=ARRY(991.02)
  1. .I SEG="PD1" D PD1(.ARRY,.MSG) Q
  1. ;
  1. ;restore the retained ICN values
  1. S ARRY(991.01)=RARRY(991.01),ARRY(991.02)=RARRY(991.02)
  1. ;UPDATE 991.01, 991.02, 991.03
  1. ;**41 first check for DFN, if this DFN location is here
  1. I $G(ARRY("DFN",2))'=""&($G(ARRY("DFNLOC"))=$P($$SITE^VASITE,"^",3)) S DFN=ARRY("DFN",2)
  1. ;**41 if dfn is not passed set DFN from ICN
  1. I $G(DFN)="" D
  1. . I $G(ARRY("ICN",2))'="" S DFN=$$GETDFN^MPIF001(ARRY("ICN",2))
  1. . I $G(ARRY("ICN",2))=""!(+$G(DFN)'>0) D
  1. .. I $G(ARRY("DFN",2))'="" S DFN=ARRY("DFN",2)
  1. .. I $G(ARRY("DFN",2))="" S DFN=ARRY("DFN",1)
  1. S ARRY(991.03)=$S(ARRY(991.03)="":"@",1:$$LKUP^XUAF4(ARRY(991.03))) ;**59 - MVI_2688 (dri)
  1. I +$G(DFN)'>0 S ERR="-1^Unknown Identifier(s) ICN#"_$G(ARRY("ICN",2))_" and DFN#"_$G(ARRY("DFN",2))
  1. I +$G(DFN)>0 S ERR=$$UPDATE^MPIFAPI(DFN,"ARRY",0) D
  1. .;remove ALL Treating Facilities except your sites and add the CMOR
  1. .D TFL^VAFCTFU1(.LIST,DFN) I $O(LIST(0)) D
  1. .. N LOC,MPINODE,LOCIEN,CMOR,MPIFX,ERROR
  1. .. S (CMOR,MPIFX)=0 F S MPIFX=$O(LIST(MPIFX)) Q:'MPIFX I $P(LIST(MPIFX),"^",5)="VAMC" D
  1. ... ;get MPI node
  1. ... S MPINODE=$$MPINODE^MPIFAPI(DFN),LOC=$P(LIST(MPIFX),"^"),LOCIEN=$$IEN^XUAF4(LOC)
  1. ... I LOC=$P($$SITE^VASITE,"^",3) Q ;do not delete own site
  1. ... I LOCIEN=$P(MPINODE,"^",3) S CMOR=LOCIEN Q ;do not delete CMOR site
  1. ... S ERROR=$$DELETETF^VAFCTFU($P(MPINODE,"^",1),LOCIEN)
  1. .. ;add CMOR site to TF list if it did not already exist
  1. .. I CMOR'=0 D FILE^VAFCTFU(DFN,CMOR,1)
  1. .; trigger A31 to MPI incase there have been edits since the ICN was created -- tasked off
  1. .; **39 DON'T TASK OFF A31 IF MOVING FROM ONE NATIONAL ICN TO A DIFFERENT NATIONAL ICN
  1. .I ARRY("ICN",1)=ARRY("ICN",2) D
  1. ..S ZTRTN="TA31^MPIFA31B",ZTDESC="A31 triggered from A24 for DFN "_DFN ;**39 added DFN to text
  1. ..S ZTSAVE("DFN")=DFN,ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
  1. ..D ^%ZTLOAD
  1. .I ARRY("ICN",1)'=ARRY("ICN",2) D RESEX^MPIFDUP(DFN,2) ;**48
  1. .K ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
  1. ;
  1. N AA S AA="AA"
  1. I $G(ERR)'>0,$P($G(ERR),"^",2)["is already in use for pt DFN" S AA="AE" ;**52 MPIC_1681/1753
  1. S HLA("HLA",1)="MSA"_HL("FS")_AA_HL("FS")_HL("MID")_HL("FS")_$S(+$G(ERR)'>0:$P(ERR,"^",2),1:"")
  1. S $P(HLA("HLA",1),HL("FS"),7)="ICN="_ARRY("ICN",1)
  1. ;**75 - Story - 1260465 (ckn) - Include 200M in HLL links for HAC
  1. D LINK^HLUTIL3(ARRY("SITE"),.LINK) S IEN=$O(LINK(0)),HLL("LINKS",1)="^"_LINK(IEN)_$S($P($$SITE^VASITE(),"^",3)=741:"^200M",1:"")
  1. D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MPIFRSLT,"",.HL)
  1. K LINK,MPIFRSLT
  1. ;PATCH 25
  1. I ARRY("ICN",1)'=ARRY("ICN",2),ARRY("ICN",2)'="" D
  1. .; ^ checking if this is a result of a "merge" of ICNs from the MPI
  1. .; to trigger if this is station 200 the MERGE for the FHIE Framework
  1. .Q:$P($$SITE^VASITE,"^",3)'=200
  1. .N FHIE S FHIE=$$MERGE^OMGPIDMI(ARRY("ICN",2),ARRY("ICN",1))
  1. .; ^^ THIS API IS ONLY AVAILABLE ON THE FHIE HOST SYSTEM
  1. .I +FHIE=-1 D START^RGHLLOG(),EXC^RGHLLOG(208,$P(FHIE,"^",2),DFN),STOP^RGHLLOG()
  1. Q
  1. ;
  1. MSH(ARY,MSG) ;processing MSH fields
  1. N COMP
  1. S COMP=$E(HL("ECH"),1)
  1. S ARY("SITE")=$$LKUP^XUAF4($P($P(MSG,HL("FS"),4),COMP))
  1. Q
  1. ;
  1. EVN(ARY,MSG) ;processing EVN fields
  1. S ARY("EVTR")=$P(MSG,HL("FS"),2) ;not currently used
  1. S ARY("DLT")=$$FMDATE^HLFNC($P(MSG,HL("FS"),3))
  1. Q
  1. ;
  1. PID(ARY,MSG,FIRST) ;processing PID fields
  1. N REP,PID,COMP,SUBCOMP,MPIDFN,MPISSN,ICN
  1. S REP=$E(HL("ECH"),2),COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4)
  1. S MPISSN="",MPIDFN=""
  1. ;**41 replaced with line below D PIDPROC^MPIFA43(.ICN,.MPISSN,.MPIDFN,.PID)
  1. D PIDP^RGADTP1(.MSG,.ARY,.HL)
  1. I FIRST=1 S ARY(991.01)=+ARY("ICN"),ARY(991.02)=$P(ARY("ICN"),"V",2)
  1. S ARY("ICN",FIRST)=ARY("ICN")
  1. S ARY("SSN",FIRST)=ARY("SSN")
  1. S ARY("DFN",FIRST)=ARY("DFN")
  1. Q
  1. ;
  1. PD1(ARY,MSG) ;processing PD1 fields
  1. N COMP
  1. S COMP=$E(HL("ECH"),1)
  1. S ARY(991.03)=$P($P(HLNODE,HL("FS"),4),COMP,3)
  1. Q
  1. ;
  1. PROC ;
  1. N NXT,DFN
  1. F NXT=1:1 X HLNEXT Q:HLQUIT'>0 D
  1. .I $E(HLNODE,1,3)="MSA" S DFN=$P($P(HLNODE,HL("FS"),7),"=",2)
  1. .I $E(HLNODE,1,3)="MSA"&($P(HLNODE,HL("FS"),4)'="") D
  1. ..; ERROR RETURNED IN MSA - LOG EXCEPTION
  1. ..D START^RGHLLOG(HLMTIEN,"","")
  1. ..D EXC^RGHLLOG(208,$P(HLNODE,HL("FS"),4)_" for HL msg# "_HLMTIEN,DFN)
  1. ..D STOP^RGHLLOG(0)
  1. K ^XTMP("MPIFA24%"_DFN)
  1. Q