64 lines
4.2 KiB
Mathematica
64 lines
4.2 KiB
Mathematica
HLLP ;AISC/SAW-HL7 Hybrid Lower Level Protocol Receiver/Sender ;9/5/96 10:50
|
|
;;1.6;HEALTH LEVEL SEVEN;**1,12,29**;Oct 13, 1995
|
|
;This routine is used for the Version 1.5 Interface Only
|
|
INIT ;Initialize Variables
|
|
S X="ERR^HLLP" S @^%ZOSF("TRAP") I $D(HLION) S IOP=HLION D ^%ZIS G EXIT:POP
|
|
I '$D(HLION) D HOME^%ZIS G EXIT:POP S HLION=$S(ION']"":"UNKNOWN",1:ION)
|
|
S IOP="NULL DEVICE" D ^%ZIS G EXIT:POP K IOP U IO D DT^DICRW S HLTIME=% U IO(0) X ^%ZOSF("TYPE-AHEAD")
|
|
K %,%H,%I,X S (DTIME,HLTRIES)=0 S:$D(HLNDAP0) DTIME=$P(HLNDAP0,"^",9),HLTRIES=$P(HLNDAP0,"^",5) S:DTIME'>0 DTIME=60 S:HLTRIES'>0 HLTRIES=3
|
|
I $D(^%ZOSF("OS")),^%ZOSF("OS")["VAX" U IO(0):PACK X ^%ZOSF("EOFF")
|
|
E U IO(0) X ^%ZOSF("EOFF")
|
|
S HLLPC=^%ZOSF("LPC"),X=255,HLTRM=^%ZOSF("TRMRD") X ^%ZOSF("RM") X ^%ZOSF("TRMON")
|
|
LOOP ;Infinite loop to check for HL7 messages to send/receive
|
|
F S HLLOG=$S($D(^HL(770,"ALOG",HLION)):1,1:0) D CHKREC,CHKSEND I $$S^%ZTLOAD S ZTSTOP=1 Q
|
|
EXIT Q
|
|
ERR ;Trap error
|
|
K HLL(1),^TMP("HLR",$J),^TMP("HLS",$J) D @^%ZOSF("ERRTN"),^%ZISC Q
|
|
CHKREC ;Check if there are HL7 messages to receive
|
|
D REC I '$D(HLDTOUT),'HLERR S HLSDATA(1)=$C(11)_"N21"_$C(13)_HLERR,HLC1=0,HLC2="" D SENDN K HLSDATA,HLERR G CHKREC
|
|
I '$D(HLDTOUT) U IO K HLERR D ^HLCHK
|
|
U IO Q
|
|
CHKSEND ;Check if there are HL7 messages to send
|
|
Q:'$D(HLNDAP)
|
|
I '$D(HLNDAP0) S HLNDAP0=$G(^HL(770,HLNDAP,0))
|
|
S HLDA=+$O(^HL(772,"AC","O",+$P(HLNDAP0,U,12),0)) G:'HLDA EX
|
|
S HLDA0=$G(^HL(772,HLDA,0)) G:HLDA0']"" EX
|
|
S HLXMZ=+$P(HLDA0,"^",5)
|
|
I 'HLXMZ D G EX
|
|
.D STATUS^HLTF0(HLDA,4,"","No pointer to Message file(#3.9)")
|
|
I '$D(^XMB(3.9,HLXMZ)) D G EX
|
|
.D STATUS^HLTF0(HLDA,4,"","No message found at #"_HLXMZ_" in Message file(#3.9)")
|
|
I '$O(^XMB(3.9,HLXMZ,2,0)) D G EX
|
|
.D STATUS^HLTF0(HLDA,4,"","No message contents at #"_HLXMZ_" in Message file(#3.9)")
|
|
S (HLI,HLTRIED)=0,HLSDT=+HLDA0 F HLJ=1:1 S HLI=$O(^XMB(3.9,HLXMZ,2,HLI)) Q:HLI'>0 S ^TMP("HLS",$J,HLSDT,HLJ)=$G(^XMB(3.9,HLXMZ,2,HLI,0))
|
|
CS1 S HLTRIED=HLTRIED+1 K ^TMP("HLR",$J),HLSDATA D SEND,REC I HLTRIED'=HLTRIES G CS1:$D(HLDTOUT) G CS1:$E(X0)="N"
|
|
G EX:$D(HLDTOUT)
|
|
I $E(X0)="N" S HLAC=4,HLMSG="Lower Level Protocol Error - "_$S($E(X1)="X":"Checksum",1:"Character Count")_" Did Not Match" D STATUS^HLTF0(HLDA,HLAC,HLMSG) G EX
|
|
I $S('$D(HLL(1)):1,"BHS,MSH"'[$E(HLL(1),1,3):1,1:0) S HLAC=4,HLMSG="Application Level error - Header Segment Missing" D STATUS^HLTF0(HLDA,HLAC,HLMSG) G EX
|
|
K HLXMZ D CHK^HLCHK,IN^HLTF(HLMTN,HLMID,HLTIME)
|
|
EX K HLAC,HLDA,HLDA0,HLERR,HLMSG,HLI,HLJ,^TMP("HLS",$J),^TMP("HLR",$J),HLSDATA,HLSDT,HLTRIED Q
|
|
CSUM ;Calculate Checksum
|
|
S HLC1=HLC1+$L(X),X=X_HLC2 X HLLPC S HLC2=$C(Y) Q
|
|
REC ;Receive a Message
|
|
U IO D DT^DICRW
|
|
I HLTIME<% S HLTIME=%
|
|
E S HLTIME=$$FMADD^XLFDT(HLTIME,0,0,0,1)
|
|
K HLDTOUT,HLL,^TMP("HLR",$J) S HLC1=0,HLC2="",HLI=0
|
|
REC1 U IO(0) R X#245:DTIME S:'$T HLDTOUT=1 Q:$D(HLDTOUT) X HLTRM G REC1:Y'=11
|
|
U IO(0) R X0:DTIME S:'$T HLDTOUT=1 Q:$D(HLDTOUT) S X=$C(11)_X0_$C(13) D CSUM S:HLLOG HLI=HLI+1,^TMP("HL",HLION,HLTIME,"REC",HLI)=X0
|
|
U IO(0) F HLK=1:1 R X1#246:DTIME S:'$T HLDTOUT=1 Q:$D(HLDTOUT) X HLTRM D:HLLOG Q:Y=28 I $L(X1) S:HLK'>2 HLL(HLK)=X1 S ^TMP("HLR",$J,HLTIME,HLK)=X1,X=X1_$S($L(X1)<245:$C(13),1:"") D CSUM
|
|
.;Record Incoming Transmission in Log
|
|
.S HLII=X1 S:$P(X1,$E(X1,4))="MSH" $P(X1,$E(X1,4),8)=""
|
|
.S HLI=HLI+1,^TMP("HL",HLION,HLTIME,"REC",HLI)=X1,X1=HLII
|
|
Q:$D(HLDTOUT) S X=HLC2 X HLLPC S HLCSUM=Y,HLC=+$E(X1,($L(X1)-2),$L(X1)),HLB=+$E(X1,($L(X1)-7),($L(X1)-3)),HLERR=$S(HLCSUM'=HLC:"X",HLC1'=HLB:"C",1:1)
|
|
I HLLOG S ^TMP("HL",HLION,HLTIME,"REC","CKS")=HLCSUM_"/"_HLC_"^"_HLC1_"/"_HLB
|
|
U IO(0) R X2:DTIME S:'$T HLDTOUT=1
|
|
Q
|
|
SEND ;Send a Message
|
|
N X,Y S HLC1=0,HLC2=""
|
|
U IO(0) S X=$C(11)_"D21"_$C(13) W X D CSUM I HLLOG S ^TMP("HL",HLION,HLTIME,"SEND",0)="D21"
|
|
SENDN I '$D(HLSDT) U IO(0) S HLI="" F S HLI=$O(HLSDATA(HLI)) Q:HLI="" S X=HLSDATA(HLI)_$S('$D(HLERR):$C(13),1:"") W X D CSUM I HLLOG S ^TMP("HL",HLION,HLTIME,"SEND",HLI)=$S('$D(HLERR):HLSDATA(HLI),1:"N21 "_HLERR)
|
|
I $D(HLSDT) U IO(0) S HLI="" F S HLI=$O(^TMP("HLS",$J,HLSDT,HLI)) Q:HLI="" S HLSDATA=^(HLI),X=HLSDATA_$C(13) W X D CSUM I HLLOG S ^TMP("HL",HLION,HLTIME,"SEND",HLI)=HLSDATA
|
|
S X=HLC2 X HLLPC S X=$E("0000",1,(5-$L(HLC1)))_HLC1_$E("00",1,(3-$L(Y)))_Y_$C(28)_$C(13) U IO(0) W X I HLLOG S ^TMP("HL",HLION,HLTIME,"SEND","CKS")=$P(X,$C(28))
|
|
Q
|