264 lines
7.5 KiB
Mathematica
264 lines
7.5 KiB
Mathematica
LA7VMSG1 ;DALOI/JMC - LAB ORU (Observation Result) message builder cont'd; 4-10-00
|
|
;;5.2;AUTOMATED LAB INSTRUMENTS;**56,46,61,64**;Sep 27, 1994
|
|
;
|
|
START ; Process entries in queue
|
|
; Called from LA7VMSG
|
|
;
|
|
N LA,LAER,LA7VER
|
|
N EID,HLEID,HLMTIEN,HLRESLT,HLARYTYP,HLECH,HLFS,HLCOMP,HLFORMAT
|
|
N GBL,LA7MID,LA7V,LA7VS,LA7V0N,LA7VIEN,RSITE,LRNT
|
|
N LA76248,LA76249,LA76249P,LA7DT,LA7ECH,LA7END,LA7FS,LA7NVAF,LA7ROOT,LA7X,LRDFN,LRUID
|
|
;
|
|
; variable list
|
|
; LA("LRUID") - Host Unique ID from the local ACCESSION file (#68)
|
|
; LA("SITE") - Primary site number of remote site ($$SITE^VASITE)
|
|
; LA("RUID") - Remote sites Unique ID from ACCESSION file (#68)
|
|
; LA("ORD") - Free text ordered test name from WKLD CODE file (#64)
|
|
; LA("LRNLT") - National Laboratory test code from WKLD CODE file (#64)
|
|
; LA("LRIDT") - Inverse date/time (accession date/time)
|
|
; LA("LRSS") - test subscript defined in LABORATORY TEST file (#60)
|
|
; LA("LRDFN") - IEN in LAB DATA file (#63)
|
|
; LA("ORDT") - Order date
|
|
; LA(62.49) - entry in #62.49 which contains pointer to results to build
|
|
;
|
|
L +^LAHM(62.49,"HL7 PROCESS",LA7MTYP):0 Q:'$T
|
|
;
|
|
S GBL="^TMP(""HLS"","_$J_")"
|
|
;
|
|
D SORTPAT
|
|
I $D(^TMP("LA76248",$J)) D PROCESS
|
|
D KVAR^LRX
|
|
;
|
|
; Release lock
|
|
L -^LAHM(62.49,"HL7 PROCESS",LA7MTYP)
|
|
;
|
|
K ^TMP("LA76248",$J),^TMP("LA7VS",$J),^TMP("HLS",$J)
|
|
;
|
|
I $D(ZTQUEUED) S ZTREQ="@"
|
|
;
|
|
Q
|
|
;
|
|
;
|
|
SORTPAT ; Sort all results for tranmsission
|
|
;
|
|
N LA76248,LA76249,LA7END,LA7ROOT,LRDFN,LRUID
|
|
;
|
|
K ^TMP("LA76248",$J)
|
|
; Flag to indicate end of global.
|
|
S LA7END=0
|
|
;
|
|
; Sort by configuration (LA76248), patient (LRDFN), UID (LRUID), file #62.49 ien (LA76249)
|
|
S LA7ROOT="^LAHM(62.49,""AC"",LA7MTYP,""P"")"
|
|
F S LA7ROOT=$Q(@LA7ROOT) Q:LA7END D
|
|
. I $QS(LA7ROOT,3)'=LA7MTYP!($QS(LA7ROOT,6)<1) S LA7END=1 Q
|
|
. S LA76248=$QS(LA7ROOT,5),LA76249=$QS(LA7ROOT,6)
|
|
. L +^LAHM(62.49,LA76249):5 Q:'$T
|
|
. S LRDFN=$P($G(^LAHM(62.49,LA76249,63)),"^",8)
|
|
. S LRUID=$P($G(^LAHM(62.49,LA76249,63)),"^",1)
|
|
. I LRDFN,LRUID]"" S ^TMP("LA76248",$J,LA76248,LRDFN,LRUID,LA76249)=""
|
|
. L -^LAHM(62.49,LA76249)
|
|
;
|
|
Q
|
|
;
|
|
;
|
|
PROCESS ; Process and build messages to be sent
|
|
;
|
|
N LA7101,LA76248,LA76249,LA76249P,LA7NTESN,LA7OBRSN,LA7OBXSN,LA7PIDSN,LA7SMSG,LA7VS,LRDFN
|
|
;
|
|
; Cleanup
|
|
K ^TMP("LA7VS",$J),^TMP("HLS",$J)
|
|
; Initialize variables
|
|
S (LA76248,LA76249,LA76249P,LA7END,LRDFN)=0,LRUID=""
|
|
;
|
|
; Process sorted list of results to transmit.
|
|
S LA7ROOT="^TMP(""LA76248"",$J)"
|
|
F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT="" D Q:LA7END
|
|
. I $QS(LA7ROOT,1)'="LA76248"!($QS(LA7ROOT,2)'=$J) S LA7END=1 Q
|
|
. I LA76248'=$QS(LA7ROOT,3) D CONFIG
|
|
. I '$P(LA76248(0),"^",3) Q
|
|
. S (LA76249,LA(62.49))=$QS(LA7ROOT,6)
|
|
. S LA7X=$G(^LAHM(62.49,LA76249,63))
|
|
. S LA("HUID")=$P(LA7X,U),LA("SITE")=$P(LA7X,U,2),LA("RUID")=$P(LA7X,U,3),LA("ORD")=$P(LA7X,U,4),LA("NLT")=$P(LA7X,U,5),LA("LRIDT")=$P(LA7X,U,6),LA("SUB")=$P(LA7X,U,7),LA("LRDFN")=$P(LA7X,U,8),LA("ORDT")=$P(LA7X,U,9)
|
|
. S LA7NVAF=$$NVAF^LA7VHLU2(+LA("SITE"))
|
|
. I LRUID'=$QS(LA7ROOT,5),LA7SMSG=2 D PAT Q:LA7END
|
|
. I LRDFN'=$QS(LA7ROOT,4) D PAT Q:LA7END
|
|
. S LRUID=$QS(LA7ROOT,5)
|
|
. S ^TMP("LA7VS",$J,LA76249)=LA76249P
|
|
. N LA76249
|
|
. S LA76249=LA76249P
|
|
. I LA7MTYP="ORU" D EN^LA7VORU(.LA)
|
|
. I LA7MTYP="ORR" D EN^LA7VORR1(.LA)
|
|
;
|
|
I LA76249P D SENDMSG
|
|
;
|
|
Q
|
|
;
|
|
;
|
|
STARTMSG ; Initialize a HL7 message and variables
|
|
;
|
|
N LA7EVNT,SITE
|
|
;
|
|
K ^TMP("LA7VS",$J),@GBL
|
|
;
|
|
S LA76249P=LA76249
|
|
S SITE=$$RETFACID^LA7VHLU2(LA("SITE"),2,1)
|
|
;
|
|
I LA7MTYP="ORU" S LA7EVNT="LA7V Results Reporting to "_SITE
|
|
I LA7MTYP="ORR" S LA7EVNT="LA7V Order Response to "_SITE
|
|
D STARTMSG^LA7VHLU(LA7EVNT,LA76249P)
|
|
I $G(HL) S LA7END=1
|
|
;
|
|
Q
|
|
;
|
|
;
|
|
SENDMSG ; File HL7 message with HL and LAB packages
|
|
;
|
|
; No data to send
|
|
I '$D(^TMP("HLS",$J)) Q
|
|
;
|
|
D GEN^LA7VHLU
|
|
I $P(LA7MID,U)=0 D
|
|
. N LA7X
|
|
. S LA7X(1)=LA76249P,LA7X(2)=$TR($P(HLMID,"^",2,3),"^","-")
|
|
. D CREATE^LA7LOG(28)
|
|
;
|
|
D UPDT6249
|
|
D UPDLPD
|
|
;
|
|
S (LA76249P,LA7PIDSN,LA7OBRSN,LA7OBXSN,LA7NTESN)=0
|
|
;
|
|
Q
|
|
;
|
|
;
|
|
CONFIG ; Setup for this configuration
|
|
;
|
|
; Send a building message
|
|
I LA76249P D SENDMSG
|
|
;
|
|
; Retrieve configuration information from #62.48
|
|
S LA76248=$QS(LA7ROOT,3)
|
|
S LA76248(0)=$G(^LAHM(62.48,LA76248,0))
|
|
;
|
|
; Flag to control message building; 1-one patient/msg, 2-one order/msg
|
|
S LA7SMSG=+$P(LA76248(0),"^",8)
|
|
;
|
|
; Initialize variables
|
|
S (LA76249,LA76249P,LRDFN)=0
|
|
S LRUID=""
|
|
;
|
|
Q
|
|
;
|
|
;
|
|
PAT ; Build patient information
|
|
;
|
|
N LA7ALTID,LA7EXTID,LA7PID,LA7PV1
|
|
;
|
|
; If one patient/msg or one order/msg and message building then send it.
|
|
I LA7SMSG>0,LA76249P D SENDMSG
|
|
;
|
|
; If no message building then start one.
|
|
I 'LA76249P S LA7PIDSN=0 D STARTMSG Q:LA7END
|
|
;
|
|
; Setup PID and PV1 segments.
|
|
S LRDFN=$QS(LA7ROOT,4)
|
|
S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3)
|
|
D DEM^LRX
|
|
;
|
|
; Send placer's patient id (PID-3), return in PID-2, return PID-4 with alternate id
|
|
S (LA7ALTID,LA7EXTID)=""
|
|
D PTEXTID^LA7VHLU(LA("SITE"),LA("RUID"),.LA7EXTID)
|
|
I $L($G(LA7EXTID("PID-2"))) S LA7EXTID=$$CNVFLD^LA7VHLU3(LA7EXTID("PID-2"),LA7EXTID("ECH"),LA7ECH)
|
|
I $L($G(LA7EXTID("PID-4"))) S LA7ALTID=$$CNVFLD^LA7VHLU3(LA7EXTID("PID-4"),LA7EXTID("ECH"),LA7ECH)
|
|
;
|
|
; Build PID segment
|
|
D PID^LA7VPID(LRDFN,LA7EXTID,.LA7PID,.LA7PIDSN,.HL,LA7ALTID)
|
|
D FILESEG^LA7VHLU(GBL,.LA7PID)
|
|
D FILE6249^LA7VHLU(LA76249P,.LA7PID)
|
|
;
|
|
; Build PV1 segment
|
|
; Not built when sending to DoD facility - not used by CHCS
|
|
I LA7NVAF'=1 D
|
|
. D PV1^LA7VPID(LRDFN,.LA7PV1,LA7FS,LA7ECH)
|
|
. D FILESEG^LA7VHLU(GBL,.LA7PV1)
|
|
. D FILE6249^LA7VHLU(LA76249P,.LA7PV1)
|
|
;
|
|
S LRUID="",(LA7OBRSN,LA7OBXSN,LA7NTESN)=0
|
|
;
|
|
Q
|
|
;
|
|
;
|
|
UPDT6249 ; Update entries in file #62.49
|
|
;
|
|
N LA7ERR,LA76249,LA76249P
|
|
;
|
|
S LA76249=0
|
|
F S LA76249=$O(^TMP("LA7VS",$J,LA76249)) Q:'LA76249 D
|
|
. N FDA,LA7ERR
|
|
. S LA76249P=+$G(^TMP("LA7VS",$J,LA76249))
|
|
. ; Set pointer to parent on child entry.
|
|
. I LA76249'=LA76249P S FDA(1,62.49,LA76249_",",6)=LA76249P
|
|
. I $G(HL("APAT"))="AL"!($G(HL("APAT"))="") S FDA(1,62.49,LA76249_",",2)="A"
|
|
. E S FDA(1,62.49,LA76249_",",2)="X"
|
|
. S FDA(1,62.49,LA76249_",",102)=HL("SAN")
|
|
. S FDA(1,62.49,LA76249_",",103)=HL("SAF")
|
|
. S FDA(1,62.49,LA76249_",",108)=HL("MTN")
|
|
. S FDA(1,62.49,LA76249_",",110)=HL("PID")
|
|
. S FDA(1,62.49,LA76249_",",111)=HL("VER")
|
|
. I $P($G(LA7MID),"^")'="" S FDA(1,62.49,LA76249_",",109)=$P(LA7MID,"^")
|
|
. I $P($G(LA7MID),"^",2) D
|
|
. . S FDA(1,62.49,LA76249_",",160)=$P(LA7MID,"^",2)
|
|
. . S FDA(1,62.49,LA76249_",",161)=$P(LA7MID,"^",3)
|
|
. D FILE^DIE("","FDA(1)","LA7ERR(1)")
|
|
. D CLEAN^DILF
|
|
;
|
|
Q
|
|
;
|
|
;
|
|
UPDLPD ; Update lab pending orders (#69.6) for each entry in #62.49
|
|
;
|
|
N LA76249
|
|
;
|
|
S LA76249=0
|
|
F S LA76249=$O(^TMP("LA7VS",$J,LA76249)) Q:'LA76249 D UPD696
|
|
Q
|
|
;
|
|
;
|
|
UPD696 ; Update LAB PENDING ORDERS file #69.6
|
|
;
|
|
N LA74,LA7696,LA76964,LA7ERR,LA7ORDT,LA7STAT,LA7X
|
|
;
|
|
; Find "Results Available" status in #64.061
|
|
S LA7STAT=$$FIND1^DIC(64.061,"","OMX","Results Available","","I $P(^LAB(64.061,Y,0),U,7)=""U""")
|
|
;
|
|
S LA7X=$G(^LAHM(62.49,LA76249,63))
|
|
;
|
|
; Ordering institution - pointer to file #4
|
|
S LA74=$P(LA7X,"^",2)
|
|
I LA74="" Q
|
|
;
|
|
; Ordered test
|
|
S LA7ORDT=$P(LA7X,"^",4)
|
|
I LA7ORDT="" Q
|
|
;
|
|
; File #69.6 ien and ordered test multiple ien
|
|
S LA7696=0
|
|
F S LA7696=$O(^LRO(69.6,"RST",LA74,LA("RUID"),LA7696)) Q:'LA7696 D
|
|
. N FDA
|
|
. S LA76964=$O(^LRO(69.6,LA7696,2,"B",LA7ORDT,0))
|
|
. I LA76964<1 Q
|
|
. ;
|
|
. L +^LRO(69.6,LA7696):99999
|
|
. ; Cannot get lock on ENTRY in 69.6
|
|
. I '$T D CREATE^LA7LOG(33) Q
|
|
. ;
|
|
. ; Store outgoing HL7 message ID
|
|
. S FDA(1,69.64,LA76964_","_LA7696_",",7)=$P(LA7MID,U)
|
|
. ; Set to Results Available.
|
|
. S FDA(1,69.64,LA76964_","_LA7696_",",5)=LA7STAT
|
|
. D FILE^DIE("","FDA(1)","LA7ERR(1)")
|
|
. D CLEAN^DILF
|
|
. ;
|
|
. L -^LRO(69.6,LA7696)
|
|
;
|
|
Q
|