INHUSEN2 ; DGH ; 10 Jul 97 17:29; More enhanced processing functions
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
ACKIN(GBL,MSASTAT,INEXPCT,INDST,INDSTP,ACKMSG,INERR) ;Returns variables for incoming acks
;INPUT
;--GBL = global being checked, can be ^INTHU
;--------If numeric, assumed to be IEN for ^INTHU
;--------If non-numeric, assumed to be global reference
;--MSASTAT = Status, MSA-2. (PASS BY REFERENCE)
;--INEXPCTP = Expected sequence #, MSA-5 (PBR)
;--INDST = Destination string (if application ack) (PBR)
;--INDSTP = Destination pointer (if application ack) (PBR)
;--ACKMSG = Originating message being acked (PBR)
;--INERR = error message array (PBR)
;-MESSID = message ID (is not a parameter, value set in INHUSEN)
;RETURN
;0=success 1=non-fatal error 2=fatal error
N INMSA,LCT,X,UIF,INTT,ACKTT,I
I GBL S LCT=1 F I=1:1:5 D Q:$D(INMSA)
. D GETLINE^INHOU(GBL,.LCT,.X) S:$P(X,INDELIM)="MSA" INMSA=X
I 'GBL F I=2:1:5 D Q:$D(INMSA)
. S X=$G(@GBL@(I)) S:$P(X,INDELIM)="MSA" INMSA=X
;For following 3 errors, be sure MSASTAT, INDSTP and INDST are set so
;incoming ack is filed. Let output controller log error.
I '$D(INMSA) D ERRADD^INHUSEN3(.INERR,"Ack message "_MESSID_" does not have an MSA segment") S MSASTAT="AA" D DEFAULT Q 0
S MSASTAT=$P(INMSA,INDELIM,2),ACKMSG=$P(INMSA,INDELIM,3),INEXPCT=$P(INMSA,INDELIM,5)
I ACKMSG="" D ERRADD^INHUSEN3(.INERR,"Ack message "_MESSID_" does not identify an orginating message"),DEFAULT Q 0
I '$D(^INTHU("C",ACKMSG)) D ERRADD^INHUSEN3(.INERR,"Acknowledged message "_ACKMSG_" can not be found for ack "_ORIGID),DEFAULT Q 0
;If this is a commit ack, use generic destination (required to STORE).
I $E(MSASTAT)="C" S INDST="INCOMING ACK" Q 0
;If application ack, destination must be passed in with tranceiver???
;If tranceiver passed INXDST, execute it. Otherwise call DEST.
;NOTE: For time being, APCOTS is sending AA instead of CA. Need
;to allow generic INDST="INCOMING ACK" to test
;***commented during sir 25459
X:$L($G(INXDST)) INXDST
;But don't log error (that's what the SIR was about). Instead
;fall through to default if there is no INDSTP
I $L($G(INDSTP)) D Q 0
.;pointer needed for most functions, NAME needed for NEW^INHD.
.S:'$L($G(INDST)) INDST=$P($G(^INRHD(INDSTP,0)),U)
;
;;;;or, should we use originating TT pointer to ack for incoming
;;;;as well as outgoing messages?
ALT ;If application ack, find destination based on originating message
S UIF=$O(^INTHU("C",ACKMSG,"")),INTT=$P(^INTHU(UIF,0),U,11)
;If originating message does not designate an acknowledge script,
;use generic incoming ack.
I 'INTT D ERRADD^INHUSEN3(.INERR,"Originating message has no Transaction Type") Q 1
S ACKTT=$P(^INRHT(INTT,0),U,9) I 'ACKTT D DEFAULT Q 0
S INDSTP=$P(^INRHT(ACKTT,0),U,2) I INDSTP="" D DEFAULT Q 0
S INDST=$P($G(^INRHD(INDSTP,0)),U)
Q 0
;
DEFAULT ;set default destination if incoming ack is missing needed information
S INDST="INCOMING ACK",INDSTP=$O(^INRHD("B",INDST,""))
Q
;
CACK(INDSTR,STAT,ORIGID,TXT,EXPCT,DELAY,INERR,INQUE,INA,INDA) ;Send accept (commit) acknowledgement
;Commit ack does not go through output processor. The pointer to the
;commit ack TT is in the Int. Destination File and is independent of
;the originating message TT.
;-INDSTR = (REQ) Receiver dest pointer -- $P(^INTHPC(INBPN,0),U)
;-ORIGID = (REQ) MESSID of Incoming message being acknowledged -- MSA-2
;-STAT = ack status (commit ack: CA, CR, CE) --MSA-1
;-TXT = Text message -- MSA-3
;-EXPCT = Expected sequence number -- MSA-4
;-DELAY = Delayed Ack type -- MSA-5
;-INERR = Error condition -- MSA-6
;-INQUE = (OPT) If set to 1 (default) commit ack will not be queued
; into ^INLHSCH. This is normal for a commit ack because
; the tranceiver will usually send back to other system.
; If set to 0, the ack will be entered into INLHSCH.
;-INDA = (OPT) The INDA array of ien entry numbers.
;-INA = (OPT) The INA variable array.
;--NOTE: INDA and INA are not normally needed for commit acks, but
; may be used is specialized situations.
;RETURN
;-0=success, 1= non-fatal. Inability to return ack is non-fatal to msg.
;-INSEND = ien of accept ack in ^INTHU.
N INA,TRT,UIF,DA,DIE,DR,DIC,SCR,DEST,Z,INTNAME
I '$D(ORIGID) D ENR^INHE(INBPN,"Unable to determine originating message ID") Q 1
I '$D(^INRHD(INDSTR)) D ENR^INHE(INBPN,"Invalid destination in message "_ORIGID) Q 1
S TRT=$P(^INRHD(INDSTR,0),U,10) I 'TRT D ENR^INHE(INBPN,"No Transaction Type designated for commit ack for destination "_$P(^INRHD(INDSTR,0),U)) 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.
D
.S SCR=$P(^INRHT(TRT,0),U,3),DEST=+$P(^INRHT(TRT,0),U,2),INTNAME=$P(^INRHT(TRT,0),U)
.Q:'SCR!'DEST Q:'$D(^INRHS(SCR))!'$D(^INRHD(DEST))
.;Determine if this should go into output queue. Normally not,
.S INQUE=$S('$D(INQUE):1,INQUE=0:0,1:1)
.;Set INDA array. Normally, Ack message has value of -1.
.S INDA=$S('$D(INDA):-1,INDA="":-1,1:INDA)
.;Start transaction audit
.D:$D(XUAUDIT) TTSTRT^XUSAUD($G(INTNAME),"",$P($G(^INTHPC(INBPN,0)),U),$G(INHSRVR),"SCRIPT")
.S Z="S ER=$$^IS"_$E(SCR#100000+100000,2,6)_"("_TRT_",.INDA,.INA,"_DEST_","_INQUE_")"
.X Z
.;Stop transaction audit with one of the following
.D:$D(XUAUDIT) TTSTP^XUSAUD(0)
;
;The script leaves UIF variable after execution
I '$D(UIF) D ENR^INHE(INBPN,"Unable to create ack message for "_ORIGID) Q 1
;Unless ack went on queue (unlikely), set ack status to "complete"
I INQUE,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
;Modified version of ACKLOG^INHU. Will store status in originating
;message of "A"=Accept ack received or "E"=Error
;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
;
Q:'$D(^INTHU(+$G(INCAACK)))
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
;
;
;
;
INHUSEN2 ; DGH ; 10 Jul 97 17:29; More enhanced processing functions
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
ACKIN(GBL,MSASTAT,INEXPCT,INDST,INDSTP,ACKMSG,INERR) ;Returns variables for incoming acks
+1 ;INPUT
+2 ;--GBL = global being checked, can be ^INTHU
+3 ;--------If numeric, assumed to be IEN for ^INTHU
+4 ;--------If non-numeric, assumed to be global reference
+5 ;--MSASTAT = Status, MSA-2. (PASS BY REFERENCE)
+6 ;--INEXPCTP = Expected sequence #, MSA-5 (PBR)
+7 ;--INDST = Destination string (if application ack) (PBR)
+8 ;--INDSTP = Destination pointer (if application ack) (PBR)
+9 ;--ACKMSG = Originating message being acked (PBR)
+10 ;--INERR = error message array (PBR)
+11 ;-MESSID = message ID (is not a parameter, value set in INHUSEN)
+12 ;RETURN
+13 ;0=success 1=non-fatal error 2=fatal error
+14 NEW INMSA,LCT,X,UIF,INTT,ACKTT,I
+15 IF GBL
SET LCT=1
FOR I=1:1:5
Begin DoDot:1
+16 DO GETLINE^INHOU(GBL,.LCT,.X)
IF $PIECE(X,INDELIM)="MSA"
SET INMSA=X
End DoDot:1
IF $DATA(INMSA)
QUIT
+17 IF 'GBL
FOR I=2:1:5
Begin DoDot:1
+18 SET X=$GET(@GBL@(I))
IF $PIECE(X,INDELIM)="MSA"
SET INMSA=X
End DoDot:1
IF $DATA(INMSA)
QUIT
+19 ;For following 3 errors, be sure MSASTAT, INDSTP and INDST are set so
+20 ;incoming ack is filed. Let output controller log error.
+21 IF '$DATA(INMSA)
DO ERRADD^INHUSEN3(.INERR,"Ack message "_MESSID_" does not have an MSA segment")
SET MSASTAT="AA"
DO DEFAULT
QUIT 0
+22 SET MSASTAT=$PIECE(INMSA,INDELIM,2)
SET ACKMSG=$PIECE(INMSA,INDELIM,3)
SET INEXPCT=$PIECE(INMSA,INDELIM,5)
+23 IF ACKMSG=""
DO ERRADD^INHUSEN3(.INERR,"Ack message "_MESSID_" does not identify an orginating message")
DO DEFAULT
QUIT 0
+24 IF '$DATA(^INTHU("C",ACKMSG))
DO ERRADD^INHUSEN3(.INERR,"Acknowledged message "_ACKMSG_" can not be found for ack "_ORIGID)
DO DEFAULT
QUIT 0
+25 ;If this is a commit ack, use generic destination (required to STORE).
+26 IF $EXTRACT(MSASTAT)="C"
SET INDST="INCOMING ACK"
QUIT 0
+27 ;If application ack, destination must be passed in with tranceiver???
+28 ;If tranceiver passed INXDST, execute it. Otherwise call DEST.
+29 ;NOTE: For time being, APCOTS is sending AA instead of CA. Need
+30 ;to allow generic INDST="INCOMING ACK" to test
+31 ;***commented during sir 25459
+32 IF $LENGTH($GET(INXDST))
XECUTE INXDST
+33 ;But don't log error (that's what the SIR was about). Instead
+34 ;fall through to default if there is no INDSTP
+35 IF $LENGTH($GET(INDSTP))
Begin DoDot:1
+36 ;pointer needed for most functions, NAME needed for NEW^INHD.
+37 IF '$LENGTH($GET(INDST))
SET INDST=$PIECE($GET(^INRHD(INDSTP,0)),U)
End DoDot:1
QUIT 0
+38 ;
+39 ;;;;or, should we use originating TT pointer to ack for incoming
+40 ;;;;as well as outgoing messages?
ALT ;If application ack, find destination based on originating message
+1 SET UIF=$ORDER(^INTHU("C",ACKMSG,""))
SET INTT=$PIECE(^INTHU(UIF,0),U,11)
+2 ;If originating message does not designate an acknowledge script,
+3 ;use generic incoming ack.
+4 IF 'INTT
DO ERRADD^INHUSEN3(.INERR,"Originating message has no Transaction Type")
QUIT 1
+5 SET ACKTT=$PIECE(^INRHT(INTT,0),U,9)
IF 'ACKTT
DO DEFAULT
QUIT 0
+6 SET INDSTP=$PIECE(^INRHT(ACKTT,0),U,2)
IF INDSTP=""
DO DEFAULT
QUIT 0
+7 SET INDST=$PIECE($GET(^INRHD(INDSTP,0)),U)
+8 QUIT 0
+9 ;
DEFAULT ;set default destination if incoming ack is missing needed information
+1 SET INDST="INCOMING ACK"
SET INDSTP=$ORDER(^INRHD("B",INDST,""))
+2 QUIT
+3 ;
CACK(INDSTR,STAT,ORIGID,TXT,EXPCT,DELAY,INERR,INQUE,INA,INDA) ;Send accept (commit) acknowledgement
+1 ;Commit ack does not go through output processor. The pointer to the
+2 ;commit ack TT is in the Int. Destination File and is independent of
+3 ;the originating message TT.
+4 ;-INDSTR = (REQ) Receiver dest pointer -- $P(^INTHPC(INBPN,0),U)
+5 ;-ORIGID = (REQ) MESSID of Incoming message being acknowledged -- MSA-2
+6 ;-STAT = ack status (commit ack: CA, CR, CE) --MSA-1
+7 ;-TXT = Text message -- MSA-3
+8 ;-EXPCT = Expected sequence number -- MSA-4
+9 ;-DELAY = Delayed Ack type -- MSA-5
+10 ;-INERR = Error condition -- MSA-6
+11 ;-INQUE = (OPT) If set to 1 (default) commit ack will not be queued
+12 ; into ^INLHSCH. This is normal for a commit ack because
+13 ; the tranceiver will usually send back to other system.
+14 ; If set to 0, the ack will be entered into INLHSCH.
+15 ;-INDA = (OPT) The INDA array of ien entry numbers.
+16 ;-INA = (OPT) The INA variable array.
+17 ;--NOTE: INDA and INA are not normally needed for commit acks, but
+18 ; may be used is specialized situations.
+19 ;RETURN
+20 ;-0=success, 1= non-fatal. Inability to return ack is non-fatal to msg.
+21 ;-INSEND = ien of accept ack in ^INTHU.
+22 NEW INA,TRT,UIF,DA,DIE,DR,DIC,SCR,DEST,Z,INTNAME
+23 IF '$DATA(ORIGID)
DO ENR^INHE(INBPN,"Unable to determine originating message ID")
QUIT 1
+24 IF '$DATA(^INRHD(INDSTR))
DO ENR^INHE(INBPN,"Invalid destination in message "_ORIGID)
QUIT 1
+25 SET TRT=$PIECE(^INRHD(INDSTR,0),U,10)
IF 'TRT
DO ENR^INHE(INBPN,"No Transaction Type designated for commit ack for destination "_$PIECE(^INRHD(INDSTR,0),U))
QUIT 1
+26 SET INA("INSTAT")=STAT
SET INA("INORIGID")=ORIGID
+27 IF $DATA(EXPCT)
SET INA("INEXPSEQ")=EXPCT
+28 IF $DATA(TXT)
SET INA("INACKTXT")=$SELECT($LENGTH($GET(TXT)):TXT,$LENGTH($QUERY(TXT)):@$QUERY(TXT),1:"")
+29 IF $DATA(DELAY)
SET INA("INDELAY")=DELAY
+30 ;INERR may be top level, or it may be an array. Take top if it exists.
+31 IF $DATA(INERR)
SET INA("INACKERR")=$SELECT($LENGTH($GET(INERR)):INERR,$LENGTH($QUERY(INERR)):@$QUERY(INERR),1:"")
+32 ;Following code copied from ACK^INHF and modified.
+33 Begin DoDot:1
+34 SET SCR=$PIECE(^INRHT(TRT,0),U,3)
SET DEST=+$PIECE(^INRHT(TRT,0),U,2)
SET INTNAME=$PIECE(^INRHT(TRT,0),U)
+35 IF 'SCR!'DEST
QUIT
IF '$DATA(^INRHS(SCR))!'$DATA(^INRHD(DEST))
QUIT
+36 ;Determine if this should go into output queue. Normally not,
+37 SET INQUE=$SELECT('$DATA(INQUE):1,INQUE=0:0,1:1)
+38 ;Set INDA array. Normally, Ack message has value of -1.
+39 SET INDA=$SELECT('$DATA(INDA):-1,INDA="":-1,1:INDA)
+40 ;Start transaction audit
+41 IF $DATA(XUAUDIT)
DO TTSTRT^XUSAUD($GET(INTNAME),"",$PIECE($GET(^INTHPC(INBPN,0)),U),$GET(INHSRVR),"SCRIPT")
+42 SET Z="S ER=$$^IS"_$EXTRACT(SCR#100000+100000,2,6)_"("_TRT_",.INDA,.INA,"_DEST_","_INQUE_")"
+43 XECUTE Z
+44 ;Stop transaction audit with one of the following
+45 IF $DATA(XUAUDIT)
DO TTSTP^XUSAUD(0)
End DoDot:1
+46 ;
+47 ;The script leaves UIF variable after execution
+48 IF '$DATA(UIF)
DO ENR^INHE(INBPN,"Unable to create ack message for "_ORIGID)
QUIT 1
+49 ;Unless ack went on queue (unlikely), set ack status to "complete"
+50 IF INQUE
IF UIF>0
DO ULOG^INHU(UIF,"C")
+51 SET INSEND=$SELECT(UIF>0:UIF,1:"")
+52 QUIT 0
+53 ;
+54 ;
CACKLOG(INCAACK,INCAORIG,INCASTAT,INCANAKM) ;Log an accept (commit) acknowledgement to a message
+1 ;Modified version of ACKLOG^INHU. Will store status in originating
+2 ;message of "A"=Accept ack received or "E"=Error
+3 ;INCAACK (reqd) = UIF entry # of current message
+4 ;INCAORIG (reqd) = ID of message to acknowledge
+5 ;INCASTAT (reqd) = ack status (CA,CE or CR)
+6 ;INCANAKM (opt) = message to store if NAK
+7 ;
+8 IF '$DATA(^INTHU(+$GET(INCAACK)))
QUIT
+9 NEW AMID,MESS,STAT,DIE,DR,DA
+10 ;Mark the accept ack complete before updating original message
+11 SET DIE="^INTHU("
SET DA=INCAACK
SET DR=".03///C;.09////"_$$NOW^UTDT
Begin DoDot:1
+12 ;Temporary stack to be sure variable integrety later on
+13 NEW INCAACK,INCAORIG,INCASTAT,INCANAKM
DO ^DIE
End DoDot:1
+14 IF '$LENGTH($GET(INCAORIG))
QUIT
+15 ;find original message
+16 SET AMID=$ORDER(^INTHU("C",INCAORIG,0))
IF 'AMID
QUIT
+17 SET $PIECE(^INTHU(INCAACK,0),U,7)=AMID
+18 SET $PIECE(^INTHU(AMID,0),U,18)=INCAACK
SET STAT=$SELECT(INCASTAT="CA":"A",1:"E")
+19 IF STAT="A"
SET MESS(1)="Commit Acknowledge received with CA status"
+20 ;If originating message does not require application ack, upgrade
+21 ;successful status to C
+22 IF STAT="A"
IF '$PIECE(^INTHU(AMID,0),U,4)
SET STAT="C"
+23 SET DIE="^INTHU("
SET DA=AMID
SET DR=".03///"_STAT
DO ^DIE
+24 IF STAT="E"
SET MESS(1)="Negative Commit Acknowledge received"
IF $GET(INCANAKM)]""
SET MESS(2)=INCANAKM
+25 SET MESS(1)=MESS(1)_" in transaction with ID="_$PIECE(^INTHU(INCAACK,0),U,5)
+26 DO ULOG^INHU(AMID,STAT,.MESS)
+27 ;D ULOG^INHU(INCAACK,"C",.MESS)
+28 QUIT
+29 ;
+30 ;
+31 ;
+32 ;
