MHV7U ;WAS/GPM - HL7 UTILITIES ; [1/7/08 10:21pm]
;;1.0;My HealtheVet;**1,2**;Aug 23, 2005;Build 22
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;This routine contains generic utilities used when building
;or processing HL7 messages.
;
Q ;Direct entry not supported
;
LOADMSG(MSGROOT) ; Load HL7 message into temporary global for processing
;
;This subroutine assumes that all VistA HL7 environment variables are
;properly initialized and will produce a fatal error if they aren't.
;
N CNT,SEG
K @MSGROOT
F SEG=1:1 X HLNEXT Q:HLQUIT'>0 D
. S CNT=0
. S @MSGROOT@(SEG,CNT)=HLNODE
. F S CNT=$O(HLNODE(CNT)) Q:'CNT S @MSGROOT@(SEG,CNT)=HLNODE(CNT)
Q
;
LOADXMT(XMT) ;Set HL dependent XMT values
;
; The HL array and variables are expected to be defined. If not,
; message processing will fail. These references should not be
; wrapped in $G, as null values will simply postpone the failure to
; a point that will be harder to diagnose. Except HL("APAT") which
; is not defined on synchronous calls.
; Also assumes MHV RESPONSE MAP file is setup for every protocol
; pair defined by MHV package.
;
; Integration Agreements:
; 1373 : Reference to PROTOCOL file #101
;
N SUBPROT,RESPIEN,RESP0
S XMT("MID")=HL("MID") ;Message ID
S XMT("MODE")="A" ;Response mode
I $G(HL("APAT"))="" S XMT("MODE")="S" ;Synchronous mode
S XMT("HLMTIENS")=HLMTIENS ;Message IEN
S XMT("MESSAGE TYPE")=HL("MTN") ;Message type
S XMT("EVENT TYPE")=HL("ETN") ;Event type
S XMT("DELIM")=HL("FS")_HL("ECH") ;HL Delimiters
S XMT("MAX SIZE")=0 ;Default size unlimited
;
; Map response protocol and builder
S SUBPROT=$P(^ORD(101,HL("EIDS"),0),"^")
S RESPIEN=$O(^MHV(2275.4,"B",SUBPROT,0))
S RESP0=$G(^MHV(2275.4,RESPIEN,0))
S XMT("PROTOCOL")=$P(RESP0,"^",2) ;Response Protocol
S XMT("BUILDER")=$TR($P(RESP0,"^",3),"~","^") ;Response Builder
S XMT("BREAK SEGMENT")=$P(RESP0,"^",4) ;Boundary Segment
Q
;
DELIM(PROTOCOL) ;Return string of message delimiters based on Protocol
;
; Integration Agreements:
; 2161 : INIT^HLFNC2
;
N HL
Q:PROTOCOL="" ""
D INIT^HLFNC2(PROTOCOL,.HL)
Q $G(HL("FS"))_$G(HL("ECH"))
;
PARSEMSG(MSGROOT,HL) ; Message Parser
; Does not handle segments that span nodes
; Does not handle extremely long segments (uses a local)
; Does not handle long fields (segment parser doesn't)
;
N SEG,CNT,DATA,MSG
F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D
. D PARSESEG(SEG(0),.DATA,.HL)
. K @MSGROOT@(CNT)
. I DATA(0)'="" M @MSGROOT@(CNT)=DATA
. Q:'$D(SEG(1))
. ;Add handler for segments that span nodes here.
. Q
Q
;
PARSESEG(SEG,DATA,HL) ;Generic segment parser
;This procedure parses a single HL7 segment and builds an array
;subscripted by the field number containing the data for that field.
; Does not handle segments that span nodes
;
; Input:
; SEG - HL7 segment to parse
; HL - HL7 environment array
;
; Output:
; Function value - field data array [SUB1:field, SUB2:repetition,
; SUB3:component, SUB4:sub-component]
;
N CMP ;component subscript
N CMPVAL ;component value
N FLD ;field subscript
N FLDVAL ;field value
N REP ;repetition subscript
N REPVAL ;repetition value
N SUB ;sub-component subscript
N SUBVAL ;sub-component value
N FS ;field separator
N CS ;component separator
N RS ;repetition separator
N SS ;sub-component separator
;
K DATA
S FS=HL("FS")
S CS=$E(HL("ECH"))
S RS=$E(HL("ECH"),2)
S SS=$E(HL("ECH"),4)
;
S DATA(0)=$P(SEG,FS)
S SEG=$P(SEG,FS,2,9999)
F FLD=1:1:$L(SEG,FS) D
. S FLDVAL=$P(SEG,FS,FLD)
. F REP=1:1:$L(FLDVAL,RS) D
. . S REPVAL=$P(FLDVAL,RS,REP)
. . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D
. . . S CMPVAL=$P(REPVAL,CS,CMP)
. . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D
. . . . S SUBVAL=$P(CMPVAL,SS,SUB)
. . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL
. . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL
. . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL
. I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL
Q
;
BLDSEG(DATA,HL) ;generic segment builder
;
; Input:
; DATA - field data array [SUB1:field, SUB2:repetition,
; SUB3:component, SUB4:sub-component]
; HL - HL7 environment array
;
; Output:
; Function Value - Formatted HL7 segment on success, "" on failure
;
N CMP ;component subscript
N CMPVAL ;component value
N FLD ;field subscript
N FLDVAL ;field value
N REP ;repetition subscript
N REPVAL ;repetition value
N SUB ;sub-component subscript
N SUBVAL ;sub-component value
N FS ;field separator
N CS ;component separator
N RS ;repetition separator
N ES ;escape character
N SS ;sub-component separator
N SEG,SEP
;
S FS=HL("FS")
S CS=$E(HL("ECH"))
S RS=$E(HL("ECH"),2)
S ES=$E(HL("ECH"),3)
S SS=$E(HL("ECH"),4)
;
S SEG=$G(DATA(0))
F FLD=1:1:$O(DATA(""),-1) D
. S FLDVAL=$G(DATA(FLD)),SEP=FS
. S SEG=SEG_SEP_FLDVAL
. F REP=1:1:$O(DATA(FLD,""),-1) D
. . S REPVAL=$G(DATA(FLD,REP))
. . S SEP=$S(REP=1:"",1:RS)
. . S SEG=SEG_SEP_REPVAL
. . F CMP=1:1:$O(DATA(FLD,REP,""),-1) D
. . . S CMPVAL=$G(DATA(FLD,REP,CMP))
. . . S SEP=$S(CMP=1:"",1:CS)
. . . S SEG=SEG_SEP_CMPVAL
. . . F SUB=1:1:$O(DATA(FLD,REP,CMP,""),-1) D
. . . . S SUBVAL=$G(DATA(FLD,REP,CMP,SUB))
. . . . S SEP=$S(SUB=1:"",1:SS)
. . . . S SEG=SEG_SEP_SUBVAL
Q SEG
;
BLDWP(WP,SEG,MAXLEN,FORMAT,FMTLEN,HL) ;
;Builds segment nodes to add word processing fields to a segment
N CNT,LINE,LAST,FS,RS,LENGTH,I
I MAXLEN<1 S MAXLEN=99999999999999999
S FS=HL("FS") ;field separator
S RS=$E(HL("ECH"),2) ;repeat separator
S CNT=$O(SEG(""),-1)+1
S SEG(CNT)=FS
S FMTLEN=0
S LENGTH=0
;
S I=0
F S I=$O(WP(I)) Q:'I D Q:LENGTH'<MAXLEN
. I $D(WP(I,0)) S LINE=$G(WP(I,0)) ;conventional WP field
. E S LINE=$G(WP(I))
. S LENGTH=LENGTH+$L(LINE)
. I LENGTH'<MAXLEN S LINE=$E(LINE,1,$L(LINE)-(LENGTH-MAXLEN))
. S LINE=$$ESCAPE(LINE,.HL)
. S LAST=$E(LINE,$L(LINE))
. ;first line
. I SEG(CNT)=FS S SEG(CNT)=FS_LINE,FMTLEN=FMTLEN+$L(SEG(CNT)) Q
. S CNT=CNT+1
. S SEG(CNT)=RS_LINE,FMTLEN=FMTLEN+$L(SEG(CNT))
. Q:'FORMAT
. ;attempt to keep sentences together
. I $E(LINE)=" "!(LAST=" ") S SEG(CNT)=LINE,FMTLEN=FMTLEN+$L(LINE)
. Q
Q
;
ESCAPE(VAL,HL) ;Escape any special characters
; *** Does not handle long strings of special characters ***
;
; Input:
; VAL - value to escape
; HL - HL7 environment array
;
; Output:
; VAL - passed by reference
;
N FS ;field separator
N CS ;component separator
N RS ;repetition separator
N ES ;escape character
N SS ;sub-component separator
N L,STR,I
;
S FS=HL("FS")
S CS=$E(HL("ECH"))
S RS=$E(HL("ECH"),2)
S ES=$E(HL("ECH"),3)
S SS=$E(HL("ECH"),4)
;
I VAL[ES D
. S L=$L(VAL,ES),STR=""
. F I=1:1:L S $P(STR,ES_"E"_ES,I)=$P(VAL,ES,I)
. S VAL=STR
I VAL[FS D
. S L=$L(VAL,FS),STR=""
. F I=1:1:L S $P(STR,ES_"F"_ES,I)=$P(VAL,FS,I)
. S VAL=STR
I VAL[RS D
. S L=$L(VAL,RS),STR=""
. F I=1:1:L S $P(STR,ES_"R"_ES,I)=$P(VAL,RS,I)
. S VAL=STR
I VAL[CS D
. S L=$L(VAL,CS),STR=""
. F I=1:1:L S $P(STR,ES_"S"_ES,I)=$P(VAL,CS,I)
. S VAL=STR
I VAL[SS D
. S L=$L(VAL,SS),STR=""
. F I=1:1:L S $P(STR,ES_"T"_ES,I)=$P(VAL,SS,I)
. S VAL=STR
Q VAL
;
UNESC(VAL,HL) ;Reconstitute any escaped characters
;
; Input:
; VAL - Value to reconstitute
; HL - HL7 environment array
;
; Output:
; VAL - passed by reference
;
N FS ;field separator
N CS ;component separator
N RS ;repetition separator
N ES ;escape character
N SS ;sub-component separator
N L,STR,I,FESC,CESC,RESC,EESC,SESC
;
S FS=HL("FS")
S CS=$E(HL("ECH"))
S RS=$E(HL("ECH"),2)
S ES=$E(HL("ECH"),3)
S SS=$E(HL("ECH"),4)
S FESC=ES_"F"_ES
S CESC=ES_"S"_ES
S RESC=ES_"R"_ES
S EESC=ES_"E"_ES
S SESC=ES_"T"_ES
;
I VAL'[ES Q VAL
I VAL[FESC D
. S L=$L(VAL,FESC),STR=""
. F I=1:1:L S $P(STR,FS,I)=$P(VAL,FESC,I)
. S VAL=STR
I VAL[CESC D
. S L=$L(VAL,CESC),STR=""
. F I=1:1:L S $P(STR,CS,I)=$P(VAL,CESC,I)
. S VAL=STR
I VAL[RESC D
. S L=$L(VAL,RESC),STR=""
. F I=1:1:L S $P(STR,RS,I)=$P(VAL,RESC,I)
. S VAL=STR
I VAL[SESC D
. S L=$L(VAL,SESC),STR=""
. F I=1:1:L S $P(STR,SS,I)=$P(VAL,SESC,I)
. S VAL=STR
I VAL[EESC D
. S L=$L(VAL,EESC),STR=""
. F I=1:1:L S $P(STR,ES,I)=$P(VAL,EESC,I)
. S VAL=STR
Q VAL
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHV7U 8873 printed Jan 18, 2025@03:17:05 Page 2
MHV7U ;WAS/GPM - HL7 UTILITIES ; [1/7/08 10:21pm]
+1 ;;1.0;My HealtheVet;**1,2**;Aug 23, 2005;Build 22
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;This routine contains generic utilities used when building
+5 ;or processing HL7 messages.
+6 ;
+7 ;Direct entry not supported
QUIT
+8 ;
LOADMSG(MSGROOT) ; Load HL7 message into temporary global for processing
+1 ;
+2 ;This subroutine assumes that all VistA HL7 environment variables are
+3 ;properly initialized and will produce a fatal error if they aren't.
+4 ;
+5 NEW CNT,SEG
+6 KILL @MSGROOT
+7 FOR SEG=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+8 SET CNT=0
+9 SET @MSGROOT@(SEG,CNT)=HLNODE
+10 FOR
SET CNT=$ORDER(HLNODE(CNT))
if 'CNT
QUIT
SET @MSGROOT@(SEG,CNT)=HLNODE(CNT)
End DoDot:1
+11 QUIT
+12 ;
LOADXMT(XMT) ;Set HL dependent XMT values
+1 ;
+2 ; The HL array and variables are expected to be defined. If not,
+3 ; message processing will fail. These references should not be
+4 ; wrapped in $G, as null values will simply postpone the failure to
+5 ; a point that will be harder to diagnose. Except HL("APAT") which
+6 ; is not defined on synchronous calls.
+7 ; Also assumes MHV RESPONSE MAP file is setup for every protocol
+8 ; pair defined by MHV package.
+9 ;
+10 ; Integration Agreements:
+11 ; 1373 : Reference to PROTOCOL file #101
+12 ;
+13 NEW SUBPROT,RESPIEN,RESP0
+14 ;Message ID
SET XMT("MID")=HL("MID")
+15 ;Response mode
SET XMT("MODE")="A"
+16 ;Synchronous mode
IF $GET(HL("APAT"))=""
SET XMT("MODE")="S"
+17 ;Message IEN
SET XMT("HLMTIENS")=HLMTIENS
+18 ;Message type
SET XMT("MESSAGE TYPE")=HL("MTN")
+19 ;Event type
SET XMT("EVENT TYPE")=HL("ETN")
+20 ;HL Delimiters
SET XMT("DELIM")=HL("FS")_HL("ECH")
+21 ;Default size unlimited
SET XMT("MAX SIZE")=0
+22 ;
+23 ; Map response protocol and builder
+24 SET SUBPROT=$PIECE(^ORD(101,HL("EIDS"),0),"^")
+25 SET RESPIEN=$ORDER(^MHV(2275.4,"B",SUBPROT,0))
+26 SET RESP0=$GET(^MHV(2275.4,RESPIEN,0))
+27 ;Response Protocol
SET XMT("PROTOCOL")=$PIECE(RESP0,"^",2)
+28 ;Response Builder
SET XMT("BUILDER")=$TRANSLATE($PIECE(RESP0,"^",3),"~","^")
+29 ;Boundary Segment
SET XMT("BREAK SEGMENT")=$PIECE(RESP0,"^",4)
+30 QUIT
+31 ;
DELIM(PROTOCOL) ;Return string of message delimiters based on Protocol
+1 ;
+2 ; Integration Agreements:
+3 ; 2161 : INIT^HLFNC2
+4 ;
+5 NEW HL
+6 if PROTOCOL=""
QUIT ""
+7 DO INIT^HLFNC2(PROTOCOL,.HL)
+8 QUIT $GET(HL("FS"))_$GET(HL("ECH"))
+9 ;
PARSEMSG(MSGROOT,HL) ; Message Parser
+1 ; Does not handle segments that span nodes
+2 ; Does not handle extremely long segments (uses a local)
+3 ; Does not handle long fields (segment parser doesn't)
+4 ;
+5 NEW SEG,CNT,DATA,MSG
+6 FOR CNT=1:1
if '$DATA(@MSGROOT@(CNT))
QUIT
MERGE SEG=@MSGROOT@(CNT)
Begin DoDot:1
+7 DO PARSESEG(SEG(0),.DATA,.HL)
+8 KILL @MSGROOT@(CNT)
+9 IF DATA(0)'=""
MERGE @MSGROOT@(CNT)=DATA
+10 if '$DATA(SEG(1))
QUIT
+11 ;Add handler for segments that span nodes here.
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
PARSESEG(SEG,DATA,HL) ;Generic segment parser
+1 ;This procedure parses a single HL7 segment and builds an array
+2 ;subscripted by the field number containing the data for that field.
+3 ; Does not handle segments that span nodes
+4 ;
+5 ; Input:
+6 ; SEG - HL7 segment to parse
+7 ; HL - HL7 environment array
+8 ;
+9 ; Output:
+10 ; Function value - field data array [SUB1:field, SUB2:repetition,
+11 ; SUB3:component, SUB4:sub-component]
+12 ;
+13 ;component subscript
NEW CMP
+14 ;component value
NEW CMPVAL
+15 ;field subscript
NEW FLD
+16 ;field value
NEW FLDVAL
+17 ;repetition subscript
NEW REP
+18 ;repetition value
NEW REPVAL
+19 ;sub-component subscript
NEW SUB
+20 ;sub-component value
NEW SUBVAL
+21 ;field separator
NEW FS
+22 ;component separator
NEW CS
+23 ;repetition separator
NEW RS
+24 ;sub-component separator
NEW SS
+25 ;
+26 KILL DATA
+27 SET FS=HL("FS")
+28 SET CS=$EXTRACT(HL("ECH"))
+29 SET RS=$EXTRACT(HL("ECH"),2)
+30 SET SS=$EXTRACT(HL("ECH"),4)
+31 ;
+32 SET DATA(0)=$PIECE(SEG,FS)
+33 SET SEG=$PIECE(SEG,FS,2,9999)
+34 FOR FLD=1:1:$LENGTH(SEG,FS)
Begin DoDot:1
+35 SET FLDVAL=$PIECE(SEG,FS,FLD)
+36 FOR REP=1:1:$LENGTH(FLDVAL,RS)
Begin DoDot:2
+37 SET REPVAL=$PIECE(FLDVAL,RS,REP)
+38 IF REPVAL[CS
FOR CMP=1:1:$LENGTH(REPVAL,CS)
Begin DoDot:3
+39 SET CMPVAL=$PIECE(REPVAL,CS,CMP)
+40 IF CMPVAL[SS
FOR SUB=1:1:$LENGTH(CMPVAL,SS)
Begin DoDot:4
+41 SET SUBVAL=$PIECE(CMPVAL,SS,SUB)
+42 IF SUBVAL'=""
SET DATA(FLD,REP,CMP,SUB)=SUBVAL
End DoDot:4
+43 IF '$DATA(DATA(FLD,REP,CMP))
IF CMPVAL'=""
SET DATA(FLD,REP,CMP)=CMPVAL
End DoDot:3
+44 IF '$DATA(DATA(FLD,REP))
IF REPVAL'=""
IF FLDVAL[RS
SET DATA(FLD,REP)=REPVAL
End DoDot:2
+45 IF '$DATA(DATA(FLD))
IF FLDVAL'=""
SET DATA(FLD)=FLDVAL
End DoDot:1
+46 QUIT
+47 ;
BLDSEG(DATA,HL) ;generic segment builder
+1 ;
+2 ; Input:
+3 ; DATA - field data array [SUB1:field, SUB2:repetition,
+4 ; SUB3:component, SUB4:sub-component]
+5 ; HL - HL7 environment array
+6 ;
+7 ; Output:
+8 ; Function Value - Formatted HL7 segment on success, "" on failure
+9 ;
+10 ;component subscript
NEW CMP
+11 ;component value
NEW CMPVAL
+12 ;field subscript
NEW FLD
+13 ;field value
NEW FLDVAL
+14 ;repetition subscript
NEW REP
+15 ;repetition value
NEW REPVAL
+16 ;sub-component subscript
NEW SUB
+17 ;sub-component value
NEW SUBVAL
+18 ;field separator
NEW FS
+19 ;component separator
NEW CS
+20 ;repetition separator
NEW RS
+21 ;escape character
NEW ES
+22 ;sub-component separator
NEW SS
+23 NEW SEG,SEP
+24 ;
+25 SET FS=HL("FS")
+26 SET CS=$EXTRACT(HL("ECH"))
+27 SET RS=$EXTRACT(HL("ECH"),2)
+28 SET ES=$EXTRACT(HL("ECH"),3)
+29 SET SS=$EXTRACT(HL("ECH"),4)
+30 ;
+31 SET SEG=$GET(DATA(0))
+32 FOR FLD=1:1:$ORDER(DATA(""),-1)
Begin DoDot:1
+33 SET FLDVAL=$GET(DATA(FLD))
SET SEP=FS
+34 SET SEG=SEG_SEP_FLDVAL
+35 FOR REP=1:1:$ORDER(DATA(FLD,""),-1)
Begin DoDot:2
+36 SET REPVAL=$GET(DATA(FLD,REP))
+37 SET SEP=$SELECT(REP=1:"",1:RS)
+38 SET SEG=SEG_SEP_REPVAL
+39 FOR CMP=1:1:$ORDER(DATA(FLD,REP,""),-1)
Begin DoDot:3
+40 SET CMPVAL=$GET(DATA(FLD,REP,CMP))
+41 SET SEP=$SELECT(CMP=1:"",1:CS)
+42 SET SEG=SEG_SEP_CMPVAL
+43 FOR SUB=1:1:$ORDER(DATA(FLD,REP,CMP,""),-1)
Begin DoDot:4
+44 SET SUBVAL=$GET(DATA(FLD,REP,CMP,SUB))
+45 SET SEP=$SELECT(SUB=1:"",1:SS)
+46 SET SEG=SEG_SEP_SUBVAL
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+47 QUIT SEG
+48 ;
BLDWP(WP,SEG,MAXLEN,FORMAT,FMTLEN,HL) ;
+1 ;Builds segment nodes to add word processing fields to a segment
+2 NEW CNT,LINE,LAST,FS,RS,LENGTH,I
+3 IF MAXLEN<1
SET MAXLEN=99999999999999999
+4 ;field separator
SET FS=HL("FS")
+5 ;repeat separator
SET RS=$EXTRACT(HL("ECH"),2)
+6 SET CNT=$ORDER(SEG(""),-1)+1
+7 SET SEG(CNT)=FS
+8 SET FMTLEN=0
+9 SET LENGTH=0
+10 ;
+11 SET I=0
+12 FOR
SET I=$ORDER(WP(I))
if 'I
QUIT
Begin DoDot:1
+13 ;conventional WP field
IF $DATA(WP(I,0))
SET LINE=$GET(WP(I,0))
+14 IF '$TEST
SET LINE=$GET(WP(I))
+15 SET LENGTH=LENGTH+$LENGTH(LINE)
+16 IF LENGTH'<MAXLEN
SET LINE=$EXTRACT(LINE,1,$LENGTH(LINE)-(LENGTH-MAXLEN))
+17 SET LINE=$$ESCAPE(LINE,.HL)
+18 SET LAST=$EXTRACT(LINE,$LENGTH(LINE))
+19 ;first line
+20 IF SEG(CNT)=FS
SET SEG(CNT)=FS_LINE
SET FMTLEN=FMTLEN+$LENGTH(SEG(CNT))
QUIT
+21 SET CNT=CNT+1
+22 SET SEG(CNT)=RS_LINE
SET FMTLEN=FMTLEN+$LENGTH(SEG(CNT))
+23 if 'FORMAT
QUIT
+24 ;attempt to keep sentences together
+25 IF $EXTRACT(LINE)=" "!(LAST=" ")
SET SEG(CNT)=LINE
SET FMTLEN=FMTLEN+$LENGTH(LINE)
+26 QUIT
End DoDot:1
if LENGTH'<MAXLEN
QUIT
+27 QUIT
+28 ;
ESCAPE(VAL,HL) ;Escape any special characters
+1 ; *** Does not handle long strings of special characters ***
+2 ;
+3 ; Input:
+4 ; VAL - value to escape
+5 ; HL - HL7 environment array
+6 ;
+7 ; Output:
+8 ; VAL - passed by reference
+9 ;
+10 ;field separator
NEW FS
+11 ;component separator
NEW CS
+12 ;repetition separator
NEW RS
+13 ;escape character
NEW ES
+14 ;sub-component separator
NEW SS
+15 NEW L,STR,I
+16 ;
+17 SET FS=HL("FS")
+18 SET CS=$EXTRACT(HL("ECH"))
+19 SET RS=$EXTRACT(HL("ECH"),2)
+20 SET ES=$EXTRACT(HL("ECH"),3)
+21 SET SS=$EXTRACT(HL("ECH"),4)
+22 ;
+23 IF VAL[ES
Begin DoDot:1
+24 SET L=$LENGTH(VAL,ES)
SET STR=""
+25 FOR I=1:1:L
SET $PIECE(STR,ES_"E"_ES,I)=$PIECE(VAL,ES,I)
+26 SET VAL=STR
End DoDot:1
+27 IF VAL[FS
Begin DoDot:1
+28 SET L=$LENGTH(VAL,FS)
SET STR=""
+29 FOR I=1:1:L
SET $PIECE(STR,ES_"F"_ES,I)=$PIECE(VAL,FS,I)
+30 SET VAL=STR
End DoDot:1
+31 IF VAL[RS
Begin DoDot:1
+32 SET L=$LENGTH(VAL,RS)
SET STR=""
+33 FOR I=1:1:L
SET $PIECE(STR,ES_"R"_ES,I)=$PIECE(VAL,RS,I)
+34 SET VAL=STR
End DoDot:1
+35 IF VAL[CS
Begin DoDot:1
+36 SET L=$LENGTH(VAL,CS)
SET STR=""
+37 FOR I=1:1:L
SET $PIECE(STR,ES_"S"_ES,I)=$PIECE(VAL,CS,I)
+38 SET VAL=STR
End DoDot:1
+39 IF VAL[SS
Begin DoDot:1
+40 SET L=$LENGTH(VAL,SS)
SET STR=""
+41 FOR I=1:1:L
SET $PIECE(STR,ES_"T"_ES,I)=$PIECE(VAL,SS,I)
+42 SET VAL=STR
End DoDot:1
+43 QUIT VAL
+44 ;
UNESC(VAL,HL) ;Reconstitute any escaped characters
+1 ;
+2 ; Input:
+3 ; VAL - Value to reconstitute
+4 ; HL - HL7 environment array
+5 ;
+6 ; Output:
+7 ; VAL - passed by reference
+8 ;
+9 ;field separator
NEW FS
+10 ;component separator
NEW CS
+11 ;repetition separator
NEW RS
+12 ;escape character
NEW ES
+13 ;sub-component separator
NEW SS
+14 NEW L,STR,I,FESC,CESC,RESC,EESC,SESC
+15 ;
+16 SET FS=HL("FS")
+17 SET CS=$EXTRACT(HL("ECH"))
+18 SET RS=$EXTRACT(HL("ECH"),2)
+19 SET ES=$EXTRACT(HL("ECH"),3)
+20 SET SS=$EXTRACT(HL("ECH"),4)
+21 SET FESC=ES_"F"_ES
+22 SET CESC=ES_"S"_ES
+23 SET RESC=ES_"R"_ES
+24 SET EESC=ES_"E"_ES
+25 SET SESC=ES_"T"_ES
+26 ;
+27 IF VAL'[ES
QUIT VAL
+28 IF VAL[FESC
Begin DoDot:1
+29 SET L=$LENGTH(VAL,FESC)
SET STR=""
+30 FOR I=1:1:L
SET $PIECE(STR,FS,I)=$PIECE(VAL,FESC,I)
+31 SET VAL=STR
End DoDot:1
+32 IF VAL[CESC
Begin DoDot:1
+33 SET L=$LENGTH(VAL,CESC)
SET STR=""
+34 FOR I=1:1:L
SET $PIECE(STR,CS,I)=$PIECE(VAL,CESC,I)
+35 SET VAL=STR
End DoDot:1
+36 IF VAL[RESC
Begin DoDot:1
+37 SET L=$LENGTH(VAL,RESC)
SET STR=""
+38 FOR I=1:1:L
SET $PIECE(STR,RS,I)=$PIECE(VAL,RESC,I)
+39 SET VAL=STR
End DoDot:1
+40 IF VAL[SESC
Begin DoDot:1
+41 SET L=$LENGTH(VAL,SESC)
SET STR=""
+42 FOR I=1:1:L
SET $PIECE(STR,SS,I)=$PIECE(VAL,SESC,I)
+43 SET VAL=STR
End DoDot:1
+44 IF VAL[EESC
Begin DoDot:1
+45 SET L=$LENGTH(VAL,EESC)
SET STR=""
+46 FOR I=1:1:L
SET $PIECE(STR,ES,I)=$PIECE(VAL,EESC,I)
+47 SET VAL=STR
End DoDot:1
+48 QUIT VAL
+49 ;
