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

INHUSEN3.m

Go to the documentation of this file. 
  1. INHUSEN3 ;DGH ; 26 Jun 96 14:33;More enhanced functions 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1. ACK(%TT,%S,INUIF,INHERR,INA,INDA,INQUE,ACKUIF) ;Create application ack
  1.  ;Modified version of ACK^INHOS.
  1.  ; Variables
  1.  ;  %TT = (REQ) Transaction Type entry # of incoming message
  1.  ; %S  = (0 = NAK, 1 = ACK) for backward compatibility
  1.  ;  %S is optional if INA("INSTAT") is set in INA array
  1.  ; INUIF = (REQ) Incoming message being acknowledged
  1.  ; INHERR = (PBR) Used to pass in an error message which
  1.  ;  will be part of the MSA segment.
  1.  ;  It is reset as the ack script is run to return
  1.  ;  the success/failure of the script.
  1.  ; INA = (PBR) Variable array to pass into script
  1.  ; INDA = (PBR) Array to pass into script. If the inbound script
  1.  ;  triggers an acknowledge message that extracts
  1.  ;  data (ie inbound is a query, ack is a patreg)
  1.  ;  INDA or an INDA array is used by the outbound script.
  1.  ;  If INDA is null, a -1 is passed into the ack script.
  1.  ; INQUE = If set to 1, will pass parameter into script
  1.  ;  signalling that ack is not to be queued into
  1.  ;  output controller, INLHSCH
  1.  ; ACKUIF = (PBR) If INQUE=1 and calling transceiver routine will
  1.  ;  be sending ack, ACKUIF is the UIF of the created ack.
  1.  N TRT,X,CND,UIF,DA,DIE,DR,DIC,SCR,DEST,Z,CREATE
  1.  Q:'$G(%TT)
  1.  ;CND is the conditions under which application ack is generated.
  1.  ;It will be MSH-16, unless over-ride exists in ^INRHT, piece 18
  1.  S CND=$P($G(^INRHT(%TT,0)),U,18)
  1.  I '$L(CND) Q:$$APPACK^INHUSEN3(INUIF,.CND,.INERR)
  1.  ;No need to ack if MSH INDICATES NEVER
  1.  Q:CND="NE"
  1.  ;Quit if no ack TRT is specified in the incoming TT
  1.  Q:'$D(^INRHT(%TT))  S TRT=$P(^INRHT(%TT,0),U,9) Q:'TRT
  1.  ;If calling routine has set status in INA array, it will override
  1.  ;the following.
  1.  I '$D(INA("INSTAT")) D
  1.  .S %S=+$G(%S)
  1.  .I %S S INA("INSTAT")="AA" Q
  1.  .S INA("INSTAT")="AE"
  1.  ;Determine if ack is needed based on condition
  1.  S CREATE=0 D
  1.  .;If CND is null, assume original ack rules. As long as the TRT pointer
  1.  .;was found above, create an ack. Also create ack if condition=AL
  1.  .I CND=""!(CND="AL") S CREATE=1 Q
  1.  .;Otherwise use enhanced processing rules and examine CND
  1.  .;If stat is successful, and condition is SU or AL, create an ack
  1.  .;If stat is unsuccessful, and condition is AL or ER, create an ACK
  1.  .S CREATE=$S($E(INA("INSTAT"),2)="A"&(CND="SU"):1,("R,E"[$E(INA("INSTAT"),2)!'%S)&(CND="ER"):1,1:0)
  1.  Q:'CREATE
  1.  ;If origid is passed in, don't go to disk to look it up
  1.  S:'$D(INA("INORIGID")) INA("INORIGID")=$P($G(^INTHU(INUIF,2)),U)
  1.  ;Set ack error message, then kill error message for later reset
  1.  I $D(INHERR),'$D(INA("INACKERR")) S INA("INACKERR")=$E(INHERR,1,100) K INHERR
  1.  S SCR=$P(^INRHT(TRT,0),U,3),DEST=+$P(^INRHT(TRT,0),U,2),INTNAME=$P(^INRHT(TRT,0),U)
  1.  S:'$L($G(INDA)) INDA=-1
  1.  Q:'SCR!'DEST  Q:'$D(^INRHS(SCR))!'$D(^INRHD(DEST))
  1.  ;Start transaction audit
  1.  D:$D(XUAUDIT) TTSTRT^XUSAUD(INTNAME,"",$P($G(^INTHPC(INBPN,0)),U),$G(INHSRVR),"SCRIPT")
  1.  S Z="S X=$$^IS"_$E(SCR#100000+100000,2,6)_"("_TRT_",.INDA,.INA,"_DEST_","_+$G(INQUE)_")"
  1.  X Z S ACKUIF=$S($G(UIF)>0:UIF,1:"")
  1.  ;Stop transaction audit
  1.  D:$D(XUAUDIT) TTSTP^XUSAUD(0)
  1.  D:ACKUIF
  1.  .;Set pointer in original message to the app ack
  1.  .S $P(^INTHU(ACKUIF,0),U,7)=INUIF
  1.  .;Set pointer in ack to original message
  1.  .S $P(^INTHU(INUIF,0),U,6)=ACKUIF
  1.  .;If ack did not go on queue, set ack status to "complete"
  1.  .D:$G(INQUE) ULOG^INHU(ACKUIF,"C")
  1.  Q
  1.  ;
  1. APPACK(GBL,APPL,INERR) ;Returns type of application acknowledgment required
  1.  ;INPUT
  1.  ;--GBL = global being checked, usually will be ^INTHU
  1.  ;--------If numeric, assumed to be IEN for ^INTHU
  1.  ;--------If non-numeric, assumed to be global reference
  1.  ;--APPL = variable to contain type
  1.  ;--INERR=Variable to contain error array
  1.  ;RETURN
  1.  ;0=success 2=fatal error
  1.  N LCT,MSH
  1.  I +GBL S LCT=0 D GETLINE^INHOU(GBL,.LCT,.MSH)
  1.  I 'GBL S MSH=$G(@GBL@(1))
  1.  I $G(MSH)'["MSH" D ERRADD^INHUSEN3(.INERR,"Message does not have the MSH segment in the correct location") Q 2
  1.  S INDELIM=$E(MSH,4)
  1.  S APPL=$P(MSH,INDELIM,16)
  1.  Q 0
  1.  ;
  1. DSTQUE(INUIF,INERR) ;Builds queues by destination
  1.  ;This function is called from any output controller routine
  1.  ;to build queus by destination. Messages will be "moved" from
  1.  ;^INLHSCH(prior,time,uif) to ^INLHSCH("BP",dest,sequence,prior,time,uif)
  1.  ;It is a generic version of INHVTSQ
  1.  ;INPUT:
  1.  ;  INUIF - ien in Universal Interface file
  1.  ;OUTPUT:
  1.  ;  INERR - array containing any error messages
  1.  ;  function value - success or failure
  1.  ;        [  0 - success ;  1 - failure ]
  1.  ;
  1.  N H,P,D,Z,SEQ
  1.  S Z=$G(^INTHU(+$G(INUIF),0))
  1.  I '$L(Z) S INERR="Nonexistent Message "_INUIF Q 1
  1.  ;Get message priority
  1.  S P=+$P(Z,U,16)
  1.  ;Get time to process - NOW
  1.  S H=$H,$P(H,",",2)=$E(100000+$P(H,",",2),2,6)
  1.  ;Get destination
  1.  S D=+$P(Z,U,2) I 'D S INERR="No destination for message "_INUIF Q 1
  1.  ;Get sequence number (default=0)
  1.  S SEQ=+$P(Z,U,17)
  1.  ;L +^INLHDEST(D):5
  1.  ;E  S INERR="Unable to lock message queue ^INLHDEST("_$P(^INRHD(D,0),U)_") " Q 1
  1.  S ^INLHDEST(D,P,H,INUIF)=""
  1.  ;L -^INLHDEST(D)
  1.  Q 0
  1.  ;
  1. ERRADD(INERR,INMSG) ;Build/concatenate error messages to error array
  1.  ;INPUT:
  1.  ;--INERR=The existing error array (Pass by ref)
  1.  ;--INMSG=The line or lines of errors to be added to the array (PBR)
  1.  ;
  1.  Q:'$D(INMSG)
  1.  N ERRNO,MSGNO,I
  1.  S ERRNO=$O(INERR(""),-1)+1
  1.  ;If new message is contained in top level
  1.  I $L($G(INMSG)) S INERR(ERRNO)=INMSG,ERRNO=ERRNO+1
  1.  ;Pick up all subscripted messages, if any
  1.  S MSGNO="" F  S MSGNO=$O(INMSG(MSGNO)) Q:'MSGNO  D
  1.  .S:$L(INMSG(MSGNO)) INERR(ERRNO)=INMSG(MSGNO),ERRNO=ERRNO+1
  1.  ;kill additional lines before exiting, only return "real" array.
  1.  K INMSG
  1.  Q
  1.  ;