HLFNC3 ;AISC/SAW-Continuation of HLFNC, Additional Functions/Calls Used for HL7 Messages ;1/17/95 11:16
;;1.6;HEALTH LEVEL SEVEN;;Oct 13, 1995
BHS(HL,BID,RESULT,SECURITY,MSA) ;Create a BHS Segment for an Outgoing HL7
;Batch Message
;
;This is a subroutine call with parameter passing that returns an HL7
;Batch Header (BHS) segment in the variable RESULT (and possibly
;RESULT(1) if the BHS segment is longer than 245 characters). If the
;required input parameters HL or BID are missing, RESULT is returned
;equal to null
;
;Required Input Parameters
; HL = The array of values returned by the call to INIT^HLFNC2
; BID = The Batch Control ID to be included in the BHS segment.
; The Batch Control ID for the batch is returned by the
; call to CREATE^HLTF.
; RESULT = The variable that will be returned to the calling
; application as described above
;Optional Input Parameters
;SECURITY = Security to be included in field #8 of the BHS segment
; MSA = Three components (separated by the HL7 component separator
; character) consisting of the first three fields in the
; MSA segment. This variable is required if the message
; you are building is a batch acknowledgment
;
;Check for required parameters
I '$D(HL)#2!('$D(BID)) Q ""
N X,X1,X2
;Build BHS segment from HL array variables and other input parameters
S X="BHS"_HL("FS")_HL("ECH")_HL("FS")_HL("SAN")_HL("FS")_HL("SAF")_HL("FS")_$S($D(HL("RAN")):HL("RAN"),1:"")_HL("FS")_$S($D(HL("RAF")):HL("RAF"),1:"")_HL("FS")_$S($D(HL("DTM")):HL("DTM"),1:"")_HL("FS")
S X=X_$S($G(SECURITY)]"":SECURITY,1:"")_HL("FS")_$E(HL("ECH"))_HL("PID")_$E(HL("ECH"))_HL("MTN")_$E(HL("ECH"))_HL("VER")_HL("FS")_HL("FS")_BID
;If the MSA parameter exists, insert it in pieces 11 and 12 and
;create new variable X1 if length of X will be greater than 245
I $D(MSA) D
.S $P(X,HL("FS"),12)=$P(MSA,$E(HL("ECH")),2),MSA=$P(MSA,$E(HL("ECH")))_$E(HL("ECH"))_$P(MSA,$E(HL("ECH")),3)
.I $L(X)+$L(MSA)'>245 S $P(X,HL("FS"),10)=MSA Q
.S X1=HL("FS")_$P(X,HL("FS"),11,12),X=$P(X,HL("FS"),1,10)
.S X2=$L(X),X=X_$E(MSA,1,(245-X2)),X1=$E(MSA,(246-X2),245)_X1
.S X2=$L(X) I $L(X2)<245 S X=X_$E(X1,1,(245-X2)),X1=$E(X1,(246-X2),245)
S RESULT=X S:$L($G(X1)) RESULT(1)=X1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLFNC3 2353 printed Nov 22, 2024@17:08:19 Page 2
HLFNC3 ;AISC/SAW-Continuation of HLFNC, Additional Functions/Calls Used for HL7 Messages ;1/17/95 11:16
+1 ;;1.6;HEALTH LEVEL SEVEN;;Oct 13, 1995
BHS(HL,BID,RESULT,SECURITY,MSA) ;Create a BHS Segment for an Outgoing HL7
+1 ;Batch Message
+2 ;
+3 ;This is a subroutine call with parameter passing that returns an HL7
+4 ;Batch Header (BHS) segment in the variable RESULT (and possibly
+5 ;RESULT(1) if the BHS segment is longer than 245 characters). If the
+6 ;required input parameters HL or BID are missing, RESULT is returned
+7 ;equal to null
+8 ;
+9 ;Required Input Parameters
+10 ; HL = The array of values returned by the call to INIT^HLFNC2
+11 ; BID = The Batch Control ID to be included in the BHS segment.
+12 ; The Batch Control ID for the batch is returned by the
+13 ; call to CREATE^HLTF.
+14 ; RESULT = The variable that will be returned to the calling
+15 ; application as described above
+16 ;Optional Input Parameters
+17 ;SECURITY = Security to be included in field #8 of the BHS segment
+18 ; MSA = Three components (separated by the HL7 component separator
+19 ; character) consisting of the first three fields in the
+20 ; MSA segment. This variable is required if the message
+21 ; you are building is a batch acknowledgment
+22 ;
+23 ;Check for required parameters
+24 IF '$DATA(HL)#2!('$DATA(BID))
QUIT ""
+25 NEW X,X1,X2
+26 ;Build BHS segment from HL array variables and other input parameters
+27 SET X="BHS"_HL("FS")_HL("ECH")_HL("FS")_HL("SAN")_HL("FS")_HL("SAF")_HL("FS")_$SELECT($DATA(HL("RAN")):HL("RAN"),1:"")_HL("FS")_$SELECT($DATA(HL("RAF")):HL("RAF"),1:"")_HL("FS")_$SELECT($DATA(HL("DTM")):HL("DTM"),1:"")_HL("FS")
+28 SET X=X_$SELECT($GET(SECURITY)]"":SECURITY,1:"")_HL("FS")_$EXTRACT(HL("ECH"))_HL("PID")_$EXTRACT(HL("ECH"))_HL("MTN")_$EXTRACT(HL("ECH"))_HL("VER")_HL("FS")_HL("FS")_BID
+29 ;If the MSA parameter exists, insert it in pieces 11 and 12 and
+30 ;create new variable X1 if length of X will be greater than 245
+31 IF $DATA(MSA)
Begin DoDot:1
+32 SET $PIECE(X,HL("FS"),12)=$PIECE(MSA,$EXTRACT(HL("ECH")),2)
SET MSA=$PIECE(MSA,$EXTRACT(HL("ECH")))_$EXTRACT(HL("ECH"))_$PIECE(MSA,$EXTRACT(HL("ECH")),3)
+33 IF $LENGTH(X)+$LENGTH(MSA)'>245
SET $PIECE(X,HL("FS"),10)=MSA
QUIT
+34 SET X1=HL("FS")_$PIECE(X,HL("FS"),11,12)
SET X=$PIECE(X,HL("FS"),1,10)
+35 SET X2=$LENGTH(X)
SET X=X_$EXTRACT(MSA,1,(245-X2))
SET X1=$EXTRACT(MSA,(246-X2),245)_X1
+36 SET X2=$LENGTH(X)
IF $LENGTH(X2)<245
SET X=X_$EXTRACT(X1,1,(245-X2))
SET X1=$EXTRACT(X1,(246-X2),245)
End DoDot:1
+37 SET RESULT=X
if $LENGTH($GET(X1))
SET RESULT(1)=X1
+38 QUIT