HLTF1 ;AISC/SAW/MTC-Process Message Text File Entries (Cont'd) ;10/17/2007 09:43
;;1.6;HEALTH LEVEL SEVEN;**5,8,22,25,19,78,122**;Oct 13, 1995;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
MERGE15(ARAYTYPE,MTIEN,SUB1,SUB2) ;Merge Local/Global Array From Application into
;Message Text File
;
;This is a routine call with parameter passing. There are no output
;parameters returned by this call.
;
;** Merges incoming data for v1.5 applications only **
;
;Required input parameters
; MTIEN = The IEN from the Message Text file of the entry to be
; updated
; ARAYTYPE = Array type, G for global or L for local
; SUB1 = The first level subscript of the array. Must be
; either HLS or HLA
;Optional input parameter
; SUB2 = A second subscript associated with the array
;
;Check for required parameters
I "GL"'[$G(ARAYTYPE)!($G(SUB1)']"")!('$G(MTIEN)) G MRGE15X
;
N HLCHAR,HLEVN,HLFS,I,X,X1,X2,X3 S (HLCHAR,HLEVN,X)=0
;
;Merge data from a global array with two subscript
I ARAYTYPE="G",$G(SUB2)'="" D
. S X="",I=0
. F S X=$O(^TMP(SUB1,$J,SUB2,X)) Q:'X S I=I+1,X1=^TMP(SUB1,$J,SUB2,X),HLCHAR=HLCHAR+$L(X1) S:$E(X1,1,3)="MSH" HLFS=$E(X1,4),$P(X1,HLFS,8)="",HLEVN=HLEVN+1 S ^HL(772,MTIEN,"IN",I,0)=X1
;
;Merge data from a global array with one subscripts
I ARAYTYPE="G",$G(SUB2)="" D
. S X="",I=0
. F S X=$O(^TMP(SUB1,$J,X)) Q:'X S I=I+1,X1=^TMP(SUB1,$J,X),HLCHAR=HLCHAR+$L(X1) S:$E(X1,1,3)="MSH" HLFS=$E(X1,4),$P(X1,HLFS,8)="",HLEVN=HLEVN+1 S ^HL(772,MTIEN,"IN",I,0)=X1
;
;Merge data from a local array with one subscript
I ARAYTYPE="L" D
. S X="",I=0
. F S X=$O(HLA(SUB1,X)) Q:'X S I=I+1,X1=HLA(SUB1,X),HLCHAR=HLCHAR+$L(X1) S:$E(X1,1,3)="MSH" HLFS=$E(X1,4),$P(X1,HLFS,8)="",HLEVN=HLEVN+1 S ^HL(772,MTIEN,"IN",I,0)=X1
;
;-- update 0 node for message text
S ^HL(772,MTIEN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
;
;File message statistics
D STATS^HLTF0(MTIEN,HLCHAR,HLEVN)
;
MRGE15X ;-- exit merge
Q
;
MERGE(ARAYTYPE,MTIEN,SUB1,SUB2) ;Merge Local/Global Array From Application into
;Message Text File
;
;This is a routine call with parameter passing. There are no output
;parameters returned by this call.
;
;Required input parameters
; MTIEN = The IEN from the Message Text file of the entry to be
; updated
; ARAYTYPE = Array type, G for global or L for local
; SUB1 = The first level subscript of the array. Must be
; either HLS or HLA
;Optional input parameter
; SUB2 = A second subscript associated with the array
;
;Check for required parameters
I "GL"'[$G(ARAYTYPE)!($G(SUB1)']"")!('$G(MTIEN)) G MERGEX
;
N HLCHAR,HLEVN,HLFS,I,X,X1,X2,X3 S (HLCHAR,HLEVN,X)=0
;
; patch HL*1.6*122: MPI-client/server
F L +^HL(772,+$G(MTIEN)):10 Q:$T H 1
;
;Merge data from a global array with two subscript
I ARAYTYPE="G",$G(SUB2)'="" D
. S X="",I=0
. F S X=$O(^TMP(SUB1,$J,SUB2,X)) Q:'X S I=I+1,X1=^TMP(SUB1,$J,SUB2,X),HLCHAR=HLCHAR+$L(X1) S:$E(X1,1,3)="MSH" HLFS=$E(X1,4),$P(X1,HLFS,8)="",HLEVN=HLEVN+1 S ^HL(772,MTIEN,"IN",I,0)=X1,X2=$D(^TMP(SUB1,$J,SUB2,X)) D
.. I X2=11 S X3="" F S X3=$O(^TMP(SUB1,$J,SUB2,X,X3)) Q:'X3 D
... S I=I+1,X1=$G(^TMP(SUB1,$J,SUB2,X,X3)),HLCHAR=HLCHAR+$L(X1),^HL(772,MTIEN,"IN",I,0)=X1
.. S I=I+1,^HL(772,MTIEN,"IN",I,0)="" Q
;
;Merge data from a global array with one subscripts
I ARAYTYPE="G",$G(SUB2)="" D
. S X="",I=0
. F S X=$O(^TMP(SUB1,$J,X)) Q:'X S I=I+1,X1=^TMP(SUB1,$J,X),HLCHAR=HLCHAR+$L(X1) S:$E(X1,1,3)="MSH" HLFS=$E(X1,4),$P(X1,HLFS,8)="",HLEVN=HLEVN+1 S ^HL(772,MTIEN,"IN",I,0)=X1,X2=$D(^TMP(SUB1,$J,X)) D
.. I X2=11 S X3="" F S X3=$O(^TMP(SUB1,$J,X,X3)) Q:'X3 D
... S I=I+1,X1=$G(^TMP(SUB1,$J,X,X3)),HLCHAR=HLCHAR+$L(X1),^HL(772,MTIEN,"IN",I,0)=X1
.. S I=I+1,^HL(772,MTIEN,"IN",I,0)="" Q
;
;Merge data from a local array with one subscript
I ARAYTYPE="L" D
. S X="",I=0
. F S X=$O(HLA(SUB1,X)) Q:'X S I=I+1,X1=HLA(SUB1,X),HLCHAR=HLCHAR+$L(X1) S:$E(X1,1,3)="MSH" HLFS=$E(X1,4),$P(X1,HLFS,8)="",HLEVN=HLEVN+1 S ^HL(772,MTIEN,"IN",I,0)=X1,X2=$D(HLA(SUB1,X)) D
.. I X2=11 S X3="" F S X3=$O(HLA(SUB1,X,X3)) Q:'X3 D
... S I=I+1,X1=$G(HLA(SUB1,X,X3)),HLCHAR=HLCHAR+$L(X1),^HL(772,MTIEN,"IN",I,0)=X1
.. S I=I+1,^HL(772,MTIEN,"IN",I,0)="" Q
;
S:HLEVN=0 HLEVN=1
;X=ien in file 773 for TCP messages
S X=+$O(^HLMA("B",MTIEN,0))
;batch message type
I X,$P($G(^HLMA(X,0)),U,5)="B" D BTS
I 'X,$P(^HL(772,MTIEN,0),U,8),$P(^HL(772,$P(^(0),U,8),0),U,14)="B" D BTS
;
;-- update 0 node for message text
S ^HL(772,MTIEN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
;
; patch HL*1.6*122: MPI-client/server
L -^HL(772,+$G(MTIEN))
;
;File message statistics
D STATS^HLTF0(MTIEN,HLCHAR,HLEVN)
;
MERGEX ;-- exit merge
Q
;
BTS ; create batch trailer seg (BTS)
;HL*1.6*78 to obtain and insert FIELD SEPARATOR, HLFS
N HLFS,HLSAN
S HLFS=$G(HL("FS")) ; obtain from HL array
; or obtain from sending application; default to "^"
I HLFS="" D S:HLFS="" HLFS="^"
. S HLSAN=$P($G(^HL(772,MTIEN,0)),U,2)
. S:HLSAN HLFS=$G(^HL(771,HLSAN,"FS"))
S I=I+1,^HL(772,MTIEN,"IN",I,0)="BTS"_HLFS_HLEVN,I=I+1,^HL(772,MTIEN,"IN",I,0)=""
Q
;
MRGINT(MTOUT,MTIN,HDR) ;Merge Internal to Internal Message from the
; Outbound message in 772 (MTOUT) to an Inbound entry (MTIN). The process
; will involve Moving the Header and Text into 772.
;
;Required input parameters
; MTOUT= Internal entry number of the Outbound message
; MTIN = Internal entry number of the Inbound message
; HDR = Name of the array that contains HL7 Header segment
; format: HLHDR - Used with indirection to build message in out
; queue
; This routine will first take the header information in the array
; specified by HDR and merge into the Message Text field of file 870.
; Then it will move the message contained in 772 (MTIEN) into 870.
;
;Check for required parameters
I '$G(MTOUT)!('$G(MTIN))!(HDR="") Q
;
;-- initilize
N I,X
S I=0
;
;-- move header into 772 from HDR array
S X="" F S X=$O(@HDR@(X)) Q:'X D
. S I=I+1,^HL(772,MTIN,"IN",I,0)=@HDR@(X)
S I=I+1,^HL(772,MTIN,"IN",I,0)=""
;
;Move data from Message Text (MTOUT) file TO Message Text 772 (MTIN)
S X=0 F S X=$O(^HL(772,MTOUT,"IN",X)) Q:X="" S I=I+1 D
. S ^HL(772,MTIN,"IN",I,0)=$G(^HL(772,MTOUT,"IN",X,0))
;
;-- update 0 node of message and format arrays
S ^HL(772,MTIN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLTF1 6616 printed Oct 16, 2024@18:00:41 Page 2
HLTF1 ;AISC/SAW/MTC-Process Message Text File Entries (Cont'd) ;10/17/2007 09:43
+1 ;;1.6;HEALTH LEVEL SEVEN;**5,8,22,25,19,78,122**;Oct 13, 1995;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
MERGE15(ARAYTYPE,MTIEN,SUB1,SUB2) ;Merge Local/Global Array From Application into
+1 ;Message Text File
+2 ;
+3 ;This is a routine call with parameter passing. There are no output
+4 ;parameters returned by this call.
+5 ;
+6 ;** Merges incoming data for v1.5 applications only **
+7 ;
+8 ;Required input parameters
+9 ; MTIEN = The IEN from the Message Text file of the entry to be
+10 ; updated
+11 ; ARAYTYPE = Array type, G for global or L for local
+12 ; SUB1 = The first level subscript of the array. Must be
+13 ; either HLS or HLA
+14 ;Optional input parameter
+15 ; SUB2 = A second subscript associated with the array
+16 ;
+17 ;Check for required parameters
+18 IF "GL"'[$GET(ARAYTYPE)!($GET(SUB1)']"")!('$GET(MTIEN))
GOTO MRGE15X
+19 ;
+20 NEW HLCHAR,HLEVN,HLFS,I,X,X1,X2,X3
SET (HLCHAR,HLEVN,X)=0
+21 ;
+22 ;Merge data from a global array with two subscript
+23 IF ARAYTYPE="G"
IF $GET(SUB2)'=""
Begin DoDot:1
+24 SET X=""
SET I=0
+25 FOR
SET X=$ORDER(^TMP(SUB1,$JOB,SUB2,X))
if 'X
QUIT
SET I=I+1
SET X1=^TMP(SUB1,$JOB,SUB2,X)
SET HLCHAR=HLCHAR+$LENGTH(X1)
if $EXTRACT(X1,1,3)="MSH"
SET HLFS=$EXTRACT(X1,4)
SET $PIECE(X1,HLFS,8)=""
SET HLEVN=HLEVN+1
SET ^HL(772,MTIEN,"IN",I,0)=X1
End DoDot:1
+26 ;
+27 ;Merge data from a global array with one subscripts
+28 IF ARAYTYPE="G"
IF $GET(SUB2)=""
Begin DoDot:1
+29 SET X=""
SET I=0
+30 FOR
SET X=$ORDER(^TMP(SUB1,$JOB,X))
if 'X
QUIT
SET I=I+1
SET X1=^TMP(SUB1,$JOB,X)
SET HLCHAR=HLCHAR+$LENGTH(X1)
if $EXTRACT(X1,1,3)="MSH"
SET HLFS=$EXTRACT(X1,4)
SET $PIECE(X1,HLFS,8)=""
SET HLEVN=HLEVN+1
SET ^HL(772,MTIEN,"IN",I,0)=X1
End DoDot:1
+31 ;
+32 ;Merge data from a local array with one subscript
+33 IF ARAYTYPE="L"
Begin DoDot:1
+34 SET X=""
SET I=0
+35 FOR
SET X=$ORDER(HLA(SUB1,X))
if 'X
QUIT
SET I=I+1
SET X1=HLA(SUB1,X)
SET HLCHAR=HLCHAR+$LENGTH(X1)
if $EXTRACT(X1,1,3)="MSH"
SET HLFS=$EXTRACT(X1,4)
SET $PIECE(X1,HLFS,8)=""
SET HLEVN=HLEVN+1
SET ^HL(772,MTIEN,"IN",I,0)=X1
End DoDot:1
+36 ;
+37 ;-- update 0 node for message text
+38 SET ^HL(772,MTIEN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
+39 ;
+40 ;File message statistics
+41 DO STATS^HLTF0(MTIEN,HLCHAR,HLEVN)
+42 ;
MRGE15X ;-- exit merge
+1 QUIT
+2 ;
MERGE(ARAYTYPE,MTIEN,SUB1,SUB2) ;Merge Local/Global Array From Application into
+1 ;Message Text File
+2 ;
+3 ;This is a routine call with parameter passing. There are no output
+4 ;parameters returned by this call.
+5 ;
+6 ;Required input parameters
+7 ; MTIEN = The IEN from the Message Text file of the entry to be
+8 ; updated
+9 ; ARAYTYPE = Array type, G for global or L for local
+10 ; SUB1 = The first level subscript of the array. Must be
+11 ; either HLS or HLA
+12 ;Optional input parameter
+13 ; SUB2 = A second subscript associated with the array
+14 ;
+15 ;Check for required parameters
+16 IF "GL"'[$GET(ARAYTYPE)!($GET(SUB1)']"")!('$GET(MTIEN))
GOTO MERGEX
+17 ;
+18 NEW HLCHAR,HLEVN,HLFS,I,X,X1,X2,X3
SET (HLCHAR,HLEVN,X)=0
+19 ;
+20 ; patch HL*1.6*122: MPI-client/server
+21 FOR
LOCK +^HL(772,+$GET(MTIEN)):10
if $TEST
QUIT
HANG 1
+22 ;
+23 ;Merge data from a global array with two subscript
+24 IF ARAYTYPE="G"
IF $GET(SUB2)'=""
Begin DoDot:1
+25 SET X=""
SET I=0
+26 FOR
SET X=$ORDER(^TMP(SUB1,$JOB,SUB2,X))
if 'X
QUIT
SET I=I+1
SET X1=^TMP(SUB1,$JOB,SUB2,X)
SET HLCHAR=HLCHAR+$LENGTH(X1)
if $EXTRACT(X1,1,3)="MSH"
SET HLFS=$EXTRACT(X1,4)
SET $PIECE(X1,HLFS,8)=""
SET HLEVN=HLEVN+1
SET ^HL(772,MTIEN,"IN",I,0)=X1
SET X2=$DATA(^TMP(SUB1,$JOB,SUB2,X))
Begin DoDot:2
+27 IF X2=11
SET X3=""
FOR
SET X3=$ORDER(^TMP(SUB1,$JOB,SUB2,X,X3))
if 'X3
QUIT
Begin DoDot:3
+28 SET I=I+1
SET X1=$GET(^TMP(SUB1,$JOB,SUB2,X,X3))
SET HLCHAR=HLCHAR+$LENGTH(X1)
SET ^HL(772,MTIEN,"IN",I,0)=X1
End DoDot:3
+29 SET I=I+1
SET ^HL(772,MTIEN,"IN",I,0)=""
QUIT
End DoDot:2
End DoDot:1
+30 ;
+31 ;Merge data from a global array with one subscripts
+32 IF ARAYTYPE="G"
IF $GET(SUB2)=""
Begin DoDot:1
+33 SET X=""
SET I=0
+34 FOR
SET X=$ORDER(^TMP(SUB1,$JOB,X))
if 'X
QUIT
SET I=I+1
SET X1=^TMP(SUB1,$JOB,X)
SET HLCHAR=HLCHAR+$LENGTH(X1)
if $EXTRACT(X1,1,3)="MSH"
SET HLFS=$EXTRACT(X1,4)
SET $PIECE(X1,HLFS,8)=""
SET HLEVN=HLEVN+1
SET ^HL(772,MTIEN,"IN",I,0)=X1
SET X2=$DATA(^TMP(SUB1,$JOB,X))
Begin DoDot:2
+35 IF X2=11
SET X3=""
FOR
SET X3=$ORDER(^TMP(SUB1,$JOB,X,X3))
if 'X3
QUIT
Begin DoDot:3
+36 SET I=I+1
SET X1=$GET(^TMP(SUB1,$JOB,X,X3))
SET HLCHAR=HLCHAR+$LENGTH(X1)
SET ^HL(772,MTIEN,"IN",I,0)=X1
End DoDot:3
+37 SET I=I+1
SET ^HL(772,MTIEN,"IN",I,0)=""
QUIT
End DoDot:2
End DoDot:1
+38 ;
+39 ;Merge data from a local array with one subscript
+40 IF ARAYTYPE="L"
Begin DoDot:1
+41 SET X=""
SET I=0
+42 FOR
SET X=$ORDER(HLA(SUB1,X))
if 'X
QUIT
SET I=I+1
SET X1=HLA(SUB1,X)
SET HLCHAR=HLCHAR+$LENGTH(X1)
if $EXTRACT(X1,1,3)="MSH"
SET HLFS=$EXTRACT(X1,4)
SET $PIECE(X1,HLFS,8)=""
SET HLEVN=HLEVN+1
SET ^HL(772,MTIEN,"IN",I,0)=X1
SET X2=$DATA(HLA(SUB1,X))
Begin DoDot:2
+43 IF X2=11
SET X3=""
FOR
SET X3=$ORDER(HLA(SUB1,X,X3))
if 'X3
QUIT
Begin DoDot:3
+44 SET I=I+1
SET X1=$GET(HLA(SUB1,X,X3))
SET HLCHAR=HLCHAR+$LENGTH(X1)
SET ^HL(772,MTIEN,"IN",I,0)=X1
End DoDot:3
+45 SET I=I+1
SET ^HL(772,MTIEN,"IN",I,0)=""
QUIT
End DoDot:2
End DoDot:1
+46 ;
+47 if HLEVN=0
SET HLEVN=1
+48 ;X=ien in file 773 for TCP messages
+49 SET X=+$ORDER(^HLMA("B",MTIEN,0))
+50 ;batch message type
+51 IF X
IF $PIECE($GET(^HLMA(X,0)),U,5)="B"
DO BTS
+52 IF 'X
IF $PIECE(^HL(772,MTIEN,0),U,8)
IF $PIECE(^HL(772,$PIECE(^(0),U,8),0),U,14)="B"
DO BTS
+53 ;
+54 ;-- update 0 node for message text
+55 SET ^HL(772,MTIEN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
+56 ;
+57 ; patch HL*1.6*122: MPI-client/server
+58 LOCK -^HL(772,+$GET(MTIEN))
+59 ;
+60 ;File message statistics
+61 DO STATS^HLTF0(MTIEN,HLCHAR,HLEVN)
+62 ;
MERGEX ;-- exit merge
+1 QUIT
+2 ;
BTS ; create batch trailer seg (BTS)
+1 ;HL*1.6*78 to obtain and insert FIELD SEPARATOR, HLFS
+2 NEW HLFS,HLSAN
+3 ; obtain from HL array
SET HLFS=$GET(HL("FS"))
+4 ; or obtain from sending application; default to "^"
+5 IF HLFS=""
Begin DoDot:1
+6 SET HLSAN=$PIECE($GET(^HL(772,MTIEN,0)),U,2)
+7 if HLSAN
SET HLFS=$GET(^HL(771,HLSAN,"FS"))
End DoDot:1
if HLFS=""
SET HLFS="^"
+8 SET I=I+1
SET ^HL(772,MTIEN,"IN",I,0)="BTS"_HLFS_HLEVN
SET I=I+1
SET ^HL(772,MTIEN,"IN",I,0)=""
+9 QUIT
+10 ;
MRGINT(MTOUT,MTIN,HDR) ;Merge Internal to Internal Message from the
+1 ; Outbound message in 772 (MTOUT) to an Inbound entry (MTIN). The process
+2 ; will involve Moving the Header and Text into 772.
+3 ;
+4 ;Required input parameters
+5 ; MTOUT= Internal entry number of the Outbound message
+6 ; MTIN = Internal entry number of the Inbound message
+7 ; HDR = Name of the array that contains HL7 Header segment
+8 ; format: HLHDR - Used with indirection to build message in out
+9 ; queue
+10 ; This routine will first take the header information in the array
+11 ; specified by HDR and merge into the Message Text field of file 870.
+12 ; Then it will move the message contained in 772 (MTIEN) into 870.
+13 ;
+14 ;Check for required parameters
+15 IF '$GET(MTOUT)!('$GET(MTIN))!(HDR="")
QUIT
+16 ;
+17 ;-- initilize
+18 NEW I,X
+19 SET I=0
+20 ;
+21 ;-- move header into 772 from HDR array
+22 SET X=""
FOR
SET X=$ORDER(@HDR@(X))
if 'X
QUIT
Begin DoDot:1
+23 SET I=I+1
SET ^HL(772,MTIN,"IN",I,0)=@HDR@(X)
End DoDot:1
+24 SET I=I+1
SET ^HL(772,MTIN,"IN",I,0)=""
+25 ;
+26 ;Move data from Message Text (MTOUT) file TO Message Text 772 (MTIN)
+27 SET X=0
FOR
SET X=$ORDER(^HL(772,MTOUT,"IN",X))
if X=""
QUIT
SET I=I+1
Begin DoDot:1
+28 SET ^HL(772,MTIN,"IN",I,0)=$GET(^HL(772,MTOUT,"IN",X,0))
End DoDot:1
+29 ;
+30 ;-- update 0 node of message and format arrays
+31 SET ^HL(772,MTIN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
+32 ;
+33 QUIT
