LA7VMSG1 ;DALOI/JMC - LAB ORU (Observation Result) message builder cont'd ;Aug 8, 2008
;;5.2;AUTOMATED LAB INSTRUMENTS;**56,46,61,64,68,74**;Sep 27, 1994;Build 229
;
START ; Process entries in queue
; Called from LA7VMSG
;
N EID,GBL,HLEID,HLMTIEN,HLRESLT,HLARYTYP,HLECH,HLFS,HLCOMP,HLFORMAT,RSITE
N LA,LA76248,LA76249,LA76249P,LA7DT,LA7ECH,LA7END,LA7FS,LA7ID,LA7MID,LA7NVAF,LA7ROOT,LA7V,LA7VS,LA7VER,LA7V0N,LA7VIEN,LA7X
N LAER,LRDFN,LRIDT,LRNT,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
;
D LOCK^DILF("^LAHM(62.49,""HL7 PROCESS"",LA7MTYP)")
I '$T Q
;
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 transmission
;
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)
; Check status of each message to insure that cross-reference is not an orphan which can cause
; repetitive message generation and receving problems.
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)
. D LOCK^DILF("^LAHM(62.49,LA76249)") Q:'$T
. I $P($G(^LAHM(62.49,LA76249,0)),"^",3)'="P" K ^LAHM(62.49,"AC",LA7MTYP,"P",LA76248,LA76249) L -^LAHM(62.49,LA76249) Q
. 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="",LA7ID=$P(LA76248(0),"^")_"-O-"
;
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
I $G(PNM)'="" D
. D SETID^LA7VHLU1(LA76249,LA7ID,PNM,0)
. D SETID^LA7VHLU1(LA76249,"",PNM,0)
I $G(SSN)'="" D
. D SETID^LA7VHLU1(LA76249,LA7ID,SSN,0)
. D SETID^LA7VHLU1(LA76249,"",SSN,0)
;
; 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
;
; UNDEF HL array will cause HL7 filers to stop. The $G(HL(x)) prevents the filers from halting on UNDEF error but we
; want to log the missing HL array as an error for system monitoring/troubleshooting.
I $D(HL)<10 D ^%ZTER
;
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 $P(^LAHM(62.49,LA76249,0),"^",3)'="E" D
. . 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)=$G(HL("SAN"))
. S FDA(1,62.49,LA76249_",",103)=$G(HL("SAF"))
. S FDA(1,62.49,LA76249_",",108)=$G(HL("MTN"))
. S FDA(1,62.49,LA76249_",",110)=$G(HL("PID"))
. S FDA(1,62.49,LA76249_",",111)=$G(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
. D UPID^LA7VHLU1(LA76249)
;
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
. ;
. D LOCK^DILF("^LRO(69.6,LA7696)")
. ; 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VMSG1 8843 printed Dec 13, 2024@01:40:46 Page 2
LA7VMSG1 ;DALOI/JMC - LAB ORU (Observation Result) message builder cont'd ;Aug 8, 2008
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**56,46,61,64,68,74**;Sep 27, 1994;Build 229
+2 ;
START ; Process entries in queue
+1 ; Called from LA7VMSG
+2 ;
+3 NEW EID,GBL,HLEID,HLMTIEN,HLRESLT,HLARYTYP,HLECH,HLFS,HLCOMP,HLFORMAT,RSITE
+4 NEW LA,LA76248,LA76249,LA76249P,LA7DT,LA7ECH,LA7END,LA7FS,LA7ID,LA7MID,LA7NVAF,LA7ROOT,LA7V,LA7VS,LA7VER,LA7V0N,LA7VIEN,LA7X
+5 NEW LAER,LRDFN,LRIDT,LRNT,LRSS,LRUID
+6 ;
+7 ; variable list
+8 ; LA("LRUID") - Host Unique ID from the local ACCESSION file (#68)
+9 ; LA("SITE") - Primary site number of remote site ($$SITE^VASITE)
+10 ; LA("RUID") - Remote sites Unique ID from ACCESSION file (#68)
+11 ; LA("ORD") - Free text ordered test name from WKLD CODE file (#64)
+12 ; LA("LRNLT") - National Laboratory test code from WKLD CODE file (#64)
+13 ; LA("LRIDT") - Inverse date/time (accession date/time)
+14 ; LA("LRSS") - test subscript defined in LABORATORY TEST file (#60)
+15 ; LA("LRDFN") - IEN in LAB DATA file (#63)
+16 ; LA("ORDT") - Order date
+17 ; LA(62.49) - entry in #62.49 which contains pointer to results to build
+18 ;
+19 DO LOCK^DILF("^LAHM(62.49,""HL7 PROCESS"",LA7MTYP)")
+20 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 transmission
+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 ; Check status of each message to insure that cross-reference is not an orphan which can cause
+10 ; repetitive message generation and receving problems.
+11 SET LA7ROOT="^LAHM(62.49,""AC"",LA7MTYP,""P"")"
+12 FOR
SET LA7ROOT=$QUERY(@LA7ROOT)
if LA7END
QUIT
Begin DoDot:1
+13 IF $QSUBSCRIPT(LA7ROOT,3)'=LA7MTYP!($QSUBSCRIPT(LA7ROOT,6)<1)
SET LA7END=1
QUIT
+14 SET LA76248=$QSUBSCRIPT(LA7ROOT,5)
SET LA76249=$QSUBSCRIPT(LA7ROOT,6)
+15 DO LOCK^DILF("^LAHM(62.49,LA76249)")
if '$TEST
QUIT
+16 IF $PIECE($GET(^LAHM(62.49,LA76249,0)),"^",3)'="P"
KILL ^LAHM(62.49,"AC",LA7MTYP,"P",LA76248,LA76249)
LOCK -^LAHM(62.49,LA76249)
QUIT
+17 SET LRDFN=$PIECE($GET(^LAHM(62.49,LA76249,63)),"^",8)
+18 SET LRUID=$PIECE($GET(^LAHM(62.49,LA76249,63)),"^",1)
+19 IF LRDFN
IF LRUID'=""
SET ^TMP("LA76248",$JOB,LA76248,LRDFN,LRUID,LA76249)=""
+20 LOCK -^LAHM(62.49,LA76249)
End DoDot:1
+21 ;
+22 QUIT
+23 ;
+24 ;
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=""
SET LA7ID=$PIECE(LA76248(0),"^")_"-O-"
+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 IF $GET(PNM)'=""
Begin DoDot:1
+15 DO SETID^LA7VHLU1(LA76249,LA7ID,PNM,0)
+16 DO SETID^LA7VHLU1(LA76249,"",PNM,0)
End DoDot:1
+17 IF $GET(SSN)'=""
Begin DoDot:1
+18 DO SETID^LA7VHLU1(LA76249,LA7ID,SSN,0)
+19 DO SETID^LA7VHLU1(LA76249,"",SSN,0)
End DoDot:1
+20 ;
+21 ; Send placer's patient id (PID-3), return in PID-2, return PID-4 with alternate id
+22 SET (LA7ALTID,LA7EXTID)=""
+23 DO PTEXTID^LA7VHLU(LA("SITE"),LA("RUID"),.LA7EXTID)
+24 IF $GET(LA7EXTID("PID-2"))'=""
SET LA7EXTID=$$CNVFLD^LA7VHLU3(LA7EXTID("PID-2"),LA7EXTID("ECH"),LA7ECH)
+25 IF $GET(LA7EXTID("PID-4"))'=""
SET LA7ALTID=$$CNVFLD^LA7VHLU3(LA7EXTID("PID-4"),LA7EXTID("ECH"),LA7ECH)
+26 ;
+27 ; Build PID segment
+28 DO PID^LA7VPID(LRDFN,LA7EXTID,.LA7PID,.LA7PIDSN,.HL,LA7ALTID)
+29 DO FILESEG^LA7VHLU(GBL,.LA7PID)
+30 DO FILE6249^LA7VHLU(LA76249P,.LA7PID)
+31 ;
+32 ; Build PV1 segment
+33 ; Not built when sending to DoD facility - not used by CHCS
+34 IF LA7NVAF'=1
Begin DoDot:1
+35 DO PV1^LA7VPID(LRDFN,.LA7PV1,LA7FS,LA7ECH)
+36 DO FILESEG^LA7VHLU(GBL,.LA7PV1)
+37 DO FILE6249^LA7VHLU(LA76249P,.LA7PV1)
End DoDot:1
+38 ;
+39 SET LRUID=""
SET (LA7OBRSN,LA7OBXSN,LA7NTESN)=0
+40 ;
+41 QUIT
+42 ;
+43 ;
UPDT6249 ; Update entries in file #62.49
+1 ;
+2 NEW LA7ERR,LA76249,LA76249P
+3 ;
+4 ; UNDEF HL array will cause HL7 filers to stop. The $G(HL(x)) prevents the filers from halting on UNDEF error but we
+5 ; want to log the missing HL array as an error for system monitoring/troubleshooting.
+6 IF $DATA(HL)<10
DO ^%ZTER
+7 ;
+8 SET LA76249=0
+9 FOR
SET LA76249=$ORDER(^TMP("LA7VS",$JOB,LA76249))
if 'LA76249
QUIT
Begin DoDot:1
+10 NEW FDA,LA7ERR
+11 SET LA76249P=+$GET(^TMP("LA7VS",$JOB,LA76249))
+12 ; Set pointer to parent on child entry.
+13 IF LA76249'=LA76249P
SET FDA(1,62.49,LA76249_",",6)=LA76249P
+14 IF $PIECE(^LAHM(62.49,LA76249,0),"^",3)'="E"
Begin DoDot:2
+15 IF $GET(HL("APAT"))="AL"!($GET(HL("APAT"))="")
SET FDA(1,62.49,LA76249_",",2)="A"
+16 IF '$TEST
SET FDA(1,62.49,LA76249_",",2)="X"
End DoDot:2
+17 SET FDA(1,62.49,LA76249_",",102)=$GET(HL("SAN"))
+18 SET FDA(1,62.49,LA76249_",",103)=$GET(HL("SAF"))
+19 SET FDA(1,62.49,LA76249_",",108)=$GET(HL("MTN"))
+20 SET FDA(1,62.49,LA76249_",",110)=$GET(HL("PID"))
+21 SET FDA(1,62.49,LA76249_",",111)=$GET(HL("VER"))
+22 IF $PIECE($GET(LA7MID),"^")'=""
SET FDA(1,62.49,LA76249_",",109)=$PIECE(LA7MID,"^")
+23 IF $PIECE($GET(LA7MID),"^",2)
Begin DoDot:2
+24 SET FDA(1,62.49,LA76249_",",160)=$PIECE(LA7MID,"^",2)
+25 SET FDA(1,62.49,LA76249_",",161)=$PIECE(LA7MID,"^",3)
End DoDot:2
+26 DO FILE^DIE("","FDA(1)","LA7ERR(1)")
+27 DO CLEAN^DILF
+28 DO UPID^LA7VHLU1(LA76249)
End DoDot:1
+29 ;
+30 QUIT
+31 ;
+32 ;
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 DO LOCK^DILF("^LRO(69.6,LA7696)")
+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
