INHVATR(UIF,ERROR) ;JSH; 7 Aug 92 05:52;Transceiver/Receiver
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
;First part is the transceiver
;First, get an entry in the SAIC-CARE MESSAGE FILE
L +^INVAS(0) S Z=^INVAS(0),INZ=$P(Z,U,3)+1 F INZ=INZ:1 Q:'$D(^INVAS(INZ))
S ^INVAS(INZ,0)="",$P(Z,U,3,4)=INZ_U_($P(Z,U,4)+1),^INVAS(0)=Z
L -^INVAS(0) L +^INVAS(INZ)
S $P(^INVAS(INZ,0),U,1,3)=$$NOW^UTDT("S")_U_U_0
S (%,LCT)=0 F D GETLINE^INHOU(UIF,.LCT,.LINE) Q:'$D(LINE) D
. ;copy main line
. S %=%+1,^INVAS(INZ,1,%,0)=LINE
. ;Copy overflow nodes
. F I=1:1 Q:'$D(LINE(I)) S ^INVAS(INZ,1,%+I,0)=LINE(I)
. S %=%+I-1,^INVAS(INZ,1,%,0)=^INVAS(INZ,1,%,0)_$C(13)
S ^INVAS(INZ,1,0)=U_U_%_U_%
;Cross-reference the entry
S DA=INZ,DIK="^INVAS(" D IX1^DIK
;Unlock and quit
L -^INVAS(INZ) Q 0
;
VERIFY ;Verify transmission global processing
I '$D(IOF) S IOP="" D ^%ZIS
W @IOF
N I,Y,%
S (I,%)=0
F S I=$O(^INVAS("AP",0,I)) Q:'I I $D(^INVAS(I,0)) S %=%+1 I %=1 S Y=+^(0) X ^DD("DD")
W !,"There "_$P("is ^are ",U,%'=1+1)_%_" message"_$E("s",%'=1)_" from SAIC-Care to DHCP not yet received." W:% !?5,"Oldest was transmitted "_Y
S (I,%)=0 W !
F S I=$O(^INVAX("AP",0,I)) Q:'I I $D(^INVAX(I,0)) S %=%+1 I %=1 S Y=+^(0) X ^DD("DD")
W !,"There "_$P("is ^are ",U,%'=1+1)_%_" message"_$E("s",%'=1)_" from DHCP to SAIC-Care not yet received." W:% !?5,"Oldest was transmitted "_Y
Q
;
RECEIVE ;Receiver
;
LOOP Q:'$D(^INRHB("RUN",INBPN)) S IN=0
LP1 ;Look for a message using the AP cross reference
L -^INVAX(IN) Q:'$D(^INRHB("RUN",INBPN)) S ^INRHB("RUN",INBPN)=$H
S IN=$O(^INVAX("AP",0,IN)) G:'IN WAIT
;Lock the entry
L +^INVAX(IN):0 E G LP1
I '$D(^INVAX(IN,0)) K ^INVAX("AP",0,IN) G LP1
I $P(^INVAX(IN,0),U,3) K ^INVAX("AP",0,IN) G 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 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 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 message entry #"_IN) G MP
;
STORE ;store in UIF
S MESSID=$P(INDATA(1),U,10) I MESSID="" D ENR^INHE(INBPN,"DHCP 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 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
INHVATR(UIF,ERROR) ;JSH; 7 Aug 92 05:52;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 ;First, get an entry in the SAIC-CARE MESSAGE FILE
+6 LOCK +^INVAS(0)
SET Z=^INVAS(0)
SET INZ=$PIECE(Z,U,3)+1
FOR INZ=INZ:1
IF '$DATA(^INVAS(INZ))
QUIT
+7 SET ^INVAS(INZ,0)=""
SET $PIECE(Z,U,3,4)=INZ_U_($PIECE(Z,U,4)+1)
SET ^INVAS(0)=Z
+8 LOCK -^INVAS(0)
LOCK +^INVAS(INZ)
+9 SET $PIECE(^INVAS(INZ,0),U,1,3)=$$NOW^UTDT("S")_U_U_0
+10 SET (%,LCT)=0
FOR
DO GETLINE^INHOU(UIF,.LCT,.LINE)
IF '$DATA(LINE)
QUIT
Begin DoDot:1
+11 ;copy main line
+12 SET %=%+1
SET ^INVAS(INZ,1,%,0)=LINE
+13 ;Copy overflow nodes
+14 FOR I=1:1
IF '$DATA(LINE(I))
QUIT
SET ^INVAS(INZ,1,%+I,0)=LINE(I)
+15 SET %=%+I-1
SET ^INVAS(INZ,1,%,0)=^INVAS(INZ,1,%,0)_$CHAR(13)
End DoDot:1
+16 SET ^INVAS(INZ,1,0)=U_U_%_U_%
+17 ;Cross-reference the entry
+18 SET DA=INZ
SET DIK="^INVAS("
DO IX1^DIK
+19 ;Unlock and quit
+20 LOCK -^INVAS(INZ)
QUIT 0
+21 ;
VERIFY ;Verify transmission global processing
+1 IF '$DATA(IOF)
SET IOP=""
DO ^%ZIS
+2 WRITE @IOF
+3 NEW I,Y,%
+4 SET (I,%)=0
+5 FOR
SET I=$ORDER(^INVAS("AP",0,I))
IF 'I
QUIT
IF $DATA(^INVAS(I,0))
SET %=%+1
IF %=1
SET Y=+^(0)
XECUTE ^DD("DD")
+6 WRITE !,"There "_$PIECE("is ^are ",U,%'=1+1)_%_" message"_$EXTRACT("s",%'=1)_" from SAIC-Care to DHCP not yet received."
IF %
WRITE !?5,"Oldest was transmitted "_Y
+7 SET (I,%)=0
WRITE !
+8 FOR
SET I=$ORDER(^INVAX("AP",0,I))
IF 'I
QUIT
IF $DATA(^INVAX(I,0))
SET %=%+1
IF %=1
SET Y=+^(0)
XECUTE ^DD("DD")
+9 WRITE !,"There "_$PIECE("is ^are ",U,%'=1+1)_%_" message"_$EXTRACT("s",%'=1)_" from DHCP to SAIC-Care not yet received."
IF %
WRITE !?5,"Oldest was transmitted "_Y
+10 QUIT
+11 ;
RECEIVE ;Receiver
+1 ;
LOOP IF '$DATA(^INRHB("RUN",INBPN))
QUIT
SET IN=0
LP1 ;Look for a message using the AP cross reference
+1 LOCK -^INVAX(IN)
IF '$DATA(^INRHB("RUN",INBPN))
QUIT
SET ^INRHB("RUN",INBPN)=$HOROLOG
+2 SET IN=$ORDER(^INVAX("AP",0,IN))
IF 'IN
GOTO WAIT
+3 ;Lock the entry
+4 LOCK +^INVAX(IN):0
IF '$TEST
GOTO LP1
+5 IF '$DATA(^INVAX(IN,0))
KILL ^INVAX("AP",0,IN)
GOTO LP1
+6 IF $PIECE(^INVAX(IN,0),U,3)
KILL ^INVAX("AP",0,IN)
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 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 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 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 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 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
