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

LA7UIO1.m

Go to the documentation of this file.
  1. LA7UIO1 ;DALOI/JMC - Process Download Message for an entry in 62.48 ;12/11/15 16:39
  1. ;;5.2;AUTOMATED LAB INSTRUMENTS;**66,74,88**;Sep 27, 1994;Build 10
  1. ;
  1. ; Reference to PROTOCOL file (#101) supported by ICR #872
  1. ;
  1. Q
  1. ;
  1. BUILD ; Build one accession into an HL7 message
  1. ;
  1. N GBL,HL,I,LA760,LA761,LA7CDT,LA7CMT,LA7CS,LA7ERR,LA7FAC,LA7FS,LA7ECH,LA7HLP,LA7I,LA7ID,LA7LINK,LA7NVAF,LA7OBRSN,LA7PIDSN,LA7SCMT,LA7SID,LA7SPEC,LA7SUB,LA7X,LA7Y
  1. S GBL="^TMP(""HLS"","_$J_")"
  1. ;
  1. I '$D(ZTQUEUED),$G(LRLL) W:$X+5>IOM !,$S($G(LRTYPE):"Cup",1:"Seq"),": " W LA76822,", "
  1. ;
  1. S LA7CNT=0
  1. F I=0,.1,.2,.3,3 S LA76802(I)=$G(^LRO(68,LA768,1,LA76801,1,LA76802,I))
  1. S LA7X=LA76802(3)
  1. ; Draw time
  1. S LA7CDT=+LA7X
  1. ;
  1. ; Specimen comment if any, strip "~"
  1. S LA7SCMT=$TR($P(LA7X,"^",6),"~")
  1. ;
  1. ; Specimen
  1. S LA761=+$G(^LRO(68,LA768,1,LA76801,1,LA76802,5,1,0))
  1. ; Accession/unique ID - Long (UID) or short (accession #) sample ID
  1. S LA7ACC=$P(LA76802(.2),"^"),LA7UID=$P(LA76802(.3),"^"),LA7X=$G(^LRO(68,LA768,.4))
  1. I $P(LA7X,"^",2)="S" S LA7SID=$$RJ^XLFSTR(LA76802,+$P(LA7X,"^",3),"0")
  1. E S LA7SID=LA7UID
  1. ;
  1. ; Start message
  1. D INIT Q:$G(HL)
  1. ;
  1. ; Setup links and subscriber array for HL7 message generation
  1. S LA76248(0)=$G(^LAHM(62.48,LA76248,0)),LA7Y=$P(LA76248(0),"^")
  1. I $E(LA7Y,1,5)'="LA7UI"!($P(LA76248(0),"^",9)'=1) Q
  1. ;
  1. ; Check if interface has been updagraded to HL7 v2.5.1 otherwise use v2.2 protocol
  1. S LA7SUB="LA7UI ORM-O01 SUBS"
  1. S X=$O(^ORD(101,"B",LA7SUB,0))
  1. I X<1 S LA7SUB="LA7UI ORM-O01 SUBS 2.2"
  1. ;
  1. S LA7LINK=LA7SUB_"^"_LA7Y
  1. S LA7FAC=$P($$SITE^VASITE(DT),"^",3)
  1. S LA7HLP("SUBSCRIBER")="^^"_LA7FAC_"^"_LA7Y_"^"
  1. ; Following line used when debugging
  1. ;S $P(LA7HLP("SUBSCRIBER"),"^",8)="1-1-2"
  1. ;
  1. ; Build segments PID, PV1, and ORC/OBR segment for each test to be sent
  1. D PID,PV1
  1. S (LA7I,LA7OBRSN)=0
  1. F S LA7I=$O(LA7ACC(LA7I)) Q:'LA7I D ORC,OBR
  1. ; Build entry in MESSAGE QUEUE file 62.49
  1. D SENDMSG
  1. L -^LAHM(62.49,LA76249)
  1. D KVAR^LRX
  1. Q
  1. ;
  1. ;
  1. INIT ; Create/initialize HL message
  1. ;
  1. N LA7EVENT,X
  1. ;
  1. K @GBL
  1. S (LA76249,LA7NVAF,LA7PIDSN)=0
  1. ;
  1. ; Check if interface has been updagraded to HL7 v2.5.1 otherwise use v2.2 protocol
  1. S LA7EVENT="LA7UI ORM-O01 EVENT"
  1. S X=$O(^ORD(101,"B",LA7EVENT,0))
  1. I X<1 S LA7EVENT="LA7UI ORM-O01 EVENT 2.2"
  1. D STARTMSG^LA7VHLU(LA7EVENT,.LA76249)
  1. ;
  1. S LA7ID=$P(LRAUTO,"^",1)_"-O-"_LA7UID
  1. ;
  1. K ^TMP("LA7-ID",$J)
  1. D SETID^LA7VHLU1(LA76249,"",LA7ID,1)
  1. D SETID^LA7VHLU1(LA76249,"",LA7UID,0)
  1. D SETID^LA7VHLU1(LA76249,"",LA7ACC,0)
  1. S LA7CS=$E(LA7ECH,1)
  1. I $G(HL) S LA7ERR=28 D UPDT6249^LA7VORM1
  1. Q
  1. ;
  1. ;
  1. PID ; Build PID segment
  1. N LA7DATA,LA7FLAG,NAME,PID
  1. S LRDFN=+LA7ACC0,LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3)
  1. D DEM^LRX
  1. ;
  1. S PID(0)="PID"
  1. S PID(1)=1
  1. S PID(3)=$$M11^HLFNC(LRDFN)
  1. ;
  1. ; Pass patient and referral files through name standardization.
  1. ; Don't pass lab control and other file's "paient" names thru name standardization as it affects name order.
  1. I LRDPF?1(1"2",1"67",1"200") S NAME("FILE")=LRDPF,NAME("FIELD")=.01,NAME("IENS")=DFN,LA7FLAG="S"
  1. E S NAME("FAMILY")=$P(PNM,","),NAME("GIVEN")=$P(PNM,",",2),LA7FLAG=""
  1. S PID(5)=$$HLNAME^XLFNAME(.NAME,LA7FLAG,LA7CS)
  1. ;
  1. ; Date of birth
  1. I DOB S PID(7)=$$FMTHL7^XLFDT(DOB)
  1. S PID(8)=$S(SEX'="":SEX,1:"U")
  1. ;
  1. ; Race
  1. D RACE
  1. ;
  1. ; Patient's SSN
  1. I SSN'="" S PID(19)=SSN
  1. ;
  1. D BUILDSEG^LA7VHLU(.PID,.LA7DATA,LA7FS)
  1. D FILESEG^LA7VHLU(GBL,.LA7DATA)
  1. D FILE6249^LA7VHLU(LA76249,.LA7DATA)
  1. D SETID^LA7VHLU1(LA76249,"",PNM,0)
  1. Q
  1. ;
  1. ;
  1. PV1 ; Build PV1 segment
  1. N LA7PV1,LA7X
  1. D PV1^LA7VPID(LRDFN,.LA7PV1,LA7FS,LA7ECH)
  1. ; If not inpatient use patient location from Accession
  1. 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
  1. ;
  1. D FILESEG^LA7VHLU(GBL,.LA7PV1)
  1. D FILE6249^LA7VHLU(LA76249,.LA7PV1)
  1. Q
  1. ;
  1. ;
  1. ORC ; Build ORC segment
  1. N LA7DATA,ORC
  1. S ORC(0)="ORC"
  1. S ORC(1)="NW"
  1. ;
  1. ; Placer/filler order number - sample ID
  1. S ORC(2)=$$ORC2^LA7VORC(LA7SID,LA7FS,LA7ECH)
  1. S ORC(3)=$$ORC3^LA7VORC(LA7SID,LA7FS,LA7ECH)
  1. ;
  1. ; Order/draw time - if no order date/time then try draw time
  1. I $P(LA76802(0),"^",4) S ORC(9)=$$ORC9^LA7VORC($P(LA76802(0),"^",4))
  1. I '$P(LA76802(0),"^",4),$P(LA76802(3),"^") S ORC(9)=$$ORC9^LA7VORC($P(LA76802(3),"^"))
  1. ;
  1. ; Provider
  1. S LA7X=$$FNDOLOC^LA7VHLU2(LA7UID)
  1. S ORC(12)=$$ORC12^LA7VORC($P(LA76802(0),"^",8),$P(LA7X,"^",3),LA7FS,LA7ECH,2)
  1. ; Provider Callback Number ;**88
  1. S ORC(14)=$$ORC14^LA7VORC($P(LA76802(0),"^",8),DT,LA7FS,LA7ECH)
  1. D BUILDSEG^LA7VHLU(.ORC,.LA7DATA,LA7FS)
  1. D FILESEG^LA7VHLU(GBL,.LA7DATA)
  1. D FILE6249^LA7VHLU(LA76249,.LA7DATA)
  1. Q
  1. ;
  1. ;
  1. OBR ; Build OBR segment
  1. N LA764,LA7ALT,LA7CADR,LA7NLT,LA7TCMT
  1. K OBR
  1. ;
  1. S LA760=+LA7ACC(LA7I)
  1. S LA764=+$P($G(^LAB(60,LA760,64)),"^")
  1. S LA7NLT=$P($G(^LAM(LA764,0)),"^",2)
  1. S LA7TMP=$G(^TMP("LA7",$J,LA7INST,LA7I))
  1. Q:'LA7TMP
  1. ;
  1. S LA7CODE=$P(LA7TMP,"^",6),LA7DATA=$P(LA7TMP,"^",7)
  1. S OBR(0)="OBR"
  1. S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN)
  1. ; Placer/filler order number - sample ID
  1. S OBR(2)=$$OBR2^LA7VOBR(LA7SID,LA7FS,LA7ECH)
  1. S OBR(3)=$$OBR3^LA7VOBR(LA7SID,LA7FS,LA7ECH)
  1. ; Test order code
  1. S LA7ALT=LA7CODE_"^"_$$GET1^DIQ(60,LA760_",",.01)_"^"_"99001"
  1. S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,LA760,LA7ALT,LA7FS,LA7ECH)
  1. ; Draw time.
  1. I $G(LA7CDT) S OBR(7)=$$OBR7^LA7VOBR(LA7CDT)
  1. ; Infection warning.
  1. S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
  1. ;
  1. ; Specimen comment
  1. ; If no specimen comment
  1. ; then check order for test comments on test
  1. ; or parent test if panel exploded
  1. I LA7SCMT'="" S OBR(13)=$$OBR13^LA7VOBR(LA7SCMT,LA7FS,LA7ECH)
  1. I LA7SCMT="" D
  1. . S LA7TCMT=$$TESTCMT(LA768,LA76801,LA76802,LA760)
  1. . I LA7TCMT="" D
  1. . . N LA760P
  1. . . S LA760P=$P(LA7ACC(LA7I),"^",3)
  1. . . I LA760P>0,LA760'=LA760P S LA7TCMT=$$TESTCMT(LA768,LA76801,LA76802,LA760P)
  1. . I LA7TCMT'="" S OBR(13)=$$OBR13^LA7VOBR(LA7TCMT,LA7FS,LA7ECH)
  1. ;
  1. ; Lab Arrival Time
  1. S OBR(14)=$$OBR14^LA7VOBR($P(LA76802(3),"^",3))
  1. ; HL7 code from Topography
  1. S LA7X=$S(LRDPF=62.3:"^^^CONTROL",1:"")
  1. S OBR(15)=$$OBR15^LA7VOBR(LA761,"",LA7X,LA7FS,LA7ECH)
  1. ; Ordering provider
  1. S LA7X=$$FNDOLOC^LA7VHLU2(LA7UID)
  1. S OBR(16)=$$ORC12^LA7VORC($P(LA76802(0),"^",8),$P(LA7X,"^",3),LA7FS,LA7ECH,2)
  1. ; Provider Callback Number ;**88
  1. S OBR(17)=$$ORC14^LA7VORC($P(LA76802(0),"^",8),DT,LA7FS,LA7ECH)
  1. ; Placer's field #1 - instrument name^card address
  1. K LA7X
  1. S LA7X(1)=$P(LRAUTO,"^")
  1. S LA7CADR=$P($G(^LAB(62.4,LRINST,9)),U,9)
  1. I LA7CADR'="" S LA7X(2)=LA7CADR
  1. S OBR(18)=$$OBR18^LA7VOBR(.LA7X,LA7FS,LA7ECH)
  1. ; Placer's field #2 - tray^cup^lraa^lrad^lran^lracc^lruid
  1. K LA7X
  1. ; No tray/cup if don't send tray/cup flag.
  1. I $G(LRFORCE) S:LA76821 LA7X(1)=LA76821 S:LA76822 LA7X(2)=LA76822
  1. S LA7X(3)=LA768,LA7X(4)=LA76801,LA7X(5)=LA76802,LA7X(6)=LA7ACC,LA7X(7)=LA7UID
  1. S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
  1. ;
  1. ; Test urgency
  1. S OBR(27)=$$OBR27^LA7VOBR("","",+$P(LA7ACC(LA7I),"^",2),LA7FS,LA7ECH)
  1. ;
  1. K LA7DATA
  1. D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
  1. D FILESEG^LA7VHLU(GBL,.LA7DATA)
  1. D FILE6249^LA7VHLU(LA76249,.LA7DATA)
  1. Q
  1. ;
  1. ;
  1. SENDMSG ; Send the HL7 message.
  1. N HLL,HLP
  1. S HLL("LINKS",1)=LA7LINK
  1. I $D(LA7HLP) M HLP=LA7HLP
  1. D GEN^LA7VHLU,UPDT6249^LA7VORM1
  1. Q
  1. ;
  1. ;
  1. TESTCMT(LA768,LA76801,LA76802,LA760) ; Check and build order test comments
  1. ;
  1. ; Call with LA768 = IEN of accesseion area
  1. ; LA76801 = FM accession date
  1. ; LA76802 = accession number
  1. ; LA760 = IEN of file #60 test
  1. ;
  1. ; Returns LA7CMT = comments in a single string (truncated to 300 characters per HL7 standard)
  1. ;
  1. N LA7CMT,LA7I,LA7QUIT,LA7X,LA7Y,LRIEN,LRODT,LRSN
  1. ;
  1. S LA7CMT="",LRIEN=0
  1. S LA7Y=$G(^LRO(68,LA768,1,LA76801,1,LA76802,0))
  1. S LRODT=+$P(LA7Y,"^",4),LRSN=+$P(LA7Y,"^",5)
  1. I LRODT>0,LRSN>0 S LRIEN=$O(^LRO(69,LRODT,1,LRSN,2,"B",LA760,0))
  1. ;
  1. I LRIEN D
  1. . S (LA7I,LA7QUIT)=0,LA7X=""
  1. . F S LA7I=$O(^LRO(69,LRODT,1,LRSN,2,LRIEN,1,LA7I)) Q:LA7I<1 D Q:LA7QUIT
  1. . . S LA7X=$G(^LRO(69,LRODT,1,LRSN,2,LRIEN,1,LA7I,0))
  1. . . I $E(LA7X,1,10)="~For Test:" Q
  1. . . I LA7X'="" S LA7X=$TR(LA7X,"~","")
  1. . . I LA7CMT'="" S LA7X=" "_LA7X
  1. . . S LA7CMT=LA7CMT_LA7X
  1. . . I $L(LA7CMT)>300 S LA7CMT=$E(LA7CMT,1,300),LA7QUIT=1
  1. ;
  1. Q LA7CMT
  1. ;
  1. ;
  1. RACE ; Build RACE field in PID segment
  1. ;
  1. N CNT,IEN,LA7X,LA7Y,RACE,RACENUM,X,Y
  1. ;
  1. S PID(10)=""
  1. ;
  1. ; if from PATIENT file (#2) then check RACE array (VADM(12).
  1. I LRDPF=2,$G(VADM(12)) D Q
  1. . ; Loop through all races (CNT is repetition location)
  1. . S RACENUM=0
  1. . F CNT=1:1 S RACENUM=+$O(VADM(12,RACENUM)) Q:'RACENUM D
  1. . . ; Fabricate race value -> RACE-METHOD
  1. . . S RACE=$$PTR2CODE^DGUTL4(+VADM(12,RACENUM),1,2)
  1. . . S X=$$PTR2CODE^DGUTL4(+$G(VADM(12,RACENUM,1)),3,2)
  1. . . S:X="" X="UNK"
  1. . . S RACE=RACE_"-"_X
  1. . . ; First triplet
  1. . . S LA7Y(10,CNT,1)=RACE
  1. . . S LA7Y(10,CNT,2)=$P(VADM(12,RACENUM),"^",2)
  1. . . S LA7Y(10,CNT,3)="HL70005"
  1. . . ; Second triplet
  1. . . S X=$$PTR2CODE^DGUTL4(+VADM(12,RACENUM),1,3)
  1. . . S LA7Y(10,CNT,4)=X
  1. . . S LA7Y(10,CNT,5)=$P(VADM(12,RACENUM),"^",2)
  1. . . S LA7Y(10,CNT,6)="CDC"
  1. . S IEN=0
  1. . F S IEN=$O(LA7Y(10,IEN)) Q:IEN="" D
  1. . . S LA7X=""
  1. . . F CNT=1:1:6 I LA7Y(10,IEN,CNT)'="" S $P(LA7X,$E(LA7ECH,1),CNT)=LA7Y(10,IEN,CNT)
  1. . . I LA7X="" Q
  1. . . I PID(10)'="" S PID(10)=PID(10)_$E(LA7ECH,2)
  1. . . S PID(10)=PID(10)_LA7X
  1. ;
  1. ; if from REFERRAL PATIENT file (#67) then check RACE field.
  1. I LRDPF=67 D Q
  1. . S LA7X=$$GET1^DIQ(67,DFN_",",.06,"I")
  1. . I LA7X<1 Q
  1. . S PID(10)=$$PTR2CODE^DGUTL4(LA7X,1,2)
  1. . S $P(PID(10),$E(LA7ECH,1),2)=$$PTR2TEXT^DGUTL4(LA7X,1)
  1. . S $P(PID(10),$E(LA7ECH,1),3)="HL70005"
  1. ;
  1. Q