source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VHLU3.m@ 1470

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

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1LA7VHLU3 ;DALOI/JMC - HL7 Segment Utility ;01/19/99 13:48
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
3 ;
4 Q
5 ;
6NTE(LA7TXT,LA7TYP,LA7FS,LA7ECH,LA7NTESN) ; Build NTE segment - notes and comments
7 ; Call with LA7TXT = text to send
8 ; LA7TYP = source of comment - HL table 0105
9 ; Default to L (ancilliary/filler)
10 ; LA7FS = HL field separator
11 ; LA7ECH = HL encoding characters
12 ; LA7NTESN = segment SET ID (pass by reference)
13 ;
14 ; Returns LA7Y - built segment
15 ;
16 N LA7Y
17 ;
18 S LA7FS=$G(LA7FS),LA7TXT=$G(LA7TXT)
19 ; Remove leading "~" from comments
20 I $E(LA7TXT,1)="~" S LA7TXT=$$TRIM^XLFSTR(LA7TXT,"L","~")
21 S LA7TXT=$$CHKDATA^LA7VHLU3(LA7TXT,LA7FS_LA7ECH)
22 ;
23 ; Update segment SET ID
24 S LA7NTESN=$G(LA7NTESN)+1
25 ;
26 ; Default source of comment if undefined
27 I $G(LA7TYP)="" S LA7TYP="L"
28 ;
29 S LA7Y="NTE"_LA7FS_LA7NTESN_LA7FS_LA7TYP_LA7FS_LA7TXT_LA7FS
30 ;
31 Q LA7Y
32 ;
33 ;
34CHKDATA(LA7IN,LA7CH) ; Check data to be built into an HL7 field for characters that
35 ; conflict with encoding characters. Convert conflicting character using HL7 escape encoding.
36 ;
37 ; Call with LA7IN = data to be checked
38 ; LA7CH = HL7 delimiters to check for
39 ;
40 ; Returns LA7OUT - checked data, converted if appropriate
41 ;
42 N J,LA7DLIM,LA7ESC,LA7LEN,LA7OUT,X
43 ;
44 S LA7IN=$G(LA7IN),LA7CH=$G(LA7CH)
45 S LA7OUT=""
46 ;
47 I LA7IN=""!(LA7CH="") Q LA7OUT
48 ;
49 ; Build array of encoding characters to check
50 S LA7LEN=$L(LA7CH)
51 S LA7DLIM=$S(LA7LEN=5:"FSRET",1:"SRET")
52 S LA7ESC=$E(LA7CH,LA7LEN-1)
53 F J=1:1:LA7LEN S LA7CH($E(LA7CH,J))=$E(LA7DLIM,J)
54 ;
55 ; Check each character and convert if appropiate
56 F J=1:1:$L(LA7IN) D
57 . S X=$E(LA7IN,J)
58 . I $D(LA7CH(X)) S X=$$ENESC(LA7CH(X),LA7ESC)
59 . S LA7OUT=LA7OUT_X
60 ;
61 Q LA7OUT
62 ;
63 ;
64CNVFLD(LA7IN,LA7ECH1,LA7ECH2) ; Convert an encoded HL7 segment/field from one encoding scheme to another
65 ; Call with LA7IN = data to be converted
66 ; LA7ECH1 = delimiters of input
67 ; LA7ECH2 = delimiters of output
68 ;
69 ; Returns LA7OUT - segment/field converted to new encoding scheme
70 ;
71 N J,LA7DLIM,LA7ECH,LA7ESC,LA7LEN,LA7OUT,X
72 ;
73 S LA7IN=$G(LA7IN),LA7ECH1=$G(LA7ECH1),LA7ECH2=$G(LA7ECH2)
74 S LA7OUT=""
75 ;
76 I LA7IN=""!(LA7ECH1="")!(LA7ECH2="") Q LA7OUT
77 ;
78 ; Abort if encoding schemes not equal length
79 I $L(LA7ECH1)'=$L(LA7ECH2) Q LA7OUT
80 ;
81 ; If same then return input as output
82 I LA7ECH1=LA7ECH2 Q LA7IN
83 ;
84 ; Determine position of HL7 ESCAPE encoding character
85 ; 4th position if field separator and encoding characters passed
86 ; 3rd position if only encoding characters passed
87 ; Based on length of input encoding character variable
88 S LA7LEN=$L(LA7ECH1)
89 S LA7DLIM=$S(LA7LEN=5:"FSRET",1:"SRET")
90 S LA7ESC=$E(LA7DLIM,LA7LEN-1)
91 ;
92 ; Build array to convert source encoding to target encoding
93 F J=1:1:$L(LA7ECH1) S LA7ECH($E(LA7ECH1,J))=$E(LA7ECH2,J)
94 ;
95 ; Check each character and convert if appropiate
96 ; If source conflicts with target encoding character
97 ; then convert to escape encoding
98 ; If match on source encoding character - convert to new encoding
99 F J=1:1:$L(LA7IN) D
100 . S X=$E(LA7IN,J)
101 . I '$D(LA7ECH(X)),LA7ECH2[X S X=$$ENESC($E(LA7DLIM,($F(LA7ECH2,X)-1)),LA7ESC)
102 . I $D(LA7ECH(X)) S X=LA7ECH(X)
103 . S LA7OUT=LA7OUT_X
104 ;
105 Q LA7OUT
106 ;
107 ;
108ENESC(LA7X,LA7ESC) ; Encode data using HL7 escape encoding
109 ; Call with LA7X = character to encode
110 ; LA7ESC = HL7 escape encoding character
111 ;
112 ; Returns string of escape encoded data.
113 ;
114 N LA7Y
115 ;
116 S LA7Y=""
117 S LA7Y=LA7ESC_LA7X_LA7ESC
118 ;
119 Q LA7Y
120 ;
121 ;
122UNESC(LA7X,LA7CH) ; Unescape data using HL7 escape encoding
123 ; Call with LA7X = string to decode
124 ; LA7CH = HL7 delimiters (both field separator & encoding characters)
125 ;
126 ; Returns string of unencoded data.
127 ;
128 N J,LA7ESC,LA7DLIM,LA7LEN
129 ;
130 ; If data does not contain escape encoding then return input string as output
131 S LA7LEN=$L(LA7CH),LA7ESC=$E(LA7CH,LA7LEN-1)
132 I LA7X'[LA7ESC Q LA7X
133 ;
134 ; Build array of encoding characters to replace
135 S LA7DLIM=$S(LA7LEN=5:"FSRET",1:"SRET")
136 F J=1:1:LA7LEN S LA7CH(LA7ESC_$E(LA7DLIM,J)_LA7ESC)=$E(LA7CH,J)
137 ;
138 Q $$REPLACE^XLFSTR(LA7X,.LA7CH)
139 ;
140 ;
141UNESCFT(LA7X,LA7CH,LA7Y) ; Unescape formatted text data using HL7 escape encoding
142 ; Call with LA7X = array to decode (pass by reference)
143 ; LA7CH = HL7 delimiters (both field separator & encoding characters)
144 ;
145 ; Returns LA7Y = array of unencoded data.
146 ;
147 N J,K,LA7ESC,LA7I,LA7Z,SAVX,SAVY,Z
148 ;
149 S J=0,LA7ESC=$E(LA7CH,$L(LA7CH)-1),(LA7I,SAVX,SAVY)=""
150 F S LA7I=$O(LA7X(LA7I)) Q:LA7I="" D
151 . S J=J+1
152 . I LA7X(LA7I)'[LA7ESC,SAVY="" S LA7Y(J,0)=LA7X(LA7I) Q
153 . F K=1:1:$L(LA7X(LA7I)) D
154 . . S Z=$E(LA7X(LA7I),K)
155 . . I Z=LA7ESC D Q
156 . . . I SAVY="" S SAVY=Z Q
157 . . . S SAVY=SAVY_Z
158 . . . I $P(SAVY,LA7ESC,2)=".br" S LA7Y(J,0)=$S(SAVX]"":SAVX,1:" "),SAVX="",J=J+1
159 . . . I $E(SAVY,2)'="." S SAVX=SAVX_$$UNESC(SAVY,LA7CH)
160 . . . S SAVY=""
161 . . I SAVY]"" S SAVY=SAVY_Z Q
162 . . S SAVX=SAVX_Z
163 . S LA7Y(J,0)=SAVX,SAVX=""
164 S LA7Y=J
165 ;
166 Q
Note: See TracBrowser for help on using the repository browser.