173 lines
5.2 KiB
Mathematica
173 lines
5.2 KiB
Mathematica
LA7UIO1 ;DALOI/JMC - Process Download Message for an entry in 62.48 ;May 20, 2008
|
|
;;5.2;AUTOMATED LAB INSTRUMENTS;**66**;Sep 27, 1994;Build 30
|
|
Q
|
|
;
|
|
BUILD ; Build one accession into an HL7 message
|
|
;
|
|
N GBL,HL,LA760,LA761,LA7CDT,LA7CMT,LA7ERR,LA7FAC,LA7FS,LA7ECH,LA7HLP,LA7I,LA7ID
|
|
N LA7LINK,LA7OBRSN,LA7PIDSN,LA7SID,LA7SPEC,LA7X,LA7Y
|
|
S GBL="^TMP(""HLS"","_$J_")"
|
|
;
|
|
I '$D(ZTQUEUED),$G(LRLL) W:$X+5>IOM !,$S($G(LRTYPE):"Cup",1:"Seq"),": " W LA76822,", "
|
|
;
|
|
S LA7CNT=0
|
|
F I=0,.1,.2,.3,3 S LA76802(I)=$G(^LRO(68,LA768,1,LA76801,1,LA76802,I))
|
|
S LA7X=LA76802(3)
|
|
; Draw time
|
|
S LA7CDT=+LA7X
|
|
; Specimen comment if any, strip "~"
|
|
S LA7CMT=$TR($P(LA7X,"^",6),"~")
|
|
; Specimen
|
|
S LA761=+$G(^LRO(68,LA768,1,LA76801,1,LA76802,5,1,0))
|
|
; Accession/unique ID - Long (UID) or short (accession #) sample ID
|
|
S LA7ACC=$P(LA76802(.2),"^"),LA7UID=$P(LA76802(.3),"^"),LA7X=$G(^LRO(68,LA768,.4))
|
|
I $P(LA7X,"^",2)="S" S LA7SID=$$RJ^XLFSTR(LA76802,+$P(LA7X,"^",3),"0")
|
|
E S LA7SID=LA7UID
|
|
;
|
|
; Start message
|
|
D INIT Q:$G(HL)
|
|
;
|
|
; Setup links and subscriber array for HL7 message generation
|
|
S LA76248(0)=$G(^LAHM(62.48,LA76248,0)),LA7Y=$P(LA76248(0),"^")
|
|
I $E(LA7Y,1,5)'="LA7UI"!($P(LA76248(0),"^",9)'=1) Q
|
|
S LA7LINK="LA7UI ORM-O01 SUBS 2.2^"_LA7Y
|
|
S LA7FAC=$P($$SITE^VASITE(DT),"^",3)
|
|
S LA7HLP("SUBSCRIBER")="^^"_LA7FAC_"^"_LA7Y_"^"
|
|
; Following line used when debugging
|
|
;S $P(LA7HLP("SUBSCRIBER"),"^",8)="1-1-2"
|
|
;
|
|
; Build segments PID, PV1, and ORC/OBR segment for each test to be sent
|
|
D PID,PV1
|
|
S (LA7I,LA7OBRSN)=0
|
|
F S LA7I=$O(LA7ACC(LA7I)) Q:'LA7I D ORC,OBR
|
|
; Build entry in MESSAGE QUEUE file 62.49
|
|
D SENDMSG
|
|
L -^LAHM(62.49,LA76249)
|
|
D KVAR^LRX
|
|
Q
|
|
;
|
|
;
|
|
INIT ; Create/initialize HL message
|
|
;
|
|
K @GBL
|
|
S (LA76249,LA7NVAF,LA7PIDSN)=0
|
|
D STARTMSG^LA7VHLU("LA7UI ORM-O01 EVENT 2.2",.LA76249)
|
|
S LA7ID=$P(LRAUTO,"^",1)_"-O-"_LA7UID
|
|
I $G(HL) S LA7ERR=28 D UPDT6249^LA7VORM1
|
|
Q
|
|
;
|
|
;
|
|
PID ; Build PID segment
|
|
N LA7DATA,PID
|
|
S LRDFN=+LA7ACC0,LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3)
|
|
D DEM^LRX
|
|
;
|
|
S PID(0)="PID"
|
|
S PID(1)=1
|
|
S PID(3)=$$M11^HLFNC(LRDFN)
|
|
S PID(5)=$$HLNAME^HLFNC(PNM)
|
|
S PID(8)=$S(SEX'="":SEX,1:"U")
|
|
I SSN'="" S PID(19)=SSN
|
|
I DOB S PID(7)=$$FMTHL7^XLFDT(DOB)
|
|
D BUILDSEG^LA7VHLU(.PID,.LA7DATA,LA7FS)
|
|
D FILESEG^LA7VHLU(GBL,.LA7DATA)
|
|
D FILE6249^LA7VHLU(LA76249,.LA7DATA)
|
|
Q
|
|
;
|
|
;
|
|
PV1 ; Build PV1 segment
|
|
N LA7PV1,LA7X
|
|
D PV1^LA7VPID(LRDFN,.LA7PV1,LA7FS,LA7ECH)
|
|
; If not inpatient use patient location from Accession
|
|
I $P(LA7PV1(0),LA7FS,3)'="I" S LA7X=$P($G(LA76802(0)),"^",7) S LA7X=$$CHKDATA^LA7VHLU3(LA7X,LA7FS_LA7ECH) S $P(LA7PV1(0),LA7FS,4)=LA7X
|
|
;
|
|
D FILESEG^LA7VHLU(GBL,.LA7PV1)
|
|
D FILE6249^LA7VHLU(LA76249,.LA7PV1)
|
|
Q
|
|
;
|
|
;
|
|
ORC ; Build ORC segment
|
|
N LA7DATA,ORC
|
|
S ORC(0)="ORC"
|
|
S ORC(1)="NW"
|
|
;
|
|
; Placer/filler order number - sample ID
|
|
S ORC(2)=$$ORC2^LA7VORC(LA7SID,LA7FS,LA7ECH)
|
|
S ORC(3)=$$ORC3^LA7VORC(LA7SID,LA7FS,LA7ECH)
|
|
;
|
|
; Order/draw time - if no order date/time then try draw time
|
|
I $P(LA76802(0),"^",4) S ORC(9)=$$ORC9^LA7VORC($P(LA76802(0),"^",4))
|
|
I '$P(LA76802(0),"^",4),$P(LA76802(3),"^") S ORC(9)=$$ORC9^LA7VORC($P(LA76802(3),"^"))
|
|
;
|
|
; Provider
|
|
S LA7X=$$FNDOLOC^LA7VHLU2(LA7UID)
|
|
S ORC(12)=$$ORC12^LA7VORC($P(LA76802(0),"^",8),$P(LA7X,"^",3),LA7FS,LA7ECH)
|
|
D BUILDSEG^LA7VHLU(.ORC,.LA7DATA,LA7FS)
|
|
D FILESEG^LA7VHLU(GBL,.LA7DATA)
|
|
D FILE6249^LA7VHLU(LA76249,.LA7DATA)
|
|
Q
|
|
;
|
|
;
|
|
OBR ; Build OBR segment
|
|
N LA764,LA7ALT,LA7CADR,LA7NLT
|
|
K OBR
|
|
;
|
|
S LA760=+LA7ACC(LA7I)
|
|
S LA764=+$P($G(^LAB(60,LA760,64)),"^")
|
|
S LA7NLT=$P($G(^LAM(LA764,0)),"^",2)
|
|
S LA7TMP=$G(^TMP("LA7",$J,LA7INST,LA7I))
|
|
Q:'LA7TMP
|
|
;
|
|
S LA7CODE=$P(LA7TMP,"^",6),LA7DATA=$P(LA7TMP,"^",7)
|
|
S OBR(0)="OBR"
|
|
S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN)
|
|
; Placer/filler order number - sample ID
|
|
S OBR(2)=$$OBR2^LA7VOBR(LA7SID,LA7FS,LA7ECH)
|
|
S OBR(3)=$$OBR3^LA7VOBR(LA7SID,LA7FS,LA7ECH)
|
|
; Test order code
|
|
S LA7ALT=LA7CODE_"^"_$$GET1^DIQ(60,LA760_",",.01)_"^"_"99001"
|
|
S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,LA760,LA7ALT,LA7FS,LA7ECH)
|
|
; Draw time.
|
|
I $G(LA7CDT) S OBR(7)=$$OBR7^LA7VOBR(LA7CDT)
|
|
; Infection warning.
|
|
S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
|
|
; Specimen comment
|
|
S OBR(13)=LA7CMT
|
|
; Lab Arrival Time
|
|
S OBR(14)=$$OBR14^LA7VOBR($P(LA76802(3),"^",3))
|
|
; HL7 code from Topography
|
|
S LA7X=$S(LRDPF=62.3:"^^^CONTROL",1:"")
|
|
S OBR(15)=$$OBR15^LA7VOBR(LA761,"",LA7X,LA7FS,LA7ECH)
|
|
; Ordering provider
|
|
S LA7X=$$FNDOLOC^LA7VHLU2(LA7UID)
|
|
S OBR(16)=$$ORC12^LA7VORC($P(LA76802(0),"^",8),$P(LA7X,"^",3),LA7FS,LA7ECH)
|
|
; Placer's field #1 - instrument name^card address
|
|
K LA7X
|
|
S LA7X(1)=$P(LRAUTO,"^")
|
|
S LA7CADR=$P($G(^LAB(62.4,LRINST,9)),U,9)
|
|
I LA7CADR'="" S LA7X(2)=LA7CADR
|
|
S OBR(18)=$$OBR18^LA7VOBR(.LA7X,LA7FS,LA7ECH)
|
|
; Placer's field #2 - tray^cup^lraa^lrad^lran^lracc^lruid
|
|
K LA7X
|
|
; No tray/cup if don't send tray/cup flag.
|
|
I $G(LRFORCE) S:LA76821 LA7X(1)=LA76821 S:LA76822 LA7X(2)=LA76822
|
|
S LA7X(3)=LA768,LA7X(4)=LA76801,LA7X(5)=LA76802,LA7X(6)=LA7ACC,LA7X(7)=LA7UID
|
|
S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
|
|
;
|
|
; Test urgency
|
|
S OBR(27)=$$OBR27^LA7VOBR("","",+$P(LA7ACC(LA7I),"^",2),LA7FS,LA7ECH)
|
|
;
|
|
K LA7DATA
|
|
D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
|
|
D FILESEG^LA7VHLU(GBL,.LA7DATA)
|
|
D FILE6249^LA7VHLU(LA76249,.LA7DATA)
|
|
Q
|
|
;
|
|
;
|
|
SENDMSG ; Send the HL7 message.
|
|
N HLL,HLP
|
|
S HLL("LINKS",1)=LA7LINK
|
|
I $D(LA7HLP) M HLP=LA7HLP
|
|
D GEN^LA7VHLU,UPDT6249^LA7VORM1
|
|
Q
|