MPIFSA2 ;SF/CMC,CKN-STAND ALONE QUERY PART 2 ; 4/29/14 1:34pm
;;1.0;MASTER PATIENT INDEX VISTA;**28,29,35,38,43,52,55,57,59,66,80**;30 Apr 99;Build 2
;
;Integration Agreements: $$EN^HLCSAC - #3471
;
FIELD ;
;;@00108.1;LAST NAME;ST;30
;;@00122;SSN;ST;9
;;@00110;DOB;TS;8
;;@00756;PRIMARY CARE SITE;ST;6
;;@00105;ICN;ST;19
;;@00108.2;FIRST NAME;ST;30
;;@00169;TREATING FACILITY (MULTIPLE--FILE 985.5);ST;999
;;@00740;DATE OF DEATH;TS;8
;;@00108.3;MIDDLE;ST;16
;;@00111;SEX;ST;1
;;@00126.1;BIRTH PLACE CITY;ST;30
;;@00126.2;BIRTH PLACE STATE;ST;3
;;@00108.5;NAME PREFIX;ST;15
;;@00108.4;NAME SUFFIX;ST;10
;;@00109.1;MOTHER'S MAIDEN NAME;ST;20
;;@ZEL6;CLAIM NUMBER;ST;9
;;@CASE#;MPI DUP CASE#;ST;69
;;@POW;POW STATUS;ST;1
;;@00127;MULTIPLE BIRTH INDICATOR;ST;1
;;@00112.1;ALIAS LAST NAME;ST;30
;;@00112.2;ALIAS FIRST NAME;ST;25
;;@00112.3;ALIAS MIDDLE NAME;ST;25
;;@00112.5;ALIAS PREFIX;ST;10
;;@00112.4;ALIAS SUFFIX;ST;10
;;@00114.1;STREET ADDRESS LINE 1;ST;35
;;@00114.2;STREET ADDRESS LINE 2;ST;30
;;@00114.3;CITY;ST;28
;;@00114.8;STREET ADDRESS LINE 3;ST;30
;;@00116;PHONE NUMBER (RESIDENCE);ST;23
;;@SCORE;SCORE;ST;8
;;@ALTRSHLD;AUTOLINK THRESHOLD;ST;5
;;@TKTRSHLD;TASK THRESHOLD;ST;5
;;
VTQ(MPIVAR) ;
N TIME,% D NOW^%DTC S TIME=%
W !!,"Attempting to connect to the Master Patient Index in Austin...",!,"If DOB is inexact or if SSN is not passed or if common name,",!,"this could take some time - please be patient...."
N HL,MPIQRYNM,MPIINM,MPIOUT,MPIIN,MPIMCNT,MPICNT,MPICS,HEADER,RDF,QUERY,TEST,SITE,MPIDC,MPINM,MPI1NM,MPI2NM,MPIESC,MPIHDOB,MPIRS,MPISCS,QUEDDOB,MPIFLDV
N MPIMID,MPIPRE,MPISUF ;80 VAMPI-24421 (jfw)
S HLP("ACKTIME")=300,HL("ECH")="^~\&",HL("FS")="|",MPIIN="",MPICNT=1,MPICS=$E(HL("ECH"),1)
;**43 CHANGING QUERY NAME FROM VTQ_PID_ICN_NO_LOAD TO VTQ_DISPLAY_ONLY_QUERY to enable the returning of potential matches and not just exact matches
S MPIQRYNM="VTQ_DISPLAY_ONLY_QUERY"
I '$D(MPIVAR("DFN")) S MPIVAR("DFN")=""
S MPIMCNT=MPIVAR("DFN")
;SETUP VTQ
S MPICS=$E(HL("ECH"),1),MPIRS=$E(HL("ECH"),2),MPISCS=$E(HL("ECH"),4),MPIESC=$E(HL("ECH"),3)
D BLDRDF(.MPIOUT,3,MPIRS,MPICS)
; ^ fields to be returned in query response
S QUERY="VTQ"_HL("FS")_$G(MPIVAR("DFN"))_HL("FS")_"T"_HL("FS")_MPIQRYNM_HL("FS")_"ICN"_HL("FS")
S MPI2NM=$P($G(MPIVAR("NM")),",",1),QUERY=QUERY_"@00108.1"_MPICS_"EQ"_MPICS_MPI2NM ; ^ sending last name
I MPIVAR("SSN")'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00122"_MPICS_"EQ"_MPICS_$G(MPIVAR("SSN")) ; ^ sending SSN
S MPI1NM=$P($G(MPIVAR("NM")),",",2),MPI1NM=$P(MPI1NM," ",1) I MPI1NM'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.2"_MPICS_"EQ"_MPICS_MPI1NM
; ^ sending first name
I $G(MPIVAR("DOB"))>0 D
.S MPIHDOB=$$HLDATE^HLFNC(MPIVAR("DOB")) ; send date of birth (convert to hl7 date format)
.S QUEDDOB=MPICS_"AND"_MPIRS_"@00110"_MPICS_"EQ"_MPICS_MPIHDOB,QUERY=QUERY_QUEDDOB ; ^ sending date of birth
S MPI1NM=$P($G(MPIVAR("NM")),",",2),MPIMID=$P(MPI1NM," ",2) I MPIMID'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.3"_MPICS_"EQ"_MPICS_MPIMID ; sending middle name
S MPISUF=$P(MPI1NM," ",3) I MPISUF'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.4"_MPICS_"EQ"_MPICS_MPISUF ; sending suffix
S MPIPRE=$P(MPI1NM," ",4) I MPIPRE'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.5"_MPICS_"EQ"_MPICS_MPIPRE ; sending prefix
I $G(MPIVAR("SEX"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00111"_MPICS_"EQ"_MPICS_$G(MPIVAR("SEX")) ;sending sex
I $G(MPIVAR("ADDR1"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.1"_MPICS_"EQ"_MPICS_$G(MPIVAR("ADDR1")) ;sending Address 1
I $G(MPIVAR("ADDR2"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.2"_MPICS_"EQ"_MPICS_$G(MPIVAR("ADDR2")) ;sending Address 2
I $G(MPIVAR("CITY"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.3"_MPICS_"EQ"_MPICS_$G(MPIVAR("CITY")) ;sending City
I $G(MPIVAR("ADDR3"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.8"_MPICS_"EQ"_MPICS_$G(MPIVAR("ADDR3")) ;sending Address 3
I $G(MPIVAR("PHONE"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00116"_MPICS_"EQ"_MPICS_$G(MPIVAR("PHONE")) ;sending Residence Phone
;keep following traits for future use
;I $G(MPIVAR("MMN"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00109.1"_MPICS_"EQ"_MPICS_$G(MPIVAR("MMN")) ;sending Mother's maiden name
;I $G(MPIVAR("CLAIM"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@ZEL6"_MPICS_"EQ"_MPICS_$G(MPIVAR("CLAIM")) ;sending Claim #
;I $G(MPIVAR("POBCITY"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00126.1"_MPICS_"EQ"_MPICS_$G(MPIVAR("POBCITY")) ;sending POB city
;I $G(MPIVAR("POBSTATE"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00126.2"_MPICS_"EQ"_MPICS_$G(MPIVAR("POBSTATE")) ;sending POB State
S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",3) ;**29
S HEADER="MSH"_HL("FS")_HL("ECH")_HL("FS")_"MPI_LOAD"_HL("FS")_SITE_HL("FS")_"MPI-ICN"_HL("FS")_HL("FS")_HL("FS")_HL("FS")_"VQQ"_MPICS_"Q02"_HL("FS")_MPIMCNT_"-"_MPICNT_HL("FS") ;create msh **38 changed VTQ to VQQ
S MPIOUT(1)=HEADER K MPIOUT(0) S MPIOUT(2)=QUERY
;Attempt to connect to MPI and send message,receive message. Message is returned in MPIDC array
S TEST=$$EN^HLCSAC("MPIVA DIR","MPIOUT","MPIDC")
K HLP("ACKTIME") ;Clean up the ack timeout HLP array variable
I +TEST<0 W !!,"Could not connect to MPI or Time-out occured, try again later." G EXIT
K ^TMP("MPIFVQQ",$J),^TMP("MPIDOQ",$J)
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
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
I '$D(^TMP("MPIFVQQ",$J)) W !!,"Patient was not found in the MPI." G EXIT
I INDEX>9 W !!,"More Identity Traits Required to Make a Match." G EXIT
DISPLAY ; display data found
I INDEX>1 W !!,"Found potential matches"
I INDEX=1 W !!,"Found One Match"
N CNT1,CNT2,STOP,CNTR2,TTF,CNT3,DIR,X,Y,DATA,PREFIX,ANAME,APRE,ALN,AFN,NAME,SSN,BIRTHDAY,CMOR,TF,ICN,POBC,POBS,PAST,XXX,AMID,ASUF
N MNAME,SUFFIX,SEX,IEN,CMOR2,TF2,CLAIM,CASE,NOIS,CUSER,TFN,CMOR3,POW,MBIRTH,TIEN,MIDDLE,SCORE,ALTRSHLD,TKTRSHLD,I
N COUNT,DTOUT,DUOUT,ENOUGH,ICNARR,M,TMPICN ;80 VAMPI-24421 (jfw)
S (CNT1)=0
F S CNT1=$O(^TMP("MPIFVQQ",$J,CNT1)) Q:CNT1'>0!($D(STOP)) D
. S DATA=$G(^TMP("MPIFVQQ",$J,CNT1,"DATA"))
. Q:DATA=""
. K CHECK S NAME=$P(DATA,"^"),SSN=$P(DATA,"^",3),BIRTHDAY=$P(DATA,"^",4),ICN=$P(DATA,"^",6)
. S SEX=$P(DATA,"^",11),SCORE=$P(DATA,"^",21),ALTRSHLD=$P(DATA,"^",22),TKTRSHLD=$P(DATA,"^",23)
. I $G(SCORE)="" W !!,"IdM System uavailable, try again later!" S STOP=1 Q ;Quit if no score is returned.
. ;**55 MPIC_2218 Commented the following two lines, added the third
. ;I SCORE>=ALTRSHLD S M="E"
. ;I SCORE<ALTRSHLD,(SCORE>=TKTRSHLD) S M="P"
. S M=$S(SCORE>=ALTRSHLD:"E",1:"P")
. ;Rearranging array for sectional view display
. ;S FULLICN=ICN ;**57 - MVI_2350 (cml)
. ;**59 - MVI_3785 (ckn) - Storing full ICN in TMP global so it
. ;display full ICN correctly. Removing + sign in front of ICN
. ;in below lines.
. S ^TMP("MPIDOQ",$J,M,SCORE,ICN)=NAME_"^"_SSN_"^"_BIRTHDAY_"^"_SEX
. M ^TMP("MPIDOQ",$J,M,SCORE,ICN,"TF")=^TMP("MPIFVQQ",$J,CNT1,"TF")
I $D(STOP) Q ;Quit if no score is returned
DISP2 ;
S COUNT=0
W @IOF
F I="E","P" D
. I $D(^TMP("MPIDOQ",$J,I)) D HDR($S(I="E":"",I="P":" POTENTIAL",1:""))
. S SCORE=9999999 F S SCORE=$O(^TMP("MPIDOQ",$J,I,SCORE),-1) Q:SCORE="" D
. . S ICN=0 F S ICN=$O(^TMP("MPIDOQ",$J,I,SCORE,ICN)) Q:ICN="" D
. . . S ICNARR(ICN)="",COUNT=COUNT+1
. . . S DATA=$G(^TMP("MPIDOQ",$J,I,SCORE,ICN))
. . . D HDR1
. . . ;**59 - MVI_3785 (ckn) - replacing FULLICN with ICN
. . . W !,COUNT_") ",?4,ICN,?22,$P(DATA,"^"),?54,$P(DATA,"^",2),?65,$P(DATA,"^",3),?76,$P(DATA,"^",4) ;**57 - MVI_2350 (cml)
. . . W ! N TMP S XXX=0 F S XXX=$O(^TMP("MPIDOQ",$J,I,SCORE,ICN,"TF",XXX)) Q:XXX="" S TMP=$G(^TMP("MPIDOQ",$J,I,SCORE,ICN,"TF",XXX)) Q:TMP="" D
. . . . S TMP=$P(TMP,"^",1) W !,?10,"Treating Facility: ",$P($$NS^XUAF4($$LKUP^XUAF4(TMP)),"^")," (",TMP,")"
. . . W !
S ENOUGH=0
W !
D ASK I ENOUGH G EXIT
;**59 - MVI_3785 (ckn) - send short ICN in ENRPC tag.
I TMPICN'="" W !,"Please wait..." D ENRPC(+TMPICN)
W !!
K DIR,DA S DIR(0)="Y",DIR("B")="NO",DIR("A")="Would you like to see another record" D ^DIR
I $D(DTOUT)!($D(DUOUT)) S ENOUGH=1 G EXIT
I Y G DISP2
EXIT K DA,X,Y,^TMP("MPIDOQ",$J) W !! Q
HDR(HDL) ;Header
W !,"--- All ICNs Below meet the"_HDL_" Match criteria ---"
Q
HDR1 ;Repeating header
; Story 603957 (elz) change Sex to Birth Sex
W !,?74,"BIRTH"
W !,?4,"ICN",?22,"NAME",?54,"SSN",?65,"DOB",?75,"SEX" ;**57 - MVI_2350 (cml)
Q
ASK ;
N DIR,DA,DR,ND,SC,CNTR,BC,EC,ICN,QFLG ;80 VAMPI-24421 (jfw) - New QFLG Variable
S EC=0,BC=1
S TMP=0 F S TMP=$O(ICNARR(TMP)) Q:TMP="" S EC=EC+1
K DIR,X,Y S DIR(0)="NA^"_BC_":"_EC,DIR("A")="Enter the Number to display the details: ",DIR("?")="Enter the number from range of "_BC_" to "_EC D ^DIR
I $D(DTOUT)!($D(DUOUT)) S ENOUGH=1 Q
S QFLG=0,CNTR=0
F I="E","P" D
. S SC=10000 F S SC=$O(^TMP("MPIDOQ",$J,I,SC),-1) Q:SC=""!(QFLG) D
..S ICN=0 F S ICN=$O(^TMP("MPIDOQ",$J,I,SC,ICN)) Q:ICN=""!(QFLG) D
...S CNTR=CNTR+1 I CNTR=+Y S QFLG=1,TMPICN=ICN
Q
ENRPC(ICN) ;RPC Call
N LOC,HNDL,RETURN,I,ND
S LOC="200M"
D EN1^XWB2HL7(.RETURN,LOC,"MPIF EDAT REMOTE",1,ICN)
S HNDL=$G(RETURN(0))
;**57,MVI_1414: Check whether EN^XWB2HL7 call succeeded
I HNDL="" W:+$G(RETURN(1))=-1 !,$P(RETURN(1),"^",2) Q
I +HNDL=-1 W !,$P(HNDL,"^",2) Q
F I=1:1:20 K RETURN D RPCCHK^XWB2HL7(.RETURN,HNDL) Q:+RETURN(0)=1 Q:+RETURN(0)=-1 W "." H 5
I +RETURN(0)=-1 W !,$P(RETURN(0),"^",2) Q
I +RETURN(0)'=1 W !,"MPI system is unavailable to display the record, Try again later." Q
;S DONE=0
;F I=1:1:20 D Q:DONE
;. H 5 W "."
;. D RTNDATA^XWBDRPC(.RETURN,HNDL)
;. Q:$P(RETURN(0),"^")=0
;. I $P(RETURN(0),"^")=-1 D Q
;. . I RETURN(0)["Not DONE" Q
;. S DONE=1
;I 'DONE W !,"MPI system is unavailable to display the record, Try again later." Q
;I DONE,$G(^XTMP(HNDL,"D",1))'="" D
I $G(^XTMP(HNDL,"D",1))'="" D
. W @IOF S $Y=1
. S ND=0 F S ND=$O(^XTMP(HNDL,"D",ND)) Q:ND="" D
..W !,^XTMP(HNDL,"D",ND)
K ^XTMP(HNDL),RETURN
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 ;
Q
RDT ;
S INDEX=$G(INDEX)+1
D RDT^MPIFSA3(.INDEX,.HL,.MSG)
Q
BLDRDF(MPIOUT,MPICNT,MPIRS,MPICS) ;
S MPIOUT(MPICNT)="RDF"_HL("FS")_32_HL("FS") N T,I F I=1:1 S T=$T(FIELD+I) Q:$P(T,";",3)="" D
. I I=1 S MPIFLDV=$P(T,";",3)_MPICS_$P(T,";",5)_MPICS_$P(T,";",6)
. I I'=1 S MPIFLDV=MPIRS_$P(T,";",3)_MPICS_$P(T,";",5)_MPICS_$P(T,";",6)
.N XLEN,TOTLEN
. S TOTLEN=$L($G(MPIOUT(MPICNT)))+$L(MPIFLDV)
. I TOTLEN'>245 S MPIOUT(MPICNT)=$G(MPIOUT(MPICNT))_MPIFLDV Q
. I TOTLEN>245 D
.. S XLEN=245-$L($G(MPIOUT(MPICNT)))
.. S MPIOUT(MPICNT)=$G(MPIOUT(MPICNT))_$E(MPIFLDV,1,XLEN),MPICNT=MPICNT+1
.. S MPIOUT(MPICNT)=$E(MPIFLDV,XLEN+1,245)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFSA2 11355 printed Oct 16, 2024@18:12:24 Page 2
MPIFSA2 ;SF/CMC,CKN-STAND ALONE QUERY PART 2 ; 4/29/14 1:34pm
+1 ;;1.0;MASTER PATIENT INDEX VISTA;**28,29,35,38,43,52,55,57,59,66,80**;30 Apr 99;Build 2
+2 ;
+3 ;Integration Agreements: $$EN^HLCSAC - #3471
+4 ;
FIELD ;
+1 ;;@00108.1;LAST NAME;ST;30
+2 ;;@00122;SSN;ST;9
+3 ;;@00110;DOB;TS;8
+4 ;;@00756;PRIMARY CARE SITE;ST;6
+5 ;;@00105;ICN;ST;19
+6 ;;@00108.2;FIRST NAME;ST;30
+7 ;;@00169;TREATING FACILITY (MULTIPLE--FILE 985.5);ST;999
+8 ;;@00740;DATE OF DEATH;TS;8
+9 ;;@00108.3;MIDDLE;ST;16
+10 ;;@00111;SEX;ST;1
+11 ;;@00126.1;BIRTH PLACE CITY;ST;30
+12 ;;@00126.2;BIRTH PLACE STATE;ST;3
+13 ;;@00108.5;NAME PREFIX;ST;15
+14 ;;@00108.4;NAME SUFFIX;ST;10
+15 ;;@00109.1;MOTHER'S MAIDEN NAME;ST;20
+16 ;;@ZEL6;CLAIM NUMBER;ST;9
+17 ;;@CASE#;MPI DUP CASE#;ST;69
+18 ;;@POW;POW STATUS;ST;1
+19 ;;@00127;MULTIPLE BIRTH INDICATOR;ST;1
+20 ;;@00112.1;ALIAS LAST NAME;ST;30
+21 ;;@00112.2;ALIAS FIRST NAME;ST;25
+22 ;;@00112.3;ALIAS MIDDLE NAME;ST;25
+23 ;;@00112.5;ALIAS PREFIX;ST;10
+24 ;;@00112.4;ALIAS SUFFIX;ST;10
+25 ;;@00114.1;STREET ADDRESS LINE 1;ST;35
+26 ;;@00114.2;STREET ADDRESS LINE 2;ST;30
+27 ;;@00114.3;CITY;ST;28
+28 ;;@00114.8;STREET ADDRESS LINE 3;ST;30
+29 ;;@00116;PHONE NUMBER (RESIDENCE);ST;23
+30 ;;@SCORE;SCORE;ST;8
+31 ;;@ALTRSHLD;AUTOLINK THRESHOLD;ST;5
+32 ;;@TKTRSHLD;TASK THRESHOLD;ST;5
+33 ;;
VTQ(MPIVAR) ;
+1 NEW TIME,%
DO NOW^%DTC
SET TIME=%
+2 WRITE !!,"Attempting to connect to the Master Patient Index in Austin...",!,"If DOB is inexact or if SSN is not passed or if common name,",!,"this could take some time - please be patient...."
+3 NEW HL,MPIQRYNM,MPIINM,MPIOUT,MPIIN,MPIMCNT,MPICNT,MPICS,HEADER,RDF,QUERY,TEST,SITE,MPIDC,MPINM,MPI1NM,MPI2NM,MPIESC,MPIHDOB,MPIRS,MPISCS,QUEDDOB,MPIFLDV
+4 ;80 VAMPI-24421 (jfw)
NEW MPIMID,MPIPRE,MPISUF
+5 SET HLP("ACKTIME")=300
SET HL("ECH")="^~\&"
SET HL("FS")="|"
SET MPIIN=""
SET MPICNT=1
SET MPICS=$EXTRACT(HL("ECH"),1)
+6 ;**43 CHANGING QUERY NAME FROM VTQ_PID_ICN_NO_LOAD TO VTQ_DISPLAY_ONLY_QUERY to enable the returning of potential matches and not just exact matches
+7 SET MPIQRYNM="VTQ_DISPLAY_ONLY_QUERY"
+8 IF '$DATA(MPIVAR("DFN"))
SET MPIVAR("DFN")=""
+9 SET MPIMCNT=MPIVAR("DFN")
+10 ;SETUP VTQ
+11 SET MPICS=$EXTRACT(HL("ECH"),1)
SET MPIRS=$EXTRACT(HL("ECH"),2)
SET MPISCS=$EXTRACT(HL("ECH"),4)
SET MPIESC=$EXTRACT(HL("ECH"),3)
+12 DO BLDRDF(.MPIOUT,3,MPIRS,MPICS)
+13 ; ^ fields to be returned in query response
+14 SET QUERY="VTQ"_HL("FS")_$GET(MPIVAR("DFN"))_HL("FS")_"T"_HL("FS")_MPIQRYNM_HL("FS")_"ICN"_HL("FS")
+15 ; ^ sending last name
SET MPI2NM=$PIECE($GET(MPIVAR("NM")),",",1)
SET QUERY=QUERY_"@00108.1"_MPICS_"EQ"_MPICS_MPI2NM
+16 ; ^ sending SSN
IF MPIVAR("SSN")'=""
SET QUERY=QUERY_MPICS_"AND"_MPIRS_"@00122"_MPICS_"EQ"_MPICS_$GET(MPIVAR("SSN"))
+17 SET MPI1NM=$PIECE($GET(MPIVAR("NM")),",",2)
SET MPI1NM=$PIECE(MPI1NM," ",1)
IF MPI1NM'=""
SET QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.2"_MPICS_"EQ"_MPICS_MPI1NM
+18 ; ^ sending first name
+19 IF $GET(MPIVAR("DOB"))>0
Begin DoDot:1
+20 ; send date of birth (convert to hl7 date format)
SET MPIHDOB=$$HLDATE^HLFNC(MPIVAR("DOB"))
+21 ; ^ sending date of birth
SET QUEDDOB=MPICS_"AND"_MPIRS_"@00110"_MPICS_"EQ"_MPICS_MPIHDOB
SET QUERY=QUERY_QUEDDOB
End DoDot:1
+22 ; sending middle name
SET MPI1NM=$PIECE($GET(MPIVAR("NM")),",",2)
SET MPIMID=$PIECE(MPI1NM," ",2)
IF MPIMID'=""
SET QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.3"_MPICS_"EQ"_MPICS_MPIMID
+23 ; sending suffix
SET MPISUF=$PIECE(MPI1NM," ",3)
IF MPISUF'=""
SET QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.4"_MPICS_"EQ"_MPICS_MPISUF
+24 ; sending prefix
SET MPIPRE=$PIECE(MPI1NM," ",4)
IF MPIPRE'=""
SET QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.5"_MPICS_"EQ"_MPICS_MPIPRE
+25 ;sending sex
IF $GET(MPIVAR("SEX"))'=""
SET QUERY=QUERY_MPICS_"AND"_MPIRS_"@00111"_MPICS_"EQ"_MPICS_$GET(MPIVAR("SEX"))
+26 ;sending Address 1
IF $GET(MPIVAR("ADDR1"))'=""
SET QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.1"_MPICS_"EQ"_MPICS_$GET(MPIVAR("ADDR1"))
+27 ;sending Address 2
IF $GET(MPIVAR("ADDR2"))'=""
SET QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.2"_MPICS_"EQ"_MPICS_$GET(MPIVAR("ADDR2"))
+28 ;sending City
IF $GET(MPIVAR("CITY"))'=""
SET QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.3"_MPICS_"EQ"_MPICS_$GET(MPIVAR("CITY"))
+29 ;sending Address 3
IF $GET(MPIVAR("ADDR3"))'=""
SET QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.8"_MPICS_"EQ"_MPICS_$GET(MPIVAR("ADDR3"))
+30 ;sending Residence Phone
IF $GET(MPIVAR("PHONE"))'=""
SET QUERY=QUERY_MPICS_"AND"_MPIRS_"@00116"_MPICS_"EQ"_MPICS_$GET(MPIVAR("PHONE"))
+31 ;keep following traits for future use
+32 ;I $G(MPIVAR("MMN"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00109.1"_MPICS_"EQ"_MPICS_$G(MPIVAR("MMN")) ;sending Mother's maiden name
+33 ;I $G(MPIVAR("CLAIM"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@ZEL6"_MPICS_"EQ"_MPICS_$G(MPIVAR("CLAIM")) ;sending Claim #
+34 ;I $G(MPIVAR("POBCITY"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00126.1"_MPICS_"EQ"_MPICS_$G(MPIVAR("POBCITY")) ;sending POB city
+35 ;I $G(MPIVAR("POBSTATE"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00126.2"_MPICS_"EQ"_MPICS_$G(MPIVAR("POBSTATE")) ;sending POB State
+36 ;**29
SET SITE=$$SITE^VASITE
SET SITE=$PIECE(SITE,"^",3)
+37 ;create msh **38 changed VTQ to VQQ
SET HEADER="MSH"_HL("FS")_HL("ECH")_HL("FS")_"MPI_LOAD"_HL("FS")_SITE_HL("FS")_"MPI-ICN"_HL("FS")_HL("FS")_HL("FS")_HL("FS")_"VQQ"_MPICS_"Q02"_HL("FS")_MPIMCNT_"-"_MPICNT_HL("FS")
+38 SET MPIOUT(1)=HEADER
KILL MPIOUT(0)
SET MPIOUT(2)=QUERY
+39 ;Attempt to connect to MPI and send message,receive message. Message is returned in MPIDC array
+40 SET TEST=$$EN^HLCSAC("MPIVA DIR","MPIOUT","MPIDC")
+41 ;Clean up the ack timeout HLP array variable
KILL HLP("ACKTIME")
+42 IF +TEST<0
WRITE !!,"Could not connect to MPI or Time-out occured, try again later."
GOTO EXIT
+43 KILL ^TMP("MPIFVQQ",$JOB),^TMP("MPIDOQ",$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 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
+8 IF '$DATA(^TMP("MPIFVQQ",$JOB))
WRITE !!,"Patient was not found in the MPI."
GOTO EXIT
+9 IF INDEX>9
WRITE !!,"More Identity Traits Required to Make a Match."
GOTO EXIT
DISPLAY ; display data found
+1 IF INDEX>1
WRITE !!,"Found potential matches"
+2 IF INDEX=1
WRITE !!,"Found One Match"
+3 NEW CNT1,CNT2,STOP,CNTR2,TTF,CNT3,DIR,X,Y,DATA,PREFIX,ANAME,APRE,ALN,AFN,NAME,SSN,BIRTHDAY,CMOR,TF,ICN,POBC,POBS,PAST,XXX,AMID,ASUF
+4 NEW MNAME,SUFFIX,SEX,IEN,CMOR2,TF2,CLAIM,CASE,NOIS,CUSER,TFN,CMOR3,POW,MBIRTH,TIEN,MIDDLE,SCORE,ALTRSHLD,TKTRSHLD,I
+5 ;80 VAMPI-24421 (jfw)
NEW COUNT,DTOUT,DUOUT,ENOUGH,ICNARR,M,TMPICN
+6 SET (CNT1)=0
+7 FOR
SET CNT1=$ORDER(^TMP("MPIFVQQ",$JOB,CNT1))
if CNT1'>0!($DATA(STOP))
QUIT
Begin DoDot:1
+8 SET DATA=$GET(^TMP("MPIFVQQ",$JOB,CNT1,"DATA"))
+9 if DATA=""
QUIT
+10 KILL CHECK
SET NAME=$PIECE(DATA,"^")
SET SSN=$PIECE(DATA,"^",3)
SET BIRTHDAY=$PIECE(DATA,"^",4)
SET ICN=$PIECE(DATA,"^",6)
+11 SET SEX=$PIECE(DATA,"^",11)
SET SCORE=$PIECE(DATA,"^",21)
SET ALTRSHLD=$PIECE(DATA,"^",22)
SET TKTRSHLD=$PIECE(DATA,"^",23)
+12 ;Quit if no score is returned.
IF $GET(SCORE)=""
WRITE !!,"IdM System uavailable, try again later!"
SET STOP=1
QUIT
+13 ;**55 MPIC_2218 Commented the following two lines, added the third
+14 ;I SCORE>=ALTRSHLD S M="E"
+15 ;I SCORE<ALTRSHLD,(SCORE>=TKTRSHLD) S M="P"
+16 SET M=$SELECT(SCORE>=ALTRSHLD:"E",1:"P")
+17 ;Rearranging array for sectional view display
+18 ;S FULLICN=ICN ;**57 - MVI_2350 (cml)
+19 ;**59 - MVI_3785 (ckn) - Storing full ICN in TMP global so it
+20 ;display full ICN correctly. Removing + sign in front of ICN
+21 ;in below lines.
+22 SET ^TMP("MPIDOQ",$JOB,M,SCORE,ICN)=NAME_"^"_SSN_"^"_BIRTHDAY_"^"_SEX
+23 MERGE ^TMP("MPIDOQ",$JOB,M,SCORE,ICN,"TF")=^TMP("MPIFVQQ",$JOB,CNT1,"TF")
End DoDot:1
+24 ;Quit if no score is returned
IF $DATA(STOP)
QUIT
DISP2 ;
+1 SET COUNT=0
+2 WRITE @IOF
+3 FOR I="E","P"
Begin DoDot:1
+4 IF $DATA(^TMP("MPIDOQ",$JOB,I))
DO HDR($SELECT(I="E":"",I="P":" POTENTIAL",1:""))
+5 SET SCORE=9999999
FOR
SET SCORE=$ORDER(^TMP("MPIDOQ",$JOB,I,SCORE),-1)
if SCORE=""
QUIT
Begin DoDot:2
+6 SET ICN=0
FOR
SET ICN=$ORDER(^TMP("MPIDOQ",$JOB,I,SCORE,ICN))
if ICN=""
QUIT
Begin DoDot:3
+7 SET ICNARR(ICN)=""
SET COUNT=COUNT+1
+8 SET DATA=$GET(^TMP("MPIDOQ",$JOB,I,SCORE,ICN))
+9 DO HDR1
+10 ;**59 - MVI_3785 (ckn) - replacing FULLICN with ICN
+11 ;**57 - MVI_2350 (cml)
WRITE !,COUNT_") ",?4,ICN,?22,$PIECE(DATA,"^"),?54,$PIECE(DATA,"^",2),?65,$PIECE(DATA,"^",3),?76,$PIECE(DATA,"^",4)
+12 WRITE !
NEW TMP
SET XXX=0
FOR
SET XXX=$ORDER(^TMP("MPIDOQ",$JOB,I,SCORE,ICN,"TF",XXX))
if XXX=""
QUIT
SET TMP=$GET(^TMP("MPIDOQ",$JOB,I,SCORE,ICN,"TF",XXX))
if TMP=""
QUIT
Begin DoDot:4
+13 SET TMP=$PIECE(TMP,"^",1)
WRITE !,?10,"Treating Facility: ",$PIECE($$NS^XUAF4($$LKUP^XUAF4(TMP)),"^")," (",TMP,")"
End DoDot:4
+14 WRITE !
End DoDot:3
End DoDot:2
End DoDot:1
+15 SET ENOUGH=0
+16 WRITE !
+17 DO ASK
IF ENOUGH
GOTO EXIT
+18 ;**59 - MVI_3785 (ckn) - send short ICN in ENRPC tag.
+19 IF TMPICN'=""
WRITE !,"Please wait..."
DO ENRPC(+TMPICN)
+20 WRITE !!
+21 KILL DIR,DA
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Would you like to see another record"
DO ^DIR
+22 IF $DATA(DTOUT)!($DATA(DUOUT))
SET ENOUGH=1
GOTO EXIT
+23 IF Y
GOTO DISP2
EXIT KILL DA,X,Y,^TMP("MPIDOQ",$JOB)
WRITE !!
QUIT
HDR(HDL) ;Header
+1 WRITE !,"--- All ICNs Below meet the"_HDL_" Match criteria ---"
+2 QUIT
HDR1 ;Repeating header
+1 ; Story 603957 (elz) change Sex to Birth Sex
+2 WRITE !,?74,"BIRTH"
+3 ;**57 - MVI_2350 (cml)
WRITE !,?4,"ICN",?22,"NAME",?54,"SSN",?65,"DOB",?75,"SEX"
+4 QUIT
ASK ;
+1 ;80 VAMPI-24421 (jfw) - New QFLG Variable
NEW DIR,DA,DR,ND,SC,CNTR,BC,EC,ICN,QFLG
+2 SET EC=0
SET BC=1
+3 SET TMP=0
FOR
SET TMP=$ORDER(ICNARR(TMP))
if TMP=""
QUIT
SET EC=EC+1
+4 KILL DIR,X,Y
SET DIR(0)="NA^"_BC_":"_EC
SET DIR("A")="Enter the Number to display the details: "
SET DIR("?")="Enter the number from range of "_BC_" to "_EC
DO ^DIR
+5 IF $DATA(DTOUT)!($DATA(DUOUT))
SET ENOUGH=1
QUIT
+6 SET QFLG=0
SET CNTR=0
+7 FOR I="E","P"
Begin DoDot:1
+8 SET SC=10000
FOR
SET SC=$ORDER(^TMP("MPIDOQ",$JOB,I,SC),-1)
if SC=""!(QFLG)
QUIT
Begin DoDot:2
+9 SET ICN=0
FOR
SET ICN=$ORDER(^TMP("MPIDOQ",$JOB,I,SC,ICN))
if ICN=""!(QFLG)
QUIT
Begin DoDot:3
+10 SET CNTR=CNTR+1
IF CNTR=+Y
SET QFLG=1
SET TMPICN=ICN
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
ENRPC(ICN) ;RPC Call
+1 NEW LOC,HNDL,RETURN,I,ND
+2 SET LOC="200M"
+3 DO EN1^XWB2HL7(.RETURN,LOC,"MPIF EDAT REMOTE",1,ICN)
+4 SET HNDL=$GET(RETURN(0))
+5 ;**57,MVI_1414: Check whether EN^XWB2HL7 call succeeded
+6 IF HNDL=""
if +$GET(RETURN(1))=-1
WRITE !,$PIECE(RETURN(1),"^",2)
QUIT
+7 IF +HNDL=-1
WRITE !,$PIECE(HNDL,"^",2)
QUIT
+8 FOR I=1:1:20
KILL RETURN
DO RPCCHK^XWB2HL7(.RETURN,HNDL)
if +RETURN(0)=1
QUIT
if +RETURN(0)=-1
QUIT
WRITE "."
HANG 5
+9 IF +RETURN(0)=-1
WRITE !,$PIECE(RETURN(0),"^",2)
QUIT
+10 IF +RETURN(0)'=1
WRITE !,"MPI system is unavailable to display the record, Try again later."
QUIT
+11 ;S DONE=0
+12 ;F I=1:1:20 D Q:DONE
+13 ;. H 5 W "."
+14 ;. D RTNDATA^XWBDRPC(.RETURN,HNDL)
+15 ;. Q:$P(RETURN(0),"^")=0
+16 ;. I $P(RETURN(0),"^")=-1 D Q
+17 ;. . I RETURN(0)["Not DONE" Q
+18 ;. S DONE=1
+19 ;I 'DONE W !,"MPI system is unavailable to display the record, Try again later." Q
+20 ;I DONE,$G(^XTMP(HNDL,"D",1))'="" D
+21 IF $GET(^XTMP(HNDL,"D",1))'=""
Begin DoDot:1
+22 WRITE @IOF
SET $Y=1
+23 SET ND=0
FOR
SET ND=$ORDER(^XTMP(HNDL,"D",ND))
if ND=""
QUIT
Begin DoDot:2
+24 WRITE !,^XTMP(HNDL,"D",ND)
End DoDot:2
End DoDot:1
+25 KILL ^XTMP(HNDL),RETURN
+26 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 ;
+1 QUIT
RDT ;
+1 SET INDEX=$GET(INDEX)+1
+2 DO RDT^MPIFSA3(.INDEX,.HL,.MSG)
+3 QUIT
BLDRDF(MPIOUT,MPICNT,MPIRS,MPICS) ;
+1 SET MPIOUT(MPICNT)="RDF"_HL("FS")_32_HL("FS")
NEW T,I
FOR I=1:1
SET T=$TEXT(FIELD+I)
if $PIECE(T,";",3)=""
QUIT
Begin DoDot:1
+2 IF I=1
SET MPIFLDV=$PIECE(T,";",3)_MPICS_$PIECE(T,";",5)_MPICS_$PIECE(T,";",6)
+3 IF I'=1
SET MPIFLDV=MPIRS_$PIECE(T,";",3)_MPICS_$PIECE(T,";",5)_MPICS_$PIECE(T,";",6)
+4 NEW XLEN,TOTLEN
+5 SET TOTLEN=$LENGTH($GET(MPIOUT(MPICNT)))+$LENGTH(MPIFLDV)
+6 IF TOTLEN'>245
SET MPIOUT(MPICNT)=$GET(MPIOUT(MPICNT))_MPIFLDV
QUIT
+7 IF TOTLEN>245
Begin DoDot:2
+8 SET XLEN=245-$LENGTH($GET(MPIOUT(MPICNT)))
+9 SET MPIOUT(MPICNT)=$GET(MPIOUT(MPICNT))_$EXTRACT(MPIFLDV,1,XLEN)
SET MPICNT=MPICNT+1
+10 SET MPIOUT(MPICNT)=$EXTRACT(MPIFLDV,XLEN+1,245)
End DoDot:2
End DoDot:1
+11 QUIT
