INHVCRL4.m

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