source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUMFXHL7.m@ 660

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1XUMFXHL7 ;BPFO/JRP - IEMM UTILTIES (CONT);7/29/2002
2 ;;8.0;KERNEL;**299,407**;Jul 10, 1995;Build 8
3 ;
4 ;copied from SCMSVUT5
5 ;
6PARSE(INARR,OUTARR,SEP,SUB,MAX) ;Parse array into individual fields
7 ;Input : INARR - Array containing data to parse (full global ref)
8 ; INARR = First 245 characters of data
9 ; INARR(1..n) = Continuation nodes
10 ; OR
11 ; INARR(x) = First 245 characters of data
12 ; INARR(x,1..n) = Continuation nodes
13 ; OUTARR - Array to put parsed data into (full global ref)
14 ; SEP - Field separator (defaults to ^) (1 character)
15 ; SUB - Starting subscript of OUTARR (defaults to 0)
16 ; MAX - Maximum length of output node (defaults to 245)
17 ;Output : None
18 ; OUTARR(SUB) = First piece (MAX characters)
19 ; OUTARR(SUB,1..n) = Continuation nodes
20 ; OUTARR(SUB+X) = Xth piece (MAX characters)
21 ; OUTARR(SUB+X,1..n) = Continuation nodes
22 ;Notes : OUTARR is initialized (KILLed) on entry
23 ; : Assumes that INARR and OUTARR are defined and valid
24 ;
25 ;Declare variables
26 N NODE,STOP,DATA,INFO,FLD,SEPCNT,CN,OUT,TMP,ROOT,OUTNODE
27 K @OUTARR
28 S SEP=$G(SEP) S SEP=$E(SEP,1) S:SEP="" SEP="^"
29 S SUB=+$G(SUB)
30 S MAX=+$G(MAX) S:'MAX MAX=245
31 S NODE=INARR
32 S INFO=$G(@NODE)
33 S ROOT=$$OREF^DILF(INARR)
34 S FLD=1
35 S SEPCNT=$L(INFO,SEP)
36 S STOP=0
37 S OUTNODE=$NA(@OUTARR@(SUB))
38 S CN=0
39 F S DATA=$P(INFO,SEP,FLD) D Q:STOP
40 .I FLD=SEPCNT D Q
41 ..D ADDNODE
42 ..S NODE=$Q(@NODE)
43 ..I (NODE="")!(NODE'[ROOT) S STOP=1 Q
44 ..S INFO=$G(@NODE)
45 ..S SEPCNT=$L(INFO,SEP)
46 ..S FLD=1
47 .D ADDNODE
48 .S SUB=SUB+1
49 .S CN=0
50 .S OUTNODE=$NA(@OUTARR@(SUB))
51 .S FLD=FLD+1
52 Q
53ADDNODE ;Used by PARSE to add data to output node (handles continuation nodes)
54 S TMP=$G(@OUTNODE)
55 I ($L(TMP)+$L(DATA))<(MAX+1) S @OUTNODE=TMP_DATA Q
56 S @OUTNODE=TMP_$E(DATA,1,(MAX-$L(TMP)))
57 S CN=CN+1
58 S DATA=$E(DATA,(MAX-$L(TMP)+1),$L(DATA))
59 S OUTNODE=$NA(@OUTARR@(SUB,CN))
60 I DATA'="" D ADDNODE
61 Q
62 ;
63 ;
64SEGPRSE(SEGMENT,OUTARR,FS,LENGTH) ;Parse HL7 segment by field separator
65 ;Input : SEGMENT - Array containing HL7 segment to parse
66 ; (full global ref)
67 ; SEGMENT = First 245 characters of segment
68 ; SEGMENT(1..n) = Continuation nodes
69 ; OR
70 ; SEGMENT(x) = First 245 characters of segment
71 ; SEGMENT(x,1..n) = Continuation nodes
72 ; OUTARR - Array to put parsed segment into (full global ref)
73 ; FS - HL7 field separator (defaults to ^) (1 character)
74 ;Output : None
75 ; OUTARR(0) = Segment name
76 ; OUTARR(seq#) = Data (first 245 characters)
77 ; OUTARR(seq#,1..n) Continuation nodes
78 ;Notes : OUTARR is initialized (KILLed) on entry
79 ; : Assumes SEGMENT and OUTARR are defined and valid
80 ;
81 S LENGTH=$S($G(LENGTH):LENGTH,1:245)
82 ;
83 D PARSE($G(SEGMENT),$G(OUTARR),$G(FS),0,LENGTH)
84 Q
85 ;
86SEQPRSE(SEQDATA,OUTARR,ENCODE) ;Parse HL7 sequence by component
87 ;Input : SEQDATA - Array containing seq to parse (full global ref)
88 ; SEQDATA = First 245 characters of sequence
89 ; SEQDATA(1..n) = Continuation nodes
90 ; OR
91 ; SEQDATA(x) = First 245 characters of sequence
92 ; SEQDATA(x,1..n) = Continuation nodes
93 ; OUTARR - Array to put parsed sequence into (full global ref)
94 ; ENCODE - HL7 encoding characters (defaults to ~|\&) (4 chars)
95 ;Output : None
96 ; OUTARR(rep#,comp#) = Data (first 245 characters)
97 ; OUTARR(rep#,comp#,1..n) = Continuation nodes
98 ;Notes : OUTARR is initialized (KILLed) on entry
99 ; : Assumes SEQDATA and OUTARR are defined and valid
100 ;
101 ;Declare variables
102 N RS,CS,INFO,DATA,REP,COMP
103 S ENCODE=$G(ENCODE,"~|\&")
104 S ENCODE=$E(ENCODE,1,4) S:$L(ENCODE)'=4 ENCODE="~|\&"
105 S CS=$E(ENCODE,1)
106 S RS=$E(ENCODE,2)
107 S INFO=$NA(^TMP("XUMFXHL7",$J,"SEQPRSE"))
108 D PARSE($G(SEQDATA),INFO,RS,1,245)
109 S REP=0
110 F S REP=+$O(@INFO@(REP)) Q:'REP D PARSE($NA(@INFO@(REP)),$NA(@OUTARR@(REP)),CS,1,245)
111 K @INFO
112 Q
113
Note: See TracBrowser for help on using the repository browser.