INHUSEN ; DGH ; 05 Nov 1999 12:57 ; Enhanced processing functions and utilities
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;CHCS TOOLS_460; GEN 5; 21-MAY-1997
;COPYRIGHT 1994 SAIC
;
IN(ING,INDEST,INDSTR,INUSEQ,INSEND,INERR,INXDST,INMSG,INLHSCH,INMSASTA,INNOACK,INSTD) ;Process incoming
;--1) Verify all needed data is present
;--2) Store xmission (if verified but not if it is for housekeeping)
;--3) Determines if seq. # protocol is in effect, and processes
;--4) Create receipt ack as specified in MSH.
;INPUT:
;--ING = (REQ) Variable array/global containing lines from msg.
;--INDEST = Array of valid destinations in format
; INDEST(type) = .01 field of Tran Type. This is not
; required if processing incoming ACKS, but will generate
; an error if processing incoming msg with no destination.
;--INDSTR = (REQ) Receiver dest. pointer -- $P(^INTHPC(INBPN,0),U,7)
;--INUSEQ = (OPT) Use seq. # protocol? 0=no (default) 1=yes
;--INSEND = (OPT) Variable which will contain the UIF entry(ies) of
;---msg which needs to be sent by tranceiver back to other system.
;---This may be an accept ack, or it may be a msg which must be
;---resent under sequence number protocol. (Pass By Reference)
;--INERR = (OPT) Variable to return error msg. (PBR)
;--INXDST = (OPT) EXecutable code to identify the destination for
;---msgs which won't be uniquely identified by INTYP_INEVN.
;---The executable must return the ien in the variable INDSTP.
;--INMSG = (OPT) Variable to return UIF of inbound msg (PBR)
;--INLHSCH = (OPT) Set to 1 if the incoming msg should not
; be placed on the output controller queue, ^INLHSCH.
; If not specified, this routine will determine the
; conditions under which a msg is queued.
;--INBPN = background process internal number. (Will be set in recvr)
;--INMSASTA = (OPT) Variable to return MSA-1 ack status (PBR)
;--INNOACK = (OPT) =1 to uppress commit ack. Used for transmitters,
; which should not create a commit ack to a commit ack.
;--INSTD = (OPT) Namespace/interface standard. Values such as
; NC (NCPDP) or X1 (X12) will branch to appropriate logic.
;RETURN:
;0 = success, 1 = non-fatal error, 2 = fatal error
N ORIGID,ORIGID2,MESSID,INVL,CND,SEQ,STAT,EXPCT,INDST,INDSTP,INMSH,INTYP,INEVN,LOOP,Z,ACKMSG,MSG
;Note: INDST and INDSTP are variables for the Dest. file for the
;incoming msg. This may differ from the destination of the
;background process.
;--Branch to support MEDE America implementation of NCPDP
I $G(INSTD)="PDTS" S ERR=$$INNC^INHUSEN5(ING,.INUSEQ,.INXDST,.INERR) Q ERR
;--Identify interface standard
S INSTD=$$GETSTD(ING)
;---X12 branch
I $G(INSTD)="X12" S ERR=$$X12IN^INHUSEN6(ING,.INDEST,INDSTR,.INSEND,.INERR,.INXDST,.INMSG,$G(INLHSCH),.INMSASTA,$G(INNOACK)) Q ERR
;INUSEQ and INSTD not carred forward from IN
;---
S (EXPCT,INSEND)="" S:'$D(INUSEQ) INUSEQ=0
;First verify MSH, get msg type and event type. If invalid, quit
S INVL=$$VERIF(ING,.INMSH,.INTYP,.INEVN,.INERR) I INVL Q 2
;Determine accept acknowledge conditions
S CND=$P(INMSH,INDELIM,15)
S (MESSID,ORIGID)=$P(INMSH,INDELIM,10) I MESSID="" S MSG(1)="Message does not have a message ID",MSG(2)=$E(INMSH,1,250) D ERRADD^INHUSEN3(.INERR,.MSG) Q 2
I INTYP="" S INVL=2,MSG(1)="Unable to determine message type",MSG(2)=$E(INMSH,1,250) D ERRADD^INHUSEN3(.INERR,.MSG) G ACK
;If ack, get status (and other data as needed based on MSA).
;If application ack, will store and determine if commit ack is needed.
I INTYP["ACK" D I $E($G(INMSASTA))="A"!INVL G ACK
. S INVL=$$ACKIN^INHUSEN2(ING,.INMSASTA,.EXPCT,.INDST,.INDSTP,.ACKMSG,.INERR) Q:INVL
. ;destination only needed for App. ack.
. Q:$E($G(INMSASTA))="C"
. I '$G(INDSTP) S MSG(1)="Ack "_MESSID_" has no destination",MSG(2)=$E(INMSH,1,250),INVL=2 D ERRADD^INHUSEN3(.INERR,.MSG) Q
. S STAT=0 D STORE
;--If incoming is a msg not an ack, must determine tran. type.
I INTYP'["ACK" D G:INVL ACK
.;If tranceiver passed INXDST, execute it. Otherwise do DEST.
.S Z=$S($L($G(INXDST)):INXDST,1:"D DEST") X Z
.I '$D(INDSTP) S INVL=2,MSG(1)="Message "_MESSID_" has no destination",MSG(2)=$E(INMSH,1,250) D ERRADD^INHUSEN3(.INERR,.MSG) Q
.;pointer needed for most functions, NAME needed for NEW^INHD.
.S:'$D(INDST) INDST=$P(^INRHD(INDSTP,0),U)
;
;--Handle sequence number protocol if applicable. Will not store
;--msg if link is out of synch or if msg is for re-synch only.
I INUSEQ D G:INVL ACK
.;If commit ack (application ack won't get this far in routine)
.I INTYP["ACK" S INVL=$$ACKINSEQ^INHUSEQ(INMSASTA,INDSTR,EXPCT,.INSEND,.INERR) Q
.;If msg, verify sequence number
.S SEQ=$P(INMSH,INDELIM,13)
.S INVL=$$SEQIN^INHUSEQ(INDSTR,.SEQ,.STAT,.INERR,.EXPCT)
.;If invalid, must return ack no matter what CND
.S:INVL CND="ER"
;
;Store msg
D STORE
;If inbound is an application ack, see if commit ack needed
I INTYP["ACK",$E(INMSASTA)["A" G ACK
;Update parent for commit acks
I INTYP["ACK",INMSG>0 D CACKLOG^INHUSEN2(INMSG,ACKMSG,INMSASTA,.INERR)
;Under sequence number protocol, update LAST RECEIVED, but only after
;msg is successfully filed
I INUSEQ N LTRY S LOOP=0 F LTRY=1:1:5 D Q:LOOP
.L +^INRHD(INDSTR,3):3
.I $T S:'$D(^INRHB("RUN",INBPN)) LOOP=1 Q
.S $P(^INRHD(INDSTR,3),U)=SEQ,LOOP=1 L -^INRHD(INDSTR,3)
.I '$T D ERRADD^INHUSEN3(.INERR,"Lock failed on ^INRHD("_INDSTR_" for message "_MESSID) Q 2
;Flow through to tag ACK. Routine may also jump to ACK from above.
ACK ;Process commit ack and quit back to transceiver routine.
;CND originally set from MSH.
D
.;INNOACK parameter over-rides all others.
.I $G(INNOACK) S CND="NE" Q
.;Interface Destination File may have over-ride value.
.S:$L($P(^INRHD(INDSTR,0),U,11)) CND=$P(^INRHD(INDSTR,0),U,11)
;Stop Transaction Type Audit
D:$D(XUAUDIT) TTSTP^XUSAUD("",$G(INMSG))
N STAT,CERR D
. Q:CND="NE"
. ;If CND has value, msg is in enhanced HL7 mode
. I $L(CND) D Q
.. I 'INVL,"SU,AL"[CND S CERR=$$CACK^INHUSEN2(INDSTR,"CA",ORIGID,.INERR,EXPCT) Q
.. I INVL,"AL,ER"[CND S CERR=$$CACK^INHUSEN2(INDSTR,"CR",ORIGID,.INERR,EXPCT) Q
. ;CND will be null if msg is in original mode.
. ;If msg can't be filed, let CACK function create reject ack.
. ;(Transceiver routine will have to send the commit type ack)
. ;If msg was filed, do nothing. Application will ack.
. I INVL>1,'$L($P($G(INMSH),U,16)) S CERR=$$CACK^INHUSEN2(INDSTR,"AR",ORIGID,.INERR,EXPCT)
Q $S($G(CERR)>INVL:CERR,1:INVL)
;
STORE ;Store incoming xmission in the Universal Interface file
;IHS needs DT
D SETDT^UTDT
D STORE^INHUSEN4
Q
;
VERIF(INGBL,INMSH,INTYP,INEVN,INERR) ;Determine HL7 message type and event
Q $$VERIF^INHUSEN4(INGBL,.INMSH,.INTYP,.INEVN,.INERR)
;
DEST ;Find destination for incoming message (not incoming ack?).
D DEST^INHUSEN4
Q
;
GETSTD(INGBL) ;Identify the standard of the incoming message.
;This function looks at the first part of the first segment of
;the incoming message to distinguish between X12 and HL7 messages.
;INPUT
; INGBL passed from receiver
;RETURN
; Interface Standard such as X12 or HL7
; -1 if standard is unknown or first segment is unrecognizable.
N LINE,LCT
I +INGBL S LCT=0 D GETLINE^INHOU(INGBL,.LCT,.LINE)
I 'INGBL S LINE=$G(@INGBL@(1))
I $E(LINE,1,3)="MSH" Q "HL7"
I $E(LINE,1,3)="ISA" Q "X12"
;If none of the above, error
S MSG(1)="Message from receiver "_$P(^INTHPC(INBPN,0),U)_" does not have a known header segment",MSG(2)=$E(LINE,1,250) D ERRADD^INHUSEN3(.INERR,.MSG)
Q -1
;
INHUSEN ; DGH ; 05 Nov 1999 12:57 ; Enhanced processing functions and utilities
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;CHCS TOOLS_460; GEN 5; 21-MAY-1997
+4 ;COPYRIGHT 1994 SAIC
+5 ;
IN(ING,INDEST,INDSTR,INUSEQ,INSEND,INERR,INXDST,INMSG,INLHSCH,INMSASTA,INNOACK,INSTD) ;Process incoming
+1 ;--1) Verify all needed data is present
+2 ;--2) Store xmission (if verified but not if it is for housekeeping)
+3 ;--3) Determines if seq. # protocol is in effect, and processes
+4 ;--4) Create receipt ack as specified in MSH.
+5 ;INPUT:
+6 ;--ING = (REQ) Variable array/global containing lines from msg.
+7 ;--INDEST = Array of valid destinations in format
+8 ; INDEST(type) = .01 field of Tran Type. This is not
+9 ; required if processing incoming ACKS, but will generate
+10 ; an error if processing incoming msg with no destination.
+11 ;--INDSTR = (REQ) Receiver dest. pointer -- $P(^INTHPC(INBPN,0),U,7)
+12 ;--INUSEQ = (OPT) Use seq. # protocol? 0=no (default) 1=yes
+13 ;--INSEND = (OPT) Variable which will contain the UIF entry(ies) of
+14 ;---msg which needs to be sent by tranceiver back to other system.
+15 ;---This may be an accept ack, or it may be a msg which must be
+16 ;---resent under sequence number protocol. (Pass By Reference)
+17 ;--INERR = (OPT) Variable to return error msg. (PBR)
+18 ;--INXDST = (OPT) EXecutable code to identify the destination for
+19 ;---msgs which won't be uniquely identified by INTYP_INEVN.
+20 ;---The executable must return the ien in the variable INDSTP.
+21 ;--INMSG = (OPT) Variable to return UIF of inbound msg (PBR)
+22 ;--INLHSCH = (OPT) Set to 1 if the incoming msg should not
+23 ; be placed on the output controller queue, ^INLHSCH.
+24 ; If not specified, this routine will determine the
+25 ; conditions under which a msg is queued.
+26 ;--INBPN = background process internal number. (Will be set in recvr)
+27 ;--INMSASTA = (OPT) Variable to return MSA-1 ack status (PBR)
+28 ;--INNOACK = (OPT) =1 to uppress commit ack. Used for transmitters,
+29 ; which should not create a commit ack to a commit ack.
+30 ;--INSTD = (OPT) Namespace/interface standard. Values such as
+31 ; NC (NCPDP) or X1 (X12) will branch to appropriate logic.
+32 ;RETURN:
+33 ;0 = success, 1 = non-fatal error, 2 = fatal error
+34 NEW ORIGID,ORIGID2,MESSID,INVL,CND,SEQ,STAT,EXPCT,INDST,INDSTP,INMSH,INTYP,INEVN,LOOP,Z,ACKMSG,MSG
+35 ;Note: INDST and INDSTP are variables for the Dest. file for the
+36 ;incoming msg. This may differ from the destination of the
+37 ;background process.
+38 ;--Branch to support MEDE America implementation of NCPDP
+39 IF $GET(INSTD)="PDTS"
SET ERR=$$INNC^INHUSEN5(ING,.INUSEQ,.INXDST,.INERR)
QUIT ERR
+40 ;--Identify interface standard
+41 SET INSTD=$$GETSTD(ING)
+42 ;---X12 branch
+43 IF $GET(INSTD)="X12"
SET ERR=$$X12IN^INHUSEN6(ING,.INDEST,INDSTR,.INSEND,.INERR,.INXDST,.INMSG,$GET(INLHSCH),.INMSASTA,$GET(INNOACK))
QUIT ERR
+44 ;INUSEQ and INSTD not carred forward from IN
+45 ;---
+46 SET (EXPCT,INSEND)=""
IF '$DATA(INUSEQ)
SET INUSEQ=0
+47 ;First verify MSH, get msg type and event type. If invalid, quit
+48 SET INVL=$$VERIF(ING,.INMSH,.INTYP,.INEVN,.INERR)
IF INVL
QUIT 2
+49 ;Determine accept acknowledge conditions
+50 SET CND=$PIECE(INMSH,INDELIM,15)
+51 SET (MESSID,ORIGID)=$PIECE(INMSH,INDELIM,10)
IF MESSID=""
SET MSG(1)="Message does not have a message ID"
SET MSG(2)=$EXTRACT(INMSH,1,250)
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT 2
+52 IF INTYP=""
SET INVL=2
SET MSG(1)="Unable to determine message type"
SET MSG(2)=$EXTRACT(INMSH,1,250)
DO ERRADD^INHUSEN3(.INERR,.MSG)
GOTO ACK
+53 ;If ack, get status (and other data as needed based on MSA).
+54 ;If application ack, will store and determine if commit ack is needed.
+55 IF INTYP["ACK"
Begin DoDot:1
+56 SET INVL=$$ACKIN^INHUSEN2(ING,.INMSASTA,.EXPCT,.INDST,.INDSTP,.ACKMSG,.INERR)
IF INVL
QUIT
+57 ;destination only needed for App. ack.
+58 IF $EXTRACT($GET(INMSASTA))="C"
QUIT
+59 IF '$GET(INDSTP)
SET MSG(1)="Ack "_MESSID_" has no destination"
SET MSG(2)=$EXTRACT(INMSH,1,250)
SET INVL=2
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT
+60 SET STAT=0
DO STORE
End DoDot:1
IF $EXTRACT($GET(INMSASTA))="A"!INVL
GOTO ACK
+61 ;--If incoming is a msg not an ack, must determine tran. type.
+62 IF INTYP'["ACK"
Begin DoDot:1
+63 ;If tranceiver passed INXDST, execute it. Otherwise do DEST.
+64 SET Z=$SELECT($LENGTH($GET(INXDST)):INXDST,1:"D DEST")
XECUTE Z
+65 IF '$DATA(INDSTP)
SET INVL=2
SET MSG(1)="Message "_MESSID_" has no destination"
SET MSG(2)=$EXTRACT(INMSH,1,250)
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT
+66 ;pointer needed for most functions, NAME needed for NEW^INHD.
+67 IF '$DATA(INDST)
SET INDST=$PIECE(^INRHD(INDSTP,0),U)
End DoDot:1
IF INVL
GOTO ACK
+68 ;
+69 ;--Handle sequence number protocol if applicable. Will not store
+70 ;--msg if link is out of synch or if msg is for re-synch only.
+71 IF INUSEQ
Begin DoDot:1
+72 ;If commit ack (application ack won't get this far in routine)
+73 IF INTYP["ACK"
SET INVL=$$ACKINSEQ^INHUSEQ(INMSASTA,INDSTR,EXPCT,.INSEND,.INERR)
QUIT
+74 ;If msg, verify sequence number
+75 SET SEQ=$PIECE(INMSH,INDELIM,13)
+76 SET INVL=$$SEQIN^INHUSEQ(INDSTR,.SEQ,.STAT,.INERR,.EXPCT)
+77 ;If invalid, must return ack no matter what CND
+78 IF INVL
SET CND="ER"
End DoDot:1
IF INVL
GOTO ACK
+79 ;
+80 ;Store msg
+81 DO STORE
+82 ;If inbound is an application ack, see if commit ack needed
+83 IF INTYP["ACK"
IF $EXTRACT(INMSASTA)["A"
GOTO ACK
+84 ;Update parent for commit acks
+85 IF INTYP["ACK"
IF INMSG>0
DO CACKLOG^INHUSEN2(INMSG,ACKMSG,INMSASTA,.INERR)
+86 ;Under sequence number protocol, update LAST RECEIVED, but only after
+87 ;msg is successfully filed
+88 IF INUSEQ
NEW LTRY
SET LOOP=0
FOR LTRY=1:1:5
Begin DoDot:1
+89 LOCK +^INRHD(INDSTR,3):3
+90 IF $TEST
IF '$DATA(^INRHB("RUN",INBPN))
SET LOOP=1
QUIT
+91 SET $PIECE(^INRHD(INDSTR,3),U)=SEQ
SET LOOP=1
LOCK -^INRHD(INDSTR,3)
+92 IF '$TEST
DO ERRADD^INHUSEN3(.INERR,"Lock failed on ^INRHD("_INDSTR_" for message "_MESSID)
QUIT 2
End DoDot:1
IF LOOP
QUIT
+93 ;Flow through to tag ACK. Routine may also jump to ACK from above.
ACK ;Process commit ack and quit back to transceiver routine.
+1 ;CND originally set from MSH.
+2 Begin DoDot:1
+3 ;INNOACK parameter over-rides all others.
+4 IF $GET(INNOACK)
SET CND="NE"
QUIT
+5 ;Interface Destination File may have over-ride value.
+6 IF $LENGTH($PIECE(^INRHD(INDSTR,0),U,11))
SET CND=$PIECE(^INRHD(INDSTR,0),U,11)
End DoDot:1
+7 ;Stop Transaction Type Audit
+8 IF $DATA(XUAUDIT)
DO TTSTP^XUSAUD("",$GET(INMSG))
+9 NEW STAT,CERR
Begin DoDot:1
+10 IF CND="NE"
QUIT
+11 ;If CND has value, msg is in enhanced HL7 mode
+12 IF $LENGTH(CND)
Begin DoDot:2
+13 IF 'INVL
IF "SU,AL"[CND
SET CERR=$$CACK^INHUSEN2(INDSTR,"CA",ORIGID,.INERR,EXPCT)
QUIT
+14 IF INVL
IF "AL,ER"[CND
SET CERR=$$CACK^INHUSEN2(INDSTR,"CR",ORIGID,.INERR,EXPCT)
QUIT
End DoDot:2
QUIT
+15 ;CND will be null if msg is in original mode.
+16 ;If msg can't be filed, let CACK function create reject ack.
+17 ;(Transceiver routine will have to send the commit type ack)
+18 ;If msg was filed, do nothing. Application will ack.
+19 IF INVL>1
IF '$LENGTH($PIECE($GET(INMSH),U,16))
SET CERR=$$CACK^INHUSEN2(INDSTR,"AR",ORIGID,.INERR,EXPCT)
End DoDot:1
+20 QUIT $SELECT($GET(CERR)>INVL:CERR,1:INVL)
+21 ;
STORE ;Store incoming xmission in the Universal Interface file
+1 ;IHS needs DT
+2 DO SETDT^UTDT
+3 DO STORE^INHUSEN4
+4 QUIT
+5 ;
VERIF(INGBL,INMSH,INTYP,INEVN,INERR) ;Determine HL7 message type and event
+1 QUIT $$VERIF^INHUSEN4(INGBL,.INMSH,.INTYP,.INEVN,.INERR)
+2 ;
DEST ;Find destination for incoming message (not incoming ack?).
+1 DO DEST^INHUSEN4
+2 QUIT
+3 ;
GETSTD(INGBL) ;Identify the standard of the incoming message.
+1 ;This function looks at the first part of the first segment of
+2 ;the incoming message to distinguish between X12 and HL7 messages.
+3 ;INPUT
+4 ; INGBL passed from receiver
+5 ;RETURN
+6 ; Interface Standard such as X12 or HL7
+7 ; -1 if standard is unknown or first segment is unrecognizable.
+8 NEW LINE,LCT
+9 IF +INGBL
SET LCT=0
DO GETLINE^INHOU(INGBL,.LCT,.LINE)
+10 IF 'INGBL
SET LINE=$GET(@INGBL@(1))
+11 IF $EXTRACT(LINE,1,3)="MSH"
QUIT "HL7"
+12 IF $EXTRACT(LINE,1,3)="ISA"
QUIT "X12"
+13 ;If none of the above, error
+14 SET MSG(1)="Message from receiver "_$PIECE(^INTHPC(INBPN,0),U)_" does not have a known header segment"
SET MSG(2)=$EXTRACT(LINE,1,250)
DO ERRADD^INHUSEN3(.INERR,.MSG)
+15 QUIT -1
+16 ;
