source: FOIAVistA/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFSA2.m@ 1671

Last change on this file since 1671 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.3 KB
Line 
1MPIFSA2 ;SF/CMC-STAND ALONE QUERY PART 2 ;APRIL 22, 2003
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**28,29,35,38,43**;30 Apr 99
3 ;
4 ;Integration Agreements: $$EN^HLCSAC - #3471
5 ;
6FIELD ;
7 ;;@00108.1;LAST NAME;ST;30
8 ;;@00122;SSN;ST;9
9 ;;@00110;DOB;TS;8
10 ;;@00756;PRIMARY CARE SITE;ST;6
11 ;;@00105;ICN;ST;19
12 ;;@00108.2;FIRST NAME;ST;30
13 ;;@00169;TREATING FACILITY (MULTIPLE--FILE 985.5);ST;999
14 ;;@00740;DATE OF DEATH;TS;8
15 ;;@00108.3;MIDDLE;ST;16
16 ;;@00111;SEX;ST;1
17 ;;@00126.1;BIRTH PLACE CITY;ST;30
18 ;;@00126.2;BIRTH PLACE STATE;ST;3
19 ;;@00108.5;NAME PREFIX;ST;15
20 ;;@00108.4;NAME SUFFIX;ST;10
21 ;;@00109.1;MOTHER'S MAIDEN NAME;ST;20
22 ;;@ZEL6;CLAIM NUMBER;ST;9
23 ;;@CASE#;MPI DUP CASE#;ST;69
24 ;;@POW;POW STATUS;ST;1
25 ;;@00127;MULTIPLE BIRTH INDICATOR;ST;1
26 ;;@00112.1;ALIAS LAST NAME;ST;30
27 ;;@00112.2;ALIAS FIRST NAME;ST;25
28 ;;@00112.3;ALIAS MIDDLE NAME;ST;25
29 ;;@00112.5;ALIAS PREFIX;ST;10
30 ;;@00112.4;ALIAS SUFFIX;ST;10
31 ;;
32VTQ(MPIVAR) ;
33 N TIME,% D NOW^%DTC S TIME=%
34 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...."
35 N HL,MPIQRYNM,MPIINM,MPIOUT,MPIIN,MPIMCNT,MPICNT,MPICS,HEADER,RDF,QUERY,TEST,SITE,MPIDC,MPINM,MPI1NM,MPI2NM,MPIESC,MPIHDOB,MPIRS,MPISCS,QUEDDOB,MPIFLDV
36 S HLP("ACKTIME")=300,HL("ECH")="^~\&",HL("FS")="|",MPIIN="",MPICNT=1,MPICS=$E(HL("ECH"),1)
37 ;**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
38 S MPIQRYNM="VTQ_DISPLAY_ONLY_QUERY"
39 I '$D(MPIVAR("DFN")) S MPIVAR("DFN")=""
40 S MPIMCNT=MPIVAR("DFN")
41 ;SETUP VTQ
42 S MPICS=$E(HL("ECH"),1),MPIRS=$E(HL("ECH"),2),MPISCS=$E(HL("ECH"),4),MPIESC=$E(HL("ECH"),3)
43 D BLDRDF(.MPIOUT,3,MPIRS,MPICS)
44 ; ^ fields to be returned in query response
45 S QUERY="VTQ"_HL("FS")_$G(MPIVAR("DFN"))_HL("FS")_"T"_HL("FS")_MPIQRYNM_HL("FS")_"ICN"_HL("FS")
46 S MPI2NM=$P($G(MPIVAR("NM")),",",1),QUERY=QUERY_"@00108.1"_MPICS_"EQ"_MPICS_MPI2NM ; ^ sending last name
47 I MPIVAR("SSN")'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00122"_MPICS_"EQ"_MPICS_$G(MPIVAR("SSN")) ; ^ sending SSN
48 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
49 I $G(MPIVAR("DOB"))>0 D
50 .S MPIHDOB=$$HLDATE^HLFNC(MPIVAR("DOB")) ; send date of birth (convert to hl7 date format)
51 .S QUEDDOB=MPICS_"AND"_MPIRS_"@00110"_MPICS_"EQ"_MPICS_MPIHDOB,QUERY=QUERY_QUEDDOB ; ^ sending date of birth
52 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
53 S MPISUF=$P(MPI1NM," ",3) I MPISUF'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.4"_MPICS_"EQ"_MPICS_MPISUF ; sending suffix
54 S MPIPRE=$P(MPI1NM," ",4) I MPIPRE'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.5"_MPICS_"EQ"_MPICS_MPIPRE ; sending prefix
55 I $G(MPIVAR("SEX"))'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00111"_MPICS_"EQ"_MPICS_$G(MPIVAR("SEX")) ;sending sex
56 S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",3) ;**29
57 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
58 S MPIOUT(1)=HEADER K MPIOUT(0) S MPIOUT(2)=QUERY
59 ;Attempt to connect to MPI and send message,receive message. Message is returned in MPIDC array
60 S TEST=$$EN^HLCSAC("MPIVA DIR","MPIOUT","MPIDC")
61 K HLP("ACKTIME") ;Clean up the ack timeout HLP array variable
62 I +TEST<0 W !!,"Could not connect to MPI or Time-out occured, try again later." G EXIT
63 K ^TMP("MPIFVQQ",$J)
64INIPARS ;
65 N SEG,INDEX,SKIP,CHECK,AL,TTF2,TFLL,TF,TF2,MPIREP,MPICOMP
66 S INDEX=0 K CHECK
67LOOP1 ;
68 ;process in ADT type messages
69 N MPIX S MPIX=0 N REP,SG,MSG,MPIQUIT,MPINODE
70 S MPIQUIT=0
71 F MPIX=0:1 X "D LOOP2" D K MPINODE,MSG Q:MPIQUIT'>0
72 . I $D(MPINODE(1)) S SG=$E(MPINODE(1),1,3) S MSG(1)=MPINODE(1) D
73 .. S MPIJ=1 F S MPIJ=$O(MPINODE(MPIJ)) Q:'MPIJ S MSG(MPIJ)=MPINODE(MPIJ)
74 .. D:SG?2A1(1A,1N) @SG
75 I '$D(^TMP("MPIFVQQ",$J)) W !!,"Patient was not found in the MPI." G EXIT
76DISPLAY ; display data found
77 I INDEX>1 W !!,"Found potential matches"
78 I INDEX=1 W !!,"Found One Match"
79 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
80 S (CNT1)=0
81 F S CNT1=$O(^TMP("MPIFVQQ",$J,CNT1)) Q:CNT1'>0!($D(STOP)) D
82 . S CNTR2=0
83 . I CNT1>1 D
84 . . K DIR,X,Y S DIR(0)="Y",DIR("B")="YES",DIR("A")="Continue to next Patient? " D ^DIR
85 . . I Y'=1 S STOP=""
86 . Q:$D(STOP)
87 . S CNTR2=CNTR2+1,DATA=$G(^TMP("MPIFVQQ",$J,CNT1,"DATA"))
88 . Q:DATA=""
89 . K CHECK S NAME=$P(DATA,"^"),SSN=$P(DATA,"^",3),BIRTHDAY=$P(DATA,"^",4),ICN=$P(DATA,"^",6),CMOR=$P(DATA,"^",5)
90 . I $G(CMOR)'="" S TIEN=$$LKUP^XUAF4(CMOR) I TIEN'="" S CMOR2=$P($$NS^XUAF4(+TIEN),"^")
91 . 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)
92 . S PAST=$P(DATA,"^",9),CLAIM=$P(DATA,"^",17),CASE=$P(DATA,"^",18),NOIS=$P(CASE,"/",2),CUSER=$P(CASE,"/",3),CASE=$P(CASE,"/")
93 . S CMOR3=$P($$NS^XUAF4(CMOR),"^"),MBIRTH=$P(DATA,"^",20),POW=$P(DATA,"^",19)
94 . W:$G(CASE)'="" !,"<<THIS ICN IS ACTIVELY BEING WORKED ON - CASE #",CASE
95 . W:$G(NOIS)'="" " NOIS/REMEDY TICKET: ",NOIS ;**43 CHANGED DISPLAY TO BE NOIS/REMEDY TICKET
96 . W:$G(CASE)'="" ">>"
97 . W:$G(CUSER)'="" !,?3,"Case Worker: ",CUSER
98 . W !!,"ICN : ",$P(ICN,"V"),?30,"CMOR: ",CMOR2," (",CMOR,")"
99 . W !,"Name : ",NAME,!,"SSN : ",SSN
100 . W !,"DOB : ",BIRTHDAY
101 . W:$G(PAST)'="" ?30,"Date of Death: ",PAST
102 . W:$G(MBIRTH)'=""&(MBIRTH'="N") !,"Multiple Birth Indicator: Yes"
103 . W !,"Sex : ",SEX
104 . W:$G(CLAIM)'="" !,"Claim # : ",CLAIM
105 . W:$G(POBC)'="" !,"Place of Birth: ",POBC W:$G(POBS)'="" ", ",POBS
106 . W:$G(MNAME)'="" !,"Mother's Maiden Name: ",MNAME
107 . W:$G(POW)'="" !,"POW Status: ",POW
108 . I $D(^TMP("MPIFVQQ",$J,CNT1,"ALIAS")) D
109 . . W !!,"Alias(es): "
110 . . S XXX=0 F S XXX=$O(^TMP("MPIFVQQ",$J,CNT1,"ALIAS",XXX)) Q:XXX="" D
111 . . . W !?5,^TMP("MPIFVQQ",$J,CNT1,"ALIAS",XXX)
112 . S CNT2=""
113 . 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
114 .. S TMP=$P(TMP,MPICOMP,1) I TMP'=CMOR3 W !?10,"Treating Facility: ",$P($$NS^XUAF4($$LKUP^XUAF4(TMP)),"^")," (",TMP,")"
115 .W !!
116EXIT K DA,X,Y W !! Q
117LOOP2 ;
118 N MPIDONE,MPII,MPIJ
119 S MPII=0,MPIDONE=0
120 F S MPIQUIT=$O(MPIDC(MPIQUIT)) Q:'MPIQUIT D Q:MPIDONE
121 . I MPIDC(MPIQUIT)="" S MPIDONE=1 Q
122 . S MPII=MPII+1,MPINODE(MPII)=$G(MPIDC(MPIQUIT)) Q
123 Q
124MSH ;
125 S MPIREP=$E(HL("ECH"),2),MPICOMP=$E(HL("ECH"),1)
126 Q
127MSA ;
128 Q
129RDF ;
130 Q
131QAK ;
132 Q
133RDT ;
134 S INDEX=$G(INDEX)+1
135 D RDT^MPIFSA3(.INDEX,.HL,.MSG)
136 Q
137BLDRDF(MPIOUT,MPICNT,MPIRS,MPICS) ;
138 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
139 . I I=1 S MPIFLDV=$P(T,";",3)_MPICS_$P(T,";",5)_MPICS_$P(T,";",6)
140 . I I'=1 S MPIFLDV=MPIRS_$P(T,";",3)_MPICS_$P(T,";",5)_MPICS_$P(T,";",6)
141 .N XLEN,TOTLEN
142 . S TOTLEN=$L($G(MPIOUT(MPICNT)))+$L(MPIFLDV)
143 . I TOTLEN'>245 S MPIOUT(MPICNT)=$G(MPIOUT(MPICNT))_MPIFLDV Q
144 . I TOTLEN>245 D
145 .. S XLEN=245-$L($G(MPIOUT(MPICNT)))
146 .. S MPIOUT(MPICNT)=$G(MPIOUT(MPICNT))_$E(MPIFLDV,1,XLEN),MPICNT=MPICNT+1
147 .. S MPIOUT(MPICNT)=$E(MPIFLDV,XLEN+1,245)
148 Q
Note: See TracBrowser for help on using the repository browser.