INHUSEN7 ;KN,DGH; 11 Nov 1999 16:52 ; X12 verification logic
;;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
;
VERIF(INGBL,INTYP,INTA,ORIGID,INLINK,INSTAT,INERR) ;12/6/98
; Description:
; The function VERIF is used to verify and evaluate X12 headers
; such as ISA, GS or TA1 and X12 Trailers such as GE, IEA.
; It returns values such as message type, control numbers, etc.
;
; Parameters:
; Input:
; INGBL = May be a local or global array of X12 message lines
; If numeric, assumed to be IEN for ^INTHU
; If non-numeric, assumed to be variable array
; INTYP = (PRB) Variable to contain X12 Functional Identifier (msg type)
; INTA = (PBR) Variable array contains fields of interest
; ORIGID = (PBR) Message ID of incoming message
; INLINK = (PBR) ID of original message such as a query.
; This will be stored in CHCS as a sequence number because
; alpha characters are not allowed by X12.
; INSTAT = (PBR) Variable to contain status of original message.
; (INLINK & INSTAT are only populated for FA and TA1 message types)
; kim is including following in INTA, not sure if this is needed
; INTA = array of value for interchange ack (PBR)
; INTA("ORGICNUM") = Original Interchange Control Number
; INTA("ORGDATE") = Original Date
; INTA("ORGTIME") = Original Time
; INTA("ACKCODE") = Interchange Ack Code
; INTA("NOTECODE") = Interchange Note Code
; INORGID = Original message ID (PBR)
; the Transaction Set Control Number (ST02) is the original ID.
;
; Returns:
; 0 = Success
; 1 = Non-Fatal Error
; 2 = Fatal Error
;
N LCT,INDOCNT,INISA,INGST,INGE,INIEA,INER,INGS2,LINE,MSG,INACK
N INFROM,INSTCNT,INTEREST,LINE,SEGID
;Initialize
S INVL=0 K INACK
;Get Interchnage Control Header ISA
I +INGBL D GETLINE^INHOU(INGBL,.LCT,.LINE)
I 'INGBL S LINE=$G(@INGBL@(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
S INDELIM=$E(LINE,4),INSUBDEL=$E(LINE,105)
;Set ORIGID of the ISA. If incoming is TA1, this must be used.
;If not a TA1, ORIGID will be overwritten with id in the ST segment.
S ORIGID=$P(LINE,INDELIM,13)
; Default value is good transmission
;Get next line, INGST=GS or TA1
I +INGBL D GETLINE^INHOU(INGBL,.LCT,.LINE)
I 'INGBL S LINE=$G(@INGBL@(2))
;Second segment must be either GS or TA1
S SEGID=$P(LINE,INDELIM)
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
;--TA1 not planned for DEERS use, but needed for generic X12 processing.
I SEGID="TA1" D Q INVL
.S INTYP="TA1"
.S INLINK=$P(LINE,INDELIM,2),INSTAT=$P(LINE,INDELIM,4)
.I ",A,E,R,"'[(","_INSTAT_",") D ERRADD^INHUSEN3(.INERR,"Missing or invalid acknowledge code "_LINE) S INVL=2 Q
.I INSTAT'="A" D ERRADD^INHUSEN3(.INERR,LINE)
;
;--Else next segment is a GS.
S (INTYP,INTA("GS01"))=$P(LINE,INDELIM,2)
S INTA("GS06")=$P(LINE,INDELIM,7)
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)
Q:INVL INVL
;$Order through remainder lines to obtain needed control data.
S INTEREST=",ISA,GS,ST,SE,GE,ISE,TA1,AK1,AK2,AK3,AK4,AK5,AK9,BHT,BGN,BGF,",INDOCNT=0
I +INGBL D Q:'INVL
.D GETLINE^INHOU(INGBL,.LCT,.LINE)
.S SEGID=$P(LINE,INDELIM)
.;count segments beteween ST and SE if "do count" flag is set.
.I INDOCNT S INSTCNT=$G(INSTCNT)+1
.D:INTEREST[SEGID INCNTL
I 'INGBL S LCT=2 F S LCT=$O(@INGBL@(LCT)) Q:'LCT D
.S LINE=$G(@INGBL@(LCT))
.S SEGID=$P(LINE,INDELIM)
.;Count segments between ST and SE. Note: Overflow nodes will be
.;in @INGBL@(LCT,I), so LINE is an accurate counte of segments.
.I INDOCNT S INSTCNT=$G(INSTCNT)+1
.D:INTEREST[SEGID INCNTL
;
;---Miscellaneous error checking section--
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
;---Set other needed variables. INLINK value differs by message type--
S ORIGID=$G(INTA("ST02"))
S:INTYP="HB" INLINK=$G(INTA("BHT03")) ;271
S:INTYP="AG" INLINK=$G(INTA("BGN02")) ;824
S:INTYP="BE" INLINK=$G(INTA("BGN02")) ;834
S:INTYP="HI" INLINK=$G(INTA("BHT03")) ;278
Q INVL
;
INCNTL ;Get control segment field values for segments of interest
;This assumes that needed variables are within the first 240
;characters of LINE (e.g. there are no overflow nodes). If INGBL
;is a local array (most likely), any overflow of a segment would
;not reach this call because the calling logic is doing a $O of
;the first subscript and overflow beyond 240 chars are in subsequent.
;Input
; LINE=first line of segment if global; first 240 characters if local
; SEGID
;Return
; fields needed to process
Q:SEGID=""
I SEGID="ISA" S MSG(1)="Second ISA found in message",MSG(2)=LINE,INVL=2 D ERRADD^INHUSEN3(.INERR,.MSG) Q
I SEGID="GS" S MSG(1)="Multiple GS loops not supported",MSG(2)=LINE,INVL=2 D ERRADD^INHUSEN3(.INERR,.MSG) Q
I SEGID="IEA" S INTA("IEA1")=$P(LINE,INDELIM,2),INTA("IEA2")=$P(LINE,INDELIM,2) Q
I SEGID="TA1" S ORIGID=$P(LINE,INDELIM,2),INTA("ACKCODE")=$P(LINE,INDELIM,3),INTA("NOTECODE")=$P(LINE,INDELIM,4) Q
I SEGID="ST" D Q
.;Turn "do count" on and initialize ST-SE segment counter to 1.
.S (INSTCNT,INDOCNT)=1
.I $D(INTA("ST01")) S MSG(1)="Multiple ST loops not supported",INVL=2 D ERRADD^INHUSEN3(.INERR,.MSG)
.S INTA("ST01")=$P(LINE,INDELIM,2),INTA("ST02")=$P(LINE,INDELIM,3) Q
I SEGID="SE" D Q
.S INTA("SE01")=$P(LINE,INDELIM,2),INTA("SE02")=$P(LINE,INDELIM,3)
.;Turn "do count" flag off and compare count in SE01 with INSTCNT
.S INDOCNT=0
.I INTA("SE01")'=INSTCNT S MSG(1)="Segment count "_INSTCNT_" does not match specified count "_INTA("SE01"),INVL=1 D ERRADD^INHUSEN3(.INERR,.MSG)
I SEGID="GE" S INTA("GE01")=$P(LINE,INDELIM,2),INTA("GE02")=$P(LINE,INDELIM,3) Q
I SEGID="BHT" S INTA("BHT03")=$P(LINE,INDELIM,4)
I SEGID="BGN" S INTA("BGN01")=$P(LINE,INDELIM,2),INTA("BGN02")=$P(LINE,INDELIM,3) Q
I SEGID="BGF" S INTA("BGF01")=$P(LINE,INDELIM,2),INTA("BGF02")=$P(LINE,INDELIM,3) Q
;Following should only exist if INTYP=FA (Functional Acknowledge).
Q:INTYP'="FA"
;Logic will add each AKn segment to temp array. Only roll it into
;error log if status is in error. But we don't know that till the end.
;Don't set INSTAT flag until the last segment--AK9
I SEGID="AK2" S INLINK=$P(LINE,INDELIM,3)
I ",AK1,AK2,AK3,AK4,AK5,"[(","_SEGID_",") D ERRADD^INHUSEN3(.INACK,LINE) Q
;AK9-1 has value of X12's INSTAT, the equivalent of HL7's MSASTAT.
I SEGID="AK9" D
.S INSTAT=$P(LINE,INDELIM,2)
.I ",A,E,R,"'[(","_INSTAT_",") D ERRADD^INHUSEN3(.INERR,"Missing or invalid acknowledge code "_LINE) S INVL=2 Q
.I INSTAT'="A" D ERRADD^INHUSEN3(.INACK,LINE),ERRADD^INHUSEN3(.INERR,.INACK)
Q
;
;
INHUSEN7 ;KN,DGH; 11 Nov 1999 16:52 ; X12 verification logic
+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 ;
VERIF(INGBL,INTYP,INTA,ORIGID,INLINK,INSTAT,INERR) ;12/6/98
+1 ; Description:
+2 ; The function VERIF is used to verify and evaluate X12 headers
+3 ; such as ISA, GS or TA1 and X12 Trailers such as GE, IEA.
+4 ; It returns values such as message type, control numbers, etc.
+5 ;
+6 ; Parameters:
+7 ; Input:
+8 ; INGBL = May be a local or global array of X12 message lines
+9 ; If numeric, assumed to be IEN for ^INTHU
+10 ; If non-numeric, assumed to be variable array
+11 ; INTYP = (PRB) Variable to contain X12 Functional Identifier (msg type)
+12 ; INTA = (PBR) Variable array contains fields of interest
+13 ; ORIGID = (PBR) Message ID of incoming message
+14 ; INLINK = (PBR) ID of original message such as a query.
+15 ; This will be stored in CHCS as a sequence number because
+16 ; alpha characters are not allowed by X12.
+17 ; INSTAT = (PBR) Variable to contain status of original message.
+18 ; (INLINK & INSTAT are only populated for FA and TA1 message types)
+19 ; kim is including following in INTA, not sure if this is needed
+20 ; INTA = array of value for interchange ack (PBR)
+21 ; INTA("ORGICNUM") = Original Interchange Control Number
+22 ; INTA("ORGDATE") = Original Date
+23 ; INTA("ORGTIME") = Original Time
+24 ; INTA("ACKCODE") = Interchange Ack Code
+25 ; INTA("NOTECODE") = Interchange Note Code
+26 ; INORGID = Original message ID (PBR)
+27 ; the Transaction Set Control Number (ST02) is the original ID.
+28 ;
+29 ; Returns:
+30 ; 0 = Success
+31 ; 1 = Non-Fatal Error
+32 ; 2 = Fatal Error
+33 ;
+34 NEW LCT,INDOCNT,INISA,INGST,INGE,INIEA,INER,INGS2,LINE,MSG,INACK
+35 NEW INFROM,INSTCNT,INTEREST,LINE,SEGID
+36 ;Initialize
+37 SET INVL=0
KILL INACK
+38 ;Get Interchnage Control Header ISA
+39 IF +INGBL
DO GETLINE^INHOU(INGBL,.LCT,.LINE)
+40 IF 'INGBL
SET LINE=$GET(@INGBL@(1))
+41 IF $EXTRACT(LINE,1,3)'="ISA"
WRITE !,"Message from receiver "_$PIECE(^INTHPC(INBPN,0),U)_" does not have the ISA segment in the correct location",MSG(2)=$EXTRACT(LINE,1,250)
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT 2
+42 SET INDELIM=$EXTRACT(LINE,4)
SET INSUBDEL=$EXTRACT(LINE,105)
+43 ;Set ORIGID of the ISA. If incoming is TA1, this must be used.
+44 ;If not a TA1, ORIGID will be overwritten with id in the ST segment.
+45 SET ORIGID=$PIECE(LINE,INDELIM,13)
+46 ; Default value is good transmission
+47 ;Get next line, INGST=GS or TA1
+48 IF +INGBL
DO GETLINE^INHOU(INGBL,.LCT,.LINE)
+49 IF 'INGBL
SET LINE=$GET(@INGBL@(2))
+50 ;Second segment must be either GS or TA1
+51 SET SEGID=$PIECE(LINE,INDELIM)
+52 IF ",TA1,GS,"'[(","_SEGID_",")
SET MSG(1)="Second segment is not GS nor TA1"
SET MSG(2)=$EXTRACT(LINE,1,250)
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT 2
+53 ;--TA1 not planned for DEERS use, but needed for generic X12 processing.
+54 IF SEGID="TA1"
Begin DoDot:1
+55 SET INTYP="TA1"
+56 SET INLINK=$PIECE(LINE,INDELIM,2)
SET INSTAT=$PIECE(LINE,INDELIM,4)
+57 IF ",A,E,R,"'[(","_INSTAT_",")
DO ERRADD^INHUSEN3(.INERR,"Missing or invalid acknowledge code "_LINE)
SET INVL=2
QUIT
+58 IF INSTAT'="A"
DO ERRADD^INHUSEN3(.INERR,LINE)
End DoDot:1
QUIT INVL
+59 ;
+60 ;--Else next segment is a GS.
+61 SET (INTYP,INTA("GS01"))=$PIECE(LINE,INDELIM,2)
+62 SET INTA("GS06")=$PIECE(LINE,INDELIM,7)
+63 IF '$LENGTH(INTYP)
SET MSG(1)="Message from receiver "_$PIECE(^INTHPC(INBPN,0),U)_" does not have a type."
SET MSG(2)=$EXTRACT(LINE,1,250)
SET INVL=2
DO ERRADD^INHUSEN3(.INERR,.MSG)
+64 IF INVL
QUIT INVL
+65 ;$Order through remainder lines to obtain needed control data.
+66 SET INTEREST=",ISA,GS,ST,SE,GE,ISE,TA1,AK1,AK2,AK3,AK4,AK5,AK9,BHT,BGN,BGF,"
SET INDOCNT=0
+67 IF +INGBL
Begin DoDot:1
+68 DO GETLINE^INHOU(INGBL,.LCT,.LINE)
+69 SET SEGID=$PIECE(LINE,INDELIM)
+70 ;count segments beteween ST and SE if "do count" flag is set.
+71 IF INDOCNT
SET INSTCNT=$GET(INSTCNT)+1
+72 IF INTEREST[SEGID
DO INCNTL
End DoDot:1
IF 'INVL
QUIT
+73 IF 'INGBL
SET LCT=2
FOR
SET LCT=$ORDER(@INGBL@(LCT))
IF 'LCT
QUIT
Begin DoDot:1
+74 SET LINE=$GET(@INGBL@(LCT))
+75 SET SEGID=$PIECE(LINE,INDELIM)
+76 ;Count segments between ST and SE. Note: Overflow nodes will be
+77 ;in @INGBL@(LCT,I), so LINE is an accurate counte of segments.
+78 IF INDOCNT
SET INSTCNT=$GET(INSTCNT)+1
+79 IF INTEREST[SEGID
DO INCNTL
End DoDot:1
+80 ;
+81 ;---Miscellaneous error checking section--
+82 IF $GET(INTA("ST02"))'=$GET(INTA("SE02"))
SET MSG(1)="ST02 "_$GET(INTA("ST02"))_" does not match SE02 "_$GET(INTA("SE02"))_" transaction set control numbers"
SET INVL=2
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT INVL
+83 ;---Set other needed variables. INLINK value differs by message type--
+84 SET ORIGID=$GET(INTA("ST02"))
+85 ;271
IF INTYP="HB"
SET INLINK=$GET(INTA("BHT03"))
+86 ;824
IF INTYP="AG"
SET INLINK=$GET(INTA("BGN02"))
+87 ;834
IF INTYP="BE"
SET INLINK=$GET(INTA("BGN02"))
+88 ;278
IF INTYP="HI"
SET INLINK=$GET(INTA("BHT03"))
+89 QUIT INVL
+90 ;
INCNTL ;Get control segment field values for segments of interest
+1 ;This assumes that needed variables are within the first 240
+2 ;characters of LINE (e.g. there are no overflow nodes). If INGBL
+3 ;is a local array (most likely), any overflow of a segment would
+4 ;not reach this call because the calling logic is doing a $O of
+5 ;the first subscript and overflow beyond 240 chars are in subsequent.
+6 ;Input
+7 ; LINE=first line of segment if global; first 240 characters if local
+8 ; SEGID
+9 ;Return
+10 ; fields needed to process
+11 IF SEGID=""
QUIT
+12 IF SEGID="ISA"
SET MSG(1)="Second ISA found in message"
SET MSG(2)=LINE
SET INVL=2
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT
+13 IF SEGID="GS"
SET MSG(1)="Multiple GS loops not supported"
SET MSG(2)=LINE
SET INVL=2
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT
+14 IF SEGID="IEA"
SET INTA("IEA1")=$PIECE(LINE,INDELIM,2)
SET INTA("IEA2")=$PIECE(LINE,INDELIM,2)
QUIT
+15 IF SEGID="TA1"
SET ORIGID=$PIECE(LINE,INDELIM,2)
SET INTA("ACKCODE")=$PIECE(LINE,INDELIM,3)
SET INTA("NOTECODE")=$PIECE(LINE,INDELIM,4)
QUIT
+16 IF SEGID="ST"
Begin DoDot:1
+17 ;Turn "do count" on and initialize ST-SE segment counter to 1.
+18 SET (INSTCNT,INDOCNT)=1
+19 IF $DATA(INTA("ST01"))
SET MSG(1)="Multiple ST loops not supported"
SET INVL=2
DO ERRADD^INHUSEN3(.INERR,.MSG)
+20 SET INTA("ST01")=$PIECE(LINE,INDELIM,2)
SET INTA("ST02")=$PIECE(LINE,INDELIM,3)
QUIT
End DoDot:1
QUIT
+21 IF SEGID="SE"
Begin DoDot:1
+22 SET INTA("SE01")=$PIECE(LINE,INDELIM,2)
SET INTA("SE02")=$PIECE(LINE,INDELIM,3)
+23 ;Turn "do count" flag off and compare count in SE01 with INSTCNT
+24 SET INDOCNT=0
+25 IF INTA("SE01")'=INSTCNT
SET MSG(1)="Segment count "_INSTCNT_" does not match specified count "_INTA("SE01")
SET INVL=1
DO ERRADD^INHUSEN3(.INERR,.MSG)
End DoDot:1
QUIT
+26 IF SEGID="GE"
SET INTA("GE01")=$PIECE(LINE,INDELIM,2)
SET INTA("GE02")=$PIECE(LINE,INDELIM,3)
QUIT
+27 IF SEGID="BHT"
SET INTA("BHT03")=$PIECE(LINE,INDELIM,4)
+28 IF SEGID="BGN"
SET INTA("BGN01")=$PIECE(LINE,INDELIM,2)
SET INTA("BGN02")=$PIECE(LINE,INDELIM,3)
QUIT
+29 IF SEGID="BGF"
SET INTA("BGF01")=$PIECE(LINE,INDELIM,2)
SET INTA("BGF02")=$PIECE(LINE,INDELIM,3)
QUIT
+30 ;Following should only exist if INTYP=FA (Functional Acknowledge).
+31 IF INTYP'="FA"
QUIT
+32 ;Logic will add each AKn segment to temp array. Only roll it into
+33 ;error log if status is in error. But we don't know that till the end.
+34 ;Don't set INSTAT flag until the last segment--AK9
+35 IF SEGID="AK2"
SET INLINK=$PIECE(LINE,INDELIM,3)
+36 IF ",AK1,AK2,AK3,AK4,AK5,"[(","_SEGID_",")
DO ERRADD^INHUSEN3(.INACK,LINE)
QUIT
+37 ;AK9-1 has value of X12's INSTAT, the equivalent of HL7's MSASTAT.
+38 IF SEGID="AK9"
Begin DoDot:1
+39 SET INSTAT=$PIECE(LINE,INDELIM,2)
+40 IF ",A,E,R,"'[(","_INSTAT_",")
DO ERRADD^INHUSEN3(.INERR,"Missing or invalid acknowledge code "_LINE)
SET INVL=2
QUIT
+41 IF INSTAT'="A"
DO ERRADD^INHUSEN3(.INACK,LINE)
DO ERRADD^INHUSEN3(.INERR,.INACK)
End DoDot:1
+42 QUIT
+43 ;
+44 ;
