Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7VHL

LA7VHL.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; This routine is not meant to be invoked by name
  1. ;
  1. QUIT
  1. ;
  1. ; 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.
  1. ; The line tag is called if it is entered into the PROCESSING ROUTINE field for the server protocol.
  1. ;
  1. ORR ; Process incoming ORR messages
  1. ACK ; Process incoming ACK messages
  1. ORM ; Process incoming ORM messages
  1. ORU ; Process incoming ORU messages
  1. ;
  1. N DIQUIET,HLA,HLL,HLP,X,Y
  1. 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
  1. ;
  1. ; Prevent FileMan from issuing any unwanted WRITE(s).
  1. S (DIQUIET,LRQUIET)=1
  1. ; Insure DT and DILOCKTM is defined
  1. D DT^DICRW
  1. ;
  1. S (LA76248,LA76249,LA7INTYP,LA7SEQ)=0,(LA7AERR,LA7ERR)=""
  1. ;
  1. K ^TMP("HLA",$J)
  1. ;
  1. ; Setup DUZ array to 'non-human' user LRLAB,HL
  1. ; If user not found - send alert to G.LAB MESSAGING
  1. S LA7X=$P($G(^XTMP("LA7 PROXY","LRLAB,HL")),"^")
  1. I LA7X<1 D
  1. . S LA7X=$$FIND1^DIC(200,"","OQUX","LRLAB,HL","B","")
  1. . S ^XTMP("LA7 PROXY",0)=DT_"^"_DT_"^LAB HL7 PROXY USERS"
  1. . I LA7X>0 S ^XTMP("LA7 PROXY","LRLAB,HL")=LA7X
  1. I LA7X<1 D Q
  1. . N MSG
  1. . S MSG="Lab Messaging - Unable to identify user 'LRLAB,HL' in NEW PERSON file"
  1. . D XQA^LA7UXQA(0,LA76248,0,0,MSG,"",0)
  1. D DUZ^XUP(LA7X)
  1. ;
  1. ; Set up LA7HLS with HL variables to build ACK message.
  1. ; Handle situation when systems use different encoding characters.
  1. D RSPINIT^HLFNC2(HL("EIDS"),.LA7HLS)
  1. ;
  1. ; Move message from HL7 global to Lab global
  1. F LA7VI=1:1 X HLNEXT Q:HLQUIT'>0 D
  1. . K LA7SEG,LA7STYP
  1. . I HLNODE="" Q
  1. . S LA7SEG(0)=HLNODE,LA7STYP=$E(LA7SEG(0),1,3)
  1. . I LA7STYP'?2U1UN D
  1. . . S LA7ERR=34,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
  1. . . D REJECT($P(LA7AERR,"^",2))
  1. . S LA7VJ=0
  1. . F S LA7VJ=$O(HLNODE(LA7VJ)) Q:'LA7VJ S LA7SEG(LA7VJ)=HLNODE(LA7VJ)
  1. . I LA7STYP="MSH" D MSH
  1. . I LA7AERR="",LA7SEQ<1 D REJECT("no MSH segment found") Q
  1. . D FILE6249^LA7VHLU(LA76249,.LA7SEG)
  1. ;
  1. ; Update entry in 62.49
  1. ; Change status to (Q)ueued for processing from (B)uilding
  1. I LA76249>0,$P($G(^LAHM(62.49,LA76249,0)),"^",3)'="E" D
  1. . N FDA,LA7ERR
  1. . S FDA(1,62.49,LA76249_",",2)="Q"
  1. . D FILE^DIE("","FDA(1)","LA7ERR(1)")
  1. ;
  1. ; Release lock on file #62.49 entry (tells LA7VIN message is stored).
  1. I LA76249>0 L -^LAHM(62.49,LA76249)
  1. ;
  1. ; Run processing routine
  1. I '$D(^LAHM(62.48,LA76248,1)) S LA7ERR=5,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
  1. I $D(^LAHM(62.48,LA76248,1)) X ^(1)
  1. ;
  1. ; Don't (ACK)nowledge ACK or ORR messages
  1. I $G(LA7MTYP)="ACK"!($G(LA7MTYP)="ORR") Q
  1. ;
  1. ; No application acknowledgement
  1. I $G(LA7AAT(1))="NE" Q
  1. ;
  1. ; Other system only wants ACK on successful completion condition and we found an error.
  1. I $G(LA7AERR)'="",$G(LA7AAT(1))="SU" Q
  1. ;
  1. ; Other system only wants ACK on error/reject condition
  1. I $G(LA7AERR)="",$G(LA7AAT(1))="ER" Q
  1. ;
  1. ; If POC interface and no error then quit - send application ack after processing message.
  1. I $G(LA7AERR)="",LA7INTYP>19,LA7INTYP<30 S X=$$DONTPURG^HLUTIL() Q
  1. ;
  1. ; If LEDI interface and ORM message and no error then quit - send application ack after processing message.
  1. I $G(LA7AERR)="",LA7INTYP=10,$G(LA7MTYP)="ORM" S X=$$DONTPURG^HLUTIL() Q
  1. ;
  1. ; If UI interface using enchanced acknowlegment and ORU message and no error then quit - send application ack after processing message.
  1. I $G(LA7AERR)="",LA7INTYP=1,$G(LA7AAT(1))'="",$G(LA7MTYP)="ORU" S X=$$DONTPURG^HLUTIL() Q
  1. ;
  1. ; If POC interface and error then setup HLL array
  1. I LA7INTYP>19,LA7INTYP<30 D
  1. . S HLL("SET FOR APP ACK")=1
  1. . S HLL("LINKS",1)=HL("EIDS")_"^"_$S($G(LA76248):$P(LA76248(0),"^"),1:$G(LA7SAP))
  1. ;
  1. ; If Lab UI interface using enhanced ack and error then setup HLL array
  1. I LA7INTYP=1,$G(LA7AAT(1))'="" D
  1. . S HLL("SET FOR APP ACK")=1
  1. . S HLL("LINKS",1)=HL("EIDS")_"^"_$S($G(LA76248):$P(LA76248(0),"^"),1:$G(LA7SAP))
  1. ;
  1. ; HL7 returns this as ACK if no errors found
  1. I $G(LA7AERR)="" S HLA("HLA",1)="MSA"_LA7HLS("RFS")_"AA"_LA7HLS("RFS")_HL("MID")
  1. ;
  1. ; Send ACK message
  1. I $D(HLA("HLA")) D
  1. . S HLP("NAMESPACE")="LA"
  1. . S HLP("SUBSCRIBER")="^"_LA7RAP_"^"_LA7RSITE
  1. . D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.LA7HLSA,"",.HLP)
  1. ;
  1. I $D(^TMP("HLA",$J)) D
  1. . S HLP("NAMESPACE")="LA"
  1. . S HLP("SUBSCRIBER")="^"_LA7RAP_"^"_LA7RSITE
  1. . D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.LA7HLSA,"",.HLP)
  1. ;
  1. Q
  1. ;
  1. ;
  1. MSH ;;MSH
  1. ;
  1. N LA7CFIG,LA7MID,LA7NOW,X
  1. ;
  1. S LA7SEQ=1
  1. S LA7FS=$E(LA7SEG(0),4)
  1. S LA7ECH=$E(LA7SEG(0),5,8)
  1. S LA7CS=$E(LA7ECH,1)
  1. ; Sending application
  1. S LA7SAP=$P($$P^LA7VHLU(.LA7SEG,3,LA7FS),LA7CS)
  1. ; Sending facility
  1. S LA7SSITE=$P($$P^LA7VHLU(.LA7SEG,4,LA7FS),LA7CS)
  1. ; Receiving application
  1. S LA7RAP=$P($$P^LA7VHLU(.LA7SEG,5,LA7FS),LA7CS)
  1. ; Receiving facility
  1. S LA7RSITE=$P($$P^LA7VHLU(.LA7SEG,6,LA7FS),LA7CS)
  1. ; Date/time of message
  1. S LA7MEDT=$$P^LA7VHLU(.LA7SEG,7,LA7FS)
  1. ; Message type/trigger event/message structure
  1. S X=$$P^LA7VHLU(.LA7SEG,9,LA7FS)
  1. S LA7MTYP=$P(X,LA7CS),LA7MTYP("EVN")=$P(X,LA7CS,2),LA7MTYP("MSGSTR")=$P(X,LA7CS,3)
  1. ; Message Control ID
  1. S LA7MID=$$P^LA7VHLU(.LA7SEG,10,LA7FS)
  1. ; Processing ID
  1. S LA7PRID=$$P^LA7VHLU(.LA7SEG,11,LA7FS)
  1. ; Version ID
  1. S LA7VER=$$P^LA7VHLU(.LA7SEG,12,LA7FS)
  1. ; Accept acknowledgement type
  1. S LA7AAT(0)=$$P^LA7VHLU(.LA7SEG,15,LA7FS)
  1. ; Application acknowledgement type
  1. S LA7AAT(1)=$$P^LA7VHLU(.LA7SEG,16,LA7FS)
  1. ;
  1. S LA7CFIG=LA7SAP_LA7SSITE_LA7RAP_LA7RSITE
  1. S X=LA7CFIG X ^%ZOSF("LPC")
  1. S LA76248=+$O(^LAHM(62.48,"C",$E(LA7CFIG,1,27)_Y,0))
  1. I 'LA76248 S LA76248=+$O(^LAHM(62.48,"B",LA7SAP,0))
  1. I 'LA76248,$E(LA7SAP,1,11)="LA7V REMOTE" S LA76248=+$O(^LAHM(62.48,"B","LA7V COLLECTION "_$P(LA7SAP," ",3),0))
  1. I 'LA76248 D Q
  1. . S LA7ERR=1,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
  1. . D REJECT("no config in 62.48")
  1. ;
  1. S LA76248(0)=$G(^LAHM(62.48,LA76248,0))
  1. ;
  1. ; Determine interface type
  1. S LA7INTYP=+$P(^LAHM(62.48,LA76248,0),"^",9)
  1. ;
  1. I '$P($G(^LAHM(62.48,LA76248,0)),"^",3) D
  1. . S LA7ERR=3,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
  1. . D REJECT("config is inactive")
  1. ;
  1. ; store incoming message in ^LAHM(62.49)
  1. S LA76249=$$INIT6249^LA7VHLU
  1. I LA76249<1 Q
  1. ;
  1. ; update entry in 62.49
  1. N FDA,LA7FERR
  1. I $G(LA76248) S FDA(1,62.49,LA76249_",",.5)=LA76248
  1. S FDA(1,62.49,LA76249_",",1)="I"
  1. I LA7ERR S FDA(1,62.49,LA76249_",",2)="E"
  1. S FDA(1,62.49,LA76249_",",3)=3
  1. S FDA(1,62.49,LA76249_",",102)=LA7SAP
  1. S FDA(1,62.49,LA76249_",",103)=LA7SSITE
  1. S FDA(1,62.49,LA76249_",",104)=LA7RAP
  1. S FDA(1,62.49,LA76249_",",105)=LA7RSITE
  1. S FDA(1,62.49,LA76249_",",106)=LA7MEDT
  1. S FDA(1,62.49,LA76249_",",108)=LA7MTYP
  1. S FDA(1,62.49,LA76249_",",109)=LA7MID
  1. S FDA(1,62.49,LA76249_",",110)=LA7PRID
  1. S FDA(1,62.49,LA76249_",",111)=LA7VER
  1. S FDA(1,62.49,LA76249_",",700)=HL("EID")_";"_HLMTIENS_";"_HL("EIDS")
  1. D FILE^DIE("","FDA(1)","LA7FERR(1)")
  1. ;
  1. Q
  1. ;
  1. ;
  1. 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
  1. ; LA7AR is a free text string that is included in the reject
  1. ; message for debugging purposes.
  1. ;
  1. S HLA("HLA",1)="MSA"_LA7HLS("RFS")_"AR"_LA7HLS("RFS")_HL("MID")_LA7HLS("RFS")_LA7AR
  1. S LA7AERR=LA7AR
  1. Q