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

INTSUSN.m

Go to the documentation of this file. 
  1. INTSUSN ; DGH JPD; 3 Jun 96 09:54; Enhanced functions and utilities 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1. IN(INIP,ING,INDEST,INSEND,INERR,INXDST,INMSG,INMSASTA,INRONLY) ;Process incoming
  1.  ;Copied from INHUSEN
  1.  ;Verify all needed data is present
  1.  ;Store xmission (if verified but not if it is for housekeeping)
  1.  ;Create receipt ack as specified in MSH.
  1.  ;
  1.  ;Input:
  1.  ; INIP - array of parameters
  1.  ; ING = (REQ) Variable array/global containing lines from msg.
  1.  ; INDEST = Array of valid destinations in format
  1.  ;          INDEST(type) =  .01 field of destination.  This is not
  1.  ;          required if processing incoming ACKS, but will generate
  1.  ;          an error if processing incoming msg with no destination.
  1.  ; INSEND = (OPT) UIF entry(ies) of msg which needs to be sent by 
  1.  ;          tranceiver back to other system.
  1.  ;          This may be an accept ack
  1.  ; INERR = (OPT) Variable to return error msg. (PBR)
  1.  ; INXDST = (OPT) EXecutable code to identify the destination for
  1.  ; msgs which won't be uniquely identified by INTYP_INEVN.
  1.  ;  The executable must return the ien in the variable INDSTP.
  1.  ;  INMSG = (OPT) Variable to return UIF of inbound msg (PBR)
  1.  ;  INMSASTA = (OPT) Variable to return MSA-1 ack status (PBR)
  1.  ;  INRONLY - 1 Receive only send no ack, 0 receive then send ack
  1.  ;
  1.  ;Returns:
  1.  ;  0 = success, 1 = non-fatal error, 2 = fatal error
  1.  ;
  1.  N ORIGID,ORIGID2,MESSID,INVL,STAT,EXPCT,INDST,INDSTP,INMSH,INTYP
  1.  N INEVN,Z,ACKMSG
  1.  ;Note: INDST and INDSTP are variables for the Dest. file for the
  1.  ;incoming msg. This may differ from the destination of the
  1.  ;background process.
  1.  S (EXPCT,INSEND,INERR)=""
  1.  ;First verify MSH, get msg type and event type. If invalid, quit
  1.  I $$VERIF^INTSUSN1(ING,.INMSH,.INTYP,.INEVN,.INERR) Q 2
  1.  S (MESSID,ORIGID)=$P(INMSH,INDELIM,10)
  1.  ;
  1.  ;is message ID valid
  1.  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
  1.  ;
  1.  ;is message type invalid
  1.  I INTYP="" D  Q $$ACK(.INIP,2,.INSEND,INRONLY)
  1.  .S MSG(1)="Unable to determine message type",MSG(2)=$E(INMSH,1,250)
  1.  .D ERRADD^INHUSEN3(.INERR,.MSG)
  1.  ;
  1.  S INVL=""
  1.  ;  If ack,destination only needed for App. ack.
  1.  I INTYP["ACK" D TYPEACK(ING,.INVL,.INMSG)
  1.  ;  If incoming is a msg not an ack, must determine tran. type.
  1.  I INTYP'["ACK" D TYPNOTAK(ING,.INXDST,.INDSTP,.INDST,.INVL,.INMSG)
  1.  Q $$ACK(.INIP,.INVL,.INSEND,INRONLY)
  1.  ;
  1. TYPEACK(ING,INVL,INMSG) ;Type was ack
  1.  ;Input:
  1.  ; ING = Variable array/global containing lines from msg.
  1.  ;Output:
  1.  ; INVL - True - invalid, "" no error
  1.  ; INMSG = (OPT) Variable to return UIF of inbound msg (PBR)
  1.  ;Local
  1.  ; INMSGSTAT - 
  1.  ;  AA - Application Accept or No MSA segment Accept
  1.  ;  AE - Application Error
  1.  ;  AR - Application Reject
  1.  ;  CA - Commit Accept Ack
  1.  ;  CE - Commit Error
  1.  ;  CR - Commit Reject
  1.  ;               
  1.  N INMSASTA,EXPCT,INDST,INDSTP,ACKMSG
  1.  S INVL=$$ACKIN^INHUSEN2(ING,.INMSASTA,.EXPCT,.INDST,.INDSTP,.ACKMSG,.INERR)
  1.  ;quit if invalid
  1.  Q:INVL
  1.  ;If application ack and no destination
  1.  I $E($G(INMSASTA))="A",'$G(INDSTP) D  Q
  1.  .S MSG(1)="Ack "_MESSID_" has no destination",MSG(2)=$E(INMSH,1,250)
  1.  .D ERRADD^INHUSEN3(.INERR,.MSG)
  1.  .S INVL=2
  1.  D STORE(INDST,ING,.INMSG)
  1.  ;Update parent for commit acks
  1.  I $E($G(INMSASTA))="C",INMSG>0 D CACKLOG(INMSG,ACKMSG,INMSASTA,.INERR)
  1.  Q
  1. TYPNOTAK(ING,INXDST,INDSTP,INDST,INVL,INMSG) ;Type was not an ack
  1.  ;Input:
  1.  ; ING = Variable array/global containing lines from msg.
  1.  ; INXDST = eXecutable code to identify the destination
  1.  ; INDSTP - Destination pointer
  1.  ; INDST - Destination pointer
  1.  ; INVL - True - invalid, "" no error
  1.  ; INMSG = (OPT) Variable to return UIF of inbound msg (PBR)
  1.  ;If tranceiver passed INXDST, execute it. Otherwise do DEST.
  1.  X $S($L($G(INXDST)):INXDST,1:"D DEST")
  1.  I '$G(INDSTP) D  Q
  1.  .S MSG(1)="Message "_MESSID_" has no destination",MSG(2)=$E(INMSH,1,250)
  1.  .D ERRADD^INHUSEN3(.INERR,.MSG)
  1.  .S INVL=2
  1.  ;pointer needed for most functions, NAME needed for NEW^INHD.
  1.  S:'$D(INDST) INDST=$P(^INRHD(INDSTP,0),U)
  1.  D STORE(INDST,ING,.INMSG)
  1.  Q
  1. ACK(INIP,INVL,INSEND,INRONLY) ;Process commit ack and quit back to transceiver routine.
  1.  ;Input:
  1.  ; INIP - Array of parameters from gallery
  1.  ; INVL - True - invalid, "" no error
  1.  ; INSEND - ien of UIF
  1.  ; INRONLY - 1 Receive only send no ack, 0 receive then send ack
  1.  N CND
  1.  ;If receive only then we don't want to send ack
  1.  Q:INRONLY +$G(INVL)
  1.  S CND=$P(INMSH,INDELIM,15)
  1.  ;Overide accept ack condition
  1.  I INIP("AAC")'="" S CND=INIP("AAC")
  1.  N STAT,CERR
  1.  I CND'="NE" D
  1.  .;If CND has value, msg is in enhanced HL7 mode
  1.  .I $L(CND) D  Q
  1.  ..I 'INVL,"SU,AL"[CND S CERR=$$CACK(.INSEND,"CA",ORIGID,.INERR,EXPCT) Q
  1.  ..I INVL,"AL,ER"[CND S CERR=$$CACK(.INSEND,"CR",ORIGID,.INERR,EXPCT) Q
  1.  .I INVL>1,'$L($P($G(INMSH),U,16)) S CERR=$$CACK(.INSEND,"AR",ORIGID,.INERR,EXPCT)
  1.  Q $S($G(CERR)>INVL:CERR,1:INVL)
  1.  ;
  1. 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
  1.  ; ORIGID = (REQ) MESSID of Incoming message being acknowledged    MSA-2
  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.  ; INA = (OPT) The INA variable array.
  1.  ; INDA = (OPT) The INDA array of ien entry numbers.
  1.  ;  NOTE: INDA and INA are not normally needed for commit acks, but
  1.  ;        may be used is specialized situations.
  1.  ;
  1.  ; Output:
  1.  ; INSEND = ien of accept ack in ^INTHU.
  1.  ;
  1.  ; Returns:
  1.  ;  0=success, 1= non-fatal. Inability to return ack is non-fatal to msg.
  1.  ;
  1.  N INA,TRT,UIF,DA,DIE,DR,DIC,SCR,DEST,Z
  1.  I '$D(ORIGID) D DISPLAY^INTSUT1("Unable to determine originating message ID") Q 1
  1.  ;Get transaction type
  1.  S TRT=INIP("AATT") I 'TRT D DISPLAY^INTSUT1("No Transaction Type designated for commit ack.") 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.  S SCR=$P(^INRHT(TRT,0),U,3),DEST=+$P(^INRHT(TRT,0),U,2)
  1.  I $D(^INRHS(+SCR)),$D(^INRHD(+DEST)) D
  1.  .;Set INDA array. Normally, Ack message has value of -1.
  1.  .S INDA=$S('$D(INDA):-1,INDA="":-1,1:INDA)
  1.  .X "S ER=$$^IS"_$E(SCR#100000+100000,2,6)_"("_TRT_",.INDA,.INA,"_DEST_","_0_")"
  1.  ;The script leaves UIF variable after execution
  1.  I '$D(UIF) D DISPLAY^INTSUT1("Unable to create ack message for "_ORIGID) Q 1
  1.  ;Unless ack went on queue (unlikely), set ack status to "complete"
  1.  I UIF>0 D ULOG^INHU(UIF,"C")
  1.  S INSEND=$S(UIF>0:UIF,1:"")
  1.  Q 0
  1. CACKLOG(INCAACK,INCAORIG,INCASTAT,INCANAKM) ;Log an accept (commit) acknowledgement to a message
  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.  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. STORE(INDST,ING,INMSG) ;Store incoming xmission in the Universal Interface file
  1.  ;Input:
  1.  ; INDST = string name of entry in Int. Dest. File
  1.  ; ING = array to be stored
  1.  ;
  1.  ;Output:
  1.  ; INMSG = UIF of new msg, or -1 if creation failed.
  1.  ;
  1.  N SOURCE,DIE,DR
  1.  ;Create a unique INCOMING MESSAGE ID for field 2.1 of the UIF
  1.  ;in format "ORIGID-XX-NN" where XX is 1st two letters from background
  1.  ;process file and NN increments from 1.
  1.  ;Set PN to piece # of the # (If ORIGID already has "-"
  1.  ;embedded, need to place XX-NN further than pieces 2 and 3)
  1.  S ORIGID2=ORIGID_"-TU-1" D:$D(^INTHU("C",ORIGID2))
  1.  . N USED,PN S PN=$L(ORIGID,"-")+2
  1.  . F USED=2:1 S $P(ORIGID2,"-",PN)=USED Q:'$D(^INTHU("C",ORIGID2))
  1.  S SOURCE="Incoming message from transceiver the Test Utility"
  1.  ;Create msg in UIF using modified originating messid
  1.  S INMSG=$$NEW^INHD(ORIGID2,INDST,SOURCE,ING,0,"I",1)
  1.  ;If the input driver returns a -1 then the transaction was rejected
  1.  I INMSG<0 S INERR="Message "_MESSID_" was rejected by the GIS",INVL=2 Q
  1.  ;store original message id (will also be in "D" x-ref)
  1.  S DA=+INMSG,DIE="^INTHU(",DR="2.1///"_ORIGID D ^DIE
  1.  Q
  1. DEST ;Find destination for incoming message (not incoming ack?).
  1.  ;INPUT:
  1.  ;OUTPUT:
  1.  ;--INDSTP - Pointer to destination file
  1.  ;
  1.  I '$D(^INRHD("B","TEST UTILITY DEST STUB - IN")) D DISPLAY^INTSUT1("TEST UTILITY DEST STUB - IN missing, destination not set")
  1.  S INDSTP=$O(^INRHD("B","TEST UTILITY DEST STUB - IN",""))
  1.  Q