Changeset 623 for WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7U.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7U.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7U.m
r613 r623 1 MHV7U ;WAS/GPM - HL7 UTILITIES ; [1/7/08 10:21pm] 2 ;;1.0;My HealtheVet;**1,2**;Aug 23, 2005;Build 22 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 LOADXMT(XMT) ;Set HL dependent XMT values 24 ; 25 ; The HL array and variables are expected to be defined. If not, 26 ; message processing will fail. These references should not be 27 ; wrapped in $G, as null values will simply postpone the failure to 28 ; a point that will be harder to diagnose. Except HL("APAT") which 29 ; is not defined on synchronous calls. 30 ; Also assumes MHV RESPONSE MAP file is setup for every protocol 31 ; pair defined by MHV package. 32 ; 33 ; Integration Agreements: 34 ; 1373 : Reference to PROTOCOL file #101 35 ; 36 N SUBPROT,RESPIEN,RESP0 37 S XMT("MID")=HL("MID") ;Message ID 38 S XMT("MODE")="A" ;Response mode 39 I $G(HL("APAT"))="" S XMT("MODE")="S" ;Synchronous mode 40 S XMT("HLMTIENS")=HLMTIENS ;Message IEN 41 S XMT("MESSAGE TYPE")=HL("MTN") ;Message type 42 S XMT("EVENT TYPE")=HL("ETN") ;Event type 43 S XMT("DELIM")=HL("FS")_HL("ECH") ;HL Delimiters 44 S XMT("MAX SIZE")=0 ;Default size unlimited 45 ; 46 ; Map response protocol and builder 47 S SUBPROT=$P(^ORD(101,HL("EIDS"),0),"^") 48 S RESPIEN=$O(^MHV(2275.4,"B",SUBPROT,0)) 49 S RESP0=$G(^MHV(2275.4,RESPIEN,0)) 50 S XMT("PROTOCOL")=$P(RESP0,"^",2) ;Response Protocol 51 S XMT("BUILDER")=$TR($P(RESP0,"^",3),"~","^") ;Response Builder 52 S XMT("BREAK SEGMENT")=$P(RESP0,"^",4) ;Boundary Segment 53 Q 54 ; 55 DELIM(PROTOCOL) ;Return string of message delimiters based on Protocol 56 ; 57 ; Integration Agreements: 58 ; 2161 : INIT^HLFNC2 59 ; 60 N HL 61 Q:PROTOCOL="" "" 62 D INIT^HLFNC2(PROTOCOL,.HL) 63 Q $G(HL("FS"))_$G(HL("ECH")) 64 ; 65 PARSEMSG(MSGROOT,HL) ; Message Parser 66 ; Does not handle segments that span nodes 67 ; Does not handle extremely long segments (uses a local) 68 ; Does not handle long fields (segment parser doesn't) 69 ; 70 N SEG,CNT,DATA,MSG 71 F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D 72 . D PARSESEG(SEG(0),.DATA,.HL) 73 . K @MSGROOT@(CNT) 74 . I DATA(0)'="" M @MSGROOT@(CNT)=DATA 75 . Q:'$D(SEG(1)) 76 . ;Add handler for segments that span nodes here. 77 . Q 78 Q 79 ; 80 PARSESEG(SEG,DATA,HL) ;Generic segment parser 81 ;This procedure parses a single HL7 segment and builds an array 82 ;subscripted by the field number containing the data for that field. 83 ; Does not handle segments that span nodes 84 ; 85 ; Input: 86 ; SEG - HL7 segment to parse 87 ; HL - HL7 environment array 88 ; 89 ; Output: 90 ; Function value - field data array [SUB1:field, SUB2:repetition, 91 ; SUB3:component, SUB4:sub-component] 92 ; 93 N CMP ;component subscript 94 N CMPVAL ;component value 95 N FLD ;field subscript 96 N FLDVAL ;field value 97 N REP ;repetition subscript 98 N REPVAL ;repetition value 99 N SUB ;sub-component subscript 100 N SUBVAL ;sub-component value 101 N FS ;field separator 102 N CS ;component separator 103 N RS ;repetition separator 104 N SS ;sub-component separator 105 ; 106 K DATA 107 S FS=HL("FS") 108 S CS=$E(HL("ECH")) 109 S RS=$E(HL("ECH"),2) 110 S SS=$E(HL("ECH"),4) 111 ; 112 S DATA(0)=$P(SEG,FS) 113 S SEG=$P(SEG,FS,2,9999) 114 F FLD=1:1:$L(SEG,FS) D 115 . S FLDVAL=$P(SEG,FS,FLD) 116 . F REP=1:1:$L(FLDVAL,RS) D 117 . . S REPVAL=$P(FLDVAL,RS,REP) 118 . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D 119 . . . S CMPVAL=$P(REPVAL,CS,CMP) 120 . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D 121 . . . . S SUBVAL=$P(CMPVAL,SS,SUB) 122 . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL 123 . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL 124 . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL 125 . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL 126 Q 127 ; 128 BLDSEG(DATA,HL) ;generic segment builder 129 ; 130 ; Input: 131 ; DATA - field data array [SUB1:field, SUB2:repetition, 132 ; SUB3:component, SUB4:sub-component] 133 ; HL - HL7 environment array 134 ; 135 ; Output: 136 ; Function Value - Formatted HL7 segment on success, "" on failure 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 ES ;escape character 150 N SS ;sub-component separator 151 N SEG,SEP 152 ; 153 S FS=HL("FS") 154 S CS=$E(HL("ECH")) 155 S RS=$E(HL("ECH"),2) 156 S ES=$E(HL("ECH"),3) 157 S SS=$E(HL("ECH"),4) 158 ; 159 S SEG=$G(DATA(0)) 160 F FLD=1:1:$O(DATA(""),-1) D 161 . S FLDVAL=$G(DATA(FLD)),SEP=FS 162 . S SEG=SEG_SEP_FLDVAL 163 . F REP=1:1:$O(DATA(FLD,""),-1) D 164 . . S REPVAL=$G(DATA(FLD,REP)) 165 . . S SEP=$S(REP=1:"",1:RS) 166 . . S SEG=SEG_SEP_REPVAL 167 . . F CMP=1:1:$O(DATA(FLD,REP,""),-1) D 168 . . . S CMPVAL=$G(DATA(FLD,REP,CMP)) 169 . . . S SEP=$S(CMP=1:"",1:CS) 170 . . . S SEG=SEG_SEP_CMPVAL 171 . . . F SUB=1:1:$O(DATA(FLD,REP,CMP,""),-1) D 172 . . . . S SUBVAL=$G(DATA(FLD,REP,CMP,SUB)) 173 . . . . S SEP=$S(SUB=1:"",1:SS) 174 . . . . S SEG=SEG_SEP_SUBVAL 175 Q SEG 176 ; 177 BLDWP(WP,SEG,MAXLEN,FORMAT,FMTLEN,HL) ; 178 ;Builds segment nodes to add word processing fields to a segment 179 N CNT,LINE,LAST,FS,RS,LENGTH,I 180 I MAXLEN<1 S MAXLEN=99999999999999999 181 S FS=HL("FS") ;field separator 182 S RS=$E(HL("ECH"),2) ;repeat separator 183 S CNT=$O(SEG(""),-1)+1 184 S SEG(CNT)=FS 185 S FMTLEN=0 186 S LENGTH=0 187 ; 188 S I=0 189 F S I=$O(WP(I)) Q:'I D Q:LENGTH'<MAXLEN 190 . I $D(WP(I,0)) S LINE=$G(WP(I,0)) ;conventional WP field 191 . E S LINE=$G(WP(I)) 192 . S LENGTH=LENGTH+$L(LINE) 193 . I LENGTH'<MAXLEN S LINE=$E(LINE,1,$L(LINE)-(LENGTH-MAXLEN)) 194 . S LINE=$$ESCAPE(LINE,.HL) 195 . S LAST=$E(LINE,$L(LINE)) 196 . ;first line 197 . I SEG(CNT)=FS S SEG(CNT)=FS_LINE,FMTLEN=FMTLEN+$L(SEG(CNT)) Q 198 . S CNT=CNT+1 199 . S SEG(CNT)=RS_LINE,FMTLEN=FMTLEN+$L(SEG(CNT)) 200 . Q:'FORMAT 201 . ;attempt to keep sentences together 202 . I $E(LINE)=" "!(LAST=" ") S SEG(CNT)=LINE,FMTLEN=FMTLEN+$L(LINE) 203 . Q 204 Q 205 ; 206 ESCAPE(VAL,HL) ;Escape any special characters 207 ; *** Does not handle long strings of special characters *** 208 ; 209 ; Input: 210 ; VAL - value to escape 211 ; HL - HL7 environment array 212 ; 213 ; Output: 214 ; VAL - passed by reference 215 ; 216 N FS ;field separator 217 N CS ;component separator 218 N RS ;repetition separator 219 N ES ;escape character 220 N SS ;sub-component separator 221 N L,STR,I 222 ; 223 S FS=HL("FS") 224 S CS=$E(HL("ECH")) 225 S RS=$E(HL("ECH"),2) 226 S ES=$E(HL("ECH"),3) 227 S SS=$E(HL("ECH"),4) 228 ; 229 I VAL[ES D 230 . S L=$L(VAL,ES),STR="" 231 . F I=1:1:L S $P(STR,ES_"E"_ES,I)=$P(VAL,ES,I) 232 . S VAL=STR 233 I VAL[FS D 234 . S L=$L(VAL,FS),STR="" 235 . F I=1:1:L S $P(STR,ES_"F"_ES,I)=$P(VAL,FS,I) 236 . S VAL=STR 237 I VAL[RS D 238 . S L=$L(VAL,RS),STR="" 239 . F I=1:1:L S $P(STR,ES_"R"_ES,I)=$P(VAL,RS,I) 240 . S VAL=STR 241 I VAL[CS D 242 . S L=$L(VAL,CS),STR="" 243 . F I=1:1:L S $P(STR,ES_"S"_ES,I)=$P(VAL,CS,I) 244 . S VAL=STR 245 I VAL[SS D 246 . S L=$L(VAL,SS),STR="" 247 . F I=1:1:L S $P(STR,ES_"T"_ES,I)=$P(VAL,SS,I) 248 . S VAL=STR 249 Q VAL 250 ; 251 UNESC(VAL,HL) ;Reconstitute any escaped characters 252 ; 253 ; Input: 254 ; VAL - Value to reconstitute 255 ; HL - HL7 environment array 256 ; 257 ; Output: 258 ; VAL - passed by reference 259 ; 260 N FS ;field separator 261 N CS ;component separator 262 N RS ;repetition separator 263 N ES ;escape character 264 N SS ;sub-component separator 265 N L,STR,I,FESC,CESC,RESC,EESC,SESC 266 ; 267 S FS=HL("FS") 268 S CS=$E(HL("ECH")) 269 S RS=$E(HL("ECH"),2) 270 S ES=$E(HL("ECH"),3) 271 S SS=$E(HL("ECH"),4) 272 S FESC=ES_"F"_ES 273 S CESC=ES_"S"_ES 274 S RESC=ES_"R"_ES 275 S EESC=ES_"E"_ES 276 S SESC=ES_"T"_ES 277 ; 278 I VAL'[ES Q VAL 279 I VAL[FESC D 280 . S L=$L(VAL,FESC),STR="" 281 . F I=1:1:L S $P(STR,FS,I)=$P(VAL,FESC,I) 282 . S VAL=STR 283 I VAL[CESC D 284 . S L=$L(VAL,CESC),STR="" 285 . F I=1:1:L S $P(STR,CS,I)=$P(VAL,CESC,I) 286 . S VAL=STR 287 I VAL[RESC D 288 . S L=$L(VAL,RESC),STR="" 289 . F I=1:1:L S $P(STR,RS,I)=$P(VAL,RESC,I) 290 . S VAL=STR 291 I VAL[SESC D 292 . S L=$L(VAL,SESC),STR="" 293 . F I=1:1:L S $P(STR,SS,I)=$P(VAL,SESC,I) 294 . S VAL=STR 295 I VAL[EESC D 296 . S L=$L(VAL,EESC),STR="" 297 . F I=1:1:L S $P(STR,ES,I)=$P(VAL,EESC,I) 298 . S VAL=STR 299 Q VAL 300 ; 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 ;
Note:
See TracChangeset
for help on using the changeset viewer.
