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

HLOPRS1.m

Go to the documentation of this file.
  1. HLOPRS1 ;IRMFO-ALB/CJM -RTNs for parsing messages (continued);03/24/2004 14:43 ;01/19/2007
  1. ;;1.6;HEALTH LEVEL SEVEN;**118,131,133,134**;Oct 13, 1995;Build 30
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. PARSE(FIELD,REP,COMP,SUBCOMP,ESCAPE,SEG,TO) ;
  1. ;Parses the segment stored in SEG(1),SEG(2),... into TO()
  1. ;Input:
  1. ; FIELD - field separator
  1. ; REP - field repetition separator
  1. ; COMP - component separator
  1. ; SUBCOMP - subcomponent separator
  1. ; ESCAPE - escape character
  1. ; SEG - (pass by reference) the array holding the unparsed segment.
  1. ;Output:
  1. ; Function returns 1 on success, 0 on failure
  1. ; TO - (pass by reference) - the parsed values
  1. ; SEG- This input variable is deleted during the processing. If it is needs to be retained, pass in a copy!
  1. ;
  1. N VALUE,CHAR,COUNTS
  1. K TO
  1. Q:$L($G(FIELD))'=1 0
  1. Q:$L($G(REP))'=1 0
  1. Q:$L($G(COMP))'=1 0
  1. Q:'$D(SUBCOMP) 0
  1. Q:'$D(SEG) 0
  1. S COUNTS("FIELD")=0
  1. S COUNTS("REP")=1
  1. S COUNTS("COMP")=1
  1. S COUNTS("SUBCOMP")=1
  1. S VALUE=""
  1. S SEG("LINE")=$O(SEG(0)),SEG("CHAR")=0
  1. F S CHAR=$$NEXTCHAR(.SEG) D Q:'$L(CHAR)
  1. .I '$L(CHAR) D Q
  1. ..I $L(VALUE) S TO(COUNTS("FIELD"),COUNTS("REP"),COUNTS("COMP"),COUNTS("SUBCOMP"))=VALUE
  1. .E I CHAR=FIELD D Q
  1. ..I $L(VALUE) S TO(COUNTS("FIELD"),COUNTS("REP"),COUNTS("COMP"),COUNTS("SUBCOMP"))=$$DESCAPE(VALUE,.FIELD,.COMP,.SUBCOMP,.REP,.ESCAPE),VALUE=""
  1. ..S COUNTS("FIELD")=COUNTS("FIELD")+1,COUNTS("REP")=1,COUNTS("COMP")=1,COUNTS("SUBCOMP")=1
  1. .E I CHAR=REP D Q
  1. ..I $L(VALUE) S TO(COUNTS("FIELD"),COUNTS("REP"),COUNTS("COMP"),COUNTS("SUBCOMP"))=$$DESCAPE(VALUE,.FIELD,.COMP,.SUBCOMP,.REP,.ESCAPE),VALUE=""
  1. ..S COUNTS("REP")=COUNTS("REP")+1,COUNTS("COMP")=1,COUNTS("SUBCOMP")=1
  1. .E I CHAR=COMP D Q
  1. ..I $L(VALUE) S TO(COUNTS("FIELD"),COUNTS("REP"),COUNTS("COMP"),COUNTS("SUBCOMP"))=$$DESCAPE(VALUE,.FIELD,.COMP,.SUBCOMP,.REP,.ESCAPE),VALUE=""
  1. ..S COUNTS("COMP")=COUNTS("COMP")+1,COUNTS("SUBCOMP")=1
  1. .E I CHAR=SUBCOMP D Q
  1. ..I $L(VALUE) S TO(COUNTS("FIELD"),COUNTS("REP"),COUNTS("COMP"),COUNTS("SUBCOMP"))=$$DESCAPE(VALUE,.FIELD,.COMP,.SUBCOMP,.REP,.ESCAPE),VALUE=""
  1. ..S COUNTS("SUBCOMP")=COUNTS("SUBCOMP")+1
  1. .E S VALUE=VALUE_CHAR
  1. S TO("SEGMENT TYPE")=$G(TO(0,1,1,1)),TO(0)=TO("SEGMENT TYPE")
  1. I (TO("SEGMENT TYPE")="BHS")!(TO("SEGMENT TYPE")="MSH") S TO("FIELD SEPARATOR")=FIELD
  1. Q 1
  1. ;
  1. NEXTCHAR(SEG) ;
  1. ;returns the next character in the segment array
  1. ;
  1. Q:'SEG("LINE") ""
  1. N RET
  1. S SEG("CHAR")=SEG("CHAR")+1
  1. S RET=$E(SEG(SEG("LINE")),SEG("CHAR"))
  1. Q:RET]"" RET
  1. S SEG("LINE")=$O(SEG(SEG("LINE")))
  1. I SEG("LINE") S SEG("CHAR")=1 Q $E(SEG(SEG("LINE")))
  1. Q ""
  1. ;
  1. DESCAPE(VALUE,FIELD,COMP,SUBCOMP,REP,ESCAPE) ;
  1. ;Replaces the escape sequences with the corresponding encoding character and returns the result as the function value
  1. ;
  1. Q:ESCAPE="" VALUE
  1. N NEWSTRNG,SUBSTRNG,SET,LEN,I,SUBLEN,CHAR
  1. S (NEWSTRNG,SUBSTRNG,SUBLEN)=""
  1. S SET="FSTRE"
  1. S LEN=$L(VALUE)
  1. F I=1:1:LEN S SUBSTRNG=SUBSTRNG_$E(VALUE,I),SUBLEN=SUBLEN+1 D:SUBLEN=3
  1. .S CHAR=$E(SUBSTRNG,2)
  1. .I $E(SUBSTRNG,1)=ESCAPE,$E(SUBSTRNG,3)=ESCAPE,SET[CHAR D
  1. ..I CHAR="F" S NEWSTRNG=NEWSTRNG_FIELD,SUBSTRNG="",SUBLEN=0 Q
  1. ..I CHAR="S" S NEWSTRNG=NEWSTRNG_COMP,SUBSTRNG="",SUBLEN=0 Q
  1. ..I CHAR="T" S NEWSTRNG=NEWSTRNG_SUBCOMP,SUBSTRNG="",SUBLEN=0 Q
  1. ..I CHAR="R" S NEWSTRNG=NEWSTRNG_REP,SUBSTRNG="",SUBLEN=0 Q
  1. ..I CHAR="E" S NEWSTRNG=NEWSTRNG_ESCAPE,SUBSTRNG="",SUBLEN=0 Q
  1. .E S NEWSTRNG=NEWSTRNG_$E(SUBSTRNG),SUBSTRNG=$E(SUBSTRNG,2,3),SUBLEN=2
  1. Q NEWSTRNG_SUBSTRNG
  1. ;
  1. GETCODE(SEG,VALUE,FIELD,COMP,REP) ;
  1. ;Implements GETCNE and GETCWE
  1. ;
  1. N SUB,VAR
  1. Q:'$G(FIELD)
  1. I '$G(COMP) D
  1. .S VAR="COMP",SUB=1
  1. E D
  1. .S VAR="SUB"
  1. S:'$G(REP) REP=1
  1. S @VAR=1,VALUE("ID")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)
  1. S @VAR=2,VALUE("TEXT")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)
  1. S @VAR=3,VALUE("SYSTEM")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)
  1. S @VAR=4,VALUE("ALTERNATE ID")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)
  1. S @VAR=5,VALUE("ALTERNATE TEXT")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)
  1. S @VAR=6,VALUE("ALTERNATE SYSTEM")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,RE)
  1. S @VAR=7,VALUE("SYSTEM VERSION")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)
  1. S @VAR=8,VALUE("ALTERNATE SYSTEM VERSION")=$$GET^HLOPRS(.SEG,FIELD,COM)
  1. S @VAR=9,VALUE("ORIGINAL TEXT")=$$GET^HLOPRS(.SEG,FIELD,COMP,SUB,REP)
  1. Q