354 lines
9.0 KiB
Mathematica
354 lines
9.0 KiB
Mathematica
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
|
|
;
|