INHVCRL2 ;KAC ; 29 Feb 96 11:38; Logon Server (LoS) Background Controller (continued)
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q
;
INPARMS(INDSTP,INPARMS,INERR,INUIF) ; $$function - Build persistent msg parameter
; array for an inbound msg. If array already exists for this inbound msg's
; destination, exit.
;
; Input:
; INDSTP - (pbr) INTERFACE DESTINATION IEN for inbound msg from
; UNIVERSAL INTERFACE file
; INERR - (pbr) array containing error msg used to log an error
; INPARMS - (pbr) inbound msg parameter array
; Format: INPARMS(INDSTP,"param")=value
; INUIF - (opt) UNIVERSAL INTERFACE IEN for inbound msg
; Required if INDSTP needs to be set.
;
; Variables:
; INGETACK - flag - null = Ack is NOT used by this inbound transaction type
; >0 = Ack IS used by this inbound transaction type
; X - scratch
;
; Output:
; 0 - success - INPARMS(INDSTP,"param") = value
; 1 - failure - NO data is stored in inbound msg parameter array
; - INERR = error msg
;
; Get destination for this inbound msg (if NOT passed in or if null)
I '$G(INDSTP) D Q:$L($G(INERR)) 1
. I '$G(INUIF) S INERR="Missing UNIVERSAL INTERFACE entry for inbound message" Q
. S INDSTP=$P($G(^INTHU(INUIF,0)),U,2)
. I 'INDSTP S INERR="Missing destination for inbound message - UNIVERSAL INTERFACE entry, '"_INUIF_"'"
;
; Quit if array for this inbound destination has been built
Q:$D(INPARMS(INDSTP)) 0
;
N DSIN0,DSIN01,DSOUT,DSOUT0,DSOUT01,INGETACK,SCIN,SCOUT,TTIN,TTIN0,TTIN01,TTOUT,TTOUT0,TTOUT01,X
;
; Get 0-node & name for inbound destination
S DSIN0=$G(^INRHD(INDSTP,0)),DSIN01=$P(DSIN0,U)
I '$L(DSIN01) S INERR="Missing inbound destination name for INTERFACE DESTINATION entry, '"_INDSTP_"'" Q 1
;
; Get inbound transaction type for this destination
S TTIN=$P(DSIN0,U,2)
I 'TTIN S INERR="Missing inbound transaction type for INTERFACE DESTINATION, '"_DSIN01_"'" Q 1
;
; Get 0-node & name for inbound transaction type
S TTIN0=$G(^INRHT(TTIN,0)),TTIN01=$P(TTIN0,U)
I '$L(TTIN01) S INERR="Missing inbound transaction type name for INTERFACE TRANSACTION TYPE entry, '"_TTIN_"'" Q 1
;
; Verify whether inbound transaction type is active
I '$P(TTIN0,U,5) S INERR="Inactive INTERFACE TRANSACTION TYPE, '"_TTIN01_"'" Q 1
;
; Get inbound script for this transaction type
S SCIN=$P(TTIN0,U,3)
I 'SCIN S INERR="Missing inbound script for INTERFACE TRANSACTION TYPE, '"_TTIN01_"'" Q 1
;
; Ack information may NOT be required for every transaction type.
S INGETACK=$P(TTIN0,U,9) ; get Ack transaction type
I INGETACK D Q:$L($G(INERR)) 1
. S TTOUT=INGETACK
.; Get 0-node & name for Ack transaction type
. S TTOUT0=$G(^INRHT(TTOUT,0)),TTOUT01=$P(TTOUT0,U)
. I '$L(TTOUT01) S INERR="Missing Ack transaction type name for INTERFACE TRANSACTION TYPE entry, '"_TTOUT_"'" Q
.;
.; Get outbound script for Ack transaction type
. S SCOUT=$P(TTOUT0,U,3)
. I 'SCOUT S INERR="Missing outbound script for INTERFACE TRANSACTION TYPE, '"_TTOUT01_"'" Q
.;
.; Get outbound destination for Ack transaction type
. S DSOUT=$P(TTOUT0,U,2)
. I 'DSOUT S INERR="Missing outbound destination for INTERFACE TRANSACTION TYPE, '"_TTOUT01_"'" Q
.;
.; Get 0-node & name for outbound (Ack) destination
. S DSOUT0=$G(^INRHD(DSOUT,0)),DSOUT01=$P(DSOUT0,U)
. I '$L(DSOUT01) S INERR="Missing outbound destination name for INTERFACE DESTINATION entry, '"_DSOUT_"'" Q
;
; Build inbound msg parameter array
F X="DSIN01","DSOUT","DSOUT01","SCIN","SCOUT","TTIN","TTIN01","TTOUT","TTOUT01" S:$D(@X) INPARMS(INDSTP,X)=@X
Q 0
;
SNDAACK(INBPN,INCHNL,INIP,INA,INDA,INUIF,INPARMS,INQUE,INERR) ;
; $$function - Send application Acknowledgement to remote system.
;
; Input:
; INA - (opt) array containing either:
; 1) INA = UNIVERSAL INTERFACE IEN for outbound Ack
; (already processed by outbound script)
; 2) INA array subscripts, some or all of which have
; been defined, comprising a msg ready to be
; processed by outbound script
; If NOT passed, ACK^INHOS creates an application
; error Ack ("AE").
; INBPN - (req) BACKGROUND PROCESS CONTROL IEN for calling process
; INCHNL - (req) TCP channel assigned to this server when connection
; is opened
; INDA - (opt) array containing information to be sent to an
; outbound destination
; INDA = IEN in base file used by outbound script
; Subscripts may hold subfile IENs in the format:
; INDA(subfile #,DA)=""
; If NOT passed, ACK^INHOS sets to -1.
; INERR - (pbr) array containing error msg used to log an error
; INIP - (req) array containing initialization parameters from
; BACKGROUND PROCESS CONTROL file
; INPARMS - (opt) inbound msg parameter array
; Format: INPARMS(INDSTP,"param")=value
; INQUE - (opt) flag - 1 = do NOT que Ack to o/p ctlr
; 0 = que Ack to o/p ctlr (default)
; INUIF - (opt) UNIVERSAL INTERFACE IEN for inbound msg
; Required if need to "build" Ack from INA array.
;
; Variables:
; INACKTYP - flag - 1 = positive Ack - AA = application accept
; 0 = negative Ack (default)
; AE or AR = application error reject
; INACKUIF - UNIVERSAL INTERFACE IEN for outbound Ack
; INDSTP - INTERFACE DESTINATION IEN for original inbound msg from
; UNIVERSAL INTERFACE file
; INERRACK - error information returned by function
;
; Output:
; 0 = Ack successfully sent
; 1 = Ack NOT successfully sent
;
N INACKTYP,INACKUIF,INDSTP,INERRACK
;
I $G(INCHNL)'>0 S INERR="Failed to send Ack - invalid channel #" Q 1
S INACKUIF=$G(INA) ; if Ack is already built in UIF, INACKUIF = IEN
;
; Create Ack if NOT already built in UIF
I $S('INACKUIF:1,'$D(^INTHU(INACKUIF)):1,1:0) D Q:$D(INERR) 1
. I $S('$G(INUIF):1,'$D(^INTHU(INUIF)):1,1:0) S INERR="Missing entry in UNIVERSAL INTERFACE file for Ack creation" Q
.; Get inbound INTERFACE TRANSACTION TYPE IEN
. I $$INPARMS^INHVCRL2(.INDSTP,.INPARMS,.INERR,INUIF) Q
.; Get type of Ack
. S INACKTYP=$S($E($G(INA("INSTAT")),2)="A":1,1:0)
. D ACK^INHOS(INPARMS(INDSTP,"TTIN"),INACKTYP,INUIF,.INERR,.INA,.INDA,$G(INQUE),.INACKUIF)
;
; Transmit Ack to remote system
;Start transaction audit
D:$D(XUAUDIT) TTSTRT^XUSAUD(INACKUIF,"",$P(^INTHPC(INBPN,0),U),$G(INHSRVR),"TRANSMIT")
S INERRACK=$$SEND^INHUVUT(INACKUIF,INCHNL,.INIP)
;Stop transaction audit
D:$D(XUAUDIT) TTSTP^XUSAUD(0)
Q INERRACK
;
INHVCRL2 ;KAC ; 29 Feb 96 11:38; Logon Server (LoS) Background Controller (continued)
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 QUIT
+5 ;
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
+2 ; destination, exit.
+3 ;
+4 ; Input:
+5 ; INDSTP - (pbr) INTERFACE DESTINATION IEN for inbound msg from
+6 ; UNIVERSAL INTERFACE file
+7 ; INERR - (pbr) array containing error msg used to log an error
+8 ; INPARMS - (pbr) inbound msg parameter array
+9 ; Format: INPARMS(INDSTP,"param")=value
+10 ; INUIF - (opt) UNIVERSAL INTERFACE IEN for inbound msg
+11 ; Required if INDSTP needs to be set.
+12 ;
+13 ; Variables:
+14 ; INGETACK - flag - null = Ack is NOT used by this inbound transaction type
+15 ; >0 = Ack IS used by this inbound transaction type
+16 ; X - scratch
+17 ;
+18 ; Output:
+19 ; 0 - success - INPARMS(INDSTP,"param") = value
+20 ; 1 - failure - NO data is stored in inbound msg parameter array
+21 ; - INERR = error msg
+22 ;
+23 ; Get destination for this inbound msg (if NOT passed in or if null)
+24 IF '$GET(INDSTP)
Begin DoDot:1
+25 IF '$GET(INUIF)
SET INERR="Missing UNIVERSAL INTERFACE entry for inbound message"
QUIT
+26 SET INDSTP=$PIECE($GET(^INTHU(INUIF,0)),U,2)
+27 IF 'INDSTP
SET INERR="Missing destination for inbound message - UNIVERSAL INTERFACE entry, '"_INUIF_"'"
End DoDot:1
IF $LENGTH($GET(INERR))
QUIT 1
+28 ;
+29 ; Quit if array for this inbound destination has been built
+30 IF $DATA(INPARMS(INDSTP))
QUIT 0
+31 ;
+32 NEW DSIN0,DSIN01,DSOUT,DSOUT0,DSOUT01,INGETACK,SCIN,SCOUT,TTIN,TTIN0,TTIN01,TTOUT,TTOUT0,TTOUT01,X
+33 ;
+34 ; Get 0-node & name for inbound destination
+35 SET DSIN0=$GET(^INRHD(INDSTP,0))
SET DSIN01=$PIECE(DSIN0,U)
+36 IF '$LENGTH(DSIN01)
SET INERR="Missing inbound destination name for INTERFACE DESTINATION entry, '"_INDSTP_"'"
QUIT 1
+37 ;
+38 ; Get inbound transaction type for this destination
+39 SET TTIN=$PIECE(DSIN0,U,2)
+40 IF 'TTIN
SET INERR="Missing inbound transaction type for INTERFACE DESTINATION, '"_DSIN01_"'"
QUIT 1
+41 ;
+42 ; Get 0-node & name for inbound transaction type
+43 SET TTIN0=$GET(^INRHT(TTIN,0))
SET TTIN01=$PIECE(TTIN0,U)
+44 IF '$LENGTH(TTIN01)
SET INERR="Missing inbound transaction type name for INTERFACE TRANSACTION TYPE entry, '"_TTIN_"'"
QUIT 1
+45 ;
+46 ; Verify whether inbound transaction type is active
+47 IF '$PIECE(TTIN0,U,5)
SET INERR="Inactive INTERFACE TRANSACTION TYPE, '"_TTIN01_"'"
QUIT 1
+48 ;
+49 ; Get inbound script for this transaction type
+50 SET SCIN=$PIECE(TTIN0,U,3)
+51 IF 'SCIN
SET INERR="Missing inbound script for INTERFACE TRANSACTION TYPE, '"_TTIN01_"'"
QUIT 1
+52 ;
+53 ; Ack information may NOT be required for every transaction type.
+54 ; get Ack transaction type
SET INGETACK=$PIECE(TTIN0,U,9)
+55 IF INGETACK
Begin DoDot:1
+56 SET TTOUT=INGETACK
+57 ; Get 0-node & name for Ack transaction type
+58 SET TTOUT0=$GET(^INRHT(TTOUT,0))
SET TTOUT01=$PIECE(TTOUT0,U)
+59 IF '$LENGTH(TTOUT01)
SET INERR="Missing Ack transaction type name for INTERFACE TRANSACTION TYPE entry, '"_TTOUT_"'"
QUIT
+60 ;
+61 ; Get outbound script for Ack transaction type
+62 SET SCOUT=$PIECE(TTOUT0,U,3)
+63 IF 'SCOUT
SET INERR="Missing outbound script for INTERFACE TRANSACTION TYPE, '"_TTOUT01_"'"
QUIT
+64 ;
+65 ; Get outbound destination for Ack transaction type
+66 SET DSOUT=$PIECE(TTOUT0,U,2)
+67 IF 'DSOUT
SET INERR="Missing outbound destination for INTERFACE TRANSACTION TYPE, '"_TTOUT01_"'"
QUIT
+68 ;
+69 ; Get 0-node & name for outbound (Ack) destination
+70 SET DSOUT0=$GET(^INRHD(DSOUT,0))
SET DSOUT01=$PIECE(DSOUT0,U)
+71 IF '$LENGTH(DSOUT01)
SET INERR="Missing outbound destination name for INTERFACE DESTINATION entry, '"_DSOUT_"'"
QUIT
End DoDot:1
IF $LENGTH($GET(INERR))
QUIT 1
+72 ;
+73 ; Build inbound msg parameter array
+74 FOR X="DSIN01","DSOUT","DSOUT01","SCIN","SCOUT","TTIN","TTIN01","TTOUT","TTOUT01"
IF $DATA(@X)
SET INPARMS(INDSTP,X)=@X
+75 QUIT 0
+76 ;
SNDAACK(INBPN,INCHNL,INIP,INA,INDA,INUIF,INPARMS,INQUE,INERR) ;
+1 ; $$function - Send application Acknowledgement to remote system.
+2 ;
+3 ; Input:
+4 ; INA - (opt) array containing either:
+5 ; 1) INA = UNIVERSAL INTERFACE IEN for outbound Ack
+6 ; (already processed by outbound script)
+7 ; 2) INA array subscripts, some or all of which have
+8 ; been defined, comprising a msg ready to be
+9 ; processed by outbound script
+10 ; If NOT passed, ACK^INHOS creates an application
+11 ; error Ack ("AE").
+12 ; INBPN - (req) BACKGROUND PROCESS CONTROL IEN for calling process
+13 ; INCHNL - (req) TCP channel assigned to this server when connection
+14 ; is opened
+15 ; INDA - (opt) array containing information to be sent to an
+16 ; outbound destination
+17 ; INDA = IEN in base file used by outbound script
+18 ; Subscripts may hold subfile IENs in the format:
+19 ; INDA(subfile #,DA)=""
+20 ; If NOT passed, ACK^INHOS sets to -1.
+21 ; INERR - (pbr) array containing error msg used to log an error
+22 ; INIP - (req) array containing initialization parameters from
+23 ; BACKGROUND PROCESS CONTROL file
+24 ; INPARMS - (opt) inbound msg parameter array
+25 ; Format: INPARMS(INDSTP,"param")=value
+26 ; INQUE - (opt) flag - 1 = do NOT que Ack to o/p ctlr
+27 ; 0 = que Ack to o/p ctlr (default)
+28 ; INUIF - (opt) UNIVERSAL INTERFACE IEN for inbound msg
+29 ; Required if need to "build" Ack from INA array.
+30 ;
+31 ; Variables:
+32 ; INACKTYP - flag - 1 = positive Ack - AA = application accept
+33 ; 0 = negative Ack (default)
+34 ; AE or AR = application error reject
+35 ; INACKUIF - UNIVERSAL INTERFACE IEN for outbound Ack
+36 ; INDSTP - INTERFACE DESTINATION IEN for original inbound msg from
+37 ; UNIVERSAL INTERFACE file
+38 ; INERRACK - error information returned by function
+39 ;
+40 ; Output:
+41 ; 0 = Ack successfully sent
+42 ; 1 = Ack NOT successfully sent
+43 ;
+44 NEW INACKTYP,INACKUIF,INDSTP,INERRACK
+45 ;
+46 IF $GET(INCHNL)'>0
SET INERR="Failed to send Ack - invalid channel #"
QUIT 1
+47 ; if Ack is already built in UIF, INACKUIF = IEN
SET INACKUIF=$GET(INA)
+48 ;
+49 ; Create Ack if NOT already built in UIF
+50 IF $SELECT('INACKUIF:1,'$DATA(^INTHU(INACKUIF)):1,1:0)
Begin DoDot:1
+51 IF $SELECT('$GET(INUIF):1,'$DATA(^INTHU(INUIF)):1,1:0)
SET INERR="Missing entry in UNIVERSAL INTERFACE file for Ack creation"
QUIT
+52 ; Get inbound INTERFACE TRANSACTION TYPE IEN
+53 IF $$INPARMS^INHVCRL2(.INDSTP,.INPARMS,.INERR,INUIF)
QUIT
+54 ; Get type of Ack
+55 SET INACKTYP=$SELECT($EXTRACT($GET(INA("INSTAT")),2)="A":1,1:0)
+56 DO ACK^INHOS(INPARMS(INDSTP,"TTIN"),INACKTYP,INUIF,.INERR,.INA,.INDA,$GET(INQUE),.INACKUIF)
End DoDot:1
IF $DATA(INERR)
QUIT 1
+57 ;
+58 ; Transmit Ack to remote system
+59 ;Start transaction audit
+60 IF $DATA(XUAUDIT)
DO TTSTRT^XUSAUD(INACKUIF,"",$PIECE(^INTHPC(INBPN,0),U),$GET(INHSRVR),"TRANSMIT")
+61 SET INERRACK=$$SEND^INHUVUT(INACKUIF,INCHNL,.INIP)
+62 ;Stop transaction audit
+63 IF $DATA(XUAUDIT)
DO TTSTP^XUSAUD(0)
+64 QUIT INERRACK
+65 ;
