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

RGFIPM1.m

Go to the documentation of this file. 
  1. RGFIPM1 ;ALB/CJM-PROCESS FACILITY INTEGRATION MESSAGE ;08/27/99
  1.  ;;1.0;CLINICAL INFO RESOURCE NETWORK;**5,9**;30 Apr 99
  1.  ;
  1. RECEIVE ;
  1.  ;Description: Process the Facility Integration Message
  1.  ;
  1.  ;Input:
  1.  ;  HL7 variables must be defined
  1.  ;Output: none
  1.  ;Variables:
  1.  ;  LEGACY - station # of legacy site
  1.  ;  PRIMARY - station # of primary site
  1.  ;  ICN - patient ICN from message
  1.  ;  CHECKSUM - ICN checksum from message
  1.  ;  CMOR - station # of CMOR
  1.  ;  CMORIEN - ien of CMOR in Institution file
  1.  ;  HERE - ien in Institution file of site this routine is executing on
  1.  ;  HERE("STATION#") - station number of this site
  1.  ;  FROM - station # of sending site
  1.  ;  DFN - ien from the patient file
  1.  ;  HLERR - error encountered
  1.  ;  LCHKSUM - local checksum
  1.  ;
  1.  N CMOR,CMORIEN,LEGACY,PRIMARY,ICN,FROM,HERE,DFN,CHECKSUM,LCHKSUM
  1.  K HLERR
  1.  D
  1.  .I '$$PARSE(0,.LEGACY,.PRIMARY,.ICN,.CHECKSUM,.FROM,.HLERR) Q
  1.  .S HERE=$$SITE^VASITE(),HERE("STATION#")=$P(HERE,"^",3),HERE=+HERE
  1.  .S DFN=$$DFN^RGFIU(ICN)
  1.  .I ('DFN)!('$D(^DPT(+DFN))) D  Q
  1.  ..S HLERR=$$ERROR("PATIENT LOOKUP BASED ON ICN FAILED",228,ICN)
  1.  .;
  1.  .S LCHKSUM=$P($$GETICN^MPIF001(DFN),"V",2)
  1.  .I (+CHECKSUM)'=(+LCHKSUM) D  Q
  1.  ..;If this is a local problem notify the local site
  1.  ..I (+LCHKSUM)'=(+$$CHECKDG^MPIFSPC(ICN)) D
  1.  ...S HLERR=$$ERROR("LOCAL DATABASE HAS INCORRECT ICN CHECKSUM",1,ICN)
  1.  ...D EXC^RGFIU(1,$P(HLERR,"^",2),DFN)
  1.  ..E  D
  1.  ...S HLERR=$$ERROR("SENT INCORRECT ICN CHECKSUM",1,ICN)
  1.  .;
  1.  .S CMORIEN=$P($$MPINODE^RGFIU(DFN),"^",3)
  1.  .S CMOR=$$STATNUM^RGFIU(CMORIEN)
  1.  .;
  1.  .;Notify site if there is no station number for CMOR
  1.  .I 'CMOR D EXC^RGFIU(221,"ERROR ENCOUNTERED WHILE PROCESSING FACILITY INTEGRATION MESSAGE",DFN)
  1.  .;
  1.  .;If this is the legacy site it does not need to process this message
  1.  .Q:(HERE("STATION#")=LEGACY)
  1.  .;
  1.  .;If this site is the CMOR, it should only be receiving this message
  1.  .;from the legacy site
  1.  .I (CMORIEN=HERE),(FROM'=LEGACY) D  Q
  1.  ..S HLERR=$$ERROR("SITE INTEGRATION MSG TO CMOR NOT FROM LEGACY SITE",230,ICN)
  1.  .;
  1.  .;If this site is not the CMOR, the message must be from the CMOR
  1.  .I CMORIEN,HERE'=CMORIEN,FROM'=CMOR D  Q
  1.  ..S HLERR=$$ERROR("SITE INTEGRATION MSG NOT FROM CMOR, CMOR IS "_CMOR,226,ICN)
  1.  .;
  1.  .;update database
  1.  .I '$$XCHANGE^RGFIPM(DFN,LEGACY,PRIMARY) ;local exceptins are logged by $$XCHANGE if errors are encountered
  1.  .;
  1.  .;at this point the receiving application has decided that it can accept the message.  An AA will be returned to the sender.
  1.  .;
  1.  .I '$D(HLERR),$G(HL("APAT"))="AL" D ACK(FROM,.HLERR)
  1.  .;
  1.  .;if this is the CMOR, notify subscribers & MPI of the site integration
  1.  .I CMORIEN=HERE,'$$SEND^RGFIBM(DFN,LEGACY,PRIMARY) ;local exceptions are logged by $$SEND if errors are encountered
  1.  ;
  1.  I $D(HLERR),$G(HL("APAT"))="AL" D ACK(FROM,.HLERR)
  1.  D:$G(RGLOG) STOP^RGHLLOG(1)
  1.  Q
  1.  ;
  1. ACK(FROM,HLERR) ;
  1.  ;Description:  Send an acknowledment
  1.  ;
  1.  ;Input:
  1.  ;  FROM - station number of site that sent the original message
  1.  ;  HLERR - error to be returned in format <exception code>^<error text>
  1.  ;  HL7 variables - assumed defined
  1.  ;
  1.  N RESULT,HLA,FS,CS,HLL,TOLINK
  1.  S TOLINK=$$GETLINK^RGFIU($$LKUP^XUAF4(FROM))
  1.  S HLL("LINKS",1)="RG FACILITY INTEGRATION CLIENT^"_TOLINK
  1.  S FS=HL("FS"),CS=$E(HL("ECH"),1)
  1.  I $D(HLERR) D
  1.  .;return NAK
  1.  .S HLA("HLA",1)="MSA"_FS_"ER"_FS_HL("MID")_FS_$P($G(HLERR),";;",2)_FS_FS_FS_CS_CS_CS_$P($G(HLERR),";;")
  1.  E  D
  1.  .;return ACK
  1.  .S HLA("HLA",1)="MSA"_FS_"AA"_FS_HL("MID")
  1.  D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.RESULT)
  1.  Q
  1.  ;
  1. PARSE(SKIPMSH,LEGACY,PRIMARY,ICN,CHECKSUM,FROM,HLERR) ;
  1.  ;Description:  Parses the message and returns parameters.
  1.  ;Input:
  1.  ;   SKIPMSH - (optional) if set to 1, means that the MSH segment is
  1.  ;              not expected to exist. This is the case when the
  1.  ;              routing logic is called.
  1.  ;   HL7 variables must be defined (assumed)
  1.  ;Output:
  1.  ;  Function Value:  1 on success, 0 on failure
  1.  ;  LEGACY - station # of legacy site (pass by reference)
  1.  ;  PRIMARY - station # of primary site (pass by reference)
  1.  ;  ICN - ICN of patient (pass by reference)
  1.  ;  CHECKSUM - ICN checksum (pass by reference)
  1.  ;  FROM - station # of sendign site (pass by reference)
  1.  ;  HLERR - returns a message if an error is encountered (pass by reference) 
  1.  ;
  1.  ;Variables:
  1.  ;  FS - field seperator
  1.  ;  CS - component seperator
  1.  ;  ERRFLAG - initially set to 1, set to 0 if message passes all checks
  1.  ;
  1.  N FS,CS,ERRFLAG
  1.  S FS=HL("FS")
  1.  S CS=$E(HL("ECH"),1)
  1.  S ERRFLAG=1
  1.  S (LEGACY,PRIMARY,ICN,CHECKSUM,FROM)=""
  1.  K HLERR
  1.  ;
  1.  D
  1.  .D:'$G(SKIPMSH)  Q:$D(HLERR)
  1.  ..X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("MSH") Q
  1.  ..I $P(HLNODE,FS)'["MSH" S HLERR=$$SEGERROR("MSH") Q
  1.  ..S FROM=$P($P(HLNODE,FS,4),CS)
  1.  ..I 'FROM S HLERR=$$ERROR("MISSING STATION NUMBER IN MSH SEGMENT FOR SENDING SITE",11) Q
  1.  .;
  1.  .X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("EVN") Q
  1.  .I $P(HLNODE,FS)'["EVN" D  Q:$D(HLERR)
  1.  ..I $G(SKIPMSH) X HLNEXT
  1.  ..I $P(HLNODE,FS)'["EVN" S HLERR=$$SEGERROR("EVN") Q
  1.  .I $P(HLNODE,FS,5)'=51 S HLERR=$$ERROR("EVENT REASON CODE NOT 51",9) Q
  1.  .;
  1.  .X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("PID") Q
  1.  .I $P(HLNODE,FS)'["PID" S HLERR=$$SEGERROR("PID") Q
  1.  .S ICN=$P($P(HLNODE,FS,3),"V")
  1.  .I 'ICN D  Q
  1.  ..S HLERR=$$ERROR("MISSING ICN IN PID SEGMENT",10)
  1.  .S CHECKSUM=$P($P(HLNODE,FS,3),"V",2)
  1.  .;
  1.  .X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("PV1",ICN) Q
  1.  .I $P(HLNODE,FS)'["PV1" S HLERR=$$SEGERROR("PV1",ICN) Q
  1.  .;
  1.  .X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("NTE",ICN) Q
  1.  .I $P(HLNODE,FS)'["NTE" S HLERR=$$SEGERROR("NTE",ICN) Q
  1.  .S LEGACY=$P($P(HLNODE,FS,4),CS)
  1.  .I 'LEGACY S HLERR=$$ERROR("MISSING LEGACY STATION # IN NTE SEGMENT",8,ICN) Q
  1.  .S PRIMARY=$P($P(HLNODE,FS,4),CS,2)
  1.  .I 'PRIMARY S HLERR=$$ERROR("MISSING PRIMARY STATION # IN NTE SEGMENT",8,ICN) Q
  1.  .S ERRFLAG=0
  1.  Q 'ERRFLAG
  1.  ;
  1. ERROR(ERRMSG,CODE,ICN) ;
  1.  ;Description:  formats ERRMSG in format <exception type>;<error text>
  1.  ;Input:
  1.  ;  ERRMSG - text to incorporate into message
  1.  ;  CODE - Exception Type
  1.  ;  ICN - patient ICN
  1.  ;  
  1.  ;
  1.  Q $G(CODE)_";;"_" From Station:"_$P($$SITE^VASITE(),"^",3)_" ICN:"_$G(ICN)_" Code:"_$G(CODE)_" Msg:"_$G(ERRMSG)
  1.  ;
  1.  ;
  1. SEGERROR(SEGMENT,ICN) ;
  1.  ;Description:  formats error if expected segment not there
  1.  S ERRMSG="MISSING SEGMENT: "_SEGMENT
  1.  Q $$ERROR(ERRMSG,7,$G(ICN))