Routine: INHVCRAC

INHVCRAC ;JKB ; 6 Apr 96 16:22; CIW-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

 ; CIW application interface.

DEST ; determine destination for an inbound PWS 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

 ;Set flag to allow anyone to log in

 S INANYONE=1

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

 ; build INDEST() if not done so for PWS

 I $G(INDEST)'="CIW" S INDEST="CIW" 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))

DISP ;Display

 W !!,"MsgTyp",?10,"EvnTyp",?20,"OrdTyp",?30,"Destination",!

 F I=1:1 S X=$P($T(DESTTXT+I),";;",2) Q:'$L(X)  D

 .  W !," " F J=1:1:4 W ?(J-1*10),$P(X,U,J)

 W !!

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

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

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

 ;;ZPW^*^^HL ORPW PATIENT SELECT

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

 ;;ORM^O01^8^HL ORPW ANC ORDER - IN

 ;;ORM^O01^10^HL ORPW CLN ORDER - IN

 ;;ORM^O01^30^HL ORPW CON ORDER - IN

 ;;ORM^O01^14^HL ORPW DTS ORDER IN

 ;;ORM^O01^11^HL ORPW IVP IN

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

 ;;ORM^O01^6^HL ORPW MED ORDER IN

 ;;ORM^O01^3^HL ORPW NRS ORDER - IN

 ;;ORM^O01^80^HL ORPW NRS ORDER - IN

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

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

INHVCRAC  ;JKB ; 6 Apr 96 16:22; CIW-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       ; This routine contains Application Server (ApS) code specific for the

 +6       ; CIW application interface.

 +7       ;

DEST      ; determine destination for an inbound PWS 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 flag to allow anyone to log in

 +18       SET INANYONE=1

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

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

           SET INORTYP=""

 +20      ; build INDEST() if not done so for PWS

 +21       IF $GET(INDEST)'="CIW"

               SET INDEST="CIW"

               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)

 +22       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

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

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

 +25       IF $DATA(INDEST(X))

               SET INDST=INDEST(X)

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

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

 +26       QUIT

DISP      ;Display

 +1       ;

 +2        WRITE !!,"MsgTyp",?10,"EvnTyp",?20,"OrdTyp",?30,"Destination",!

 +3        FOR I=1:1

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

               IF '$LENGTH(X)

                   QUIT

               Begin DoDot:1

 +4                WRITE !," "

                   FOR J=1:1:4

                       WRITE ?(J-1*10),$PIECE(X,U,J)

               End DoDot:1

 +5        WRITE !!

 +6        QUIT

 +7       ;

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

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

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

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

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

 +5       ;;ORM^O01^8^HL ORPW ANC ORDER - IN

 +6       ;;ORM^O01^10^HL ORPW CLN ORDER - IN

 +7       ;;ORM^O01^30^HL ORPW CON ORDER - IN

 +8       ;;ORM^O01^14^HL ORPW DTS ORDER IN

 +9       ;;ORM^O01^11^HL ORPW IVP IN

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

 +11      ;;ORM^O01^6^HL ORPW MED ORDER IN

 +12      ;;ORM^O01^3^HL ORPW NRS ORDER - IN

 +13      ;;ORM^O01^80^HL ORPW NRS ORDER - IN

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

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

INHVCRAC.m