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

INHUSEN2.m

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