RGFIPM1 ;ALB/CJM-PROCESS FACILITY INTEGRATION MESSAGE ;08/27/99
;;1.0;CLINICAL INFO RESOURCE NETWORK;**5,9**;30 Apr 99
;
RECEIVE ;
;Description: Process the Facility Integration Message
;
;Input:
; HL7 variables must be defined
;Output: none
;Variables:
; LEGACY - station # of legacy site
; PRIMARY - station # of primary site
; ICN - patient ICN from message
; CHECKSUM - ICN checksum from message
; CMOR - station # of CMOR
; CMORIEN - ien of CMOR in Institution file
; HERE - ien in Institution file of site this routine is executing on
; HERE("STATION#") - station number of this site
; FROM - station # of sending site
; DFN - ien from the patient file
; HLERR - error encountered
; LCHKSUM - local checksum
;
N CMOR,CMORIEN,LEGACY,PRIMARY,ICN,FROM,HERE,DFN,CHECKSUM,LCHKSUM
K HLERR
D
.I '$$PARSE(0,.LEGACY,.PRIMARY,.ICN,.CHECKSUM,.FROM,.HLERR) Q
.S HERE=$$SITE^VASITE(),HERE("STATION#")=$P(HERE,"^",3),HERE=+HERE
.S DFN=$$DFN^RGFIU(ICN)
.I ('DFN)!('$D(^DPT(+DFN))) D Q
..S HLERR=$$ERROR("PATIENT LOOKUP BASED ON ICN FAILED",228,ICN)
.;
.S LCHKSUM=$P($$GETICN^MPIF001(DFN),"V",2)
.I (+CHECKSUM)'=(+LCHKSUM) D Q
..;If this is a local problem notify the local site
..I (+LCHKSUM)'=(+$$CHECKDG^MPIFSPC(ICN)) D
...S HLERR=$$ERROR("LOCAL DATABASE HAS INCORRECT ICN CHECKSUM",1,ICN)
...D EXC^RGFIU(1,$P(HLERR,"^",2),DFN)
..E D
...S HLERR=$$ERROR("SENT INCORRECT ICN CHECKSUM",1,ICN)
.;
.S CMORIEN=$P($$MPINODE^RGFIU(DFN),"^",3)
.S CMOR=$$STATNUM^RGFIU(CMORIEN)
.;
.;Notify site if there is no station number for CMOR
.I 'CMOR D EXC^RGFIU(221,"ERROR ENCOUNTERED WHILE PROCESSING FACILITY INTEGRATION MESSAGE",DFN)
.;
.;If this is the legacy site it does not need to process this message
.Q:(HERE("STATION#")=LEGACY)
.;
.;If this site is the CMOR, it should only be receiving this message
.;from the legacy site
.I (CMORIEN=HERE),(FROM'=LEGACY) D Q
..S HLERR=$$ERROR("SITE INTEGRATION MSG TO CMOR NOT FROM LEGACY SITE",230,ICN)
.;
.;If this site is not the CMOR, the message must be from the CMOR
.I CMORIEN,HERE'=CMORIEN,FROM'=CMOR D Q
..S HLERR=$$ERROR("SITE INTEGRATION MSG NOT FROM CMOR, CMOR IS "_CMOR,226,ICN)
.;
.;update database
.I '$$XCHANGE^RGFIPM(DFN,LEGACY,PRIMARY) ;local exceptins are logged by $$XCHANGE if errors are encountered
.;
.;at this point the receiving application has decided that it can accept the message. An AA will be returned to the sender.
.;
.I '$D(HLERR),$G(HL("APAT"))="AL" D ACK(FROM,.HLERR)
.;
.;if this is the CMOR, notify subscribers & MPI of the site integration
.I CMORIEN=HERE,'$$SEND^RGFIBM(DFN,LEGACY,PRIMARY) ;local exceptions are logged by $$SEND if errors are encountered
;
I $D(HLERR),$G(HL("APAT"))="AL" D ACK(FROM,.HLERR)
D:$G(RGLOG) STOP^RGHLLOG(1)
Q
;
ACK(FROM,HLERR) ;
;Description: Send an acknowledment
;
;Input:
; FROM - station number of site that sent the original message
; HLERR - error to be returned in format <exception code>^<error text>
; HL7 variables - assumed defined
;
N RESULT,HLA,FS,CS,HLL,TOLINK
S TOLINK=$$GETLINK^RGFIU($$LKUP^XUAF4(FROM))
S HLL("LINKS",1)="RG FACILITY INTEGRATION CLIENT^"_TOLINK
S FS=HL("FS"),CS=$E(HL("ECH"),1)
I $D(HLERR) D
.;return NAK
.S HLA("HLA",1)="MSA"_FS_"ER"_FS_HL("MID")_FS_$P($G(HLERR),";;",2)_FS_FS_FS_CS_CS_CS_$P($G(HLERR),";;")
E D
.;return ACK
.S HLA("HLA",1)="MSA"_FS_"AA"_FS_HL("MID")
D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.RESULT)
Q
;
PARSE(SKIPMSH,LEGACY,PRIMARY,ICN,CHECKSUM,FROM,HLERR) ;
;Description: Parses the message and returns parameters.
;Input:
; SKIPMSH - (optional) if set to 1, means that the MSH segment is
; not expected to exist. This is the case when the
; routing logic is called.
; HL7 variables must be defined (assumed)
;Output:
; Function Value: 1 on success, 0 on failure
; LEGACY - station # of legacy site (pass by reference)
; PRIMARY - station # of primary site (pass by reference)
; ICN - ICN of patient (pass by reference)
; CHECKSUM - ICN checksum (pass by reference)
; FROM - station # of sendign site (pass by reference)
; HLERR - returns a message if an error is encountered (pass by reference)
;
;Variables:
; FS - field seperator
; CS - component seperator
; ERRFLAG - initially set to 1, set to 0 if message passes all checks
;
N FS,CS,ERRFLAG
S FS=HL("FS")
S CS=$E(HL("ECH"),1)
S ERRFLAG=1
S (LEGACY,PRIMARY,ICN,CHECKSUM,FROM)=""
K HLERR
;
D
.D:'$G(SKIPMSH) Q:$D(HLERR)
..X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("MSH") Q
..I $P(HLNODE,FS)'["MSH" S HLERR=$$SEGERROR("MSH") Q
..S FROM=$P($P(HLNODE,FS,4),CS)
..I 'FROM S HLERR=$$ERROR("MISSING STATION NUMBER IN MSH SEGMENT FOR SENDING SITE",11) Q
.;
.X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("EVN") Q
.I $P(HLNODE,FS)'["EVN" D Q:$D(HLERR)
..I $G(SKIPMSH) X HLNEXT
..I $P(HLNODE,FS)'["EVN" S HLERR=$$SEGERROR("EVN") Q
.I $P(HLNODE,FS,5)'=51 S HLERR=$$ERROR("EVENT REASON CODE NOT 51",9) Q
.;
.X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("PID") Q
.I $P(HLNODE,FS)'["PID" S HLERR=$$SEGERROR("PID") Q
.S ICN=$P($P(HLNODE,FS,3),"V")
.I 'ICN D Q
..S HLERR=$$ERROR("MISSING ICN IN PID SEGMENT",10)
.S CHECKSUM=$P($P(HLNODE,FS,3),"V",2)
.;
.X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("PV1",ICN) Q
.I $P(HLNODE,FS)'["PV1" S HLERR=$$SEGERROR("PV1",ICN) Q
.;
.X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("NTE",ICN) Q
.I $P(HLNODE,FS)'["NTE" S HLERR=$$SEGERROR("NTE",ICN) Q
.S LEGACY=$P($P(HLNODE,FS,4),CS)
.I 'LEGACY S HLERR=$$ERROR("MISSING LEGACY STATION # IN NTE SEGMENT",8,ICN) Q
.S PRIMARY=$P($P(HLNODE,FS,4),CS,2)
.I 'PRIMARY S HLERR=$$ERROR("MISSING PRIMARY STATION # IN NTE SEGMENT",8,ICN) Q
.S ERRFLAG=0
Q 'ERRFLAG
;
ERROR(ERRMSG,CODE,ICN) ;
;Description: formats ERRMSG in format <exception type>;<error text>
;Input:
; ERRMSG - text to incorporate into message
; CODE - Exception Type
; ICN - patient ICN
;
;
Q $G(CODE)_";;"_" From Station:"_$P($$SITE^VASITE(),"^",3)_" ICN:"_$G(ICN)_" Code:"_$G(CODE)_" Msg:"_$G(ERRMSG)
;
;
SEGERROR(SEGMENT,ICN) ;
;Description: formats error if expected segment not there
S ERRMSG="MISSING SEGMENT: "_SEGMENT
Q $$ERROR(ERRMSG,7,$G(ICN))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGFIPM1 6389 printed Oct 16, 2024@17:42:42 Page 2
RGFIPM1 ;ALB/CJM-PROCESS FACILITY INTEGRATION MESSAGE ;08/27/99
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**5,9**;30 Apr 99
+2 ;
RECEIVE ;
+1 ;Description: Process the Facility Integration Message
+2 ;
+3 ;Input:
+4 ; HL7 variables must be defined
+5 ;Output: none
+6 ;Variables:
+7 ; LEGACY - station # of legacy site
+8 ; PRIMARY - station # of primary site
+9 ; ICN - patient ICN from message
+10 ; CHECKSUM - ICN checksum from message
+11 ; CMOR - station # of CMOR
+12 ; CMORIEN - ien of CMOR in Institution file
+13 ; HERE - ien in Institution file of site this routine is executing on
+14 ; HERE("STATION#") - station number of this site
+15 ; FROM - station # of sending site
+16 ; DFN - ien from the patient file
+17 ; HLERR - error encountered
+18 ; LCHKSUM - local checksum
+19 ;
+20 NEW CMOR,CMORIEN,LEGACY,PRIMARY,ICN,FROM,HERE,DFN,CHECKSUM,LCHKSUM
+21 KILL HLERR
+22 Begin DoDot:1
+23 IF '$$PARSE(0,.LEGACY,.PRIMARY,.ICN,.CHECKSUM,.FROM,.HLERR)
QUIT
+24 SET HERE=$$SITE^VASITE()
SET HERE("STATION#")=$PIECE(HERE,"^",3)
SET HERE=+HERE
+25 SET DFN=$$DFN^RGFIU(ICN)
+26 IF ('DFN)!('$DATA(^DPT(+DFN)))
Begin DoDot:2
+27 SET HLERR=$$ERROR("PATIENT LOOKUP BASED ON ICN FAILED",228,ICN)
End DoDot:2
QUIT
+28 ;
+29 SET LCHKSUM=$PIECE($$GETICN^MPIF001(DFN),"V",2)
+30 IF (+CHECKSUM)'=(+LCHKSUM)
Begin DoDot:2
+31 ;If this is a local problem notify the local site
+32 IF (+LCHKSUM)'=(+$$CHECKDG^MPIFSPC(ICN))
Begin DoDot:3
+33 SET HLERR=$$ERROR("LOCAL DATABASE HAS INCORRECT ICN CHECKSUM",1,ICN)
+34 DO EXC^RGFIU(1,$PIECE(HLERR,"^",2),DFN)
End DoDot:3
+35 IF '$TEST
Begin DoDot:3
+36 SET HLERR=$$ERROR("SENT INCORRECT ICN CHECKSUM",1,ICN)
End DoDot:3
End DoDot:2
QUIT
+37 ;
+38 SET CMORIEN=$PIECE($$MPINODE^RGFIU(DFN),"^",3)
+39 SET CMOR=$$STATNUM^RGFIU(CMORIEN)
+40 ;
+41 ;Notify site if there is no station number for CMOR
+42 IF 'CMOR
DO EXC^RGFIU(221,"ERROR ENCOUNTERED WHILE PROCESSING FACILITY INTEGRATION MESSAGE",DFN)
+43 ;
+44 ;If this is the legacy site it does not need to process this message
+45 if (HERE("STATION#")=LEGACY)
QUIT
+46 ;
+47 ;If this site is the CMOR, it should only be receiving this message
+48 ;from the legacy site
+49 IF (CMORIEN=HERE)
IF (FROM'=LEGACY)
Begin DoDot:2
+50 SET HLERR=$$ERROR("SITE INTEGRATION MSG TO CMOR NOT FROM LEGACY SITE",230,ICN)
End DoDot:2
QUIT
+51 ;
+52 ;If this site is not the CMOR, the message must be from the CMOR
+53 IF CMORIEN
IF HERE'=CMORIEN
IF FROM'=CMOR
Begin DoDot:2
+54 SET HLERR=$$ERROR("SITE INTEGRATION MSG NOT FROM CMOR, CMOR IS "_CMOR,226,ICN)
End DoDot:2
QUIT
+55 ;
+56 ;update database
+57 ;local exceptins are logged by $$XCHANGE if errors are encountered
IF '$$XCHANGE^RGFIPM(DFN,LEGACY,PRIMARY)
+58 ;
+59 ;at this point the receiving application has decided that it can accept the message. An AA will be returned to the sender.
+60 ;
+61 IF '$DATA(HLERR)
IF $GET(HL("APAT"))="AL"
DO ACK(FROM,.HLERR)
+62 ;
+63 ;if this is the CMOR, notify subscribers & MPI of the site integration
+64 ;local exceptions are logged by $$SEND if errors are encountered
IF CMORIEN=HERE
IF '$$SEND^RGFIBM(DFN,LEGACY,PRIMARY)
End DoDot:1
+65 ;
+66 IF $DATA(HLERR)
IF $GET(HL("APAT"))="AL"
DO ACK(FROM,.HLERR)
+67 if $GET(RGLOG)
DO STOP^RGHLLOG(1)
+68 QUIT
+69 ;
ACK(FROM,HLERR) ;
+1 ;Description: Send an acknowledment
+2 ;
+3 ;Input:
+4 ; FROM - station number of site that sent the original message
+5 ; HLERR - error to be returned in format <exception code>^<error text>
+6 ; HL7 variables - assumed defined
+7 ;
+8 NEW RESULT,HLA,FS,CS,HLL,TOLINK
+9 SET TOLINK=$$GETLINK^RGFIU($$LKUP^XUAF4(FROM))
+10 SET HLL("LINKS",1)="RG FACILITY INTEGRATION CLIENT^"_TOLINK
+11 SET FS=HL("FS")
SET CS=$EXTRACT(HL("ECH"),1)
+12 IF $DATA(HLERR)
Begin DoDot:1
+13 ;return NAK
+14 SET HLA("HLA",1)="MSA"_FS_"ER"_FS_HL("MID")_FS_$PIECE($GET(HLERR),";;",2)_FS_FS_FS_CS_CS_CS_$PIECE($GET(HLERR),";;")
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 ;return ACK
+17 SET HLA("HLA",1)="MSA"_FS_"AA"_FS_HL("MID")
End DoDot:1
+18 DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.RESULT)
+19 QUIT
+20 ;
PARSE(SKIPMSH,LEGACY,PRIMARY,ICN,CHECKSUM,FROM,HLERR) ;
+1 ;Description: Parses the message and returns parameters.
+2 ;Input:
+3 ; SKIPMSH - (optional) if set to 1, means that the MSH segment is
+4 ; not expected to exist. This is the case when the
+5 ; routing logic is called.
+6 ; HL7 variables must be defined (assumed)
+7 ;Output:
+8 ; Function Value: 1 on success, 0 on failure
+9 ; LEGACY - station # of legacy site (pass by reference)
+10 ; PRIMARY - station # of primary site (pass by reference)
+11 ; ICN - ICN of patient (pass by reference)
+12 ; CHECKSUM - ICN checksum (pass by reference)
+13 ; FROM - station # of sendign site (pass by reference)
+14 ; HLERR - returns a message if an error is encountered (pass by reference)
+15 ;
+16 ;Variables:
+17 ; FS - field seperator
+18 ; CS - component seperator
+19 ; ERRFLAG - initially set to 1, set to 0 if message passes all checks
+20 ;
+21 NEW FS,CS,ERRFLAG
+22 SET FS=HL("FS")
+23 SET CS=$EXTRACT(HL("ECH"),1)
+24 SET ERRFLAG=1
+25 SET (LEGACY,PRIMARY,ICN,CHECKSUM,FROM)=""
+26 KILL HLERR
+27 ;
+28 Begin DoDot:1
+29 if '$GET(SKIPMSH)
Begin DoDot:2
+30 XECUTE HLNEXT
IF (HLQUIT'>0)
SET HLERR=$$SEGERROR("MSH")
QUIT
+31 IF $PIECE(HLNODE,FS)'["MSH"
SET HLERR=$$SEGERROR("MSH")
QUIT
+32 SET FROM=$PIECE($PIECE(HLNODE,FS,4),CS)
+33 IF 'FROM
SET HLERR=$$ERROR("MISSING STATION NUMBER IN MSH SEGMENT FOR SENDING SITE",11)
QUIT
End DoDot:2
if $DATA(HLERR)
QUIT
+34 ;
+35 XECUTE HLNEXT
IF (HLQUIT'>0)
SET HLERR=$$SEGERROR("EVN")
QUIT
+36 IF $PIECE(HLNODE,FS)'["EVN"
Begin DoDot:2
+37 IF $GET(SKIPMSH)
XECUTE HLNEXT
+38 IF $PIECE(HLNODE,FS)'["EVN"
SET HLERR=$$SEGERROR("EVN")
QUIT
End DoDot:2
if $DATA(HLERR)
QUIT
+39 IF $PIECE(HLNODE,FS,5)'=51
SET HLERR=$$ERROR("EVENT REASON CODE NOT 51",9)
QUIT
+40 ;
+41 XECUTE HLNEXT
IF (HLQUIT'>0)
SET HLERR=$$SEGERROR("PID")
QUIT
+42 IF $PIECE(HLNODE,FS)'["PID"
SET HLERR=$$SEGERROR("PID")
QUIT
+43 SET ICN=$PIECE($PIECE(HLNODE,FS,3),"V")
+44 IF 'ICN
Begin DoDot:2
+45 SET HLERR=$$ERROR("MISSING ICN IN PID SEGMENT",10)
End DoDot:2
QUIT
+46 SET CHECKSUM=$PIECE($PIECE(HLNODE,FS,3),"V",2)
+47 ;
+48 XECUTE HLNEXT
IF (HLQUIT'>0)
SET HLERR=$$SEGERROR("PV1",ICN)
QUIT
+49 IF $PIECE(HLNODE,FS)'["PV1"
SET HLERR=$$SEGERROR("PV1",ICN)
QUIT
+50 ;
+51 XECUTE HLNEXT
IF (HLQUIT'>0)
SET HLERR=$$SEGERROR("NTE",ICN)
QUIT
+52 IF $PIECE(HLNODE,FS)'["NTE"
SET HLERR=$$SEGERROR("NTE",ICN)
QUIT
+53 SET LEGACY=$PIECE($PIECE(HLNODE,FS,4),CS)
+54 IF 'LEGACY
SET HLERR=$$ERROR("MISSING LEGACY STATION # IN NTE SEGMENT",8,ICN)
QUIT
+55 SET PRIMARY=$PIECE($PIECE(HLNODE,FS,4),CS,2)
+56 IF 'PRIMARY
SET HLERR=$$ERROR("MISSING PRIMARY STATION # IN NTE SEGMENT",8,ICN)
QUIT
+57 SET ERRFLAG=0
End DoDot:1
+58 QUIT 'ERRFLAG
+59 ;
ERROR(ERRMSG,CODE,ICN) ;
+1 ;Description: formats ERRMSG in format <exception type>;<error text>
+2 ;Input:
+3 ; ERRMSG - text to incorporate into message
+4 ; CODE - Exception Type
+5 ; ICN - patient ICN
+6 ;
+7 ;
+8 QUIT $GET(CODE)_";;"_" From Station:"_$PIECE($$SITE^VASITE(),"^",3)_" ICN:"_$GET(ICN)_" Code:"_$GET(CODE)_" Msg:"_$GET(ERRMSG)
+9 ;
+10 ;
SEGERROR(SEGMENT,ICN) ;
+1 ;Description: formats error if expected segment not there
+2 SET ERRMSG="MISSING SEGMENT: "_SEGMENT
+3 QUIT $$ERROR(ERRMSG,7,$GET(ICN))
