SCMSVUT4 ;BPFO/JRP - IEMM Utilities (cont);6/18/2002
;;5.3;Scheduling;**245**;Aug 13, 1993
;
Q
;
CNVRTHLQ(STRING,HLQ) ;Convert HL7 null designation to null
;Input : STRING - String to perform conversion on
; HLQ - HL7 null designation (defaults to "")
;Output : STRING with HLQ converted to null
;
;Declare variables
N X,L
S STRING=$G(STRING)
I (STRING="") Q ""
S:('$D(HLQ)) HLQ=$C(34,34)
S:HLQ="" HLQ=$C(34,34)
S L=$L(HLQ)
;Convert by removing all instances of HLQ
F S X=$F(STRING,HLQ) Q:'X D
.S STRING=$E(STRING,1,(X-L-1))_$E(STRING,X,$L(STRING))
Q STRING
;
PARFLD(FLD,OUTARR,HL,SUBS) ;Parse HL7 field by component
;Input : FLD - Field to parse
; OUTARR - Array to put parsed field into (pass by value)
; HL - Array containing HL7 variables (pass by reference)
; Using HL("FS"), HL("ECH"), HL("Q")
; This is output by $$INIT^HLFNC2()
; SUBS - Flag indicating if sub-components should also
; be broken out
; 0 = No (default)
; 1 = Yes
;Output : None
; OUTARR = Value (if field not broken into components)
; OUTARR(Cmp#) = Value
; OUTARR(Cmp#,Sub#) = Value (if sub-component requested)
;Notes : Existance and validity of input is assumed
; : OUTARR initialized (KILLed) on entry
; : FLD can not be a repeating field
;Declare variables
N CS,COMP,SS,VALUE,SUB
S FLD=$G(FLD)
Q:FLD=""
Q:'$D(HL)
S CNVRT=+$G(CNVRT)
K @OUTARR
;Get component & sub-component separators
S CS=$E(HL("ECH"),1)
S SS=$E(HL("ECH"),4)
;No components - set field at main level
I FLD'[CS S @OUTARR=FLD Q
;Parse out components
F COMP=1:1:$L(FLD,CS) D
.S VALUE=$P(FLD,CS,COMP)
.I 'SUBS S @OUTARR@(COMP)=VALUE Q
.;Parse out sub-components
.I VALUE'[SS S @OUTARR@(COMP)=VALUE Q
.F SUB=1:1:$L(VALUE,SS) D
..S @OUTARR@(COMP,SUB)=$P(VALUE,SS,SUB)
Q
;
PARSEG(SEGARR,OUTARR,HL,PARCOMP,CNVRT) ;Parse HL7 segment by field
;Input : SEGARR - Array containing segment (pass by value)
; SEGARR = First 245 characters of segment
; SEGARR(1..n) = Continuation nodes
; OR
; SEGARR(0) = First 245 characters of segment
; SEGARR(1..n) = Continuation nodes
; OUTARR - Array to put parsed segment into (pass by value)
; HL - Array containing HL7 variables (pass by reference)
; Using HL("FS"), HL("ECH"), HL("Q")
; This is output by $$INIT^HLFNC2()
; PARCOMP - Flag indicating if fields should be parsed into
; their components
; 0 = No (default)
; 10 = Yes - components only
; 11 = Yes - component and sub-components
; CNVRT - Flag indicating if HL7 null designation should be
; converted to MUMPS null (optional)
; 0 = No (default)
; 1 = Yes
;Output : None
; OUTARR will be in the following format:
; OUTARR(0) = Segment name
; OUTARR(Seq#,Rpt#) = Value
; OUTARR(Seq#,Rpt#,Cmp#) = Value
; OUTARR(Seq#,Rpt#,Cmp#,Sub#) = Value
;
;Notes : Existance and validity of input is assumed
; : OUTARR initialized (KILLed) on entry
; : Assumes no field in segment greater than 245 characters
; : Data stored with the least number of subscripts in OUTARR.
; If field not broken into components then the component
; subscript will not be used. Same is true of the
; sub-component subscript.
;
;Declare variables
N SEQ,CURNODE,CURDATA,NXTNODE,NXTDATA,VALUE,RS,REP,STOP,SEG
Q:'$D(SEGARR)
Q:'$D(@SEGARR)
Q:'$D(OUTARR)
Q:'$D(HL)
S PARCOMP=+$G(PARCOMP)
S CNVRT=+$G(CNVRT)
K @OUTARR
;Get repetition separator
S RS=$E(HL("ECH"),2)
;Get initial and next nodes
S CURNODE=$S($D(@SEGARR)#2:"",1:$O(@SEGARR@("")))
S CURDATA=$S(CURNODE="":@SEGARR,1:@SEGARR@(CURNODE))
S NXTNODE=$O(@SEGARR@(CURNODE))
S NXTDATA=$S(NXTNODE="":"",1:$G(@SEGARR@(NXTNODE)))
;Get/strip segment name
S SEG=$P(CURDATA,HL("FS"),1)
Q:($L(SEG)'=3)
S CURDATA=$P(CURDATA,HL("FS"),2,99999)
S @OUTARR@(0)=SEG
;Parse out fields
S STOP=0
S SEQ=1
F D Q:STOP
.S VALUE=$P(CURDATA,HL("FS"),1)
.;Account for continuation of data on next node
.I CURDATA'[HL("FS") D
..S VALUE=VALUE_$P(NXTDATA,HL("FS"),1)
..S NXTDATA=$P(NXTDATA,HL("FS"),2,99999)
.;Convert HL7 null to MUMPS null
.I CNVRT S VALUE=$$CNVRTHLQ(VALUE,HL("Q"))
.;Parse out repetitions
.F REP=1:1:$L(VALUE,RS) D
..;Parse out components
..I PARCOMP D Q
...D PARFLD($P(VALUE,RS,REP),$NA(@OUTARR@(SEQ,REP)),.HL,(PARCOMP#2))
..;Don't parse out components
..S @OUTARR@(SEQ,REP)=$P(VALUE,RS,REP)
.;Increment sequence number
.S SEQ=SEQ+1
.;No more fields on current node - move to next node
.I CURDATA'[HL("FS") D Q
..;No more fields - stop parsing
..I NXTDATA="" S STOP=1 Q
..;Update current node and get next node
..S CURDATA=NXTDATA
..S CURNODE=NXTNODE
..S NXTNODE=$O(@SEGARR@(CURNODE))
..S NXTDATA=$S(NXTNODE="":"",1:$G(@SEGARR@(NXTNODE)))
.;Remove current field from node
.S CURDATA=$P(CURDATA,HL("FS"),2,99999)
Q
;
PARMSG(MSGARR,OUTARR,HL,PARCOMP,CNVRT) ;Parse HL7 message by segment
; and field
;Input : MSGARR - Array containing message (pass by value)
; MSGARR(x) = First 245 characters of Xth segment
; MSGARR(x,1..n) = Continuation nodes for Xth segment
; OUTARR - Array to put parsed message into (pass by value)
; HL - Array containing HL7 variables (pass by reference)
; Using HL("FS"), HL("ECH"), HL("Q")
; This is output by $$INIT^HLFNC2()
; PARCOMP - Flag indicating if fields should be parsed into
; their components
; 0 = No (default)
; 1 = Yes
; CNVRT - Flag indicating if HL7 null designation should be
; converted to MUMPS null (optional)
; 0 = No (default)
; 10 = Yes - components only
; 11 = Yes - component and sub-components
;Output : None
; OUTARR will be in the following format:
; OUTARR(0) = Segment name
; OUTARR(SegName,Rpt#)=Seg#
; OUTARR(Seg#,Seq#,Rpt#) = Value
; OUTARR(Seg#,Seq#,Rpt#,Cmp#) = Value
; OUTARR(Seg#,Seq#,Rpt#,Cmp#,Sub#) = Value
;
;Notes : Existance and validity of input is assumed
; : OUTARR initialized (KILLed) on entry
; : Assumes no field in segment greater than 245 characters
; : Data stored with the least number of subscripts in OUTARR.
; If field not broken into components then the component
; subscript will not be used. Same is true of the
; sub-component subscript.
;
;Declare variables
N SEG,SEGNAME,REP
Q:'$D(MSGARR)
Q:'$D(@MSGARR)
Q:'$D(OUTARR)
Q:'$D(HL)
S PARCOMP=+$G(PARCOMP)
S CNVRT=+$G(CNVRT)
K @OUTARR
;Parse message by segment
S SEG=""
F S SEG=$O(@MSGARR@(SEG)) Q:SEG="" D
.;Parse segment
.D PARSEG($NA(@MSGARR@(SEG)),$NA(@OUTARR@(SEG)),.HL,PARCOMP,CNVRT)
.;Set up segment index
.S SEGNAME=$G(@OUTARR@(SEG,0))
.Q:SEGNAME=""
.S REP=$O(@OUTARR@(SEGNAME,""),-1)+1
.S @OUTARR@(SEGNAME,REP)=SEG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMSVUT4 7576 printed Sep 23, 2025@20:18:32 Page 2
SCMSVUT4 ;BPFO/JRP - IEMM Utilities (cont);6/18/2002
+1 ;;5.3;Scheduling;**245**;Aug 13, 1993
+2 ;
+3 QUIT
+4 ;
CNVRTHLQ(STRING,HLQ) ;Convert HL7 null designation to null
+1 ;Input : STRING - String to perform conversion on
+2 ; HLQ - HL7 null designation (defaults to "")
+3 ;Output : STRING with HLQ converted to null
+4 ;
+5 ;Declare variables
+6 NEW X,L
+7 SET STRING=$GET(STRING)
+8 IF (STRING="")
QUIT ""
+9 if ('$DATA(HLQ))
SET HLQ=$CHAR(34,34)
+10 if HLQ=""
SET HLQ=$CHAR(34,34)
+11 SET L=$LENGTH(HLQ)
+12 ;Convert by removing all instances of HLQ
+13 FOR
SET X=$FIND(STRING,HLQ)
if 'X
QUIT
Begin DoDot:1
+14 SET STRING=$EXTRACT(STRING,1,(X-L-1))_$EXTRACT(STRING,X,$LENGTH(STRING))
End DoDot:1
+15 QUIT STRING
+16 ;
PARFLD(FLD,OUTARR,HL,SUBS) ;Parse HL7 field by component
+1 ;Input : FLD - Field to parse
+2 ; OUTARR - Array to put parsed field into (pass by value)
+3 ; HL - Array containing HL7 variables (pass by reference)
+4 ; Using HL("FS"), HL("ECH"), HL("Q")
+5 ; This is output by $$INIT^HLFNC2()
+6 ; SUBS - Flag indicating if sub-components should also
+7 ; be broken out
+8 ; 0 = No (default)
+9 ; 1 = Yes
+10 ;Output : None
+11 ; OUTARR = Value (if field not broken into components)
+12 ; OUTARR(Cmp#) = Value
+13 ; OUTARR(Cmp#,Sub#) = Value (if sub-component requested)
+14 ;Notes : Existance and validity of input is assumed
+15 ; : OUTARR initialized (KILLed) on entry
+16 ; : FLD can not be a repeating field
+17 ;Declare variables
+18 NEW CS,COMP,SS,VALUE,SUB
+19 SET FLD=$GET(FLD)
+20 if FLD=""
QUIT
+21 if '$DATA(HL)
QUIT
+22 SET CNVRT=+$GET(CNVRT)
+23 KILL @OUTARR
+24 ;Get component & sub-component separators
+25 SET CS=$EXTRACT(HL("ECH"),1)
+26 SET SS=$EXTRACT(HL("ECH"),4)
+27 ;No components - set field at main level
+28 IF FLD'[CS
SET @OUTARR=FLD
QUIT
+29 ;Parse out components
+30 FOR COMP=1:1:$LENGTH(FLD,CS)
Begin DoDot:1
+31 SET VALUE=$PIECE(FLD,CS,COMP)
+32 IF 'SUBS
SET @OUTARR@(COMP)=VALUE
QUIT
+33 ;Parse out sub-components
+34 IF VALUE'[SS
SET @OUTARR@(COMP)=VALUE
QUIT
+35 FOR SUB=1:1:$LENGTH(VALUE,SS)
Begin DoDot:2
+36 SET @OUTARR@(COMP,SUB)=$PIECE(VALUE,SS,SUB)
End DoDot:2
End DoDot:1
+37 QUIT
+38 ;
PARSEG(SEGARR,OUTARR,HL,PARCOMP,CNVRT) ;Parse HL7 segment by field
+1 ;Input : SEGARR - Array containing segment (pass by value)
+2 ; SEGARR = First 245 characters of segment
+3 ; SEGARR(1..n) = Continuation nodes
+4 ; OR
+5 ; SEGARR(0) = First 245 characters of segment
+6 ; SEGARR(1..n) = Continuation nodes
+7 ; OUTARR - Array to put parsed segment into (pass by value)
+8 ; HL - Array containing HL7 variables (pass by reference)
+9 ; Using HL("FS"), HL("ECH"), HL("Q")
+10 ; This is output by $$INIT^HLFNC2()
+11 ; PARCOMP - Flag indicating if fields should be parsed into
+12 ; their components
+13 ; 0 = No (default)
+14 ; 10 = Yes - components only
+15 ; 11 = Yes - component and sub-components
+16 ; CNVRT - Flag indicating if HL7 null designation should be
+17 ; converted to MUMPS null (optional)
+18 ; 0 = No (default)
+19 ; 1 = Yes
+20 ;Output : None
+21 ; OUTARR will be in the following format:
+22 ; OUTARR(0) = Segment name
+23 ; OUTARR(Seq#,Rpt#) = Value
+24 ; OUTARR(Seq#,Rpt#,Cmp#) = Value
+25 ; OUTARR(Seq#,Rpt#,Cmp#,Sub#) = Value
+26 ;
+27 ;Notes : Existance and validity of input is assumed
+28 ; : OUTARR initialized (KILLed) on entry
+29 ; : Assumes no field in segment greater than 245 characters
+30 ; : Data stored with the least number of subscripts in OUTARR.
+31 ; If field not broken into components then the component
+32 ; subscript will not be used. Same is true of the
+33 ; sub-component subscript.
+34 ;
+35 ;Declare variables
+36 NEW SEQ,CURNODE,CURDATA,NXTNODE,NXTDATA,VALUE,RS,REP,STOP,SEG
+37 if '$DATA(SEGARR)
QUIT
+38 if '$DATA(@SEGARR)
QUIT
+39 if '$DATA(OUTARR)
QUIT
+40 if '$DATA(HL)
QUIT
+41 SET PARCOMP=+$GET(PARCOMP)
+42 SET CNVRT=+$GET(CNVRT)
+43 KILL @OUTARR
+44 ;Get repetition separator
+45 SET RS=$EXTRACT(HL("ECH"),2)
+46 ;Get initial and next nodes
+47 SET CURNODE=$SELECT($DATA(@SEGARR)#2:"",1:$ORDER(@SEGARR@("")))
+48 SET CURDATA=$SELECT(CURNODE="":@SEGARR,1:@SEGARR@(CURNODE))
+49 SET NXTNODE=$ORDER(@SEGARR@(CURNODE))
+50 SET NXTDATA=$SELECT(NXTNODE="":"",1:$GET(@SEGARR@(NXTNODE)))
+51 ;Get/strip segment name
+52 SET SEG=$PIECE(CURDATA,HL("FS"),1)
+53 if ($LENGTH(SEG)'=3)
QUIT
+54 SET CURDATA=$PIECE(CURDATA,HL("FS"),2,99999)
+55 SET @OUTARR@(0)=SEG
+56 ;Parse out fields
+57 SET STOP=0
+58 SET SEQ=1
+59 FOR
Begin DoDot:1
+60 SET VALUE=$PIECE(CURDATA,HL("FS"),1)
+61 ;Account for continuation of data on next node
+62 IF CURDATA'[HL("FS")
Begin DoDot:2
+63 SET VALUE=VALUE_$PIECE(NXTDATA,HL("FS"),1)
+64 SET NXTDATA=$PIECE(NXTDATA,HL("FS"),2,99999)
End DoDot:2
+65 ;Convert HL7 null to MUMPS null
+66 IF CNVRT
SET VALUE=$$CNVRTHLQ(VALUE,HL("Q"))
+67 ;Parse out repetitions
+68 FOR REP=1:1:$LENGTH(VALUE,RS)
Begin DoDot:2
+69 ;Parse out components
+70 IF PARCOMP
Begin DoDot:3
+71 DO PARFLD($PIECE(VALUE,RS,REP),$NAME(@OUTARR@(SEQ,REP)),.HL,(PARCOMP#2))
End DoDot:3
QUIT
+72 ;Don't parse out components
+73 SET @OUTARR@(SEQ,REP)=$PIECE(VALUE,RS,REP)
End DoDot:2
+74 ;Increment sequence number
+75 SET SEQ=SEQ+1
+76 ;No more fields on current node - move to next node
+77 IF CURDATA'[HL("FS")
Begin DoDot:2
+78 ;No more fields - stop parsing
+79 IF NXTDATA=""
SET STOP=1
QUIT
+80 ;Update current node and get next node
+81 SET CURDATA=NXTDATA
+82 SET CURNODE=NXTNODE
+83 SET NXTNODE=$ORDER(@SEGARR@(CURNODE))
+84 SET NXTDATA=$SELECT(NXTNODE="":"",1:$GET(@SEGARR@(NXTNODE)))
End DoDot:2
QUIT
+85 ;Remove current field from node
+86 SET CURDATA=$PIECE(CURDATA,HL("FS"),2,99999)
End DoDot:1
if STOP
QUIT
+87 QUIT
+88 ;
PARMSG(MSGARR,OUTARR,HL,PARCOMP,CNVRT) ;Parse HL7 message by segment
+1 ; and field
+2 ;Input : MSGARR - Array containing message (pass by value)
+3 ; MSGARR(x) = First 245 characters of Xth segment
+4 ; MSGARR(x,1..n) = Continuation nodes for Xth segment
+5 ; OUTARR - Array to put parsed message into (pass by value)
+6 ; HL - Array containing HL7 variables (pass by reference)
+7 ; Using HL("FS"), HL("ECH"), HL("Q")
+8 ; This is output by $$INIT^HLFNC2()
+9 ; PARCOMP - Flag indicating if fields should be parsed into
+10 ; their components
+11 ; 0 = No (default)
+12 ; 1 = Yes
+13 ; CNVRT - Flag indicating if HL7 null designation should be
+14 ; converted to MUMPS null (optional)
+15 ; 0 = No (default)
+16 ; 10 = Yes - components only
+17 ; 11 = Yes - component and sub-components
+18 ;Output : None
+19 ; OUTARR will be in the following format:
+20 ; OUTARR(0) = Segment name
+21 ; OUTARR(SegName,Rpt#)=Seg#
+22 ; OUTARR(Seg#,Seq#,Rpt#) = Value
+23 ; OUTARR(Seg#,Seq#,Rpt#,Cmp#) = Value
+24 ; OUTARR(Seg#,Seq#,Rpt#,Cmp#,Sub#) = Value
+25 ;
+26 ;Notes : Existance and validity of input is assumed
+27 ; : OUTARR initialized (KILLed) on entry
+28 ; : Assumes no field in segment greater than 245 characters
+29 ; : Data stored with the least number of subscripts in OUTARR.
+30 ; If field not broken into components then the component
+31 ; subscript will not be used. Same is true of the
+32 ; sub-component subscript.
+33 ;
+34 ;Declare variables
+35 NEW SEG,SEGNAME,REP
+36 if '$DATA(MSGARR)
QUIT
+37 if '$DATA(@MSGARR)
QUIT
+38 if '$DATA(OUTARR)
QUIT
+39 if '$DATA(HL)
QUIT
+40 SET PARCOMP=+$GET(PARCOMP)
+41 SET CNVRT=+$GET(CNVRT)
+42 KILL @OUTARR
+43 ;Parse message by segment
+44 SET SEG=""
+45 FOR
SET SEG=$ORDER(@MSGARR@(SEG))
if SEG=""
QUIT
Begin DoDot:1
+46 ;Parse segment
+47 DO PARSEG($NAME(@MSGARR@(SEG)),$NAME(@OUTARR@(SEG)),.HL,PARCOMP,CNVRT)
+48 ;Set up segment index
+49 SET SEGNAME=$GET(@OUTARR@(SEG,0))
+50 if SEGNAME=""
QUIT
+51 SET REP=$ORDER(@OUTARR@(SEGNAME,""),-1)+1
+52 SET @OUTARR@(SEGNAME,REP)=SEG
End DoDot:1
+53 QUIT
