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

INHVCRA.m

Go to the documentation of this file. 
  1. INHVCRA ;KAC,JKB ; 7 Mar 96 14:02; Application Server (ApS)
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  Q  ;no top entry
  1.  ;
  1.  ; The Application Server (ApS) accepts service requests from remote
  1.  ; systems in the form of HL7 messages.  If the request maps to an
  1.  ; active inbound Transaction Type, the message is processed.  An 
  1.  ; acknowledgement message is then transmitted to the remote system.
  1.  ; If signalled to stop, the ApS will complete any transaction in 
  1.  ; progress and then terminate.
  1.  ;
  1.  ; The ApS has been originally designed and tested to initiate as a
  1.  ; client in the TCP client/server model.  However, the code should be
  1.  ; able to allow the ApS to open as a server merely by not passing in an
  1.  ; IP address (INADDR at EN).
  1.  ;
  1.  ; The ApS is intended to be generic with the specifics for a particular
  1.  ; interface to be held in tables.  The related BACKGROUND PROCESS entry
  1.  ; is "PWS APP SERVER" with a corresponding INTERFACE DESTINATION of
  1.  ; "HL PWS APP SERVER".  For PWS, the PWS specific code is in ^INHVCRAP.
  1.  ;
  1. EN(INBPN,INHSRVR,INADDR,INPORT,INTICK,INDUZ) ;
  1.  ;
  1.  ; Input    : all required
  1.  ; INBPN    = BACKGROUND PROCESS CONTROL ptr for ApS
  1.  ; INHSRVR  = server number for this particular ApS
  1.  ; INADDR   = IP address of remote server to connect to as a TCP client,
  1.  ;            or null to open as a TCP server
  1.  ; INPORT   = IP port to open (client or server)
  1.  ; INTICK   = security ticket
  1.  ; INDUZ    = USER ptr
  1.  ;
  1.  ; Output   : void
  1.  ;
  1.  ; Internal :
  1.  ; ERR      = scratch error holder
  1.  ; INACKUIF = UNIVERSAL INTERFACE IEN of outbound Ack
  1.  ; INCHNL   = TCP channel assigned to ApS
  1.  ; INDATA   = array containing msg received from remote system
  1.  ; INDEST   = array of valid inbound destinations
  1.  ; INDST    = INTERFACE DESTINATION Name for an inbound msg
  1.  ; INDSTOFF = INTERFACE DESTINATION Name for the ApS login msg
  1.  ; INDSTON  = INTERFACE DESTINATION Name for the ApS logoff msg
  1.  ; INDSTP   = INTERFACE DESTINATION ptr for an inbound msg
  1.  ; INDSTR   = INTERFACE DESTINATION ptr for the ApS receiver
  1.  ; INERR    = error string used to log an error
  1.  ; ING      = indirected variable containing array, INDATA
  1.  ; INIP     = array of init parms from BACKGROUND PROCESS
  1.  ; INLOGON  = boolean flag denoting ApS has processed the logon msg
  1.  ; INMEM    = memory var used ultimately by %INET
  1.  ; INMSGP   = inbound message parameter array (see $$INPARMS^INHVCRL2)
  1.  ; INOA     = msg array output from inbound msg script for use in ack
  1.  ; INODA    = same as INOA, but for file pointers
  1.  ; INPNAME  = name for this BACKGROUND PROCESS
  1.  ; INUIF    = UNIVERSAL INTERFACE ptr of inbound msg
  1.  ; INUSEQ   = Sequence Number Protocol flag (0=off,1=on)
  1.  ; INXDST   = Executable code used by ^INHUSEN to determine INTERFACE
  1.  ;            DESTINATION for an inbound msg
  1.  ;
  1.  ; init ApS
  1.  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
  1.  S U="^",ERR=0,X="ERR^INHVCRA",@^%ZOSF("TRAP"),INPNAME=$P(^INTHPC(INBPN,0),U)
  1.  ; determine whether debugging and/or instrumentation is on
  1.  D DEBUG^INHVCRA1(),AUDCHK^XUSAUD
  1.  ; start GIS background process audit if instrumentation on
  1.  D:$D(XUAUDIT) ITIME^XUSAUD(INPNAME,INHSRVR)
  1.  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
  1.  D LOG^INHVCRA1("initing Aps for user "_INDUZ,1)
  1.  S ERR=$$SETENV^INHULOG(INDUZ) I ERR D LOG^INHVCRA1("bad init for ApS"_INHSRVR_": "_$P(ERR,U,2),"E") G SHUTDWN
  1.  ; get BACKGROUND PROCESS CONTROL params for the ApS
  1.  D INIT^INHUVUT1(INBPN,.INIP)
  1.  S INDSTR=$P($G(^INTHPC(INBPN,0)),U,7),INXDST=$G(^(8))
  1.  I 'INDSTR D LOG^INHVCRA1("no Destination designated for Background Process","E") S ERR=1 G SHUTDWN
  1.  ; get INTERFACE DESTINATION params for the ApS
  1.  S INUSEQ=$P($G(^INRHD(INDSTR,0)),U,9)
  1.  ; get logon/logoff msg destinations (these could be table based)
  1.  I '$$LOGONDS(.INDSTON) D LOG^INHVCRA1("no logon messsage destination for ApS","E") S ERR=1 G SHUTDWN
  1.  I '$$LOGOFFDS(.INDSTOFF) D LOG^INHVCRA1("no logoff messsage destination for ApS","E") S ERR=1 G SHUTDWN
  1.  D LOG^INHVCRA1("Aps configured for user "_DUZ,1)
  1.  ; check shutdown status
  1.  I '$$RUN^INHOTM G SHUTDWN
  1.  ; open connection
  1.  D LOG^INHVCRA1("connecting to "_INADDR_"/"_INPORT)
  1.  D OPEN^INHVCRA1(.INCHNL,.INMEM,.INADDR,INPORT,.INIP)
  1.  I 'INCHNL D LOG^INHVCRA1(INCHNL,"E") S ERR=1 G SHUTDWN
  1.  D LOG^INHVCRA1("connected")
  1.  ;
  1.  ; Main Message Loop
  1.  S INLOGON="" F  D  Q:INLOGON=0!'$$RUN^INHOTM
  1.  .; update background process audit
  1.  .D:$D(XUAUDIT) ITIME^XUSAUD(INPNAME,INHSRVR)
  1.  .; receive message
  1.  .D LOG^INHVCRA1("listening for user "_DUZ)
  1.  .K INACKUIF,INDST,INDSTP,INERR,INOA,INODA,INUIF
  1.  .S ING="INDATA",ERR=$$RECEIVE^INHVCRA1(.ING,INCHNL,.INIP,.INERR,.INMEM)
  1.  .I ERR D LOG^INHVCRA1(.INERR,"E") S INLOGON=0 Q
  1.  .; verify and store message
  1.  .D LOG^INHVCRA1("processing inbound message")
  1.  .; start transaction audit, trans type not known (stop is in INHUSEN)
  1.  .D:$D(XUAUDIT) TTSTRT^XUSAUD("","",INPNAME,INHSRVR,"RECEIVE")
  1.  .S ERR=$$IN^INHUSEN(ING,.INDEST,INDSTR,INUSEQ,.INACKUIF,.INERR,INXDST,.INUIF,1)
  1.  .; if message not stored, build error array to include input array
  1.  .I $G(INUIF)<1 D
  1.  ..N I,J,X
  1.  ..I $D(INERR)=1 S X=INERR K INERR I $L(X) S INERR(1)=X
  1.  ..S I=$O(INERR(""),-1)+1,J=""
  1.  ..S INERR(I)="msg not stored - input buffer "_ING_" follows:"
  1.  ..F  S J=$O(@ING@(J)) Q:J=""  S I=I+1,INERR(I)=J_U_@ING@(J)
  1.  .K @ING
  1.  .I ERR D REJECT(.INERR) Q
  1.  .; get message params for inbound destination
  1.  .S ERR=$$INPARMS^INHVCRL2(.INDSTP,.INMSGP,.INERR,INUIF)
  1.  .I ERR D REJECT(.INERR) Q
  1.  .; if no error and ack built, must be a commit ack
  1.  .I $G(INACKUIF)>0 S INOA("INSTAT")="CA" D SENDACK
  1.  .S INDST=INMSGP(INDSTP,"DSIN01")
  1.  .; check for receipt of a 2nd logon msg
  1.  .I INLOGON,INDST=INDSTON D REJECT("unexpected 2nd logon message") Q
  1.  .; check whether logon is first msg received
  1.  .I 'INLOGON S INLOGON=INDST=INDSTON I 'INLOGON D REJECT("first message not a logon") Q  ; shutdown ApS
  1.  .; set flag if logoff msg has been received
  1.  .I INDST=INDSTOFF S INLOGON=0
  1.  .; execute the inbound script for transaction
  1.  .D LOG^INHVCRA1("executing for destination "_INDST,1)
  1.  .; start transaction audit
  1.  .D:$D(XUAUDIT) TTSTRT^XUSAUD(INUIF,"",INPNAME,INHSRVR,"SCRIPT")
  1.  .S ERR=$$RUNIN^INHVCRL3(INUIF,.INMSGP,INDSTP,.INOA,.INODA,.INERR)
  1.  .; stop transaction audit
  1.  .D:$D(XUAUDIT) TTSTP^XUSAUD(ERR)
  1.  .I ERR D REJECT(.INERR) S:INDST=INDSTON INLOGON=0 Q  ; shutdown ApS if logon failed
  1.  .; send Ack
  1.  .S INOA("INSTAT")="AA" D SENDACK
  1.  .I ERR S:INDST=INDSTON INLOGON=0 Q  ; shutdown ApS if logon Ack failed
  1.  ;
  1. SHUTDWN ; shutdown ApS
  1.  D:$G(INCHNL) CLOSE^%INET(INCHNL)
  1.  K ^UTILITY("INREC",$J),^UTILITY("INV",$J)
  1.  K ^INRHB("RUN","SRVR",INBPN,INHSRVR)
  1.  L -^INRHB("RUN","SRVR",INBPN,INHSRVR)
  1.  D LOG^INHVCRA1("shutdown",1),DEBUG^INHVCRA1(0)
  1.  ; stop background process audit
  1.  D:$D(XUAUDIT) AUDSTP^XUSAUD
  1.  Q
  1.  ;
  1. ERR ; error trap vector
  1.  ; reset trap
  1.  S ERR=1,X="SHUTDWN^INHVCRA",@^%ZOSF("TRAP")
  1.  ; log error
  1.  D ERRLOG^%ZTOS,LOG^INHVCRA1($$ERRMSG^INHU1,"E")
  1.  G SHUTDWN
  1.  ;
  1. REJECT(INERR) ; reject inbound message
  1.  ; Input :  INERR (req) = error msg
  1.  ; Output:  void
  1.  ; log error
  1.  D LOG^INHVCRA1(.INERR,"E")
  1.  S INOA("INSTAT")="AR"
  1. SENDACK ; send acknowledgement
  1.  ; Input :  INACKUIF,INBPN,INCHNL,INERR,INIP(),INOA,INUIF,INMSGP()
  1.  ; Output:  void
  1.  ;          ERR,INACKUIF
  1.  I '$D(INOA("INSTAT")) D LOG^INHVCRA1("unknown ack status","E") S INOA("INSTAT")="AE"
  1.  I $G(INACKUIF)<1 D  Q:$G(INACKUIF)<1
  1.  .I $G(INUIF)<1 D LOG^INHVCRA1("msg unavailable to ack","E") S ERR=1 Q
  1.  .D LOG^INHVCRA1("creating ack for "_INUIF)
  1.  .D ACK^INHOS(INMSGP(INDSTP,"TTIN"),"",INUIF,.INERR,.INOA,.INODA,1,.INACKUIF) K:$L($G(INV)) @INV
  1.  .I $G(INACKUIF)<1 D LOG^INHVCRA1("error in ack creation","E") S ERR=1 Q
  1.  D LOG^INHVCRA1("sending "_INOA("INSTAT")_" ack "_INACKUIF)
  1.  ; start transaction audit
  1.  D:$D(XUAUDIT) TTSTRT^XUSAUD(INACKUIF,"",INPNAME,INHSRVR,"TRANSMIT")
  1.  S ERR=$$SEND^INHUVUT(INACKUIF,INCHNL,.INIP)
  1.  ; stop transaction audit
  1.  D:$D(XUAUDIT) TTSTP^XUSAUD(ERR)
  1.  I ERR D LOG^INHVCRA1("error in ack transmission","E") S ERR=1 Q
  1.  D LOG^INHVCRA1("ack sent","S",$E(INOA("INSTAT"),2)="A")
  1.  Q
  1.  ;
  1. LOGONDS(X) ; get the logon message destination
  1.  ; Input : X (opt) = var for logon msg INTERFACE DESTINATION Name (pbr)
  1.  ; Output: boolean; returns true if logon dest found; else false
  1.  S X="HL INH APPLICATION SERVER LOGON"
  1.  Q $D(^INRHD("B",X))>9
  1.  ;
  1. LOGOFFDS(X) ; get the logoff message destination
  1.  ; Input : X (opt) = var for logoff msg INTERFACE DESTINATION Name (pbr)
  1.  ; Output: boolean; returns true if logoff dest found; else false
  1.  S X="HL INH APPLICATION SERVER LOGOFF"
  1.  Q $D(^INRHD("B",X))>9