- 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 Dec 13, 2024@01:59:54 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