INHVCRL ;DGH,KAC ; 19 Mar 96 10:43; Logon Server (LoS) Background Controller
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q
;
EN ; The Logon Server (LoS) accepts requests for access from remote
; systems. These requests are in the form of HL7 messages. If the
; message meets HL7 specifications, the request is validated. An
; acknowledgement message is then transmitted to the remote system.
;
; GIS INTERFACE TRANSACTION TYPEs supported by the LoS:
; HL XXX LOGON REQUEST FROM REMOTE SYSTEM
; HL XXX LOGON REQUEST FROM REMOTE SYSTEM - ACK
; where: XXX = PWS
;
;
; Assumptions:
; - HL7 Original Acknowledgement Mode is used. (MSH-15/16="")
; - The LoS functions as a server in the TCP client/server model.
; - If the LoS has been signalled to stop, it will complete any
; transaction in progress and then terminate.
;
;
; Input:
; INBPN - BACKGROUND PROCESS CONTROL IEN for LoS
;
;
; Variables:
; INACKUIF - UNIVERSAL INTERFACE IEN for outbound Ack
; INCHNL - TCP channel assigned to the LoS when connection is opened
; INDATA - array containing inbound msg received from remote system
; WARNING: Size of inbound data may require that INDATA
; be replaced with ^UTILITY("INREC",$J). As a result, do
; NOT new this variable - must be killed (see INMSGLOS).
; INDEST - array containing valid inbound destinations for LoS
; Format: INDEST(msg-type_event-type)=
; INTERFACE DESTINATION name for inbound msg
; INDSTP - INTERFACE DESTINATION IEN for inbound msg from
; UNIVERSAL INTERFACE file
; INDSTR - INTERFACE DESTINATION IEN for LoS from BACKGROUND PROCESS
; CONTROL file
; INERR - array containing error msg used to log an error
; INERRLOS - error information returned by function
; INIP - array containing initialization parameters from
; BACKGROUND PROCESS CONTROL file
; INMSGLOS - indirected variable containing location of inbound msg
; 1) local array = INDATA 2) global = ^UTILITY("INREC",$J)
; WARNING: Size of inbound data may require that the local
; array be replaced with global storage.
; INMEM - memory variable used by %INET
; INOA - array containing Ack msg data to be returned to remote system
; INODA - array containing information to be sent to an outbound
; destination
; INODA = IEN in base file used by outbound script
; Subscripts may hold subfile IENs in the format:
; INODA(subfile #,DA)=""
; If NOT needed, set to -1 prior to running outbound script.
; INPARMS - inbound msg parameter array
; Format: INPARMS(INDSTP,"param")=value
; INRUNLOS - flag - 0 = LoS should shutdown
; 1 = LoS should continue running
; INUIF - UNIVERSAL INTERFACE IEN for inbound msg
; INUSEQ - flag - Sequence Number Protocol - 0=off, 1=on
; INXDST - executable code used by IN^INHUSEN to determine INTERFACE
; DESTINATION for an inbound msg
; X - scratch
;
; Output:
; None.
;
; Initialization
N INACKUIF,INCHNL,INDEST,INDSTP,INDSTR,INERR,INERRLOS,INIP,INMSGLOS,INMEM,INOA,INODA,INPARMS,INRUNLOS,INUIF,INUSEQ,INXDST,X
S X="ERR^INHVCRL",@^%ZOSF("TRAP")
D DEBUG^INHVCRA1() ; turn debug on
Q:'$$RUN^INHOTM ; ck shutdown status
;Start GIS Background process audit if flag is set in Site Parms File
N INPNAME S INPNAME=$P(^INTHPC(INBPN,0),U) D AUDCHK^XUSAUD D:$D(XUAUDIT) ITIME^XUSAUD(INPNAME)
L +^INRHB("RUN",INBPN):5 E D
. D LOG^INHVCRA1("Cannot get exclusive lock for: ^INRHB(""RUN"","_INBPN_")","E")
. D SHUTDWN(INBPN)
;
; Get LoS INTERFACE DESTINATION IEN & Destination Determination Code
S INDSTR=$P($G(^INTHPC(INBPN,0)),U,7),INXDST=$G(^(8))
I 'INDSTR D Q
. D LOG^INHVCRA1("No destination designated for background process "_INBPN,"E")
. D SHUTDWN(INBPN)
;
I '$L($G(INXDST)) D Q
. D LOG^INHVCRA1("Missing code to determine inbound message destination for background process "_INBPN,"E")
. D SHUTDWN(INBPN)
;
; Verify designation of LoS port(s)
I '$O(^INTHPC(INBPN,5,0)) D Q
. D LOG^INHVCRA1("No ports designated for background process "_INBPN,"E")
. D SHUTDWN(INBPN)
;
; Get LoS parameters from BACKGROUND PROCESS CONTROL file
D INIT^INHUVUT1(INBPN,.INIP)
;
S INUSEQ=+$P($G(^INRHD(INDSTR,0)),U,9) ; use sequence number protocol?
;
; Main program loop
F D K @INMSGLOS Q:'$G(INRUNLOS)
.;Update background process audit
.D:$D(XUAUDIT) ITIME^XUSAUD(INPNAME)
.; Kill variables that are modified with each incoming/outgoing msg
. K INACKUIF,INDSTP,INERR,INMEM,INOA,INODA,INUIF
.; Error trap positioned to allow for continuation following "non-fatal" error
. S X="ERR^INHVCRL",@^%ZOSF("TRAP")
. S INMSGLOS="INDATA" ; reset local array in which to receive data
.;
.; Select port, open connection & wait for transmissions
. S INRUNLOS=$$RUN^INHOTM Q:'INRUNLOS
. D LOG^INHVCRA1("Listening for connection")
. S INERRLOS=$$OPEN^INHUVUT(INBPN,.INCHNL,.INERR,.INMEM)
. I 'INERRLOS D Q ; open failed - retry
.. D LOG^INHVCRA1(.INERR,"E")
.. D WAIT^INHUVUT(INBPN,INIP("OHNG"),"Waiting to retry open",.INRUNLOS)
.. S INRUNLOS='INRUNLOS
. S INRUNLOS=$$RUN^INHOTM Q:'INRUNLOS
. D LOG^INHVCRA1("Connected")
.;
.; Receive data from remote system
. S INRUNLOS=$$RUN^INHOTM Q:'INRUNLOS
. D LOG^INHVCRA1("Receiving data on channel: "_INCHNL)
. S INERRLOS=$$RECEIVE^INHUVUT(.INMSGLOS,INCHNL,.INIP,.INERR,.INMEM)
. I INERRLOS D RESET^INHVCRL1(INBPN,INCHNL,.INERR) Q
.;
.; Process inbound msg
. S INRUNLOS=$$RUN^INHOTM
. D LOG^INHVCRA1("Processing inbound message")
.;Start transaction audit
. D:$D(XUAUDIT) TTSTRT^XUSAUD("","",$P(^INTHPC(INBPN,0),U),$G(INHSRVR),"RECEIVE")
. S INERRLOS=$$IN^INHUSEN(INMSGLOS,.INDEST,INDSTR,INUSEQ,.INACKUIF,.INERR,INXDST,.INUIF,1)
. ;Stop transaction audit. Pass in UIF entry if it exists.
. D:$D(XUAUDIT) TTSTP^XUSAUD(0,$G(INUIF))
. I INERRLOS D RESET^INHVCRL1(INBPN,INCHNL,.INERR,$S($G(INACKUIF):INACKUIF,1:"AR"),.INIP,$G(INUIF),.INPARMS) Q
.;
.; Get parameters associated with inbound msg (INUIF)
. S INRUNLOS=INRUNLOS&$$RUN^INHOTM
. S INERRLOS=$$INPARMS^INHVCRL2(.INDSTP,.INPARMS,.INERR,INUIF)
. I INERRLOS D RESET^INHVCRL1(INBPN,INCHNL,.INERR) Q
.;
.; Execute inbound script generated for this transaction/destination
. S INRUNLOS=INRUNLOS&$$RUN^INHOTM
. D LOG^INHVCRA1("Executing inbound script for UIF entry = "_INUIF)
.;Start transaction audit
. D:$D(XUAUDIT) TTSTRT^XUSAUD(INUIF,"",$P(^INTHPC(INBPN,0),U),$G(INHSRVR),"SCRIPT")
. S INERRLOS=$$RUNIN^INHVCRL3(INUIF,.INPARMS,INDSTP,.INOA,.INODA,.INERR)
. ;Stop transaction audit.
. D:$D(XUAUDIT) TTSTP^XUSAUD(INERRLOS)
. I INERRLOS D Q
.. S:'$D(INOA) INOA="AR"
.. D RESET^INHVCRL1(INBPN,INCHNL,.INERR,.INOA,.INIP,INUIF,.INPARMS)
.;
.; Send Ack to remote system. INOA array returned by inbound script
.; contains Ack data.
. S INRUNLOS=INRUNLOS&$$RUN^INHOTM
. D LOG^INHVCRA1("Transmitting positive acknowledgement")
. S INERRLOS=$$SNDAACK^INHVCRL2(INBPN,INCHNL,.INIP,.INOA,.INODA,INUIF,.INPARMS,1,.INERR)
. I INERRLOS D RESET^INHVCRL1(INBPN,INCHNL,.INERR) Q
. D LOG^INHVCRA1("Successful transmission","S",1)
.;
.; Close LoS port and wait for another system to connect
. S INRUNLOS=INRUNLOS&$$RUN^INHOTM Q:'INRUNLOS
. D LOG^INHVCRA1("Closing connection")
. D CLOSE(INBPN,INCHNL)
;
;
D SHUTDWN(INBPN,$G(INCHNL))
Q
;
;
SHUTDWN(INBPN,INCHNL) ; Shutdown LoS
; Input:
; INBPN - (req) BACKGROUND PROCESS CONTROL IEN for LoS
; INCHNL - (opt) TCP channel assigned to this server when connection
; is opened
; Output:
; None.
;
D LOG^INHVCRA1("Shutting down")
D CLOSE(INBPN,$G(INCHNL))
D LOG^INHVCRA1("Shutdown")
D DEBUG^INHVCRA1(0) ; turn debugging off
K ^UTILITY("INREC",$J),^UTILITY("INV",$J)
K ^INRHB("RUN",INBPN)
L -^INRHB("RUN",INBPN)
;Stop background process audit
D:$D(XUAUDIT) AUDSTP^XUSAUD
;
Q
;
CLOSE(INBPN,INCHNL) ; Close channel
; Input:
; INBPN - (req) BACKGROUND PROCESS CONTROL IEN for LoS
; INCHNL - (req) TCP channel assigned to this server when connection
; is opened
; Output:
; None.
;
I $G(INCHNL) D
. D CLOSE^%INET(INCHNL)
. D LOG^INHVCRA1("Connection closed")
Q
;
ERR ; Error handler
S X="HALT^INHVCRL",@^%ZOSF("TRAP")
X $G(^INTHOS(1,3)) ; log error in trap
D RESET^INHVCRL1(INBPN,$G(INCHNL),$$ERRMSG^INHU1,"AR",.INIP,$G(INUIF),.INPARMS)
Q:$G(INCHNL) ; return to main loop and reopen connection
;
HALT ; Halt process
D LOG^INHVCRA1("** HALTING - FATAL ERROR **","E")
D SHUTDWN(INBPN,$G(INCHNL))
H
;
PARSE ; Debug Only - Lookup/Store Routine in Message Definition for LoS
S INOA("INSTAT")="AA"
S INOA("ZIL1")="REQ"
S INOA("ZIL4")=373
S INOA("ZIL5")=$P(^DIC(3,373,8000),"^")
S INOA("ZIL6")=$P(^DIC(3,373,200),"^",10)
S INOA("ZIL10")="KERBEROS KEY"
Q
INHVCRL ;DGH,KAC ; 19 Mar 96 10:43; Logon Server (LoS) Background Controller
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 QUIT
+5 ;
EN ; The Logon Server (LoS) accepts requests for access from remote
+1 ; systems. These requests are in the form of HL7 messages. If the
+2 ; message meets HL7 specifications, the request is validated. An
+3 ; acknowledgement message is then transmitted to the remote system.
+4 ;
+5 ; GIS INTERFACE TRANSACTION TYPEs supported by the LoS:
+6 ; HL XXX LOGON REQUEST FROM REMOTE SYSTEM
+7 ; HL XXX LOGON REQUEST FROM REMOTE SYSTEM - ACK
+8 ; where: XXX = PWS
+9 ;
+10 ;
+11 ; Assumptions:
+12 ; - HL7 Original Acknowledgement Mode is used. (MSH-15/16="")
+13 ; - The LoS functions as a server in the TCP client/server model.
+14 ; - If the LoS has been signalled to stop, it will complete any
+15 ; transaction in progress and then terminate.
+16 ;
+17 ;
+18 ; Input:
+19 ; INBPN - BACKGROUND PROCESS CONTROL IEN for LoS
+20 ;
+21 ;
+22 ; Variables:
+23 ; INACKUIF - UNIVERSAL INTERFACE IEN for outbound Ack
+24 ; INCHNL - TCP channel assigned to the LoS when connection is opened
+25 ; INDATA - array containing inbound msg received from remote system
+26 ; WARNING: Size of inbound data may require that INDATA
+27 ; be replaced with ^UTILITY("INREC",$J). As a result, do
+28 ; NOT new this variable - must be killed (see INMSGLOS).
+29 ; INDEST - array containing valid inbound destinations for LoS
+30 ; Format: INDEST(msg-type_event-type)=
+31 ; INTERFACE DESTINATION name for inbound msg
+32 ; INDSTP - INTERFACE DESTINATION IEN for inbound msg from
+33 ; UNIVERSAL INTERFACE file
+34 ; INDSTR - INTERFACE DESTINATION IEN for LoS from BACKGROUND PROCESS
+35 ; CONTROL file
+36 ; INERR - array containing error msg used to log an error
+37 ; INERRLOS - error information returned by function
+38 ; INIP - array containing initialization parameters from
+39 ; BACKGROUND PROCESS CONTROL file
+40 ; INMSGLOS - indirected variable containing location of inbound msg
+41 ; 1) local array = INDATA 2) global = ^UTILITY("INREC",$J)
+42 ; WARNING: Size of inbound data may require that the local
+43 ; array be replaced with global storage.
+44 ; INMEM - memory variable used by %INET
+45 ; INOA - array containing Ack msg data to be returned to remote system
+46 ; INODA - array containing information to be sent to an outbound
+47 ; destination
+48 ; INODA = IEN in base file used by outbound script
+49 ; Subscripts may hold subfile IENs in the format:
+50 ; INODA(subfile #,DA)=""
+51 ; If NOT needed, set to -1 prior to running outbound script.
+52 ; INPARMS - inbound msg parameter array
+53 ; Format: INPARMS(INDSTP,"param")=value
+54 ; INRUNLOS - flag - 0 = LoS should shutdown
+55 ; 1 = LoS should continue running
+56 ; INUIF - UNIVERSAL INTERFACE IEN for inbound msg
+57 ; INUSEQ - flag - Sequence Number Protocol - 0=off, 1=on
+58 ; INXDST - executable code used by IN^INHUSEN to determine INTERFACE
+59 ; DESTINATION for an inbound msg
+60 ; X - scratch
+61 ;
+62 ; Output:
+63 ; None.
+64 ;
+65 ; Initialization
+66 NEW INACKUIF,INCHNL,INDEST,INDSTP,INDSTR,INERR,INERRLOS,INIP,INMSGLOS,INMEM,INOA,INODA,INPARMS,INRUNLOS,INUIF,INUSEQ,INXDST,X
+67 SET X="ERR^INHVCRL"
SET @^%ZOSF("TRAP")
+68 ; turn debug on
DO DEBUG^INHVCRA1()
+69 ; ck shutdown status
IF '$$RUN^INHOTM
QUIT
+70 ;Start GIS Background process audit if flag is set in Site Parms File
+71 NEW INPNAME
SET INPNAME=$PIECE(^INTHPC(INBPN,0),U)
DO AUDCHK^XUSAUD
IF $DATA(XUAUDIT)
DO ITIME^XUSAUD(INPNAME)
+72 LOCK +^INRHB("RUN",INBPN):5
IF '$TEST
Begin DoDot:1
+73 DO LOG^INHVCRA1("Cannot get exclusive lock for: ^INRHB(""RUN"","_INBPN_")","E")
+74 DO SHUTDWN(INBPN)
End DoDot:1
+75 ;
+76 ; Get LoS INTERFACE DESTINATION IEN & Destination Determination Code
+77 SET INDSTR=$PIECE($GET(^INTHPC(INBPN,0)),U,7)
SET INXDST=$GET(^(8))
+78 IF 'INDSTR
Begin DoDot:1
+79 DO LOG^INHVCRA1("No destination designated for background process "_INBPN,"E")
+80 DO SHUTDWN(INBPN)
End DoDot:1
QUIT
+81 ;
+82 IF '$LENGTH($GET(INXDST))
Begin DoDot:1
+83 DO LOG^INHVCRA1("Missing code to determine inbound message destination for background process "_INBPN,"E")
+84 DO SHUTDWN(INBPN)
End DoDot:1
QUIT
+85 ;
+86 ; Verify designation of LoS port(s)
+87 IF '$ORDER(^INTHPC(INBPN,5,0))
Begin DoDot:1
+88 DO LOG^INHVCRA1("No ports designated for background process "_INBPN,"E")
+89 DO SHUTDWN(INBPN)
End DoDot:1
QUIT
+90 ;
+91 ; Get LoS parameters from BACKGROUND PROCESS CONTROL file
+92 DO INIT^INHUVUT1(INBPN,.INIP)
+93 ;
+94 ; use sequence number protocol?
SET INUSEQ=+$PIECE($GET(^INRHD(INDSTR,0)),U,9)
+95 ;
+96 ; Main program loop
+97 FOR
Begin DoDot:1
+98 ;Update background process audit
+99 IF $DATA(XUAUDIT)
DO ITIME^XUSAUD(INPNAME)
+100 ; Kill variables that are modified with each incoming/outgoing msg
+101 KILL INACKUIF,INDSTP,INERR,INMEM,INOA,INODA,INUIF
+102 ; Error trap positioned to allow for continuation following "non-fatal" error
+103 SET X="ERR^INHVCRL"
SET @^%ZOSF("TRAP")
+104 ; reset local array in which to receive data
SET INMSGLOS="INDATA"
+105 ;
+106 ; Select port, open connection & wait for transmissions
+107 SET INRUNLOS=$$RUN^INHOTM
IF 'INRUNLOS
QUIT
+108 DO LOG^INHVCRA1("Listening for connection")
+109 SET INERRLOS=$$OPEN^INHUVUT(INBPN,.INCHNL,.INERR,.INMEM)
+110 ; open failed - retry
IF 'INERRLOS
Begin DoDot:2
+111 DO LOG^INHVCRA1(.INERR,"E")
+112 DO WAIT^INHUVUT(INBPN,INIP("OHNG"),"Waiting to retry open",.INRUNLOS)
+113 SET INRUNLOS='INRUNLOS
End DoDot:2
QUIT
+114 SET INRUNLOS=$$RUN^INHOTM
IF 'INRUNLOS
QUIT
+115 DO LOG^INHVCRA1("Connected")
+116 ;
+117 ; Receive data from remote system
+118 SET INRUNLOS=$$RUN^INHOTM
IF 'INRUNLOS
QUIT
+119 DO LOG^INHVCRA1("Receiving data on channel: "_INCHNL)
+120 SET INERRLOS=$$RECEIVE^INHUVUT(.INMSGLOS,INCHNL,.INIP,.INERR,.INMEM)
+121 IF INERRLOS
DO RESET^INHVCRL1(INBPN,INCHNL,.INERR)
QUIT
+122 ;
+123 ; Process inbound msg
+124 SET INRUNLOS=$$RUN^INHOTM
+125 DO LOG^INHVCRA1("Processing inbound message")
+126 ;Start transaction audit
+127 IF $DATA(XUAUDIT)
DO TTSTRT^XUSAUD("","",$PIECE(^INTHPC(INBPN,0),U),$GET(INHSRVR),"RECEIVE")
+128 SET INERRLOS=$$IN^INHUSEN(INMSGLOS,.INDEST,INDSTR,INUSEQ,.INACKUIF,.INERR,INXDST,.INUIF,1)
+129 ;Stop transaction audit. Pass in UIF entry if it exists.
+130 IF $DATA(XUAUDIT)
DO TTSTP^XUSAUD(0,$GET(INUIF))
+131 IF INERRLOS
DO RESET^INHVCRL1(INBPN,INCHNL,.INERR,$SELECT($GET(INACKUIF):INACKUIF,1:"AR"),.INIP,$GET(INUIF),.INPARMS)
QUIT
+132 ;
+133 ; Get parameters associated with inbound msg (INUIF)
+134 SET INRUNLOS=INRUNLOS&$$RUN^INHOTM
+135 SET INERRLOS=$$INPARMS^INHVCRL2(.INDSTP,.INPARMS,.INERR,INUIF)
+136 IF INERRLOS
DO RESET^INHVCRL1(INBPN,INCHNL,.INERR)
QUIT
+137 ;
+138 ; Execute inbound script generated for this transaction/destination
+139 SET INRUNLOS=INRUNLOS&$$RUN^INHOTM
+140 DO LOG^INHVCRA1("Executing inbound script for UIF entry = "_INUIF)
+141 ;Start transaction audit
+142 IF $DATA(XUAUDIT)
DO TTSTRT^XUSAUD(INUIF,"",$PIECE(^INTHPC(INBPN,0),U),$GET(INHSRVR),"SCRIPT")
+143 SET INERRLOS=$$RUNIN^INHVCRL3(INUIF,.INPARMS,INDSTP,.INOA,.INODA,.INERR)
+144 ;Stop transaction audit.
+145 IF $DATA(XUAUDIT)
DO TTSTP^XUSAUD(INERRLOS)
+146 IF INERRLOS
Begin DoDot:2
+147 IF '$DATA(INOA)
SET INOA="AR"
+148 DO RESET^INHVCRL1(INBPN,INCHNL,.INERR,.INOA,.INIP,INUIF,.INPARMS)
End DoDot:2
QUIT
+149 ;
+150 ; Send Ack to remote system. INOA array returned by inbound script
+151 ; contains Ack data.
+152 SET INRUNLOS=INRUNLOS&$$RUN^INHOTM
+153 DO LOG^INHVCRA1("Transmitting positive acknowledgement")
+154 SET INERRLOS=$$SNDAACK^INHVCRL2(INBPN,INCHNL,.INIP,.INOA,.INODA,INUIF,.INPARMS,1,.INERR)
+155 IF INERRLOS
DO RESET^INHVCRL1(INBPN,INCHNL,.INERR)
QUIT
+156 DO LOG^INHVCRA1("Successful transmission","S",1)
+157 ;
+158 ; Close LoS port and wait for another system to connect
+159 SET INRUNLOS=INRUNLOS&$$RUN^INHOTM
IF 'INRUNLOS
QUIT
+160 DO LOG^INHVCRA1("Closing connection")
+161 DO CLOSE(INBPN,INCHNL)
End DoDot:1
KILL @INMSGLOS
IF '$GET(INRUNLOS)
QUIT
+162 ;
+163 ;
+164 DO SHUTDWN(INBPN,$GET(INCHNL))
+165 QUIT
+166 ;
+167 ;
SHUTDWN(INBPN,INCHNL) ; Shutdown LoS
+1 ; Input:
+2 ; INBPN - (req) BACKGROUND PROCESS CONTROL IEN for LoS
+3 ; INCHNL - (opt) TCP channel assigned to this server when connection
+4 ; is opened
+5 ; Output:
+6 ; None.
+7 ;
+8 DO LOG^INHVCRA1("Shutting down")
+9 DO CLOSE(INBPN,$GET(INCHNL))
+10 DO LOG^INHVCRA1("Shutdown")
+11 ; turn debugging off
DO DEBUG^INHVCRA1(0)
+12 KILL ^UTILITY("INREC",$JOB),^UTILITY("INV",$JOB)
+13 KILL ^INRHB("RUN",INBPN)
+14 LOCK -^INRHB("RUN",INBPN)
+15 ;Stop background process audit
+16 IF $DATA(XUAUDIT)
DO AUDSTP^XUSAUD
+17 ;
+18 QUIT
+19 ;
CLOSE(INBPN,INCHNL) ; Close channel
+1 ; Input:
+2 ; INBPN - (req) BACKGROUND PROCESS CONTROL IEN for LoS
+3 ; INCHNL - (req) TCP channel assigned to this server when connection
+4 ; is opened
+5 ; Output:
+6 ; None.
+7 ;
+8 IF $GET(INCHNL)
Begin DoDot:1
+9 DO CLOSE^%INET(INCHNL)
+10 DO LOG^INHVCRA1("Connection closed")
End DoDot:1
+11 QUIT
+12 ;
ERR ; Error handler
+1 SET X="HALT^INHVCRL"
SET @^%ZOSF("TRAP")
+2 ; log error in trap
XECUTE $GET(^INTHOS(1,3))
+3 DO RESET^INHVCRL1(INBPN,$GET(INCHNL),$$ERRMSG^INHU1,"AR",.INIP,$GET(INUIF),.INPARMS)
+4 ; return to main loop and reopen connection
IF $GET(INCHNL)
QUIT
+5 ;
HALT ; Halt process
+1 DO LOG^INHVCRA1("** HALTING - FATAL ERROR **","E")
+2 DO SHUTDWN(INBPN,$GET(INCHNL))
+3 HANG
+4 ;
PARSE ; Debug Only - Lookup/Store Routine in Message Definition for LoS
+1 SET INOA("INSTAT")="AA"
+2 SET INOA("ZIL1")="REQ"
+3 SET INOA("ZIL4")=373
+4 SET INOA("ZIL5")=$PIECE(^DIC(3,373,8000),"^")
+5 SET INOA("ZIL6")=$PIECE(^DIC(3,373,200),"^",10)
+6 SET INOA("ZIL10")="KERBEROS KEY"
+7 QUIT
