INHVCRA ;KAC,JKB ; 7 Mar 96 14:02; Application Server (ApS)
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q ;no top entry
;
; The Application Server (ApS) accepts service requests from remote
; systems in the form of HL7 messages. If the request maps to an
; active inbound Transaction Type, the message is processed. An
; acknowledgement message is then transmitted to the remote system.
; If signalled to stop, the ApS will complete any transaction in
; progress and then terminate.
;
; The ApS has been originally designed and tested to initiate as a
; client in the TCP client/server model. However, the code should be
; able to allow the ApS to open as a server merely by not passing in an
; IP address (INADDR at EN).
;
; The ApS is intended to be generic with the specifics for a particular
; interface to be held in tables. The related BACKGROUND PROCESS entry
; is "PWS APP SERVER" with a corresponding INTERFACE DESTINATION of
; "HL PWS APP SERVER". For PWS, the PWS specific code is in ^INHVCRAP.
;
EN(INBPN,INHSRVR,INADDR,INPORT,INTICK,INDUZ) ;
;
; Input : all required
; INBPN = BACKGROUND PROCESS CONTROL ptr for ApS
; INHSRVR = server number for this particular ApS
; INADDR = IP address of remote server to connect to as a TCP client,
; or null to open as a TCP server
; INPORT = IP port to open (client or server)
; INTICK = security ticket
; INDUZ = USER ptr
;
; Output : void
;
; Internal :
; ERR = scratch error holder
; INACKUIF = UNIVERSAL INTERFACE IEN of outbound Ack
; INCHNL = TCP channel assigned to ApS
; INDATA = array containing msg received from remote system
; INDEST = array of valid inbound destinations
; INDST = INTERFACE DESTINATION Name for an inbound msg
; INDSTOFF = INTERFACE DESTINATION Name for the ApS login msg
; INDSTON = INTERFACE DESTINATION Name for the ApS logoff msg
; INDSTP = INTERFACE DESTINATION ptr for an inbound msg
; INDSTR = INTERFACE DESTINATION ptr for the ApS receiver
; INERR = error string used to log an error
; ING = indirected variable containing array, INDATA
; INIP = array of init parms from BACKGROUND PROCESS
; INLOGON = boolean flag denoting ApS has processed the logon msg
; INMEM = memory var used ultimately by %INET
; INMSGP = inbound message parameter array (see $$INPARMS^INHVCRL2)
; INOA = msg array output from inbound msg script for use in ack
; INODA = same as INOA, but for file pointers
; INPNAME = name for this BACKGROUND PROCESS
; INUIF = UNIVERSAL INTERFACE ptr of inbound msg
; INUSEQ = Sequence Number Protocol flag (0=off,1=on)
; INXDST = Executable code used by ^INHUSEN to determine INTERFACE
; DESTINATION for an inbound msg
;
; init ApS
N ERR,INACKUIF,INCHNL,INDATA,INDEST,INDST,INDSTON,INDSTOFF,INDSTP,INDSTR,INERR,ING,INIP,INLOGON,INMEM,INMSGP,INOA,INODA,INPNAME,INUIF,INUSEQ,INV,INXDST,X
S U="^",ERR=0,X="ERR^INHVCRA",@^%ZOSF("TRAP"),INPNAME=$P(^INTHPC(INBPN,0),U)
; determine whether debugging and/or instrumentation is on
D DEBUG^INHVCRA1(),AUDCHK^XUSAUD
; start GIS background process audit if instrumentation on
D:$D(XUAUDIT) ITIME^XUSAUD(INPNAME,INHSRVR)
L +^INRHB("RUN","SRVR",INBPN,INHSRVR):10 E D LOG^INHVCRA1("can't lock run node for ApS"_INHSRVR,"E") S ERR=1 G SHUTDWN
D LOG^INHVCRA1("initing Aps for user "_INDUZ,1)
S ERR=$$SETENV^INHULOG(INDUZ) I ERR D LOG^INHVCRA1("bad init for ApS"_INHSRVR_": "_$P(ERR,U,2),"E") G SHUTDWN
; get BACKGROUND PROCESS CONTROL params for the ApS
D INIT^INHUVUT1(INBPN,.INIP)
S INDSTR=$P($G(^INTHPC(INBPN,0)),U,7),INXDST=$G(^(8))
I 'INDSTR D LOG^INHVCRA1("no Destination designated for Background Process","E") S ERR=1 G SHUTDWN
; get INTERFACE DESTINATION params for the ApS
S INUSEQ=$P($G(^INRHD(INDSTR,0)),U,9)
; get logon/logoff msg destinations (these could be table based)
I '$$LOGONDS(.INDSTON) D LOG^INHVCRA1("no logon messsage destination for ApS","E") S ERR=1 G SHUTDWN
I '$$LOGOFFDS(.INDSTOFF) D LOG^INHVCRA1("no logoff messsage destination for ApS","E") S ERR=1 G SHUTDWN
D LOG^INHVCRA1("Aps configured for user "_DUZ,1)
; check shutdown status
I '$$RUN^INHOTM G SHUTDWN
; open connection
D LOG^INHVCRA1("connecting to "_INADDR_"/"_INPORT)
D OPEN^INHVCRA1(.INCHNL,.INMEM,.INADDR,INPORT,.INIP)
I 'INCHNL D LOG^INHVCRA1(INCHNL,"E") S ERR=1 G SHUTDWN
D LOG^INHVCRA1("connected")
;
; Main Message Loop
S INLOGON="" F D Q:INLOGON=0!'$$RUN^INHOTM
.; update background process audit
.D:$D(XUAUDIT) ITIME^XUSAUD(INPNAME,INHSRVR)
.; receive message
.D LOG^INHVCRA1("listening for user "_DUZ)
.K INACKUIF,INDST,INDSTP,INERR,INOA,INODA,INUIF
.S ING="INDATA",ERR=$$RECEIVE^INHVCRA1(.ING,INCHNL,.INIP,.INERR,.INMEM)
.I ERR D LOG^INHVCRA1(.INERR,"E") S INLOGON=0 Q
.; verify and store message
.D LOG^INHVCRA1("processing inbound message")
.; start transaction audit, trans type not known (stop is in INHUSEN)
.D:$D(XUAUDIT) TTSTRT^XUSAUD("","",INPNAME,INHSRVR,"RECEIVE")
.S ERR=$$IN^INHUSEN(ING,.INDEST,INDSTR,INUSEQ,.INACKUIF,.INERR,INXDST,.INUIF,1)
.; if message not stored, build error array to include input array
.I $G(INUIF)<1 D
..N I,J,X
..I $D(INERR)=1 S X=INERR K INERR I $L(X) S INERR(1)=X
..S I=$O(INERR(""),-1)+1,J=""
..S INERR(I)="msg not stored - input buffer "_ING_" follows:"
..F S J=$O(@ING@(J)) Q:J="" S I=I+1,INERR(I)=J_U_@ING@(J)
.K @ING
.I ERR D REJECT(.INERR) Q
.; get message params for inbound destination
.S ERR=$$INPARMS^INHVCRL2(.INDSTP,.INMSGP,.INERR,INUIF)
.I ERR D REJECT(.INERR) Q
.; if no error and ack built, must be a commit ack
.I $G(INACKUIF)>0 S INOA("INSTAT")="CA" D SENDACK
.S INDST=INMSGP(INDSTP,"DSIN01")
.; check for receipt of a 2nd logon msg
.I INLOGON,INDST=INDSTON D REJECT("unexpected 2nd logon message") Q
.; check whether logon is first msg received
.I 'INLOGON S INLOGON=INDST=INDSTON I 'INLOGON D REJECT("first message not a logon") Q ; shutdown ApS
.; set flag if logoff msg has been received
.I INDST=INDSTOFF S INLOGON=0
.; execute the inbound script for transaction
.D LOG^INHVCRA1("executing for destination "_INDST,1)
.; start transaction audit
.D:$D(XUAUDIT) TTSTRT^XUSAUD(INUIF,"",INPNAME,INHSRVR,"SCRIPT")
.S ERR=$$RUNIN^INHVCRL3(INUIF,.INMSGP,INDSTP,.INOA,.INODA,.INERR)
.; stop transaction audit
.D:$D(XUAUDIT) TTSTP^XUSAUD(ERR)
.I ERR D REJECT(.INERR) S:INDST=INDSTON INLOGON=0 Q ; shutdown ApS if logon failed
.; send Ack
.S INOA("INSTAT")="AA" D SENDACK
.I ERR S:INDST=INDSTON INLOGON=0 Q ; shutdown ApS if logon Ack failed
;
SHUTDWN ; shutdown ApS
D:$G(INCHNL) CLOSE^%INET(INCHNL)
K ^UTILITY("INREC",$J),^UTILITY("INV",$J)
K ^INRHB("RUN","SRVR",INBPN,INHSRVR)
L -^INRHB("RUN","SRVR",INBPN,INHSRVR)
D LOG^INHVCRA1("shutdown",1),DEBUG^INHVCRA1(0)
; stop background process audit
D:$D(XUAUDIT) AUDSTP^XUSAUD
Q
;
ERR ; error trap vector
; reset trap
S ERR=1,X="SHUTDWN^INHVCRA",@^%ZOSF("TRAP")
; log error
D ERRLOG^%ZTOS,LOG^INHVCRA1($$ERRMSG^INHU1,"E")
G SHUTDWN
;
REJECT(INERR) ; reject inbound message
; Input : INERR (req) = error msg
; Output: void
; log error
D LOG^INHVCRA1(.INERR,"E")
S INOA("INSTAT")="AR"
SENDACK ; send acknowledgement
; Input : INACKUIF,INBPN,INCHNL,INERR,INIP(),INOA,INUIF,INMSGP()
; Output: void
; ERR,INACKUIF
I '$D(INOA("INSTAT")) D LOG^INHVCRA1("unknown ack status","E") S INOA("INSTAT")="AE"
I $G(INACKUIF)<1 D Q:$G(INACKUIF)<1
.I $G(INUIF)<1 D LOG^INHVCRA1("msg unavailable to ack","E") S ERR=1 Q
.D LOG^INHVCRA1("creating ack for "_INUIF)
.D ACK^INHOS(INMSGP(INDSTP,"TTIN"),"",INUIF,.INERR,.INOA,.INODA,1,.INACKUIF) K:$L($G(INV)) @INV
.I $G(INACKUIF)<1 D LOG^INHVCRA1("error in ack creation","E") S ERR=1 Q
D LOG^INHVCRA1("sending "_INOA("INSTAT")_" ack "_INACKUIF)
; start transaction audit
D:$D(XUAUDIT) TTSTRT^XUSAUD(INACKUIF,"",INPNAME,INHSRVR,"TRANSMIT")
S ERR=$$SEND^INHUVUT(INACKUIF,INCHNL,.INIP)
; stop transaction audit
D:$D(XUAUDIT) TTSTP^XUSAUD(ERR)
I ERR D LOG^INHVCRA1("error in ack transmission","E") S ERR=1 Q
D LOG^INHVCRA1("ack sent","S",$E(INOA("INSTAT"),2)="A")
Q
;
LOGONDS(X) ; get the logon message destination
; Input : X (opt) = var for logon msg INTERFACE DESTINATION Name (pbr)
; Output: boolean; returns true if logon dest found; else false
S X="HL INH APPLICATION SERVER LOGON"
Q $D(^INRHD("B",X))>9
;
LOGOFFDS(X) ; get the logoff message destination
; Input : X (opt) = var for logoff msg INTERFACE DESTINATION Name (pbr)
; Output: boolean; returns true if logoff dest found; else false
S X="HL INH APPLICATION SERVER LOGOFF"
Q $D(^INRHD("B",X))>9
INHVCRA ;KAC,JKB ; 7 Mar 96 14:02; Application Server (ApS)
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ;no top entry
QUIT
+5 ;
+6 ; The Application Server (ApS) accepts service requests from remote
+7 ; systems in the form of HL7 messages. If the request maps to an
+8 ; active inbound Transaction Type, the message is processed. An
+9 ; acknowledgement message is then transmitted to the remote system.
+10 ; If signalled to stop, the ApS will complete any transaction in
+11 ; progress and then terminate.
+12 ;
+13 ; The ApS has been originally designed and tested to initiate as a
+14 ; client in the TCP client/server model. However, the code should be
+15 ; able to allow the ApS to open as a server merely by not passing in an
+16 ; IP address (INADDR at EN).
+17 ;
+18 ; The ApS is intended to be generic with the specifics for a particular
+19 ; interface to be held in tables. The related BACKGROUND PROCESS entry
+20 ; is "PWS APP SERVER" with a corresponding INTERFACE DESTINATION of
+21 ; "HL PWS APP SERVER". For PWS, the PWS specific code is in ^INHVCRAP.
+22 ;
EN(INBPN,INHSRVR,INADDR,INPORT,INTICK,INDUZ) ;
+1 ;
+2 ; Input : all required
+3 ; INBPN = BACKGROUND PROCESS CONTROL ptr for ApS
+4 ; INHSRVR = server number for this particular ApS
+5 ; INADDR = IP address of remote server to connect to as a TCP client,
+6 ; or null to open as a TCP server
+7 ; INPORT = IP port to open (client or server)
+8 ; INTICK = security ticket
+9 ; INDUZ = USER ptr
+10 ;
+11 ; Output : void
+12 ;
+13 ; Internal :
+14 ; ERR = scratch error holder
+15 ; INACKUIF = UNIVERSAL INTERFACE IEN of outbound Ack
+16 ; INCHNL = TCP channel assigned to ApS
+17 ; INDATA = array containing msg received from remote system
+18 ; INDEST = array of valid inbound destinations
+19 ; INDST = INTERFACE DESTINATION Name for an inbound msg
+20 ; INDSTOFF = INTERFACE DESTINATION Name for the ApS login msg
+21 ; INDSTON = INTERFACE DESTINATION Name for the ApS logoff msg
+22 ; INDSTP = INTERFACE DESTINATION ptr for an inbound msg
+23 ; INDSTR = INTERFACE DESTINATION ptr for the ApS receiver
+24 ; INERR = error string used to log an error
+25 ; ING = indirected variable containing array, INDATA
+26 ; INIP = array of init parms from BACKGROUND PROCESS
+27 ; INLOGON = boolean flag denoting ApS has processed the logon msg
+28 ; INMEM = memory var used ultimately by %INET
+29 ; INMSGP = inbound message parameter array (see $$INPARMS^INHVCRL2)
+30 ; INOA = msg array output from inbound msg script for use in ack
+31 ; INODA = same as INOA, but for file pointers
+32 ; INPNAME = name for this BACKGROUND PROCESS
+33 ; INUIF = UNIVERSAL INTERFACE ptr of inbound msg
+34 ; INUSEQ = Sequence Number Protocol flag (0=off,1=on)
+35 ; INXDST = Executable code used by ^INHUSEN to determine INTERFACE
+36 ; DESTINATION for an inbound msg
+37 ;
+38 ; init ApS
+39 NEW ERR,INACKUIF,INCHNL,INDATA,INDEST,INDST,INDSTON,INDSTOFF,INDSTP,INDSTR,INERR,ING,INIP,INLOGON,INMEM,INMSGP,INOA,INODA,INPNAME,INUIF,INUSEQ,INV,INXDST,X
+40 SET U="^"
SET ERR=0
SET X="ERR^INHVCRA"
SET @^%ZOSF("TRAP")
SET INPNAME=$PIECE(^INTHPC(INBPN,0),U)
+41 ; determine whether debugging and/or instrumentation is on
+42 DO DEBUG^INHVCRA1()
DO AUDCHK^XUSAUD
+43 ; start GIS background process audit if instrumentation on
+44 IF $DATA(XUAUDIT)
DO ITIME^XUSAUD(INPNAME,INHSRVR)
+45 LOCK +^INRHB("RUN","SRVR",INBPN,INHSRVR):10
IF '$TEST
DO LOG^INHVCRA1("can't lock run node for ApS"_INHSRVR,"E")
SET ERR=1
GOTO SHUTDWN
+46 DO LOG^INHVCRA1("initing Aps for user "_INDUZ,1)
+47 SET ERR=$$SETENV^INHULOG(INDUZ)
IF ERR
DO LOG^INHVCRA1("bad init for ApS"_INHSRVR_": "_$PIECE(ERR,U,2),"E")
GOTO SHUTDWN
+48 ; get BACKGROUND PROCESS CONTROL params for the ApS
+49 DO INIT^INHUVUT1(INBPN,.INIP)
+50 SET INDSTR=$PIECE($GET(^INTHPC(INBPN,0)),U,7)
SET INXDST=$GET(^(8))
+51 IF 'INDSTR
DO LOG^INHVCRA1("no Destination designated for Background Process","E")
SET ERR=1
GOTO SHUTDWN
+52 ; get INTERFACE DESTINATION params for the ApS
+53 SET INUSEQ=$PIECE($GET(^INRHD(INDSTR,0)),U,9)
+54 ; get logon/logoff msg destinations (these could be table based)
+55 IF '$$LOGONDS(.INDSTON)
DO LOG^INHVCRA1("no logon messsage destination for ApS","E")
SET ERR=1
GOTO SHUTDWN
+56 IF '$$LOGOFFDS(.INDSTOFF)
DO LOG^INHVCRA1("no logoff messsage destination for ApS","E")
SET ERR=1
GOTO SHUTDWN
+57 DO LOG^INHVCRA1("Aps configured for user "_DUZ,1)
+58 ; check shutdown status
+59 IF '$$RUN^INHOTM
GOTO SHUTDWN
+60 ; open connection
+61 DO LOG^INHVCRA1("connecting to "_INADDR_"/"_INPORT)
+62 DO OPEN^INHVCRA1(.INCHNL,.INMEM,.INADDR,INPORT,.INIP)
+63 IF 'INCHNL
DO LOG^INHVCRA1(INCHNL,"E")
SET ERR=1
GOTO SHUTDWN
+64 DO LOG^INHVCRA1("connected")
+65 ;
+66 ; Main Message Loop
+67 SET INLOGON=""
FOR
Begin DoDot:1
+68 ; update background process audit
+69 IF $DATA(XUAUDIT)
DO ITIME^XUSAUD(INPNAME,INHSRVR)
+70 ; receive message
+71 DO LOG^INHVCRA1("listening for user "_DUZ)
+72 KILL INACKUIF,INDST,INDSTP,INERR,INOA,INODA,INUIF
+73 SET ING="INDATA"
SET ERR=$$RECEIVE^INHVCRA1(.ING,INCHNL,.INIP,.INERR,.INMEM)
+74 IF ERR
DO LOG^INHVCRA1(.INERR,"E")
SET INLOGON=0
QUIT
+75 ; verify and store message
+76 DO LOG^INHVCRA1("processing inbound message")
+77 ; start transaction audit, trans type not known (stop is in INHUSEN)
+78 IF $DATA(XUAUDIT)
DO TTSTRT^XUSAUD("","",INPNAME,INHSRVR,"RECEIVE")
+79 SET ERR=$$IN^INHUSEN(ING,.INDEST,INDSTR,INUSEQ,.INACKUIF,.INERR,INXDST,.INUIF,1)
+80 ; if message not stored, build error array to include input array
+81 IF $GET(INUIF)<1
Begin DoDot:2
+82 NEW I,J,X
+83 IF $DATA(INERR)=1
SET X=INERR
KILL INERR
IF $LENGTH(X)
SET INERR(1)=X
+84 SET I=$ORDER(INERR(""),-1)+1
SET J=""
+85 SET INERR(I)="msg not stored - input buffer "_ING_" follows:"
+86 FOR
SET J=$ORDER(@ING@(J))
IF J=""
QUIT
SET I=I+1
SET INERR(I)=J_U_@ING@(J)
End DoDot:2
+87 KILL @ING
+88 IF ERR
DO REJECT(.INERR)
QUIT
+89 ; get message params for inbound destination
+90 SET ERR=$$INPARMS^INHVCRL2(.INDSTP,.INMSGP,.INERR,INUIF)
+91 IF ERR
DO REJECT(.INERR)
QUIT
+92 ; if no error and ack built, must be a commit ack
+93 IF $GET(INACKUIF)>0
SET INOA("INSTAT")="CA"
DO SENDACK
+94 SET INDST=INMSGP(INDSTP,"DSIN01")
+95 ; check for receipt of a 2nd logon msg
+96 IF INLOGON
IF INDST=INDSTON
DO REJECT("unexpected 2nd logon message")
QUIT
+97 ; check whether logon is first msg received
+98 ; shutdown ApS
IF 'INLOGON
SET INLOGON=INDST=INDSTON
IF 'INLOGON
DO REJECT("first message not a logon")
QUIT
+99 ; set flag if logoff msg has been received
+100 IF INDST=INDSTOFF
SET INLOGON=0
+101 ; execute the inbound script for transaction
+102 DO LOG^INHVCRA1("executing for destination "_INDST,1)
+103 ; start transaction audit
+104 IF $DATA(XUAUDIT)
DO TTSTRT^XUSAUD(INUIF,"",INPNAME,INHSRVR,"SCRIPT")
+105 SET ERR=$$RUNIN^INHVCRL3(INUIF,.INMSGP,INDSTP,.INOA,.INODA,.INERR)
+106 ; stop transaction audit
+107 IF $DATA(XUAUDIT)
DO TTSTP^XUSAUD(ERR)
+108 ; shutdown ApS if logon failed
IF ERR
DO REJECT(.INERR)
IF INDST=INDSTON
SET INLOGON=0
QUIT
+109 ; send Ack
+110 SET INOA("INSTAT")="AA"
DO SENDACK
+111 ; shutdown ApS if logon Ack failed
IF ERR
IF INDST=INDSTON
SET INLOGON=0
QUIT
End DoDot:1
IF INLOGON=0!'$$RUN^INHOTM
QUIT
+112 ;
SHUTDWN ; shutdown ApS
+1 IF $GET(INCHNL)
DO CLOSE^%INET(INCHNL)
+2 KILL ^UTILITY("INREC",$JOB),^UTILITY("INV",$JOB)
+3 KILL ^INRHB("RUN","SRVR",INBPN,INHSRVR)
+4 LOCK -^INRHB("RUN","SRVR",INBPN,INHSRVR)
+5 DO LOG^INHVCRA1("shutdown",1)
DO DEBUG^INHVCRA1(0)
+6 ; stop background process audit
+7 IF $DATA(XUAUDIT)
DO AUDSTP^XUSAUD
+8 QUIT
+9 ;
ERR ; error trap vector
+1 ; reset trap
+2 SET ERR=1
SET X="SHUTDWN^INHVCRA"
SET @^%ZOSF("TRAP")
+3 ; log error
+4 DO ERRLOG^%ZTOS
DO LOG^INHVCRA1($$ERRMSG^INHU1,"E")
+5 GOTO SHUTDWN
+6 ;
REJECT(INERR) ; reject inbound message
+1 ; Input : INERR (req) = error msg
+2 ; Output: void
+3 ; log error
+4 DO LOG^INHVCRA1(.INERR,"E")
+5 SET INOA("INSTAT")="AR"
SENDACK ; send acknowledgement
+1 ; Input : INACKUIF,INBPN,INCHNL,INERR,INIP(),INOA,INUIF,INMSGP()
+2 ; Output: void
+3 ; ERR,INACKUIF
+4 IF '$DATA(INOA("INSTAT"))
DO LOG^INHVCRA1("unknown ack status","E")
SET INOA("INSTAT")="AE"
+5 IF $GET(INACKUIF)<1
Begin DoDot:1
+6 IF $GET(INUIF)<1
DO LOG^INHVCRA1("msg unavailable to ack","E")
SET ERR=1
QUIT
+7 DO LOG^INHVCRA1("creating ack for "_INUIF)
+8 DO ACK^INHOS(INMSGP(INDSTP,"TTIN"),"",INUIF,.INERR,.INOA,.INODA,1,.INACKUIF)
IF $LENGTH($GET(INV))
KILL @INV
+9 IF $GET(INACKUIF)<1
DO LOG^INHVCRA1("error in ack creation","E")
SET ERR=1
QUIT
End DoDot:1
IF $GET(INACKUIF)<1
QUIT
+10 DO LOG^INHVCRA1("sending "_INOA("INSTAT")_" ack "_INACKUIF)
+11 ; start transaction audit
+12 IF $DATA(XUAUDIT)
DO TTSTRT^XUSAUD(INACKUIF,"",INPNAME,INHSRVR,"TRANSMIT")
+13 SET ERR=$$SEND^INHUVUT(INACKUIF,INCHNL,.INIP)
+14 ; stop transaction audit
+15 IF $DATA(XUAUDIT)
DO TTSTP^XUSAUD(ERR)
+16 IF ERR
DO LOG^INHVCRA1("error in ack transmission","E")
SET ERR=1
QUIT
+17 DO LOG^INHVCRA1("ack sent","S",$EXTRACT(INOA("INSTAT"),2)="A")
+18 QUIT
+19 ;
LOGONDS(X) ; get the logon message destination
+1 ; Input : X (opt) = var for logon msg INTERFACE DESTINATION Name (pbr)
+2 ; Output: boolean; returns true if logon dest found; else false
+3 SET X="HL INH APPLICATION SERVER LOGON"
+4 QUIT $DATA(^INRHD("B",X))>9
+5 ;
LOGOFFDS(X) ; get the logoff message destination
+1 ; Input : X (opt) = var for logoff msg INTERFACE DESTINATION Name (pbr)
+2 ; Output: boolean; returns true if logoff dest found; else false
+3 SET X="HL INH APPLICATION SERVER LOGOFF"
+4 QUIT $DATA(^INRHD("B",X))>9
