HLOPBLD ;ALB/CJM-HL7 - Building segments ;10/24/2006
;;1.6;HEALTH LEVEL SEVEN;**126,132**;Oct 13, 1995;Build 6
;Per VHA Directive 2004-038, this routine should not be modified.
;
;
BUILDSEG(HLMSTATE,SEG,TOARY,ERROR) ;Builds the segment from the individual values
;Input:
; HLMSTATE() - (pass by reference, required) Used to track the progress of the message. Uses these subscripts:
; ("HDR","FIELD SEPARATOR")
; ("HDR","ENCODING CHARACTERS")
; SEG() - (pass by reference, required) Contains the data. It must be built by calls to SET^HLOAPI prior to calling $$BUILDSEG.
;
;Note#1: The '0' field must be a 3 character segment type
;Note#2: ***SEG is killed upon successfully adding the segment***
;
;Output:
; Function - returns 1 on success, 0 on failure
; TOARY (pass by reference) This will return the segment in an array format TOARY(1),TOARY(2),... For segments that are shorter than the MUMPS maximum string length, there will be only TOARY(1)
; ERROR (optional, pass by reference) - returns an error message on failure
;
;
K ERROR,TOARY
N TEMP1,TEMP2,LINE,LAST,SEQ,MAX,COUNT,SEGTYPE
S COUNT=0
S MAX=HLMSTATE("SYSTEM","MAXSTRING")-1 ;save some room for the <CR>
S SEGTYPE=$G(SEG(0,1,1,1))
S LAST=0,(TEMP1,TEMP2)="",LINE=SEGTYPE_HLMSTATE("HDR","FIELD SEPARATOR")
F S SEQ=$O(SEG(LAST)) Q:'SEQ D
.S TEMP2="",$P(TEMP2,HLMSTATE("HDR","FIELD SEPARATOR"),$S(LAST=0:SEQ,1:SEQ-LAST+1))=""
.S TEMP1=TEMP2
.S LAST=SEQ
.N REP,LAST
.S LAST=0
.F S REP=$O(SEG(SEQ,LAST)) Q:'REP D
..S TEMP2="",$P(TEMP2,$E(HLMSTATE("HDR","ENCODING CHARACTERS"),2),$S(LAST=0:REP,1:REP-LAST+1))=""
..S TEMP1=TEMP1_TEMP2
..S LAST=REP
..;
..N COMP,LAST
..S LAST=0
..F S COMP=$O(SEG(SEQ,REP,LAST)) Q:'COMP D
...S TEMP2="",$P(TEMP2,$E(HLMSTATE("HDR","ENCODING CHARACTERS"),1),$S(LAST=0:COMP,1:COMP-LAST+1))=""
...S TEMP1=TEMP1_TEMP2
...S LAST=COMP
...;
...N SUBCOMP,LAST
...S LAST=0
...F S SUBCOMP=$O(SEG(SEQ,REP,COMP,LAST)) Q:'SUBCOMP D
....N VALUE
....S TEMP2="",$P(TEMP2,$E(HLMSTATE("HDR","ENCODING CHARACTERS"),4),$S(LAST=0:SUBCOMP,1:SUBCOMP-LAST+1))=""
....S VALUE=$G(SEG(SEQ,REP,COMP,SUBCOMP))
....K SEG(SEQ,REP,COMP,SUBCOMP)
....S:((SEGTYPE'="MSH")&(SEGTYPE'="BHS"))!(SEQ'=2) VALUE=$$ESCAPE(.HLMSTATE,VALUE)
....S TEMP2=TEMP2_VALUE
....S TEMP1=TEMP1_TEMP2
....I $L(LINE)+$L(TEMP1)<MAX D
.....S LINE=LINE_TEMP1
....E D
.....D ADDLINE(.TOARY,LINE_$E(TEMP1,1,MAX-$L(LINE)),.COUNT)
.....S LINE=$E(TEMP1,MAX-$L(LINE)+1,MAX+100)
....S TEMP1=""
....S LAST=SUBCOMP
I $L(LINE) D ADDLINE(.TOARY,LINE,.COUNT)
K SEG
Q 1
;
ADDLINE(TOARY,LINE,COUNT) ;
S COUNT=COUNT+1
S TOARY(COUNT)=LINE
Q
;
ESCAPE(HLMSTATE,VALUE) ;
;Replaces the HL7 encoding characters with the corresponding escape sequences and returns the result as the function value
;
N ESC,CHARS,I,NEWVALUE,LEN,CUR
S CHARS=HLMSTATE("HDR","ENCODING CHARACTERS")
S ESC=$E(CHARS,3)
S NEWVALUE="",LEN=$L(VALUE)
F I=1:1:LEN D
.S CUR=$E(VALUE,I)
.S NEWVALUE=NEWVALUE_$S(CUR=HLMSTATE("HDR","FIELD SEPARATOR"):ESC_"F"_ESC,CUR=ESC:ESC_"E"_ESC,CUR=$E(CHARS,1):ESC_"S"_ESC,CUR=$E(CHARS,4):ESC_"T"_ESC,CUR=$E(CHARS,2):ESC_"R"_ESC,1:CUR)
Q NEWVALUE
;
REPLACE(VALUE,CHAR,STRING) ;
;Takes the input string=VALUE and replaces each instance of the character
;=CHAR with the string=STRING and returns the resultant string
;as the function value
;
N I,NEWVALUE,CURCHAR
S NEWVALUE=""
F I=1:1:$L(VALUE) D
.S CURCHAR=$E(VALUE,I)
.S NEWVALUE=NEWVALUE_$S(CURCHAR=CHAR:STRING,1:CURCHAR)
Q NEWVALUE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOPBLD 3595 printed Dec 13, 2024@01:58:52 Page 2
HLOPBLD ;ALB/CJM-HL7 - Building segments ;10/24/2006
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,132**;Oct 13, 1995;Build 6
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
BUILDSEG(HLMSTATE,SEG,TOARY,ERROR) ;Builds the segment from the individual values
+1 ;Input:
+2 ; HLMSTATE() - (pass by reference, required) Used to track the progress of the message. Uses these subscripts:
+3 ; ("HDR","FIELD SEPARATOR")
+4 ; ("HDR","ENCODING CHARACTERS")
+5 ; SEG() - (pass by reference, required) Contains the data. It must be built by calls to SET^HLOAPI prior to calling $$BUILDSEG.
+6 ;
+7 ;Note#1: The '0' field must be a 3 character segment type
+8 ;Note#2: ***SEG is killed upon successfully adding the segment***
+9 ;
+10 ;Output:
+11 ; Function - returns 1 on success, 0 on failure
+12 ; TOARY (pass by reference) This will return the segment in an array format TOARY(1),TOARY(2),... For segments that are shorter than the MUMPS maximum string length, there will be only TOARY(1)
+13 ; ERROR (optional, pass by reference) - returns an error message on failure
+14 ;
+15 ;
+16 KILL ERROR,TOARY
+17 NEW TEMP1,TEMP2,LINE,LAST,SEQ,MAX,COUNT,SEGTYPE
+18 SET COUNT=0
+19 ;save some room for the <CR>
SET MAX=HLMSTATE("SYSTEM","MAXSTRING")-1
+20 SET SEGTYPE=$GET(SEG(0,1,1,1))
+21 SET LAST=0
SET (TEMP1,TEMP2)=""
SET LINE=SEGTYPE_HLMSTATE("HDR","FIELD SEPARATOR")
+22 FOR
SET SEQ=$ORDER(SEG(LAST))
if 'SEQ
QUIT
Begin DoDot:1
+23 SET TEMP2=""
SET $PIECE(TEMP2,HLMSTATE("HDR","FIELD SEPARATOR"),$SELECT(LAST=0:SEQ,1:SEQ-LAST+1))=""
+24 SET TEMP1=TEMP2
+25 SET LAST=SEQ
+26 NEW REP,LAST
+27 SET LAST=0
+28 FOR
SET REP=$ORDER(SEG(SEQ,LAST))
if 'REP
QUIT
Begin DoDot:2
+29 SET TEMP2=""
SET $PIECE(TEMP2,$EXTRACT(HLMSTATE("HDR","ENCODING CHARACTERS"),2),$SELECT(LAST=0:REP,1:REP-LAST+1))=""
+30 SET TEMP1=TEMP1_TEMP2
+31 SET LAST=REP
+32 ;
+33 NEW COMP,LAST
+34 SET LAST=0
+35 FOR
SET COMP=$ORDER(SEG(SEQ,REP,LAST))
if 'COMP
QUIT
Begin DoDot:3
+36 SET TEMP2=""
SET $PIECE(TEMP2,$EXTRACT(HLMSTATE("HDR","ENCODING CHARACTERS"),1),$SELECT(LAST=0:COMP,1:COMP-LAST+1))=""
+37 SET TEMP1=TEMP1_TEMP2
+38 SET LAST=COMP
+39 ;
+40 NEW SUBCOMP,LAST
+41 SET LAST=0
+42 FOR
SET SUBCOMP=$ORDER(SEG(SEQ,REP,COMP,LAST))
if 'SUBCOMP
QUIT
Begin DoDot:4
+43 NEW VALUE
+44 SET TEMP2=""
SET $PIECE(TEMP2,$EXTRACT(HLMSTATE("HDR","ENCODING CHARACTERS"),4),$SELECT(LAST=0:SUBCOMP,1:SUBCOMP-LAST+1))=""
+45 SET VALUE=$GET(SEG(SEQ,REP,COMP,SUBCOMP))
+46 KILL SEG(SEQ,REP,COMP,SUBCOMP)
+47 if ((SEGTYPE'="MSH")&(SEGTYPE'="BHS"))!(SEQ'=2)
SET VALUE=$$ESCAPE(.HLMSTATE,VALUE)
+48 SET TEMP2=TEMP2_VALUE
+49 SET TEMP1=TEMP1_TEMP2
+50 IF $LENGTH(LINE)+$LENGTH(TEMP1)<MAX
Begin DoDot:5
+51 SET LINE=LINE_TEMP1
End DoDot:5
+52 IF '$TEST
Begin DoDot:5
+53 DO ADDLINE(.TOARY,LINE_$EXTRACT(TEMP1,1,MAX-$LENGTH(LINE)),.COUNT)
+54 SET LINE=$EXTRACT(TEMP1,MAX-$LENGTH(LINE)+1,MAX+100)
End DoDot:5
+55 SET TEMP1=""
+56 SET LAST=SUBCOMP
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+57 IF $LENGTH(LINE)
DO ADDLINE(.TOARY,LINE,.COUNT)
+58 KILL SEG
+59 QUIT 1
+60 ;
ADDLINE(TOARY,LINE,COUNT) ;
+1 SET COUNT=COUNT+1
+2 SET TOARY(COUNT)=LINE
+3 QUIT
+4 ;
ESCAPE(HLMSTATE,VALUE) ;
+1 ;Replaces the HL7 encoding characters with the corresponding escape sequences and returns the result as the function value
+2 ;
+3 NEW ESC,CHARS,I,NEWVALUE,LEN,CUR
+4 SET CHARS=HLMSTATE("HDR","ENCODING CHARACTERS")
+5 SET ESC=$EXTRACT(CHARS,3)
+6 SET NEWVALUE=""
SET LEN=$LENGTH(VALUE)
+7 FOR I=1:1:LEN
Begin DoDot:1
+8 SET CUR=$EXTRACT(VALUE,I)
+9 SET NEWVALUE=NEWVALUE_$SELECT(CUR=HLMSTATE("HDR","FIELD SEPARATOR"):ESC_"F"_ESC,CUR=ESC:ESC_"E"_ESC,CUR=$EXTRACT(CHARS,1):ESC_"S"_ESC,CUR=$EXTRACT(CHARS,4):ESC_"T"_ESC,CUR=$EXTRACT(CHARS,2):ESC_"R"_ESC,1:CUR)
End DoDot:1
+10 QUIT NEWVALUE
+11 ;
REPLACE(VALUE,CHAR,STRING) ;
+1 ;Takes the input string=VALUE and replaces each instance of the character
+2 ;=CHAR with the string=STRING and returns the resultant string
+3 ;as the function value
+4 ;
+5 NEW I,NEWVALUE,CURCHAR
+6 SET NEWVALUE=""
+7 FOR I=1:1:$LENGTH(VALUE)
Begin DoDot:1
+8 SET CURCHAR=$EXTRACT(VALUE,I)
+9 SET NEWVALUE=NEWVALUE_$SELECT(CURCHAR=CHAR:STRING,1:CURCHAR)
End DoDot:1
+10 QUIT NEWVALUE
