INHVCRL4 ;JKB,KAC ; 20 Oct 1999 18:38 ; Logon Server (LoS) - Determine destination for inbound msg
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q
DEST2 ;Entry point From Background Message
;Anyone can log in flag
N INSEND
S INANYONE=1
S INSEND=$P(INMSH,INDELIM,3)
S $P(INSEND,"\")="CIW",$P(INMSH,INDELIM,3)=INSEND
D DEST
Q
DEST3 ;Entry point From Background Message
;Anyone can log in flag
N INSEND
S INANYONE=1
S INSEND=$P(INMSH,INDELIM,3)
S $P(INSEND,"\")="BCC",$P(INMSH,INDELIM,3)=INSEND
D DEST
Q
DEST ; Determine destination for an inbound logon message.
;
; Called by:
; - eXec'd from IN^INHUSEN where the context includes the input vars
; & expects the output vars documented below. The code that is
; eXec'd is set in the Logon Server (LoS), INHVCRL (file #4004,
; node #8).
;
; Input:
; ING - (req) var name for inbound data array
; INTYP - (req) msg type
; INEVN - (req) event type
; INMSH - (req) MSH segment
; INDELIM - (req) segment delimiter
;
; Variables:
; X - scratch
; INBLDST - entry reference to build array of valid LoS inbound
; destinations based on sending application
; INMESSID - message control ID (MSH:10)
; INRECV - receiving app (MSH:5) - Not currently used.
; INSEND - sending app (MSH:3)
;
; Output:
; INDST - INTERFACE DESTINATION name
; INDSTP - INTERFACE DESTINATION ptr
; Undefined if destination determination fails.
; INDEST - array containing valid LoS inbound destinations based
; on sending application
; Format: INDEST(msg-type_event-type)=
; INTERFACE DESTINATION name for inbound msg
; INERR - array containing error msg used to log an error
; Unaltered if destination determination succeeds.
;
K INDSTP
N INBLDST,INMESSID,INRECV,INSEND,X
S INSEND=$P(INMSH,INDELIM,3),INRECV=$P(INMSH,INDELIM,5),INMESSID=$P(INMSH,INDELIM,10)
;
; Build INDEST array
S INBLDST=$P(INSEND,"\")_"BLD"
I '$L($TEXT(@INBLDST)) S INERR="Message "_INMESSID_" contains unsupported sending application: '"_INSEND_"'" Q
S:INSEND["DDSA" INANYONE=1 ; DDSA
D @INBLDST
;
S X=$G(INTYP)_$G(INEVN)
I $D(INDEST(X)) S INDST=INDEST(X) I $D(^INRHD("B",INDST)) S INDSTP=$O(^(INDST,0))
Q
;
DDSABLD ;DDSA
PWSBLD ; Build array containing valid inbound PWS destinations for LoS.
;
; Output:
; INDEST - array containing valid PWS inbound destinations for LoS
; Format: INDEST(msg-type_event-type)=
; INTERFACE DESTINATION name for inbound msg
;
Q:$G(INDEST)="PWS" ; array already exists?
K INDEST
S INDEST="PWS"
S INDEST("ZILZ01")="HL PWS LOGON REQUEST FROM REMOTE SYSTEM"
Q
CIWBLD ; Build array containing valid inbound PWS destinations for LoS.
;
; Output:
; INDEST - array containing valid CIW inbound destinations for LoS
; Format: INDEST(msg-type_event-type)=
; INTERFACE DESTINATION name for inbound msg
;
Q:$G(INDEST)="CIW" ; array already exists?
K INDEST
S INDEST="CIW"
S INDEST("ZILZ01")="HL CIW LOGON REQUEST FROM REMOTE SYSTEM"
Q
;
BCCBLD ; Build array containing valid inbound BCC destinations for LoS.
;
; Output:
; INDEST - array containing valid PWS inbound destinations for LoS
; Format: INDEST(msg-type_event-type)=
; INTERFACE DESTINATION name for inbound msg
;
Q:$G(INDEST)="BCC" ; array already exists?
K INDEST
S INDEST="BCC"
S INDEST("ZILZ01")="HL BCC LOGON REQUEST FROM REMOTE SYSTEM"
Q
INHVCRL4 ;JKB,KAC ; 20 Oct 1999 18:38 ; Logon Server (LoS) - Determine destination for inbound msg
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 QUIT
DEST2 ;Entry point From Background Message
+1 ;Anyone can log in flag
+2 NEW INSEND
+3 SET INANYONE=1
+4 SET INSEND=$PIECE(INMSH,INDELIM,3)
+5 SET $PIECE(INSEND,"\")="CIW"
SET $PIECE(INMSH,INDELIM,3)=INSEND
+6 DO DEST
+7 QUIT
DEST3 ;Entry point From Background Message
+1 ;Anyone can log in flag
+2 NEW INSEND
+3 SET INANYONE=1
+4 SET INSEND=$PIECE(INMSH,INDELIM,3)
+5 SET $PIECE(INSEND,"\")="BCC"
SET $PIECE(INMSH,INDELIM,3)=INSEND
+6 DO DEST
+7 QUIT
DEST ; Determine destination for an inbound logon message.
+1 ;
+2 ; Called by:
+3 ; - eXec'd from IN^INHUSEN where the context includes the input vars
+4 ; & expects the output vars documented below. The code that is
+5 ; eXec'd is set in the Logon Server (LoS), INHVCRL (file #4004,
+6 ; node #8).
+7 ;
+8 ; Input:
+9 ; ING - (req) var name for inbound data array
+10 ; INTYP - (req) msg type
+11 ; INEVN - (req) event type
+12 ; INMSH - (req) MSH segment
+13 ; INDELIM - (req) segment delimiter
+14 ;
+15 ; Variables:
+16 ; X - scratch
+17 ; INBLDST - entry reference to build array of valid LoS inbound
+18 ; destinations based on sending application
+19 ; INMESSID - message control ID (MSH:10)
+20 ; INRECV - receiving app (MSH:5) - Not currently used.
+21 ; INSEND - sending app (MSH:3)
+22 ;
+23 ; Output:
+24 ; INDST - INTERFACE DESTINATION name
+25 ; INDSTP - INTERFACE DESTINATION ptr
+26 ; Undefined if destination determination fails.
+27 ; INDEST - array containing valid LoS inbound destinations based
+28 ; on sending application
+29 ; Format: INDEST(msg-type_event-type)=
+30 ; INTERFACE DESTINATION name for inbound msg
+31 ; INERR - array containing error msg used to log an error
+32 ; Unaltered if destination determination succeeds.
+33 ;
+34 KILL INDSTP
+35 NEW INBLDST,INMESSID,INRECV,INSEND,X
+36 SET INSEND=$PIECE(INMSH,INDELIM,3)
SET INRECV=$PIECE(INMSH,INDELIM,5)
SET INMESSID=$PIECE(INMSH,INDELIM,10)
+37 ;
+38 ; Build INDEST array
+39 SET INBLDST=$PIECE(INSEND,"\")_"BLD"
+40 IF '$LENGTH($TEXT(@INBLDST))
SET INERR="Message "_INMESSID_" contains unsupported sending application: '"_INSEND_"'"
QUIT
+41 ; DDSA
IF INSEND["DDSA"
SET INANYONE=1
+42 DO @INBLDST
+43 ;
+44 SET X=$GET(INTYP)_$GET(INEVN)
+45 IF $DATA(INDEST(X))
SET INDST=INDEST(X)
IF $DATA(^INRHD("B",INDST))
SET INDSTP=$ORDER(^(INDST,0))
+46 QUIT
+47 ;
DDSABLD ;DDSA
PWSBLD ; Build array containing valid inbound PWS destinations for LoS.
+1 ;
+2 ; Output:
+3 ; INDEST - array containing valid PWS inbound destinations for LoS
+4 ; Format: INDEST(msg-type_event-type)=
+5 ; INTERFACE DESTINATION name for inbound msg
+6 ;
+7 ; array already exists?
IF $GET(INDEST)="PWS"
QUIT
+8 KILL INDEST
+9 SET INDEST="PWS"
+10 SET INDEST("ZILZ01")="HL PWS LOGON REQUEST FROM REMOTE SYSTEM"
+11 QUIT
CIWBLD ; Build array containing valid inbound PWS destinations for LoS.
+1 ;
+2 ; Output:
+3 ; INDEST - array containing valid CIW inbound destinations for LoS
+4 ; Format: INDEST(msg-type_event-type)=
+5 ; INTERFACE DESTINATION name for inbound msg
+6 ;
+7 ; array already exists?
IF $GET(INDEST)="CIW"
QUIT
+8 KILL INDEST
+9 SET INDEST="CIW"
+10 SET INDEST("ZILZ01")="HL CIW LOGON REQUEST FROM REMOTE SYSTEM"
+11 QUIT
+12 ;
BCCBLD ; Build array containing valid inbound BCC destinations for LoS.
+1 ;
+2 ; Output:
+3 ; INDEST - array containing valid PWS inbound destinations for LoS
+4 ; Format: INDEST(msg-type_event-type)=
+5 ; INTERFACE DESTINATION name for inbound msg
+6 ;
+7 ; array already exists?
IF $GET(INDEST)="BCC"
QUIT
+8 KILL INDEST
+9 SET INDEST="BCC"
+10 SET INDEST("ZILZ01")="HL BCC LOGON REQUEST FROM REMOTE SYSTEM"
+11 QUIT
