XUMFXHL7 ;BPFO/JRP - IEMM UTILTIES (CONT);7/29/2002
;;8.0;KERNEL;**299,407**;Jul 10, 1995;Build 8
;
;copied from SCMSVUT5
;
PARSE(INARR,OUTARR,SEP,SUB,MAX) ;Parse array into individual fields
;Input : INARR - Array containing data to parse (full global ref)
; INARR = First 245 characters of data
; INARR(1..n) = Continuation nodes
; OR
; INARR(x) = First 245 characters of data
; INARR(x,1..n) = Continuation nodes
; OUTARR - Array to put parsed data into (full global ref)
; SEP - Field separator (defaults to ^) (1 character)
; SUB - Starting subscript of OUTARR (defaults to 0)
; MAX - Maximum length of output node (defaults to 245)
;Output : None
; OUTARR(SUB) = First piece (MAX characters)
; OUTARR(SUB,1..n) = Continuation nodes
; OUTARR(SUB+X) = Xth piece (MAX characters)
; OUTARR(SUB+X,1..n) = Continuation nodes
;Notes : OUTARR is initialized (KILLed) on entry
; : Assumes that INARR and OUTARR are defined and valid
;
;Declare variables
N NODE,STOP,DATA,INFO,FLD,SEPCNT,CN,OUT,TMP,ROOT,OUTNODE
K @OUTARR
S SEP=$G(SEP) S SEP=$E(SEP,1) S:SEP="" SEP="^"
S SUB=+$G(SUB)
S MAX=+$G(MAX) S:'MAX MAX=245
S NODE=INARR
S INFO=$G(@NODE)
S ROOT=$$OREF^DILF(INARR)
S FLD=1
S SEPCNT=$L(INFO,SEP)
S STOP=0
S OUTNODE=$NA(@OUTARR@(SUB))
S CN=0
F S DATA=$P(INFO,SEP,FLD) D Q:STOP
.I FLD=SEPCNT D Q
..D ADDNODE
..S NODE=$Q(@NODE)
..I (NODE="")!(NODE'[ROOT) S STOP=1 Q
..S INFO=$G(@NODE)
..S SEPCNT=$L(INFO,SEP)
..S FLD=1
.D ADDNODE
.S SUB=SUB+1
.S CN=0
.S OUTNODE=$NA(@OUTARR@(SUB))
.S FLD=FLD+1
Q
ADDNODE ;Used by PARSE to add data to output node (handles continuation nodes)
S TMP=$G(@OUTNODE)
I ($L(TMP)+$L(DATA))<(MAX+1) S @OUTNODE=TMP_DATA Q
S @OUTNODE=TMP_$E(DATA,1,(MAX-$L(TMP)))
S CN=CN+1
S DATA=$E(DATA,(MAX-$L(TMP)+1),$L(DATA))
S OUTNODE=$NA(@OUTARR@(SUB,CN))
I DATA'="" D ADDNODE
Q
;
;
SEGPRSE(SEGMENT,OUTARR,FS,LENGTH) ;Parse HL7 segment by field separator
;Input : SEGMENT - Array containing HL7 segment to parse
; (full global ref)
; SEGMENT = First 245 characters of segment
; SEGMENT(1..n) = Continuation nodes
; OR
; SEGMENT(x) = First 245 characters of segment
; SEGMENT(x,1..n) = Continuation nodes
; OUTARR - Array to put parsed segment into (full global ref)
; FS - HL7 field separator (defaults to ^) (1 character)
;Output : None
; OUTARR(0) = Segment name
; OUTARR(seq#) = Data (first 245 characters)
; OUTARR(seq#,1..n) Continuation nodes
;Notes : OUTARR is initialized (KILLed) on entry
; : Assumes SEGMENT and OUTARR are defined and valid
;
S LENGTH=$S($G(LENGTH):LENGTH,1:245)
;
D PARSE($G(SEGMENT),$G(OUTARR),$G(FS),0,LENGTH)
Q
;
SEQPRSE(SEQDATA,OUTARR,ENCODE) ;Parse HL7 sequence by component
;Input : SEQDATA - Array containing seq to parse (full global ref)
; SEQDATA = First 245 characters of sequence
; SEQDATA(1..n) = Continuation nodes
; OR
; SEQDATA(x) = First 245 characters of sequence
; SEQDATA(x,1..n) = Continuation nodes
; OUTARR - Array to put parsed sequence into (full global ref)
; ENCODE - HL7 encoding characters (defaults to ~|\&) (4 chars)
;Output : None
; OUTARR(rep#,comp#) = Data (first 245 characters)
; OUTARR(rep#,comp#,1..n) = Continuation nodes
;Notes : OUTARR is initialized (KILLed) on entry
; : Assumes SEQDATA and OUTARR are defined and valid
;
;Declare variables
N RS,CS,INFO,DATA,REP,COMP
S ENCODE=$G(ENCODE,"~|\&")
S ENCODE=$E(ENCODE,1,4) S:$L(ENCODE)'=4 ENCODE="~|\&"
S CS=$E(ENCODE,1)
S RS=$E(ENCODE,2)
S INFO=$NA(^TMP("XUMFXHL7",$J,"SEQPRSE"))
D PARSE($G(SEQDATA),INFO,RS,1,245)
S REP=0
F S REP=+$O(@INFO@(REP)) Q:'REP D PARSE($NA(@INFO@(REP)),$NA(@OUTARR@(REP)),CS,1,245)
K @INFO
Q
XUMFXHL7 ;BPFO/JRP - IEMM UTILTIES (CONT);7/29/2002
+1 ;;8.0;KERNEL;**299,407**;Jul 10, 1995;Build 8
+2 ;
+3 ;copied from SCMSVUT5
+4 ;
PARSE(INARR,OUTARR,SEP,SUB,MAX) ;Parse array into individual fields
+1 ;Input : INARR - Array containing data to parse (full global ref)
+2 ; INARR = First 245 characters of data
+3 ; INARR(1..n) = Continuation nodes
+4 ; OR
+5 ; INARR(x) = First 245 characters of data
+6 ; INARR(x,1..n) = Continuation nodes
+7 ; OUTARR - Array to put parsed data into (full global ref)
+8 ; SEP - Field separator (defaults to ^) (1 character)
+9 ; SUB - Starting subscript of OUTARR (defaults to 0)
+10 ; MAX - Maximum length of output node (defaults to 245)
+11 ;Output : None
+12 ; OUTARR(SUB) = First piece (MAX characters)
+13 ; OUTARR(SUB,1..n) = Continuation nodes
+14 ; OUTARR(SUB+X) = Xth piece (MAX characters)
+15 ; OUTARR(SUB+X,1..n) = Continuation nodes
+16 ;Notes : OUTARR is initialized (KILLed) on entry
+17 ; : Assumes that INARR and OUTARR are defined and valid
+18 ;
+19 ;Declare variables
+20 NEW NODE,STOP,DATA,INFO,FLD,SEPCNT,CN,OUT,TMP,ROOT,OUTNODE
+21 KILL @OUTARR
+22 SET SEP=$GET(SEP)
SET SEP=$EXTRACT(SEP,1)
IF SEP=""
SET SEP="^"
+23 SET SUB=+$GET(SUB)
+24 SET MAX=+$GET(MAX)
IF 'MAX
SET MAX=245
+25 SET NODE=INARR
+26 SET INFO=$GET(@NODE)
+27 SET ROOT=$$OREF^DILF(INARR)
+28 SET FLD=1
+29 SET SEPCNT=$LENGTH(INFO,SEP)
+30 SET STOP=0
+31 SET OUTNODE=$NAME(@OUTARR@(SUB))
+32 SET CN=0
+33 FOR
SET DATA=$PIECE(INFO,SEP,FLD)
Begin DoDot:1
+34 IF FLD=SEPCNT
Begin DoDot:2
+35 DO ADDNODE
+36 SET NODE=$QUERY(@NODE)
+37 IF (NODE="")!(NODE'[ROOT)
SET STOP=1
QUIT
+38 SET INFO=$GET(@NODE)
+39 SET SEPCNT=$LENGTH(INFO,SEP)
+40 SET FLD=1
End DoDot:2
QUIT
+41 DO ADDNODE
+42 SET SUB=SUB+1
+43 SET CN=0
+44 SET OUTNODE=$NAME(@OUTARR@(SUB))
+45 SET FLD=FLD+1
End DoDot:1
IF STOP
QUIT
+46 QUIT
ADDNODE ;Used by PARSE to add data to output node (handles continuation nodes)
+1 SET TMP=$GET(@OUTNODE)
+2 IF ($LENGTH(TMP)+$LENGTH(DATA))<(MAX+1)
SET @OUTNODE=TMP_DATA
QUIT
+3 SET @OUTNODE=TMP_$EXTRACT(DATA,1,(MAX-$LENGTH(TMP)))
+4 SET CN=CN+1
+5 SET DATA=$EXTRACT(DATA,(MAX-$LENGTH(TMP)+1),$LENGTH(DATA))
+6 SET OUTNODE=$NAME(@OUTARR@(SUB,CN))
+7 IF DATA'=""
DO ADDNODE
+8 QUIT
+9 ;
+10 ;
SEGPRSE(SEGMENT,OUTARR,FS,LENGTH) ;Parse HL7 segment by field separator
+1 ;Input : SEGMENT - Array containing HL7 segment to parse
+2 ; (full global ref)
+3 ; SEGMENT = First 245 characters of segment
+4 ; SEGMENT(1..n) = Continuation nodes
+5 ; OR
+6 ; SEGMENT(x) = First 245 characters of segment
+7 ; SEGMENT(x,1..n) = Continuation nodes
+8 ; OUTARR - Array to put parsed segment into (full global ref)
+9 ; FS - HL7 field separator (defaults to ^) (1 character)
+10 ;Output : None
+11 ; OUTARR(0) = Segment name
+12 ; OUTARR(seq#) = Data (first 245 characters)
+13 ; OUTARR(seq#,1..n) Continuation nodes
+14 ;Notes : OUTARR is initialized (KILLed) on entry
+15 ; : Assumes SEGMENT and OUTARR are defined and valid
+16 ;
+17 SET LENGTH=$SELECT($GET(LENGTH):LENGTH,1:245)
+18 ;
+19 DO PARSE($GET(SEGMENT),$GET(OUTARR),$GET(FS),0,LENGTH)
+20 QUIT
+21 ;
SEQPRSE(SEQDATA,OUTARR,ENCODE) ;Parse HL7 sequence by component
+1 ;Input : SEQDATA - Array containing seq to parse (full global ref)
+2 ; SEQDATA = First 245 characters of sequence
+3 ; SEQDATA(1..n) = Continuation nodes
+4 ; OR
+5 ; SEQDATA(x) = First 245 characters of sequence
+6 ; SEQDATA(x,1..n) = Continuation nodes
+7 ; OUTARR - Array to put parsed sequence into (full global ref)
+8 ; ENCODE - HL7 encoding characters (defaults to ~|\&) (4 chars)
+9 ;Output : None
+10 ; OUTARR(rep#,comp#) = Data (first 245 characters)
+11 ; OUTARR(rep#,comp#,1..n) = Continuation nodes
+12 ;Notes : OUTARR is initialized (KILLed) on entry
+13 ; : Assumes SEQDATA and OUTARR are defined and valid
+14 ;
+15 ;Declare variables
+16 NEW RS,CS,INFO,DATA,REP,COMP
+17 SET ENCODE=$GET(ENCODE,"~|\&")
+18 SET ENCODE=$EXTRACT(ENCODE,1,4)
IF $LENGTH(ENCODE)'=4
SET ENCODE="~|\&"
+19 SET CS=$EXTRACT(ENCODE,1)
+20 SET RS=$EXTRACT(ENCODE,2)
+21 SET INFO=$NAME(^TMP("XUMFXHL7",$JOB,"SEQPRSE"))
+22 DO PARSE($GET(SEQDATA),INFO,RS,1,245)
+23 SET REP=0
+24 FOR
SET REP=+$ORDER(@INFO@(REP))
IF 'REP
QUIT
DO PARSE($NAME(@INFO@(REP)),$NAME(@OUTARR@(REP)),CS,1,245)
+25 KILL @INFO
+26 QUIT
+27
