LA7HDR ;VA/DALOI/JMC - LAB HDR ORU (Observation Result) message builder ; 13-Aug-2013 09:09 ; MKK
;;5.2;AUTOMATED LAB INSTRUMENTS;**68,1033**;NOV 1, 1997
;
; Reference to variable DIQUIET supported by DBIA #2098
;
Q
;
;
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
; LRSB (Optional) - array of Chemistry results
; ex. glucose LRSB(2)=LR NODE
;
D ENTRYAUD^BLRUTIL("QUEUE^LA7HDR 0.0")
;
N I,LA76248,LA7V,LA7VCH,LASTYP,LAVERR,X,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
;
; 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
;
Q:$$NOLRSPEC() ; IHS/MSC/MKK - LR*5.2*1033 -- Quit if LRSPEC Variable is null or cannot be set
;
; 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 ZTRTN="BUILD^LA7HDR",ZTDTH=$H,ZTIO="",ZTDESC="Tasked Lab HL7 HDR ORU Build"
F I="LRAA","LRAD","LRAN","LRIDT","LRSS","LRDFN" 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 ^%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
;
;
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
NOLRSPEC() ; EP - Check LRSPEC Variable
D ENTRYAUD^BLRUTIL("NOLRSPEC^LA7HDR 0.0")
;
Q:+$G(LRSPEC) 0 ; If LRSPEC exists, return
;
S LRSPEC=$P($G(^LR(LRDFN,LRSS,LRIDT,0)),U,5) ; Try setting LRSPEC using Lab Data file
;
Q:+$G(LRSPEC) 0
;
Q 1
; ----- END IHS/MSC/MKK - LR*5.2*1033
;
;
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.
;
D ENTRYAUD^BLRUTIL("BUILD^LA7HDR 0.0")
;
N DIQUIET,FDA,GBL,HL,HLQ,RUID,SITE
N LA76248,LA76249,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)
;
D ENTRYAUD^BLRUTIL("BUILD^LA7HDR 5.0")
;
; 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"
. . 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 "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^LA7VHLU(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^LA7QRY1
. 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
D EXIT^LA7HDR1
Q
;
;
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
LA7HDR ;VA/DALOI/JMC - LAB HDR ORU (Observation Result) message builder ; 13-Aug-2013 09:09 ; MKK
+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 ;
+7 ;
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 ; LRSB (Optional) - array of Chemistry results
+12 ; ex. glucose LRSB(2)=LR NODE
+13 ;
+14 DO ENTRYAUD^BLRUTIL("QUEUE^LA7HDR 0.0")
+15 ;
+16 NEW I,LA76248,LA7V,LA7VCH,LASTYP,LAVERR,X,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+17 ;
+18 ; If no accession area then quit - not much we can do.
+19 IF $GET(LRAA)=""
QUIT
+20 ;
+21 ; If LRSS not defined then set from file #68
+22 IF $GET(LRSS)=""
NEW LRSS
SET LRSS=$PIECE($GET(^LRO(68,LRAA,0)),"^",2)
+23 ;
+24 ; Not supporting AU and BB at this time (or if LRSS is null).
+25 IF "AUBB"[LRSS
QUIT
+26 ;
+27 ; Check if CPRS has called us more than once for this accession.
+28 ; Results are processed on first call.
+29 IF $DATA(LRTMPO("LRIFN"))
IF $GET(LRNIFN)>1
QUIT
+30 IF LRSS="MI"
IF $DATA(LRTMPO("LRIFN"))
IF $GET(^TMP("LA7HDR",$JOB))=(LRAA_"^"_LRAD_"^"_LRAN)
KILL ^TMP("LA7HDR",$JOB)
QUIT
+31 ;
+32 ; Quit if test patient on a production account.
+33 IF $$TESTPAT^VADPT($PIECE($GET(^LR(LRDFN,0)),"^",3))
IF $$PROD^XUPROD(0)
QUIT
+34 ;
+35 ; IHS/MSC/MKK - LR*5.2*1033 -- Quit if LRSPEC Variable is null or cannot be set
IF $$NOLRSPEC()
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 ZTRTN="BUILD^LA7HDR"
SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTDESC="Tasked Lab HL7 HDR ORU Build"
+45 FOR I="LRAA","LRAD","LRAN","LRIDT","LRSS","LRDFN"
SET ZTSAVE(I)=""
+46 IF LRSS="CH"
Begin DoDot:1
+47 SET LA7V=0
+48 FOR
SET LA7V=$ORDER(LRSB(LA7V))
IF 'LA7V
QUIT
Begin DoDot:2
+49 IF $PIECE(LRSB(LA7V),"^")=""
QUIT
+50 SET LA7VCH(LA7V)=LRSB(LA7V)
+51 IF $DATA(LRSA(LA7V,2))
SET LA7VCH(LA7V,1)="C"
End DoDot:2
+52 SET ZTSAVE("LA7VCH*")=""
SET ZTSAVE("LRSPEC")=""
End DoDot:1
+53 IF LRSS="CH"
IF '$DATA(LA7VCH)
QUIT
+54 SET ZTSAVE=("LA7MTYP")="ORU"
+55 DO ^%ZTLOAD
+56 IF $GET(ZTSK)'>0
QUIT
+57 ;
+58 ; Set flag to handle CPRS calling us multiple times during verifying session for each ordered test.
+59 SET ^TMP("LA7HDR",$JOB)=LRAA_"^"_LRAD_"^"_LRAN
+60 ;
+61 QUIT
+62 ;
+63 ;
+64 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
NOLRSPEC() ; EP - Check LRSPEC Variable
+1 DO ENTRYAUD^BLRUTIL("NOLRSPEC^LA7HDR 0.0")
+2 ;
+3 ; If LRSPEC exists, return
IF +$GET(LRSPEC)
QUIT 0
+4 ;
+5 ; Try setting LRSPEC using Lab Data file
SET LRSPEC=$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,0)),U,5)
+6 ;
+7 IF +$GET(LRSPEC)
QUIT 0
+8 ;
+9 QUIT 1
+10 ; ----- END IHS/MSC/MKK - LR*5.2*1033
+11 ;
+12 ;
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 DO ENTRYAUD^BLRUTIL("BUILD^LA7HDR 0.0")
+4 ;
+5 NEW DIQUIET,FDA,GBL,HL,HLQ,RUID,SITE
+6 NEW LA76248,LA76249,LA76249P,LA7DT,LA7ERR,LA7EVNT,LA7ID,LA7INTYP,LA7LNCVR,LA7LOAD,LA7NOMSG,LA7NVAF,LA7RSITE,LA7X,LA7Y,LRQUIET,LRUID
+7 ;
+8 ; Prevent FileMan from issuing any unwanted WRITE(s).
+9 SET (DIQUIET,LRQUIET)=1
+10 ; Insure DILOCKTM is defined
+11 DO DT^DICRW
+12 ;
+13 ; Lock record while building message.
+14 FOR
LOCK +^LR(LRDFN,LRSS,LRIDT,0):DILOCKTM
IF $TEST
QUIT
HANG 5
+15 ;
+16 SET (LA7ERR,LA7NVAF)=0
SET LA7EVNT="LA7 LAB RESULTS AVAILABLE (EVN)"
+17 ; Create 62.49 entry but don't store message text.
+18 ;S LA7NOMSG=2
+19 SET LA7NOMSG=0
+20 ;
+21 IF $GET(LA7MTYP)=""
SET LA7MTYP="ORU"
+22 ;
+23 SET LA7X=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
+24 SET LRUID=$PIECE(LA7X,"^")
SET RUID=$PIECE(LA7X,"^",5)
+25 IF LRUID=""
SET LRUID=$$LRUID^LRX(LRAA,LRAD,LRAN)
+26 ;
+27 SET (LA7RSITE,SITE)="LA7HDR"
SET LA7ID=LA7RSITE_"-O-"
SET LA76248=$ORDER(^LAHM(62.48,"B",LA7RSITE,0))
+28 ; No entry in 62.48 - *** Need to add error logging ****
+29 IF 'LA76248
QUIT
+30 ; not active
IF '$PIECE(^LAHM(62.48,LA76248,0),"^",3)
QUIT
+31 SET LA7INTYP=+$PIECE(^LAHM(62.48,LA76248,0),"^",9)
+32 ;
+33 DO ENTRYAUD^BLRUTIL("BUILD^LA7HDR 5.0")
+34 ;
+35 ; Determine if patient needs to have initial load sent to HDR.
+36 ; *** need to establish location of HDR flag in 63***
+37 SET LA7LOAD=0
+38 ;
+39 ; Create new outgoing entry in 62.49
+40 SET (LA76249,LA76249P)=$$INIT6249^LA7VHLU
+41 IF LA76249<1
Begin DoDot:1
+42 ; Log entry creation error
End DoDot:1
QUIT
+43 ;
+44 KILL ^TMP("LA7-QRY",$JOB)
+45 ;
+46 ; Check "CH" test results for ordered tests.
+47 ; Per Change Control Board decision to perform lab test's result aggregation on VistA -
+48 ; - besides test verified during this session include all other test results stored with this specimen.
+49 IF LRSS="CH"
Begin DoDot:1
+50 NEW FDA,FDAIEN,LA7ER,LA7VT,LRSB
+51 SET LA7Y=1
+52 FOR
SET LA7Y=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7Y))
IF 'LA7Y
QUIT
Begin DoDot:2
+53 IF '$DATA(LA7VCH(LA7Y))
SET LA7VCH(LA7Y)=^LR(LRDFN,LRSS,LRIDT,LA7Y)
+54 IF $PIECE(LA7VCH(LA7Y),"^")=""
QUIT
+55 SET LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LA7Y,$PIECE(LA7VCH(LA7Y),"^",3),LRSPEC)
+56 SET LRSB=LA7Y
IF $GET(LA7VCH(LA7Y,1))="C"
SET $PIECE(LRSB,"^",2)="C"
+57 DO STORE^LA7QRY2
+58 KILL FDA,FDAIEN,LA7ER
+59 SET FDA(2,62.49162,"+2,"_LA76249_",",.01)=LRSB
+60 IF $GET(LA7VCH(LA7Y,1))="C"
SET FDA(2,62.49162,"+2,"_LA76249_",",.02)="C"
+61 SET FDAIEN(1)=LA76249
+62 DO UPDATE^DIE("","FDA(2)","FDAIEN","LA7ER(2)")
+63 DO CLEAN^DILF
End DoDot:2
End DoDot:1
+64 ;
+65 IF "CYEMSP"[LRSS
Begin DoDot:1
+66 SET LRSB=.012
SET LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"","")
+67 DO STORE^LA7QRY2
End DoDot:1
+68 ;
+69 IF LRSS="MI"
Begin DoDot:1
+70 SET LRSPEC=$PIECE(^LR(LRDFN,LRSS,LRIDT,0),"^",5)
+71 SET LA7ND=0
+72 FOR LA7ND=1,5,8,11,16
IF $DATA(^LR(LRDFN,LRSS,LRIDT,LA7ND))
Begin DoDot:2
+73 ; If no status - skip
IF $PIECE(^LR(LRDFN,LRSS,LRIDT,LA7ND),"^",2)=""
QUIT
+74 ; Already marked this report to send
IF $DATA(^TMP("LA7-QRY",$JOB,LRDFN,LRIDT,LRSS))
QUIT
+75 SET LRSB=$SELECT(LA7ND=1:11,LA7ND=5:14,LA7ND=8:18,LA7ND=11:22,LA7ND=16:33,1:11)
+76 SET LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"",LRSPEC)
+77 DO STORE^LA7QRY2
End DoDot:2
End DoDot:1
+78 ;
+79 SET GBL="^TMP(""HLS"","_$JOB_")"
+80 DO STARTMSG^LA7VHLU(LA7EVNT,.LA76249,LA7NOMSG)
+81 IF $GET(HL)
SET LA7ERR=$TRANSLATE(HL,"^","-")
+82 SET (HLQ,HL("Q"))=""
+83 DO CHKACC^LA7VMSG
+84 IF 'LA7ERR
Begin DoDot:1
+85 IF LA7LOAD
Begin DoDot:2
+86 NEW LA7EDT,LA7SC,LA7SDT,LA7SPEC,LRIDT,LRSS,LRUID
+87 SET (LA7SC,LA7SPEC)="*"
SET LA7SDT=$$FMADD^XLFDT(DT,-730,0,0,0)
SET LA7EDT=DT
+88 DO BCD^LA7QRY2
End DoDot:2
+89 DO BUILDMSG^LA7QRY1
+90 DO SENDMSG^LA7VMSG1
End DoDot:1
+91 SET LA7ID=LA7RSITE_"-O-"_LRUID
+92 DO UPDT6249^LA7VORM1
+93 ; File additional data
+94 SET FDA(1,62.49,LA76249_",",151)=LRUID
+95 SET FDA(1,62.49,LA76249_",",156)=LRIDT
+96 SET FDA(1,62.49,LA76249_",",157)=LRSS
+97 SET FDA(1,62.49,LA76249_",",158)=LRDFN
+98 DO FILE^DIE("","FDA(1)","LA7ERR(1)")
+99 DO CLEAN^DILF
+100 ;
+101 ; Release locks on entries.
+102 LOCK -^LAHM(62.49,LA76249)
+103 LOCK -^LR(LRDFN,LRSS,LRIDT)
+104 ;
+105 ; Cleanup
+106 KILL LA7ND,LRUID,LRNLT,LRIDT,LRSS,LRDFN,LA7VCH,LA7MTYP
+107 DO EXIT^LA7HDR1
+108 QUIT
+109 ;
+110 ;
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
