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

INHVCRLD.m

Go to the documentation of this file. 
  1. 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
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ;This is a modify copy of ^INHVCRLT
  1.  ;It send back the IEN of the ack logon message. 
  1.  Q
  1.  ;
  1. 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 
  1.  ; acknowledgement message is received in response to this logon
  1.  ; request.
  1.  ;
  1.  ; Assumptions:
  1.  ;
  1.  ;The Test Transmitter function as a client in the TCP client/server model.
  1.  ;
  1.  ; Input:
  1.  ;   INBPN    - BACKGROUND PROCESS CONTROL IEN for Test Transmitter
  1.  ;
  1.  ;
  1.  ; Variables:
  1.  ;   INACKUIF - UNIVERSAL INTERFACE IEN for outbound Ack
  1.  ;   INCHNL   - TCP channel assigned to this Test Transmitter when 
  1.  ;              connection is opened
  1.  ;   INDATA   - array containing inbound msg received from remote system
  1.  ;              WARNING: Size of inbound data may require that INDATA
  1.  ;              be replaced with ^UTILITY("INREC",$J).  As a result, do 
  1.  ;              NOT new this variable - must be killed (see INMSGTST).
  1.  ;   INDEST   - array containing valid destinations for Test Transmitter
  1.  ;              Format: INDEST(msg-type_event-type)=
  1.  ;                      INTERFACE DESTINATION name for inbound msg
  1.  ;   INDSTR   - INTERFACE DESTINATION IEN for Test Transmitter from
  1.  ;              BACKGROUND PROCESS CONTROL file
  1.  ;   INERR    - array containing error msg used to log an error
  1.  ;   INERRTST - error information returned by function
  1.  ;   INMSGTST - indirected variable containing location of inbound msg
  1.  ;              1) local array = INDATA  2) global = ^UTILITY("INREC",$J)
  1.  ;              WARNING: Size of inbound data may require that the local
  1.  ;              array be replaced with global storage.
  1.  ;   INIP     - array containing initialization parameters from
  1.  ;              BACKGROUND PROCESS CONTROL file
  1.  ;   INMEM    - memory variable used by %INET
  1.  ;   INRUNTST - flag - 0 = Test Transmitter should shutdown
  1.  ;                     1 = Test Transmitter should continue running
  1.  ;   INUIF    - UNIVERSAL INTERFACE IEN for inbound msg
  1.  ;   INUSEQ   - flag - Sequence Number Protocol - 0=off, 1=on
  1.  ;   X,Y,Z    - scratch
  1.  ;
  1.  ; Output:
  1.  ;   None.
  1.  ;
  1.  ; Initialization
  1.  S INQKILL=1 ; kill entry after sending - yes/no
  1.  S:'$D(INDEBUG) INDEBUG=0
  1.  I INDEBUG D  Q:POP
  1.  .S %ZIS="QM" D ^%ZIS Q:POP
  1.  .U IO W !!,$$CDATASC^%ZTFDT($H,2,2)_" Entering Test Transmitter"
  1.  ;
  1.  N INCHNL,INDEST,INDSTR,INERRTST,INMSGTST,INIP,INRUNTST,INUSEQ,X,Y,Z
  1.  S X="ERR^INHVCRLD",@^%ZOSF("TRAP")
  1.  Q:'$$RUN^INHOTM  ; ck shutdown status
  1.  ;
  1.  S POP=0 F INSER=1:1 D  Q:POP
  1.  .L +^INRHB("RUN","SRVR",INBPN,INSER):5 S POP=1
  1.  .;D SHUTDWN(INBPN)
  1.  ;
  1.  ; Get Test Transmitter INTERFACE DESTINATION IEN
  1.  S INDSTR=+$P($G(^INTHPC(INBPN,0)),U,7)
  1.  I 'INDSTR D  Q
  1.  .D ENR^INHE(INBPN,"No destination designated for background process "_INBPN)
  1.  .D SHUTDWN(INBPN)
  1.  ;
  1.  ; Get Test Transmitter parameters from BACKGROUND PROCESS CONTROL file
  1.  D INIT^INHUVUT(INBPN,.INIP)
  1.  ;
  1.  ; Set array of valid inbound INTERFACE DESTINATION names
  1.  F X=1:1 S Y=$T(DEST+X) Q:Y'[";;"  S Z=$TR($P(Y,";;")," ",""),INDEST(Z)=$P(Y,";;",2)
  1.  ;
  1.  S INUSEQ=+$P($G(^INRHD(INDSTR,0)),U,9) ; use sequence number protocol?
  1.  ;
  1.  ;;;;;; Main program loop
  1.  N INACKUIF,INERR,INMEM,INMSGTST
  1.  ; Error trap positioned to allow for continuation following 
  1.  ; "non-fatal" error
  1.  S X="ERR^INHVCRLD",@^%ZOSF("TRAP")
  1.  S INMSGTST="INDATA" ; reset local array in which to receive data
  1.  ;
  1.  ; Select port, open connection
  1.  W:INDEBUG !!?5,$$CDATASC^%ZTFDT($H,2,2)_" Opening socket"
  1.  F  D  Q:INERRTST!'INRUNTST  D WAIT^INHUVUT(INBPN,INIP("OHNG"))
  1.  . S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Attempting to open socket") Q:'INRUNTST
  1.  .S INERRTST=$$OPEN^INHUVUT(INBPN,.INCHNL,.INERR,.INMEM)
  1.  S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Socket opened") Q:'INRUNTST
  1.  ;
  1.  ;Logon message
  1.  S INUIF=$O(^UTILITY("INTHU",DUZ,TESTNUM,.5,""))
  1.  ;
  1.  Q:'INRUNTST
  1.  ;
  1.  ; Send data to CHCS system
  1.  W:INDEBUG !!?10,$$CDATASC^%ZTFDT($H,2,2)_" Sending data to CHCS system on channel: "_$G(INCHNL)
  1.  F  D  Q:'INERRTST!'INRUNTST  D WAIT^INHUVUT(INBPN,INIP("SHNG"))
  1.  .S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Sending data to CHCS system")
  1.  .Q:'INRUNTST
  1.  .S INERRTST=$$SEND^INHUVUT(INUIF,INCHNL,.INIP)
  1.  Q:'INRUNTST
  1.  ;
  1.  ; Receive data from remote system
  1.  W:INDEBUG !!?10,$$CDATASC^%ZTFDT($H,2,2)_" Waiting to receive Ack from CHCS"
  1.  S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Waiting to receive Ack from CHCS")
  1.  Q:'INRUNTST
  1.  S INERRTST=$$RECEIVE^INHUVUT(.INMSGTST,INCHNL,.INIP,.INERR,.INMEM)
  1.  I INERRTST D  Q
  1.  .D ENR^INHE(INBPN,"Error during receive of Ack from CHCS= "_$G(INERR))
  1.  .D SHUTDWN(INBPN)
  1.  .W:INDEBUG !!?10,$$CDATASC^%ZTFDT($H,2,2)_" Error during receive of Ack from CHCS - closing socket"
  1.  ;
  1.  W:INDEBUG !!?10,$$CDATASC^%ZTFDT($H,2,2)_" Processing inbound message"
  1.  S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Processing inbound message")
  1.  S INERRTST=$$IN^INHUSEN(INMSGTST,.INDEST,INDSTR,INUSEQ,.INACKUIF,.INERR,"",.INUIF,1)
  1.  I INERRTST D  Q
  1.  .D ENR^INHE(INBPN,"Error during processing of Ack= "_$G(INERR))
  1.  .D SHUTDWN(INBPN)
  1.  .W:INDEBUG !!?10,$$CDATASC^%ZTFDT($H,2,2)_" Error during processing of Ack from CHCS - closing socket"
  1.  ;
  1.  ; Close Test Transmitter port and re-open to send another message
  1.  D:INDEBUG
  1.  .W:INDEBUG !!?10,$$CDATASC^%ZTFDT($H,2,2)_" Closing socket"
  1.  .W:INDEBUG !!?15,"Inbound msg UIF = "_$G(INUIF)
  1.  S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Closing Socket") Q:'INRUNTST
  1.  D SHUTDWN(INBPN)
  1.  S INRUNTST=$$INRHB^INHUVUT1(INBPN,"Idle",1) Q:'INRUNTST
  1.  ;
  1.  D SHUTDWN(INBPN)
  1.  Q
  1.  ;
  1. SHUTDWN(INBPN) ; Shutdown Test Transmitter
  1.  N X
  1.  S X=$$INRHB^INHUVUT1(INBPN,"Shutting down",2)
  1.  I $G(INCHNL) D
  1.  .N X D CLOSE^%INET(INCHNL)
  1.  .S X=$$INRHB^INHUVUT1(INBPN,"Socket closed")
  1.  Q
  1.  ;
  1. ERR ; Error handler
  1.  S X="HALT^INHVCRLD",@^%ZOSF("TRAP")
  1.  X $G(^INTHOS(1,3))  ; log error in trap
  1.  D:INDEBUG
  1.  . U IO ; error trap uses another file
  1.  . W !!,$$CDATASC^%ZTFDT($H,2,2)_" System error: "_$$ERRMSG^INHU1
  1.  D ENR^INHE(INBPN,$$ERRMSG^INHU1)
  1.  D SHUTDWN(INBPN)
  1.  Q:$G(INCHNL)  ; return to main loop and reopen connection
  1.  ;
  1. HALT ; Halt process
  1.  D:INDEBUG
  1.  .X $G(^INTHOS(1,3))  ; log error in trap
  1.  .U IO
  1.  .W !!,$$CDATASC^%ZTFDT($H,2,2)_" ***** HALTING - FATAL ERROR *****"
  1.  .W !!,"Symbol table upon exit:"
  1.  ;
  1.  K ^UTILITY("INREC",$J),^UTILITY("INV",$J)
  1.  H
  1.  ;
  1. DEST ; The following tags identify valid message destinations.
  1. ACKACK ;;TEST INTERACTIVE
  1.  ;
  1. PARSE ; PWS Test Transmitter Lookup Routine
  1.  Q
  1.  ;