LA7VHL ;DALOI/DLR - Main Driver for incoming HL7 V1.6 messages ;04/06/16 16:31
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,62,64,67,74,88**;Sep 27, 1994;Build 10
;
; This routine is not meant to be invoked by name
;
QUIT
;
; This routine is called by the HL v1.6 package to process incoming HL7 messages. Expected variables are those documented in the HL7 package documentation.
; The line tag is called if it is entered into the PROCESSING ROUTINE field for the server protocol.
;
ORR ; Process incoming ORR messages
ACK ; Process incoming ACK messages
ORM ; Process incoming ORM messages
ORU ; Process incoming ORU messages
;
N DIQUIET,HLA,HLL,HLP,X,Y
N LA76248,LA76249,LA7AAT,LA7AERR,LA7CS,LA7DT,LA7ECH,LA7ERR,LA7FS,LA7HLS,LA7HLSA,LA7INTYP,LA7MEDT,LA7MTYP,LA7RAP,LA7PRID,LA7RSITE,LA7SAP,LA7SEQ,LA7SSITE,LA7STYP,LA7TYPE,LA7VER,LA7VI,LA7VJ,LA7X,LRQUIET
;
; Prevent FileMan from issuing any unwanted WRITE(s).
S (DIQUIET,LRQUIET)=1
; Insure DT and DILOCKTM is defined
D DT^DICRW
;
S (LA76248,LA76249,LA7INTYP,LA7SEQ)=0,(LA7AERR,LA7ERR)=""
;
K ^TMP("HLA",$J)
;
; Setup DUZ array to 'non-human' user LRLAB,HL
; If user not found - send alert to G.LAB MESSAGING
S LA7X=$P($G(^XTMP("LA7 PROXY","LRLAB,HL")),"^")
I LA7X<1 D
. S LA7X=$$FIND1^DIC(200,"","OQUX","LRLAB,HL","B","")
. S ^XTMP("LA7 PROXY",0)=DT_"^"_DT_"^LAB HL7 PROXY USERS"
. I LA7X>0 S ^XTMP("LA7 PROXY","LRLAB,HL")=LA7X
I LA7X<1 D Q
. N MSG
. S MSG="Lab Messaging - Unable to identify user 'LRLAB,HL' in NEW PERSON file"
. D XQA^LA7UXQA(0,LA76248,0,0,MSG,"",0)
D DUZ^XUP(LA7X)
;
; Set up LA7HLS with HL variables to build ACK message.
; Handle situation when systems use different encoding characters.
D RSPINIT^HLFNC2(HL("EIDS"),.LA7HLS)
;
; Move message from HL7 global to Lab global
F LA7VI=1:1 X HLNEXT Q:HLQUIT'>0 D
. K LA7SEG,LA7STYP
. I HLNODE="" Q
. S LA7SEG(0)=HLNODE,LA7STYP=$E(LA7SEG(0),1,3)
. I LA7STYP'?2U1UN D
. . S LA7ERR=34,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
. . D REJECT($P(LA7AERR,"^",2))
. S LA7VJ=0
. F S LA7VJ=$O(HLNODE(LA7VJ)) Q:'LA7VJ S LA7SEG(LA7VJ)=HLNODE(LA7VJ)
. I LA7STYP="MSH" D MSH
. I LA7AERR="",LA7SEQ<1 D REJECT("no MSH segment found") Q
. D FILE6249^LA7VHLU(LA76249,.LA7SEG)
;
; Update entry in 62.49
; Change status to (Q)ueued for processing from (B)uilding
I LA76249>0,$P($G(^LAHM(62.49,LA76249,0)),"^",3)'="E" D
. N FDA,LA7ERR
. S FDA(1,62.49,LA76249_",",2)="Q"
. D FILE^DIE("","FDA(1)","LA7ERR(1)")
;
; Release lock on file #62.49 entry (tells LA7VIN message is stored).
I LA76249>0 L -^LAHM(62.49,LA76249)
;
; Run processing routine
I '$D(^LAHM(62.48,LA76248,1)) S LA7ERR=5,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
I $D(^LAHM(62.48,LA76248,1)) X ^(1)
;
; Don't (ACK)nowledge ACK or ORR messages
I $G(LA7MTYP)="ACK"!($G(LA7MTYP)="ORR") Q
;
; No application acknowledgement
I $G(LA7AAT(1))="NE" Q
;
; Other system only wants ACK on successful completion condition and we found an error.
I $G(LA7AERR)'="",$G(LA7AAT(1))="SU" Q
;
; Other system only wants ACK on error/reject condition
I $G(LA7AERR)="",$G(LA7AAT(1))="ER" Q
;
; If POC interface and no error then quit - send application ack after processing message.
I $G(LA7AERR)="",LA7INTYP>19,LA7INTYP<30 S X=$$DONTPURG^HLUTIL() Q
;
; If LEDI interface and ORM message and no error then quit - send application ack after processing message.
I $G(LA7AERR)="",LA7INTYP=10,$G(LA7MTYP)="ORM" S X=$$DONTPURG^HLUTIL() Q
;
; If UI interface using enchanced acknowlegment and ORU message and no error then quit - send application ack after processing message.
I $G(LA7AERR)="",LA7INTYP=1,$G(LA7AAT(1))'="",$G(LA7MTYP)="ORU" S X=$$DONTPURG^HLUTIL() Q
;
; If POC interface and error then setup HLL array
I LA7INTYP>19,LA7INTYP<30 D
. S HLL("SET FOR APP ACK")=1
. S HLL("LINKS",1)=HL("EIDS")_"^"_$S($G(LA76248):$P(LA76248(0),"^"),1:$G(LA7SAP))
;
; If Lab UI interface using enhanced ack and error then setup HLL array
I LA7INTYP=1,$G(LA7AAT(1))'="" D
. S HLL("SET FOR APP ACK")=1
. S HLL("LINKS",1)=HL("EIDS")_"^"_$S($G(LA76248):$P(LA76248(0),"^"),1:$G(LA7SAP))
;
; HL7 returns this as ACK if no errors found
I $G(LA7AERR)="" S HLA("HLA",1)="MSA"_LA7HLS("RFS")_"AA"_LA7HLS("RFS")_HL("MID")
;
; Send ACK message
I $D(HLA("HLA")) D
. S HLP("NAMESPACE")="LA"
. S HLP("SUBSCRIBER")="^"_LA7RAP_"^"_LA7RSITE
. D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.LA7HLSA,"",.HLP)
;
I $D(^TMP("HLA",$J)) D
. S HLP("NAMESPACE")="LA"
. S HLP("SUBSCRIBER")="^"_LA7RAP_"^"_LA7RSITE
. D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.LA7HLSA,"",.HLP)
;
Q
;
;
MSH ;;MSH
;
N LA7CFIG,LA7MID,LA7NOW,X
;
S LA7SEQ=1
S LA7FS=$E(LA7SEG(0),4)
S LA7ECH=$E(LA7SEG(0),5,8)
S LA7CS=$E(LA7ECH,1)
; Sending application
S LA7SAP=$P($$P^LA7VHLU(.LA7SEG,3,LA7FS),LA7CS)
; Sending facility
S LA7SSITE=$P($$P^LA7VHLU(.LA7SEG,4,LA7FS),LA7CS)
; Receiving application
S LA7RAP=$P($$P^LA7VHLU(.LA7SEG,5,LA7FS),LA7CS)
; Receiving facility
S LA7RSITE=$P($$P^LA7VHLU(.LA7SEG,6,LA7FS),LA7CS)
; Date/time of message
S LA7MEDT=$$P^LA7VHLU(.LA7SEG,7,LA7FS)
; Message type/trigger event/message structure
S X=$$P^LA7VHLU(.LA7SEG,9,LA7FS)
S LA7MTYP=$P(X,LA7CS),LA7MTYP("EVN")=$P(X,LA7CS,2),LA7MTYP("MSGSTR")=$P(X,LA7CS,3)
; Message Control ID
S LA7MID=$$P^LA7VHLU(.LA7SEG,10,LA7FS)
; Processing ID
S LA7PRID=$$P^LA7VHLU(.LA7SEG,11,LA7FS)
; Version ID
S LA7VER=$$P^LA7VHLU(.LA7SEG,12,LA7FS)
; Accept acknowledgement type
S LA7AAT(0)=$$P^LA7VHLU(.LA7SEG,15,LA7FS)
; Application acknowledgement type
S LA7AAT(1)=$$P^LA7VHLU(.LA7SEG,16,LA7FS)
;
S LA7CFIG=LA7SAP_LA7SSITE_LA7RAP_LA7RSITE
S X=LA7CFIG X ^%ZOSF("LPC")
S LA76248=+$O(^LAHM(62.48,"C",$E(LA7CFIG,1,27)_Y,0))
I 'LA76248 S LA76248=+$O(^LAHM(62.48,"B",LA7SAP,0))
I 'LA76248,$E(LA7SAP,1,11)="LA7V REMOTE" S LA76248=+$O(^LAHM(62.48,"B","LA7V COLLECTION "_$P(LA7SAP," ",3),0))
I 'LA76248 D Q
. S LA7ERR=1,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
. D REJECT("no config in 62.48")
;
S LA76248(0)=$G(^LAHM(62.48,LA76248,0))
;
; Determine interface type
S LA7INTYP=+$P(^LAHM(62.48,LA76248,0),"^",9)
;
I '$P($G(^LAHM(62.48,LA76248,0)),"^",3) D
. S LA7ERR=3,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
. D REJECT("config is inactive")
;
; store incoming message in ^LAHM(62.49)
S LA76249=$$INIT6249^LA7VHLU
I LA76249<1 Q
;
; update entry in 62.49
N FDA,LA7FERR
I $G(LA76248) S FDA(1,62.49,LA76249_",",.5)=LA76248
S FDA(1,62.49,LA76249_",",1)="I"
I LA7ERR S FDA(1,62.49,LA76249_",",2)="E"
S FDA(1,62.49,LA76249_",",3)=3
S FDA(1,62.49,LA76249_",",102)=LA7SAP
S FDA(1,62.49,LA76249_",",103)=LA7SSITE
S FDA(1,62.49,LA76249_",",104)=LA7RAP
S FDA(1,62.49,LA76249_",",105)=LA7RSITE
S FDA(1,62.49,LA76249_",",106)=LA7MEDT
S FDA(1,62.49,LA76249_",",108)=LA7MTYP
S FDA(1,62.49,LA76249_",",109)=LA7MID
S FDA(1,62.49,LA76249_",",110)=LA7PRID
S FDA(1,62.49,LA76249_",",111)=LA7VER
S FDA(1,62.49,LA76249_",",700)=HL("EID")_";"_HLMTIENS_";"_HL("EIDS")
D FILE^DIE("","FDA(1)","LA7FERR(1)")
;
Q
;
;
REJECT(LA7AR) ; Build a reject segment if the incoming message could not be processed.
; Setting HLA("HLA",1) conforms to HL7 package rules for acknowledgements
; LA7AR is a free text string that is included in the reject
; message for debugging purposes.
;
S HLA("HLA",1)="MSA"_LA7HLS("RFS")_"AR"_LA7HLS("RFS")_HL("MID")_LA7HLS("RFS")_LA7AR
S LA7AERR=LA7AR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VHL 7559 printed Dec 13, 2024@01:40:05 Page 2
LA7VHL ;DALOI/DLR - Main Driver for incoming HL7 V1.6 messages ;04/06/16 16:31
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,62,64,67,74,88**;Sep 27, 1994;Build 10
+2 ;
+3 ; This routine is not meant to be invoked by name
+4 ;
+5 QUIT
+6 ;
+7 ; This routine is called by the HL v1.6 package to process incoming HL7 messages. Expected variables are those documented in the HL7 package documentation.
+8 ; The line tag is called if it is entered into the PROCESSING ROUTINE field for the server protocol.
+9 ;
ORR ; Process incoming ORR messages
ACK ; Process incoming ACK messages
ORM ; Process incoming ORM messages
ORU ; Process incoming ORU messages
+1 ;
+2 NEW DIQUIET,HLA,HLL,HLP,X,Y
+3 NEW LA76248,LA76249,LA7AAT,LA7AERR,LA7CS,LA7DT,LA7ECH,LA7ERR,LA7FS,LA7HLS,LA7HLSA,LA7INTYP,LA7MEDT,LA7MTYP,LA7RAP,LA7PRID,LA7RSITE,LA7SAP,LA7SEQ,LA7SSITE,LA7STYP,LA7TYPE,LA7VER,LA7VI,LA7VJ,LA7X,LRQUIET
+4 ;
+5 ; Prevent FileMan from issuing any unwanted WRITE(s).
+6 SET (DIQUIET,LRQUIET)=1
+7 ; Insure DT and DILOCKTM is defined
+8 DO DT^DICRW
+9 ;
+10 SET (LA76248,LA76249,LA7INTYP,LA7SEQ)=0
SET (LA7AERR,LA7ERR)=""
+11 ;
+12 KILL ^TMP("HLA",$JOB)
+13 ;
+14 ; Setup DUZ array to 'non-human' user LRLAB,HL
+15 ; If user not found - send alert to G.LAB MESSAGING
+16 SET LA7X=$PIECE($GET(^XTMP("LA7 PROXY","LRLAB,HL")),"^")
+17 IF LA7X<1
Begin DoDot:1
+18 SET LA7X=$$FIND1^DIC(200,"","OQUX","LRLAB,HL","B","")
+19 SET ^XTMP("LA7 PROXY",0)=DT_"^"_DT_"^LAB HL7 PROXY USERS"
+20 IF LA7X>0
SET ^XTMP("LA7 PROXY","LRLAB,HL")=LA7X
End DoDot:1
+21 IF LA7X<1
Begin DoDot:1
+22 NEW MSG
+23 SET MSG="Lab Messaging - Unable to identify user 'LRLAB,HL' in NEW PERSON file"
+24 DO XQA^LA7UXQA(0,LA76248,0,0,MSG,"",0)
End DoDot:1
QUIT
+25 DO DUZ^XUP(LA7X)
+26 ;
+27 ; Set up LA7HLS with HL variables to build ACK message.
+28 ; Handle situation when systems use different encoding characters.
+29 DO RSPINIT^HLFNC2(HL("EIDS"),.LA7HLS)
+30 ;
+31 ; Move message from HL7 global to Lab global
+32 FOR LA7VI=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+33 KILL LA7SEG,LA7STYP
+34 IF HLNODE=""
QUIT
+35 SET LA7SEG(0)=HLNODE
SET LA7STYP=$EXTRACT(LA7SEG(0),1,3)
+36 IF LA7STYP'?2U1UN
Begin DoDot:2
+37 SET LA7ERR=34
SET LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
+38 DO REJECT($PIECE(LA7AERR,"^",2))
End DoDot:2
+39 SET LA7VJ=0
+40 FOR
SET LA7VJ=$ORDER(HLNODE(LA7VJ))
if 'LA7VJ
QUIT
SET LA7SEG(LA7VJ)=HLNODE(LA7VJ)
+41 IF LA7STYP="MSH"
DO MSH
+42 IF LA7AERR=""
IF LA7SEQ<1
DO REJECT("no MSH segment found")
QUIT
+43 DO FILE6249^LA7VHLU(LA76249,.LA7SEG)
End DoDot:1
+44 ;
+45 ; Update entry in 62.49
+46 ; Change status to (Q)ueued for processing from (B)uilding
+47 IF LA76249>0
IF $PIECE($GET(^LAHM(62.49,LA76249,0)),"^",3)'="E"
Begin DoDot:1
+48 NEW FDA,LA7ERR
+49 SET FDA(1,62.49,LA76249_",",2)="Q"
+50 DO FILE^DIE("","FDA(1)","LA7ERR(1)")
End DoDot:1
+51 ;
+52 ; Release lock on file #62.49 entry (tells LA7VIN message is stored).
+53 IF LA76249>0
LOCK -^LAHM(62.49,LA76249)
+54 ;
+55 ; Run processing routine
+56 IF '$DATA(^LAHM(62.48,LA76248,1))
SET LA7ERR=5
SET LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
+57 IF $DATA(^LAHM(62.48,LA76248,1))
XECUTE ^(1)
+58 ;
+59 ; Don't (ACK)nowledge ACK or ORR messages
+60 IF $GET(LA7MTYP)="ACK"!($GET(LA7MTYP)="ORR")
QUIT
+61 ;
+62 ; No application acknowledgement
+63 IF $GET(LA7AAT(1))="NE"
QUIT
+64 ;
+65 ; Other system only wants ACK on successful completion condition and we found an error.
+66 IF $GET(LA7AERR)'=""
IF $GET(LA7AAT(1))="SU"
QUIT
+67 ;
+68 ; Other system only wants ACK on error/reject condition
+69 IF $GET(LA7AERR)=""
IF $GET(LA7AAT(1))="ER"
QUIT
+70 ;
+71 ; If POC interface and no error then quit - send application ack after processing message.
+72 IF $GET(LA7AERR)=""
IF LA7INTYP>19
IF LA7INTYP<30
SET X=$$DONTPURG^HLUTIL()
QUIT
+73 ;
+74 ; If LEDI interface and ORM message and no error then quit - send application ack after processing message.
+75 IF $GET(LA7AERR)=""
IF LA7INTYP=10
IF $GET(LA7MTYP)="ORM"
SET X=$$DONTPURG^HLUTIL()
QUIT
+76 ;
+77 ; If UI interface using enchanced acknowlegment and ORU message and no error then quit - send application ack after processing message.
+78 IF $GET(LA7AERR)=""
IF LA7INTYP=1
IF $GET(LA7AAT(1))'=""
IF $GET(LA7MTYP)="ORU"
SET X=$$DONTPURG^HLUTIL()
QUIT
+79 ;
+80 ; If POC interface and error then setup HLL array
+81 IF LA7INTYP>19
IF LA7INTYP<30
Begin DoDot:1
+82 SET HLL("SET FOR APP ACK")=1
+83 SET HLL("LINKS",1)=HL("EIDS")_"^"_$SELECT($GET(LA76248):$PIECE(LA76248(0),"^"),1:$GET(LA7SAP))
End DoDot:1
+84 ;
+85 ; If Lab UI interface using enhanced ack and error then setup HLL array
+86 IF LA7INTYP=1
IF $GET(LA7AAT(1))'=""
Begin DoDot:1
+87 SET HLL("SET FOR APP ACK")=1
+88 SET HLL("LINKS",1)=HL("EIDS")_"^"_$SELECT($GET(LA76248):$PIECE(LA76248(0),"^"),1:$GET(LA7SAP))
End DoDot:1
+89 ;
+90 ; HL7 returns this as ACK if no errors found
+91 IF $GET(LA7AERR)=""
SET HLA("HLA",1)="MSA"_LA7HLS("RFS")_"AA"_LA7HLS("RFS")_HL("MID")
+92 ;
+93 ; Send ACK message
+94 IF $DATA(HLA("HLA"))
Begin DoDot:1
+95 SET HLP("NAMESPACE")="LA"
+96 SET HLP("SUBSCRIBER")="^"_LA7RAP_"^"_LA7RSITE
+97 DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.LA7HLSA,"",.HLP)
End DoDot:1
+98 ;
+99 IF $DATA(^TMP("HLA",$JOB))
Begin DoDot:1
+100 SET HLP("NAMESPACE")="LA"
+101 SET HLP("SUBSCRIBER")="^"_LA7RAP_"^"_LA7RSITE
+102 DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.LA7HLSA,"",.HLP)
End DoDot:1
+103 ;
+104 QUIT
+105 ;
+106 ;
MSH ;;MSH
+1 ;
+2 NEW LA7CFIG,LA7MID,LA7NOW,X
+3 ;
+4 SET LA7SEQ=1
+5 SET LA7FS=$EXTRACT(LA7SEG(0),4)
+6 SET LA7ECH=$EXTRACT(LA7SEG(0),5,8)
+7 SET LA7CS=$EXTRACT(LA7ECH,1)
+8 ; Sending application
+9 SET LA7SAP=$PIECE($$P^LA7VHLU(.LA7SEG,3,LA7FS),LA7CS)
+10 ; Sending facility
+11 SET LA7SSITE=$PIECE($$P^LA7VHLU(.LA7SEG,4,LA7FS),LA7CS)
+12 ; Receiving application
+13 SET LA7RAP=$PIECE($$P^LA7VHLU(.LA7SEG,5,LA7FS),LA7CS)
+14 ; Receiving facility
+15 SET LA7RSITE=$PIECE($$P^LA7VHLU(.LA7SEG,6,LA7FS),LA7CS)
+16 ; Date/time of message
+17 SET LA7MEDT=$$P^LA7VHLU(.LA7SEG,7,LA7FS)
+18 ; Message type/trigger event/message structure
+19 SET X=$$P^LA7VHLU(.LA7SEG,9,LA7FS)
+20 SET LA7MTYP=$PIECE(X,LA7CS)
SET LA7MTYP("EVN")=$PIECE(X,LA7CS,2)
SET LA7MTYP("MSGSTR")=$PIECE(X,LA7CS,3)
+21 ; Message Control ID
+22 SET LA7MID=$$P^LA7VHLU(.LA7SEG,10,LA7FS)
+23 ; Processing ID
+24 SET LA7PRID=$$P^LA7VHLU(.LA7SEG,11,LA7FS)
+25 ; Version ID
+26 SET LA7VER=$$P^LA7VHLU(.LA7SEG,12,LA7FS)
+27 ; Accept acknowledgement type
+28 SET LA7AAT(0)=$$P^LA7VHLU(.LA7SEG,15,LA7FS)
+29 ; Application acknowledgement type
+30 SET LA7AAT(1)=$$P^LA7VHLU(.LA7SEG,16,LA7FS)
+31 ;
+32 SET LA7CFIG=LA7SAP_LA7SSITE_LA7RAP_LA7RSITE
+33 SET X=LA7CFIG
XECUTE ^%ZOSF("LPC")
+34 SET LA76248=+$ORDER(^LAHM(62.48,"C",$EXTRACT(LA7CFIG,1,27)_Y,0))
+35 IF 'LA76248
SET LA76248=+$ORDER(^LAHM(62.48,"B",LA7SAP,0))
+36 IF 'LA76248
IF $EXTRACT(LA7SAP,1,11)="LA7V REMOTE"
SET LA76248=+$ORDER(^LAHM(62.48,"B","LA7V COLLECTION "_$PIECE(LA7SAP," ",3),0))
+37 IF 'LA76248
Begin DoDot:1
+38 SET LA7ERR=1
SET LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
+39 DO REJECT("no config in 62.48")
End DoDot:1
QUIT
+40 ;
+41 SET LA76248(0)=$GET(^LAHM(62.48,LA76248,0))
+42 ;
+43 ; Determine interface type
+44 SET LA7INTYP=+$PIECE(^LAHM(62.48,LA76248,0),"^",9)
+45 ;
+46 IF '$PIECE($GET(^LAHM(62.48,LA76248,0)),"^",3)
Begin DoDot:1
+47 SET LA7ERR=3
SET LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
+48 DO REJECT("config is inactive")
End DoDot:1
+49 ;
+50 ; store incoming message in ^LAHM(62.49)
+51 SET LA76249=$$INIT6249^LA7VHLU
+52 IF LA76249<1
QUIT
+53 ;
+54 ; update entry in 62.49
+55 NEW FDA,LA7FERR
+56 IF $GET(LA76248)
SET FDA(1,62.49,LA76249_",",.5)=LA76248
+57 SET FDA(1,62.49,LA76249_",",1)="I"
+58 IF LA7ERR
SET FDA(1,62.49,LA76249_",",2)="E"
+59 SET FDA(1,62.49,LA76249_",",3)=3
+60 SET FDA(1,62.49,LA76249_",",102)=LA7SAP
+61 SET FDA(1,62.49,LA76249_",",103)=LA7SSITE
+62 SET FDA(1,62.49,LA76249_",",104)=LA7RAP
+63 SET FDA(1,62.49,LA76249_",",105)=LA7RSITE
+64 SET FDA(1,62.49,LA76249_",",106)=LA7MEDT
+65 SET FDA(1,62.49,LA76249_",",108)=LA7MTYP
+66 SET FDA(1,62.49,LA76249_",",109)=LA7MID
+67 SET FDA(1,62.49,LA76249_",",110)=LA7PRID
+68 SET FDA(1,62.49,LA76249_",",111)=LA7VER
+69 SET FDA(1,62.49,LA76249_",",700)=HL("EID")_";"_HLMTIENS_";"_HL("EIDS")
+70 DO FILE^DIE("","FDA(1)","LA7FERR(1)")
+71 ;
+72 QUIT
+73 ;
+74 ;
REJECT(LA7AR) ; Build a reject segment if the incoming message could not be processed.
+1 ; Setting HLA("HLA",1) conforms to HL7 package rules for acknowledgements
+2 ; LA7AR is a free text string that is included in the reject
+3 ; message for debugging purposes.
+4 ;
+5 SET HLA("HLA",1)="MSA"_LA7HLS("RFS")_"AR"_LA7HLS("RFS")_HL("MID")_LA7HLS("RFS")_LA7AR
+6 SET LA7AERR=LA7AR
+7 QUIT
