- 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 ;