source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSDR2.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: 5.2 KB
Line 
1HLCSDR2 ;ALB/RJS - HYBRID LOWER LAYER PROTOCOL UTILITIES 2.2 - ;08/22/2001 11:23
2 ;;1.6;HEALTH LEVEL SEVEN;**2,9,62,109**;Oct 13, 1995
3 Q
4WRITE(HLDOUT0,HLDOUT1) ; This function writes a message from the Logical
5 ; Link file (#870) to the specified device in the following format:
6 ; <Start Block><Data Block><End Block>
7 ; The data block is the complete HL7 message terminated by a <CR>.
8 ; INPUT : HLDOUT0 - IFN of file 870
9 ; HLDOUT1 - IFN of Out Queue Multiple
10 ; OUTPUT: None
11 I HLDOUT0']""!(HLDOUT1']"") Q
12 ;-- HLLINE,HLC1,HLC2 are initialized in INITIZE
13 N HLCLN,HLCHK,I,X
14 D INITIZE
15 ;
16 ;-- write start block
17 S X=$C(HLDSTRT)_"D"_HLDVER_$C(13) D CHKSUM
18 U IO W X
19 ;
20 S HLWFLG=0
21 ;-- process and write data block
22 F S HLLINE=$$NEXTLINE^HLCSUTL(HLDOUT0,HLDOUT1,HLLINE,"HLCLN","OUT") Q:'HLLINE D
23 . S HLCHK=$$CHKSUM^HLCSUTL("HLCLN")
24 . S HLC2=HLC2_$C($P(HLCHK,U)),HLC1=HLC1+$P(HLCHK,U,2)
25 . I $E(HLCLN(1),1,3)="MSA" S HLWFLG=1
26 . ;U IO
27 . S I=0 F S I=$O(HLCLN(I)) Q:'I W $G(HLCLN(I))
28 . K HLCLN,HLCHK
29 ;
30 D CHKSUM1
31 ;-- store checksum values
32 D MONITOR(HLC1,4,HLDP,HLDOUT1,"OUT"),MONITOR(HLC2,5,HLDP,HLDOUT1,"OUT")
33 ;
34 S HLC1=$$RJ(HLC1,5)
35 S HLC2=$$RJ(HLC2,3)
36 ;
37 ;-- write end block
38 S X=HLC1_HLC2_$C(HLDEND)_$C(13)
39 U IO W X
40 Q
41SETNODE(HLD0,HLD1,CR) ;
42 S HLLINE=HLLINE+1,^HLCS(870,HLD0,1,HLD1,1,HLLINE,0)=$G(X)
43 I CR="CR" S HLLINE=HLLINE+1,^HLCS(870,HLD0,1,HLD1,1,HLLINE,0)=""
44 Q
45SETNODE2 ;
46 S HLLINE=HLLINE+1,^TMP("HLCSDR1",$J,HLDP,HLLINE)=$G(X)
47 Q
48TRANS(HLTOUT,HLTRANS) ; This function returns the state of the read operation.
49 ; INPUT : HLTOUT - Data returned from read (Will contain TIMEOUT)
50 ; HLTRANS - Variable passed by reference containing how
51 ; the read was terminated.
52 ; OUTPUT: HLTRANS - Translation of read termination.
53 S HLTRANS=$S($G(HLTOUT)["TIMEOUT":"TIMEOUT",HLTRANS=0:"LONGLINE",HLTRANS=1:"SOH",HLTRANS=4:"EOT",HLTRANS=HLDSTRT:"VT",HLTRANS=13:"CR",HLTRANS=HLDEND:"FS",1:"OTHER")
54 I $D(HLTRACE) U IO(0) W !,"HLTRANS=",HLTRANS
55 Q
56INITIZE ;Initialize Line counter and Checksum variables
57 S (HLLINE,HLC1)=0,HLC2=""
58 Q
59NAK(HLTRANS) ; Send NAK
60 N HLDATA
61 D INITIZE
62 ;-- start block and data
63 S (X,HLDATA)=$C(HLDSTRT)_"N"_HLDVER_$C(13)_HLTRANS
64 D CHKSUM,CHKSUM1
65 S HLC1=$$RJ(HLC1,5)
66 S HLC2=$$RJ(HLC2,3)
67 ;-- end block
68 S X=HLDATA_HLC1_HLC2_$C(HLDEND)_$C(13)
69 U IO W X
70 Q
71ACK ; Send ACK
72 N HLDATA
73 D INITIZE
74 ;-- start block and data
75 S (X,HLDATA)=$C(HLDSTRT)_"D"_HLDVER_$C(13)
76 D CHKSUM,CHKSUM1
77 S HLC1=$$RJ(HLC1,5)
78 S HLC2=$$RJ(HLC2,3)
79 ;-- end block
80 S X=HLDATA_HLC1_HLC2_$C(HLDEND)_$C(13)
81 U IO W X
82 Q
83DUMP ;
84 Q:'$D(HLTRACE)
85 U IO(0)
86 W !,"DUMP"
87 I '$D(HLC1) S HLC1=-1
88 I '$D(HLC2) S HLC2=-1
89 I '$D(HLBLOCK) S HLBLOCK=-1
90 I '$D(HLXOR) S HLXOR=-1
91 W !,"HLC1=",HLC1," ","HLBLOCK=",HLBLOCK
92 W !,"HLC2=",HLC2," ","HLXOR=",HLXOR
93 Q
94CHKSUM ;
95 X ^%ZOSF("LPC") S HLC1=HLC1+$L(X),HLC2=HLC2_$C(Y)
96 I $L(HLC2)>240 D CHKSUM1
97 Q
98CHKSUM1 ;
99 S X=HLC2 X ^%ZOSF("LPC") S HLC2=Y
100 Q
101VALID1(FLAG,CHK,HLIND0,HLIND1) ;
102 ;This function extracts the checksum sent with a message and then
103 ;compares it to the checksums that have been calculated and stored
104 ;in the HLC1 and HLC2 variables. HLC1 and HLC2 are not passed as
105 ;parameters, their scope is "communication server-wide"
106 ;FLAG tells the function what type of message this is, should the
107 ;last block of data be written to an "in queue" ? or a TMP variable ?
108 ;this depends on whether the incoming message is a message or just
109 ;a lower level acknowledgement "LLP-ACK"
110 ;CHK contains the 8 character cheksum that was sent with the message
111 ;HLIND0,HLIND1 are just D0 and D1 for the "input queue" in file #870
112 N HLBLOCK,HLXOR
113 ;WRITE LAST BLOCK 'O DATA TO GLOBAL
114 I $G(X)'="",FLAG="INCOMING MESSAGE" D SETNODE(HLIND0,HLIND1,HLTRANS),CHKSUM
115 I $G(X)'="",FLAG="LLP-ACK" D SETNODE2,CHKSUM
116 ;Extract checksums
117 S HLBLOCK=+$E(CHK,1,5),HLXOR=+$E(CHK,6,8)
118 D CHKSUM1,DUMP
119 S X="$$CHK$$^"_CHK_"^HLCHK^"_$$RJ(HLC1,5)_$$RJ(HLC2,3)
120 I FLAG="INCOMING MESSAGE" D MONITOR(HLBLOCK,5,HLDP,HLIND1,"IN"),MONITOR(HLXOR,6,HLDP,HLIND1,"IN"),MONITOR(HLC1,7,HLDP,HLIND1,"IN"),MONITOR(HLC2,8,HLDP,HLIND1,"IN")
121 I FLAG="LLP-ACK" D SETNODE2
122 I HLXOR="999" Q "VALID"
123 I HLBLOCK=HLC1,HLC2=HLXOR Q "VALID"
124 I HLBLOCK'=HLC1 Q "C"
125 I HLXOR'=HLC2 Q "X"
126 Q "G"
127TRACE ;When HLTRACE is instantiated this subroutine simply writes out the
128 ;states that the finite state machine (Lower Layer Protocol) goes thru
129 Q:'$D(HLTRACE)
130 U IO(0) W !,"IN STATE ",HLNXST
131 Q
132MONITOR(VALUE,PIECE,HLD0,HLD1,QUEUE) ;
133 ;This subroutine simply updates a particular piece in a global node
134 ;in file #870. It can be a zero node, or a node in a queue multiple
135 I '$D(^HLCS(870,HLD0,0)) Q
136 I $G(HLD1)']"" S $P(^HLCS(870,HLD0,0),U,PIECE)=VALUE Q
137 I PIECE=2,$G(QUEUE)="IN" D Q
138 . N HLJ
139 . S HLJ(870.019,HLD1_","_HLD0_",",1)=VALUE
140 . D FILE^HLDIE("","HLJ","","MONITOR","HLCSDR2") ; HL*1.6*109
141 S $P(^HLCS(870,HLD0,$S(QUEUE="IN":1,1:2),HLD1,0),U,PIECE)=VALUE
142 Q
143FORMAT(HLC,LENGTH) ;Function to stuff leading zeroes for checksums
144 ;HLC is the checksum, Length is self-documenting
145 Q $E("00000",1,LENGTH-$L(HLC))
146RJ(HLC,LENGTH) ;Function to stuff leading zeroes for checksums
147 ;HLC is the checksum, Length is self-documenting
148 ;Functionally equivalent to $$RJ^XLFSTR(HLC,LENGTH,"0")
149 ;Also equivalent to $$FORMAT(HLC,LENGTH)_HLC
150 Q $E("00000",1,LENGTH-$L(HLC))_HLC
Note: See TracBrowser for help on using the repository browser.