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

VAFHLU.m

Go to the documentation of this file.
  1. VAFHLU ;BPFO/JRP - SEGMENT BUILDING UTILTIES ;7/12/2002
  1. ;;5.3;Registration;**415,508**;Aug 13, 1993
  1. ;
  1. Q
  1. MAKEIT(SEGNAME,SEGARR,FIRST245,ADTLNODE) ;Make segment
  1. ;Input : SEGNAME - Name of segment being built
  1. ; SEGARR - Array continue segment data (pass by value)
  1. ; SEGARR(X) = Value for sequence N
  1. ; SEGARR(X,Y) = Repetition Y of sequence X
  1. ; SEGARR(X,Y,Z) = Component Z of repetition Y of sequence X
  1. ; SEGARR(X,Y,Z,A) = Subcomponent A of component Z of
  1. ; repetition Y of sequence X
  1. ; FIRST245 - Variable to return first 245 characters of
  1. ; segment in (pass by value)
  1. ; ADTLNODE - Array for continuation nodes (pass by value)
  1. ;Assumed: HL7 encoding chars (output of INIT^HLFNC2 or INIT^HLTRANS)
  1. ;Output : None
  1. ; FIRST245 = First 245 characters of segment
  1. ; ADTLNODE(1..n) = Continuation of segment
  1. ;Notes : Validity & existance of input is assumed
  1. ; : Assumes no single element contained in SEGARR is greater
  1. ; than 245 characters
  1. ; : Continuation nodes are added at element boundaries
  1. ;
  1. ;Declare variables
  1. N SUB1,SUB2,SUB3,CS,RS,FS,SS,OUTREF,X
  1. K FIRST245,ADTLNODE
  1. ;Get HL7 separators (attempts to use HL() array)
  1. S FS=$S($D(HL("FS")):HL("FS"),1:HLFS)
  1. S X=$S($D(HL("ECH")):HL("ECH"),1:HLECH)
  1. S CS=$E(X,1),RS=$E(X,2),SS=$E(X,4)
  1. ;Build output
  1. S OUTREF=$NA(FIRST245)
  1. S @OUTREF=SEGNAME
  1. I '$O(SEGARR(0)) S X="",Y=FS D ADD Q
  1. F SUB1=1:1:$O(SEGARR(""),-1) D
  1. .S X=$G(SEGARR(SUB1)),Y=FS D ADD
  1. .F SUB2=1:1:$O(SEGARR(SUB1,""),-1) D
  1. ..S X=$G(SEGARR(SUB1,SUB2)),Y=$S(SUB2=1:"",1:RS) D ADD
  1. ..F SUB3=1:1:$O(SEGARR(SUB1,SUB2,""),-1) D
  1. ...S X=$G(SEGARR(SUB1,SUB2,SUB3)),Y=$S(SUB3=1:"",1:CS) D ADD
  1. ...F SUB4=1:1:$O(SEGARR(SUB1,SUB2,SUB3,""),-1) D
  1. ....S X=$G(SEGARR(SUB1,SUB2,SUB3,SUB4)),Y=$S(SUB4=1:"",1:SS) D ADD
  1. Q
  1. ADD ;Add to output - account for continuation node
  1. I ($L(@OUTREF)+$L(X)+1)>245 D
  1. .S X1=1+$O(ADTLNODE(""),-1)
  1. .S OUTREF=$NA(ADTLNODE(X1))
  1. .S @OUTREF=""
  1. S @OUTREF=@OUTREF_Y_X
  1. Q