- 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 Jan 18, 2025@02:41:20 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