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

MPIFSA2.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;Integration Agreements: $$EN^HLCSAC - #3471
  1. ;
  1. FIELD ;
  1. ;;@00108.1;LAST NAME;ST;30
  1. ;;@00122;SSN;ST;9
  1. ;;@00110;DOB;TS;8
  1. ;;@00756;PRIMARY CARE SITE;ST;6
  1. ;;@00105;ICN;ST;19
  1. ;;@00108.2;FIRST NAME;ST;30
  1. ;;@00169;TREATING FACILITY (MULTIPLE--FILE 985.5);ST;999
  1. ;;@00740;DATE OF DEATH;TS;8
  1. ;;@00108.3;MIDDLE;ST;16
  1. ;;@00111;SEX;ST;1
  1. ;;@00126.1;BIRTH PLACE CITY;ST;30
  1. ;;@00126.2;BIRTH PLACE STATE;ST;3
  1. ;;@00108.5;NAME PREFIX;ST;15
  1. ;;@00108.4;NAME SUFFIX;ST;10
  1. ;;@00109.1;MOTHER'S MAIDEN NAME;ST;20
  1. ;;@ZEL6;CLAIM NUMBER;ST;9
  1. ;;@CASE#;MPI DUP CASE#;ST;69
  1. ;;@POW;POW STATUS;ST;1
  1. ;;@00127;MULTIPLE BIRTH INDICATOR;ST;1
  1. ;;@00112.1;ALIAS LAST NAME;ST;30
  1. ;;@00112.2;ALIAS FIRST NAME;ST;25
  1. ;;@00112.3;ALIAS MIDDLE NAME;ST;25
  1. ;;@00112.5;ALIAS PREFIX;ST;10
  1. ;;@00112.4;ALIAS SUFFIX;ST;10
  1. ;;@00114.1;STREET ADDRESS LINE 1;ST;35
  1. ;;@00114.2;STREET ADDRESS LINE 2;ST;30
  1. ;;@00114.3;CITY;ST;28
  1. ;;@00114.8;STREET ADDRESS LINE 3;ST;30
  1. ;;@00116;PHONE NUMBER (RESIDENCE);ST;23
  1. ;;@SCORE;SCORE;ST;8
  1. ;;@ALTRSHLD;AUTOLINK THRESHOLD;ST;5
  1. ;;@TKTRSHLD;TASK THRESHOLD;ST;5
  1. ;;
  1. VTQ(MPIVAR) ;
  1. N TIME,% D NOW^%DTC S TIME=%
  1. 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...."
  1. N HL,MPIQRYNM,MPIINM,MPIOUT,MPIIN,MPIMCNT,MPICNT,MPICS,HEADER,RDF,QUERY,TEST,SITE,MPIDC,MPINM,MPI1NM,MPI2NM,MPIESC,MPIHDOB,MPIRS,MPISCS,QUEDDOB,MPIFLDV
  1. N MPIMID,MPIPRE,MPISUF ;80 VAMPI-24421 (jfw)
  1. S HLP("ACKTIME")=300,HL("ECH")="^~\&",HL("FS")="|",MPIIN="",MPICNT=1,MPICS=$E(HL("ECH"),1)
  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
  1. S MPIQRYNM="VTQ_DISPLAY_ONLY_QUERY"
  1. I '$D(MPIVAR("DFN")) S MPIVAR("DFN")=""
  1. S MPIMCNT=MPIVAR("DFN")
  1. ;SETUP VTQ
  1. S MPICS=$E(HL("ECH"),1),MPIRS=$E(HL("ECH"),2),MPISCS=$E(HL("ECH"),4),MPIESC=$E(HL("ECH"),3)
  1. D BLDRDF(.MPIOUT,3,MPIRS,MPICS)
  1. ; ^ fields to be returned in query response
  1. S QUERY="VTQ"_HL("FS")_$G(MPIVAR("DFN"))_HL("FS")_"T"_HL("FS")_MPIQRYNM_HL("FS")_"ICN"_HL("FS")
  1. S MPI2NM=$P($G(MPIVAR("NM")),",",1),QUERY=QUERY_"@00108.1"_MPICS_"EQ"_MPICS_MPI2NM ; ^ sending last name
  1. I MPIVAR("SSN")'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00122"_MPICS_"EQ"_MPICS_$G(MPIVAR("SSN")) ; ^ sending SSN
  1. 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
  1. ; ^ sending first name
  1. I $G(MPIVAR("DOB"))>0 D
  1. .S MPIHDOB=$$HLDATE^HLFNC(MPIVAR("DOB")) ; send date of birth (convert to hl7 date format)
  1. .S QUEDDOB=MPICS_"AND"_MPIRS_"@00110"_MPICS_"EQ"_MPICS_MPIHDOB,QUERY=QUERY_QUEDDOB ; ^ sending date of birth
  1. 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
  1. S MPISUF=$P(MPI1NM," ",3) I MPISUF'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.4"_MPICS_"EQ"_MPICS_MPISUF ; sending suffix
  1. S MPIPRE=$P(MPI1NM," ",4) I MPIPRE'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.5"_MPICS_"EQ"_MPICS_MPIPRE ; sending prefix
  1. I $G(MPIVAR("SEX"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00111"_MPICS_"EQ"_MPICS_$G(MPIVAR("SEX")) ;sending sex
  1. I $G(MPIVAR("ADDR1"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.1"_MPICS_"EQ"_MPICS_$G(MPIVAR("ADDR1")) ;sending Address 1
  1. I $G(MPIVAR("ADDR2"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.2"_MPICS_"EQ"_MPICS_$G(MPIVAR("ADDR2")) ;sending Address 2
  1. I $G(MPIVAR("CITY"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.3"_MPICS_"EQ"_MPICS_$G(MPIVAR("CITY")) ;sending City
  1. I $G(MPIVAR("ADDR3"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.8"_MPICS_"EQ"_MPICS_$G(MPIVAR("ADDR3")) ;sending Address 3
  1. I $G(MPIVAR("PHONE"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00116"_MPICS_"EQ"_MPICS_$G(MPIVAR("PHONE")) ;sending Residence Phone
  1. ;keep following traits for future use
  1. ;I $G(MPIVAR("MMN"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00109.1"_MPICS_"EQ"_MPICS_$G(MPIVAR("MMN")) ;sending Mother's maiden name
  1. ;I $G(MPIVAR("CLAIM"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@ZEL6"_MPICS_"EQ"_MPICS_$G(MPIVAR("CLAIM")) ;sending Claim #
  1. ;I $G(MPIVAR("POBCITY"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00126.1"_MPICS_"EQ"_MPICS_$G(MPIVAR("POBCITY")) ;sending POB city
  1. ;I $G(MPIVAR("POBSTATE"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00126.2"_MPICS_"EQ"_MPICS_$G(MPIVAR("POBSTATE")) ;sending POB State
  1. S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",3) ;**29
  1. 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
  1. S MPIOUT(1)=HEADER K MPIOUT(0) S MPIOUT(2)=QUERY
  1. ;Attempt to connect to MPI and send message,receive message. Message is returned in MPIDC array
  1. S TEST=$$EN^HLCSAC("MPIVA DIR","MPIOUT","MPIDC")
  1. K HLP("ACKTIME") ;Clean up the ack timeout HLP array variable
  1. I +TEST<0 W !!,"Could not connect to MPI or Time-out occured, try again later." G EXIT
  1. K ^TMP("MPIFVQQ",$J),^TMP("MPIDOQ",$J)
  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. 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. I '$D(^TMP("MPIFVQQ",$J)) W !!,"Patient was not found in the MPI." G EXIT
  1. I INDEX>9 W !!,"More Identity Traits Required to Make a Match." G EXIT
  1. DISPLAY ; display data found
  1. I INDEX>1 W !!,"Found potential matches"
  1. I INDEX=1 W !!,"Found One Match"
  1. 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
  1. N MNAME,SUFFIX,SEX,IEN,CMOR2,TF2,CLAIM,CASE,NOIS,CUSER,TFN,CMOR3,POW,MBIRTH,TIEN,MIDDLE,SCORE,ALTRSHLD,TKTRSHLD,I
  1. N COUNT,DTOUT,DUOUT,ENOUGH,ICNARR,M,TMPICN ;80 VAMPI-24421 (jfw)
  1. S (CNT1)=0
  1. F S CNT1=$O(^TMP("MPIFVQQ",$J,CNT1)) Q:CNT1'>0!($D(STOP)) D
  1. . S DATA=$G(^TMP("MPIFVQQ",$J,CNT1,"DATA"))
  1. . Q:DATA=""
  1. . K CHECK S NAME=$P(DATA,"^"),SSN=$P(DATA,"^",3),BIRTHDAY=$P(DATA,"^",4),ICN=$P(DATA,"^",6)
  1. . S SEX=$P(DATA,"^",11),SCORE=$P(DATA,"^",21),ALTRSHLD=$P(DATA,"^",22),TKTRSHLD=$P(DATA,"^",23)
  1. . I $G(SCORE)="" W !!,"IdM System uavailable, try again later!" S STOP=1 Q ;Quit if no score is returned.
  1. . ;**55 MPIC_2218 Commented the following two lines, added the third
  1. . ;I SCORE>=ALTRSHLD S M="E"
  1. . ;I SCORE<ALTRSHLD,(SCORE>=TKTRSHLD) S M="P"
  1. . S M=$S(SCORE>=ALTRSHLD:"E",1:"P")
  1. . ;Rearranging array for sectional view display
  1. . ;S FULLICN=ICN ;**57 - MVI_2350 (cml)
  1. . ;**59 - MVI_3785 (ckn) - Storing full ICN in TMP global so it
  1. . ;display full ICN correctly. Removing + sign in front of ICN
  1. . ;in below lines.
  1. . S ^TMP("MPIDOQ",$J,M,SCORE,ICN)=NAME_"^"_SSN_"^"_BIRTHDAY_"^"_SEX
  1. . M ^TMP("MPIDOQ",$J,M,SCORE,ICN,"TF")=^TMP("MPIFVQQ",$J,CNT1,"TF")
  1. I $D(STOP) Q ;Quit if no score is returned
  1. DISP2 ;
  1. S COUNT=0
  1. W @IOF
  1. F I="E","P" D
  1. . I $D(^TMP("MPIDOQ",$J,I)) D HDR($S(I="E":"",I="P":" POTENTIAL",1:""))
  1. . S SCORE=9999999 F S SCORE=$O(^TMP("MPIDOQ",$J,I,SCORE),-1) Q:SCORE="" D
  1. . . S ICN=0 F S ICN=$O(^TMP("MPIDOQ",$J,I,SCORE,ICN)) Q:ICN="" D
  1. . . . S ICNARR(ICN)="",COUNT=COUNT+1
  1. . . . S DATA=$G(^TMP("MPIDOQ",$J,I,SCORE,ICN))
  1. . . . D HDR1
  1. . . . ;**59 - MVI_3785 (ckn) - replacing FULLICN with ICN
  1. . . . W !,COUNT_") ",?4,ICN,?22,$P(DATA,"^"),?54,$P(DATA,"^",2),?65,$P(DATA,"^",3),?76,$P(DATA,"^",4) ;**57 - MVI_2350 (cml)
  1. . . . 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
  1. . . . . S TMP=$P(TMP,"^",1) W !,?10,"Treating Facility: ",$P($$NS^XUAF4($$LKUP^XUAF4(TMP)),"^")," (",TMP,")"
  1. . . . W !
  1. S ENOUGH=0
  1. W !
  1. D ASK I ENOUGH G EXIT
  1. ;**59 - MVI_3785 (ckn) - send short ICN in ENRPC tag.
  1. I TMPICN'="" W !,"Please wait..." D ENRPC(+TMPICN)
  1. W !!
  1. K DIR,DA S DIR(0)="Y",DIR("B")="NO",DIR("A")="Would you like to see another record" D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) S ENOUGH=1 G EXIT
  1. I Y G DISP2
  1. EXIT K DA,X,Y,^TMP("MPIDOQ",$J) W !! Q
  1. HDR(HDL) ;Header
  1. W !,"--- All ICNs Below meet the"_HDL_" Match criteria ---"
  1. Q
  1. HDR1 ;Repeating header
  1. ; Story 603957 (elz) change Sex to Birth Sex
  1. W !,?74,"BIRTH"
  1. W !,?4,"ICN",?22,"NAME",?54,"SSN",?65,"DOB",?75,"SEX" ;**57 - MVI_2350 (cml)
  1. Q
  1. ASK ;
  1. N DIR,DA,DR,ND,SC,CNTR,BC,EC,ICN,QFLG ;80 VAMPI-24421 (jfw) - New QFLG Variable
  1. S EC=0,BC=1
  1. S TMP=0 F S TMP=$O(ICNARR(TMP)) Q:TMP="" S EC=EC+1
  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
  1. I $D(DTOUT)!($D(DUOUT)) S ENOUGH=1 Q
  1. S QFLG=0,CNTR=0
  1. F I="E","P" D
  1. . S SC=10000 F S SC=$O(^TMP("MPIDOQ",$J,I,SC),-1) Q:SC=""!(QFLG) D
  1. ..S ICN=0 F S ICN=$O(^TMP("MPIDOQ",$J,I,SC,ICN)) Q:ICN=""!(QFLG) D
  1. ...S CNTR=CNTR+1 I CNTR=+Y S QFLG=1,TMPICN=ICN
  1. Q
  1. ENRPC(ICN) ;RPC Call
  1. N LOC,HNDL,RETURN,I,ND
  1. S LOC="200M"
  1. D EN1^XWB2HL7(.RETURN,LOC,"MPIF EDAT REMOTE",1,ICN)
  1. S HNDL=$G(RETURN(0))
  1. ;**57,MVI_1414: Check whether EN^XWB2HL7 call succeeded
  1. I HNDL="" W:+$G(RETURN(1))=-1 !,$P(RETURN(1),"^",2) Q
  1. I +HNDL=-1 W !,$P(HNDL,"^",2) Q
  1. F I=1:1:20 K RETURN D RPCCHK^XWB2HL7(.RETURN,HNDL) Q:+RETURN(0)=1 Q:+RETURN(0)=-1 W "." H 5
  1. I +RETURN(0)=-1 W !,$P(RETURN(0),"^",2) Q
  1. I +RETURN(0)'=1 W !,"MPI system is unavailable to display the record, Try again later." Q
  1. ;S DONE=0
  1. ;F I=1:1:20 D Q:DONE
  1. ;. H 5 W "."
  1. ;. D RTNDATA^XWBDRPC(.RETURN,HNDL)
  1. ;. Q:$P(RETURN(0),"^")=0
  1. ;. I $P(RETURN(0),"^")=-1 D Q
  1. ;. . I RETURN(0)["Not DONE" Q
  1. ;. S DONE=1
  1. ;I 'DONE W !,"MPI system is unavailable to display the record, Try again later." Q
  1. ;I DONE,$G(^XTMP(HNDL,"D",1))'="" D
  1. I $G(^XTMP(HNDL,"D",1))'="" D
  1. . W @IOF S $Y=1
  1. . S ND=0 F S ND=$O(^XTMP(HNDL,"D",ND)) Q:ND="" D
  1. ..W !,^XTMP(HNDL,"D",ND)
  1. K ^XTMP(HNDL),RETURN
  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 ;
  1. Q
  1. RDT ;
  1. S INDEX=$G(INDEX)+1
  1. D RDT^MPIFSA3(.INDEX,.HL,.MSG)
  1. Q
  1. BLDRDF(MPIOUT,MPICNT,MPIRS,MPICS) ;
  1. 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
  1. . I I=1 S MPIFLDV=$P(T,";",3)_MPICS_$P(T,";",5)_MPICS_$P(T,";",6)
  1. . I I'=1 S MPIFLDV=MPIRS_$P(T,";",3)_MPICS_$P(T,";",5)_MPICS_$P(T,";",6)
  1. .N XLEN,TOTLEN
  1. . S TOTLEN=$L($G(MPIOUT(MPICNT)))+$L(MPIFLDV)
  1. . I TOTLEN'>245 S MPIOUT(MPICNT)=$G(MPIOUT(MPICNT))_MPIFLDV Q
  1. . I TOTLEN>245 D
  1. .. S XLEN=245-$L($G(MPIOUT(MPICNT)))
  1. .. S MPIOUT(MPICNT)=$G(MPIOUT(MPICNT))_$E(MPIFLDV,1,XLEN),MPICNT=MPICNT+1
  1. .. S MPIOUT(MPICNT)=$E(MPIFLDV,XLEN+1,245)
  1. Q