- 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