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

MPIFQ0.m

Go to the documentation of this file.
  1. MPIFQ0 ;ALB/RJS-QUERY HANDLER TOP LEVEL ; 10/28/20 8:38pm
  1. ;;1.0;MASTER PATIENT INDEX VISTA;**1,3,8,14,13,16,17,21,20,24,26,28,31,33,35,38,43,52,54,56,60,76**;30 Apr 99;Build 1
  1. ;
  1. ; Integration Agreements utilized:
  1. ; EXC, START and STOP^RGHLLOG - #2796
  1. ; FILE^VAFCTFU - #2988
  1. ; $$EN^HLCSAC - #3471
  1. ; NAME^VAFCPID2 - #3492
  1. ;
  1. INTACTV ;Interactive standalone query
  1. N DFN,NAME1,MPIFLL
  1. K DTOUT,DUOUT,X,Y,DIC
  1. S MPIFRES="",MPIFINT="",DIC="^DPT(",DIC(0)="AEMQ" D ^DIC
  1. I ($D(DTOUT))!($D(DUOUT))!((+$G(Y))<0) W:'$D(MPIFRPC) !,"TRY AGAIN LATER" G END
  1. S DFN=+Y,HLP("ACKTIME")=300
  1. W:'$D(MPIFRPC) !
  1. CIRNEXC ; Exception Entry Point
  1. I +$$GETICN^MPIF001(DFN)>0,$$IFLOCAL^MPIF001(DFN)'=1 W:'$D(MPIFRPC) !,"Patient already has an ICN" G END
  1. N LOCDATA ;Data Returned from GETDATA in ICN array
  1. D GETDATA("^DPT(",DFN,"LOCDATA",".01;.02;.03;.09;.301;391;1901")
  1. S LOCDATA(2,DFN,991.01)=$P($$MPINODE^MPIFAPI(DFN),"^"),TSSN=LOCDATA(2,DFN,.09)
  1. I $$IFLOCAL^MPIF001(DFN)=1 S MPIFLL=""
  1. I $G(LOCDATA(2,DFN,991.01))>0&('$D(MPIFLL)) W:'$D(MPIFRPC) !,"Patient already has an ICN" G END
  1. S HLP("ACKTIME")=300,MPIQRYNM="EXACT_MATCH_QUERY"
  1. ;MPIQRYNM="VTQ_PID_ICN_NO_LOAD" **43 CHANGING QUERY NAME
  1. G JUMP
  1. VTQ G:$G(DFN)']"" END
  1. N LOCDATA ;Data Returned from GETDATA in ICN array
  1. D GETDATA("^DPT(",DFN,"LOCDATA",".01;.02;.03;.09;.301;391;1901")
  1. S LOCDATA(2,DFN,991.01)=$P($$MPINODE^MPIFAPI(DFN),"^"),TSSN=LOCDATA(2,DFN,.09)
  1. ;S MPIQRYNM="VTQ_PID_ICN_NO_LOAD" **43 CHANGING QUERY NAME
  1. S MPIQRYNM="EXACT_MATCH_QUERY"
  1. I $G(LOCDATA(2,DFN,991.01))>0 S MPIFRTN="ALREADY HAS ICN" G END ;If Pt already has ICN don't connect to MPI
  1. JUMP N TIME,% D NOW^%DTC S TIME=%
  1. N HL,MPIINM,MPIOUT,MPIIN,MPIMCNT,MPICNT,MPICS,HEADER,TEST,SITE,MPIDC,SSN
  1. I $G(HLP("ACKTIME"))="" S HLP("ACKTIME")=30 ;If the HLP("ACKTIME") is not already set for the D/C
  1. S HL("ECH")="^~\&",HL("FS")="|"
  1. I '$D(MPIQRYNM) S MPIQRYNM="VTQ_PID_ICN"
  1. S MPIIN="",MPIMCNT=DFN,MPICNT=1,MPICS=$E(HL("ECH"),1)
  1. D VTQ1^MPIFVTQ(DFN,.MPIOUT,.HL,.MPIQRYNM) ; **33 remove field list to get all now
  1. I +MPIOUT(0)=-1 D G EXIT
  1. .S ^TMP($J,"MPIFQ0-ERROR-LOG",DFN,TIME)=$G(MPIOUT(0)),MPIFRTN="CONTINUE"
  1. ;Create MSH
  1. S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",3),SITE=SITE\1,HEADER="MSH"_HL("FS")_HL("ECH")_HL("FS")_"MPI_LOAD"_HL("FS")_SITE_HL("FS")
  1. S HEADER=HEADER_"MPI-ICN"_HL("FS")_HL("FS")_HL("FS")_HL("FS")_"VQQ"_MPICS_"Q02"_HL("FS")_MPIMCNT_"-"_MPICNT_HL("FS") ;**38 changed VTQ to VQQ
  1. S MPIOUT(1)=HEADER K MPIOUT(0)
  1. I '$D(MPIFS) W:'$D(MPIFRPC) !!,"Attempting to connect to the Master Patient Index in Austin...",!,"If no SSN or inexact DOB or common name, this request",!,"may take some time, please be patient...",!
  1. S TEST=$$EN^HLCSAC("MPIVA DIR","MPIOUT","MPIDC")
  1. K HLP("ACKTIME") ;kill the HLP array set for the ack timeout
  1. I +TEST=-1 D G EXIT
  1. .S ^TMP($J,"MPIFQ0-ERROR-LOG",DFN,TIME)=TEST
  1. .I '$D(MPIFS) W:'$D(MPIFRPC) !!,"Could not connect to MPI or Timed Out, assigning local ICN (if not already assigned)..."
  1. .D LOCAL^MPIFQ3(DFN) S MPIFRTN="ASSIGNING LOCAL"
  1. K ^TMP("MPIFVQQ",$J),^TMP("MPIFQ0",$J) ;array data is parsed into for display in LM
  1. INIPARS ;
  1. N SEG,INDEX,SKIP,CHECK,AL,TTF2,TFLL,TF,TF2,MPIREP,MPICOMP
  1. S INDEX=0 K CHECK
  1. LOOP1 ;
  1. ;process in ADT type messages
  1. N MPIX S MPIX=0 N REP,SG,MSG,MPIQUIT,MPINODE
  1. K TWODFN S MPIQUIT=0
  1. F MPIX=0:1 X "D LOOP2" D K MPINODE,MSG Q:MPIQUIT'>0
  1. . I $D(MPINODE(1)) S SG=$E(MPINODE(1),1,3) S MSG(1)=MPINODE(1) D
  1. .. S MPIJ=1 F S MPIJ=$O(MPINODE(MPIJ)) Q:'MPIJ S MSG(MPIJ)=MPINODE(MPIJ)
  1. .. D:SG?2A1(1A,1N) @SG
  1. DECIDE ;If no data in ^TMP that means the patient was not found in the MPI w/VTQ Query. So we go to A28 to add the patient to the MPI.
  1. N EXC,TEXT,EXACT,EXACT2
  1. I '$D(^TMP("MPIFVQQ",$J)) D G EXIT
  1. .I '$D(MPIFS) W:'$D(MPIFRPC) !!,"Exact match for Patient was not found in the MPI..."
  1. .D A28^MPIFQ3(DFN) S MPIFRTN="DID A28"
  1. .;**43 log potential match exception if exist
  1. .;**52 removed all references to logging of Potential Matches because that will be done via a remote RPC in the Probabilistic Search flow on the MPI
  1. ;If INDEX=1 it means we got 1 match check SSN see if definitely same pt
  1. I (INDEX=1) D G EXIT
  1. .;**43 Removed &(TSSN=SSN) from line above as there will only be an exact match returned now
  1. .N CCMOR,ICN,DATA,TICN,SNM,SNM2,IEN
  1. .S DATA=^TMP("MPIFVQQ",$J,INDEX,"DATA"),CMOR=$P(DATA,"^",5),ICN=$P(DATA,"^",6),IEN=$$IEN^XUAF4(CMOR)
  1. .D START^RGHLLOG(0)
  1. .S TICN=$$GETDFN^MPIF001(+ICN)
  1. .I TICN>0,DFN'=TICN D
  1. ..; call the new DUPLICATE RECORD MERGE ADD API (see section 3.2.1.2)
  1. ..N XDRSLT,XDRLST,XDRFL
  1. ..S XDRFL=2,XDRLST(1)=TICN_"^"_DFN
  1. ..D ADD^XDRDADDS(.XDRSLT,XDRFL,.XDRLST) S TWODFN=1
  1. ..;D TWODFNS^MPIF002(TICN,DFN,ICN) S TWODFN=1
  1. ..;I '$D(MPIFS) W:'$D(MPIFRPC) !!,"Exception logged, another patient has the ICN returned already, requesting new ICN for this patient..."
  1. ..D A28^MPIFQ3(DFN),STOP^RGHLLOG(0) S MPIFRTN="Did A28" Q
  1. .;I TICN>0&(DFN'=TICN)
  1. .; CHECK IF NAME IS SAME - IF NOT POTENTIAL MATCH EXCEPTION
  1. .; **43 remove checks here as only exact match will be returned from the MPI
  1. .;S SNM=LOCDATA(2,DFN,.01) D NAME^VAFCPID2(DFN,.SNM,0) ;reformat name to DG 149 standard
  1. .;S SNM2=$P(DATA,"^") D NAME^VAFCPID2(0,.SNM2,0) S $P(DATA,"^")=SNM2
  1. .;I $P(SNM,",")=$P(SNM2,",")&($P($P(SNM2,",",2)," ")=$P($P(SNM,",",2)," ")) D
  1. .; ^first and last match - check for middle name vs middle initial
  1. .;N SNMN,SNMN2
  1. .;S SNMN=$P($P(SNM,",",2)," ",2),SNMN2=$P($P(SNM2,",",2)," ",2)
  1. .;I $L(SNMN)>1&($L(SNMN2)=1),$E(SNMN,1)=SNMN2 S EXACT=1
  1. .;I $L(SNMN2)>1&($L(SNMN)=1),$E(SNMN2,1)=SNMN S EXACT=1
  1. .;I $P($G(^DPT(DFN,0)),"^",2)'=$P(DATA,"^",11) S EXC=209,TEXT="Gender fields don't match between site and MPI for DFN "_DFN S EXACT2=1
  1. .;I SNM2'=SNM&('$D(EXACT))!($D(EXACT2)) D Q
  1. .;I '$D(EXC) S EXC=214,TEXT="Name fields don't match between site and MPI for DFN "_DFN
  1. .;I $D(MPIFINT) D START^MPIFQ1(INDEX) Q
  1. .;I '$D(MPIFINT) D LOC2^MPIFQ3(DFN) Q
  1. .I '$D(MPIFS)&('$D(TWODFN)) W:'$D(MPIFRPC) !!,"Found Patient "_$G(LOCDATA(2,DFN,.01))_" on MPI",!," Updating ICN to "_+ICN_" - just a minute..."
  1. .D STOP^RGHLLOG(0),UPDATE(DFN,ICN,CMOR) S MPIFRTN="GOT 1 HIT FROM MPI"
  1. ;I '$D(MPIFINT) D G EXIT
  1. ;. came in via PIMS options to d/c with MPI
  1. ;.I '$D(MPIFS) W:'$D(MPIFRPC) !!,"Potential Matches Found, Assigning Local ICN..."
  1. ;.I '$D(EXC) S EXC=218,TEXT="Potential matches found for patient DFN= "_DFN_" Use Single Patient Initialization to MPI option to manually process."
  1. ;.D START^RGHLLOG(0),EXC^RGHLLOG(EXC,TEXT,DFN),STOP^RGHLLOG(0)
  1. ;.D LOCAL^MPIFQ3(DFN) S MPIFRTN="ASSIGNING LOCAL"
  1. ;D START^MPIFQ1(INDEX) G END
  1. EXIT I $D(MPIFINT) K MPIFINT,MPIFRES,MPIQRYNM,TSSN,TWODFN
  1. K VALMCNT,VALMLST,CCMOR,FICN H 3 W:'$D(MPIFRPC) !!
  1. END K ^TMP("MPIFVQQ",$J),^TMP("MPIFQ0",$J) Q
  1. ;
  1. UPDATE(DFN,ICN,CMOR) ;
  1. N TICN,CHKSUM,SETICN,SETLOC,CHANGE,RGLOG,LOCAL,TMP
  1. S CHKSUM=$P(ICN,"V",2),ICN=$P(ICN,"V",1),TICN=$$GETDFN^MPIF001(+ICN)
  1. I TICN>0,TICN'=DFN,'$D(TWODFN) D TWODFNS^MPIF002(TICN,DFN,ICN) Q
  1. S SETICN=$$SETICN^MPIF001(DFN,ICN,CHKSUM)
  1. I +SETICN'>0 S ^TMP($J,"MPIFQ0-ERROR-LOG",DFN,TIME)="COULD NOT SET ICN IN MPIFQ0" Q
  1. S SETLOC=1,LOCAL="N"
  1. I $E(ICN,1,3)=$P($$SITE^VASITE(),"^",3) S LOCAL="Y"
  1. I $G(LOCAL)="Y" S SETLOC=$$SETLOC^MPIF001(DFN,1)
  1. I $G(LOCAL)'="Y" S SETLOC=$$SETLOC^MPIF001(DFN,0)
  1. I +SETLOC'>0 S ^TMP($J,"MPIFQ0-ERROR-LOG",DFN,TIME)="COULD NOT SETLOC IN MPIFQ0" Q
  1. ;**60 (elz) MVI_793 set the Full ICN field
  1. ;**76 VAMPI-799 (ckn) - Below Full ICN api is now being called by SETICN^MPIF001
  1. ;S TMP=$$SETFICN^MPIF001(DFN,ICN_"V"_CHKSUM)
  1. N CMOR1 S CMOR1=$$LKUP^XUAF4(CMOR)
  1. I CMOR1'="" S CHANGE=$$CHANGE^MPIF001(DFN,CMOR1)
  1. I CMOR1="" S CHANGE=-1
  1. I $G(LOCAL)="Y" S CHANGE=$$CHANGE^MPIF001(DFN,$P($$SITE^VASITE,"^"))
  1. ;**56 - MVI_1727 (ckn) - Don't quit after logging an error as we still want to update TFs and send A24 to MPI.
  1. I +CHANGE'>0 S ^TMP($J,"MPIFQ0-ERROR-LOG",DFN,TIME)="COULD NOT SET CMOR IN MPIFQ0" ;Q - commented out quit
  1. Q:$G(LOCAL)="Y"
  1. N RESLT S RESLT=$$A24^MPIFA24B(DFN)
  1. I +RESLT<0 D EXC^RGHLLOG(208,"Problem building A24 (ADD TF) for DFN= "_DFN,DFN)
  1. ; Added for patch 31, create treating facility list
  1. I $D(^TMP("MPIFVQQ",$J,INDEX,"TF")) D
  1. . N MPINTFI,MPINTF,TFSTRG,TFIEN,MPIFMDT
  1. . S MPINTFI=0
  1. . F S MPINTFI=$O(^TMP("MPIFVQQ",$J,INDEX,"TF",MPINTFI)) Q:'MPINTFI D
  1. .. S MPINTF=^TMP("MPIFVQQ",$J,INDEX,"TF",MPINTFI)
  1. .. S TFIEN=$$IEN^XUAF4($P(MPINTF,"^",1))
  1. .. S MPIFMDT=$$HL7TFM^XLFDT($P(MPINTF,"^",2)) I MPIFMDT<0 S MPIFMDT=""
  1. .. S TFSTRG=TFIEN_"^"_$G(MPIFMDT)_"^"_$P(MPINTF,"^",3)
  1. .. D FILE^VAFCTFU(DFN,TFSTRG,1)
  1. Q
  1. GETDATA(DIC,DA,MPIFAR,DR,EI) ;
  1. ;This function returns the values stored in the fields via FM call DIQ1
  1. ;DIC=file reference, DA=IEN in file, ARRAY=array for the values to be stored in, DR=fields requested, EI=external/internal values
  1. N DIQ S DIQ=MPIFAR
  1. I $G(EI)]"" S DIQ(0)=EI
  1. D EN^DIQ1
  1. Q
  1. LOOP2 ;
  1. N MPIDONE,MPII,MPIJ
  1. S MPII=0,MPIDONE=0
  1. F S MPIQUIT=$O(MPIDC(MPIQUIT)) Q:'MPIQUIT D Q:MPIDONE
  1. . I MPIDC(MPIQUIT)="" S MPIDONE=1 Q
  1. . S MPII=MPII+1,MPINODE(MPII)=$G(MPIDC(MPIQUIT)) Q
  1. Q
  1. MSH ;
  1. S MPIREP=$E(HL("ECH"),2),MPICOMP=$E(HL("ECH"),1)
  1. Q
  1. MSA ;
  1. Q
  1. RDF ;
  1. Q
  1. QAK ;**43 added check for potential matches
  1. K MPIPOT S MPIPOT=0
  1. I MSG(1)["POTENTIAL MATCHES" S MPIPOT=1
  1. Q
  1. RDT ;
  1. N NAME,ICN,BIRTHDAY,CMOR,IEN,SEG,HEREICN,STRING,LASTNAME,FRSTNAME,MIDDLE,SUFF,SEX
  1. S STRING="",INDEX=$G(INDEX)+1
  1. D RDT^MPIFSA3(.INDEX,.HL,.MSG)
  1. S SEG=^TMP("MPIFVQQ",$J,INDEX,"DATA")
  1. S FRSTNAME=$P(SEG,"^",7),LASTNAME=$P(SEG,"^",2),MIDDLE=$P(SEG,"^",10),SUFF=$P(SEG,"^",15)
  1. S SSN=$P(SEG,"^",3),NAME=LASTNAME_","_FRSTNAME
  1. I MIDDLE'="" S NAME=NAME_" "_MIDDLE
  1. I SUFF'="" S NAME=NAME_" "_SUFF
  1. S SEX=$P(SEG,"^",11)
  1. S ICN=$P(SEG,"^",6)
  1. S BIRTHDAY=$P(SEG,"^",4)
  1. S CMOR=$P(SEG,"^",5),IEN=$$IEN^XUAF4(CMOR)
  1. I IEN'="" S CMOR=$P($$NS^XUAF4(IEN),"^") ;**54 fix when CMOR not passed
  1. S HEREICN=$$HEREICN^MPIFQ3($P(ICN,"V",1))
  1. I HEREICN S STRING=$$SETSTR^VALM1("*",STRING,1,1),^TMP("MPIFVQQ",$J,INDEX,"INDICATOR")="*"_"^"_HEREICN
  1. S STRING=$$SETSTR^VALM1(INDEX,STRING,2,4),STRING=$$SETSTR^VALM1($E(NAME,1,23),STRING,6,23)
  1. S STRING=$$SETSTR^VALM1(SSN,STRING,30,9),STRING=$$SETSTR^VALM1(BIRTHDAY,STRING,41,10)
  1. S STRING=$$SETSTR^VALM1(CMOR,STRING,54,20)
  1. S ^TMP("MPIFVQQ",$J,INDEX,0)=STRING,^TMP("MPIFVQQ",$J,"IDX",INDEX,INDEX)=""
  1. Q
  1. Q