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

MPIFVTQ.m

Go to the documentation of this file.
  1. MPIFVTQ ;SLC/ARS-BUILD DATA TO QUERY MPI RESPONSE PROCESS (ADDPAT) ; 1/12/10 9:28am
  1. ;;1.0;MASTER PATIENT INDEX VISTA;**1,9,17,21,23,28,33,35,52,54**;30 Apr 99;Build 2
  1. ;
  1. ; Integration Agreements Utilized:
  1. ; ^DPT( -9 node check - #2762
  1. ; ^DPT( "MPI" node - #2070
  1. ; EXC, START, STOP ^RGHLLOG - #2796
  1. ; NAME^VAFCPID2 - #3492
  1. ;
  1. Q ;NOT an entry point
  1. ;
  1. VTQ1(MPIIT,MPIOUT,HL,MPIQRYNM,MPISND) ;
  1. ;MPIIT=DFN in patient file.
  1. ;MPIOUT=Array you want the VTQ/RDF put into.
  1. ;HL=Array of encoding characters and Field separator.
  1. ;MPIQRYNM=Name of query to put into message.
  1. ;MPISND (OPTIONAL) = item #'s separated by ; to be used to query.
  1. ; default is DOB;SSN;LAST NAME;FIRST NAME;SUFFIX OF NAME;SEX;DOD;
  1. ; POB-CITY;POB-STATE;MIDDLE NAME
  1. ;
  1. ;If invalid DFN, Patient Merged, if ICN already assigned, Test SSN, the VTQ query is not built and -1^'error message' returned in MPIOUT(0).
  1. ;
  1. ;If DOB does not contain a 7 digit date OR if name is not present, -1^Missing Required fields will be returned in MPIOUT(0).
  1. ;
  1. ;If patient has a date of death, the VTQ query is built with MPIOUT(0) returned with 0^Patient has date of death. Programmer to decide if VTQ should be sent.
  1. ;
  1. N MPITEST,MPISSN,MPIDTH,MPINM,MPIDOB,ERR,MPITST11,MPITST13
  1. S MPIOUT(0)=""
  1. I '$D(MPISND) S MPISND="00122;00108.1;00108.2;00110;00740;00111;00108.4;00126.1;00126.2;00108.3;00114.1;00114.2;00114.3;00114.4;00114.5;00114.6;00114.8;00114.9;00116;00119;00125;00127;00100"
  1. ;validation check
  1. I '$D(HL) S MPIOUT(0)="-1^no encoding characters" Q
  1. I $G(HL("FS"))=""!($G(HL("ECH"))="") S MPIOUT(0)="-1^no encoding characters" Q
  1. I MPIIT="" S MPIOUT(0)="-1^invalid DFN" Q
  1. I $G(^DPT(MPIIT,-9))'="" S MPIOUT(0)="-1^Patient merged "_^DPT(MPIIT,-9) Q
  1. S MPIMPI=$G(^DPT(MPIIT,"MPI"))
  1. S:MPIMPI'="" MPIZICN=$P(^DPT(MPIIT,"MPI"),"^",1)
  1. I '$D(MPIFRES),$G(MPIZICN)'="" S MPIOUT(0)="-1^ICN already assigned "_MPIZICN Q
  1. S MPITEST=$G(^DPT(MPIIT,0))
  1. S MPITST11=$G(^DPT(MPIIT,.11)),MPITST13=$G(^DPT(MPIIT,.13))
  1. I MPITEST="" S MPIOUT(0)="-1^invalid DFN" Q
  1. I $P(MPITEST,"^")=""&($P(MPITEST,"^",2)="")&($P(MPITEST,"^",3)="")&($P(MPITEST,"^",9)="") D Q
  1. .K MPIARR
  1. .S MPIOUT(0)="-1^invalid DFN" ;**54 changed the error message to allow the local/missing job to skip this record"
  1. .S MPIARR(991.01)="@",MPIARR(991.02)="@",MPIARR(991.03)="@",MPIARR(991.05)="@"
  1. .; **54 MVI 896 REMOVED SETTING OF VARIABLES MPIARR(992) & MPIARR(993)
  1. .I $G(MPIZICN)'="" S ERR=$$DELALLTF^VAFCTFU(MPIZICN) ;clean up tf list
  1. .S ERR=$$UPDATE^MPIFAPI(MPIIT,"MPIARR",1,1) K MPIARR
  1. .;PATCH 33 - stub entry with local, remove local and don't send to MPI
  1. S MPISSN=$P(MPITEST,"^",9)
  1. S MPIDTH=""
  1. S:$G(^DPT(MPIIT,.35))'="" MPIDTH=$P(^DPT(MPIIT,.35),"^",1)
  1. I $G(MPIDTH)'="" S MPIOUT(0)="0^Patient has Date of Death "_MPIDTH
  1. D VTQC(MPISSN,MPIDTH,MPISND,.HL,MPIQRYNM,.MPIOUT,MPIIT)
  1. Q
  1. EXC(IEN) ;
  1. Q:'$D(^DPT(IEN))
  1. D LOCAL^MPIFQ3(IEN)
  1. D START^RGHLLOG()
  1. D EXC^RGHLLOG(209,"DFN= "_IEN_" is Missing Required Field(s)",IEN)
  1. D STOP^RGHLLOG()
  1. Q
  1. ;
  1. VTQC(MPISSN,MPIDTH,MPISND,HL,MPIQRYNM,MPIOUT,MPIIT) ;
  1. N MPIPOB,MPIPOBS,MPINM,MPI2MN,MPI1NM,QUERY,MPIDOB,RDF,MPIMOD
  1. N MPIHDTH,MPIZDOB,MPIXDOB,MPIMPI,MPIZICN,QUEDOB,MPI2NM,MPICS,MPIESC,MPIHDOB,MPIMNM,MPIMN
  1. N MPINMSFX,MPIRS,MPISCS,MPISEX,MPIZLOC,MPISTR1,MPISTR2,MPISTR3,MPICITY,MPISTPRV,XNOD
  1. N MPIZIPPL,MPICNTRY,MPICNTY,MPIRESPH,MPIMRTST,MPIETH,MPIDLT,MPIMBI
  1. I $G(MPIQRYNM)="" S MPIQRYNM="VTQ_PID_ICN_LOAD_1"
  1. S MPICS=$E(HL("ECH"),1)
  1. S MPIRS=$E(HL("ECH"),2)
  1. S MPISCS=$E(HL("ECH"),4)
  1. S MPIESC=$E(HL("ECH"),3)
  1. ;build RDF as the third segment
  1. D BLDRDF^MPIFSA2(.MPIOUT,3,MPIRS,MPICS)
  1. S QUERY="VTQ"_HL("FS")_MPIIT_HL("FS")_"T"_HL("FS")_MPIQRYNM_HL("FS")_"ICN"_HL("FS")
  1. ;
  1. I MPISND["00108" S MPINM=$P(MPITEST,"^") D NAME^VAFCPID2(MPIIT,.MPINM) ;agressive name reformatting
  1. ; ^ sending all or part of name
  1. I MPISND["00108.1" S MPI2NM=$P(MPINM,",",1) I MPI2NM'="" S QUERY=QUERY_"@00108.1"_MPICS_"EQ"_MPICS_MPI2NM
  1. ; ^ sending last name
  1. ;I MPISND["00122"&(MPISSN'="")&(MPISSN'["P") S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00122"_MPICS_"EQ"_MPICS_MPISSN
  1. ; ^ **35 SENDING PSUEDO TO KNOW THAT THE SITE HAS A VALUE FOR SSN
  1. I MPISND["00122"&(MPISSN'="") S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00122"_MPICS_"EQ"_MPICS_MPISSN
  1. ; ^ sending SSN
  1. I MPISND["00108.2" S MPI1NM=$P(MPINM,",",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 MPISND["00110" D
  1. .S MPIDOB=$P(MPITEST,"^",3)
  1. .Q:MPIDOB=""
  1. .S MPIHDOB=$$HLDATE^HLFNC(MPIDOB)
  1. .; send date of birth (convert to hl7 date format)
  1. .S MPIMOD=MPIDOB#100
  1. .I MPIQRYNM'="VTQ_PID_ICN_LOAD_1" S MPIZDOB=MPICS_"AND"_MPIRS_"@00110"_MPICS_"GN"_MPICS_MPIHDOB
  1. .I MPIQRYNM="VTQ_PID_ICN_LOAD_1" S MPIZDOB=MPICS_"AND"_MPIRS_"@00110"_MPICS_"EQ"_MPICS_MPIHDOB
  1. .S MPIXDOB=MPICS_"AND"_MPIRS_"@00110"_MPICS_"EQ"_MPICS_MPIHDOB
  1. .S QUEDOB=$S(MPIMOD>0:MPIXDOB,1:MPIZDOB)
  1. .S QUERY=QUERY_QUEDOB
  1. ; ^ sending date of birth
  1. I $D(MPIDTH),(MPISND["00740")&(MPIDTH'="") S MPIHDTH=$$HLDATE^HLFNC(MPIDTH),QUERY=QUERY_MPICS_"AND"_MPIRS_"@00740"_MPICS_"EQ"_MPICS_MPIHDTH
  1. ; ^ sending date of death
  1. I MPISND["00111" S:$G(^DPT(MPIIT,0))'="" MPISEX=$P(^DPT(MPIIT,0),"^",2) I MPISEX'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00111"_MPICS_"EQ"_MPICS_MPISEX
  1. ; ^ sending Sex
  1. I MPISND["00108.4" S MPI1NM=$P(MPINM,",",2),MPINMSFX=$P(MPI1NM," ",3) I MPINMSFX'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.4"_MPICS_"EQ"_MPICS_MPINMSFX
  1. ; ^ sending suffix name
  1. I MPISND["00126.1" S MPIPOB=$P(^DPT(MPIIT,0),"^",11) I MPIPOB'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00126.1"_MPICS_"EQ"_MPICS_MPIPOB
  1. ; send place of birth - city
  1. I MPISND["00126.2" S MPIPOBS=$P(^DPT(MPIIT,0),"^",12) I MPIPOBS'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00126.2"_MPICS_"EQ"_MPICS_$P($G(^DIC(5,+MPIPOBS,0)),"^",2)
  1. ; send place of birth - state
  1. I MPISND["00108.3" S MPIMN=$P($P(MPINM,",",2)," ",2) I MPIMN'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00108.3"_MPICS_"EQ"_MPICS_MPIMN
  1. ; send middle name
  1. ; **52 - Initiate project
  1. ; get address data
  1. D ADDR(MPITST11)
  1. I MPISND["00114.1"&(MPISTR1'="") S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.1"_MPICS_"EQ"_MPICS_MPISTR1
  1. ; ^ send Street address line 1
  1. I MPISND["00114.2"&(MPISTR2'="") S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.2"_MPICS_"EQ"_MPICS_MPISTR2
  1. ; ^ send Street Address Line 2
  1. I MPISND["00114.3"&(MPICITY'="") S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.3"_MPICS_"EQ"_MPICS_MPICITY
  1. ; ^ send City
  1. ;I MPISND["00114.4"&(MPISTPRV'="") S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.4"_MPICS_"EQ"_MPICS_MPISTPRV
  1. ; ^ send State/Province depending on US or Foreign address
  1. ;I MPISND["00114.5"&(MPIZIPPL'="") S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.5"_MPICS_"EQ"_MPICS_MPIZIPPL
  1. ; ^ send Zip code/ Postal code depending on US or Foreign address
  1. ;I MPISND["00114.6"&(MPICNTRY'="") S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.6"_MPICS_"EQ"_MPICS_MPICNTRY
  1. ; ^ send Country
  1. I MPISND["00114.8"&(MPISTR3'="") S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.8"_MPICS_"EQ"_MPICS_MPISTR3
  1. ; ^ send Address Line 3
  1. ;I MPISND["00114.9"&(MPICNTY'="") S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00114.9"_MPICS_"EQ"_MPICS_MPICNTY
  1. ; ^ send County
  1. I MPISND["00116" S MPIRESPH=$P(MPITST13,"^") I MPIRESPH'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00116"_MPICS_"EQ"_MPICS_MPIRESPH
  1. ; ^ send Residence Phone
  1. ;I MPISND["00119" S MPIMRTST=$P(MPITEST,"^",5) I MPIMRTST'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00119"_MPICS_"EQ"_MPICS_MPIMRTST
  1. ; ^ send Marital Status
  1. ;I MPISND["00125" S XNOD=$O(^DPT(MPIIT,.06,"")) I XNOD'="" S MPIETH=$P($G(^DPT(MPIIT,.06,XNOD,0)),"^") I MPIETH'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00125"_MPICS_"EQ"_MPICS_MPIETH
  1. ; ^ send Ethnicity
  1. ;I MPISND["00127" S MPIMBI=$P($G(^DPT(MPIIT,"MPIMB")),"^") I MPIMBI'="" S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00127"_MPICS_"EQ"_MPICS_MPIMBI
  1. ; ^ send Multiple Birth Indicator
  1. ;S MPIDLT=$$GETDLT(MPIIT)
  1. ;I MPISND["00100"&(MPIDLT'="") S QUERY=QUERY_MPICS_"AND"_MPIRS_"@00100"_MPICS_"EQ"_MPICS_MPIDLT
  1. ; ^ send Date Last Treated
  1. I $G(MPIOUT(0))="" S MPIOUT(0)="1^good data"
  1. S MPIOUT(2)=QUERY
  1. Q
  1. GETDLT(MPIIT) ;Get Date Last Treated
  1. N TFIEN,TFZN
  1. S TFIEN=$O(^DGCN(391.91,"APAT",MPIIT,+$$SITE^VASITE,0))
  1. I $G(TFIEN)'="" S TFZN=^DGCN(391.91,TFIEN,0)
  1. Q $P($G(TFZN),"^",3)
  1. ;
  1. ADDR(MPITST11) ;Get Address information
  1. ;
  1. S MPISTR1=$P($G(MPITST11),"^") ;Street address line 1
  1. S MPISTR2=$P($G(MPITST11),"^",2) ;Street address line 2
  1. S MPISTR3=$P($G(MPITST11),"^",3) ;Street address line 3
  1. S MPICITY=$P($G(MPITST11),"^",4) ;City
  1. ;S MPICNTRY=$P($G(MPITST11),"^",10) ;Country
  1. ;S MPICNTY=$P($G(MPITST11),"^",7) ;County
  1. ;I MPICNTRY=""!(MPICNTRY=1) D
  1. ;. ;Have USA address
  1. ;. S MPISTPRV=$P($G(MPITST11),"^",5) ;State
  1. ;. S MPIZIPPL=$P($G(MPITST11),"^",6) ;Zip code
  1. ;I MPICNTRY'="",(MPICNTRY'=1) D
  1. ;. ;Foreign Country
  1. ;. S MPISTPRV=$P($G(MPITST11),"^",8) ;Province
  1. ;. S MPIZIPPL=$P($G(MPITST11),"^",9) ;Postal code
  1. Q