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

INHUSEN.m

Go to the documentation of this file. 
  1. INHUSEN ; DGH ; 05 Nov 1999 12:57 ; Enhanced processing functions and utilities 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;CHCS TOOLS_460; GEN 5; 21-MAY-1997
  1.  ;COPYRIGHT 1994 SAIC
  1.  ;
  1. IN(ING,INDEST,INDSTR,INUSEQ,INSEND,INERR,INXDST,INMSG,INLHSCH,INMSASTA,INNOACK,INSTD) ;Process incoming
  1.  ;--1) Verify all needed data is present
  1.  ;--2) Store xmission (if verified but not if it is for housekeeping)
  1.  ;--3) Determines if seq. # protocol is in effect, and processes
  1.  ;--4) Create receipt ack as specified in MSH.
  1.  ;INPUT:
  1.  ;--ING = (REQ) Variable array/global containing lines from msg.
  1.  ;--INDEST = Array of valid destinations in format
  1.  ;           INDEST(type) =  .01 field of Tran Type.  This is not
  1.  ;           required if processing incoming ACKS, but will generate
  1.  ;           an error if processing incoming msg with no destination.
  1.  ;--INDSTR = (REQ) Receiver dest. pointer -- $P(^INTHPC(INBPN,0),U,7)
  1.  ;--INUSEQ = (OPT) Use seq. # protocol? 0=no (default) 1=yes
  1.  ;--INSEND = (OPT) Variable which will contain the UIF entry(ies) of
  1.  ;---msg which needs to be sent by tranceiver back to other system.
  1.  ;---This may be an accept ack, or it may be a msg which must be
  1.  ;---resent under sequence number protocol. (Pass By Reference)
  1.  ;--INERR = (OPT) Variable to return error msg. (PBR)
  1.  ;--INXDST = (OPT) EXecutable code to identify the destination for
  1.  ;---msgs which won't be uniquely identified by INTYP_INEVN.
  1.  ;---The executable must return the ien in the variable INDSTP.
  1.  ;--INMSG = (OPT) Variable to return UIF of inbound msg (PBR)
  1.  ;--INLHSCH = (OPT) Set to 1 if the incoming msg should not
  1.  ;            be placed on the output controller queue, ^INLHSCH.
  1.  ;            If not specified, this routine will determine the
  1.  ;            conditions under which a msg is queued.
  1.  ;--INBPN = background process internal number. (Will be set in recvr)
  1.  ;--INMSASTA = (OPT) Variable to return MSA-1 ack status (PBR)
  1.  ;--INNOACK = (OPT) =1 to uppress commit ack. Used for transmitters,
  1.  ;            which should not create a commit ack to a commit ack.
  1.  ;--INSTD = (OPT) Namespace/interface standard. Values such as
  1.  ;          NC (NCPDP) or X1 (X12) will branch to appropriate logic.
  1.  ;RETURN:
  1.  ;0 = success, 1 = non-fatal error, 2 = fatal error
  1.  N ORIGID,ORIGID2,MESSID,INVL,CND,SEQ,STAT,EXPCT,INDST,INDSTP,INMSH,INTYP,INEVN,LOOP,Z,ACKMSG,MSG
  1.  ;Note: INDST and INDSTP are variables for the Dest. file for the
  1.  ;incoming msg. This may differ from the destination of the
  1.  ;background process.
  1.  ;--Branch to support MEDE America implementation of NCPDP
  1.  I $G(INSTD)="PDTS" S ERR=$$INNC^INHUSEN5(ING,.INUSEQ,.INXDST,.INERR) Q ERR
  1.  ;--Identify interface standard
  1.  S INSTD=$$GETSTD(ING)
  1.  ;---X12 branch
  1.  I $G(INSTD)="X12" S ERR=$$X12IN^INHUSEN6(ING,.INDEST,INDSTR,.INSEND,.INERR,.INXDST,.INMSG,$G(INLHSCH),.INMSASTA,$G(INNOACK)) Q ERR
  1.  ;INUSEQ and INSTD not carred forward from IN
  1.  ;---
  1.  S (EXPCT,INSEND)="" S:'$D(INUSEQ) INUSEQ=0
  1.  ;First verify MSH, get msg type and event type. If invalid, quit
  1.  S INVL=$$VERIF(ING,.INMSH,.INTYP,.INEVN,.INERR) I INVL Q 2
  1.  ;Determine accept acknowledge conditions
  1.  S CND=$P(INMSH,INDELIM,15)
  1.  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
  1.  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
  1.  ;If ack, get status (and other data as needed based on MSA).
  1.  ;If application ack, will store and determine if commit ack is needed.
  1.  I INTYP["ACK" D  I $E($G(INMSASTA))="A"!INVL G ACK
  1.  . S INVL=$$ACKIN^INHUSEN2(ING,.INMSASTA,.EXPCT,.INDST,.INDSTP,.ACKMSG,.INERR) Q:INVL
  1.  . ;destination only needed for App. ack.
  1.  . Q:$E($G(INMSASTA))="C"
  1.  . 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
  1.  . S STAT=0 D STORE
  1.  ;--If incoming is a msg not an ack, must determine tran. type.
  1.  I INTYP'["ACK" D  G:INVL ACK
  1.  .;If tranceiver passed INXDST, execute it. Otherwise do DEST.
  1.  .S Z=$S($L($G(INXDST)):INXDST,1:"D DEST") X Z
  1.  .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
  1.  .;pointer needed for most functions, NAME needed for NEW^INHD.
  1.  .S:'$D(INDST) INDST=$P(^INRHD(INDSTP,0),U)
  1.  ;
  1.  ;--Handle sequence number protocol if applicable. Will not store
  1.  ;--msg if link is out of synch or if msg is for re-synch only.
  1.  I INUSEQ D  G:INVL ACK
  1.  .;If commit ack (application ack won't get this far in routine)
  1.  .I INTYP["ACK" S INVL=$$ACKINSEQ^INHUSEQ(INMSASTA,INDSTR,EXPCT,.INSEND,.INERR) Q
  1.  .;If msg, verify sequence number
  1.  .S SEQ=$P(INMSH,INDELIM,13)
  1.  .S INVL=$$SEQIN^INHUSEQ(INDSTR,.SEQ,.STAT,.INERR,.EXPCT)
  1.  .;If invalid, must return ack no matter what CND
  1.  .S:INVL CND="ER"
  1.  ;
  1.  ;Store msg
  1.  D STORE
  1.  ;If inbound is an application ack, see if commit ack needed
  1.  I INTYP["ACK",$E(INMSASTA)["A" G ACK
  1.  ;Update parent for commit acks
  1.  I INTYP["ACK",INMSG>0 D CACKLOG^INHUSEN2(INMSG,ACKMSG,INMSASTA,.INERR)
  1.  ;Under sequence number protocol, update LAST RECEIVED, but only after
  1.  ;msg is successfully filed
  1.  I INUSEQ N LTRY S LOOP=0 F LTRY=1:1:5 D  Q:LOOP
  1.  .L +^INRHD(INDSTR,3):3
  1.  .I $T S:'$D(^INRHB("RUN",INBPN)) LOOP=1 Q
  1.  .S $P(^INRHD(INDSTR,3),U)=SEQ,LOOP=1 L -^INRHD(INDSTR,3)
  1.  .I '$T D ERRADD^INHUSEN3(.INERR,"Lock failed on ^INRHD("_INDSTR_" for message "_MESSID) Q 2
  1.  ;Flow through to tag ACK. Routine may also jump to ACK from above.
  1. ACK ;Process commit ack and quit back to transceiver routine.
  1.  ;CND originally set from MSH.
  1.  D
  1.  .;INNOACK parameter over-rides all others.
  1.  .I $G(INNOACK) S CND="NE" Q
  1.  .;Interface Destination File may have over-ride value.
  1.  .S:$L($P(^INRHD(INDSTR,0),U,11)) CND=$P(^INRHD(INDSTR,0),U,11)
  1.  ;Stop Transaction Type Audit
  1.  D:$D(XUAUDIT) TTSTP^XUSAUD("",$G(INMSG))
  1.  N STAT,CERR D
  1.  . Q:CND="NE"
  1.  . ;If CND has value, msg is in enhanced HL7 mode
  1.  . I $L(CND) D  Q
  1.  .. I 'INVL,"SU,AL"[CND S CERR=$$CACK^INHUSEN2(INDSTR,"CA",ORIGID,.INERR,EXPCT) Q
  1.  .. I INVL,"AL,ER"[CND S CERR=$$CACK^INHUSEN2(INDSTR,"CR",ORIGID,.INERR,EXPCT) Q
  1.  . ;CND will be null if msg is in original mode.
  1.  . ;If msg can't be filed, let CACK function create reject ack.
  1.  . ;(Transceiver routine will have to send the commit type ack)
  1.  . ;If msg was filed, do nothing. Application will ack.
  1.  . I INVL>1,'$L($P($G(INMSH),U,16)) S CERR=$$CACK^INHUSEN2(INDSTR,"AR",ORIGID,.INERR,EXPCT)
  1.  Q $S($G(CERR)>INVL:CERR,1:INVL)
  1.  ;
  1. STORE ;Store incoming xmission in the Universal Interface file
  1.  ;IHS needs DT
  1.  D SETDT^UTDT
  1.  D STORE^INHUSEN4
  1.  Q
  1.  ;
  1. VERIF(INGBL,INMSH,INTYP,INEVN,INERR) ;Determine HL7 message type and event
  1.  Q $$VERIF^INHUSEN4(INGBL,.INMSH,.INTYP,.INEVN,.INERR)
  1.  ;
  1. DEST ;Find destination for incoming message (not incoming ack?).
  1.  D DEST^INHUSEN4
  1.  Q
  1.  ;
  1. GETSTD(INGBL) ;Identify the standard of the incoming message.
  1.  ;This function looks at the first part of the first segment of
  1.  ;the incoming message to distinguish between X12 and HL7 messages.
  1.  ;INPUT
  1.  ; INGBL passed from receiver
  1.  ;RETURN
  1.  ; Interface Standard such as X12 or HL7
  1.  ; -1 if standard is unknown or first segment is unrecognizable.
  1.  N LINE,LCT
  1.  I +INGBL S LCT=0 D GETLINE^INHOU(INGBL,.LCT,.LINE)
  1.  I 'INGBL S LINE=$G(@INGBL@(1))
  1.  I $E(LINE,1,3)="MSH" Q "HL7"
  1.  I $E(LINE,1,3)="ISA" Q "X12"
  1.  ;If none of the above, error
  1.  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)
  1.  Q -1
  1.  ;