| 1 | MHV7U ;WAS/GPM - HL7 UTILITIES ; [4/19/06 12:41pm]
|
|---|
| 2 | ;;1.0;My HealtheVet;**1**;Aug 23, 2005
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;This routine contains generic utilities used when building
|
|---|
| 6 | ;or processing HL7 messages.
|
|---|
| 7 | ;
|
|---|
| 8 | Q ;Direct entry not supported
|
|---|
| 9 | ;
|
|---|
| 10 | LOADMSG(MSGROOT) ; Load HL7 message into temporary global for processing
|
|---|
| 11 | ;
|
|---|
| 12 | ;This subroutine assumes that all VistA HL7 environment variables are
|
|---|
| 13 | ;properly initialized and will produce a fatal error if they aren't.
|
|---|
| 14 | ;
|
|---|
| 15 | N CNT,SEG
|
|---|
| 16 | K @MSGROOT
|
|---|
| 17 | F SEG=1:1 X HLNEXT Q:HLQUIT'>0 D
|
|---|
| 18 | . S CNT=0
|
|---|
| 19 | . S @MSGROOT@(SEG,CNT)=HLNODE
|
|---|
| 20 | . F S CNT=$O(HLNODE(CNT)) Q:'CNT S @MSGROOT@(SEG,CNT)=HLNODE(CNT)
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | PARSEMSG(MSGROOT,HL) ; Message Parser
|
|---|
| 24 | ; Does not handle segments that span nodes
|
|---|
| 25 | ; Does not handle extremely long segments (uses a local)
|
|---|
| 26 | ; Does not handle long fields (segment parser doesn't)
|
|---|
| 27 | ;
|
|---|
| 28 | N SEG,CNT,DATA,MSG
|
|---|
| 29 | F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D
|
|---|
| 30 | . D PARSESEG(SEG(0),.DATA,.HL)
|
|---|
| 31 | . K @MSGROOT@(CNT)
|
|---|
| 32 | . I DATA(0)'="" M @MSGROOT@(CNT)=DATA
|
|---|
| 33 | . Q:'$D(SEG(1))
|
|---|
| 34 | . ;Add handler for segments that span nodes here.
|
|---|
| 35 | . Q
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | LOG(NAME,DATA,TYPE,NEW) ;Log to MHV application log
|
|---|
| 39 | ;
|
|---|
| 40 | ; Input:
|
|---|
| 41 | ; NAME - Name to identify log line
|
|---|
| 42 | ; DATA - Value,Tree, or Name of structure to put in log
|
|---|
| 43 | ; TYPE - Type of log entry
|
|---|
| 44 | ; S:Set Single Value
|
|---|
| 45 | ; M:Merge Tree
|
|---|
| 46 | ; I:Indirect Merge @
|
|---|
| 47 | ; NEW - Flag to create new log entry
|
|---|
| 48 | ;
|
|---|
| 49 | ; Output:
|
|---|
| 50 | ; Updates log
|
|---|
| 51 | ;
|
|---|
| 52 | ; ^XTMP("MHV7LOG",0) - Head of log file
|
|---|
| 53 | ; ^XTMP("MHV7LOG",1) - if set indicates that logging is on
|
|---|
| 54 | ; ^XTMP("MHV7LOG",2) - contains the log
|
|---|
| 55 | ; ^XTMP("MHV7LOG",2,negated FM timestamp,$J,counter,NAME) - log entry
|
|---|
| 56 | ;
|
|---|
| 57 | ; ^TMP("MHV7LOG",$J) - Session current log entry (DTM)
|
|---|
| 58 | ;
|
|---|
| 59 | ;Quit if logging is not turned on
|
|---|
| 60 | Q:'$G(^XTMP("MHV7LOG",1))
|
|---|
| 61 | N DTM,CNT
|
|---|
| 62 | ;
|
|---|
| 63 | Q:'$D(DATA)
|
|---|
| 64 | Q:$G(TYPE)=""
|
|---|
| 65 | Q:$G(NAME)=""
|
|---|
| 66 | S NAME=$TR(NAME,"^","-")
|
|---|
| 67 | ;
|
|---|
| 68 | ; Check ^TMP("MHV7LOG",$J) If no current log node start a new node
|
|---|
| 69 | I '$G(^TMP("MHV7LOG",$J)) S NEW=1
|
|---|
| 70 | ;
|
|---|
| 71 | I $G(NEW) D
|
|---|
| 72 | . S DTM=-$$NOW^XLFDT()
|
|---|
| 73 | . K ^XTMP("MHV7LOG",2,DTM,$J)
|
|---|
| 74 | . S ^TMP("MHV7LOG",$J)=DTM
|
|---|
| 75 | . S CNT=1
|
|---|
| 76 | . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT
|
|---|
| 77 | . D AUTOPRG
|
|---|
| 78 | . Q
|
|---|
| 79 | E D
|
|---|
| 80 | . S DTM=^TMP("MHV7LOG",$J)
|
|---|
| 81 | . S CNT=$G(^XTMP("MHV7LOG",2,DTM,$J))+1
|
|---|
| 82 | . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT
|
|---|
| 83 | . Q
|
|---|
| 84 | ;
|
|---|
| 85 | I TYPE="S" S ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q
|
|---|
| 86 | I TYPE="M" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q
|
|---|
| 87 | I TYPE="I" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=@DATA Q
|
|---|
| 88 | ;
|
|---|
| 89 | Q
|
|---|
| 90 | ;
|
|---|
| 91 | AUTOPRG ;
|
|---|
| 92 | Q:'$G(^XTMP("MHV7LOG",1,"AUTOPURGE"))
|
|---|
| 93 | N DT,DAYS,RESULT
|
|---|
| 94 | ; Purge only once per day
|
|---|
| 95 | S DT=$$DT^XLFDT
|
|---|
| 96 | Q:$G(^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE"))=DT
|
|---|
| 97 | ;
|
|---|
| 98 | S DAYS=$G(^XTMP("MHV7LOG",1,"AUTOPURGE","DAYS"))
|
|---|
| 99 | I DAYS<1 S DAYS=7
|
|---|
| 100 | ;*** Consider tasking the purge
|
|---|
| 101 | D LOGPRG^MHVUL1(.RESULT,$$HTFM^XLFDT($H-DAYS,1))
|
|---|
| 102 | S ^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE")=DT
|
|---|
| 103 | Q
|
|---|
| 104 | ;
|
|---|
| 105 | TRIMSPC(STR) ;Trim leading and trailing spaces from a text string
|
|---|
| 106 | ;
|
|---|
| 107 | ; Input:
|
|---|
| 108 | ; STR - Text string
|
|---|
| 109 | ;
|
|---|
| 110 | ; Output:
|
|---|
| 111 | ; Function Value - Input text string with leading and trailing
|
|---|
| 112 | ; spaces removed
|
|---|
| 113 | ;
|
|---|
| 114 | N SPACE,POS,LEN
|
|---|
| 115 | S SPACE=$C(32)
|
|---|
| 116 | S LEN=$L(STR)
|
|---|
| 117 | S POS=1
|
|---|
| 118 | F Q:$E(STR,POS)'=SPACE!(POS>LEN) S POS=POS+1
|
|---|
| 119 | S STR=$E(STR,POS,LEN)
|
|---|
| 120 | S POS=$L(STR)
|
|---|
| 121 | F Q:$E(STR,POS)'=SPACE!(POS<1) S POS=POS-1
|
|---|
| 122 | S STR=$E(STR,1,POS)
|
|---|
| 123 | Q STR
|
|---|
| 124 | ;
|
|---|
| 125 | PARSESEG(SEG,DATA,HL) ;Generic segment parser
|
|---|
| 126 | ;This procedure parses a single HL7 segment and builds an array
|
|---|
| 127 | ;subscripted by the field number containing the data for that field.
|
|---|
| 128 | ; Does not handle segments that span nodes
|
|---|
| 129 | ;
|
|---|
| 130 | ; Input:
|
|---|
| 131 | ; SEG - HL7 segment to parse
|
|---|
| 132 | ; HL - HL7 environment array
|
|---|
| 133 | ;
|
|---|
| 134 | ; Output:
|
|---|
| 135 | ; Function value - field data array [SUB1:field, SUB2:repetition,
|
|---|
| 136 | ; SUB3:component, SUB4:sub-component]
|
|---|
| 137 | ;
|
|---|
| 138 | N CMP ;component subscript
|
|---|
| 139 | N CMPVAL ;component value
|
|---|
| 140 | N FLD ;field subscript
|
|---|
| 141 | N FLDVAL ;field value
|
|---|
| 142 | N REP ;repetition subscript
|
|---|
| 143 | N REPVAL ;repetition value
|
|---|
| 144 | N SUB ;sub-component subscript
|
|---|
| 145 | N SUBVAL ;sub-component value
|
|---|
| 146 | N FS ;field separator
|
|---|
| 147 | N CS ;component separator
|
|---|
| 148 | N RS ;repetition separator
|
|---|
| 149 | N SS ;sub-component separator
|
|---|
| 150 | ;
|
|---|
| 151 | K DATA
|
|---|
| 152 | S FS=HL("FS")
|
|---|
| 153 | S CS=$E(HL("ECH"))
|
|---|
| 154 | S RS=$E(HL("ECH"),2)
|
|---|
| 155 | S SS=$E(HL("ECH"),4)
|
|---|
| 156 | ;
|
|---|
| 157 | S DATA(0)=$P(SEG,FS)
|
|---|
| 158 | S SEG=$P(SEG,FS,2,9999)
|
|---|
| 159 | F FLD=1:1:$L(SEG,FS) D
|
|---|
| 160 | . S FLDVAL=$P(SEG,FS,FLD)
|
|---|
| 161 | . F REP=1:1:$L(FLDVAL,RS) D
|
|---|
| 162 | . . S REPVAL=$P(FLDVAL,RS,REP)
|
|---|
| 163 | . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D
|
|---|
| 164 | . . . S CMPVAL=$P(REPVAL,CS,CMP)
|
|---|
| 165 | . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D
|
|---|
| 166 | . . . . S SUBVAL=$P(CMPVAL,SS,SUB)
|
|---|
| 167 | . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL
|
|---|
| 168 | . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL
|
|---|
| 169 | . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL
|
|---|
| 170 | . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL
|
|---|
| 171 | Q
|
|---|
| 172 | ;
|
|---|
| 173 | BLDSEG(DATA,HL) ;generic segment builder
|
|---|
| 174 | ;
|
|---|
| 175 | ; Input:
|
|---|
| 176 | ; DATA - field data array [SUB1:field, SUB2:repetition,
|
|---|
| 177 | ; SUB3:component, SUB4:sub-component]
|
|---|
| 178 | ; HL - HL7 environment array
|
|---|
| 179 | ;
|
|---|
| 180 | ; Output:
|
|---|
| 181 | ; Function Value - Formatted HL7 segment on success, "" on failure
|
|---|
| 182 | ;
|
|---|
| 183 | N CMP ;component subscript
|
|---|
| 184 | N CMPVAL ;component value
|
|---|
| 185 | N FLD ;field subscript
|
|---|
| 186 | N FLDVAL ;field value
|
|---|
| 187 | N REP ;repetition subscript
|
|---|
| 188 | N REPVAL ;repetition value
|
|---|
| 189 | N SUB ;sub-component subscript
|
|---|
| 190 | N SUBVAL ;sub-component value
|
|---|
| 191 | N FS ;field separator
|
|---|
| 192 | N CS ;component separator
|
|---|
| 193 | N RS ;repetition separator
|
|---|
| 194 | N ES ;escape character
|
|---|
| 195 | N SS ;sub-component separator
|
|---|
| 196 | N SEG,SEP
|
|---|
| 197 | ;
|
|---|
| 198 | S FS=HL("FS")
|
|---|
| 199 | S CS=$E(HL("ECH"))
|
|---|
| 200 | S RS=$E(HL("ECH"),2)
|
|---|
| 201 | S ES=$E(HL("ECH"),3)
|
|---|
| 202 | S SS=$E(HL("ECH"),4)
|
|---|
| 203 | ;
|
|---|
| 204 | S SEG=$G(DATA(0))
|
|---|
| 205 | F FLD=1:1:$O(DATA(""),-1) D
|
|---|
| 206 | . S FLDVAL=$G(DATA(FLD)),SEP=FS
|
|---|
| 207 | . S SEG=SEG_SEP_FLDVAL
|
|---|
| 208 | . F REP=1:1:$O(DATA(FLD,""),-1) D
|
|---|
| 209 | . . S REPVAL=$G(DATA(FLD,REP))
|
|---|
| 210 | . . S SEP=$S(REP=1:"",1:RS)
|
|---|
| 211 | . . S SEG=SEG_SEP_REPVAL
|
|---|
| 212 | . . F CMP=1:1:$O(DATA(FLD,REP,""),-1) D
|
|---|
| 213 | . . . S CMPVAL=$G(DATA(FLD,REP,CMP))
|
|---|
| 214 | . . . S SEP=$S(CMP=1:"",1:CS)
|
|---|
| 215 | . . . S SEG=SEG_SEP_CMPVAL
|
|---|
| 216 | . . . F SUB=1:1:$O(DATA(FLD,REP,CMP,""),-1) D
|
|---|
| 217 | . . . . S SUBVAL=$G(DATA(FLD,REP,CMP,SUB))
|
|---|
| 218 | . . . . S SEP=$S(SUB=1:"",1:SS)
|
|---|
| 219 | . . . . S SEG=SEG_SEP_SUBVAL
|
|---|
| 220 | Q SEG
|
|---|
| 221 | ;
|
|---|
| 222 | BLDWPSEG(WP,SEG,MAXLEN,HL) ;
|
|---|
| 223 | ;Builds segment nodes to add word processing fields to a segment
|
|---|
| 224 | N CNT,LINE,LAST,FS,RS,LENGTH
|
|---|
| 225 | I MAXLEN<1 S MAXLEN=999999999999
|
|---|
| 226 | S FS=HL("FS") ;field separator
|
|---|
| 227 | S RS=$E(HL("ECH"),2) ;repeat separator
|
|---|
| 228 | S CNT=$O(SEG(""),-1)+1
|
|---|
| 229 | S LINE=$O(WP(0))
|
|---|
| 230 | S LENGTH=$L(LINE)
|
|---|
| 231 | S SEG(CNT)=""
|
|---|
| 232 | S SEG(CNT)=FS_$$ESCAPE($G(WP(LINE,0)),.HL)
|
|---|
| 233 | F S LINE=$O(WP(LINE)) Q:LINE="" D Q:LENGTH'<MAXLEN
|
|---|
| 234 | . S LENGTH=LENGTH+$L(LINE)
|
|---|
| 235 | . I LENGTH'<MAXLEN S LINE=$E(LINE,1,$L(LINE)-(LENGTH-MAXLEN))
|
|---|
| 236 | . S LAST=$E(SEG(CNT),$L(SEG(CNT)))
|
|---|
| 237 | . S CNT=CNT+1
|
|---|
| 238 | . S SEG(CNT)=$$ESCAPE($G(WP(LINE,0)),.HL)
|
|---|
| 239 | . I $E(SEG(CNT))'=" ",LAST'=" " S SEG(CNT)=RS_SEG(CNT)
|
|---|
| 240 | . Q
|
|---|
| 241 | Q
|
|---|
| 242 | ;
|
|---|
| 243 | ADD(VAL,SEP,SEG) ;append a value onto segment
|
|---|
| 244 | ;
|
|---|
| 245 | ; Input:
|
|---|
| 246 | ; VAL - value to append
|
|---|
| 247 | ; SEP - HL7 separator
|
|---|
| 248 | ;
|
|---|
| 249 | ; Output:
|
|---|
| 250 | ; SEG - segment passed by reference
|
|---|
| 251 | ;
|
|---|
| 252 | S SEP=$G(SEP)
|
|---|
| 253 | S VAL=$G(VAL)
|
|---|
| 254 | ; Escape VAL??
|
|---|
| 255 | ; If exceed 512 characters don't add
|
|---|
| 256 | S SEG=SEG_SEP_VAL
|
|---|
| 257 | Q
|
|---|
| 258 | ;
|
|---|
| 259 | ESCAPE(VAL,HL) ;Escape any special characters
|
|---|
| 260 | ; *** Does not handle long strings of special characters ***
|
|---|
| 261 | ;
|
|---|
| 262 | ; Input:
|
|---|
| 263 | ; VAL - value to escape
|
|---|
| 264 | ; HL - HL7 environment array
|
|---|
| 265 | ;
|
|---|
| 266 | ; Output:
|
|---|
| 267 | ; VAL - passed by reference
|
|---|
| 268 | ;
|
|---|
| 269 | N FS ;field separator
|
|---|
| 270 | N CS ;component separator
|
|---|
| 271 | N RS ;repetition separator
|
|---|
| 272 | N ES ;escape character
|
|---|
| 273 | N SS ;sub-component separator
|
|---|
| 274 | N L,STR,I
|
|---|
| 275 | ;
|
|---|
| 276 | S FS=HL("FS")
|
|---|
| 277 | S CS=$E(HL("ECH"))
|
|---|
| 278 | S RS=$E(HL("ECH"),2)
|
|---|
| 279 | S ES=$E(HL("ECH"),3)
|
|---|
| 280 | S SS=$E(HL("ECH"),4)
|
|---|
| 281 | ;
|
|---|
| 282 | I VAL[ES D
|
|---|
| 283 | . S L=$L(VAL,ES),STR=""
|
|---|
| 284 | . F I=1:1:L S $P(STR,ES_"E"_ES,I)=$P(VAL,ES,I)
|
|---|
| 285 | . S VAL=STR
|
|---|
| 286 | I VAL[FS D
|
|---|
| 287 | . S L=$L(VAL,FS),STR=""
|
|---|
| 288 | . F I=1:1:L S $P(STR,ES_"F"_ES,I)=$P(VAL,FS,I)
|
|---|
| 289 | . S VAL=STR
|
|---|
| 290 | I VAL[RS D
|
|---|
| 291 | . S L=$L(VAL,RS),STR=""
|
|---|
| 292 | . F I=1:1:L S $P(STR,ES_"R"_ES,I)=$P(VAL,RS,I)
|
|---|
| 293 | . S VAL=STR
|
|---|
| 294 | I VAL[CS D
|
|---|
| 295 | . S L=$L(VAL,CS),STR=""
|
|---|
| 296 | . F I=1:1:L S $P(STR,ES_"S"_ES,I)=$P(VAL,CS,I)
|
|---|
| 297 | . S VAL=STR
|
|---|
| 298 | I VAL[SS D
|
|---|
| 299 | . S L=$L(VAL,SS),STR=""
|
|---|
| 300 | . F I=1:1:L S $P(STR,ES_"T"_ES,I)=$P(VAL,SS,I)
|
|---|
| 301 | . S VAL=STR
|
|---|
| 302 | Q VAL
|
|---|
| 303 | ;
|
|---|
| 304 | UNESC(VAL,HL) ;Reconstitute any escaped characters
|
|---|
| 305 | ;
|
|---|
| 306 | ; Input:
|
|---|
| 307 | ; VAL - Value to reconstitute
|
|---|
| 308 | ; HL - HL7 environment array
|
|---|
| 309 | ;
|
|---|
| 310 | ; Output:
|
|---|
| 311 | ; VAL - passed by reference
|
|---|
| 312 | ;
|
|---|
| 313 | N FS ;field separator
|
|---|
| 314 | N CS ;component separator
|
|---|
| 315 | N RS ;repetition separator
|
|---|
| 316 | N ES ;escape character
|
|---|
| 317 | N SS ;sub-component separator
|
|---|
| 318 | N L,STR,I,FESC,CESC,RESC,EESC,SESC
|
|---|
| 319 | ;
|
|---|
| 320 | S FS=HL("FS")
|
|---|
| 321 | S CS=$E(HL("ECH"))
|
|---|
| 322 | S RS=$E(HL("ECH"),2)
|
|---|
| 323 | S ES=$E(HL("ECH"),3)
|
|---|
| 324 | S SS=$E(HL("ECH"),4)
|
|---|
| 325 | S FESC=ES_"F"_ES
|
|---|
| 326 | S CESC=ES_"S"_ES
|
|---|
| 327 | S RESC=ES_"R"_ES
|
|---|
| 328 | S EESC=ES_"E"_ES
|
|---|
| 329 | S SESC=ES_"T"_ES
|
|---|
| 330 | ;
|
|---|
| 331 | I VAL'[ES Q VAL
|
|---|
| 332 | I VAL[FESC D
|
|---|
| 333 | . S L=$L(VAL,FESC),STR=""
|
|---|
| 334 | . F I=1:1:L S $P(STR,FS,I)=$P(VAL,FESC,I)
|
|---|
| 335 | . S VAL=STR
|
|---|
| 336 | I VAL[CESC D
|
|---|
| 337 | . S L=$L(VAL,CESC),STR=""
|
|---|
| 338 | . F I=1:1:L S $P(STR,CS,I)=$P(VAL,CESC,I)
|
|---|
| 339 | . S VAL=STR
|
|---|
| 340 | I VAL[RESC D
|
|---|
| 341 | . S L=$L(VAL,RESC),STR=""
|
|---|
| 342 | . F I=1:1:L S $P(STR,RS,I)=$P(VAL,RESC,I)
|
|---|
| 343 | . S VAL=STR
|
|---|
| 344 | I VAL[SESC D
|
|---|
| 345 | . S L=$L(VAL,SESC),STR=""
|
|---|
| 346 | . F I=1:1:L S $P(STR,SS,I)=$P(VAL,SESC,I)
|
|---|
| 347 | . S VAL=STR
|
|---|
| 348 | I VAL[EESC D
|
|---|
| 349 | . S L=$L(VAL,EESC),STR=""
|
|---|
| 350 | . F I=1:1:L S $P(STR,ES,I)=$P(VAL,EESC,I)
|
|---|
| 351 | . S VAL=STR
|
|---|
| 352 | Q VAL
|
|---|
| 353 | ;
|
|---|
