INHVCRAP.m

INHVCRAP ;JKB ; 22 Oct 1999 17:31 ; PWS-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

 ; PWS 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,INMSGTP

 S INMSGTP="^ZPW^ADT^SRM^"    ;DDSA-O95608

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

 S:INSEND["DDSA" INANYONE=1   ;DDSA-095608

 ;I INSEND'="PWS/ORE"!(INRECV'="CHCS/ORE") Q

 ; build INDEST() if not done so for PWS

 I $G(INDEST)'="PWS" S INDEST="PWS" 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(INMSGTP["^"_INTYP_"^":"*",1:INEVN)_INORTYP   ;DDSA-095608

 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 PWS

 ; the lines QRY^Q01,ADT^*, SRM^* are added to support DDSA

 ;;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

 ;;QRY^A19^^HL DDSA QR PAT DEM - IN

 ;;SQR^S25^^HL DDSA QR APPT HIS - IN

 ;;ADT^*^^HL DDSA PATIENT REQUEST - IN

 ;;SRM^*^^HL DDSA APPT REQUEST - IN

INHVCRAP  ;JKB ; 22 Oct 1999 17:31 ; PWS-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       ; PWS application interface.

 +8       ;

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,INMSGTP

 +17      ;DDSA-O95608

           SET INMSGTP="^ZPW^ADT^SRM^"

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

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

           SET INORTYP=""

 +19      ;DDSA-095608

           IF INSEND["DDSA"

               SET INANYONE=1

 +20      ;I INSEND'="PWS/ORE"!(INRECV'="CHCS/ORE") Q

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

 +22       IF $GET(INDEST)'="PWS"

               SET INDEST="PWS"

               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)

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

 +24      ;DDSA-095608

           SET X=INTYP_$SELECT(INMSGTP["^"_INTYP_"^":"*",1:INEVN)_INORTYP

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

 +26       IF $DATA(INDEST(X))

               SET INDST=INDEST(X)

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

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

 +27       QUIT 

 +28      ;

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

 +1       ; the lines QRY^Q01,ADT^*, SRM^* are added to support DDSA

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

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

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

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

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

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

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

 +9       ;;QRY^A19^^HL DDSA QR PAT DEM - IN

 +10      ;;SQR^S25^^HL DDSA QR APPT HIS - IN

 +11      ;;ADT^*^^HL DDSA PATIENT REQUEST - IN

 +12      ;;SRM^*^^HL DDSA APPT REQUEST - IN