HLOPRS1.m

HLOPRS1 ;IRMFO-ALB/CJM -RTNs for parsing messages (continued);03/24/2004  14:43 ;01/19/2007

 ;;1.6;HEALTH LEVEL SEVEN;**118,131,133,134**;Oct 13, 1995;Build 30

 ;Per VHA Directive 2004-038, this routine should not be modified.

 ;

PARSE(FIELD,REP,COMP,SUBCOMP,ESCAPE,SEG,TO) ;

 ;Parses the segment stored in SEG(1),SEG(2),... into TO()

 ;Input:

 ;  FIELD - field separator

 ;  REP - field repetition separator

 ;  COMP - component separator

 ;  SUBCOMP - subcomponent separator

 ;  ESCAPE - escape character

 ;  SEG - (pass by reference) the array holding the unparsed segment.

 ;Output:

 ;  Function returns 1 on success, 0 on failure

 ;  TO - (pass by reference) - the parsed values

 ;  SEG- This input variable is deleted during the processing.  If it is needs to be retained, pass in a copy!

 ;

 N VALUE,CHAR,COUNTS

 K TO

 Q:$L($G(FIELD))'=1 0

 Q:$L($G(REP))'=1 0

 Q:$L($G(COMP))'=1 0

 Q:'$D(SUBCOMP) 0

 Q:'$D(SEG) 0

 S COUNTS("FIELD")=0

 S COUNTS("REP")=1

 S COUNTS("COMP")=1

 S COUNTS("SUBCOMP")=1

 S VALUE=""

 S SEG("LINE")=$O(SEG(0)),SEG("CHAR")=0

 F  S CHAR=$$NEXTCHAR(.SEG) D  Q:'$L(CHAR)

 .I '$L(CHAR) D  Q

 ..I $L(VALUE) S TO(COUNTS("FIELD"),COUNTS("REP"),COUNTS("COMP"),COUNTS("SUBCOMP"))=VALUE

 .E  I CHAR=FIELD D  Q

 ..I $L(VALUE) S TO(COUNTS("FIELD"),COUNTS("REP"),COUNTS("COMP"),COUNTS("SUBCOMP"))=$$DESCAPE(VALUE,.FIELD,.COMP,.SUBCOMP,.REP,.ESCAPE),VALUE=""

 ..S COUNTS("FIELD")=COUNTS("FIELD")+1,COUNTS("REP")=1,COUNTS("COMP")=1,COUNTS("SUBCOMP")=1

 .E  I CHAR=REP D  Q

 ..I $L(VALUE) S TO(COUNTS("FIELD"),COUNTS("REP"),COUNTS("COMP"),COUNTS("SUBCOMP"))=$$DESCAPE(VALUE,.FIELD,.COMP,.SUBCOMP,.REP,.ESCAPE),VALUE=""

 ..S COUNTS("REP")=COUNTS("REP")+1,COUNTS("COMP")=1,COUNTS("SUBCOMP")=1

 .E  I CHAR=COMP D  Q

 ..I $L(VALUE) S TO(COUNTS("FIELD"),COUNTS("REP"),COUNTS("COMP"),COUNTS("SUBCOMP"))=$$DESCAPE(VALUE,.FIELD,.COMP,.SUBCOMP,.REP,.ESCAPE),VALUE=""

 ..S COUNTS("COMP")=COUNTS("COMP")+1,COUNTS("SUBCOMP")=1

 .E  I CHAR=SUBCOMP D  Q

 ..I $L(VALUE) S TO(COUNTS("FIELD"),COUNTS("REP"),COUNTS("COMP"),COUNTS("SUBCOMP"))=$$DESCAPE(VALUE,.FIELD,.COMP,.SUBCOMP,.REP,.ESCAPE),VALUE=""

 ..S COUNTS("SUBCOMP")=COUNTS("SUBCOMP")+1

 .E  S VALUE=VALUE_CHAR

 S TO("SEGMENT TYPE")=$G(TO(0,1,1,1)),TO(0)=TO("SEGMENT TYPE")

 I (TO("SEGMENT TYPE")="BHS")!(TO("SEGMENT TYPE")="MSH") S TO("FIELD SEPARATOR")=FIELD

 Q 1

 ;

NEXTCHAR(SEG) ;

 ;returns the next character in the segment array

 ;

 Q:'SEG("LINE") ""

 N RET

 S SEG("CHAR")=SEG("CHAR")+1

 S RET=$E(SEG(SEG("LINE")),SEG("CHAR"))

 Q:RET]"" RET

 S SEG("LINE")=$O(SEG(SEG("LINE")))

 I SEG("LINE") S SEG("CHAR")=1 Q $E(SEG(SEG("LINE")))

 Q ""

 ;

DESCAPE(VALUE,FIELD,COMP,SUBCOMP,REP,ESCAPE) ;

 ;Replaces the escape sequences with the corresponding encoding character and returns the result as the function value

 ;

 Q:ESCAPE="" VALUE

 N NEWSTRNG,SUBSTRNG,SET,LEN,I,SUBLEN,CHAR

 S (NEWSTRNG,SUBSTRNG,SUBLEN)=""

 S SET="FSTRE"

 S LEN=$L(VALUE)

 F I=1:1:LEN S SUBSTRNG=SUBSTRNG_$E(VALUE,I),SUBLEN=SUBLEN+1 D:SUBLEN=3

 .S CHAR=$E(SUBSTRNG,2)

 .I $E(SUBSTRNG,1)=ESCAPE,$E(SUBSTRNG,3)=ESCAPE,SET[CHAR D

 ..I CHAR="F" S NEWSTRNG=NEWSTRNG_FIELD,SUBSTRNG="",SUBLEN=0 Q

 ..I CHAR="S" S NEWSTRNG=NEWSTRNG_COMP,SUBSTRNG="",SUBLEN=0 Q

 ..I CHAR="T" S NEWSTRNG=NEWSTRNG_SUBCOMP,SUBSTRNG="",SUBLEN=0 Q

 ..I CHAR="R" S NEWSTRNG=NEWSTRNG_REP,SUBSTRNG="",SUBLEN=0 Q

 ..I CHAR="E" S NEWSTRNG=NEWSTRNG_ESCAPE,SUBSTRNG="",SUBLEN=0 Q

 .E  S NEWSTRNG=NEWSTRNG_$E(SUBSTRNG),SUBSTRNG=$E(SUBSTRNG,2,3),SUBLEN=2

 Q NEWSTRNG_SUBSTRNG

 ;

GETCODE(SEG,VALUE,FIELD,COMP,REP) ;

 ;Implements GETCNE and GETCWE

 ;

 N SUB,VAR

 Q:'$G(FIELD)

 I '$G(COMP) D

 .S VAR="COMP",SUB=1

 E  D

 .S VAR="SUB"

 S:'$G(REP) REP=1

 S @VAR=1,VALUE("ID")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)

 S @VAR=2,VALUE("TEXT")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)

 S @VAR=3,VALUE("SYSTEM")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)

 S @VAR=4,VALUE("ALTERNATE ID")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)

 S @VAR=5,VALUE("ALTERNATE TEXT")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)

 S @VAR=6,VALUE("ALTERNATE SYSTEM")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,RE)

 S @VAR=7,VALUE("SYSTEM VERSION")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)

 S @VAR=8,VALUE("ALTERNATE SYSTEM VERSION")=$$GET^HLOPRS(.SEG,FIELD,COM)

 S @VAR=9,VALUE("ORIGINAL TEXT")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)

 Q