LA7CHDR ;VA/DALOI/JMC - LAB HDR ORU (Observation Result) message builder ; 22-Oct-2013 09:22 ; MAW
;;5.2;AUTOMATED LAB INSTRUMENTS;**68,1033**;NOV 1, 1997
;
; Reference to variable DIQUIET supported by DBIA #2098
;
Q
;
QUEMU2(LA7UID,LRAA,LRAD,LRAN,LRIDT,LRSS,LRDFN,LRSPEC,LRSAMP,LRSB) ;
QUEUE ;
; Called by protocol LA7 LAB RESULTS ACTION
; and below (APQ) for AP subscripts
; Call with:
; LRAA - accession area (CH,MI subscript)
; LRAD - accession date (CH,MI subscript)
; LRAN - accession number (CH,MI subscript)
; LRIDT - inverse date/time (collection date/time)
; LRSS - test subscript defined in LABORATORY TEST file (#60)
; LRDFN - IEN in LAB DATA file (#63)
; LRSPEC - specimen
; LRSAMP - sample
; LRSB (Optional) - array of Chemistry results
; ex. glucose LRSB(2)=LR NODE
;
N I,LA76248,LA7V,LA7VCH,LASTYP,LAVERR,X,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
;N (LA7UID,LRAA,LRAD,LRAN,LRIDT,LRSS,LRDFN,LRSPEC,LRSB)
;
S LA7PAT=$P($G(^LR(LRDFN,0)),U,3) ;needed to see if inpatient
I $D(^DPT(LA7PAT,.1)) S LA7INPT=1 ;flag as inpatient
; If no accession area then quit - not much we can do.
I $G(LRAA)="" Q
;
; If LRSS not defined then set from file #68
I $G(LRSS)="" N LRSS S LRSS=$P($G(^LRO(68,LRAA,0)),"^",2)
;
; Not supporting AU and BB at this time (or if LRSS is null).
I "AUBB"[LRSS Q
;
; Check if CPRS has called us more than once for this accession.
; Results are processed on first call.
I $D(LRTMPO("LRIFN")),$G(LRNIFN)>1 Q
I LRSS="MI",$D(LRTMPO("LRIFN")),$G(^TMP("LA7HDR",$J))=(LRAA_"^"_LRAD_"^"_LRAN) K ^TMP("LA7HDR",$J) Q
;
; Quit if test patient on a production account.
I $$TESTPAT^VADPT($P($G(^LR(LRDFN,0)),"^",3)),$$PROD^XUPROD(0) Q
;
; Check for configuration LA7HDR in 62.48 to see if turned on and site wants subscribers to receive HL7 messages for this event.
; Task HL7 message building and transmission.
; HDR-IMS will be using HL7 messaging, no call to VDEF API.
S LA76248=$O(^LAHM(62.48,"B","LA7HDR",0))
I 'LA76248 Q
I '$P(^LAHM(62.48,LA76248,0),"^",3) Q ; not active
;
S LA7SITE=$O(^BLRRLMU("B",DUZ(2),0))
S LA7FAC=$P($G(^DIC(4,DUZ(2),0)),U)
S LA7VER=$P($G(^BLRRLMU(LA7SITE,0)),U,2)
S ZTRTN="BUILD^LA7CHDR",ZTDTH=$H,ZTIO="",ZTDESC="Tasked Lab HL7 HDR ORU Build"
F I="LRAA","LRAD","LRAN","LRIDT","LRSS","LRDFN","LA7SITE","LA7FAC","LA7VER","LRSPEC","LA7UID" S ZTSAVE(I)=""
I LRSS="CH" D
. S LA7V=0
. F S LA7V=$O(LRSB(LA7V)) Q:'LA7V D
. . I $P(LRSB(LA7V),"^")="" Q
. . S LA7VCH(LA7V)=LRSB(LA7V)
. . I $D(LRSA(LA7V,2)) S LA7VCH(LA7V,1)="C"
. S ZTSAVE("LA7VCH*")="",ZTSAVE("LRSPEC")=""
I LRSS="CH",'$D(LA7VCH) Q
S ZTSAVE=("LA7MTYP")="ORU"
D BUILD^LA7CHDR
;maw remove below once i have it working
;D ^%ZTLOAD
;I $G(ZTSK)'>0 Q
;
; Set flag to handle CPRS calling us multiple times during verifying session for each ordered test.
;S ^TMP("LA7HDR",$J)=LRAA_"^"_LRAD_"^"_LRAN
;
Q
;
;
APQ(LRDFN,LRSS,LRIDT) ; Anatomic Pathology (CY,EM,SP) subscript entry point from FileMan cross-reference on specific fields.
; Called by field #.11 in sub-files #63.02, 63.08, 63.09 - AP does not work through CPRS extended action protocols
;
; Only send file #2 patients to HDR
I $P($G(^LR(LRDFN,0)),"^",2)'=2 Q
;
D QUEUE
Q
;
;
BUILD ; Tasked entry point to build HL7 message to VA's HDR
; Tasked from above.
;
N DIQUIET,FDA,GBL,HL,HLQ,RUID,SITE
N LA76248,LA76249P,LA7DT,LA7ERR,LA7EVNT,LA7ID,LA7INTYP,LA7LNCVR,LA7LOAD,LA7NOMSG,LA7NVAF,LA7RSITE,LA7X,LA7Y,LRQUIET,LRUID
;
; Prevent FileMan from issuing any unwanted WRITE(s).
S (DIQUIET,LRQUIET)=1
; Insure DILOCKTM is defined
D DT^DICRW
;
; Lock record while building message.
;F L +^LR(LRDFN,LRSS,LRIDT,0):DILOCKTM Q:$T H 5
;
S (LA7ERR,LA7NVAF)=0,LA7EVNT="LA7 LAB RESULTS AVAILABLE (EVN)"
; Create 62.49 entry but don't store message text.
;S LA7NOMSG=2
S LA7NOMSG=0
;
I $G(LA7MTYP)="" S LA7MTYP="ORU"
;
S LA7X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
S LRUID=$P(LA7X,"^"),RUID=$P(LA7X,"^",5)
I LRUID="" S LRUID=$$LRUID^LRX(LRAA,LRAD,LRAN)
;
S (LA7RSITE,SITE)="LA7HDR",LA7ID=LA7RSITE_"-O-",LA76248=$O(^LAHM(62.48,"B",LA7RSITE,0))
; No entry in 62.48 - *** Need to add error logging ****
I 'LA76248 Q
;I '$P(^LAHM(62.48,LA76248,0),"^",3) Q ; not active
S LA7INTYP=+$P(^LAHM(62.48,LA76248,0),"^",9)
;
; Determine if patient needs to have initial load sent to HDR.
; *** need to establish location of HDR flag in 63***
S LA7LOAD=0
;
; Create new outgoing entry in 62.49
S (LA76249,LA76249P)=$$INIT6249^LA7VHLU
I LA76249<1 D Q
. ; Log entry creation error
;
K ^TMP("LA7-QRY",$J)
;
; Check "CH" test results for ordered tests.
; Per Change Control Board decision to perform lab test's result aggregation on VistA -
; - besides test verified during this session include all other test results stored with this specimen.
I LRSS="CH" D
. N FDA,FDAIEN,LA7ER,LA7VT,LRSB
. S LA7Y=1
. F S LA7Y=$O(^LR(LRDFN,LRSS,LRIDT,LA7Y)) Q:'LA7Y D
. . I '$D(LA7VCH(LA7Y)) S LA7VCH(LA7Y)=^LR(LRDFN,LRSS,LRIDT,LA7Y)
. . I $P(LA7VCH(LA7Y),"^")="" Q
. . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LA7Y,$P(LA7VCH(LA7Y),"^",3),LRSPEC)
. . S LRSB=LA7Y S:$G(LA7VCH(LA7Y,1))="C" $P(LRSB,"^",2)="C"
. . ;I $D(^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS)) Q ; Already marked this report to send tried adding this here
. . D STORE^LA7QRY2
. . K FDA,FDAIEN,LA7ER
. . S FDA(2,62.49162,"+2,"_LA76249_",",.01)=LRSB
. . I $G(LA7VCH(LA7Y,1))="C" S FDA(2,62.49162,"+2,"_LA76249_",",.02)="C"
. . S FDAIEN(1)=LA76249
. . D UPDATE^DIE("","FDA(2)","FDAIEN","LA7ER(2)")
. . D CLEAN^DILF
. I $G(LA7INPT),'$D(^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS)) D
. . S ^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS)=""
;
I "CYEMSP"[LRSS D
. S LRSB=.012,LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"","")
. D STORE^LA7QRY2
;
I LRSS="MI" D
. S LRSPEC=$P(^LR(LRDFN,LRSS,LRIDT,0),"^",5)
. S LA7ND=0
. F LA7ND=1,5,8,11,16 I $D(^LR(LRDFN,LRSS,LRIDT,LA7ND)) D
. . I $P(^LR(LRDFN,LRSS,LRIDT,LA7ND),"^",2)="" Q ; If no status - skip
. . I $D(^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS)) Q ; Already marked this report to send
. . S LRSB=$S(LA7ND=1:11,LA7ND=5:14,LA7ND=8:18,LA7ND=11:22,LA7ND=16:33,1:11)
. . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"",LRSPEC)
. . D STORE^LA7QRY2
;
S GBL="^TMP(""HLS"","_$J_")"
D STARTMSG^LA7CHLU(LA7EVNT,.LA76249,LA7NOMSG)
I $G(HL) S LA7ERR=$TR(HL,"^","-")
S (HLQ,HL("Q"))=""
D CHKACC^LA7VMSG
I 'LA7ERR D
. I LA7LOAD D
. . N LA7EDT,LA7SC,LA7SDT,LA7SPEC,LRIDT,LRSS,LRUID
. . S (LA7SC,LA7SPEC)="*",LA7SDT=$$FMADD^XLFDT(DT,-730,0,0,0),LA7EDT=DT
. . D BCD^LA7QRY2
. D BUILDMSG^LA7CQRY1
. D SENDMSG^LA7VMSG1
S LA7ID=LA7RSITE_"-O-"_LRUID
D UPDT6249^LA7VORM1
; File additional data
S FDA(1,62.49,LA76249_",",151)=LRUID
S FDA(1,62.49,LA76249_",",156)=LRIDT
S FDA(1,62.49,LA76249_",",157)=LRSS
S FDA(1,62.49,LA76249_",",158)=LRDFN
D FILE^DIE("","FDA(1)","LA7ERR(1)")
D CLEAN^DILF
;
; Release locks on entries.
L -^LAHM(62.49,LA76249)
L -^LR(LRDFN,LRSS,LRIDT)
;
; Cleanup
K LA7ND,LRUID,LRNLT,LRIDT,LRSS,LRDFN,LA7VCH,LA7MTYP
K LA7101,LA7953,LA7CODE,LA7NTESN,LA7OP,LA7PIDSN,LA7PRI,LA7SFT,LA7SITE,LA7VER,LA7FAC,LA7CLDT
K PID,NK1,SPM,TQ1,NTE
K LA7PAT,LA7INPT,LA7REJ,LA7ORCSN,LA7ADDON,LA7ADDPN,LA7PARNT,LA7STOR,LA7OBX,LA7OBR
D EXIT^LA7HDR1
Q
;
;
MSH(FS,ECH,SITE) ;return the msh segment
N I,J,MSH,CS,RS,MSHA,MSHAA
S MSHA=$G(^BLRRLMU(SITE,"MSH"))
S MSHAA=$G(^BLRRLMU(SITE,"MSHA"))
S CS=$E(ECH,1,1)
S RS=$E(ECH,2,2)
F I=1:1:25 S MSH(I)=""
S MSH="MSH"
S MSH(1)=FS
S MSH(2)=ECH
S MSH(3)=$P(MSHA,U)_CS_$P(MSHA,U,2)_CS_$P(MSHA,U,3)
S MSH(4)=$P(MSHA,U,4)_CS_$P(MSHA,U,5)_CS_$P(MSHA,U,6)
S MSH(5)=$P(MSHA,U,7)_CS_$P(MSHA,U,8)_CS_$P(MSHA,U,9)
S MSH(6)=$P(MSHA,U,10)_CS_$P(MSHA,U,11)_CS_$P(MSHA,U,12)
S MSH(7)=$$FMTHL7^XLFDT($$NOW^XLFDT)
S MSH(9)="ORU"_CS_"R01"_CS_"ORU_R01"
S MSH(10)="RPMS-HL-"_$R(100000)
S MSH(11)="T"
S MSH(12)=$P($G(^BLRRLMU(SITE,0)),U,2)
S MSH(15)="NE"
S MSH(16)="NE"
I $G(LA7INPT) D
. S MSH(15)="AL"
. S MSH(16)="NE"
S MSH(21)=$P(MSHA,U,13)_CS_$P(MSHA,U,14)_CS_$P(MSHAA,U)_CS_$P(MSHAA,U,2)
;lets make this dynamic below as it is for LRI inpatient
I $G(LA7INPT) S MSH(21)="LRI_Common_Component^Profile Component^2.16.840.1.113883.9.16^ISO~LRI_NG_Component^Profile Component^2.16.840.1.113883.9.13^ISO~LRI_RU_Component^Profile Component^2.16.840.1.113883.9.14^ISO"
F J=2:1:25 S $P(MSH,FS,J)=MSH(J)
Q MSH
;
RTR(LA7SS) ;
; Call with LA7SS = list of subscripts that HDR wants separated by ";"
; (LA7SS="CH;MI;EM")
;
; Setup link and subscriber array for HL7 HDR message generation
; Determine if HDR wants to receive lab results for this subscript
; Called by subscriber router protocol LA7 LAB RESULTS TO HDR (SUB)
; Check outgoing message and find OBR segment to determine Laboratory
; subscript this result is associated with and if it's contained in
; the LA7SS subscript list.
;
N LA7I,LA7SEG,LA7VI,LA7VJ,LA7X,LRSS,LRX
;
S LRSS=""
F LA7VI=1:1 X HLNEXT Q:HLQUIT'>0 D Q:LRSS'=""
. I $E(HLNODE,1,3)'="OBR" Q
. S LA7SEG(0)=HLNODE
. S LA7VJ=0
. F S LA7VJ=$O(HLNODE(LA7VJ)) Q:'LA7VJ S LA7SEG(LA7VJ)=HLNODE(LA7VJ)
. S LRX=$$P^LA7VHLU(.LA7SEG,21,HL("FS")),LRX=$$UNESC^LA7VHLU3(LRX,HL("FS")_HL("ECH"))
. S LRSS=$P(LRX,"^",2)
;
F LA7I=1:1 S LA7X=$P(LA7SS,";",LA7I) Q:LA7X="" D Q:LA7X=""
. I LA7X=LRSS S HLL("LINKS",1)="LA7 LAB RESULTS TO HDR (SUB)^VDEFVIE4",LA7X=""
Q
;
;
HDRLOAD(LA7SDT,LA7EDT,LA7LIMIT,LA7EVENT) ; Load patient's historical lab results to HDR (Health Data Repository).
; Call with LA7SDT = start date of data extraction in FileMan format
; LA7EDT = end date of data extraction in FileMan format
; LA7LIMIT = # of messages to create this session (default =1000)
; LA7EVENT = name of HL7 event protocol to transmit messages
;
D HDRLOAD^LA7HDR1
Q
;
;
RECOVER ; Recover failed transmissions or message building
; Called by option Recover/Transmit Lab HDR Result Messages [LA7 HDR RECOVER]
;
D RECOVER^LA7HDR1
Q
LA7CHDR ;VA/DALOI/JMC - LAB HDR ORU (Observation Result) message builder ; 22-Oct-2013 09:22 ; MAW
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**68,1033**;NOV 1, 1997
+2 ;
+3 ; Reference to variable DIQUIET supported by DBIA #2098
+4 ;
+5 QUIT
+6 ;
QUEMU2(LA7UID,LRAA,LRAD,LRAN,LRIDT,LRSS,LRDFN,LRSPEC,LRSAMP,LRSB) ;
QUEUE ;
+1 ; Called by protocol LA7 LAB RESULTS ACTION
+2 ; and below (APQ) for AP subscripts
+3 ; Call with:
+4 ; LRAA - accession area (CH,MI subscript)
+5 ; LRAD - accession date (CH,MI subscript)
+6 ; LRAN - accession number (CH,MI subscript)
+7 ; LRIDT - inverse date/time (collection date/time)
+8 ; LRSS - test subscript defined in LABORATORY TEST file (#60)
+9 ; LRDFN - IEN in LAB DATA file (#63)
+10 ; LRSPEC - specimen
+11 ; LRSAMP - sample
+12 ; LRSB (Optional) - array of Chemistry results
+13 ; ex. glucose LRSB(2)=LR NODE
+14 ;
+15 NEW I,LA76248,LA7V,LA7VCH,LASTYP,LAVERR,X,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+16 ;N (LA7UID,LRAA,LRAD,LRAN,LRIDT,LRSS,LRDFN,LRSPEC,LRSB)
+17 ;
+18 ;needed to see if inpatient
SET LA7PAT=$PIECE($GET(^LR(LRDFN,0)),U,3)
+19 ;flag as inpatient
IF $DATA(^DPT(LA7PAT,.1))
SET LA7INPT=1
+20 ; If no accession area then quit - not much we can do.
+21 IF $GET(LRAA)=""
QUIT
+22 ;
+23 ; If LRSS not defined then set from file #68
+24 IF $GET(LRSS)=""
NEW LRSS
SET LRSS=$PIECE($GET(^LRO(68,LRAA,0)),"^",2)
+25 ;
+26 ; Not supporting AU and BB at this time (or if LRSS is null).
+27 IF "AUBB"[LRSS
QUIT
+28 ;
+29 ; Check if CPRS has called us more than once for this accession.
+30 ; Results are processed on first call.
+31 IF $DATA(LRTMPO("LRIFN"))
IF $GET(LRNIFN)>1
QUIT
+32 IF LRSS="MI"
IF $DATA(LRTMPO("LRIFN"))
IF $GET(^TMP("LA7HDR",$JOB))=(LRAA_"^"_LRAD_"^"_LRAN)
KILL ^TMP("LA7HDR",$JOB)
QUIT
+33 ;
+34 ; Quit if test patient on a production account.
+35 IF $$TESTPAT^VADPT($PIECE($GET(^LR(LRDFN,0)),"^",3))
IF $$PROD^XUPROD(0)
QUIT
+36 ;
+37 ; Check for configuration LA7HDR in 62.48 to see if turned on and site wants subscribers to receive HL7 messages for this event.
+38 ; Task HL7 message building and transmission.
+39 ; HDR-IMS will be using HL7 messaging, no call to VDEF API.
+40 SET LA76248=$ORDER(^LAHM(62.48,"B","LA7HDR",0))
+41 IF 'LA76248
QUIT
+42 ; not active
IF '$PIECE(^LAHM(62.48,LA76248,0),"^",3)
QUIT
+43 ;
+44 SET LA7SITE=$ORDER(^BLRRLMU("B",DUZ(2),0))
+45 SET LA7FAC=$PIECE($GET(^DIC(4,DUZ(2),0)),U)
+46 SET LA7VER=$PIECE($GET(^BLRRLMU(LA7SITE,0)),U,2)
+47 SET ZTRTN="BUILD^LA7CHDR"
SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTDESC="Tasked Lab HL7 HDR ORU Build"
+48 FOR I="LRAA","LRAD","LRAN","LRIDT","LRSS","LRDFN","LA7SITE","LA7FAC","LA7VER","LRSPEC","LA7UID"
SET ZTSAVE(I)=""
+49 IF LRSS="CH"
Begin DoDot:1
+50 SET LA7V=0
+51 FOR
SET LA7V=$ORDER(LRSB(LA7V))
IF 'LA7V
QUIT
Begin DoDot:2
+52 IF $PIECE(LRSB(LA7V),"^")=""
QUIT
+53 SET LA7VCH(LA7V)=LRSB(LA7V)
+54 IF $DATA(LRSA(LA7V,2))
SET LA7VCH(LA7V,1)="C"
End DoDot:2
+55 SET ZTSAVE("LA7VCH*")=""
SET ZTSAVE("LRSPEC")=""
End DoDot:1
+56 IF LRSS="CH"
IF '$DATA(LA7VCH)
QUIT
+57 SET ZTSAVE=("LA7MTYP")="ORU"
+58 DO BUILD^LA7CHDR
+59 ;maw remove below once i have it working
+60 ;D ^%ZTLOAD
+61 ;I $G(ZTSK)'>0 Q
+62 ;
+63 ; Set flag to handle CPRS calling us multiple times during verifying session for each ordered test.
+64 ;S ^TMP("LA7HDR",$J)=LRAA_"^"_LRAD_"^"_LRAN
+65 ;
+66 QUIT
+67 ;
+68 ;
APQ(LRDFN,LRSS,LRIDT) ; Anatomic Pathology (CY,EM,SP) subscript entry point from FileMan cross-reference on specific fields.
+1 ; Called by field #.11 in sub-files #63.02, 63.08, 63.09 - AP does not work through CPRS extended action protocols
+2 ;
+3 ; Only send file #2 patients to HDR
+4 IF $PIECE($GET(^LR(LRDFN,0)),"^",2)'=2
QUIT
+5 ;
+6 DO QUEUE
+7 QUIT
+8 ;
+9 ;
BUILD ; Tasked entry point to build HL7 message to VA's HDR
+1 ; Tasked from above.
+2 ;
+3 NEW DIQUIET,FDA,GBL,HL,HLQ,RUID,SITE
+4 NEW LA76248,LA76249P,LA7DT,LA7ERR,LA7EVNT,LA7ID,LA7INTYP,LA7LNCVR,LA7LOAD,LA7NOMSG,LA7NVAF,LA7RSITE,LA7X,LA7Y,LRQUIET,LRUID
+5 ;
+6 ; Prevent FileMan from issuing any unwanted WRITE(s).
+7 SET (DIQUIET,LRQUIET)=1
+8 ; Insure DILOCKTM is defined
+9 DO DT^DICRW
+10 ;
+11 ; Lock record while building message.
+12 ;F L +^LR(LRDFN,LRSS,LRIDT,0):DILOCKTM Q:$T H 5
+13 ;
+14 SET (LA7ERR,LA7NVAF)=0
SET LA7EVNT="LA7 LAB RESULTS AVAILABLE (EVN)"
+15 ; Create 62.49 entry but don't store message text.
+16 ;S LA7NOMSG=2
+17 SET LA7NOMSG=0
+18 ;
+19 IF $GET(LA7MTYP)=""
SET LA7MTYP="ORU"
+20 ;
+21 SET LA7X=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
+22 SET LRUID=$PIECE(LA7X,"^")
SET RUID=$PIECE(LA7X,"^",5)
+23 IF LRUID=""
SET LRUID=$$LRUID^LRX(LRAA,LRAD,LRAN)
+24 ;
+25 SET (LA7RSITE,SITE)="LA7HDR"
SET LA7ID=LA7RSITE_"-O-"
SET LA76248=$ORDER(^LAHM(62.48,"B",LA7RSITE,0))
+26 ; No entry in 62.48 - *** Need to add error logging ****
+27 IF 'LA76248
QUIT
+28 ;I '$P(^LAHM(62.48,LA76248,0),"^",3) Q ; not active
+29 SET LA7INTYP=+$PIECE(^LAHM(62.48,LA76248,0),"^",9)
+30 ;
+31 ; Determine if patient needs to have initial load sent to HDR.
+32 ; *** need to establish location of HDR flag in 63***
+33 SET LA7LOAD=0
+34 ;
+35 ; Create new outgoing entry in 62.49
+36 SET (LA76249,LA76249P)=$$INIT6249^LA7VHLU
+37 IF LA76249<1
Begin DoDot:1
+38 ; Log entry creation error
End DoDot:1
QUIT
+39 ;
+40 KILL ^TMP("LA7-QRY",$JOB)
+41 ;
+42 ; Check "CH" test results for ordered tests.
+43 ; Per Change Control Board decision to perform lab test's result aggregation on VistA -
+44 ; - besides test verified during this session include all other test results stored with this specimen.
+45 IF LRSS="CH"
Begin DoDot:1
+46 NEW FDA,FDAIEN,LA7ER,LA7VT,LRSB
+47 SET LA7Y=1
+48 FOR
SET LA7Y=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7Y))
IF 'LA7Y
QUIT
Begin DoDot:2
+49 IF '$DATA(LA7VCH(LA7Y))
SET LA7VCH(LA7Y)=^LR(LRDFN,LRSS,LRIDT,LA7Y)
+50 IF $PIECE(LA7VCH(LA7Y),"^")=""
QUIT
+51 SET LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LA7Y,$PIECE(LA7VCH(LA7Y),"^",3),LRSPEC)
+52 SET LRSB=LA7Y
IF $GET(LA7VCH(LA7Y,1))="C"
SET $PIECE(LRSB,"^",2)="C"
+53 ;I $D(^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS)) Q ; Already marked this report to send tried adding this here
+54 DO STORE^LA7QRY2
+55 KILL FDA,FDAIEN,LA7ER
+56 SET FDA(2,62.49162,"+2,"_LA76249_",",.01)=LRSB
+57 IF $GET(LA7VCH(LA7Y,1))="C"
SET FDA(2,62.49162,"+2,"_LA76249_",",.02)="C"
+58 SET FDAIEN(1)=LA76249
+59 DO UPDATE^DIE("","FDA(2)","FDAIEN","LA7ER(2)")
+60 DO CLEAN^DILF
End DoDot:2
+61 IF $GET(LA7INPT)
IF '$DATA(^TMP("LA7-QRY",$JOB,LRDFN,LRIDT,LRSS))
Begin DoDot:2
+62 SET ^TMP("LA7-QRY",$JOB,LRDFN,LRIDT,LRSS)=""
End DoDot:2
End DoDot:1
+63 ;
+64 IF "CYEMSP"[LRSS
Begin DoDot:1
+65 SET LRSB=.012
SET LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"","")
+66 DO STORE^LA7QRY2
End DoDot:1
+67 ;
+68 IF LRSS="MI"
Begin DoDot:1
+69 SET LRSPEC=$PIECE(^LR(LRDFN,LRSS,LRIDT,0),"^",5)
+70 SET LA7ND=0
+71 FOR LA7ND=1,5,8,11,16
IF $DATA(^LR(LRDFN,LRSS,LRIDT,LA7ND))
Begin DoDot:2
+72 ; If no status - skip
IF $PIECE(^LR(LRDFN,LRSS,LRIDT,LA7ND),"^",2)=""
QUIT
+73 ; Already marked this report to send
IF $DATA(^TMP("LA7-QRY",$JOB,LRDFN,LRIDT,LRSS))
QUIT
+74 SET LRSB=$SELECT(LA7ND=1:11,LA7ND=5:14,LA7ND=8:18,LA7ND=11:22,LA7ND=16:33,1:11)
+75 SET LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"",LRSPEC)
+76 DO STORE^LA7QRY2
End DoDot:2
End DoDot:1
+77 ;
+78 SET GBL="^TMP(""HLS"","_$JOB_")"
+79 DO STARTMSG^LA7CHLU(LA7EVNT,.LA76249,LA7NOMSG)
+80 IF $GET(HL)
SET LA7ERR=$TRANSLATE(HL,"^","-")
+81 SET (HLQ,HL("Q"))=""
+82 DO CHKACC^LA7VMSG
+83 IF 'LA7ERR
Begin DoDot:1
+84 IF LA7LOAD
Begin DoDot:2
+85 NEW LA7EDT,LA7SC,LA7SDT,LA7SPEC,LRIDT,LRSS,LRUID
+86 SET (LA7SC,LA7SPEC)="*"
SET LA7SDT=$$FMADD^XLFDT(DT,-730,0,0,0)
SET LA7EDT=DT
+87 DO BCD^LA7QRY2
End DoDot:2
+88 DO BUILDMSG^LA7CQRY1
+89 DO SENDMSG^LA7VMSG1
End DoDot:1
+90 SET LA7ID=LA7RSITE_"-O-"_LRUID
+91 DO UPDT6249^LA7VORM1
+92 ; File additional data
+93 SET FDA(1,62.49,LA76249_",",151)=LRUID
+94 SET FDA(1,62.49,LA76249_",",156)=LRIDT
+95 SET FDA(1,62.49,LA76249_",",157)=LRSS
+96 SET FDA(1,62.49,LA76249_",",158)=LRDFN
+97 DO FILE^DIE("","FDA(1)","LA7ERR(1)")
+98 DO CLEAN^DILF
+99 ;
+100 ; Release locks on entries.
+101 LOCK -^LAHM(62.49,LA76249)
+102 LOCK -^LR(LRDFN,LRSS,LRIDT)
+103 ;
+104 ; Cleanup
+105 KILL LA7ND,LRUID,LRNLT,LRIDT,LRSS,LRDFN,LA7VCH,LA7MTYP
+106 KILL LA7101,LA7953,LA7CODE,LA7NTESN,LA7OP,LA7PIDSN,LA7PRI,LA7SFT,LA7SITE,LA7VER,LA7FAC,LA7CLDT
+107 KILL PID,NK1,SPM,TQ1,NTE
+108 KILL LA7PAT,LA7INPT,LA7REJ,LA7ORCSN,LA7ADDON,LA7ADDPN,LA7PARNT,LA7STOR,LA7OBX,LA7OBR
+109 DO EXIT^LA7HDR1
+110 QUIT
+111 ;
+112 ;
MSH(FS,ECH,SITE) ;return the msh segment
+1 NEW I,J,MSH,CS,RS,MSHA,MSHAA
+2 SET MSHA=$GET(^BLRRLMU(SITE,"MSH"))
+3 SET MSHAA=$GET(^BLRRLMU(SITE,"MSHA"))
+4 SET CS=$EXTRACT(ECH,1,1)
+5 SET RS=$EXTRACT(ECH,2,2)
+6 FOR I=1:1:25
SET MSH(I)=""
+7 SET MSH="MSH"
+8 SET MSH(1)=FS
+9 SET MSH(2)=ECH
+10 SET MSH(3)=$PIECE(MSHA,U)_CS_$PIECE(MSHA,U,2)_CS_$PIECE(MSHA,U,3)
+11 SET MSH(4)=$PIECE(MSHA,U,4)_CS_$PIECE(MSHA,U,5)_CS_$PIECE(MSHA,U,6)
+12 SET MSH(5)=$PIECE(MSHA,U,7)_CS_$PIECE(MSHA,U,8)_CS_$PIECE(MSHA,U,9)
+13 SET MSH(6)=$PIECE(MSHA,U,10)_CS_$PIECE(MSHA,U,11)_CS_$PIECE(MSHA,U,12)
+14 SET MSH(7)=$$FMTHL7^XLFDT($$NOW^XLFDT)
+15 SET MSH(9)="ORU"_CS_"R01"_CS_"ORU_R01"
+16 SET MSH(10)="RPMS-HL-"_$RANDOM(100000)
+17 SET MSH(11)="T"
+18 SET MSH(12)=$PIECE($GET(^BLRRLMU(SITE,0)),U,2)
+19 SET MSH(15)="NE"
+20 SET MSH(16)="NE"
+21 IF $GET(LA7INPT)
Begin DoDot:1
+22 SET MSH(15)="AL"
+23 SET MSH(16)="NE"
End DoDot:1
+24 SET MSH(21)=$PIECE(MSHA,U,13)_CS_$PIECE(MSHA,U,14)_CS_$PIECE(MSHAA,U)_CS_$PIECE(MSHAA,U,2)
+25 ;lets make this dynamic below as it is for LRI inpatient
+26 IF $GET(LA7INPT)
SET MSH(21)="LRI_Common_Component^Profile Component^2.16.840.1.113883.9.16^ISO~LRI_NG_Component^Profile Component^2.16.840.1.113883.9.13^ISO~LRI_RU_Component^Profile Component^2.16.840.1.113883.9.14^ISO"
+27 FOR J=2:1:25
SET $PIECE(MSH,FS,J)=MSH(J)
+28 QUIT MSH
+29 ;
RTR(LA7SS) ;
+1 ; Call with LA7SS = list of subscripts that HDR wants separated by ";"
+2 ; (LA7SS="CH;MI;EM")
+3 ;
+4 ; Setup link and subscriber array for HL7 HDR message generation
+5 ; Determine if HDR wants to receive lab results for this subscript
+6 ; Called by subscriber router protocol LA7 LAB RESULTS TO HDR (SUB)
+7 ; Check outgoing message and find OBR segment to determine Laboratory
+8 ; subscript this result is associated with and if it's contained in
+9 ; the LA7SS subscript list.
+10 ;
+11 NEW LA7I,LA7SEG,LA7VI,LA7VJ,LA7X,LRSS,LRX
+12 ;
+13 SET LRSS=""
+14 FOR LA7VI=1:1
XECUTE HLNEXT
IF HLQUIT'>0
QUIT
Begin DoDot:1
+15 IF $EXTRACT(HLNODE,1,3)'="OBR"
QUIT
+16 SET LA7SEG(0)=HLNODE
+17 SET LA7VJ=0
+18 FOR
SET LA7VJ=$ORDER(HLNODE(LA7VJ))
IF 'LA7VJ
QUIT
SET LA7SEG(LA7VJ)=HLNODE(LA7VJ)
+19 SET LRX=$$P^LA7VHLU(.LA7SEG,21,HL("FS"))
SET LRX=$$UNESC^LA7VHLU3(LRX,HL("FS")_HL("ECH"))
+20 SET LRSS=$PIECE(LRX,"^",2)
End DoDot:1
IF LRSS'=""
QUIT
+21 ;
+22 FOR LA7I=1:1
SET LA7X=$PIECE(LA7SS,";",LA7I)
IF LA7X=""
QUIT
Begin DoDot:1
+23 IF LA7X=LRSS
SET HLL("LINKS",1)="LA7 LAB RESULTS TO HDR (SUB)^VDEFVIE4"
SET LA7X=""
End DoDot:1
IF LA7X=""
QUIT
+24 QUIT
+25 ;
+26 ;
HDRLOAD(LA7SDT,LA7EDT,LA7LIMIT,LA7EVENT) ; Load patient's historical lab results to HDR (Health Data Repository).
+1 ; Call with LA7SDT = start date of data extraction in FileMan format
+2 ; LA7EDT = end date of data extraction in FileMan format
+3 ; LA7LIMIT = # of messages to create this session (default =1000)
+4 ; LA7EVENT = name of HL7 event protocol to transmit messages
+5 ;
+6 DO HDRLOAD^LA7HDR1
+7 QUIT
+8 ;
+9 ;
RECOVER ; Recover failed transmissions or message building
+1 ; Called by option Recover/Transmit Lab HDR Result Messages [LA7 HDR RECOVER]
+2 ;
+3 DO RECOVER^LA7HDR1
+4 QUIT
