INHVAX(UIF,ERROR) ;JSH; 21 Jul 92 10:28;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"),DIC="^INVA(",DIC(0)="L",DLAYGO=4090 D ^DICN
I Y<0 S ERROR(1)="Unable to create entry in ^INVA" Q 1
S INZ=+Y L +^INVA(INZ)
S $P(^INVA(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,^INVA(INZ,1,%,0)=LINE
. ;Copy overflow nodes
. F I=1:1 Q:'$D(LINE(I)) S ^INVA(INZ,1,%+I,0)=LINE(I)
. S %=%+I-1,^INVA(INZ,1,%,0)=^INVA(INZ,1,%,0)_$C(13)
S ^INVA(INZ,1,0)=U_U_%_U_%
;Cross-reference the entry
S DA=INZ,DIK="^INVA(" D IX1^DIK
;Unlock and quit
L -^INVA(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 -^INVA(IN) Q:'$D(^INRHB("RUN",INBPN)) S ^INRHB("RUN",INBPN)=$H
S IN=$O(^INVA("APS",0,SYSTEM,IN)) I 'IN Q:$D(CONVERT) G WAIT
;Lock the entry
L +^INVA(IN):0 E G LP1
G:$P(^INVA(IN,0),U,3) LP1
S ING="INDATA" K INDATA
S (%,%1)=0 F Q:%="" S %=$O(^INVA(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(^INVA(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
G:'$D(CONVERT) NOCON
;If doing conversion ignore those with incorrect event types
G:$P(X,U,2)'=CONVERT LP1
I $D(CONVERT(0)),$P($G(INDATA(3)),U)'=CONVERT(0) G LP1
I $D(CONVERT("C")) S CONVERT("COUNT")=CONVERT("COUNT")+1 Q:CONVERT("COUNT")>CONVERT("C")
S ACK=0 W "."
NOCON S XX=^INVA(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
S:$D(CONVERT) MESSID=$P(X,U,2)_MESSID
;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="^INVA(",DA=IN,DR=".05///NOW" D ^DIE
MP ;Mark as processed, unlock and return to loop
S DIE="^INVA(",DA=IN,DR=".03///1" D ^DIE L -^INVA(IN) G LP1
;
WAIT ;
H 5 G LOOP
;
CONVERT ;Entry to run conversion
D VAR^DWUTL K CONVERT
W @IOF D ^UTSRD("Event type to convert: ","Enter the EVENT TYPE of messages to process") Q:X=""!($E(X)="^") S CONVERT=X
W ! D ^UTSRD("Value of first segment: ","Enter a value which the first segment must match to be processed. Use NULL to bypass this check.") Q:$E(X)=U
S:X]"" CONVERT(0)=X
W ! D ^UTSRD("Max number of messages to move: ","Enter how many you wish to move.") Q:$E(X)=U S:X CONVERT("C")=+X
W ! D ^UTSRD("Starting entry number in INVA: ") Q:$E(X)=U!(+X<0) S IN=+X S:IN'<1 IN=IN-1
W ! D ^UTSRD("Number of transfer jobs: ") Q:$E(X)=U S X=+X S:X<1 X=1 S ITERC=X
D WAIT^DICD
S INBPN="CONVERT",^INRHB("RUN",INBPN)="",SYSTEM="VA",CONVERT("COUNT")=0
F X=1:1:ITERC D
.S ZTSAVE("*")="",ZTDESC="Transfer messages to GIS",ZTIO="",ZTRTN="LP1^INHVAX" D ^%ZTLOAD
Q
;
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
PATALG ;;OUTPATIENT PHARMACY BURST-AL
INHVAX(UIF,ERROR) ;JSH; 21 Jul 92 10:28;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")
SET DIC="^INVA("
SET DIC(0)="L"
SET DLAYGO=4090
DO ^DICN
+8 IF Y<0
SET ERROR(1)="Unable to create entry in ^INVA"
QUIT 1
+9 SET INZ=+Y
LOCK +^INVA(INZ)
+10 SET $PIECE(^INVA(INZ,0),U,2,3)=SYSTEM_U_0
+11 SET (%,LCT)=0
FOR
DO GETLINE^INHOU(UIF,.LCT,.LINE)
IF '$DATA(LINE)
QUIT
Begin DoDot:1
+12 ;copy main line
+13 SET %=%+1
SET ^INVA(INZ,1,%,0)=LINE
+14 ;Copy overflow nodes
+15 FOR I=1:1
IF '$DATA(LINE(I))
QUIT
SET ^INVA(INZ,1,%+I,0)=LINE(I)
+16 SET %=%+I-1
SET ^INVA(INZ,1,%,0)=^INVA(INZ,1,%,0)_$CHAR(13)
End DoDot:1
+17 SET ^INVA(INZ,1,0)=U_U_%_U_%
+18 ;Cross-reference the entry
+19 SET DA=INZ
SET DIK="^INVA("
DO IX1^DIK
+20 ;Unlock and quit
+21 LOCK -^INVA(INZ)
QUIT 0
+22 ;
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 -^INVA(IN)
IF '$DATA(^INRHB("RUN",INBPN))
QUIT
SET ^INRHB("RUN",INBPN)=$HOROLOG
+2 SET IN=$ORDER(^INVA("APS",0,SYSTEM,IN))
IF 'IN
IF $DATA(CONVERT)
QUIT
GOTO WAIT
+3 ;Lock the entry
+4 LOCK +^INVA(IN):0
IF '$TEST
GOTO LP1
+5 IF $PIECE(^INVA(IN,0),U,3)
GOTO LP1
+6 SET ING="INDATA"
KILL INDATA
+7 SET (%,%1)=0
FOR
IF %=""
QUIT
SET %=$ORDER(^INVA(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(^INVA(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 DHCP/SAIC message #"_IN)
GOTO MP
+10 IF $EXTRACT(INDATA(2),1,3)="MSA"
SET DEST="INCOMING ACK"
SET ACK=0
GOTO STORE
+11 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
+12 IF '$DATA(CONVERT)
GOTO NOCON
+13 ;If doing conversion ignore those with incorrect event types
+14 IF $PIECE(X,U,2)'=CONVERT
GOTO LP1
+15 IF $DATA(CONVERT(0))
IF $PIECE($GET(INDATA(3)),U)'=CONVERT(0)
GOTO LP1
+16 IF $DATA(CONVERT("C"))
SET CONVERT("COUNT")=CONVERT("COUNT")+1
IF CONVERT("COUNT")>CONVERT("C")
QUIT
+17 SET ACK=0
WRITE "."
NOCON SET XX=^INVA(IN,0)
SET A=$PIECE(XX,U,4)
SET A=A+1
SET $PIECE(^(0),U,4)=A
+1 IF A>5
DO ENR^INHE(INBPN,"Too many attempts for entry #"_IN)
GOTO MP
+2 SET DEST=$PIECE($TEXT(@$PIECE(X,U,2)),";",3)
SET ACK=1
+3 IF DEST=""
DO ENR^INHE(INBPN,"No known destination for event type "_$PIECE(X,U,2)_" in DHCP/SAIC message entry #"_IN)
GOTO MP
+4 ;
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 IF $DATA(CONVERT)
SET MESSID=$PIECE(X,U,2)_MESSID
+3 ;Call the input driver
+4 SET X=$$NEW^INHD(MESSID,DEST,"DHCP","INDATA",ACK,"I")
+5 ;If the input driver returns a -1 then the transaction was rejected
+6 IF X<0
DO ENR^INHE(INBPN,"DHCP/SAIC message entry #"_IN_" was rejected by GIS")
GOTO MP
+7 ;Update the DATE TRANSFERRED field
+8 SET DIE="^INVA("
SET DA=IN
SET DR=".05///NOW"
DO ^DIE
MP ;Mark as processed, unlock and return to loop
+1 SET DIE="^INVA("
SET DA=IN
SET DR=".03///1"
DO ^DIE
LOCK -^INVA(IN)
GOTO LP1
+2 ;
WAIT ;
+1 HANG 5
GOTO LOOP
+2 ;
CONVERT ;Entry to run conversion
+1 DO VAR^DWUTL
KILL CONVERT
+2 WRITE @IOF
DO ^UTSRD("Event type to convert: ","Enter the EVENT TYPE of messages to process")
IF X=""!($EXTRACT(X)="^")
QUIT
SET CONVERT=X
+3 WRITE !
DO ^UTSRD("Value of first segment: ","Enter a value which the first segment must match to be processed. Use NULL to bypass this check.")
IF $EXTRACT(X)=U
QUIT
+4 IF X]""
SET CONVERT(0)=X
+5 WRITE !
DO ^UTSRD("Max number of messages to move: ","Enter how many you wish to move.")
IF $EXTRACT(X)=U
QUIT
IF X
SET CONVERT("C")=+X
+6 WRITE !
DO ^UTSRD("Starting entry number in INVA: ")
IF $EXTRACT(X)=U!(+X<0)
QUIT
SET IN=+X
IF IN'<1
SET IN=IN-1
+7 WRITE !
DO ^UTSRD("Number of transfer jobs: ")
IF $EXTRACT(X)=U
QUIT
SET X=+X
IF X<1
SET X=1
SET ITERC=X
+8 DO WAIT^DICD
+9 SET INBPN="CONVERT"
SET ^INRHB("RUN",INBPN)=""
SET SYSTEM="VA"
SET CONVERT("COUNT")=0
+10 FOR X=1:1:ITERC
Begin DoDot:1
+11 SET ZTSAVE("*")=""
SET ZTDESC="Transfer messages to GIS"
SET ZTIO=""
SET ZTRTN="LP1^INHVAX"
DO ^%ZTLOAD
End DoDot:1
+12 QUIT
+13 ;
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
PATALG ;;OUTPATIENT PHARMACY BURST-AL
