149 lines
7.3 KiB
Mathematica
149 lines
7.3 KiB
Mathematica
|
MPIFSA2 ;SF/CMC-STAND ALONE QUERY PART 2 ;APRIL 22, 2003
|
||
|
|
;;1.0; MASTER PATIENT INDEX VISTA ;**28,29,35,38,43**;30 Apr 99
|
||
|
|
;
|
||
|
|
;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
|
||
|
|
;;
|
||
|
|
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
|
||
|
|
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
|
||
|
|
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)
|
||
|
|
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
|
||
|
|
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,MNAME,SUFFIX,SEX,IEN,CMOR2,TF2,CLAIM,CASE,NOIS,CUSER,TFN,CMOR3,POW,MBIRTH,TIEN,MIDDLE
|
||
|
|
S (CNT1)=0
|
||
|
|
F S CNT1=$O(^TMP("MPIFVQQ",$J,CNT1)) Q:CNT1'>0!($D(STOP)) D
|
||
|
|
. S CNTR2=0
|
||
|
|
. I CNT1>1 D
|
||
|
|
. . K DIR,X,Y S DIR(0)="Y",DIR("B")="YES",DIR("A")="Continue to next Patient? " D ^DIR
|
||
|
|
. . I Y'=1 S STOP=""
|
||
|
|
. Q:$D(STOP)
|
||
|
|
. S CNTR2=CNTR2+1,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),CMOR=$P(DATA,"^",5)
|
||
|
|
. I $G(CMOR)'="" S TIEN=$$LKUP^XUAF4(CMOR) I TIEN'="" S CMOR2=$P($$NS^XUAF4(+TIEN),"^")
|
||
|
|
. S SEX=$P(DATA,"^",11),SUFFIX=$P(DATA,"^",15),PREFIX=$P(DATA,"^",14),MIDDLE=$P(DATA,"^",10),POBC=$P(DATA,"^",12),POBS=$P(DATA,"^",13),MNAME=$P(DATA,"^",16)
|
||
|
|
. S PAST=$P(DATA,"^",9),CLAIM=$P(DATA,"^",17),CASE=$P(DATA,"^",18),NOIS=$P(CASE,"/",2),CUSER=$P(CASE,"/",3),CASE=$P(CASE,"/")
|
||
|
|
. S CMOR3=$P($$NS^XUAF4(CMOR),"^"),MBIRTH=$P(DATA,"^",20),POW=$P(DATA,"^",19)
|
||
|
|
. W:$G(CASE)'="" !,"<<THIS ICN IS ACTIVELY BEING WORKED ON - CASE #",CASE
|
||
|
|
. W:$G(NOIS)'="" " NOIS/REMEDY TICKET: ",NOIS ;**43 CHANGED DISPLAY TO BE NOIS/REMEDY TICKET
|
||
|
|
. W:$G(CASE)'="" ">>"
|
||
|
|
. W:$G(CUSER)'="" !,?3,"Case Worker: ",CUSER
|
||
|
|
. W !!,"ICN : ",$P(ICN,"V"),?30,"CMOR: ",CMOR2," (",CMOR,")"
|
||
|
|
. W !,"Name : ",NAME,!,"SSN : ",SSN
|
||
|
|
. W !,"DOB : ",BIRTHDAY
|
||
|
|
. W:$G(PAST)'="" ?30,"Date of Death: ",PAST
|
||
|
|
. W:$G(MBIRTH)'=""&(MBIRTH'="N") !,"Multiple Birth Indicator: Yes"
|
||
|
|
. W !,"Sex : ",SEX
|
||
|
|
. W:$G(CLAIM)'="" !,"Claim # : ",CLAIM
|
||
|
|
. W:$G(POBC)'="" !,"Place of Birth: ",POBC W:$G(POBS)'="" ", ",POBS
|
||
|
|
. W:$G(MNAME)'="" !,"Mother's Maiden Name: ",MNAME
|
||
|
|
. W:$G(POW)'="" !,"POW Status: ",POW
|
||
|
|
. I $D(^TMP("MPIFVQQ",$J,CNT1,"ALIAS")) D
|
||
|
|
. . W !!,"Alias(es): "
|
||
|
|
. . S XXX=0 F S XXX=$O(^TMP("MPIFVQQ",$J,CNT1,"ALIAS",XXX)) Q:XXX="" D
|
||
|
|
. . . W !?5,^TMP("MPIFVQQ",$J,CNT1,"ALIAS",XXX)
|
||
|
|
. S CNT2=""
|
||
|
|
. W ! N TMP S XXX=0 F S XXX=$O(^TMP("MPIFVQQ",$J,CNT1,"TF",XXX)) Q:XXX="" S TMP=$G(^TMP("MPIFVQQ",$J,CNT1,"TF",XXX)) Q:TMP="" D
|
||
|
|
.. S TMP=$P(TMP,MPICOMP,1) I TMP'=CMOR3 W !?10,"Treating Facility: ",$P($$NS^XUAF4($$LKUP^XUAF4(TMP)),"^")," (",TMP,")"
|
||
|
|
.W !!
|
||
|
|
EXIT K DA,X,Y W !! 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")_24_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
|