INTSUSN ; DGH JPD; 3 Jun 96 09:54; Enhanced functions and utilities
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
IN(INIP,ING,INDEST,INSEND,INERR,INXDST,INMSG,INMSASTA,INRONLY) ;Process incoming
;Copied from INHUSEN
;Verify all needed data is present
;Store xmission (if verified but not if it is for housekeeping)
;Create receipt ack as specified in MSH.
;
;Input:
; INIP - array of parameters
; ING = (REQ) Variable array/global containing lines from msg.
; INDEST = Array of valid destinations in format
; INDEST(type) = .01 field of destination. This is not
; required if processing incoming ACKS, but will generate
; an error if processing incoming msg with no destination.
; INSEND = (OPT) UIF entry(ies) of msg which needs to be sent by
; tranceiver back to other system.
; This may be an accept ack
; 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)
; INMSASTA = (OPT) Variable to return MSA-1 ack status (PBR)
; INRONLY - 1 Receive only send no ack, 0 receive then send ack
;
;Returns:
; 0 = success, 1 = non-fatal error, 2 = fatal error
;
N ORIGID,ORIGID2,MESSID,INVL,STAT,EXPCT,INDST,INDSTP,INMSH,INTYP
N INEVN,Z,ACKMSG
;Note: INDST and INDSTP are variables for the Dest. file for the
;incoming msg. This may differ from the destination of the
;background process.
S (EXPCT,INSEND,INERR)=""
;First verify MSH, get msg type and event type. If invalid, quit
I $$VERIF^INTSUSN1(ING,.INMSH,.INTYP,.INEVN,.INERR) Q 2
S (MESSID,ORIGID)=$P(INMSH,INDELIM,10)
;
;is message ID valid
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
;
;is message type invalid
I INTYP="" D Q $$ACK(.INIP,2,.INSEND,INRONLY)
.S MSG(1)="Unable to determine message type",MSG(2)=$E(INMSH,1,250)
.D ERRADD^INHUSEN3(.INERR,.MSG)
;
S INVL=""
; If ack,destination only needed for App. ack.
I INTYP["ACK" D TYPEACK(ING,.INVL,.INMSG)
; If incoming is a msg not an ack, must determine tran. type.
I INTYP'["ACK" D TYPNOTAK(ING,.INXDST,.INDSTP,.INDST,.INVL,.INMSG)
Q $$ACK(.INIP,.INVL,.INSEND,INRONLY)
;
TYPEACK(ING,INVL,INMSG) ;Type was ack
;Input:
; ING = Variable array/global containing lines from msg.
;Output:
; INVL - True - invalid, "" no error
; INMSG = (OPT) Variable to return UIF of inbound msg (PBR)
;Local
; INMSGSTAT -
; AA - Application Accept or No MSA segment Accept
; AE - Application Error
; AR - Application Reject
; CA - Commit Accept Ack
; CE - Commit Error
; CR - Commit Reject
;
N INMSASTA,EXPCT,INDST,INDSTP,ACKMSG
S INVL=$$ACKIN^INHUSEN2(ING,.INMSASTA,.EXPCT,.INDST,.INDSTP,.ACKMSG,.INERR)
;quit if invalid
Q:INVL
;If application ack and no destination
I $E($G(INMSASTA))="A",'$G(INDSTP) D Q
.S MSG(1)="Ack "_MESSID_" has no destination",MSG(2)=$E(INMSH,1,250)
.D ERRADD^INHUSEN3(.INERR,.MSG)
.S INVL=2
D STORE(INDST,ING,.INMSG)
;Update parent for commit acks
I $E($G(INMSASTA))="C",INMSG>0 D CACKLOG(INMSG,ACKMSG,INMSASTA,.INERR)
Q
TYPNOTAK(ING,INXDST,INDSTP,INDST,INVL,INMSG) ;Type was not an ack
;Input:
; ING = Variable array/global containing lines from msg.
; INXDST = eXecutable code to identify the destination
; INDSTP - Destination pointer
; INDST - Destination pointer
; INVL - True - invalid, "" no error
; INMSG = (OPT) Variable to return UIF of inbound msg (PBR)
;If tranceiver passed INXDST, execute it. Otherwise do DEST.
X $S($L($G(INXDST)):INXDST,1:"D DEST")
I '$G(INDSTP) D Q
.S MSG(1)="Message "_MESSID_" has no destination",MSG(2)=$E(INMSH,1,250)
.D ERRADD^INHUSEN3(.INERR,.MSG)
.S INVL=2
;pointer needed for most functions, NAME needed for NEW^INHD.
S:'$D(INDST) INDST=$P(^INRHD(INDSTP,0),U)
D STORE(INDST,ING,.INMSG)
Q
ACK(INIP,INVL,INSEND,INRONLY) ;Process commit ack and quit back to transceiver routine.
;Input:
; INIP - Array of parameters from gallery
; INVL - True - invalid, "" no error
; INSEND - ien of UIF
; INRONLY - 1 Receive only send no ack, 0 receive then send ack
N CND
;If receive only then we don't want to send ack
Q:INRONLY +$G(INVL)
S CND=$P(INMSH,INDELIM,15)
;Overide accept ack condition
I INIP("AAC")'="" S CND=INIP("AAC")
N STAT,CERR
I CND'="NE" D
.;If CND has value, msg is in enhanced HL7 mode
.I $L(CND) D Q
..I 'INVL,"SU,AL"[CND S CERR=$$CACK(.INSEND,"CA",ORIGID,.INERR,EXPCT) Q
..I INVL,"AL,ER"[CND S CERR=$$CACK(.INSEND,"CR",ORIGID,.INERR,EXPCT) Q
.I INVL>1,'$L($P($G(INMSH),U,16)) S CERR=$$CACK(.INSEND,"AR",ORIGID,.INERR,EXPCT)
Q $S($G(CERR)>INVL:CERR,1:INVL)
;
CACK(INSEND,STAT,ORIGID,TXT,EXPCT,DELAY,INERR,INA,INDA) ;Send accept (commit) acknowledgement
; STAT = ack status (commit ack: CA, CR, CE) MSA-1
; ORIGID = (REQ) MESSID of Incoming message being acknowledged MSA-2
; TXT = Text message MSA-3
; EXPCT = Expected sequence number MSA-4
; DELAY = Delayed Ack type MSA-5
; INERR = Error condition MSA-6
; INA = (OPT) The INA variable array.
; INDA = (OPT) The INDA array of ien entry numbers.
; NOTE: INDA and INA are not normally needed for commit acks, but
; may be used is specialized situations.
;
; Output:
; INSEND = ien of accept ack in ^INTHU.
;
; Returns:
; 0=success, 1= non-fatal. Inability to return ack is non-fatal to msg.
;
N INA,TRT,UIF,DA,DIE,DR,DIC,SCR,DEST,Z
I '$D(ORIGID) D DISPLAY^INTSUT1("Unable to determine originating message ID") Q 1
;Get transaction type
S TRT=INIP("AATT") I 'TRT D DISPLAY^INTSUT1("No Transaction Type designated for commit ack.") Q 1
S INA("INSTAT")=STAT,INA("INORIGID")=ORIGID
S:$D(EXPCT) INA("INEXPSEQ")=EXPCT
S:$D(TXT) INA("INACKTXT")=$S($L($G(TXT)):TXT,$L($Q(TXT)):@$Q(TXT),1:"")
S:$D(DELAY) INA("INDELAY")=DELAY
;INERR may be top level, or it may be an array. Take top if it exists.
I $D(INERR) S INA("INACKERR")=$S($L($G(INERR)):INERR,$L($Q(INERR)):@$Q(INERR),1:"")
;Following code copied from ACK^INHF and modified.
S SCR=$P(^INRHT(TRT,0),U,3),DEST=+$P(^INRHT(TRT,0),U,2)
I $D(^INRHS(+SCR)),$D(^INRHD(+DEST)) D
.;Set INDA array. Normally, Ack message has value of -1.
.S INDA=$S('$D(INDA):-1,INDA="":-1,1:INDA)
.X "S ER=$$^IS"_$E(SCR#100000+100000,2,6)_"("_TRT_",.INDA,.INA,"_DEST_","_0_")"
;The script leaves UIF variable after execution
I '$D(UIF) D DISPLAY^INTSUT1("Unable to create ack message for "_ORIGID) Q 1
;Unless ack went on queue (unlikely), set ack status to "complete"
I UIF>0 D ULOG^INHU(UIF,"C")
S INSEND=$S(UIF>0:UIF,1:"")
Q 0
CACKLOG(INCAACK,INCAORIG,INCASTAT,INCANAKM) ;Log an accept (commit) acknowledgement to a message
;INCAACK (reqd) = UIF entry # of current message
;INCAORIG (reqd) = ID of message to acknowledge
;INCASTAT (reqd) = ack status (CA,CE or CR)
;INCANAKM (opt) = message to store if NAK
;
N AMID,MESS,STAT,DIE,DR,DA
;Mark the accept ack complete before updating original message
S DIE="^INTHU(",DA=INCAACK,DR=".03///C;.09////"_$$NOW^UTDT D
.;Temporary stack to be sure variable integrety later on
.N INCAACK,INCAORIG,INCASTAT,INCANAKM D ^DIE
Q:'$L($G(INCAORIG))
;find original message
S AMID=$O(^INTHU("C",INCAORIG,0)) Q:'AMID
S $P(^INTHU(INCAACK,0),U,7)=AMID
S $P(^INTHU(AMID,0),U,18)=INCAACK,STAT=$S(INCASTAT="CA":"A",1:"E")
I STAT="A" S MESS(1)="Commit Acknowledge received with CA status"
;If originating message does not require application ack, upgrade
;successful status to C
I STAT="A",'$P(^INTHU(AMID,0),U,4) S STAT="C"
S DIE="^INTHU(",DA=AMID,DR=".03///"_STAT D ^DIE
I STAT="E" S MESS(1)="Negative Commit Acknowledge received" S:$G(INCANAKM)]"" MESS(2)=INCANAKM
S MESS(1)=MESS(1)_" in transaction with ID="_$P(^INTHU(INCAACK,0),U,5)
D ULOG^INHU(AMID,STAT,.MESS)
D ULOG^INHU(INCAACK,"C",.MESS)
Q
STORE(INDST,ING,INMSG) ;Store incoming xmission in the Universal Interface file
;Input:
; INDST = string name of entry in Int. Dest. File
; ING = array to be stored
;
;Output:
; INMSG = UIF of new msg, or -1 if creation failed.
;
N SOURCE,DIE,DR
;Create a unique INCOMING MESSAGE ID for field 2.1 of the UIF
;in format "ORIGID-XX-NN" where XX is 1st two letters from background
;process file and NN increments from 1.
;Set PN to piece # of the # (If ORIGID already has "-"
;embedded, need to place XX-NN further than pieces 2 and 3)
S ORIGID2=ORIGID_"-TU-1" D:$D(^INTHU("C",ORIGID2))
. N USED,PN S PN=$L(ORIGID,"-")+2
. F USED=2:1 S $P(ORIGID2,"-",PN)=USED Q:'$D(^INTHU("C",ORIGID2))
S SOURCE="Incoming message from transceiver the Test Utility"
;Create msg in UIF using modified originating messid
S INMSG=$$NEW^INHD(ORIGID2,INDST,SOURCE,ING,0,"I",1)
;If the input driver returns a -1 then the transaction was rejected
I INMSG<0 S INERR="Message "_MESSID_" was rejected by the GIS",INVL=2 Q
;store original message id (will also be in "D" x-ref)
S DA=+INMSG,DIE="^INTHU(",DR="2.1///"_ORIGID D ^DIE
Q
DEST ;Find destination for incoming message (not incoming ack?).
;INPUT:
;OUTPUT:
;--INDSTP - Pointer to destination file
;
I '$D(^INRHD("B","TEST UTILITY DEST STUB - IN")) D DISPLAY^INTSUT1("TEST UTILITY DEST STUB - IN missing, destination not set")
S INDSTP=$O(^INRHD("B","TEST UTILITY DEST STUB - IN",""))
Q
INTSUSN ; DGH JPD; 3 Jun 96 09:54; Enhanced functions and utilities
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
IN(INIP,ING,INDEST,INSEND,INERR,INXDST,INMSG,INMSASTA,INRONLY) ;Process incoming
+1 ;Copied from INHUSEN
+2 ;Verify all needed data is present
+3 ;Store xmission (if verified but not if it is for housekeeping)
+4 ;Create receipt ack as specified in MSH.
+5 ;
+6 ;Input:
+7 ; INIP - array of parameters
+8 ; ING = (REQ) Variable array/global containing lines from msg.
+9 ; INDEST = Array of valid destinations in format
+10 ; INDEST(type) = .01 field of destination. This is not
+11 ; required if processing incoming ACKS, but will generate
+12 ; an error if processing incoming msg with no destination.
+13 ; INSEND = (OPT) UIF entry(ies) of msg which needs to be sent by
+14 ; tranceiver back to other system.
+15 ; This may be an accept ack
+16 ; INERR = (OPT) Variable to return error msg. (PBR)
+17 ; INXDST = (OPT) EXecutable code to identify the destination for
+18 ; msgs which won't be uniquely identified by INTYP_INEVN.
+19 ; The executable must return the ien in the variable INDSTP.
+20 ; INMSG = (OPT) Variable to return UIF of inbound msg (PBR)
+21 ; INMSASTA = (OPT) Variable to return MSA-1 ack status (PBR)
+22 ; INRONLY - 1 Receive only send no ack, 0 receive then send ack
+23 ;
+24 ;Returns:
+25 ; 0 = success, 1 = non-fatal error, 2 = fatal error
+26 ;
+27 NEW ORIGID,ORIGID2,MESSID,INVL,STAT,EXPCT,INDST,INDSTP,INMSH,INTYP
+28 NEW INEVN,Z,ACKMSG
+29 ;Note: INDST and INDSTP are variables for the Dest. file for the
+30 ;incoming msg. This may differ from the destination of the
+31 ;background process.
+32 SET (EXPCT,INSEND,INERR)=""
+33 ;First verify MSH, get msg type and event type. If invalid, quit
+34 IF $$VERIF^INTSUSN1(ING,.INMSH,.INTYP,.INEVN,.INERR)
QUIT 2
+35 SET (MESSID,ORIGID)=$PIECE(INMSH,INDELIM,10)
+36 ;
+37 ;is message ID valid
+38 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
+39 ;
+40 ;is message type invalid
+41 IF INTYP=""
Begin DoDot:1
+42 SET MSG(1)="Unable to determine message type"
SET MSG(2)=$EXTRACT(INMSH,1,250)
+43 DO ERRADD^INHUSEN3(.INERR,.MSG)
End DoDot:1
QUIT $$ACK(.INIP,2,.INSEND,INRONLY)
+44 ;
+45 SET INVL=""
+46 ; If ack,destination only needed for App. ack.
+47 IF INTYP["ACK"
DO TYPEACK(ING,.INVL,.INMSG)
+48 ; If incoming is a msg not an ack, must determine tran. type.
+49 IF INTYP'["ACK"
DO TYPNOTAK(ING,.INXDST,.INDSTP,.INDST,.INVL,.INMSG)
+50 QUIT $$ACK(.INIP,.INVL,.INSEND,INRONLY)
+51 ;
TYPEACK(ING,INVL,INMSG) ;Type was ack
+1 ;Input:
+2 ; ING = Variable array/global containing lines from msg.
+3 ;Output:
+4 ; INVL - True - invalid, "" no error
+5 ; INMSG = (OPT) Variable to return UIF of inbound msg (PBR)
+6 ;Local
+7 ; INMSGSTAT -
+8 ; AA - Application Accept or No MSA segment Accept
+9 ; AE - Application Error
+10 ; AR - Application Reject
+11 ; CA - Commit Accept Ack
+12 ; CE - Commit Error
+13 ; CR - Commit Reject
+14 ;
+15 NEW INMSASTA,EXPCT,INDST,INDSTP,ACKMSG
+16 SET INVL=$$ACKIN^INHUSEN2(ING,.INMSASTA,.EXPCT,.INDST,.INDSTP,.ACKMSG,.INERR)
+17 ;quit if invalid
+18 IF INVL
QUIT
+19 ;If application ack and no destination
+20 IF $EXTRACT($GET(INMSASTA))="A"
IF '$GET(INDSTP)
Begin DoDot:1
+21 SET MSG(1)="Ack "_MESSID_" has no destination"
SET MSG(2)=$EXTRACT(INMSH,1,250)
+22 DO ERRADD^INHUSEN3(.INERR,.MSG)
+23 SET INVL=2
End DoDot:1
QUIT
+24 DO STORE(INDST,ING,.INMSG)
+25 ;Update parent for commit acks
+26 IF $EXTRACT($GET(INMSASTA))="C"
IF INMSG>0
DO CACKLOG(INMSG,ACKMSG,INMSASTA,.INERR)
+27 QUIT
TYPNOTAK(ING,INXDST,INDSTP,INDST,INVL,INMSG) ;Type was not an ack
+1 ;Input:
+2 ; ING = Variable array/global containing lines from msg.
+3 ; INXDST = eXecutable code to identify the destination
+4 ; INDSTP - Destination pointer
+5 ; INDST - Destination pointer
+6 ; INVL - True - invalid, "" no error
+7 ; INMSG = (OPT) Variable to return UIF of inbound msg (PBR)
+8 ;If tranceiver passed INXDST, execute it. Otherwise do DEST.
+9 XECUTE $SELECT($LENGTH($GET(INXDST)):INXDST,1:"D DEST")
+10 IF '$GET(INDSTP)
Begin DoDot:1
+11 SET MSG(1)="Message "_MESSID_" has no destination"
SET MSG(2)=$EXTRACT(INMSH,1,250)
+12 DO ERRADD^INHUSEN3(.INERR,.MSG)
+13 SET INVL=2
End DoDot:1
QUIT
+14 ;pointer needed for most functions, NAME needed for NEW^INHD.
+15 IF '$DATA(INDST)
SET INDST=$PIECE(^INRHD(INDSTP,0),U)
+16 DO STORE(INDST,ING,.INMSG)
+17 QUIT
ACK(INIP,INVL,INSEND,INRONLY) ;Process commit ack and quit back to transceiver routine.
+1 ;Input:
+2 ; INIP - Array of parameters from gallery
+3 ; INVL - True - invalid, "" no error
+4 ; INSEND - ien of UIF
+5 ; INRONLY - 1 Receive only send no ack, 0 receive then send ack
+6 NEW CND
+7 ;If receive only then we don't want to send ack
+8 IF INRONLY
QUIT +$GET(INVL)
+9 SET CND=$PIECE(INMSH,INDELIM,15)
+10 ;Overide accept ack condition
+11 IF INIP("AAC")'=""
SET CND=INIP("AAC")
+12 NEW STAT,CERR
+13 IF CND'="NE"
Begin DoDot:1
+14 ;If CND has value, msg is in enhanced HL7 mode
+15 IF $LENGTH(CND)
Begin DoDot:2
+16 IF 'INVL
IF "SU,AL"[CND
SET CERR=$$CACK(.INSEND,"CA",ORIGID,.INERR,EXPCT)
QUIT
+17 IF INVL
IF "AL,ER"[CND
SET CERR=$$CACK(.INSEND,"CR",ORIGID,.INERR,EXPCT)
QUIT
End DoDot:2
QUIT
+18 IF INVL>1
IF '$LENGTH($PIECE($GET(INMSH),U,16))
SET CERR=$$CACK(.INSEND,"AR",ORIGID,.INERR,EXPCT)
End DoDot:1
+19 QUIT $SELECT($GET(CERR)>INVL:CERR,1:INVL)
+20 ;
CACK(INSEND,STAT,ORIGID,TXT,EXPCT,DELAY,INERR,INA,INDA) ;Send accept (commit) acknowledgement
+1 ; STAT = ack status (commit ack: CA, CR, CE) MSA-1
+2 ; ORIGID = (REQ) MESSID of Incoming message being acknowledged MSA-2
+3 ; TXT = Text message MSA-3
+4 ; EXPCT = Expected sequence number MSA-4
+5 ; DELAY = Delayed Ack type MSA-5
+6 ; INERR = Error condition MSA-6
+7 ; INA = (OPT) The INA variable array.
+8 ; INDA = (OPT) The INDA array of ien entry numbers.
+9 ; NOTE: INDA and INA are not normally needed for commit acks, but
+10 ; may be used is specialized situations.
+11 ;
+12 ; Output:
+13 ; INSEND = ien of accept ack in ^INTHU.
+14 ;
+15 ; Returns:
+16 ; 0=success, 1= non-fatal. Inability to return ack is non-fatal to msg.
+17 ;
+18 NEW INA,TRT,UIF,DA,DIE,DR,DIC,SCR,DEST,Z
+19 IF '$DATA(ORIGID)
DO DISPLAY^INTSUT1("Unable to determine originating message ID")
QUIT 1
+20 ;Get transaction type
+21 SET TRT=INIP("AATT")
IF 'TRT
DO DISPLAY^INTSUT1("No Transaction Type designated for commit ack.")
QUIT 1
+22 SET INA("INSTAT")=STAT
SET INA("INORIGID")=ORIGID
+23 IF $DATA(EXPCT)
SET INA("INEXPSEQ")=EXPCT
+24 IF $DATA(TXT)
SET INA("INACKTXT")=$SELECT($LENGTH($GET(TXT)):TXT,$LENGTH($QUERY(TXT)):@$QUERY(TXT),1:"")
+25 IF $DATA(DELAY)
SET INA("INDELAY")=DELAY
+26 ;INERR may be top level, or it may be an array. Take top if it exists.
+27 IF $DATA(INERR)
SET INA("INACKERR")=$SELECT($LENGTH($GET(INERR)):INERR,$LENGTH($QUERY(INERR)):@$QUERY(INERR),1:"")
+28 ;Following code copied from ACK^INHF and modified.
+29 SET SCR=$PIECE(^INRHT(TRT,0),U,3)
SET DEST=+$PIECE(^INRHT(TRT,0),U,2)
+30 IF $DATA(^INRHS(+SCR))
IF $DATA(^INRHD(+DEST))
Begin DoDot:1
+31 ;Set INDA array. Normally, Ack message has value of -1.
+32 SET INDA=$SELECT('$DATA(INDA):-1,INDA="":-1,1:INDA)
+33 XECUTE "S ER=$$^IS"_$EXTRACT(SCR#100000+100000,2,6)_"("_TRT_",.INDA,.INA,"_DEST_","_0_")"
End DoDot:1
+34 ;The script leaves UIF variable after execution
+35 IF '$DATA(UIF)
DO DISPLAY^INTSUT1("Unable to create ack message for "_ORIGID)
QUIT 1
+36 ;Unless ack went on queue (unlikely), set ack status to "complete"
+37 IF UIF>0
DO ULOG^INHU(UIF,"C")
+38 SET INSEND=$SELECT(UIF>0:UIF,1:"")
+39 QUIT 0
CACKLOG(INCAACK,INCAORIG,INCASTAT,INCANAKM) ;Log an accept (commit) acknowledgement to a message
+1 ;INCAACK (reqd) = UIF entry # of current message
+2 ;INCAORIG (reqd) = ID of message to acknowledge
+3 ;INCASTAT (reqd) = ack status (CA,CE or CR)
+4 ;INCANAKM (opt) = message to store if NAK
+5 ;
+6 NEW AMID,MESS,STAT,DIE,DR,DA
+7 ;Mark the accept ack complete before updating original message
+8 SET DIE="^INTHU("
SET DA=INCAACK
SET DR=".03///C;.09////"_$$NOW^UTDT
Begin DoDot:1
+9 ;Temporary stack to be sure variable integrety later on
+10 NEW INCAACK,INCAORIG,INCASTAT,INCANAKM
DO ^DIE
End DoDot:1
+11 IF '$LENGTH($GET(INCAORIG))
QUIT
+12 ;find original message
+13 SET AMID=$ORDER(^INTHU("C",INCAORIG,0))
IF 'AMID
QUIT
+14 SET $PIECE(^INTHU(INCAACK,0),U,7)=AMID
+15 SET $PIECE(^INTHU(AMID,0),U,18)=INCAACK
SET STAT=$SELECT(INCASTAT="CA":"A",1:"E")
+16 IF STAT="A"
SET MESS(1)="Commit Acknowledge received with CA status"
+17 ;If originating message does not require application ack, upgrade
+18 ;successful status to C
+19 IF STAT="A"
IF '$PIECE(^INTHU(AMID,0),U,4)
SET STAT="C"
+20 SET DIE="^INTHU("
SET DA=AMID
SET DR=".03///"_STAT
DO ^DIE
+21 IF STAT="E"
SET MESS(1)="Negative Commit Acknowledge received"
IF $GET(INCANAKM)]""
SET MESS(2)=INCANAKM
+22 SET MESS(1)=MESS(1)_" in transaction with ID="_$PIECE(^INTHU(INCAACK,0),U,5)
+23 DO ULOG^INHU(AMID,STAT,.MESS)
+24 DO ULOG^INHU(INCAACK,"C",.MESS)
+25 QUIT
STORE(INDST,ING,INMSG) ;Store incoming xmission in the Universal Interface file
+1 ;Input:
+2 ; INDST = string name of entry in Int. Dest. File
+3 ; ING = array to be stored
+4 ;
+5 ;Output:
+6 ; INMSG = UIF of new msg, or -1 if creation failed.
+7 ;
+8 NEW SOURCE,DIE,DR
+9 ;Create a unique INCOMING MESSAGE ID for field 2.1 of the UIF
+10 ;in format "ORIGID-XX-NN" where XX is 1st two letters from background
+11 ;process file and NN increments from 1.
+12 ;Set PN to piece # of the # (If ORIGID already has "-"
+13 ;embedded, need to place XX-NN further than pieces 2 and 3)
+14 SET ORIGID2=ORIGID_"-TU-1"
IF $DATA(^INTHU("C",ORIGID2))
Begin DoDot:1
+15 NEW USED,PN
SET PN=$LENGTH(ORIGID,"-")+2
+16 FOR USED=2:1
SET $PIECE(ORIGID2,"-",PN)=USED
IF '$DATA(^INTHU("C",ORIGID2))
QUIT
End DoDot:1
+17 SET SOURCE="Incoming message from transceiver the Test Utility"
+18 ;Create msg in UIF using modified originating messid
+19 SET INMSG=$$NEW^INHD(ORIGID2,INDST,SOURCE,ING,0,"I",1)
+20 ;If the input driver returns a -1 then the transaction was rejected
+21 IF INMSG<0
SET INERR="Message "_MESSID_" was rejected by the GIS"
SET INVL=2
QUIT
+22 ;store original message id (will also be in "D" x-ref)
+23 SET DA=+INMSG
SET DIE="^INTHU("
SET DR="2.1///"_ORIGID
DO ^DIE
+24 QUIT
DEST ;Find destination for incoming message (not incoming ack?).
+1 ;INPUT:
+2 ;OUTPUT:
+3 ;--INDSTP - Pointer to destination file
+4 ;
+5 IF '$DATA(^INRHD("B","TEST UTILITY DEST STUB - IN"))
DO DISPLAY^INTSUT1("TEST UTILITY DEST STUB - IN missing, destination not set")
+6 SET INDSTP=$ORDER(^INRHD("B","TEST UTILITY DEST STUB - IN",""))
+7 QUIT
