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

INHVCRL.m

Go to the documentation of this file. 
  1. INHVCRL ;DGH,KAC ; 19 Mar 96 10:43; Logon Server (LoS) Background Controller
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  Q
  1.  ;
  1. EN ; The Logon Server (LoS) accepts requests for access from remote
  1.  ; systems.  These requests are in the form of HL7 messages.  If the
  1.  ; message meets HL7 specifications, the request is validated.  An
  1.  ; acknowledgement message is then transmitted to the remote system.
  1.  ;
  1.  ; GIS INTERFACE TRANSACTION TYPEs supported by the LoS:
  1.  ;   HL XXX LOGON REQUEST FROM REMOTE SYSTEM
  1.  ;   HL XXX LOGON REQUEST FROM REMOTE SYSTEM - ACK
  1.  ;   where: XXX = PWS
  1.  ;
  1.  ;
  1.  ; Assumptions:
  1.  ; - HL7 Original Acknowledgement Mode is used. (MSH-15/16="")
  1.  ; - The LoS functions as a server in the TCP client/server model.
  1.  ; - If the LoS has been signalled to stop, it will complete any 
  1.  ;   transaction in progress and then terminate.
  1.  ;
  1.  ;
  1.  ; Input:
  1.  ;   INBPN    - BACKGROUND PROCESS CONTROL IEN for LoS
  1.  ;
  1.  ;
  1.  ; Variables:
  1.  ;   INACKUIF - UNIVERSAL INTERFACE IEN for outbound Ack
  1.  ;   INCHNL   - TCP channel assigned to the LoS when 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 INMSGLOS).
  1.  ;   INDEST   - array containing valid inbound destinations for LoS
  1.  ;              Format: INDEST(msg-type_event-type)=
  1.  ;                      INTERFACE DESTINATION name for inbound msg
  1.  ;   INDSTP   - INTERFACE DESTINATION IEN for inbound msg from 
  1.  ;              UNIVERSAL INTERFACE file
  1.  ;   INDSTR   - INTERFACE DESTINATION IEN for LoS from BACKGROUND PROCESS
  1.  ;              CONTROL file
  1.  ;   INERR    - array containing error msg used to log an error
  1.  ;   INERRLOS - error information returned by function
  1.  ;   INIP     - array containing initialization parameters from
  1.  ;              BACKGROUND PROCESS CONTROL file
  1.  ;   INMSGLOS - 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.  ;   INMEM    - memory variable used by %INET
  1.  ;   INOA     - array containing Ack msg data to be returned to remote system
  1.  ;   INODA    - array containing information to be sent to an outbound
  1.  ;              destination
  1.  ;                INODA = IEN in base file used by outbound script
  1.  ;                Subscripts may hold subfile IENs in the format:
  1.  ;                  INODA(subfile #,DA)=""
  1.  ;              If NOT needed, set to -1 prior to running outbound script.
  1.  ;   INPARMS  - inbound msg parameter array
  1.  ;              Format: INPARMS(INDSTP,"param")=value
  1.  ;   INRUNLOS - flag - 0 = LoS should shutdown
  1.  ;                     1 = LoS should continue running
  1.  ;   INUIF    - UNIVERSAL INTERFACE IEN for inbound msg
  1.  ;   INUSEQ   - flag - Sequence Number Protocol - 0=off, 1=on
  1.  ;   INXDST   - executable code used by IN^INHUSEN to determine INTERFACE
  1.  ;              DESTINATION for an inbound msg
  1.  ;   X        - scratch
  1.  ;
  1.  ; Output:
  1.  ;   None.
  1.  ;
  1.  ; Initialization
  1.  N INACKUIF,INCHNL,INDEST,INDSTP,INDSTR,INERR,INERRLOS,INIP,INMSGLOS,INMEM,INOA,INODA,INPARMS,INRUNLOS,INUIF,INUSEQ,INXDST,X
  1.  S X="ERR^INHVCRL",@^%ZOSF("TRAP")
  1.  D DEBUG^INHVCRA1() ; turn debug on
  1.  Q:'$$RUN^INHOTM  ; ck shutdown status
  1.  ;Start GIS Background process audit if flag is set in Site Parms File
  1.  N INPNAME S INPNAME=$P(^INTHPC(INBPN,0),U) D AUDCHK^XUSAUD D:$D(XUAUDIT) ITIME^XUSAUD(INPNAME)
  1.  L +^INRHB("RUN",INBPN):5 E  D
  1.  . D LOG^INHVCRA1("Cannot get exclusive lock for: ^INRHB(""RUN"","_INBPN_")","E")
  1.  . D SHUTDWN(INBPN)
  1.  ;
  1.  ; Get LoS INTERFACE DESTINATION IEN & Destination Determination Code
  1.  S INDSTR=$P($G(^INTHPC(INBPN,0)),U,7),INXDST=$G(^(8))
  1.  I 'INDSTR D  Q
  1.  . D LOG^INHVCRA1("No destination designated for background process "_INBPN,"E")
  1.  . D SHUTDWN(INBPN)
  1.  ;
  1.  I '$L($G(INXDST)) D  Q
  1.  . D LOG^INHVCRA1("Missing code to determine inbound message destination for background process "_INBPN,"E")
  1.  . D SHUTDWN(INBPN)
  1.  ;
  1.  ; Verify designation of LoS port(s)
  1.  I '$O(^INTHPC(INBPN,5,0)) D  Q
  1.  . D LOG^INHVCRA1("No ports designated for background process "_INBPN,"E")
  1.  . D SHUTDWN(INBPN)
  1.  ;
  1.  ; Get LoS parameters from BACKGROUND PROCESS CONTROL file
  1.  D INIT^INHUVUT1(INBPN,.INIP)
  1.  ;
  1.  S INUSEQ=+$P($G(^INRHD(INDSTR,0)),U,9) ; use sequence number protocol?
  1.  ;
  1.  ; Main program loop
  1.  F  D  K @INMSGLOS Q:'$G(INRUNLOS)
  1.  .;Update background process audit
  1.  .D:$D(XUAUDIT) ITIME^XUSAUD(INPNAME)
  1.  .; Kill variables that are modified with each incoming/outgoing msg
  1.  . K INACKUIF,INDSTP,INERR,INMEM,INOA,INODA,INUIF
  1.  .; Error trap positioned to allow for continuation following "non-fatal" error
  1.  . S X="ERR^INHVCRL",@^%ZOSF("TRAP")
  1.  . S INMSGLOS="INDATA" ; reset local array in which to receive data
  1.  .;
  1.  .; Select port, open connection & wait for transmissions
  1.  . S INRUNLOS=$$RUN^INHOTM Q:'INRUNLOS
  1.  . D LOG^INHVCRA1("Listening for connection")
  1.  . S INERRLOS=$$OPEN^INHUVUT(INBPN,.INCHNL,.INERR,.INMEM)
  1.  . I 'INERRLOS D  Q  ; open failed - retry
  1.  .. D LOG^INHVCRA1(.INERR,"E")
  1.  .. D WAIT^INHUVUT(INBPN,INIP("OHNG"),"Waiting to retry open",.INRUNLOS)
  1.  .. S INRUNLOS='INRUNLOS
  1.  . S INRUNLOS=$$RUN^INHOTM Q:'INRUNLOS
  1.  . D LOG^INHVCRA1("Connected")
  1.  .;
  1.  .; Receive data from remote system
  1.  . S INRUNLOS=$$RUN^INHOTM Q:'INRUNLOS
  1.  . D LOG^INHVCRA1("Receiving data on channel: "_INCHNL)
  1.  . S INERRLOS=$$RECEIVE^INHUVUT(.INMSGLOS,INCHNL,.INIP,.INERR,.INMEM)
  1.  . I INERRLOS D RESET^INHVCRL1(INBPN,INCHNL,.INERR) Q
  1.  .;
  1.  .; Process inbound msg
  1.  . S INRUNLOS=$$RUN^INHOTM
  1.  . D LOG^INHVCRA1("Processing inbound message")
  1.  .;Start transaction audit
  1.  . D:$D(XUAUDIT) TTSTRT^XUSAUD("","",$P(^INTHPC(INBPN,0),U),$G(INHSRVR),"RECEIVE")
  1.  . S INERRLOS=$$IN^INHUSEN(INMSGLOS,.INDEST,INDSTR,INUSEQ,.INACKUIF,.INERR,INXDST,.INUIF,1)
  1.  . ;Stop transaction audit. Pass in UIF entry if it exists.
  1.  . D:$D(XUAUDIT) TTSTP^XUSAUD(0,$G(INUIF))
  1.  . I INERRLOS D RESET^INHVCRL1(INBPN,INCHNL,.INERR,$S($G(INACKUIF):INACKUIF,1:"AR"),.INIP,$G(INUIF),.INPARMS) Q
  1.  .;
  1.  .; Get parameters associated with inbound msg (INUIF)
  1.  . S INRUNLOS=INRUNLOS&$$RUN^INHOTM
  1.  . S INERRLOS=$$INPARMS^INHVCRL2(.INDSTP,.INPARMS,.INERR,INUIF)
  1.  . I INERRLOS D RESET^INHVCRL1(INBPN,INCHNL,.INERR) Q
  1.  .;
  1.  .; Execute inbound script generated for this transaction/destination
  1.  . S INRUNLOS=INRUNLOS&$$RUN^INHOTM
  1.  . D LOG^INHVCRA1("Executing inbound script for UIF entry = "_INUIF)
  1.  .;Start transaction audit
  1.  . D:$D(XUAUDIT) TTSTRT^XUSAUD(INUIF,"",$P(^INTHPC(INBPN,0),U),$G(INHSRVR),"SCRIPT")
  1.  . S INERRLOS=$$RUNIN^INHVCRL3(INUIF,.INPARMS,INDSTP,.INOA,.INODA,.INERR)
  1.  . ;Stop transaction audit.
  1.  . D:$D(XUAUDIT) TTSTP^XUSAUD(INERRLOS)
  1.  . I INERRLOS D  Q
  1.  .. S:'$D(INOA) INOA="AR"
  1.  .. D RESET^INHVCRL1(INBPN,INCHNL,.INERR,.INOA,.INIP,INUIF,.INPARMS)
  1.  .;
  1.  .; Send Ack to remote system.  INOA array returned by inbound script 
  1.  .; contains Ack data.
  1.  . S INRUNLOS=INRUNLOS&$$RUN^INHOTM
  1.  . D LOG^INHVCRA1("Transmitting positive acknowledgement")
  1.  . S INERRLOS=$$SNDAACK^INHVCRL2(INBPN,INCHNL,.INIP,.INOA,.INODA,INUIF,.INPARMS,1,.INERR)
  1.  . I INERRLOS D RESET^INHVCRL1(INBPN,INCHNL,.INERR) Q
  1.  . D LOG^INHVCRA1("Successful transmission","S",1)
  1.  .;
  1.  .; Close LoS port and wait for another system to connect
  1.  . S INRUNLOS=INRUNLOS&$$RUN^INHOTM Q:'INRUNLOS
  1.  . D LOG^INHVCRA1("Closing connection")
  1.  . D CLOSE(INBPN,INCHNL)
  1.  ;
  1.  ;
  1.  D SHUTDWN(INBPN,$G(INCHNL))
  1.  Q
  1.  ;
  1.  ;
  1. SHUTDWN(INBPN,INCHNL) ; Shutdown LoS
  1.  ; Input:
  1.  ;   INBPN    - (req) BACKGROUND PROCESS CONTROL IEN for LoS
  1.  ;   INCHNL   - (opt) TCP channel assigned to this server when connection
  1.  ;                    is opened
  1.  ; Output:
  1.  ;   None.
  1.  ;
  1.  D LOG^INHVCRA1("Shutting down")
  1.  D CLOSE(INBPN,$G(INCHNL))
  1.  D LOG^INHVCRA1("Shutdown")
  1.  D DEBUG^INHVCRA1(0) ; turn debugging off
  1.  K ^UTILITY("INREC",$J),^UTILITY("INV",$J)
  1.  K ^INRHB("RUN",INBPN)
  1.  L -^INRHB("RUN",INBPN)
  1.  ;Stop background process audit
  1.  D:$D(XUAUDIT) AUDSTP^XUSAUD
  1.  ;
  1.  Q
  1.  ;
  1. CLOSE(INBPN,INCHNL) ; Close channel
  1.  ; Input:
  1.  ;   INBPN    - (req) BACKGROUND PROCESS CONTROL IEN for LoS
  1.  ;   INCHNL   - (req) TCP channel assigned to this server when connection
  1.  ;                    is opened
  1.  ; Output:
  1.  ;   None.
  1.  ;
  1.  I $G(INCHNL) D
  1.  . D CLOSE^%INET(INCHNL)
  1.  . D LOG^INHVCRA1("Connection closed")
  1.  Q
  1.  ;
  1. ERR ; Error handler
  1.  S X="HALT^INHVCRL",@^%ZOSF("TRAP")
  1.  X $G(^INTHOS(1,3))  ; log error in trap
  1.  D RESET^INHVCRL1(INBPN,$G(INCHNL),$$ERRMSG^INHU1,"AR",.INIP,$G(INUIF),.INPARMS)
  1.  Q:$G(INCHNL)  ; return to main loop and reopen connection
  1.  ;
  1. HALT ; Halt process
  1.  D LOG^INHVCRA1("** HALTING - FATAL ERROR **","E")
  1.  D SHUTDWN(INBPN,$G(INCHNL))
  1.  H
  1.  ;
  1. PARSE ; Debug Only - Lookup/Store Routine in Message Definition for LoS
  1.  S INOA("INSTAT")="AA"
  1.  S INOA("ZIL1")="REQ"
  1.  S INOA("ZIL4")=373
  1.  S INOA("ZIL5")=$P(^DIC(3,373,8000),"^")
  1.  S INOA("ZIL6")=$P(^DIC(3,373,200),"^",10)
  1.  S INOA("ZIL10")="KERBEROS KEY"
  1.  Q