PRSHL7B ;ALB/CMC - SEGMENT BUILDING UTILTIES ;8/9/2010
;;4.0;PAID;**128**;Sep 21, 1995;Build 3
;
;Copied from XUPSHL7B 8/9/2010
;
Q
MAKEIT(SEGNAME,SEGARR,FIRST245,ADTLNODE) ;Make segment
;Input : SEGNAME - Name of segment being built
; SEGARR - Array continue segment data (pass by value)
; 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 (pass by value)
; ADTLNODE - Array for continuation nodes (pass by value)
;Assumed: HL7 encoding chars (output of INIT^HLFNC2 or INIT^HLTRANS)
;Output : None
; 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[HPRSHL7B 2167 printed Oct 16, 2024@18:27:42 Page 2
PRSHL7B ;ALB/CMC - SEGMENT BUILDING UTILTIES ;8/9/2010
+1 ;;4.0;PAID;**128**;Sep 21, 1995;Build 3
+2 ;
+3 ;Copied from XUPSHL7B 8/9/2010
+4 ;
+5 QUIT
MAKEIT(SEGNAME,SEGARR,FIRST245,ADTLNODE) ;Make segment
+1 ;Input : SEGNAME - Name of segment being built
+2 ; SEGARR - Array continue segment data (pass by value)
+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
+9 ; segment in (pass by value)
+10 ; ADTLNODE - Array for continuation nodes (pass by value)
+11 ;Assumed: HL7 encoding chars (output of INIT^HLFNC2 or INIT^HLTRANS)
+12 ;Output : None
+13 ; FIRST245 = First 245 characters of segment
+14 ; ADTLNODE(1..n) = Continuation of segment
+15 ;Notes : Validity & existance of input is assumed
+16 ; : Assumes no single element contained in SEGARR is greater
+17 ; than 245 characters
+18 ; : Continuation nodes are added at element boundaries
+19 ;
+20 ;Declare variables
+21 NEW SUB1,SUB2,SUB3,SUB4,CS,RS,FS,SS,OUTREF,X,X1,Y
+22 KILL FIRST245,ADTLNODE
+23 ;Get HL7 separators (attempts to use HL() array)
+24 SET FS=$SELECT($DATA(HL("FS")):HL("FS"),1:HLFS)
+25 SET X=$SELECT($DATA(HL("ECH")):HL("ECH"),1:HLECH)
+26 SET CS=$EXTRACT(X,1)
SET RS=$EXTRACT(X,2)
SET SS=$EXTRACT(X,4)
+27 ;Build output
+28 SET OUTREF=$NAME(FIRST245)
+29 SET @OUTREF=SEGNAME
+30 IF '$ORDER(SEGARR(0))
SET X=""
SET Y=FS
DO ADD
QUIT
+31 FOR SUB1=1:1:$ORDER(SEGARR(""),-1)
Begin DoDot:1
+32 SET X=$GET(SEGARR(SUB1))
SET Y=FS
DO ADD
+33 FOR SUB2=1:1:$ORDER(SEGARR(SUB1,""),-1)
Begin DoDot:2
+34 SET X=$GET(SEGARR(SUB1,SUB2))
SET Y=$SELECT(SUB2=1:"",1:RS)
DO ADD
+35 FOR SUB3=1:1:$ORDER(SEGARR(SUB1,SUB2,""),-1)
Begin DoDot:3
+36 SET X=$GET(SEGARR(SUB1,SUB2,SUB3))
SET Y=$SELECT(SUB3=1:"",1:CS)
DO ADD
+37 FOR SUB4=1:1:$ORDER(SEGARR(SUB1,SUB2,SUB3,""),-1)
Begin DoDot:4
+38 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
+39 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
