INHVAMR ;JSH; 27 May 94 09:34; VA gateway/MDIS Receiver
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
RECEIVE ;Receiver
;INPUT:
; INBPN - background process ien
;
S SYSTEM="VA" ;magic
LOOP ;Restart at top of queue
Q:'$D(^INRHB("RUN",INBPN)) S IN=0,^INRHB("RUN",INBPN)=$H
LP1 ;Look for a message using the APS cross reference
L -^INVAMI(IN) Q:'$D(^INRHB("RUN",INBPN)) S ^INRHB("RUN",INBPN)=$H
S IN=$O(^INVAMI("APS",0,IN)) G:'IN WAIT
;Lock the entry
L +^INVAMI(IN):0 E G LP1
G:'$D(^INVAMI(IN,0)) LP1 G:$P(^INVAMI(IN,0),U,4) LP1
S ING="INDATA" K INDATA
S (%,%1)=0 F Q:%="" S %=$O(^INVAMI(IN,1,%)) Q:'% S %1=%1+1,INDATA(%1)=^(%,0) D:INDATA(%1)'[$C(13) I INDATA(%1)[$C(13) S INDATA(%1)=$TR(INDATA(%1),$C(13))
. S %2=0 F S %=$O(^INVAMI(IN,1,%)) Q:'% S %2=%2+1,INDATA(%1,%2)=^(%,0) I INDATA(%1,%2)[$C(13) S INDATA(%1,%2)=$TR(INDATA(%1,%2),$C(13)) Q
I '$D(INDATA(2)) D ENR^INHE(INBPN,"Message format error in MDIS message #"_IN) G MP
I $E(INDATA(2),1,3)="MSA" S DEST="INCOMING ACK",ACK=0 G STORE
;Not currently accepting anything except ack messages
D ENR^INHE(INBPN,"Invalid MDIS message type received entry #"_IN) G MP
;
S X=$P(INDATA(2),U,1,2) I $E(X,1,3)'="EVN" D ENR^INHE(INBPN,"MDIS message entry #"_IN_" does not have the EVN segment in the correct location.") G MP
NOCON S XX=^INVAMI(IN,0)
;,A=$P(XX,U,4),A=A+1,$P(^(0),U,4)=A
;I A>5 D ENR^INHE(INBPN,"Too many attempts for entry #"_IN) G MP
S DEST=$P($T(@$P(X,U,2)),";",3),ACK=1
I DEST="" D ENR^INHE(INBPN,"No known destination for event type "_$P(X,U,2)_" in MDIS message entry #"_IN) G MP
;
STORE ;store in UIF
S MESSID=$P(INDATA(1),U,10) I MESSID="" D ENR^INHE(INBPN,"MDIS message entry #"_IN_" does not have a message ID") G MP
S MESSID="MDIS-"_MESSID
;Call the input driver
S X=$$NEW^INHD(MESSID,DEST,"MDIS","INDATA",ACK,"I")
;If the input driver returns a -1 then the transaction was rejected
I X<0 D ENR^INHE(INBPN,"MDIS message entry #"_IN_" was rejected by GIS") G MP
;
DEL ;Delete entry
S DIK="^INVAMI(",DA=IN D ^DIK
;unlock and return to loop
L -^INVAMI(IN) G LP1
;
MP ;Mark as processed
S DIE="^INVAMI(",DA=IN,DR=".04///1" D ^DIE
;unlock and return to loop
L -^INVAMI(IN) G LP1
;
WAIT ;Wait for new messages to appear in the queue
H 15 G LOOP
;
;
DEST ;The following tags are used to determine destination
;
INHVAMR ;JSH; 27 May 94 09:34; VA gateway/MDIS Receiver
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
RECEIVE ;Receiver
+1 ;INPUT:
+2 ; INBPN - background process ien
+3 ;
+4 ;magic
SET SYSTEM="VA"
LOOP ;Restart at top of queue
+1 IF '$DATA(^INRHB("RUN",INBPN))
QUIT
SET IN=0
SET ^INRHB("RUN",INBPN)=$HOROLOG
LP1 ;Look for a message using the APS cross reference
+1 LOCK -^INVAMI(IN)
IF '$DATA(^INRHB("RUN",INBPN))
QUIT
SET ^INRHB("RUN",INBPN)=$HOROLOG
+2 SET IN=$ORDER(^INVAMI("APS",0,IN))
IF 'IN
GOTO WAIT
+3 ;Lock the entry
+4 LOCK +^INVAMI(IN):0
IF '$TEST
GOTO LP1
+5 IF '$DATA(^INVAMI(IN,0))
GOTO LP1
IF $PIECE(^INVAMI(IN,0),U,4)
GOTO LP1
+6 SET ING="INDATA"
KILL INDATA
+7 SET (%,%1)=0
FOR
IF %=""
QUIT
SET %=$ORDER(^INVAMI(IN,1,%))
IF '%
QUIT
SET %1=%1+1
SET INDATA(%1)=^(%,0)
IF INDATA(%1)'[$CHAR(13)
Begin DoDot:1
+8 SET %2=0
FOR
SET %=$ORDER(^INVAMI(IN,1,%))
IF '%
QUIT
SET %2=%2+1
SET INDATA(%1,%2)=^(%,0)
IF INDATA(%1,%2)[$CHAR(13)
SET INDATA(%1,%2)=$TRANSLATE(INDATA(%1,%2),$CHAR(13))
QUIT
End DoDot:1
IF INDATA(%1)[$CHAR(13)
SET INDATA(%1)=$TRANSLATE(INDATA(%1),$CHAR(13))
+9 IF '$DATA(INDATA(2))
DO ENR^INHE(INBPN,"Message format error in MDIS message #"_IN)
GOTO MP
+10 IF $EXTRACT(INDATA(2),1,3)="MSA"
SET DEST="INCOMING ACK"
SET ACK=0
GOTO STORE
+11 ;Not currently accepting anything except ack messages
+12 DO ENR^INHE(INBPN,"Invalid MDIS message type received entry #"_IN)
GOTO MP
+13 ;
+14 SET X=$PIECE(INDATA(2),U,1,2)
IF $EXTRACT(X,1,3)'="EVN"
DO ENR^INHE(INBPN,"MDIS message entry #"_IN_" does not have the EVN segment in the correct location.")
GOTO MP
NOCON SET XX=^INVAMI(IN,0)
+1 ;,A=$P(XX,U,4),A=A+1,$P(^(0),U,4)=A
+2 ;I A>5 D ENR^INHE(INBPN,"Too many attempts for entry #"_IN) G MP
+3 SET DEST=$PIECE($TEXT(@$PIECE(X,U,2)),";",3)
SET ACK=1
+4 IF DEST=""
DO ENR^INHE(INBPN,"No known destination for event type "_$PIECE(X,U,2)_" in MDIS message entry #"_IN)
GOTO MP
+5 ;
STORE ;store in UIF
+1 SET MESSID=$PIECE(INDATA(1),U,10)
IF MESSID=""
DO ENR^INHE(INBPN,"MDIS message entry #"_IN_" does not have a message ID")
GOTO MP
+2 SET MESSID="MDIS-"_MESSID
+3 ;Call the input driver
+4 SET X=$$NEW^INHD(MESSID,DEST,"MDIS","INDATA",ACK,"I")
+5 ;If the input driver returns a -1 then the transaction was rejected
+6 IF X<0
DO ENR^INHE(INBPN,"MDIS message entry #"_IN_" was rejected by GIS")
GOTO MP
+7 ;
DEL ;Delete entry
+1 SET DIK="^INVAMI("
SET DA=IN
DO ^DIK
+2 ;unlock and return to loop
+3 LOCK -^INVAMI(IN)
GOTO LP1
+4 ;
MP ;Mark as processed
+1 SET DIE="^INVAMI("
SET DA=IN
SET DR=".04///1"
DO ^DIE
+2 ;unlock and return to loop
+3 LOCK -^INVAMI(IN)
GOTO LP1
+4 ;
WAIT ;Wait for new messages to appear in the queue
+1 HANG 15
GOTO LOOP
+2 ;
+3 ;
DEST ;The following tags are used to determine destination
+1 ;
