source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORBIN.m@ 699

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

initial load of WorldVistAEHR

File size: 6.0 KB
Line 
1RORBIN ;HCIOFO/SG - BINARY OPERATIONS ; 1/23/06 1:54pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** BINARY "AND" OPERATION
7 ;
8 ; V1 Operands formatted as strings of "1" and "0"
9 ; V2
10 ;
11AND(V1,V2) ;
12 N I,L1,L2,N,RES
13 S L1=$L(V1),L2=$L(V2),RES=""
14 I L1<L2 S N=L1,V2=$E(V2,L2-L1+1,L2)
15 E S N=L2,V1=$E(V1,L1-L2+1,L1)
16 F I=1:1:N S RES=RES_$S($E(V1,I)&$E(V2,I):"1",1:"0")
17 Q RES
18 ;
19 ;***** FAST CONVERSIONS FROM HEXADECIMAL TO BINARY
20 ;
21 ; VAL Hexadecimal value
22 ;
23C16TO2(VAL) ;
24 N I,J,L,RES
25 S L=$L(VAL),RES=""
26 F I=1:1:L D
27 . S J=$F("0123456789ABCDEF",$E(VAL,I))-1
28 . S RES=RES_$P("0000^0001^0010^0011^0100^0101^0110^0111^1000^1001^1010^1011^1100^1101^1110^1111","^",J)
29 Q RES
30 ;
31 ;***** CALCULATES CRC-32 FOR PROVIDED DATA
32 ;
33 ; ROR8NODE Closed root of an array that contains the data
34 ;
35CRC32(ROR8NODE) ;
36 N TMPCRC S TMPCRC=$$C16TO2("FFFFFFFF")
37 F S ROR8NODE=$Q(@ROR8NODE) Q:ROR8NODE="" D
38 . S TMPCRC=$$UPDCRC32(TMPCRC,@ROR8NODE)
39 S TMPCRC=$$BASE^XLFUTL($$NOT(TMPCRC),2,16)
40 Q $TR($J(TMPCRC,8)," ","0")
41 ;
42 ;***** BINARY "NOT" OPERATION
43 ;
44 ; V1 Operand formatted as string of "1" and "0"
45 ;
46NOT(VAL) ;
47 Q $TR(VAL,"01","10")
48 ;
49 ;***** BINARY "OR" OPERATION
50 ;
51 ; V1 Operands formatted as strings of "1" and "0"
52 ; V2
53 ;
54OR(V1,V2) ;
55 N I,L1,L2,N,RES,TMP
56 S L1=$L(V1),L2=$L(V2)
57 I L1<L2 S N=L1,RES=$E(V2,1,L2-L1),V2=$E(V2,L2-L1+1,L2)
58 E S N=L2,RES=$E(V1,1,L1-L2),V1=$E(V1,L1-L2+1,L1)
59 F I=1:1:N S RES=RES_$S($E(V1,I)!$E(V2,I):"1",1:"0")
60 Q RES
61 ;
62 ;***** RIGHT SHIFT (SIGNED OF UNSIGNED)
63 ;
64 ; V1 Operands formatted as strings of "1" and "0"
65 ; V2
66 ;
67 ; N Number of bits to shift by
68 ;
69 ; SIGN If this parameter defined and greater than 0, then
70 ; "signed" shift is performed (sign bit is propagated).
71 ; Parameter value defines the maximum number of bits
72 ; allowed for the values.
73 ;
74 ; By default ($G(SIGN)'>0), "unsigned" shift is
75 ; performed.
76 ;
77SHR(VAL,N,SIGN) ;
78 N FILL,L,RES,SIZE
79 S L=$L(VAL)
80 Q:$G(SIGN)'>0 $S(N<L:$E(VAL,1,L-N),1:"0")
81 S SIZE=+SIGN
82 ;---
83 S:L>SIZE VAL=$E(VAL,L-SIZE+1,L),L=SIZE
84 S SIGN=$S(L<SIZE:0,1:$E(VAL,1))
85 S:N>SIZE N=SIZE
86 S:SIGN $P(FILL,"1",N+1)=""
87 Q $E($G(FILL)_$S(N<L:$E(VAL,1,L-N),1:"0"),1,SIZE)
88 ;
89 ;***** INTERNAL ENTRY POINT FOR CRC-32 CALCULATION
90UPDCRC32(CRC32,STR) ;
91 N FFFFFF,I,I32,L
92 S L=$L(STR),FFFFFF=$$C16TO2("FFFFFF")
93 F I=1:1:L D
94 . S I32=$$XOR(CRC32,$$CNV^XLFUTL($A(STR,I),2))
95 . S I32=$$DEC^XLFUTL(I32,2)#256+1
96 . S TMP=$$C16TO2($P($T(TBL+I32),";;",2))
97 . S CRC32=$$XOR($$AND($$SHR(CRC32,8,32),FFFFFF),TMP)
98 Q CRC32
99 ;
100 ;***** BINARY "EXCLUSIVE OR" OPERATION
101 ;
102 ; V1 Operands formatted as strings of "1" and "0"
103 ; V2
104 ;
105XOR(V1,V2) ;
106 N I,L1,L2,N,RES,TMP
107 S L1=$L(V1),L2=$L(V2)
108 I L1<L2 S N=L1,RES=$E(V2,1,L2-L1),V2=$E(V2,L2-L1+1,L2)
109 E S N=L2,RES=$E(V1,1,L1-L2),V1=$E(V1,L1-L2+1,L1)
110 F I=1:1:N S RES=RES_$S($E(V1,I)+$E(V2,I)=1:"1",1:"0")
111 Q RES
112 ;
113 ;***** TABLE FOR CRC-32 CALCULATION
114TBL ;
115 ;;00000000
116 ;;77073096
117 ;;EE0E612C
118 ;;990951BA
119 ;;076DC419
120 ;;706AF48F
121 ;;E963A535
122 ;;9E6495A3
123 ;;0EDB8832
124 ;;79DCB8A4
125 ;;E0D5E91E
126 ;;97D2D988
127 ;;09B64C2B
128 ;;7EB17CBD
129 ;;E7B82D07
130 ;;90BF1D91
131 ;;1DB71064
132 ;;6AB020F2
133 ;;F3B97148
134 ;;84BE41DE
135 ;;1ADAD47D
136 ;;6DDDE4EB
137 ;;F4D4B551
138 ;;83D385C7
139 ;;136C9856
140 ;;646BA8C0
141 ;;FD62F97A
142 ;;8A65C9EC
143 ;;14015C4F
144 ;;63066CD9
145 ;;FA0F3D63
146 ;;8D080DF5
147 ;;3B6E20C8
148 ;;4C69105E
149 ;;D56041E4
150 ;;A2677172
151 ;;3C03E4D1
152 ;;4B04D447
153 ;;D20D85FD
154 ;;A50AB56B
155 ;;35B5A8FA
156 ;;42B2986C
157 ;;DBBBC9D6
158 ;;ACBCF940
159 ;;32D86CE3
160 ;;45DF5C75
161 ;;DCD60DCF
162 ;;ABD13D59
163 ;;26D930AC
164 ;;51DE003A
165 ;;C8D75180
166 ;;BFD06116
167 ;;21B4F4B5
168 ;;56B3C423
169 ;;CFBA9599
170 ;;B8BDA50F
171 ;;2802B89E
172 ;;5F058808
173 ;;C60CD9B2
174 ;;B10BE924
175 ;;2F6F7C87
176 ;;58684C11
177 ;;C1611DAB
178 ;;B6662D3D
179 ;;76DC4190
180 ;;01DB7106
181 ;;98D220BC
182 ;;EFD5102A
183 ;;71B18589
184 ;;06B6B51F
185 ;;9FBFE4A5
186 ;;E8B8D433
187 ;;7807C9A2
188 ;;0F00F934
189 ;;9609A88E
190 ;;E10E9818
191 ;;7F6A0DBB
192 ;;086D3D2D
193 ;;91646C97
194 ;;E6635C01
195 ;;6B6B51F4
196 ;;1C6C6162
197 ;;856530D8
198 ;;F262004E
199 ;;6C0695ED
200 ;;1B01A57B
201 ;;8208F4C1
202 ;;F50FC457
203 ;;65B0D9C6
204 ;;12B7E950
205 ;;8BBEB8EA
206 ;;FCB9887C
207 ;;62DD1DDF
208 ;;15DA2D49
209 ;;8CD37CF3
210 ;;FBD44C65
211 ;;4DB26158
212 ;;3AB551CE
213 ;;A3BC0074
214 ;;D4BB30E2
215 ;;4ADFA541
216 ;;3DD895D7
217 ;;A4D1C46D
218 ;;D3D6F4FB
219 ;;4369E96A
220 ;;346ED9FC
221 ;;AD678846
222 ;;DA60B8D0
223 ;;44042D73
224 ;;33031DE5
225 ;;AA0A4C5F
226 ;;DD0D7CC9
227 ;;5005713C
228 ;;270241AA
229 ;;BE0B1010
230 ;;C90C2086
231 ;;5768B525
232 ;;206F85B3
233 ;;B966D409
234 ;;CE61E49F
235 ;;5EDEF90E
236 ;;29D9C998
237 ;;B0D09822
238 ;;C7D7A8B4
239 ;;59B33D17
240 ;;2EB40D81
241 ;;B7BD5C3B
242 ;;C0BA6CAD
243 ;;EDB88320
244 ;;9ABFB3B6
245 ;;03B6E20C
246 ;;74B1D29A
247 ;;EAD54739
248 ;;9DD277AF
249 ;;04DB2615
250 ;;73DC1683
251 ;;E3630B12
252 ;;94643B84
253 ;;0D6D6A3E
254 ;;7A6A5AA8
255 ;;E40ECF0B
256 ;;9309FF9D
257 ;;0A00AE27
258 ;;7D079EB1
259 ;;F00F9344
260 ;;8708A3D2
261 ;;1E01F268
262 ;;6906C2FE
263 ;;F762575D
264 ;;806567CB
265 ;;196C3671
266 ;;6E6B06E7
267 ;;FED41B76
268 ;;89D32BE0
269 ;;10DA7A5A
270 ;;67DD4ACC
271 ;;F9B9DF6F
272 ;;8EBEEFF9
273 ;;17B7BE43
274 ;;60B08ED5
275 ;;D6D6A3E8
276 ;;A1D1937E
277 ;;38D8C2C4
278 ;;4FDFF252
279 ;;D1BB67F1
280 ;;A6BC5767
281 ;;3FB506DD
282 ;;48B2364B
283 ;;D80D2BDA
284 ;;AF0A1B4C
285 ;;36034AF6
286 ;;41047A60
287 ;;DF60EFC3
288 ;;A867DF55
289 ;;316E8EEF
290 ;;4669BE79
291 ;;CB61B38C
292 ;;BC66831A
293 ;;256FD2A0
294 ;;5268E236
295 ;;CC0C7795
296 ;;BB0B4703
297 ;;220216B9
298 ;;5505262F
299 ;;C5BA3BBE
300 ;;B2BD0B28
301 ;;2BB45A92
302 ;;5CB36A04
303 ;;C2D7FFA7
304 ;;B5D0CF31
305 ;;2CD99E8B
306 ;;5BDEAE1D
307 ;;9B64C2B0
308 ;;EC63F226
309 ;;756AA39C
310 ;;026D930A
311 ;;9C0906A9
312 ;;EB0E363F
313 ;;72076785
314 ;;05005713
315 ;;95BF4A82
316 ;;E2B87A14
317 ;;7BB12BAE
318 ;;0CB61B38
319 ;;92D28E9B
320 ;;E5D5BE0D
321 ;;7CDCEFB7
322 ;;0BDBDF21
323 ;;86D3D2D4
324 ;;F1D4E242
325 ;;68DDB3F8
326 ;;1FDA836E
327 ;;81BE16CD
328 ;;F6B9265B
329 ;;6FB077E1
330 ;;18B74777
331 ;;88085AE6
332 ;;FF0F6A70
333 ;;66063BCA
334 ;;11010B5C
335 ;;8F659EFF
336 ;;F862AE69
337 ;;616BFFD3
338 ;;166CCF45
339 ;;A00AE278
340 ;;D70DD2EE
341 ;;4E048354
342 ;;3903B3C2
343 ;;A7672661
344 ;;D06016F7
345 ;;4969474D
346 ;;3E6E77DB
347 ;;AED16A4A
348 ;;D9D65ADC
349 ;;40DF0B66
350 ;;37D83BF0
351 ;;A9BCAE53
352 ;;DEBB9EC5
353 ;;47B2CF7F
354 ;;30B5FFE9
355 ;;BDBDF21C
356 ;;CABAC28A
357 ;;53B39330
358 ;;24B4A3A6
359 ;;BAD03605
360 ;;CDD70693
361 ;;54DE5729
362 ;;23D967BF
363 ;;B3667A2E
364 ;;C4614AB8
365 ;;5D681B02
366 ;;2A6F2B94
367 ;;B40BBE37
368 ;;C30C8EA1
369 ;;5A05DF1B
370 ;;2D02EF8D
Note: See TracBrowser for help on using the repository browser.