- SCMSVUT5 ;BPFO/JRP - IEMM UTILTIES (CONT);7/29/2002
- ;;5.3;Scheduling;**254,293**;Aug 13, 1993
- ;
- 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) ;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
- ;
- D PARSE($G(SEGMENT),$G(OUTARR),$G(FS),0,245)
- 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("SCMSVUT5",$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
-
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMSVUT5 4164 printed Jan 18, 2025@03:43:21 Page 2
- SCMSVUT5 ;BPFO/JRP - IEMM UTILTIES (CONT);7/29/2002
- +1 ;;5.3;Scheduling;**254,293**;Aug 13, 1993
- +2 ;
- 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) ;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 DO PARSE($GET(SEGMENT),$GET(OUTARR),$GET(FS),0,245)
- +18 QUIT
- +19 ;
- 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("SCMSVUT5",$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