- 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 Jan 18, 2025@03:12:47 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