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