Index: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7U.m
===================================================================
--- WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7U.m	(revision 613)
+++ WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7U.m	(revision 623)
@@ -1,300 +1,353 @@
-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
-	;
+MHV7U ;WAS/GPM - HL7 UTILITIES ; [4/19/06 12:41pm]
+ ;;1.0;My HealtheVet;**1**;Aug 23, 2005
+ ;;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
+ ;
+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
+ ;
+LOG(NAME,DATA,TYPE,NEW) ;Log to MHV application log
+ ;
+ ;  Input:
+ ;    NAME - Name to identify log line
+ ;    DATA - Value,Tree, or Name of structure to put in log
+ ;    TYPE - Type of log entry
+ ;              S:Set Single Value
+ ;              M:Merge Tree 
+ ;              I:Indirect Merge @
+ ;     NEW - Flag to create new log entry
+ ;
+ ;  Output:
+ ;    Updates log
+ ;
+ ; ^XTMP("MHV7LOG",0) - Head of log file
+ ; ^XTMP("MHV7LOG",1) - if set indicates that logging is on
+ ; ^XTMP("MHV7LOG",2) - contains the log
+ ; ^XTMP("MHV7LOG",2,negated FM timestamp,$J,counter,NAME) - log entry
+ ;
+ ; ^TMP("MHV7LOG",$J) - Session current log entry (DTM)
+ ;
+ ;Quit if logging is not turned on
+ Q:'$G(^XTMP("MHV7LOG",1))
+ N DTM,CNT
+ ;
+ Q:'$D(DATA)
+ Q:$G(TYPE)=""
+ Q:$G(NAME)=""
+ S NAME=$TR(NAME,"^","-")
+ ;
+ ; Check ^TMP("MHV7LOG",$J) If no current log node start a new node
+ I '$G(^TMP("MHV7LOG",$J)) S NEW=1
+ ;
+ I $G(NEW) D
+ . S DTM=-$$NOW^XLFDT()
+ . K ^XTMP("MHV7LOG",2,DTM,$J)
+ . S ^TMP("MHV7LOG",$J)=DTM
+ . S CNT=1
+ . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT
+ . D AUTOPRG
+ . Q
+ E  D
+ . S DTM=^TMP("MHV7LOG",$J)
+ . S CNT=$G(^XTMP("MHV7LOG",2,DTM,$J))+1
+ . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT
+ . Q
+ ;
+ I TYPE="S" S ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q
+ I TYPE="M" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q
+ I TYPE="I" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=@DATA Q
+ ;
+ Q
+ ;
+AUTOPRG ;
+ Q:'$G(^XTMP("MHV7LOG",1,"AUTOPURGE"))
+ N DT,DAYS,RESULT
+ ; Purge only once per day
+ S DT=$$DT^XLFDT
+ Q:$G(^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE"))=DT
+ ;
+ S DAYS=$G(^XTMP("MHV7LOG",1,"AUTOPURGE","DAYS"))
+ I DAYS<1 S DAYS=7
+ ;*** Consider tasking the purge
+ D LOGPRG^MHVUL1(.RESULT,$$HTFM^XLFDT($H-DAYS,1))
+ S ^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE")=DT
+ Q
+ ;
+TRIMSPC(STR) ;Trim leading and trailing spaces from a text string
+ ;
+ ;  Input:
+ ;    STR - Text string
+ ;
+ ;  Output:
+ ;    Function Value - Input text string with leading and trailing
+ ;                    spaces removed
+ ;
+ N SPACE,POS,LEN
+ S SPACE=$C(32)
+ S LEN=$L(STR)
+ S POS=1
+ F  Q:$E(STR,POS)'=SPACE!(POS>LEN)  S POS=POS+1
+ S STR=$E(STR,POS,LEN)
+ S POS=$L(STR)
+ F  Q:$E(STR,POS)'=SPACE!(POS<1)  S POS=POS-1
+ S STR=$E(STR,1,POS)
+ Q STR
+ ;
+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
+ ;
+BLDWPSEG(WP,SEG,MAXLEN,HL) ;
+ ;Builds segment nodes to add word processing fields to a segment
+ N CNT,LINE,LAST,FS,RS,LENGTH
+ I MAXLEN<1 S MAXLEN=999999999999
+ S FS=HL("FS")         ;field separator
+ S RS=$E(HL("ECH"),2)  ;repeat separator
+ S CNT=$O(SEG(""),-1)+1
+ S LINE=$O(WP(0))
+ S LENGTH=$L(LINE)
+ S SEG(CNT)=""
+ S SEG(CNT)=FS_$$ESCAPE($G(WP(LINE,0)),.HL)
+ F  S LINE=$O(WP(LINE)) Q:LINE=""  D  Q:LENGTH'<MAXLEN
+ . S LENGTH=LENGTH+$L(LINE)
+ . I LENGTH'<MAXLEN S LINE=$E(LINE,1,$L(LINE)-(LENGTH-MAXLEN))
+ . S LAST=$E(SEG(CNT),$L(SEG(CNT)))
+ . S CNT=CNT+1
+ . S SEG(CNT)=$$ESCAPE($G(WP(LINE,0)),.HL)
+ . I $E(SEG(CNT))'=" ",LAST'=" " S SEG(CNT)=RS_SEG(CNT)
+ . Q
+ Q
+ ;
+ADD(VAL,SEP,SEG) ;append a value onto segment
+ ;
+ ;  Input:
+ ;    VAL - value to append
+ ;    SEP - HL7 separator
+ ;
+ ;  Output:
+ ;    SEG - segment passed by reference
+ ;
+ S SEP=$G(SEP)
+ S VAL=$G(VAL)
+ ; Escape VAL??
+ ; If exceed 512 characters don't add
+ S SEG=SEG_SEP_VAL
+ 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
+ ;
