INHVCRAB.m

INHVCRAB ;JKB ; 8 Jul 95 15:57; BCC-specific ApS Code

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

 ;

 Q  ;no top entry

 ;

 ; This routine contains Application Server (ApS) code specific for the

 ; BCC application interface.

 ;

DEST ; determine destination for an inbound BCC message

 ; Note  : this code is eXec'd from IN^INHUSEN where the context

 ;         includes the input vars & expects the output vars doc'd below

 ; Input : ING     (req) = var name for inbound data array

 ;         INTYP   (req) = msg type

 ;         INEVN   (req) = event type

 ;         INMSH   (req) = MSH segment

 ;         INDELIM (req) = segment delimeter

 ; Output: void

 ;         INDST   = INTERFACE DESTINATION Name

 ;         INDSTP  = INTERFACE DESTINATION ptr (undef if no destination)

 ;         INDEST  = array of valid inbound destinations

 ; Local : INORTYP = ORDER TYPE (ZOR:1)

 ;         INRECV  = receiving app (MSH:5)

 ;         INSEND  = sending app (MSH:3)

 K INDSTP

 N I,INORTYP,INRECV,INSEND,X

 S INSEND=$P(INMSH,INDELIM,3),INRECV=$P(INMSH,INDELIM,5),INORTYP=""

 ; build INDEST() if not done so for BCC

 I $G(INDEST)'="BCC" S INDEST="BCC" F I=1:1 S X=$P($T(DESTTXT+I),";;",2) Q:'$L(X)  S INDEST($TR($P(X,U,1,3),U,""))=$P(X,U,4)

 I INTYP="ORM" F I=1:1 S X=$G(@ING@(I)) Q:'$L(X)  I $P(X,INDELIM)="ZOR" S INORTYP=$P(X,INDELIM,2) Q

 S X=INTYP_$S(INTYP="ZPW":"*",1:INEVN)_INORTYP

 D LOG^INHVCRA1("msg type is "_X,5)

 I $D(INDEST(X)) S INDST=INDEST(X) I $D(^INRHD("B",INDST)) S INDSTP=$O(^(INDST,0))

 Q

 ;

DESTTXT ; the following lines are used by DEST to build INDEST() for BCC

 ;;ZIL^Z02^^HL INH APPLICATION SERVER LOGON

 ;;ZIL^Z03^^HL INH APPLICATION SERVER LOGOFF

 ;;ZPW^*^^HL ORPW PATIENT SELECT

 ;;ORM^O01^4^HL ORPW LAB ORDER IN

 ;;ORM^O01^5^HL ORPW RAD ORDER - IN

 ;;ORM^O01^9^HL ORPW RX ORDER - IN

 ;;QRY^A19^^HL ORPW PATIENT LOOKUP - IN

INHVCRAB  ;JKB ; 8 Jul 95 15:57; BCC-specific ApS Code

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

 +4       ;no top entry

           QUIT 

 +5       ;

 +6       ; This routine contains Application Server (ApS) code specific for the

 +7       ; BCC application interface.

 +8       ;

DEST      ; determine destination for an inbound BCC message

 +1       ; Note  : this code is eXec'd from IN^INHUSEN where the context

 +2       ;         includes the input vars & expects the output vars doc'd below

 +3       ; Input : ING     (req) = var name for inbound data array

 +4       ;         INTYP   (req) = msg type

 +5       ;         INEVN   (req) = event type

 +6       ;         INMSH   (req) = MSH segment

 +7       ;         INDELIM (req) = segment delimeter

 +8       ; Output: void

 +9       ;         INDST   = INTERFACE DESTINATION Name

 +10      ;         INDSTP  = INTERFACE DESTINATION ptr (undef if no destination)

 +11      ;         INDEST  = array of valid inbound destinations

 +12      ; Local : INORTYP = ORDER TYPE (ZOR:1)

 +13      ;         INRECV  = receiving app (MSH:5)

 +14      ;         INSEND  = sending app (MSH:3)

 +15       KILL INDSTP

 +16       NEW I,INORTYP,INRECV,INSEND,X

 +17       SET INSEND=$PIECE(INMSH,INDELIM,3)

           SET INRECV=$PIECE(INMSH,INDELIM,5)

           SET INORTYP=""

 +18      ; build INDEST() if not done so for BCC

 +19       IF $GET(INDEST)'="BCC"

               SET INDEST="BCC"

               FOR I=1:1

                   SET X=$PIECE($TEXT(DESTTXT+I),";;",2)

                   IF '$LENGTH(X)

                       QUIT 

                   SET INDEST($TRANSLATE($PIECE(X,U,1,3),U,""))=$PIECE(X,U,4)

 +20       IF INTYP="ORM"

               FOR I=1:1

                   SET X=$GET(@ING@(I))

                   IF '$LENGTH(X)

                       QUIT 

                   IF $PIECE(X,INDELIM)="ZOR"

                       SET INORTYP=$PIECE(X,INDELIM,2)

                       QUIT 

 +21       SET X=INTYP_$SELECT(INTYP="ZPW":"*",1:INEVN)_INORTYP

 +22       DO LOG^INHVCRA1("msg type is "_X,5)

 +23       IF $DATA(INDEST(X))

               SET INDST=INDEST(X)

               IF $DATA(^INRHD("B",INDST))

                   SET INDSTP=$ORDER(^(INDST,0))

 +24       QUIT 

 +25      ;

DESTTXT   ; the following lines are used by DEST to build INDEST() for BCC

 +1       ;;ZIL^Z02^^HL INH APPLICATION SERVER LOGON

 +2       ;;ZIL^Z03^^HL INH APPLICATION SERVER LOGOFF

 +3       ;;ZPW^*^^HL ORPW PATIENT SELECT

 +4       ;;ORM^O01^4^HL ORPW LAB ORDER IN

 +5       ;;ORM^O01^5^HL ORPW RAD ORDER - IN

 +6       ;;ORM^O01^9^HL ORPW RX ORDER - IN

 +7       ;;QRY^A19^^HL ORPW PATIENT LOOKUP - IN