[628] | 1 | HLTF2 ;AISC/SAW/MTC-Process Message Text File Entries (Cont'd) ;10/17/2007 09:44
|
---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**25,122**;Oct 13, 1995;Build 14
|
---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | MERGEIN(LLD0,LLD1,MTIEN,HDR,MSA) ;Merge Data From Communication Server
|
---|
| 6 | ;Module Logical Link File into Message Text File
|
---|
| 7 | ;
|
---|
| 8 | ;This is a subroutine call with parameter passing. The output
|
---|
| 9 | ;parameters HDR (and optionally) MSA are returned by this call.
|
---|
| 10 | ;
|
---|
| 11 | ;Required input parameters
|
---|
| 12 | ; LLD0 = Internal entry number where message is stored in Logical Link
|
---|
| 13 | ; file or XM if message is stored in MailMan
|
---|
| 14 | ; LLD1 = Internal entry number of IN QUEUE multiple entry in Logical
|
---|
| 15 | ; Link file (Only required for messages stored in Logical
|
---|
| 16 | ; Link file)
|
---|
| 17 | ; MTIEN = Internal entry number where message is to be copied to in
|
---|
| 18 | ; Message Text file
|
---|
| 19 | ; HDR = The variable in which the message header segment will
|
---|
| 20 | ; be returned
|
---|
| 21 | ; MSA = The variable in which the message acknowledgement segment
|
---|
| 22 | ; will be returned, if one exists for this message
|
---|
| 23 | ;
|
---|
| 24 | ;Check for required parameters
|
---|
| 25 | I $G(LLD0)']""!('$G(MTIEN)) Q
|
---|
| 26 | I LLD0'="XM",'$G(LLD1) Q
|
---|
| 27 | N FLG,HLCHAR,HLEVN,HLFS,I,X,X1,HLDONE
|
---|
| 28 | S (FLG,HLCHAR,HLEVN,X)=0
|
---|
| 29 | ;
|
---|
| 30 | ; patch HL*1.6*122: MPI-client/server
|
---|
| 31 | F L +^HL(772,+$G(MTIEN)):10 Q:$T H 1
|
---|
| 32 | ;
|
---|
| 33 | ;Move data from Logical Link file to Message Text file
|
---|
| 34 | I LLD0'="XM" D
|
---|
| 35 | .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
|
---|
| 36 | ..;If header segment, process it and set HDR equal to it
|
---|
| 37 | ..I X1'="","FHS,BHS,MSH"[$E(X1,1,3) D
|
---|
| 38 | ...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)
|
---|
| 39 | ...S $P(X1,HLFS,8)=""
|
---|
| 40 | ...S:$E(X1,1,3)="MSH" HLEVN=HLEVN+1
|
---|
| 41 | ..;If acknowledgement segment, set MSA equal to it
|
---|
| 42 | ..I $E(X1,1,3)="MSA",'$D(MSA),$E($G(HDR),1,3)="MSH" S MSA=X1
|
---|
| 43 | ..S I=I+1,^HL(772,MTIEN,"IN",I,0)=X1
|
---|
| 44 | ;
|
---|
| 45 | ;Move data from MailMan Message file to Message Text file
|
---|
| 46 | I LLD0="XM" D
|
---|
| 47 | .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
|
---|
| 48 | ..;If header segment, process it and set HDR equal to it
|
---|
| 49 | ..I XMRG'="","FHS,BHS,MSH"[$E(XMRG,1,3) D
|
---|
| 50 | ...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)
|
---|
| 51 | ...S $P(XMRG,HLFS,8)=""
|
---|
| 52 | ...S:$E(XMRG,1,3)="MSH" HLEVN=HLEVN+1
|
---|
| 53 | ..;If acknowledgement segment, set MSA equal to it
|
---|
| 54 | ..I $E(XMRG,1,3)="MSA",'$D(MSA),$E($G(HDR),1,3)="MSH" S MSA=XMRG
|
---|
| 55 | ..S I=I+1,^HL(772,MTIEN,"IN",I,0)=XMRG
|
---|
| 56 | S ^HL(772,MTIEN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
|
---|
| 57 | ;Update statistics in Message Text file for this entry
|
---|
| 58 | ;
|
---|
| 59 | ; patch HL*1.6*122: MPI-client/server
|
---|
| 60 | L -^HL(772,+$G(MTIEN))
|
---|
| 61 | ;
|
---|
| 62 | D STATS^HLTF0(MTIEN,HLCHAR,HLEVN)
|
---|
| 63 | Q
|
---|
| 64 | MERGEOUT(MTIEN,LLD0,LLD1,HDR) ;Merge Text in Message Text File into
|
---|
| 65 | ;Communication Server Module Logical Link File
|
---|
| 66 | ;
|
---|
| 67 | ;This is a routine call with parameter passing. There are no output
|
---|
| 68 | ;parameters returned by this call.
|
---|
| 69 | ;
|
---|
| 70 | ;Required input parameters
|
---|
| 71 | ; MTIEN = Internal entry number where message is stored in Message
|
---|
| 72 | ; Text file
|
---|
| 73 | ; LLD0 = Internal entry number where message is to be copied to in
|
---|
| 74 | ; Logical Link file
|
---|
| 75 | ; LLD1 = Internal entry number of IN QUEUE multiple entry in Logical
|
---|
| 76 | ; Link file
|
---|
| 77 | ; HDR = Name of the array that contains HL7 Header segment
|
---|
| 78 | ; format: HLHDR - Used with indirection to build message in out
|
---|
| 79 | ; queue
|
---|
| 80 | ; This routine will first take the header information in the array
|
---|
| 81 | ; specified by HDR and merge into the Message Text field of file 870.
|
---|
| 82 | ; Then it will move the message contained in 772 (MTIEN) into 870.
|
---|
| 83 | ;
|
---|
| 84 | ;Check for required parameters
|
---|
| 85 | I '$G(MTIEN)!('$G(LLD0))!('$G(LLD1))!(HDR="") Q
|
---|
| 86 | ;
|
---|
| 87 | ;-- initilize
|
---|
| 88 | N I,X
|
---|
| 89 | S I=0
|
---|
| 90 | ;
|
---|
| 91 | ; patch HL*1.6*122: MPI-client/server
|
---|
| 92 | F L +^HLCS(870,+$G(LLD0),2,+$G(LLD1)):10 Q:$T H 1
|
---|
| 93 | ;
|
---|
| 94 | ;-- move header into 870 from HDR array
|
---|
| 95 | S X="" F S X=$O(@HDR@(X)) Q:'X D
|
---|
| 96 | . S I=I+1,^HLCS(870,LLD0,2,LLD1,1,I,0)=@HDR@(X)
|
---|
| 97 | S I=I+1,^HLCS(870,LLD0,2,LLD1,1,I,0)=""
|
---|
| 98 | ;
|
---|
| 99 | ;Move data from Message Text file to Logical Link file
|
---|
| 100 | S X=0 F S X=$O(^HL(772,MTIEN,"IN",X)) Q:X="" D
|
---|
| 101 | . S I=I+1,^HLCS(870,LLD0,2,LLD1,1,I,0)=$G(^HL(772,MTIEN,"IN",X,0))
|
---|
| 102 | ;
|
---|
| 103 | ;-- update 0 node of message and format arrays
|
---|
| 104 | S ^HLCS(870,LLD0,2,LLD1,1,0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
|
---|
| 105 | ;
|
---|
| 106 | ; patch HL*1.6*122: MPI-client/server
|
---|
| 107 | L -^HLCS(870,+$G(LLD0),2,+$G(LLD1))
|
---|
| 108 | ;
|
---|
| 109 | Q
|
---|
| 110 | OUT(HLDA,HLMID,HLMTN) ;File Data in Message Text File for Outgoing Message
|
---|
| 111 | ;Version 1.5 Interface Only
|
---|
| 112 | ;
|
---|
| 113 | ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
|
---|
| 114 | ; OUT, IN, and ACK to HLTF2 routine.
|
---|
| 115 | ;
|
---|
| 116 | Q:'$D(HLFS)
|
---|
| 117 | ;
|
---|
| 118 | I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA) D ACK(HLMSA,"I") Q
|
---|
| 119 | ;
|
---|
| 120 | ;-- if message contained MSA find inbound message
|
---|
| 121 | I $D(HLMSA),$D(HLNDAP),$P(HLMSA,HLFS,3)]"" D
|
---|
| 122 | . N HLDAI
|
---|
| 123 | . S HLDAI=0
|
---|
| 124 | . F S HLDAI=$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),$P(HLMSA,HLFS,3),HLDAI)) Q:'HLDAI!($P($G(^HL(772,+HLDAI,0)),U,4)="I")
|
---|
| 125 | . I 'HLDAI K HLDAI
|
---|
| 126 | ;
|
---|
| 127 | D STUFF^HLTF0("O")
|
---|
| 128 | ;
|
---|
| 129 | N HLAC S HLAC=$S($D(HLERR):4,'$P(HLNDAP0,"^",10):1,1:2) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
|
---|
| 130 | D:$D(HLCHAR) STATS^HLTF0(HLDA,HLCHAR,$G(HLEVN))
|
---|
| 131 | ;
|
---|
| 132 | ;-- update status if MSA and found inbound message
|
---|
| 133 | I $D(HLMSA),$D(HLDAI) D
|
---|
| 134 | .N HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
|
---|
| 135 | .S HLAC=$P(HLMSA,HLFS,2)
|
---|
| 136 | .I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",HLAC="AE":"Application Error",1:"")_" - "_HLERR
|
---|
| 137 | .S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
|
---|
| 138 | Q
|
---|
| 139 | ;
|
---|
| 140 | IN(HLMTN,HLMID,HLTIME) ;File Data in Message Text File for Incoming Message
|
---|
| 141 | ;Version 1.5 Interface Only
|
---|
| 142 | ;
|
---|
| 143 | ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
|
---|
| 144 | ; OUT, IN, and ACK to HLTF2 routine.
|
---|
| 145 | ;
|
---|
| 146 | Q:'$D(HLFS)
|
---|
| 147 | I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA) D ACK(HLMSA,"O",$G(HLDA)) Q
|
---|
| 148 | ;
|
---|
| 149 | N HLDAI S HLDA=0
|
---|
| 150 | I $D(HLNDAP),HLMID]"" D
|
---|
| 151 | .F S HLDA=+$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),HLMID,HLDA)) Q:'HLDA!($P($G(^HL(772,+HLDA,0)),U,4)="I")
|
---|
| 152 | .I HLDA D
|
---|
| 153 | ..S HLDT=+$P($G(^HL(772,HLDA,0)),"^"),HLDT1=$$HLDATE^HLFNC(HLDT)
|
---|
| 154 | ..K ^HL(772,HLDA,"IN")
|
---|
| 155 | .I $D(HLMSA),$P(HLMSA,HLFS,3)]"" D
|
---|
| 156 | ..S HLDAI=0
|
---|
| 157 | ..F S HLDAI=$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),$P(HLMSA,HLFS,3),HLDAI)) Q:'HLDAI!($P($G(^HL(772,+HLDAI,0)),U,4)="O")
|
---|
| 158 | ..I 'HLDAI K HLDAI
|
---|
| 159 | ;
|
---|
| 160 | ; patch HL*1.6*122: MPI-client/server
|
---|
| 161 | ; I 'HLDA D CREATE(.HLMID,.HLDA,.HLDT,.HLDT1) K HLZ
|
---|
| 162 | I 'HLDA D CREATE^HLTF(.HLMID,.HLDA,.HLDT,.HLDT1) K HLZ
|
---|
| 163 | ;
|
---|
| 164 | D STUFF^HLTF0("I")
|
---|
| 165 | N HLAC S HLAC=$S($D(HLERR):4,1:1) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
|
---|
| 166 | ;
|
---|
| 167 | D MERGE15^HLTF1("G",HLDA,"HLR",HLTIME)
|
---|
| 168 | ;
|
---|
| 169 | I '$D(HLERR),$D(HLMSA),$D(HLDAI) D
|
---|
| 170 | .N HLAC,HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
|
---|
| 171 | .S HLAC=$P(HLMSA,HLFS,2) I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",1:"Application Error")_" - "_HLERR
|
---|
| 172 | .S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
|
---|
| 173 | Q
|
---|
| 174 | ;
|
---|
| 175 | ACK(HLMSA,HLIO,HLDA) ;Process 'ACK' Message Type - Version 1.5 Interface Only
|
---|
| 176 | ;
|
---|
| 177 | ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
|
---|
| 178 | ; OUT, IN, and ACK to HLTF2 routine.
|
---|
| 179 | ;
|
---|
| 180 | ; To determine the correct message to link the ACK, HLIO is used.
|
---|
| 181 | ; For an ack from DHCP (original message from remote system) then
|
---|
| 182 | ; HLIO should be "I" so that the correct inbound message is ack-ed. For
|
---|
| 183 | ; an inbound ack (original message outbound from DHCP) HLIO should be
|
---|
| 184 | ; "O". This distinction must be made due to the possible duplicate
|
---|
| 185 | ; message ids from a bi-direction interface.
|
---|
| 186 | ;
|
---|
| 187 | ; Input : MSA - MSA from ACK message.
|
---|
| 188 | ; HLIO - Either "I" or "O" : See note above.
|
---|
| 189 | ;Output : None
|
---|
| 190 | ;
|
---|
| 191 | N HLAC,HLMIDI
|
---|
| 192 | ;-- set up required vars
|
---|
| 193 | S HLAC=$P(HLMSA,HLFS,2),HLMIDI=$P(HLMSA,HLFS,3)
|
---|
| 194 | ;-- quit
|
---|
| 195 | Q:HLMIDI']""!(HLAC']"")!('$D(HLNDAP))
|
---|
| 196 | ;-- find message to ack
|
---|
| 197 | I '$G(HLDA) S HLDA=0 D
|
---|
| 198 | . F S HLDA=+$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),HLMIDI,HLDA)) Q:'HLDA!($P($G(^HL(772,+HLDA,0)),U,4)=HLIO)
|
---|
| 199 | ;-- quit if no message
|
---|
| 200 | Q:'$D(^HL(772,+HLDA,0))
|
---|
| 201 | ;-- check for error
|
---|
| 202 | I $P(HLMSA,HLFS,4)]"" N HLERR S HLERR=$P(HLMSA,HLFS,4)
|
---|
| 203 | I $D(HLERR),'$D(HLMSG) N HLMSG S HLMSG="Error During Receipt of Acknowledgement Message"_$S(HLAC="AR":" - Application Reject",HLAC="AE":" - Application Error",1:"")_" - "_HLERR
|
---|
| 204 | ;-- update status
|
---|
| 205 | S HLAC=$S(HLMTN="MCF":2,HLAC'="AA":4,1:3)
|
---|
| 206 | D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
|
---|
| 207 | Q
|
---|
| 208 | ;
|
---|