XUPSHL7B ;ALB/CMC - SEGMENT BUILDING UTILTIES ;8/9/2010
;;8.0;KERNEL;**551**;Jul 10, 1995;Build 2
;
;Copied from VAFHLU - 9/5/2008 BPFO/JRP
;
Q
MAKEIT(SEGNAME,SEGARR,FIRST245,ADTLNODE) ;Make segment
;Input : SEGNAME - Name of segment being built
; SEGARR - Array continue segment data
; SEGARR(X) = Value for sequence N
; SEGARR(X,Y) = Repetition Y of sequence X
; SEGARR(X,Y,Z) = Component Z of repetition Y of sequence X
; SEGARR(X,Y,Z,A) = Subcomponent A of component Z of
; repetition Y of sequence X
; FIRST245 - Variable to return first 245 characters of segment in
; ADTLNODE - Array for continuation nodes
;Assumed: HL7 encoding chars (output of INIT^HLFNC2 or INIT^HLTRANS)
;Output : FIRST245 = First 245 characters of segment
; ADTLNODE(1..n) = Continuation of segment
;Notes : Validity & existance of input is assumed
; : Assumes no single element contained in SEGARR is greater
; than 245 characters
; : Continuation nodes are added at element boundaries
;
;Declare variables
N SUB1,SUB2,SUB3,SUB4,CS,RS,FS,SS,OUTREF,X,X1,Y
K FIRST245,ADTLNODE
;Get HL7 separators (attempts to use HL() array)
S FS=$S($D(HL("FS")):HL("FS"),1:HLFS)
S X=$S($D(HL("ECH")):HL("ECH"),1:HLECH)
S CS=$E(X,1),RS=$E(X,2),SS=$E(X,4)
;Build output
S OUTREF=$NA(FIRST245)
S @OUTREF=SEGNAME
I '$O(SEGARR(0)) S X="",Y=FS D ADD Q
F SUB1=1:1:$O(SEGARR(""),-1) D
.S X=$G(SEGARR(SUB1)),Y=FS D ADD
.F SUB2=1:1:$O(SEGARR(SUB1,""),-1) D
..S X=$G(SEGARR(SUB1,SUB2)),Y=$S(SUB2=1:"",1:RS) D ADD
..F SUB3=1:1:$O(SEGARR(SUB1,SUB2,""),-1) D
...S X=$G(SEGARR(SUB1,SUB2,SUB3)),Y=$S(SUB3=1:"",1:CS) D ADD
...F SUB4=1:1:$O(SEGARR(SUB1,SUB2,SUB3,""),-1) D
....S X=$G(SEGARR(SUB1,SUB2,SUB3,SUB4)),Y=$S(SUB4=1:"",1:SS) D ADD
Q
ADD ;Add to output - account for continuation node
I ($L(@OUTREF)+$L(X)+1)>245 D
.S X1=1+$O(ADTLNODE(""),-1)
.S OUTREF=$NA(ADTLNODE(X1))
.S @OUTREF=""
S @OUTREF=@OUTREF_Y_X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUPSHL7B 2091 printed Nov 22, 2024@17:21:49 Page 2
XUPSHL7B ;ALB/CMC - SEGMENT BUILDING UTILTIES ;8/9/2010
+1 ;;8.0;KERNEL;**551**;Jul 10, 1995;Build 2
+2 ;
+3 ;Copied from VAFHLU - 9/5/2008 BPFO/JRP
+4 ;
+5 QUIT
MAKEIT(SEGNAME,SEGARR,FIRST245,ADTLNODE) ;Make segment
+1 ;Input : SEGNAME - Name of segment being built
+2 ; SEGARR - Array continue segment data
+3 ; SEGARR(X) = Value for sequence N
+4 ; SEGARR(X,Y) = Repetition Y of sequence X
+5 ; SEGARR(X,Y,Z) = Component Z of repetition Y of sequence X
+6 ; SEGARR(X,Y,Z,A) = Subcomponent A of component Z of
+7 ; repetition Y of sequence X
+8 ; FIRST245 - Variable to return first 245 characters of segment in
+9 ; ADTLNODE - Array for continuation nodes
+10 ;Assumed: HL7 encoding chars (output of INIT^HLFNC2 or INIT^HLTRANS)
+11 ;Output : FIRST245 = First 245 characters of segment
+12 ; ADTLNODE(1..n) = Continuation of segment
+13 ;Notes : Validity & existance of input is assumed
+14 ; : Assumes no single element contained in SEGARR is greater
+15 ; than 245 characters
+16 ; : Continuation nodes are added at element boundaries
+17 ;
+18 ;Declare variables
+19 NEW SUB1,SUB2,SUB3,SUB4,CS,RS,FS,SS,OUTREF,X,X1,Y
+20 KILL FIRST245,ADTLNODE
+21 ;Get HL7 separators (attempts to use HL() array)
+22 SET FS=$SELECT($DATA(HL("FS")):HL("FS"),1:HLFS)
+23 SET X=$SELECT($DATA(HL("ECH")):HL("ECH"),1:HLECH)
+24 SET CS=$EXTRACT(X,1)
SET RS=$EXTRACT(X,2)
SET SS=$EXTRACT(X,4)
+25 ;Build output
+26 SET OUTREF=$NAME(FIRST245)
+27 SET @OUTREF=SEGNAME
+28 IF '$ORDER(SEGARR(0))
SET X=""
SET Y=FS
DO ADD
QUIT
+29 FOR SUB1=1:1:$ORDER(SEGARR(""),-1)
Begin DoDot:1
+30 SET X=$GET(SEGARR(SUB1))
SET Y=FS
DO ADD
+31 FOR SUB2=1:1:$ORDER(SEGARR(SUB1,""),-1)
Begin DoDot:2
+32 SET X=$GET(SEGARR(SUB1,SUB2))
SET Y=$SELECT(SUB2=1:"",1:RS)
DO ADD
+33 FOR SUB3=1:1:$ORDER(SEGARR(SUB1,SUB2,""),-1)
Begin DoDot:3
+34 SET X=$GET(SEGARR(SUB1,SUB2,SUB3))
SET Y=$SELECT(SUB3=1:"",1:CS)
DO ADD
+35 FOR SUB4=1:1:$ORDER(SEGARR(SUB1,SUB2,SUB3,""),-1)
Begin DoDot:4
+36 SET X=$GET(SEGARR(SUB1,SUB2,SUB3,SUB4))
SET Y=$SELECT(SUB4=1:"",1:SS)
DO ADD
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+37 QUIT
ADD ;Add to output - account for continuation node
+1 IF ($LENGTH(@OUTREF)+$LENGTH(X)+1)>245
Begin DoDot:1
+2 SET X1=1+$ORDER(ADTLNODE(""),-1)
+3 SET OUTREF=$NAME(ADTLNODE(X1))
+4 SET @OUTREF=""
End DoDot:1
+5 SET @OUTREF=@OUTREF_Y_X
+6 QUIT
