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

INHVCRL2.m

Go to the documentation of this file. 
  1. INHVCRL2 ;KAC ; 29 Feb 96 11:38; Logon Server (LoS) Background Controller (continued)
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  Q
  1.  ;
  1. INPARMS(INDSTP,INPARMS,INERR,INUIF) ; $$function - Build persistent msg parameter 
  1.  ; array for an inbound msg.  If array already exists for this inbound msg's
  1.  ; destination, exit.
  1.  ;
  1.  ; Input:
  1.  ;   INDSTP   - (pbr) INTERFACE DESTINATION IEN for inbound msg from 
  1.  ;                    UNIVERSAL INTERFACE file
  1.  ;   INERR    - (pbr) array containing error msg used to log an error
  1.  ;   INPARMS  - (pbr) inbound msg parameter array
  1.  ;                    Format: INPARMS(INDSTP,"param")=value
  1.  ;   INUIF    - (opt) UNIVERSAL INTERFACE IEN for inbound msg
  1.  ;                    Required if INDSTP needs to be set.
  1.  ;
  1.  ; Variables:
  1.  ;   INGETACK - flag - null = Ack is NOT used by this inbound transaction type
  1.  ;                     >0   = Ack IS used by this inbound transaction type
  1.  ;   X        - scratch
  1.  ;
  1.  ; Output:
  1.  ;   0 - success  - INPARMS(INDSTP,"param") = value
  1.  ;   1 - failure  - NO data is stored in inbound msg parameter array
  1.  ;                - INERR = error msg
  1.  ;
  1.  ; Get destination for this inbound msg (if NOT passed in or if null)
  1.  I '$G(INDSTP) D  Q:$L($G(INERR)) 1
  1.  . I '$G(INUIF) S INERR="Missing UNIVERSAL INTERFACE entry for inbound message" Q
  1.  . S INDSTP=$P($G(^INTHU(INUIF,0)),U,2)
  1.  . I 'INDSTP S INERR="Missing destination for inbound message - UNIVERSAL INTERFACE entry, '"_INUIF_"'"
  1.  ;
  1.  ; Quit if array for this inbound destination has been built
  1.  Q:$D(INPARMS(INDSTP)) 0
  1.  ;
  1.  N DSIN0,DSIN01,DSOUT,DSOUT0,DSOUT01,INGETACK,SCIN,SCOUT,TTIN,TTIN0,TTIN01,TTOUT,TTOUT0,TTOUT01,X
  1.  ;
  1.  ; Get 0-node & name for inbound destination
  1.  S DSIN0=$G(^INRHD(INDSTP,0)),DSIN01=$P(DSIN0,U)
  1.  I '$L(DSIN01) S INERR="Missing inbound destination name for INTERFACE DESTINATION entry, '"_INDSTP_"'" Q 1
  1.  ;
  1.  ; Get inbound transaction type for this destination
  1.  S TTIN=$P(DSIN0,U,2)
  1.  I 'TTIN S INERR="Missing inbound transaction type for INTERFACE DESTINATION, '"_DSIN01_"'" Q 1
  1.  ;
  1.  ; Get 0-node & name for inbound transaction type
  1.  S TTIN0=$G(^INRHT(TTIN,0)),TTIN01=$P(TTIN0,U)
  1.  I '$L(TTIN01) S INERR="Missing inbound transaction type name for INTERFACE TRANSACTION TYPE entry, '"_TTIN_"'" Q 1
  1.  ;
  1.  ; Verify whether inbound transaction type is active
  1.  I '$P(TTIN0,U,5) S INERR="Inactive INTERFACE TRANSACTION TYPE, '"_TTIN01_"'" Q 1
  1.  ;
  1.  ; Get inbound script for this transaction type
  1.  S SCIN=$P(TTIN0,U,3)
  1.  I 'SCIN S INERR="Missing inbound script for INTERFACE TRANSACTION TYPE, '"_TTIN01_"'" Q 1
  1.  ;
  1.  ; Ack information may NOT be required for every transaction type.
  1.  S INGETACK=$P(TTIN0,U,9) ; get Ack transaction type
  1.  I INGETACK D  Q:$L($G(INERR)) 1
  1.  . S TTOUT=INGETACK
  1.  .; Get 0-node & name for Ack transaction type
  1.  . S TTOUT0=$G(^INRHT(TTOUT,0)),TTOUT01=$P(TTOUT0,U)
  1.  . I '$L(TTOUT01) S INERR="Missing Ack transaction type name for INTERFACE TRANSACTION TYPE entry, '"_TTOUT_"'" Q
  1.  .;
  1.  .; Get outbound script for Ack transaction type
  1.  . S SCOUT=$P(TTOUT0,U,3)
  1.  . I 'SCOUT S INERR="Missing outbound script for INTERFACE TRANSACTION TYPE, '"_TTOUT01_"'" Q
  1.  .;
  1.  .; Get outbound destination for Ack transaction type
  1.  . S DSOUT=$P(TTOUT0,U,2)
  1.  . I 'DSOUT S INERR="Missing outbound destination for INTERFACE TRANSACTION TYPE, '"_TTOUT01_"'" Q
  1.  .;
  1.  .; Get 0-node & name for outbound (Ack) destination
  1.  . S DSOUT0=$G(^INRHD(DSOUT,0)),DSOUT01=$P(DSOUT0,U)
  1.  . I '$L(DSOUT01) S INERR="Missing outbound destination name for INTERFACE DESTINATION entry, '"_DSOUT_"'" Q
  1.  ;
  1.  ; Build inbound msg parameter array
  1.  F X="DSIN01","DSOUT","DSOUT01","SCIN","SCOUT","TTIN","TTIN01","TTOUT","TTOUT01" S:$D(@X) INPARMS(INDSTP,X)=@X
  1.  Q 0
  1.  ;
  1. SNDAACK(INBPN,INCHNL,INIP,INA,INDA,INUIF,INPARMS,INQUE,INERR) ; 
  1.  ; $$function - Send application Acknowledgement to remote system.
  1.  ;
  1.  ; Input:
  1.  ;   INA      - (opt) array containing either:
  1.  ;                    1) INA = UNIVERSAL INTERFACE IEN for outbound Ack
  1.  ;                             (already processed by outbound script)
  1.  ;                    2) INA array subscripts, some or all of which have
  1.  ;                       been defined, comprising a msg ready to be 
  1.  ;                       processed by outbound script
  1.  ;                    If NOT passed, ACK^INHOS creates an application
  1.  ;                    error Ack ("AE").
  1.  ;   INBPN    - (req) BACKGROUND PROCESS CONTROL IEN for calling process
  1.  ;   INCHNL   - (req) TCP channel assigned to this server when connection
  1.  ;                    is opened
  1.  ;   INDA     - (opt) array containing information to be sent to an
  1.  ;                    outbound destination
  1.  ;                      INDA = IEN in base file used by outbound script
  1.  ;                      Subscripts may hold subfile IENs in the format:
  1.  ;                        INDA(subfile #,DA)=""
  1.  ;                    If NOT passed, ACK^INHOS sets to -1.
  1.  ;   INERR    - (pbr) array containing error msg used to log an error
  1.  ;   INIP     - (req) array containing initialization parameters from
  1.  ;                    BACKGROUND PROCESS CONTROL file
  1.  ;   INPARMS  - (opt) inbound msg parameter array
  1.  ;                    Format: INPARMS(INDSTP,"param")=value
  1.  ;   INQUE    - (opt) flag - 1 = do NOT que Ack to o/p ctlr
  1.  ;                           0 = que Ack to o/p ctlr (default)
  1.  ;   INUIF    - (opt) UNIVERSAL INTERFACE IEN for inbound msg
  1.  ;                    Required if need to "build" Ack from INA array.
  1.  ;
  1.  ; Variables:
  1.  ;   INACKTYP - flag - 1 = positive Ack - AA = application accept
  1.  ;                     0 = negative Ack (default)
  1.  ;                         AE or AR = application error reject
  1.  ;   INACKUIF - UNIVERSAL INTERFACE IEN for outbound Ack
  1.  ;   INDSTP   - INTERFACE DESTINATION IEN for original inbound msg from 
  1.  ;              UNIVERSAL INTERFACE file
  1.  ;   INERRACK - error information returned by function
  1.  ; 
  1.  ; Output:
  1.  ;   0 = Ack successfully sent
  1.  ;   1 = Ack NOT successfully sent
  1.  ;
  1.  N INACKTYP,INACKUIF,INDSTP,INERRACK
  1.  ;
  1.  I $G(INCHNL)'>0 S INERR="Failed to send Ack - invalid channel #" Q 1
  1.  S INACKUIF=$G(INA) ; if Ack is already built in UIF, INACKUIF = IEN
  1.  ;
  1.  ; Create Ack if NOT already built in UIF
  1.  I $S('INACKUIF:1,'$D(^INTHU(INACKUIF)):1,1:0) D  Q:$D(INERR) 1
  1.  . I $S('$G(INUIF):1,'$D(^INTHU(INUIF)):1,1:0) S INERR="Missing entry in UNIVERSAL INTERFACE file for Ack creation" Q
  1.  .; Get inbound INTERFACE TRANSACTION TYPE IEN
  1.  . I $$INPARMS^INHVCRL2(.INDSTP,.INPARMS,.INERR,INUIF) Q
  1.  .; Get type of Ack
  1.  . S INACKTYP=$S($E($G(INA("INSTAT")),2)="A":1,1:0)
  1.  . D ACK^INHOS(INPARMS(INDSTP,"TTIN"),INACKTYP,INUIF,.INERR,.INA,.INDA,$G(INQUE),.INACKUIF)
  1.  ;
  1.  ; Transmit Ack to remote system
  1.  ;Start transaction audit
  1.  D:$D(XUAUDIT) TTSTRT^XUSAUD(INACKUIF,"",$P(^INTHPC(INBPN,0),U),$G(INHSRVR),"TRANSMIT")
  1.  S INERRACK=$$SEND^INHUVUT(INACKUIF,INCHNL,.INIP)
  1.  ;Stop transaction audit
  1.  D:$D(XUAUDIT) TTSTP^XUSAUD(0)
  1.  Q INERRACK
  1.  ;