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

MPIFA37.m

Go to the documentation of this file. 
  1. MPIFA37 ;BIR/DLR-Utility for processing an ADT-A37 Un-link ID ;DEC 11, 2001
  1.  ;;1.0; MASTER PATIENT INDEX VISTA ;**22**;30 Apr 99
  1. DBIA ; Supported IA's
  1.  ;
  1.  ;IA: 2796  - EXC, START, and STOP^RGHLLOG
  1.  ;IA: 2988  - $$DELALLTF and $$DELETETF^VAFCTFU
  1.  ;
  1. IN ;Entry point for processing ADT-A37 - unlink patient information
  1.  ;Called from the MPIF ADT-A37 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
  1.  N ICN,HLCOMP,CNT,X,MPIFERR,MPIFX,MPIDFN,MPISSN,ERROR,DFN,NODE,CMOR2,PID
  1.  S MPISSN="",MPIDFN="",ICN="",ERROR=""
  1. INIT ;Process in the Treating Facility MFN msg
  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.  ;replace/remove/unlink the mismatched ICN in PID(2) as well as the old CMOR from the patients record
  1.  S CMOR2="",DFN=$$GETDFN^MPIF001(+PID(2)) I +DFN>0 S NODE=$$MPINODE^MPIFAPI(DFN) I NODE'="" S CMOR2=$P(NODE,"^",3)
  1.  ;if assigning authority = site station# then remove the ICN from site 
  1.  I $P(PID(2),"^",2)=$P($$SITE^VASITE,"^",3) D REPLACE("@","",PID(2),CMOR2,.ERROR)
  1.  ;if assigning authority '= site station# then remove assigning authority from TF list for the given ICN
  1.  I $P(PID(2),"^",2)'=$P($$SITE^VASITE,"^",3) S MPISITE=$$IEN^XUAF4($P(PID(2),"^",2)) D
  1.  . I $P(PID(2),"^",2)'>0 S ERROR="-1^Unable to remove station#"_$P(PID(2),"^",2)_" from TF list" Q
  1.  . I +$P(PID(2),"^",2)>0 S ERROR=$$DELETETF^VAFCTFU(ICN,MPISITE)
  1.  S ERROR=$S(+ERROR=0:"",1:$P(ERROR,"^",2))
  1.  ;create response message
  1.  S CNT=1
  1.  S HLA("HLA",1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS")_$G(ERROR) S CNT=CNT+1
  1.  ;Send back the appl. ack (ACK) with the ADT-A37 transaction status
  1.  D ROUTE
  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 ARRAY,MPIJ
  1.  D PIDP^RGADTP1(.MSG,.ARRAY,.HL)
  1.  S MPIJ=$P(MSG,HL("FS"),2)
  1.  S MPISSN=$G(ARRAY("SSN")),MPIDFN=$G(ARRAY("DFN")),ICN=$G(ARRAY("ICN"))
  1.  S PID(MPIJ)=+ICN_"^"_$G(ARRAY("MPISSITE"))
  1.  Q
  1. RESP ;response process logic entry point
  1.  Q
  1. ROUTE ;routing logic entry point
  1.  N MPI S MPI=$$MPILINK^MPIFAPI() D
  1.  .I $P($G(MPI),U)'=-1 S HLL("LINKS",1)="MPIF ADT-A37 CLIENT"_"^"_MPI
  1.  .I $P($G(MPI),U)=-1 D
  1.  .. N RGLOG D START^RGHLLOG(HLMTIEN,"","")
  1.  .. D EXC^RGHLLOG(224,"Unable to send ADT-A37 for DFN"_$G(DFN)_" : No MPI link identified",$G(PDFN))
  1.  .. D STOP^RGHLLOG(0)
  1.  Q
  1. REPLACE(ICN1,CMOR1,ICN2,CMOR2,ERROR) ;
  1.  ;replace icn1 with icn2 and cmor1 with cmor2
  1.  N MPIARR
  1.  S ERROR=0
  1.  I $G(ICN2)'="" S DFN=$$GETDFN^MPIF001(+ICN2) I +DFN'>0 S ERROR="-1^Unable to break ICN "_+ICN2_" 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(ICN2,"V"),MPIARR(993)=CMOR2
  1.  S ERROR=$$DELALLTF^VAFCTFU(+ICN2)
  1.  S ERROR=$$UPDATE^MPIFAPI(DFN,"MPIARR",1)
  1.  Q