HLTF2 ;AISC/SAW/MTC-Process Message Text File Entries (Cont'd) ;02/24/97 13:56
;;1.6;HEALTH LEVEL SEVEN;**1**;APR 04, 1997
;;1.6;HEALTH LEVEL SEVEN;**25**;Oct 13, 1995
MERGEIN(LLD0,LLD1,MTIEN,HDR,MSA) ;Merge Data From Communication Server
;Module Logical Link File into Message Text File
;
;This is a subroutine call with parameter passing. The output
;parameters HDR (and optionally) MSA are returned by this call.
;
;Required input parameters
; LLD0 = Internal entry number where message is stored in Logical Link
; file or XM if message is stored in MailMan
; LLD1 = Internal entry number of IN QUEUE multiple entry in Logical
; Link file (Only required for messages stored in Logical
; Link file)
; MTIEN = Internal entry number where message is to be copied to in
; Message Text file
; HDR = The variable in which the message header segment will
; be returned
; MSA = The variable in which the message acknowledgement segment
; will be returned, if one exists for this message
;
;Check for required parameters
I $G(LLD0)']""!('$G(MTIEN)) Q
I LLD0'="XM",'$G(LLD1) Q
N FLG,HLCHAR,HLEVN,HLFS,I,X,X1,HLDONE
S (FLG,HLCHAR,HLEVN,X)=0
;
;Move data from Logical Link file to Message Text file
I LLD0'="XM" D
.S I=0 F S X=$O(^HLCS(870,LLD0,1,LLD1,1,X)) Q:X'>0 S X1=$G(^(X,0)) S:"FHS,BHS,MSH"[$E(X1,1,3) FLG=1 I FLG S HLCHAR=HLCHAR+$L(X1) D
..;If header segment, process it and set HDR equal to it
..I X1'="","FHS,BHS,MSH"[$E(X1,1,3) D
...I '$D(HDR) S HDR=X1,HLFS=$E(X1,4) I $E(HDR,1,3)="BHS" S MSA="MSA"_HLFS_$P($P(HDR,HLFS,10),$E(HDR,5),1)_HLFS_$P(HDR,HLFS,12)_HLFS_$P($P(HDR,HLFS,10),$E(HDR,5),2)
...S $P(X1,HLFS,8)=""
...S:$E(X1,1,3)="MSH" HLEVN=HLEVN+1
..;If acknowledgement segment, set MSA equal to it
..I $E(X1,1,3)="MSA",'$D(MSA),$E($G(HDR),1,3)="MSH" S MSA=X1
..S I=I+1,^HL(772,MTIEN,"IN",I,0)=X1
;
;Move data from MailMan Message file to Message Text file
I LLD0="XM" D
.S I=0 F X XMREC Q:XMER<0 S:"FHS,BHS,MSH"[$E(XMRG,1,3) FLG=1 I FLG S HLCHAR=HLCHAR+$L(XMRG) D Q:XMER<0
..;If header segment, process it and set HDR equal to it
..I XMRG'="","FHS,BHS,MSH"[$E(XMRG,1,3) D
...I '$D(HDR) S HDR=XMRG,HLFS=$E(XMRG,4) I $E(HDR,1,3)="BHS" S MSA="MSA"_HLFS_$P($P(HDR,HLFS,10),$E(HDR,5),1)_HLFS_$P(HDR,HLFS,12)_HLFS_$P($P(HDR,HLFS,10),$E(HDR,5),2)
...S $P(XMRG,HLFS,8)=""
...S:$E(XMRG,1,3)="MSH" HLEVN=HLEVN+1
..;If acknowledgement segment, set MSA equal to it
..I $E(XMRG,1,3)="MSA",'$D(MSA),$E($G(HDR),1,3)="MSH" S MSA=XMRG
..S I=I+1,^HL(772,MTIEN,"IN",I,0)=XMRG
S ^HL(772,MTIEN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
;Update statistics in Message Text file for this entry
D STATS^HLTF0(MTIEN,HLCHAR,HLEVN)
Q
MERGEOUT(MTIEN,LLD0,LLD1,HDR) ;Merge Text in Message Text File into
;Communication Server Module Logical Link File
;
;This is a routine call with parameter passing. There are no output
;parameters returned by this call.
;
;Required input parameters
; MTIEN = Internal entry number where message is stored in Message
; Text file
; LLD0 = Internal entry number where message is to be copied to in
; Logical Link file
; LLD1 = Internal entry number of IN QUEUE multiple entry in Logical
; Link file
; 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(MTIEN)!('$G(LLD0))!('$G(LLD1))!(HDR="") Q
;
;-- initilize
N I,X
S I=0
;
;-- move header into 870 from HDR array
S X="" F S X=$O(@HDR@(X)) Q:'X D
. S I=I+1,^HLCS(870,LLD0,2,LLD1,1,I,0)=@HDR@(X)
S I=I+1,^HLCS(870,LLD0,2,LLD1,1,I,0)=""
;
;Move data from Message Text file to Logical Link file
S X=0 F S X=$O(^HL(772,MTIEN,"IN",X)) Q:X="" D
. S I=I+1,^HLCS(870,LLD0,2,LLD1,1,I,0)=$G(^HL(772,MTIEN,"IN",X,0))
;
;-- update 0 node of message and format arrays
S ^HLCS(870,LLD0,2,LLD1,1,0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
;
Q
HLTF2 ;AISC/SAW/MTC-Process Message Text File Entries (Cont'd) ;02/24/97 13:56
+1 ;;1.6;HEALTH LEVEL SEVEN;**1**;APR 04, 1997
+2 ;;1.6;HEALTH LEVEL SEVEN;**25**;Oct 13, 1995
MERGEIN(LLD0,LLD1,MTIEN,HDR,MSA) ;Merge Data From Communication Server
+1 ;Module Logical Link File into Message Text File
+2 ;
+3 ;This is a subroutine call with parameter passing. The output
+4 ;parameters HDR (and optionally) MSA are returned by this call.
+5 ;
+6 ;Required input parameters
+7 ; LLD0 = Internal entry number where message is stored in Logical Link
+8 ; file or XM if message is stored in MailMan
+9 ; LLD1 = Internal entry number of IN QUEUE multiple entry in Logical
+10 ; Link file (Only required for messages stored in Logical
+11 ; Link file)
+12 ; MTIEN = Internal entry number where message is to be copied to in
+13 ; Message Text file
+14 ; HDR = The variable in which the message header segment will
+15 ; be returned
+16 ; MSA = The variable in which the message acknowledgement segment
+17 ; will be returned, if one exists for this message
+18 ;
+19 ;Check for required parameters
+20 IF $GET(LLD0)']""!('$GET(MTIEN))
QUIT
+21 IF LLD0'="XM"
IF '$GET(LLD1)
QUIT
+22 NEW FLG,HLCHAR,HLEVN,HLFS,I,X,X1,HLDONE
+23 SET (FLG,HLCHAR,HLEVN,X)=0
+24 ;
+25 ;Move data from Logical Link file to Message Text file
+26 IF LLD0'="XM"
Begin DoDot:1
+27 SET I=0
FOR
SET X=$ORDER(^HLCS(870,LLD0,1,LLD1,1,X))
IF X'>0
QUIT
SET X1=$GET(^(X,0))
IF "FHS,BHS,MSH"[$EXTRACT(X1,1,3)
SET FLG=1
IF FLG
SET HLCHAR=HLCHAR+$LENGTH(X1)
Begin DoDot:2
+28 ;If header segment, process it and set HDR equal to it
+29 IF X1'=""
IF "FHS,BHS,MSH"[$EXTRACT(X1,1,3)
Begin DoDot:3
+30 IF '$DATA(HDR)
SET HDR=X1
SET HLFS=$EXTRACT(X1,4)
IF $EXTRACT(HDR,1,3)="BHS"
SET MSA="MSA"_HLFS_$PIECE($PIECE(HDR,HLFS,10),$EXTRACT(HDR,5),1)_HLFS_$PIECE(HDR,HLFS,12)_HLFS_$PIECE($PIECE(HDR,HLFS,10),$EXTRACT(HDR,5),2)
+31 SET $PIECE(X1,HLFS,8)=""
+32 IF $EXTRACT(X1,1,3)="MSH"
SET HLEVN=HLEVN+1
End DoDot:3
+33 ;If acknowledgement segment, set MSA equal to it
+34 IF $EXTRACT(X1,1,3)="MSA"
IF '$DATA(MSA)
IF $EXTRACT($GET(HDR),1,3)="MSH"
SET MSA=X1
+35 SET I=I+1
SET ^HL(772,MTIEN,"IN",I,0)=X1
End DoDot:2
End DoDot:1
+36 ;
+37 ;Move data from MailMan Message file to Message Text file
+38 IF LLD0="XM"
Begin DoDot:1
+39 SET I=0
FOR
XECUTE XMREC
IF XMER<0
QUIT
IF "FHS,BHS,MSH"[$EXTRACT(XMRG,1,3)
SET FLG=1
IF FLG
SET HLCHAR=HLCHAR+$LENGTH(XMRG)
Begin DoDot:2
+40 ;If header segment, process it and set HDR equal to it
+41 IF XMRG'=""
IF "FHS,BHS,MSH"[$EXTRACT(XMRG,1,3)
Begin DoDot:3
+42 IF '$DATA(HDR)
SET HDR=XMRG
SET HLFS=$EXTRACT(XMRG,4)
IF $EXTRACT(HDR,1,3)="BHS"
SET MSA="MSA"_HLFS_$PIECE($PIECE(HDR,HLFS,10),$EXTRACT(HDR,5),1)_HLFS_$PIECE(HDR,HLFS,12)_HLFS_$PIECE($PIECE(HDR,HLFS,10),$EXTRACT(HDR,5),2)
+43 SET $PIECE(XMRG,HLFS,8)=""
+44 IF $EXTRACT(XMRG,1,3)="MSH"
SET HLEVN=HLEVN+1
End DoDot:3
+45 ;If acknowledgement segment, set MSA equal to it
+46 IF $EXTRACT(XMRG,1,3)="MSA"
IF '$DATA(MSA)
IF $EXTRACT($GET(HDR),1,3)="MSH"
SET MSA=XMRG
+47 SET I=I+1
SET ^HL(772,MTIEN,"IN",I,0)=XMRG
End DoDot:2
IF XMER<0
QUIT
End DoDot:1
+48 SET ^HL(772,MTIEN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
+49 ;Update statistics in Message Text file for this entry
+50 DO STATS^HLTF0(MTIEN,HLCHAR,HLEVN)
+51 QUIT
MERGEOUT(MTIEN,LLD0,LLD1,HDR) ;Merge Text in Message Text File into
+1 ;Communication Server Module Logical Link 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 = Internal entry number where message is stored in Message
+8 ; Text file
+9 ; LLD0 = Internal entry number where message is to be copied to in
+10 ; Logical Link file
+11 ; LLD1 = Internal entry number of IN QUEUE multiple entry in Logical
+12 ; Link file
+13 ; HDR = Name of the array that contains HL7 Header segment
+14 ; format: HLHDR - Used with indirection to build message in out
+15 ; queue
+16 ; This routine will first take the header information in the array
+17 ; specified by HDR and merge into the Message Text field of file 870.
+18 ; Then it will move the message contained in 772 (MTIEN) into 870.
+19 ;
+20 ;Check for required parameters
+21 IF '$GET(MTIEN)!('$GET(LLD0))!('$GET(LLD1))!(HDR="")
QUIT
+22 ;
+23 ;-- initilize
+24 NEW I,X
+25 SET I=0
+26 ;
+27 ;-- move header into 870 from HDR array
+28 SET X=""
FOR
SET X=$ORDER(@HDR@(X))
IF 'X
QUIT
Begin DoDot:1
+29 SET I=I+1
SET ^HLCS(870,LLD0,2,LLD1,1,I,0)=@HDR@(X)
End DoDot:1
+30 SET I=I+1
SET ^HLCS(870,LLD0,2,LLD1,1,I,0)=""
+31 ;
+32 ;Move data from Message Text file to Logical Link file
+33 SET X=0
FOR
SET X=$ORDER(^HL(772,MTIEN,"IN",X))
IF X=""
QUIT
Begin DoDot:1
+34 SET I=I+1
SET ^HLCS(870,LLD0,2,LLD1,1,I,0)=$GET(^HL(772,MTIEN,"IN",X,0))
End DoDot:1
+35 ;
+36 ;-- update 0 node of message and format arrays
+37 SET ^HLCS(870,LLD0,2,LLD1,1,0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
+38 ;
+39 QUIT
