source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLLP.m@ 1427

Last change on this file since 1427 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1HLLP ;AISC/SAW-HL7 Hybrid Lower Level Protocol Receiver/Sender ;9/5/96 10:50
2 ;;1.6;HEALTH LEVEL SEVEN;**1,12,29**;Oct 13, 1995
3 ;This routine is used for the Version 1.5 Interface Only
4INIT ;Initialize Variables
5 S X="ERR^HLLP" S @^%ZOSF("TRAP") I $D(HLION) S IOP=HLION D ^%ZIS G EXIT:POP
6 I '$D(HLION) D HOME^%ZIS G EXIT:POP S HLION=$S(ION']"":"UNKNOWN",1:ION)
7 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")
8 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
9 I $D(^%ZOSF("OS")),^%ZOSF("OS")["VAX" U IO(0):PACK X ^%ZOSF("EOFF")
10 E U IO(0) X ^%ZOSF("EOFF")
11 S HLLPC=^%ZOSF("LPC"),X=255,HLTRM=^%ZOSF("TRMRD") X ^%ZOSF("RM") X ^%ZOSF("TRMON")
12LOOP ;Infinite loop to check for HL7 messages to send/receive
13 F S HLLOG=$S($D(^HL(770,"ALOG",HLION)):1,1:0) D CHKREC,CHKSEND I $$S^%ZTLOAD S ZTSTOP=1 Q
14EXIT Q
15ERR ;Trap error
16 K HLL(1),^TMP("HLR",$J),^TMP("HLS",$J) D @^%ZOSF("ERRTN"),^%ZISC Q
17CHKREC ;Check if there are HL7 messages to receive
18 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
19 I '$D(HLDTOUT) U IO K HLERR D ^HLCHK
20 U IO Q
21CHKSEND ;Check if there are HL7 messages to send
22 Q:'$D(HLNDAP)
23 I '$D(HLNDAP0) S HLNDAP0=$G(^HL(770,HLNDAP,0))
24 S HLDA=+$O(^HL(772,"AC","O",+$P(HLNDAP0,U,12),0)) G:'HLDA EX
25 S HLDA0=$G(^HL(772,HLDA,0)) G:HLDA0']"" EX
26 S HLXMZ=+$P(HLDA0,"^",5)
27 I 'HLXMZ D G EX
28 .D STATUS^HLTF0(HLDA,4,"","No pointer to Message file(#3.9)")
29 I '$D(^XMB(3.9,HLXMZ)) D G EX
30 .D STATUS^HLTF0(HLDA,4,"","No message found at #"_HLXMZ_" in Message file(#3.9)")
31 I '$O(^XMB(3.9,HLXMZ,2,0)) D G EX
32 .D STATUS^HLTF0(HLDA,4,"","No message contents at #"_HLXMZ_" in Message file(#3.9)")
33 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))
34CS1 S HLTRIED=HLTRIED+1 K ^TMP("HLR",$J),HLSDATA D SEND,REC I HLTRIED'=HLTRIES G CS1:$D(HLDTOUT) G CS1:$E(X0)="N"
35 G EX:$D(HLDTOUT)
36 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
37 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
38 K HLXMZ D CHK^HLCHK,IN^HLTF(HLMTN,HLMID,HLTIME)
39EX K HLAC,HLDA,HLDA0,HLERR,HLMSG,HLI,HLJ,^TMP("HLS",$J),^TMP("HLR",$J),HLSDATA,HLSDT,HLTRIED Q
40CSUM ;Calculate Checksum
41 S HLC1=HLC1+$L(X),X=X_HLC2 X HLLPC S HLC2=$C(Y) Q
42REC ;Receive a Message
43 U IO D DT^DICRW
44 I HLTIME<% S HLTIME=%
45 E S HLTIME=$$FMADD^XLFDT(HLTIME,0,0,0,1)
46 K HLDTOUT,HLL,^TMP("HLR",$J) S HLC1=0,HLC2="",HLI=0
47REC1 U IO(0) R X#245:DTIME S:'$T HLDTOUT=1 Q:$D(HLDTOUT) X HLTRM G REC1:Y'=11
48 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
49 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
50 .;Record Incoming Transmission in Log
51 .S HLII=X1 S:$P(X1,$E(X1,4))="MSH" $P(X1,$E(X1,4),8)=""
52 .S HLI=HLI+1,^TMP("HL",HLION,HLTIME,"REC",HLI)=X1,X1=HLII
53 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)
54 I HLLOG S ^TMP("HL",HLION,HLTIME,"REC","CKS")=HLCSUM_"/"_HLC_"^"_HLC1_"/"_HLB
55 U IO(0) R X2:DTIME S:'$T HLDTOUT=1
56 Q
57SEND ;Send a Message
58 N X,Y S HLC1=0,HLC2=""
59 U IO(0) S X=$C(11)_"D21"_$C(13) W X D CSUM I HLLOG S ^TMP("HL",HLION,HLTIME,"SEND",0)="D21"
60SENDN 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)
61 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
62 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))
63 Q
Note: See TracBrowser for help on using the repository browser.