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