Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MHV7U

MHV7U.m

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