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
        
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMFXHL7   4249     printed  Sep 23, 2025@19:47:23                                                                                                                                                                                                    Page 2
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