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

INHUSEN7.m

Go to the documentation of this file. 
  1. INHUSEN7 ;KN,DGH; 11 Nov 1999 16:52 ; X12 verification logic
  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. VERIF(INGBL,INTYP,INTA,ORIGID,INLINK,INSTAT,INERR) ;12/6/98
  1.  ; Description:
  1.  ; The function VERIF is used to verify and evaluate X12 headers 
  1.  ; such as ISA, GS or TA1 and X12 Trailers such as GE, IEA.
  1.  ; It returns values such as message type, control numbers, etc.
  1.  ;
  1.  ; Parameters:
  1.  ; Input:
  1.  ; INGBL = May be a local or global array of X12 message lines
  1.  ;         If numeric, assumed to be IEN for ^INTHU
  1.  ;         If non-numeric, assumed to be variable array
  1.  ; INTYP = (PRB) Variable to contain X12 Functional Identifier (msg type)
  1.  ; INTA = (PBR) Variable array contains fields of interest
  1.  ; ORIGID = (PBR) Message ID of incoming message
  1.  ; INLINK = (PBR) ID of original message such as a query.
  1.  ;          This will be stored in CHCS as a sequence number because
  1.  ;          alpha characters are not allowed by X12.
  1.  ; INSTAT = (PBR) Variable to contain status of original message.
  1.  ;    (INLINK & INSTAT are only populated for FA and TA1 message types)
  1.  ;   kim is including following in INTA, not sure if this is needed
  1.  ;  INTA   = array of value for interchange ack (PBR)
  1.  ;  INTA("ORGICNUM") = Original Interchange Control Number
  1.  ;  INTA("ORGDATE")  = Original Date
  1.  ;  INTA("ORGTIME")  = Original Time
  1.  ;  INTA("ACKCODE")  = Interchange Ack Code
  1.  ;  INTA("NOTECODE") = Interchange Note Code
  1.  ;  INORGID = Original message ID (PBR)
  1.  ; the Transaction Set Control Number (ST02) is the original ID.
  1.  ;
  1.  ; Returns:
  1.  ;    0 = Success
  1.  ;    1 = Non-Fatal Error
  1.  ;    2 = Fatal Error
  1.  ;
  1.  N LCT,INDOCNT,INISA,INGST,INGE,INIEA,INER,INGS2,LINE,MSG,INACK
  1.  N INFROM,INSTCNT,INTEREST,LINE,SEGID
  1.  ;Initialize
  1.  S INVL=0 K INACK
  1.  ;Get Interchnage Control Header ISA
  1.  I +INGBL D GETLINE^INHOU(INGBL,.LCT,.LINE)
  1.  I 'INGBL S LINE=$G(@INGBL@(1))
  1.  I $E(LINE,1,3)'="ISA" W !,"Message from receiver "_$P(^INTHPC(INBPN,0),U)_" does not have the ISA segment in the correct location",MSG(2)=$E(LINE,1,250) D ERRADD^INHUSEN3(.INERR,.MSG) Q 2
  1.  S INDELIM=$E(LINE,4),INSUBDEL=$E(LINE,105)
  1.  ;Set ORIGID of the ISA. If incoming is TA1, this must be used.
  1.  ;If not a TA1, ORIGID will be overwritten with id in the ST segment.
  1.  S ORIGID=$P(LINE,INDELIM,13)
  1.  ; Default value is good transmission
  1.  ;Get next line, INGST=GS or TA1  
  1.  I +INGBL D GETLINE^INHOU(INGBL,.LCT,.LINE)
  1.  I 'INGBL S LINE=$G(@INGBL@(2))
  1.  ;Second segment must be either GS or TA1
  1.  S SEGID=$P(LINE,INDELIM)
  1.  I ",TA1,GS,"'[(","_SEGID_",") S MSG(1)="Second segment is not GS nor TA1",MSG(2)=$E(LINE,1,250) D ERRADD^INHUSEN3(.INERR,.MSG) Q 2
  1.  ;--TA1 not planned for DEERS use, but needed for generic X12 processing.
  1.  I SEGID="TA1" D  Q INVL
  1.  .S INTYP="TA1"
  1.  .S INLINK=$P(LINE,INDELIM,2),INSTAT=$P(LINE,INDELIM,4)
  1.  .I ",A,E,R,"'[(","_INSTAT_",") D ERRADD^INHUSEN3(.INERR,"Missing or invalid acknowledge code "_LINE) S INVL=2 Q
  1.  .I INSTAT'="A" D ERRADD^INHUSEN3(.INERR,LINE)
  1.  ;
  1.  ;--Else next segment is a GS.
  1.  S (INTYP,INTA("GS01"))=$P(LINE,INDELIM,2)
  1.  S INTA("GS06")=$P(LINE,INDELIM,7)
  1.  I '$L(INTYP) S MSG(1)="Message from receiver "_$P(^INTHPC(INBPN,0),U)_" does not have a type.",MSG(2)=$E(LINE,1,250),INVL=2 D ERRADD^INHUSEN3(.INERR,.MSG)
  1.  Q:INVL INVL
  1.  ;$Order through remainder lines to obtain needed control data.
  1.  S INTEREST=",ISA,GS,ST,SE,GE,ISE,TA1,AK1,AK2,AK3,AK4,AK5,AK9,BHT,BGN,BGF,",INDOCNT=0
  1.  I +INGBL D  Q:'INVL
  1.  .D GETLINE^INHOU(INGBL,.LCT,.LINE)
  1.  .S SEGID=$P(LINE,INDELIM)
  1.  .;count segments beteween ST and SE if "do count" flag is set.
  1.  .I INDOCNT S INSTCNT=$G(INSTCNT)+1
  1.  .D:INTEREST[SEGID INCNTL
  1.  I 'INGBL S LCT=2 F  S LCT=$O(@INGBL@(LCT)) Q:'LCT  D
  1.  .S LINE=$G(@INGBL@(LCT))
  1.  .S SEGID=$P(LINE,INDELIM)
  1.  .;Count segments between ST and SE. Note: Overflow nodes will be
  1.  .;in @INGBL@(LCT,I), so LINE is an accurate counte of segments.
  1.  .I INDOCNT S INSTCNT=$G(INSTCNT)+1
  1.  .D:INTEREST[SEGID INCNTL
  1.  ;
  1.  ;---Miscellaneous error checking section--
  1.  I $G(INTA("ST02"))'=$G(INTA("SE02")) S MSG(1)="ST02 "_$G(INTA("ST02"))_" does not match SE02 "_$G(INTA("SE02"))_" transaction set control numbers",INVL=2 D ERRADD^INHUSEN3(.INERR,.MSG) Q INVL
  1.  ;---Set other needed variables. INLINK value differs by message type--
  1.  S ORIGID=$G(INTA("ST02"))
  1.  S:INTYP="HB" INLINK=$G(INTA("BHT03")) ;271
  1.  S:INTYP="AG" INLINK=$G(INTA("BGN02")) ;824
  1.  S:INTYP="BE" INLINK=$G(INTA("BGN02")) ;834
  1.  S:INTYP="HI" INLINK=$G(INTA("BHT03")) ;278
  1.  Q INVL
  1.  ;
  1. INCNTL ;Get control segment field values for segments of interest
  1.  ;This assumes that needed variables are within the first 240
  1.  ;characters of LINE (e.g. there are no overflow nodes). If INGBL
  1.  ;is a local array (most likely), any overflow of a segment would
  1.  ;not reach this call because the calling logic is doing a $O of
  1.  ;the first subscript and overflow beyond 240 chars are in subsequent.
  1.  ;Input
  1.  ; LINE=first line of segment if global; first 240 characters if local
  1.  ; SEGID
  1.  ;Return
  1.  ; fields needed to process
  1.  Q:SEGID=""
  1.  I SEGID="ISA" S MSG(1)="Second ISA found in message",MSG(2)=LINE,INVL=2 D ERRADD^INHUSEN3(.INERR,.MSG) Q
  1.  I SEGID="GS" S MSG(1)="Multiple GS loops not supported",MSG(2)=LINE,INVL=2 D ERRADD^INHUSEN3(.INERR,.MSG) Q
  1.  I SEGID="IEA" S INTA("IEA1")=$P(LINE,INDELIM,2),INTA("IEA2")=$P(LINE,INDELIM,2) Q
  1.  I SEGID="TA1" S ORIGID=$P(LINE,INDELIM,2),INTA("ACKCODE")=$P(LINE,INDELIM,3),INTA("NOTECODE")=$P(LINE,INDELIM,4) Q
  1.  I SEGID="ST" D  Q
  1.  .;Turn "do count" on and initialize ST-SE segment counter to 1.
  1.  .S (INSTCNT,INDOCNT)=1
  1.  .I $D(INTA("ST01")) S MSG(1)="Multiple ST loops not supported",INVL=2 D ERRADD^INHUSEN3(.INERR,.MSG)
  1.  .S INTA("ST01")=$P(LINE,INDELIM,2),INTA("ST02")=$P(LINE,INDELIM,3) Q
  1.  I SEGID="SE" D  Q
  1.  .S INTA("SE01")=$P(LINE,INDELIM,2),INTA("SE02")=$P(LINE,INDELIM,3)
  1.  .;Turn "do count" flag off and compare count in SE01 with INSTCNT
  1.  .S INDOCNT=0
  1.  .I INTA("SE01")'=INSTCNT S MSG(1)="Segment count "_INSTCNT_" does not match specified count "_INTA("SE01"),INVL=1 D ERRADD^INHUSEN3(.INERR,.MSG)
  1.  I SEGID="GE" S INTA("GE01")=$P(LINE,INDELIM,2),INTA("GE02")=$P(LINE,INDELIM,3) Q
  1.  I SEGID="BHT" S INTA("BHT03")=$P(LINE,INDELIM,4)
  1.  I SEGID="BGN" S INTA("BGN01")=$P(LINE,INDELIM,2),INTA("BGN02")=$P(LINE,INDELIM,3) Q
  1.  I SEGID="BGF" S INTA("BGF01")=$P(LINE,INDELIM,2),INTA("BGF02")=$P(LINE,INDELIM,3) Q
  1.  ;Following should only exist if INTYP=FA (Functional Acknowledge).
  1.  Q:INTYP'="FA"
  1.  ;Logic will add each AKn segment to temp array. Only roll it into
  1.  ;error log if status is in error. But we don't know that till the end.
  1.  ;Don't set INSTAT flag until the last segment--AK9
  1.  I SEGID="AK2" S INLINK=$P(LINE,INDELIM,3)
  1.  I ",AK1,AK2,AK3,AK4,AK5,"[(","_SEGID_",") D ERRADD^INHUSEN3(.INACK,LINE) Q
  1.  ;AK9-1 has value of X12's INSTAT, the equivalent of HL7's MSASTAT.
  1.  I SEGID="AK9" D
  1.  .S INSTAT=$P(LINE,INDELIM,2)
  1.  .I ",A,E,R,"'[(","_INSTAT_",") D ERRADD^INHUSEN3(.INERR,"Missing or invalid acknowledge code "_LINE) S INVL=2 Q
  1.  .I INSTAT'="A" D ERRADD^INHUSEN3(.INACK,LINE),ERRADD^INHUSEN3(.INERR,.INACK)
  1.  Q
  1.  ;
  1.  ;