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

MPIFA43.m

Go to the documentation of this file.
  1. MPIFA43 ;BIR/DLR-Utility for processing an ADT-A43 Un-link ID ; 5/4/20 11:01am
  1. ;;1.0;MASTER PATIENT INDEX VISTA;**22,41,46,54,75**;30 Apr 99;Build 1
  1. DBIA ; Supported IA's
  1. ;
  1. ;IA: 2796 - EXC, START, and STOP^RGHLLOG
  1. ;IA: 2988 - $$DELALLTF and $$DELETETF^VAFCTFU
  1. ;IA: 3767 - PIDP^RGADTP1
  1. ;
  1. IN ;Entry point for processing ADT-A43 - Move patient information
  1. ;Called from the MPIF ADT-A43 CLIENT protocol processing routine
  1. ;There are no inputs or outputs
  1. ;
  1. N MPIF,STATN,MPIFI,MSG,SG,MPIFARR,PDFN,INST,MFUPT,PDLT,TFIEN,ICNAUTH,MPISITE,MRG
  1. N ICN,HLCOMP,CNT,X,MPIFERR,MPIFX,MPIDFN,MPISSN,ERROR,DFN,NODE,CMOR2,PID,ARRAY
  1. S MPISSN="",MPIDFN="",ICN="",ERROR=""
  1. INIT ;Process in the ADT-A43 Move Patient Identifier msg
  1. F MPII=1:1 X HLNEXT Q:HLQUIT'>0 S MSG=HLNODE D
  1. .S MPIJ=0 F S MPIJ=$O(HLNODE(MPIJ)) Q:'MPIJ S MSG(MPIJ)=HLNODE(MPIJ)
  1. .S SG=$E(HLNODE,1,3),MPIF(MPII)=HLNODE D:SG?2A1(1A,1N) PICK
  1. .;**45 ABOVE TO REPLACE COMMENTED LINE BELOW
  1. ;F MPIFI=1:1 X HLNEXT Q:HLQUIT'>0 S (MSG,MPIF(MPIFI))=HLNODE,SG=$E(HLNODE,1,3) D:SG?2A1(1A,1N) PICK
  1. D MOVE(.ARRAY,.ERROR)
  1. ;create response message
  1. S CNT=1
  1. S HLA("HLA",1)="MSA"_HL("FS")_$S($G(ERROR)=0:"AA",1:"AE")_HL("FS")_HL("MID")_HL("FS")_$S($G(ERROR)=0:"",1:$P(ERROR,"^",2)) S CNT=CNT+1
  1. D ROUTE
  1. ;Send back the appl. ack (ACK) with the ADT-A43 transaction status
  1. D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MPIFERR,"",.HLP)
  1. Q
  1. PICK ;check routine for segment entry point
  1. I $T(@SG)]"" D @SG
  1. I $T(@SG)="" Q
  1. Q
  1. MSH ;;MSH
  1. ;process the MSH segment
  1. S (HLFS,HL("FS"))=$E(MSG,4),(HLECH,HL("ECH"))=$E(MSG,5,8)
  1. S HLCOMP=$E(HL("ECH"),1)
  1. S MPIFARR("SENDING SITE")=$P(MSG,HL("FS"),4)
  1. Q
  1. EVN ;;EVN
  1. ;process the EVN segment
  1. S STATN=+$$SITE^VASITE()_"^"_$$FMDATE^HLFNC($P(MSG,HL("FS"),3))
  1. Q
  1. PID ;;PID
  1. ;process the PID segment
  1. N COMP,REP,SUBCOMP,AUTH,IDTYP,LOC,AUTHTYP,MPIJ
  1. S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4),REP=$E(HL("ECH"),2)
  1. S MPIJ=$P(MSG,HL("FS"),2)
  1. D PIDP^RGADTP1(.MSG,.ARRAY,.HL)
  1. ;ARRAY("ICN") = NEW ICN and ARRAY("DFN") = mismatched record to be corrected
  1. Q
  1. PD1 ;processing PD1 fields for new CMOR
  1. N COMP
  1. S COMP=$E(HL("ECH"),1)
  1. S ARRAY("CMOR")=$P($P(HLNODE,HL("FS"),4),COMP,3)
  1. Q
  1. MRG ;
  1. N COMP,REP,SUBCOMP,AUTH,IDTYP,LOC,AUTHTYP,FID,ID
  1. S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4),REP=$E(HL("ECH"),2)
  1. N MPIFX,ID,AUTH
  1. S FID=$P(MSG,HL("FS"),2)
  1. F MPIFX=1:1:$L(FID,REP)+1 S ID=$P(FID,REP,MPIFX),PID=$P(ID,COMP),AUTH=$P($P(ID,COMP,4),SUBCOMP),AUTHTYP=$P($P(ID,COMP,4),SUBCOMP,2),IDTYP=$P(ID,COMP,5),LOC=$P($P(ID,COMP,6),SUBCOMP,2) D
  1. . I AUTH="USSSA" S MPISSN=PID
  1. . ;capture the old or mismatched ICN in ARRAY("ICNMISMATCH")
  1. . I AUTH="USVHA" I IDTYP="NI" S (ARRAY("ICNMISMATCH"),ICN)=PID S ARRAY("ICNMISMATCHLOC")=LOC
  1. . I AUTH="USVHA" I IDTYP="PI" S MPIDFN=PID S ARRAY("DFNLOC")=LOC
  1. Q
  1. RSP ;response process logic entry point
  1. Q
  1. ROUTE ;routing logic entry point
  1. N MPI S MPI=$$MPILINK^MPIFAPI() D
  1. .;**75 - Story - 1260465 (ckn) - Include 200M in HLL links for HAC
  1. .I $P($G(MPI),U)'=-1 S HLL("LINKS",1)="MPIF ADT-A43 CLIENT"_"^"_MPI_$S($P($$SITE^VASITE(),"^",3)=741:"^200M",1:"")
  1. .I $P($G(MPI),U)=-1 D
  1. ..N RGLOG D START^RGHLLOG(HLMTIEN,"","")
  1. ..D EXC^RGHLLOG(224,"No MPI link identified ",$G(PDFN))
  1. ..D STOP^RGHLLOG(0)
  1. Q
  1. MOVE(ARRAY,ERROR) ;
  1. ;replace ARRAY("ICNMISMATCHED") with ARRAY("ICN")
  1. N MPIARR
  1. S ERROR=0
  1. ;I ARRAY("DFNLOC")="" OLD MESSAGING SO USE ARRAY("ICNMISMATCHLOC")
  1. I $G(ARRAY("DFNLOC"))="" S ARRAY("DFNLOC")=ARRAY("ICNMISMATCHLOC")
  1. I $G(ARRAY("CMOR"))="" S ARRAY("CMOR")=ARRAY("DFNLOC")
  1. ;if assigning authority'= site station# then Quit because this is not the mismatched site so MFN-M05 sent as a result of site removal on MPI will remove it from all sites TF list
  1. ;**75 - Story 1260465 (ckn) - specific to HAC Site (741)
  1. I ARRAY("DFNLOC")="741MM" S ARRAY("DFNLOC")=741
  1. I ARRAY("DFNLOC")'=$P($$SITE^VASITE,"^",3) D Q
  1. .;if assigning authority '= site station# then remove assigning authority from TF list for the given ICN
  1. .N MPISITE S MPISITE=$$IEN^XUAF4(ARRAY("DFNLOC"))
  1. . I ARRAY("DFNLOC")'>0 S ERROR="-1^Unable to remove station#"_ARRAY("DFNLOC")_" from TF list" Q
  1. .;**54 - MVI_1009 (ckn) - Do not call DELETETF
  1. .; I +ARRAY("DFNLOC")>0 S ERROR=$$DELETETF^VAFCTFU(+ARRAY("ICNMISMATCH"),MPISITE)
  1. ;delete all TF's for this mismatched record
  1. S ERROR=$$DELALLTF^VAFCTFU(ARRAY("ICNMISMATCH"))
  1. ;if ARRAY("DFN")="" assume this is old message format and use ARRAY("ICNMISMATCHED") to get the DFN that was mismatched
  1. I $G(ARRAY("DFN"))="" D Q
  1. . S ARRAY("DFN")=$$GETDFN^MPIF001(ARRAY("ICNMISMATCH")) I +ARRAY("DFN")'>0 S ERROR="-1^Unable to break ICN "_ARRAY("ICNMISMATCH")_" because that ICN is unknown"
  1. . Q:+$G(ERROR)=-1
  1. . S MPIARR(991.01)="@",MPIARR(991.02)="@",MPIARR(991.03)="@",MPIARR(991.05)="@",MPIARR(992)=$P(ARRAY("ICNMISMATCH"),"V"),MPIARR(993)=$P($$SITE^VASITE,"^")
  1. . S ERROR=$$UPDATE^MPIFAPI(ARRAY("DFN"),"MPIARR",1)
  1. ;if new messaging
  1. I ARRAY("ICN")'="""" D
  1. . ;delete the entry first to prevent the ICN from going into history
  1. . S MPIARR(991.01)="@",MPIARR(991.02)="@",MPIARR(991.03)="@",MPIARR(991.05)="@",MPIARR(992)=$P(ARRAY("ICNMISMATCH"),"V"),MPIARR(993)=$P($$SITE^VASITE,"^")
  1. . S ERROR=$$UPDATE^MPIFAPI(ARRAY("DFN"),"MPIARR",1)
  1. . ;update the record with the new ICN
  1. . S MPIARR(991.01)=$P(ARRAY("ICN"),"V"),MPIARR(991.02)=$P(ARRAY("ICN"),"V",2),MPIARR(991.03)=$$IEN^XUAF4(ARRAY("CMOR")),MPIARR(991.05)="@",MPIARR(992)=$P(ARRAY("ICNMISMATCH"),"V"),MPIARR(993)=$P($$SITE^VASITE,"^")
  1. ;move the mismatched record from ARRAY("ICNMISMATCH") to ARRAY("ICN")
  1. S ERROR=$$UPDATE^MPIFAPI(ARRAY("DFN"),"MPIARR",1)
  1. ;add LOCAL site to TF, if CMOR is different it will be auto added
  1. D FILE^VAFCTFU(ARRAY("DFN"),+$$SITE^VASITE,1)
  1. Q