INHVCRLD ;KAC,DP ; 4 Apr 96 15:16; Logon Server (LoS) Background Controller Test Transmitter
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
;This is a modify copy of ^INHVCRLT
;It send back the IEN of the ack logon message.
Q
;
EN ; The Test Transmitter sends PWS logon requests for access to a CHCS
; Logon Server. These requests are in the form of HL7 messages. An
; acknowledgement message is received in response to this logon
; request.
;
; Assumptions:
;
;The Test Transmitter function as a client in the TCP client/server model.
;
; Input:
; INBPN - BACKGROUND PROCESS CONTROL IEN for Test Transmitter
;
;
; Variables:
; INACKUIF - UNIVERSAL INTERFACE IEN for outbound Ack
; INCHNL - TCP channel assigned to this Test Transmitter 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 INMSGTST).
; INDEST - array containing valid destinations for Test Transmitter
; Format: INDEST(msg-type_event-type)=
; INTERFACE DESTINATION name for inbound msg
; INDSTR - INTERFACE DESTINATION IEN for Test Transmitter from
; BACKGROUND PROCESS CONTROL file
; INERR - array containing error msg used to log an error
; INERRTST - error information returned by function
; INMSGTST - 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.
; INIP - array containing initialization parameters from
; BACKGROUND PROCESS CONTROL file
; INMEM - memory variable used by %INET
; INRUNTST - flag - 0 = Test Transmitter should shutdown
; 1 = Test Transmitter should continue running
; INUIF - UNIVERSAL INTERFACE IEN for inbound msg
; INUSEQ - flag - Sequence Number Protocol - 0=off, 1=on
; X,Y,Z - scratch
;
; Output:
; None.
;
; Initialization
S INQKILL=1 ; kill entry after sending - yes/no
S:'$D(INDEBUG) INDEBUG=0
I INDEBUG D Q:POP
.S %ZIS="QM" D ^%ZIS Q:POP
.U IO W !!,$$CDATASC^%ZTFDT($H,2,2)_" Entering Test Transmitter"
;
N INCHNL,INDEST,INDSTR,INERRTST,INMSGTST,INIP,INRUNTST,INUSEQ,X,Y,Z
S X="ERR^INHVCRLD",@^%ZOSF("TRAP")
Q:'$$RUN^INHOTM ; ck shutdown status
;
S POP=0 F INSER=1:1 D Q:POP
.L +^INRHB("RUN","SRVR",INBPN,INSER):5 S POP=1
.;D SHUTDWN(INBPN)
;
; Get Test Transmitter INTERFACE DESTINATION IEN
S INDSTR=+$P($G(^INTHPC(INBPN,0)),U,7)
I 'INDSTR D Q
.D ENR^INHE(INBPN,"No destination designated for background process "_INBPN)
.D SHUTDWN(INBPN)
;
; Get Test Transmitter parameters from BACKGROUND PROCESS CONTROL file
D INIT^INHUVUT(INBPN,.INIP)
;
; Set array of valid inbound INTERFACE DESTINATION names
F X=1:1 S Y=$T(DEST+X) Q:Y'[";;" S Z=$TR($P(Y,";;")," ",""),INDEST(Z)=$P(Y,";;",2)
;
S INUSEQ=+$P($G(^INRHD(INDSTR,0)),U,9) ; use sequence number protocol?
;
;;;;;; Main program loop
N INACKUIF,INERR,INMEM,INMSGTST
; Error trap positioned to allow for continuation following
; "non-fatal" error
S X="ERR^INHVCRLD",@^%ZOSF("TRAP")
S INMSGTST="INDATA" ; reset local array in which to receive data
;
; Select port, open connection
W:INDEBUG !!?5,$$CDATASC^%ZTFDT($H,2,2)_" Opening socket"
F D Q:INERRTST!'INRUNTST D WAIT^INHUVUT(INBPN,INIP("OHNG"))
. S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Attempting to open socket") Q:'INRUNTST
.S INERRTST=$$OPEN^INHUVUT(INBPN,.INCHNL,.INERR,.INMEM)
S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Socket opened") Q:'INRUNTST
;
;Logon message
S INUIF=$O(^UTILITY("INTHU",DUZ,TESTNUM,.5,""))
;
Q:'INRUNTST
;
; Send data to CHCS system
W:INDEBUG !!?10,$$CDATASC^%ZTFDT($H,2,2)_" Sending data to CHCS system on channel: "_$G(INCHNL)
F D Q:'INERRTST!'INRUNTST D WAIT^INHUVUT(INBPN,INIP("SHNG"))
.S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Sending data to CHCS system")
.Q:'INRUNTST
.S INERRTST=$$SEND^INHUVUT(INUIF,INCHNL,.INIP)
Q:'INRUNTST
;
; Receive data from remote system
W:INDEBUG !!?10,$$CDATASC^%ZTFDT($H,2,2)_" Waiting to receive Ack from CHCS"
S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Waiting to receive Ack from CHCS")
Q:'INRUNTST
S INERRTST=$$RECEIVE^INHUVUT(.INMSGTST,INCHNL,.INIP,.INERR,.INMEM)
I INERRTST D Q
.D ENR^INHE(INBPN,"Error during receive of Ack from CHCS= "_$G(INERR))
.D SHUTDWN(INBPN)
.W:INDEBUG !!?10,$$CDATASC^%ZTFDT($H,2,2)_" Error during receive of Ack from CHCS - closing socket"
;
W:INDEBUG !!?10,$$CDATASC^%ZTFDT($H,2,2)_" Processing inbound message"
S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Processing inbound message")
S INERRTST=$$IN^INHUSEN(INMSGTST,.INDEST,INDSTR,INUSEQ,.INACKUIF,.INERR,"",.INUIF,1)
I INERRTST D Q
.D ENR^INHE(INBPN,"Error during processing of Ack= "_$G(INERR))
.D SHUTDWN(INBPN)
.W:INDEBUG !!?10,$$CDATASC^%ZTFDT($H,2,2)_" Error during processing of Ack from CHCS - closing socket"
;
; Close Test Transmitter port and re-open to send another message
D:INDEBUG
.W:INDEBUG !!?10,$$CDATASC^%ZTFDT($H,2,2)_" Closing socket"
.W:INDEBUG !!?15,"Inbound msg UIF = "_$G(INUIF)
S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Closing Socket") Q:'INRUNTST
D SHUTDWN(INBPN)
S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Idle",1) Q:'INRUNTST
;
D SHUTDWN(INBPN)
Q
;
SHUTDWN(INBPN) ; Shutdown Test Transmitter
N X
S X=$$INRHB^INHUVUT1(INBPN,"Shutting down",2)
I $G(INCHNL) D
.N X D CLOSE^%INET(INCHNL)
.S X=$$INRHB^INHUVUT1(INBPN,"Socket closed")
Q
;
ERR ; Error handler
S X="HALT^INHVCRLD",@^%ZOSF("TRAP")
X $G(^INTHOS(1,3)) ; log error in trap
D:INDEBUG
. U IO ; error trap uses another file
. W !!,$$CDATASC^%ZTFDT($H,2,2)_" System error: "_$$ERRMSG^INHU1
D ENR^INHE(INBPN,$$ERRMSG^INHU1)
D SHUTDWN(INBPN)
Q:$G(INCHNL) ; return to main loop and reopen connection
;
HALT ; Halt process
D:INDEBUG
.X $G(^INTHOS(1,3)) ; log error in trap
.U IO
.W !!,$$CDATASC^%ZTFDT($H,2,2)_" ***** HALTING - FATAL ERROR *****"
.W !!,"Symbol table upon exit:"
;
K ^UTILITY("INREC",$J),^UTILITY("INV",$J)
H
;
DEST ; The following tags identify valid message destinations.
ACKACK ;;TEST INTERACTIVE
;
PARSE ; PWS Test Transmitter Lookup Routine
Q
;
INHVCRLD ;KAC,DP ; 4 Apr 96 15:16; Logon Server (LoS) Background Controller Test Transmitter
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ;This is a modify copy of ^INHVCRLT
+5 ;It send back the IEN of the ack logon message.
+6 QUIT
+7 ;
EN ; The Test Transmitter sends PWS logon requests for access to a CHCS
+1 ; Logon Server. These requests are in the form of HL7 messages. An
+2 ; acknowledgement message is received in response to this logon
+3 ; request.
+4 ;
+5 ; Assumptions:
+6 ;
+7 ;The Test Transmitter function as a client in the TCP client/server model.
+8 ;
+9 ; Input:
+10 ; INBPN - BACKGROUND PROCESS CONTROL IEN for Test Transmitter
+11 ;
+12 ;
+13 ; Variables:
+14 ; INACKUIF - UNIVERSAL INTERFACE IEN for outbound Ack
+15 ; INCHNL - TCP channel assigned to this Test Transmitter when
+16 ; connection is opened
+17 ; INDATA - array containing inbound msg received from remote system
+18 ; WARNING: Size of inbound data may require that INDATA
+19 ; be replaced with ^UTILITY("INREC",$J). As a result, do
+20 ; NOT new this variable - must be killed (see INMSGTST).
+21 ; INDEST - array containing valid destinations for Test Transmitter
+22 ; Format: INDEST(msg-type_event-type)=
+23 ; INTERFACE DESTINATION name for inbound msg
+24 ; INDSTR - INTERFACE DESTINATION IEN for Test Transmitter from
+25 ; BACKGROUND PROCESS CONTROL file
+26 ; INERR - array containing error msg used to log an error
+27 ; INERRTST - error information returned by function
+28 ; INMSGTST - indirected variable containing location of inbound msg
+29 ; 1) local array = INDATA 2) global = ^UTILITY("INREC",$J)
+30 ; WARNING: Size of inbound data may require that the local
+31 ; array be replaced with global storage.
+32 ; INIP - array containing initialization parameters from
+33 ; BACKGROUND PROCESS CONTROL file
+34 ; INMEM - memory variable used by %INET
+35 ; INRUNTST - flag - 0 = Test Transmitter should shutdown
+36 ; 1 = Test Transmitter should continue running
+37 ; INUIF - UNIVERSAL INTERFACE IEN for inbound msg
+38 ; INUSEQ - flag - Sequence Number Protocol - 0=off, 1=on
+39 ; X,Y,Z - scratch
+40 ;
+41 ; Output:
+42 ; None.
+43 ;
+44 ; Initialization
+45 ; kill entry after sending - yes/no
SET INQKILL=1
+46 IF '$DATA(INDEBUG)
SET INDEBUG=0
+47 IF INDEBUG
Begin DoDot:1
+48 SET %ZIS="QM"
DO ^%ZIS
IF POP
QUIT
+49 USE IO
WRITE !!,$$CDATASC^%ZTFDT($HOROLOG,2,2)_" Entering Test Transmitter"
End DoDot:1
IF POP
QUIT
+50 ;
+51 NEW INCHNL,INDEST,INDSTR,INERRTST,INMSGTST,INIP,INRUNTST,INUSEQ,X,Y,Z
+52 SET X="ERR^INHVCRLD"
SET @^%ZOSF("TRAP")
+53 ; ck shutdown status
IF '$$RUN^INHOTM
QUIT
+54 ;
+55 SET POP=0
FOR INSER=1:1
Begin DoDot:1
+56 LOCK +^INRHB("RUN","SRVR",INBPN,INSER):5
SET POP=1
+57 ;D SHUTDWN(INBPN)
End DoDot:1
IF POP
QUIT
+58 ;
+59 ; Get Test Transmitter INTERFACE DESTINATION IEN
+60 SET INDSTR=+$PIECE($GET(^INTHPC(INBPN,0)),U,7)
+61 IF 'INDSTR
Begin DoDot:1
+62 DO ENR^INHE(INBPN,"No destination designated for background process "_INBPN)
+63 DO SHUTDWN(INBPN)
End DoDot:1
QUIT
+64 ;
+65 ; Get Test Transmitter parameters from BACKGROUND PROCESS CONTROL file
+66 DO INIT^INHUVUT(INBPN,.INIP)
+67 ;
+68 ; Set array of valid inbound INTERFACE DESTINATION names
+69 FOR X=1:1
SET Y=$TEXT(DEST+X)
IF Y'[";;"
QUIT
SET Z=$TRANSLATE($PIECE(Y,";;")," ","")
SET INDEST(Z)=$PIECE(Y,";;",2)
+70 ;
+71 ; use sequence number protocol?
SET INUSEQ=+$PIECE($GET(^INRHD(INDSTR,0)),U,9)
+72 ;
+73 ;;;;;; Main program loop
+74 NEW INACKUIF,INERR,INMEM,INMSGTST
+75 ; Error trap positioned to allow for continuation following
+76 ; "non-fatal" error
+77 SET X="ERR^INHVCRLD"
SET @^%ZOSF("TRAP")
+78 ; reset local array in which to receive data
SET INMSGTST="INDATA"
+79 ;
+80 ; Select port, open connection
+81 IF INDEBUG
WRITE !!?5,$$CDATASC^%ZTFDT($HOROLOG,2,2)_" Opening socket"
+82 FOR
Begin DoDot:1
+83 SET INRUNTST=$$INRHB^INHUVUT1(INBPN,"Attempting to open socket")
IF 'INRUNTST
QUIT
+84 SET INERRTST=$$OPEN^INHUVUT(INBPN,.INCHNL,.INERR,.INMEM)
End DoDot:1
IF INERRTST!'INRUNTST
QUIT
DO WAIT^INHUVUT(INBPN,INIP("OHNG"))
+85 SET INRUNTST=$$INRHB^INHUVUT1(INBPN,"Socket opened")
IF 'INRUNTST
QUIT
+86 ;
+87 ;Logon message
+88 SET INUIF=$ORDER(^UTILITY("INTHU",DUZ,TESTNUM,.5,""))
+89 ;
+90 IF 'INRUNTST
QUIT
+91 ;
+92 ; Send data to CHCS system
+93 IF INDEBUG
WRITE !!?10,$$CDATASC^%ZTFDT($HOROLOG,2,2)_" Sending data to CHCS system on channel: "_$GET(INCHNL)
+94 FOR
Begin DoDot:1
+95 SET INRUNTST=$$INRHB^INHUVUT1(INBPN,"Sending data to CHCS system")
+96 IF 'INRUNTST
QUIT
+97 SET INERRTST=$$SEND^INHUVUT(INUIF,INCHNL,.INIP)
End DoDot:1
IF 'INERRTST!'INRUNTST
QUIT
DO WAIT^INHUVUT(INBPN,INIP("SHNG"))
+98 IF 'INRUNTST
QUIT
+99 ;
+100 ; Receive data from remote system
+101 IF INDEBUG
WRITE !!?10,$$CDATASC^%ZTFDT($HOROLOG,2,2)_" Waiting to receive Ack from CHCS"
+102 SET INRUNTST=$$INRHB^INHUVUT1(INBPN,"Waiting to receive Ack from CHCS")
+103 IF 'INRUNTST
QUIT
+104 SET INERRTST=$$RECEIVE^INHUVUT(.INMSGTST,INCHNL,.INIP,.INERR,.INMEM)
+105 IF INERRTST
Begin DoDot:1
+106 DO ENR^INHE(INBPN,"Error during receive of Ack from CHCS= "_$GET(INERR))
+107 DO SHUTDWN(INBPN)
+108 IF INDEBUG
WRITE !!?10,$$CDATASC^%ZTFDT($HOROLOG,2,2)_" Error during receive of Ack from CHCS - closing socket"
End DoDot:1
QUIT
+109 ;
+110 IF INDEBUG
WRITE !!?10,$$CDATASC^%ZTFDT($HOROLOG,2,2)_" Processing inbound message"
+111 SET INRUNTST=$$INRHB^INHUVUT1(INBPN,"Processing inbound message")
+112 SET INERRTST=$$IN^INHUSEN(INMSGTST,.INDEST,INDSTR,INUSEQ,.INACKUIF,.INERR,"",.INUIF,1)
+113 IF INERRTST
Begin DoDot:1
+114 DO ENR^INHE(INBPN,"Error during processing of Ack= "_$GET(INERR))
+115 DO SHUTDWN(INBPN)
+116 IF INDEBUG
WRITE !!?10,$$CDATASC^%ZTFDT($HOROLOG,2,2)_" Error during processing of Ack from CHCS - closing socket"
End DoDot:1
QUIT
+117 ;
+118 ; Close Test Transmitter port and re-open to send another message
+119 IF INDEBUG
Begin DoDot:1
+120 IF INDEBUG
WRITE !!?10,$$CDATASC^%ZTFDT($HOROLOG,2,2)_" Closing socket"
+121 IF INDEBUG
WRITE !!?15,"Inbound msg UIF = "_$GET(INUIF)
End DoDot:1
+122 SET INRUNTST=$$INRHB^INHUVUT1(INBPN,"Closing Socket")
IF 'INRUNTST
QUIT
+123 DO SHUTDWN(INBPN)
+124 SET INRUNTST=$$INRHB^INHUVUT1(INBPN,"Idle",1)
IF 'INRUNTST
QUIT
+125 ;
+126 DO SHUTDWN(INBPN)
+127 QUIT
+128 ;
SHUTDWN(INBPN) ; Shutdown Test Transmitter
+1 NEW X
+2 SET X=$$INRHB^INHUVUT1(INBPN,"Shutting down",2)
+3 IF $GET(INCHNL)
Begin DoDot:1
+4 NEW X
DO CLOSE^%INET(INCHNL)
+5 SET X=$$INRHB^INHUVUT1(INBPN,"Socket closed")
End DoDot:1
+6 QUIT
+7 ;
ERR ; Error handler
+1 SET X="HALT^INHVCRLD"
SET @^%ZOSF("TRAP")
+2 ; log error in trap
XECUTE $GET(^INTHOS(1,3))
+3 IF INDEBUG
Begin DoDot:1
+4 ; error trap uses another file
USE IO
+5 WRITE !!,$$CDATASC^%ZTFDT($HOROLOG,2,2)_" System error: "_$$ERRMSG^INHU1
End DoDot:1
+6 DO ENR^INHE(INBPN,$$ERRMSG^INHU1)
+7 DO SHUTDWN(INBPN)
+8 ; return to main loop and reopen connection
IF $GET(INCHNL)
QUIT
+9 ;
HALT ; Halt process
+1 IF INDEBUG
Begin DoDot:1
+2 ; log error in trap
XECUTE $GET(^INTHOS(1,3))
+3 USE IO
+4 WRITE !!,$$CDATASC^%ZTFDT($HOROLOG,2,2)_" ***** HALTING - FATAL ERROR *****"
+5 WRITE !!,"Symbol table upon exit:"
End DoDot:1
+6 ;
+7 KILL ^UTILITY("INREC",$JOB),^UTILITY("INV",$JOB)
+8 HANG
+9 ;
DEST ; The following tags identify valid message destinations.
ACKACK ;;TEST INTERACTIVE
+1 ;
PARSE ; PWS Test Transmitter Lookup Routine
+1 QUIT
+2 ;
