INHVATRP(UIF,ERROR) ;JSH; 11 Feb 93 12:34;Transceiver / Receiver
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
;First part is the transceiver
S SYSTEM="SC" N DIC,DLAYGO
;First, get an entry in the DHCP/SAIC-CARE MESSAGE FILE
S X=$$NOW^UTDT("S")
L +^INVAX(0) S Z=^INVAX(0),INZ=$P(Z,U,3)+1 F INZ=INZ:1 Q:'$D(^INVAX(INZ))
S ^INVAX(INZ,0)="",$P(Z,U,3,4)=INZ_U_($P(Z,U,4)+1)
L -^INVAX(0)
L +^INVAX(INZ)
S $P(^INVAX(INZ,0),U,2,3)=SYSTEM_U_0
S (%,LCT)=0 F D GETLINE^INHOU(UIF,.LCT,.LINE) Q:'$D(LINE) D
. ;copy main line
. S %=%+1,^INVAX(INZ,1,%,0)=LINE
. ;Copy overflow nodes
. F I=1:1 Q:'$D(LINE(I)) S ^INVAX(INZ,1,%+I,0)=LINE(I)
. S %=%+I-1,^INVAX(INZ,1,%,0)=^INVAX(INZ,1,%,0)_$C(13)
S ^INVAX(INZ,1,0)=U_U_%_U_%
;Cross-reference the entry
S DA=INZ,DIK="^INVAX(" D IX1^DIK
;Unlock and quit
L -^INVAX(INZ) Q 0
;
RECEIVE ;Receiver
S SYSTEM="VA" K CONVERT
LOOP Q:'$D(^INRHB("RUN",INBPN)) S IN=0,^INRHB("RUN",INBPN)=$H
LP1 ;Look for a message using the APS cross reference
L -^INVAX(IN) Q:'$D(^INRHB("RUN",INBPN))
S IN=$O(^INVAX("APS",0,SYSTEM,IN)) I 'IN Q:$D(CONVERT) G WAIT
;Lock the entry
L +^INVAX(IN):0 E G LP1
I '$D(^INVAX(IN,0)) K ^INVAX("APS",0,SYSTEM,IN) G LP1
G:$P(^INVAX(IN,0),U,3) LP1
S ING="INDATA" K INDATA
S (%,%1)=0 F Q:%="" S %=$O(^INVAX(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(^INVAX(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 DHCP/SAIC message #"_IN) G MP
I $E(INDATA(2),1,3)="MSA" S DEST="INCOMING ACK",ACK=0 G STORE
S X=$P(INDATA(2),U,1,2) I $E(X,1,3)'="EVN" D ENR^INHE(INBPN,"DHCP/SAIC message entry #"_IN_" does not have the EVN segment in the correct location.") G MP
S XX=^INVAX(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 DHCP/SAIC message entry #"_IN) G MP
;
STORE ;store in UIF
S MESSID=$P(INDATA(1),U,10) I MESSID="" D ENR^INHE(INBPN,"DHCP/SAIC message entry #"_IN_" does not have a message ID") G MP
;Call the input driver
S X=$$NEW^INHD(MESSID,DEST,"DHCP","INDATA",ACK,"I")
;If the input driver returns a -1 then the transaction was rejected
I X<0 D ENR^INHE(INBPN,"DHCP/SAIC message entry #"_IN_" was rejected by GIS") G MP
;Update the DATE TRANSFERRED field
S DIE="^INVAX(",DA=IN,DR=".05///NOW" D ^DIE
MP ;Mark as processed, unlock and return to loop
S DIE="^INVAX(",DA=IN,DR=".03///1" D ^DIE L -^INVAX(IN) G LP1
;
WAIT ;
H 5 G LOOP
;
;
DEST ;The following tags are used to determine destination
PATADM ;;PATIENT ID-IN
REGTAX ;;DISABILITY CONDITION CONVERSION
SYSUSR ;;USER/PERSON/PROVIDER CONVERSION
REGTAB ;;INSURANCE CONVERSION
PATREG ;;ADD/UPDATE PATIENT REGISTRATION
PATADT ;;ADT/PTF CONVERSION
OUTPHR ;;OUTPATIENT PHARMACY CONVERSION
PATPHARM ;;PHARMACY PATIENT UPDATE
PATBILL ;;BILLING PATIENT
PATLRG ;;GENERAL LAB RESULTS
PATLRM ;;MICROBIOLOGY RESULTS
PATLRA ;;AP RESULTS
INPHR ;;INPATIENT PHARMACY CONVERSION
INHVATRP(UIF,ERROR) ;JSH; 11 Feb 93 12:34;Transceiver / Receiver
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ;First part is the transceiver
+5 SET SYSTEM="SC"
NEW DIC,DLAYGO
+6 ;First, get an entry in the DHCP/SAIC-CARE MESSAGE FILE
+7 SET X=$$NOW^UTDT("S")
+8 LOCK +^INVAX(0)
SET Z=^INVAX(0)
SET INZ=$PIECE(Z,U,3)+1
FOR INZ=INZ:1
IF '$DATA(^INVAX(INZ))
QUIT
+9 SET ^INVAX(INZ,0)=""
SET $PIECE(Z,U,3,4)=INZ_U_($PIECE(Z,U,4)+1)
+10 LOCK -^INVAX(0)
+11 LOCK +^INVAX(INZ)
+12 SET $PIECE(^INVAX(INZ,0),U,2,3)=SYSTEM_U_0
+13 SET (%,LCT)=0
FOR
DO GETLINE^INHOU(UIF,.LCT,.LINE)
IF '$DATA(LINE)
QUIT
Begin DoDot:1
+14 ;copy main line
+15 SET %=%+1
SET ^INVAX(INZ,1,%,0)=LINE
+16 ;Copy overflow nodes
+17 FOR I=1:1
IF '$DATA(LINE(I))
QUIT
SET ^INVAX(INZ,1,%+I,0)=LINE(I)
+18 SET %=%+I-1
SET ^INVAX(INZ,1,%,0)=^INVAX(INZ,1,%,0)_$CHAR(13)
End DoDot:1
+19 SET ^INVAX(INZ,1,0)=U_U_%_U_%
+20 ;Cross-reference the entry
+21 SET DA=INZ
SET DIK="^INVAX("
DO IX1^DIK
+22 ;Unlock and quit
+23 LOCK -^INVAX(INZ)
QUIT 0
+24 ;
RECEIVE ;Receiver
+1 SET SYSTEM="VA"
KILL CONVERT
LOOP 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 -^INVAX(IN)
IF '$DATA(^INRHB("RUN",INBPN))
QUIT
+2 SET IN=$ORDER(^INVAX("APS",0,SYSTEM,IN))
IF 'IN
IF $DATA(CONVERT)
QUIT
GOTO WAIT
+3 ;Lock the entry
+4 LOCK +^INVAX(IN):0
IF '$TEST
GOTO LP1
+5 IF '$DATA(^INVAX(IN,0))
KILL ^INVAX("APS",0,SYSTEM,IN)
GOTO LP1
+6 IF $PIECE(^INVAX(IN,0),U,3)
GOTO LP1
+7 SET ING="INDATA"
KILL INDATA
+8 SET (%,%1)=0
FOR
IF %=""
QUIT
SET %=$ORDER(^INVAX(IN,1,%))
IF '%
QUIT
SET %1=%1+1
SET INDATA(%1)=^(%,0)
IF INDATA(%1)'[$CHAR(13)
Begin DoDot:1
+9 SET %2=0
FOR
SET %=$ORDER(^INVAX(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))
+10 IF '$DATA(INDATA(2))
DO ENR^INHE(INBPN,"Message format error in DHCP/SAIC message #"_IN)
GOTO MP
+11 IF $EXTRACT(INDATA(2),1,3)="MSA"
SET DEST="INCOMING ACK"
SET ACK=0
GOTO STORE
+12 SET X=$PIECE(INDATA(2),U,1,2)
IF $EXTRACT(X,1,3)'="EVN"
DO ENR^INHE(INBPN,"DHCP/SAIC message entry #"_IN_" does not have the EVN segment in the correct location.")
GOTO MP
+13 SET XX=^INVAX(IN,0)
SET A=$PIECE(XX,U,4)
SET A=A+1
SET $PIECE(^(0),U,4)=A
+14 IF A>5
DO ENR^INHE(INBPN,"Too many attempts for entry #"_IN)
GOTO MP
+15 SET DEST=$PIECE($TEXT(@$PIECE(X,U,2)),";",3)
SET ACK=1
+16 IF DEST=""
DO ENR^INHE(INBPN,"No known destination for event type "_$PIECE(X,U,2)_" in DHCP/SAIC message entry #"_IN)
GOTO MP
+17 ;
STORE ;store in UIF
+1 SET MESSID=$PIECE(INDATA(1),U,10)
IF MESSID=""
DO ENR^INHE(INBPN,"DHCP/SAIC message entry #"_IN_" does not have a message ID")
GOTO MP
+2 ;Call the input driver
+3 SET X=$$NEW^INHD(MESSID,DEST,"DHCP","INDATA",ACK,"I")
+4 ;If the input driver returns a -1 then the transaction was rejected
+5 IF X<0
DO ENR^INHE(INBPN,"DHCP/SAIC message entry #"_IN_" was rejected by GIS")
GOTO MP
+6 ;Update the DATE TRANSFERRED field
+7 SET DIE="^INVAX("
SET DA=IN
SET DR=".05///NOW"
DO ^DIE
MP ;Mark as processed, unlock and return to loop
+1 SET DIE="^INVAX("
SET DA=IN
SET DR=".03///1"
DO ^DIE
LOCK -^INVAX(IN)
GOTO LP1
+2 ;
WAIT ;
+1 HANG 5
GOTO LOOP
+2 ;
+3 ;
DEST ;The following tags are used to determine destination
PATADM ;;PATIENT ID-IN
REGTAX ;;DISABILITY CONDITION CONVERSION
SYSUSR ;;USER/PERSON/PROVIDER CONVERSION
REGTAB ;;INSURANCE CONVERSION
PATREG ;;ADD/UPDATE PATIENT REGISTRATION
PATADT ;;ADT/PTF CONVERSION
OUTPHR ;;OUTPATIENT PHARMACY CONVERSION
PATPHARM ;;PHARMACY PATIENT UPDATE
PATBILL ;;BILLING PATIENT
PATLRG ;;GENERAL LAB RESULTS
PATLRM ;;MICROBIOLOGY RESULTS
PATLRA ;;AP RESULTS
INPHR ;;INPATIENT PHARMACY CONVERSION
