- 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
