LA7VIN5 ;DALOI/JMC - Process Incoming UI Msgs, continued ;04/19/16 16:28
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,68,74,84,88**;Sep 27, 1994;Build 10
;
; This routine is a continuation of LA7VIN1 and is only called from there.
; It is called to process OBX segments for "CH" subscript tests.
;
; ZEXCEPT is used to identify variables which are external to a specific TAG
; used in conjunction with Eclipse M-editor.
Q
;
OBX ;
;
N LA76241,LA76304,LA7EII,LA7I,LA7J,LA7LIMIT,LA7OBM,LA7SUBFL,LA7TEST,LA7TREEN,LA7UNITS,LA7VAL,LA7VTYP,LA7X,LA7XFORM,LA7Y
;
K LA7RMK,^TMP("LA7TREE",$J)
;
S LA7SUBFL=63.04
;
; OBX Set ID
S LA7SOBX=$$P^LA7VHLU(.LA7SEG,2,LA7FS)
;
; Value type - type of data from Table 0125
S LA7VTYP=$P($$P^LA7VHLU(.LA7SEG,3,LA7FS),LA7CS)
;
; Determine test result codes - check for primary and alternate codes
; For DoD/CHCS interface - do NOT process test codes using 99LRT as coding system per DoD/July 2002.
S LA7X=$$P^LA7VHLU(.LA7SEG,4,LA7FS),(LA7RNLT,LA7RLNC)=""
S LA7TEST=$P(LA7X,LA7CS)
S LA7TEST(0)=$$UNESC^LA7VHLU3($P(LA7X,LA7CS,2),LA7FS_LA7ECH)
I LA7TEST(0)["^" S LA7TEST(0)=$TR(LA7TEST(0),"^","~")
S LA7TEST(0,1)=$P(LA7X,LA7CS,3)
S LA7TEST(2)=$P(LA7X,LA7CS,4)
S LA7TEST(2,0)=$$UNESC^LA7VHLU3($P(LA7X,LA7CS,5),LA7FS_LA7ECH)
I LA7TEST(2,0)["^" S LA7TEST(2,0)=$TR(LA7TEST(2,0),"^","~")
S LA7TEST(2,1)=$P(LA7X,LA7CS,6)
F I=3,6 D
. S LA7Y=$P(LA7X,LA7CS,I-2)
. I $P(LA7X,LA7CS,I)="LN" D Q
. . I $P($G(^LAB(95.3,+LA7Y,0)),"^")=LA7Y S LA7RLNC=+LA7Y Q
. . I $P($G(^LAB(95.3,+LA7Y,0)),"^")=+LA7Y S LA7RLNC=+LA7Y Q
. . S LA7J=$O(^LAB(95.3,"B",LA7Y,0))
. . I LA7J S LA7RLNC=LA7J
. I $P(LA7X,LA7CS,I)="99VA64" D Q
. . I $$FIND1^DIC(64,"","OMX",LA7Y) S LA7RNLT=LA7Y
. I $P(LA7X,LA7CS,I)="99LRT" D Q
. . I LA7TEST(0)="",LA7TEST(2,0)'="" S LA7TEST(0)=LA7TEST(2,0)
. . I LA7TEST(2,0)="",LA7TEST(0)'="" S LA7TEST(2,0)=LA7TEST(0)
. . I I=3 S (LA7TEST,LA7TEST(0),LA7TEST(0,1))="" Q
. . I I=6 S (LA7TEST(2),LA7TEST(2,0),LA7TEST(2,1))="" Q
I LA7TEST="",LA7TEST(2)'="" D
. S LA7TEST=LA7TEST(2),LA7TEST(0)=LA7TEST(2,0),LA7TEST(0,1)=LA7TEST(2,1)
. S (LA7TEST(2),LA7TEST(2,0),LA7TEST(2,1))=""
;
; No test code in message
I LA7TEST="",LA7TEST(2)="" D Q
. N LA7OBX
. S LA7OBX=LA7SEG(0)
. S LA7ERR=15,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
;
; Test code not found in auto inst file, also check alternate codes,
; and log error if none found.
I LA7MTYP="ORU" D Q:LA7TEST=""
. I LA7TEST'="",$D(^LAB(62.4,LA7624,3,"AC",LA7TEST)) Q
. I LA7TEST(2)'="",$D(^LAB(62.4,LA7624,3,"AC",LA7TEST(2))) D Q
. . S LA7TEST=LA7TEST(2),LA7TEST(0)=LA7TEST(2,0),LA7TEST(0,1)=LA7TEST(2,1)
. S LA7ERR=16,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1) S LA7TEST=""
;
; Units - trim leading/trailing spaces
S LA7X=$$P^LA7VHLU(.LA7SEG,7,LA7FS),LA7UNITS=""
I LA7X'="" D
. F I=1:1:6 S LA7UNITS(I)=$$UNESC^LA7VHLU3($P(LA7X,LA7CS,I),LA7FS_LA7ECH)
. S LA7UNITS=$$TRIM^XLFSTR(LA7UNITS(1),"LR"," ")
. I LA7UNITS["^" D
. . N LA7STR S LA7STR("^")="~U~"
. . S LA7UNITS=$$REPLACE^XLFSTR(LA7UNITS,.LA7STR)
;
; Observation result status - Table 0085
S LA7ORS=$$P^LA7VHLU(.LA7SEG,12,LA7FS)
;
; Responsible observer
S LA7RO=$$XCNTFM^LA7VHLU9($$P^LA7VHLU(.LA7SEG,17,LA7FS),LA7ECH)
;
; Observation method
S LA7X=$$P^LA7VHLU(.LA7SEG,18,LA7FS),LA7OBM=""
I $P(LA7X,LA7CS,3)="99VA64_2" S LA7OBM=$P($P(LA7X,LA7CS,1),".",2),LA7OBM="."_LA7OBM
;
; Equipment instance identifier
S LA7EII=$$P^LA7VHLU(.LA7SEG,19,LA7FS)
I LA7EII'="" D
. S LA7EII=$$UNESC^LA7VHLU3(LA7EII,LA7FS_LA7ECH)
. S LA7EII=$TR(LA7EII,"^",";")
;
; Process ORU message results for all tests which use this test code.
I LA7MTYP="ORU" D Q
. S LA7AUTORELEASE=$$ARSTATUS(LA7OBR49,LA7OBM,LA7624) ; Set Auto Release flag
. S LA76241=0
. F S LA76241=$O(^LAB(62.4,LA7624,3,"AC",LA7TEST,LA76241)) Q:'LA76241 D PROCESS
;
I LA7MTYP="ORM",$G(LA7696)>0 D ORESULTS^LA7VIN5B
;
Q
;
;
PROCESS ; Process results for a given test code
F LA7I=0,1,2 S LA76241(LA7I)=$G(^LAB(62.4,LA7624,3,LA76241,LA7I))
;
; Chem test fields incorrect
I LA76241(0)="" S LA7ERR=18,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1) Q
;
; No dataname associated with this test - skip
S LA76304=$P($G(^LAB(60,+$P(LA76241(0),"^"),.2)),"^")
I LA76304<1 Q
;
S LA7VAL=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
I LA7VTYP="CE",$P(LA7VAL,LA7CS,2)'="" S LA7VAL=$P(LA7VAL,LA7CS,2)
E S LA7VAL=$P(LA7VAL,LA7CS)
S LA7VAL=$$UNESC^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
;
; Setup LA7RMK(0) variable in case comments (NTE) sent with test results.
S LA7RMK(0,+LA76241(0))=+$P(LA76241(2),"^",7)_"^"_$P(LA76241(2),"^",8)
;
; Set flag for new results alert
I LA7ORS'?1(1"C",1"D",1"W") S ^TMP("LA7-ORU",$J,LA76248,LA76249,"CH")=""
;
; Set flag to send amended results bulletin
I LA7INTYP=10,LA7ORS?1(1"C",1"D",1"W") D
. S LA7I=$O(^TMP("LA7 AMENDED RESULTS",$J,""),-1),LA7I=LA7I+1
. S X=LA7LWL_"^"_LA7ISQN_"^"_LA76304_"^"_LA76248_"^"_LA76249_"^"_LA7ORS_"^"_LA7TEST_"^"_$S(LA7TEST(0)'="":LA7TEST(0),1:LA7TEST(2,0))_"^"_$$P^LA7VHLU(.LA7SEG,9,LA7FS)
. S ^TMP("LA7 AMENDED RESULTS",$J,LA7I)=X
. I LA7UID'="" S ^LAH("LA7 AMENDED RESULTS",LA7UID,LA76304,LA7LWL,LA7ISQN)=X
;
; NOTE - this array can be set from inside PARAM 1
K LA7XFORM
;
; execute PARAM 1 if not a LEDI interface or auto release
I LA7INTYP'=10,LA7AUTORELEASE<1 X $P(LA76241(0),"^",2)
;
I $P(LA76241(2),"^",3)=0 Q
I $P(LA76241(2),"^",3)=2,LA7ORS'?1(1"C",1"F",1"U",1"X") Q
;
; If OBX indicates no result for this test then store VistA "canc" value.
I LA7ORS="X",LA7VAL="" S LA7VAL="canc"
;
; No value found
I LA7VAL="" D Q
. S LA7ERR=17,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
;
; Transform result based on fields in file 62.4
D XFORM^LA7VIN5A
Q:LA7VAL=""
;
; Check if result passes input transform on data name
D CHKDIE^LA7VIN5A
Q:LA7VAL=""
;
; Set flag to not store comments if it wasn't explicitly ordered.
I $G(LA7LIMIT)=1 D
. N LA76804
. K LA7LIMIT,LA7TREEN,^TMP("LA7TREE",$J)
. ; Store all tests accessioned in ^TMP
. S LA76804=0
. F S LA76804=$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA76804)) Q:'LA76804 D UNWIND^LA7UTIL(LA76804)
. I '$D(^TMP("LA7TREE",$J,+LA76241(0))) S LA7LIMIT=1 ;wasn't ordered
I $G(LA7LIMIT) D Q
. S $P(LA7RMK(0,+LA76241(0)),"^",1)=0
. K LA7LIMIT,^TMP("LA7TREE",$J)
K ^TMP("LA7TREE",$J)
;
; Check point of care interface for matching specimen type for this test in #62.4
I LA7INTYP>19,LA7INTYP<30 D Q:'LA761
. N LA70070
. S LA761="",LA7X=$P(LA76241(2),"^",13) Q:'LA7X
. S LA70070=$$GET1^DIQ(61,LA7X_",","LEDI HL7:HL7 ABBR")
. I LA70070=LA7SPEC S LA761=LA7X
;
; Set data node=test value
S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^")=LA7VAL
;
; Store reference ranges except for UI (LA7INTYP=1) interfaces
D REFRNG^LA7VIN5A($$P^LA7VHLU(.LA7SEG,8,LA7FS))
;
; Store order/result codes/observation method except for UI (LA7INTYP=1) interfaces
I LA7INTYP'=1 D
. S LA7X=$P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",3)
. I LA7ONLT S $P(LA7X,"!",1)=LA7ONLT
. I LA7RNLT S $P(LA7X,"!",2)=LA7RNLT
. I LA7RLNC S $P(LA7X,"!",3)=LA7RLNC
. I LA7OBM S $P(LA7X,"!",4)=LA7OBM
. S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",3)=LA7X
;
; Store abnormal flags except for UI (LA7INTYP=1) interfaces.
D ABFLAG^LA7VIN5A($$P^LA7VHLU(.LA7SEG,9,LA7FS))
;
; Store units except for UI non Auto Release (LA7INTYP=1,LA7AUTORELEASE=1) interfaces which pull values from file #60.
I LA7UNITS'="" D
. I LA7INTYP=1,'LA7AUTORELEASE Q
. S LA7X=$P($G(^LAH(LA7LWL,1,LA7ISQN,LA76304)),"^",5)
. S $P(LA7X,"!",7)=LA7UNITS
. S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=LA7X
;
; Store responsible observer on Lab UI (1) Auto Release, POC (20), POCA (21) interfaces
I LA7RO'="",$P(LA7RO,"^",2) D
. I LA7INTYP'?1(1"1",1"20",1"21") Q
. I LA7INTYP=1,'LA7AUTORELEASE Q
. S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",4)=$P(LA7RO,"^",2)
;
; Store specimen type except for UI (LA7INTYP=1) interfaces which pull values from the accession.
I LA7INTYP'=1,$G(LA761) D
. S X=$P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)
. S $P(X,"!")=LA761
. S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=X
;
; Store where test was performed except for UI (LA7INTYP=1) interfaces
; also store related filler order number
I LA7INTYP'=1 D
. N I,LA7X,LA74
. S LA7X=$$P^LA7VHLU(.LA7SEG,24,LA7FS),LA74=""
. I $P(LA7X,LA7CS,6)="CLIA" D
. . S LA74=$$IDX^XUAF4("CLIA",$P(LA7X,LA7CS,10))
. . I LA74 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",9)=LA74
. . E S LA74=""
. I LA74="" D PRDID^LA7VIN5A($$P^LA7VHLU(.LA7SEG,16,LA7FS),LA7SFAC,LA7CS)
. I LA7FID'="" D FID
;
; Store equipment instance identifier
I LA7EII'="" D EII^LA7VIN5A
;
; If results for LEDI interface (LA7INTYP=10) and site keeps file #60
; in sync with reference lab then compare message's units and normals
; with site's to detect changes(LA7FLAG=1) and notify site.
I LA7INTYP=10,$G(LA761),$G(^LAB(60,+$P(LA76241(0),"^"),1,LA761,.1)) D
. N LA760,LA7FLAG,LA7I,LA7Y,LA7X
. S LA760=+$P(LA76241(0),"^"),LA7Y=^LAB(60,LA760,1,LA761,0),LA7FLAG=0
. S LA7X=$P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)
. I $P(LA7Y,"^",7)'=$P(LA7X,"!",7) S LA7FLAG=1
. I 'LA7FLAG,$P(LA7Y,"^",2)=$P(LA7X,"!",2),$P(LA7Y,"^",3)=$P(LA7X,"!",3) Q
. I 'LA7FLAG D
. . N AGE,DOB,PNM,SEX
. . N LRDPF,LRNG,LRNGS,LRNG2,LRNG3,LRNG4,LRNG5,LRTREA,LRWRD,LRX,LRY
. . I $G(LRDFN) D DEM^LRX,KVAR^VADPT
. . S LRNG=LA7Y D NORM^LRVER5
. . S LA7Y=$TR(LRNG,$C(34),""),LA7X=$TR(LA7X,$C(34),"")
. . I $P(LA7Y,"^",2)=$P(LA7X,"!",2),$P(LA7Y,"^",3)=$P(LA7X,"!",3) Q
. . S LA7FLAG=1
. I 'LA7FLAG Q
. S LA7I=$O(^TMP("LA7 UNITS/NORMALS CHANGED",$J,""),-1),LA7I=LA7I+1
. S X=LA7LWL_"^"_LA7ISQN_"^"_LA76304_"^"_LA76248_"^"_LA76249_"^"_LA7ORS_"^"_LA7TEST_"^"_$S(LA7TEST(0)'="":LA7TEST(0),1:LA7TEST(2,0))_"^"_$$P^LA7VHLU(.LA7SEG,9,LA7FS)_"^"_LA760
. S ^TMP("LA7 UNITS/NORMALS CHANGED",$J,LA7I)=X
;
; If LEDI interface and order status change store which results
; associated with ordered test. Used to determine if order status
; changed bulletin needs to be generated.
I LA7INTYP=10,LA7SAC?1(1"A",1"G") D
. S LA7I=$G(LA7SAC(0)) Q:'LA7I
. S ^TMP("LA7 ORDER STATUS",$J,LA7I,+LA76241(0))=""
;
; Set flag if Lab UI Auto Release interface to start auto release processing routine when ;**88
; finished - tasked by LA7VIN before shutdown
I LA7INTYP=1,LA7AUTORELEASE,$G(LA7UID)'="" D
. S LA76249("AR")=LA7AUTORELEASE
. S LA7INTYP("LWL",LA7LWL)=""
. S ^TMP("LA7 AR",$J,LA7LWL,1,"AUTOREL",LA7ISQN)=LA7UID_"^"_LA7624
. S ^TMP("LA7 AR",$J,LA7LWL,1,"AUTOREL",LA7ISQN,LA76304)=LA7624_"^"_LA7AUTORELEASE
. S ^TMP("LA7 AR",$J,LA7LWL,1,"AUTOREL-UID",LA7UID,LA7ISQN,LA76249)=$G(LA7AAT(1))
;
Q
;
;
FID ; Store filler id
;
;ZEXCEPT: LA7LWL,LA76304,LA7FID,LA7ISQN
N LA7STR,LA7X,I
;
S LA7STR("^")="~U~",LA7X=LA7FID
;
I LA7X["^" S LA7X=$$REPLACE^XLFSTR(LA7X,.LA7STR)
;
F I=2:1:4 D
. I LA7FID(I)="" Q
. I LA7FID(I)["^" S $P(LA7X,"^",I)=$$REPLACE^XLFSTR(LA7FID(I),.LA7STR) Q
. S $P(LA7X,"^",I)=LA7FID(I)
;
S ^LAH(LA7LWL,1,LA7ISQN,.1,"OBR","FID",LA76304)=LA7X
;
Q
;
;
ARSTATUS(LA7OBR49,LA7OBM,LA7624) ; Determine if LAB UI and auto release enabled and results are to be sent to auto release process.
;
; Call with LA7OBR49 = result handling code from OBR.49
; LA7OBM = WKLD Suffix code (file #64.2) from OBX.17 - .9750 = auto verification, .9760 = tech verification.
; If "-.0000" then from OBR segment before OBX segment processed.
; LA7624 = ien of entry in AUTO INSTRUMENT file #62.4
;
N LA7X,STATUS
;
S STATUS=0
;
; Check if auto release master switch parameter is ON (1).
S LA7X=$$GET^XPAR("SYS^PKG","LA UI AUTO RELEASE MASTER",1,"Q")
;
I LA7X=1,LA7OBR49="AR" S LA7X=LA7X+1
;
; Check OBX.17 (LA7OBM) field for WKLD suffix indicating auto or tech verification on middleware.
; If "-.0000" then from OBR segment before OBX segment processed.
I LA7X=2,$S(LA7OBM=".9750":1,LA7OBM=".9760":1,LA7OBM="-.0000":1,1:"") S LA7X=LA7X+1
;
; Check if file #62.4 entry is enabled for auto release based on auto or user verify middleware
I LA7X=3,$P($G(^LAB(62.4,LA7624,9)),U,11) S STATUS=$P(^LAB(62.4,LA7624,9),U,11)
;
Q STATUS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VIN5 12324 printed Oct 16, 2024@17:41:18 Page 2
LA7VIN5 ;DALOI/JMC - Process Incoming UI Msgs, continued ;04/19/16 16:28
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,68,74,84,88**;Sep 27, 1994;Build 10
+2 ;
+3 ; This routine is a continuation of LA7VIN1 and is only called from there.
+4 ; It is called to process OBX segments for "CH" subscript tests.
+5 ;
+6 ; ZEXCEPT is used to identify variables which are external to a specific TAG
+7 ; used in conjunction with Eclipse M-editor.
+8 QUIT
+9 ;
OBX ;
+1 ;
+2 NEW LA76241,LA76304,LA7EII,LA7I,LA7J,LA7LIMIT,LA7OBM,LA7SUBFL,LA7TEST,LA7TREEN,LA7UNITS,LA7VAL,LA7VTYP,LA7X,LA7XFORM,LA7Y
+3 ;
+4 KILL LA7RMK,^TMP("LA7TREE",$JOB)
+5 ;
+6 SET LA7SUBFL=63.04
+7 ;
+8 ; OBX Set ID
+9 SET LA7SOBX=$$P^LA7VHLU(.LA7SEG,2,LA7FS)
+10 ;
+11 ; Value type - type of data from Table 0125
+12 SET LA7VTYP=$PIECE($$P^LA7VHLU(.LA7SEG,3,LA7FS),LA7CS)
+13 ;
+14 ; Determine test result codes - check for primary and alternate codes
+15 ; For DoD/CHCS interface - do NOT process test codes using 99LRT as coding system per DoD/July 2002.
+16 SET LA7X=$$P^LA7VHLU(.LA7SEG,4,LA7FS)
SET (LA7RNLT,LA7RLNC)=""
+17 SET LA7TEST=$PIECE(LA7X,LA7CS)
+18 SET LA7TEST(0)=$$UNESC^LA7VHLU3($PIECE(LA7X,LA7CS,2),LA7FS_LA7ECH)
+19 IF LA7TEST(0)["^"
SET LA7TEST(0)=$TRANSLATE(LA7TEST(0),"^","~")
+20 SET LA7TEST(0,1)=$PIECE(LA7X,LA7CS,3)
+21 SET LA7TEST(2)=$PIECE(LA7X,LA7CS,4)
+22 SET LA7TEST(2,0)=$$UNESC^LA7VHLU3($PIECE(LA7X,LA7CS,5),LA7FS_LA7ECH)
+23 IF LA7TEST(2,0)["^"
SET LA7TEST(2,0)=$TRANSLATE(LA7TEST(2,0),"^","~")
+24 SET LA7TEST(2,1)=$PIECE(LA7X,LA7CS,6)
+25 FOR I=3,6
Begin DoDot:1
+26 SET LA7Y=$PIECE(LA7X,LA7CS,I-2)
+27 IF $PIECE(LA7X,LA7CS,I)="LN"
Begin DoDot:2
+28 IF $PIECE($GET(^LAB(95.3,+LA7Y,0)),"^")=LA7Y
SET LA7RLNC=+LA7Y
QUIT
+29 IF $PIECE($GET(^LAB(95.3,+LA7Y,0)),"^")=+LA7Y
SET LA7RLNC=+LA7Y
QUIT
+30 SET LA7J=$ORDER(^LAB(95.3,"B",LA7Y,0))
+31 IF LA7J
SET LA7RLNC=LA7J
End DoDot:2
QUIT
+32 IF $PIECE(LA7X,LA7CS,I)="99VA64"
Begin DoDot:2
+33 IF $$FIND1^DIC(64,"","OMX",LA7Y)
SET LA7RNLT=LA7Y
End DoDot:2
QUIT
+34 IF $PIECE(LA7X,LA7CS,I)="99LRT"
Begin DoDot:2
+35 IF LA7TEST(0)=""
IF LA7TEST(2,0)'=""
SET LA7TEST(0)=LA7TEST(2,0)
+36 IF LA7TEST(2,0)=""
IF LA7TEST(0)'=""
SET LA7TEST(2,0)=LA7TEST(0)
+37 IF I=3
SET (LA7TEST,LA7TEST(0),LA7TEST(0,1))=""
QUIT
+38 IF I=6
SET (LA7TEST(2),LA7TEST(2,0),LA7TEST(2,1))=""
QUIT
End DoDot:2
QUIT
End DoDot:1
+39 IF LA7TEST=""
IF LA7TEST(2)'=""
Begin DoDot:1
+40 SET LA7TEST=LA7TEST(2)
SET LA7TEST(0)=LA7TEST(2,0)
SET LA7TEST(0,1)=LA7TEST(2,1)
+41 SET (LA7TEST(2),LA7TEST(2,0),LA7TEST(2,1))=""
End DoDot:1
+42 ;
+43 ; No test code in message
+44 IF LA7TEST=""
IF LA7TEST(2)=""
Begin DoDot:1
+45 NEW LA7OBX
+46 SET LA7OBX=LA7SEG(0)
+47 SET LA7ERR=15
SET LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
End DoDot:1
QUIT
+48 ;
+49 ; Test code not found in auto inst file, also check alternate codes,
+50 ; and log error if none found.
+51 IF LA7MTYP="ORU"
Begin DoDot:1
+52 IF LA7TEST'=""
IF $DATA(^LAB(62.4,LA7624,3,"AC",LA7TEST))
QUIT
+53 IF LA7TEST(2)'=""
IF $DATA(^LAB(62.4,LA7624,3,"AC",LA7TEST(2)))
Begin DoDot:2
+54 SET LA7TEST=LA7TEST(2)
SET LA7TEST(0)=LA7TEST(2,0)
SET LA7TEST(0,1)=LA7TEST(2,1)
End DoDot:2
QUIT
+55 SET LA7ERR=16
SET LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
SET LA7TEST=""
End DoDot:1
if LA7TEST=""
QUIT
+56 ;
+57 ; Units - trim leading/trailing spaces
+58 SET LA7X=$$P^LA7VHLU(.LA7SEG,7,LA7FS)
SET LA7UNITS=""
+59 IF LA7X'=""
Begin DoDot:1
+60 FOR I=1:1:6
SET LA7UNITS(I)=$$UNESC^LA7VHLU3($PIECE(LA7X,LA7CS,I),LA7FS_LA7ECH)
+61 SET LA7UNITS=$$TRIM^XLFSTR(LA7UNITS(1),"LR"," ")
+62 IF LA7UNITS["^"
Begin DoDot:2
+63 NEW LA7STR
SET LA7STR("^")="~U~"
+64 SET LA7UNITS=$$REPLACE^XLFSTR(LA7UNITS,.LA7STR)
End DoDot:2
End DoDot:1
+65 ;
+66 ; Observation result status - Table 0085
+67 SET LA7ORS=$$P^LA7VHLU(.LA7SEG,12,LA7FS)
+68 ;
+69 ; Responsible observer
+70 SET LA7RO=$$XCNTFM^LA7VHLU9($$P^LA7VHLU(.LA7SEG,17,LA7FS),LA7ECH)
+71 ;
+72 ; Observation method
+73 SET LA7X=$$P^LA7VHLU(.LA7SEG,18,LA7FS)
SET LA7OBM=""
+74 IF $PIECE(LA7X,LA7CS,3)="99VA64_2"
SET LA7OBM=$PIECE($PIECE(LA7X,LA7CS,1),".",2)
SET LA7OBM="."_LA7OBM
+75 ;
+76 ; Equipment instance identifier
+77 SET LA7EII=$$P^LA7VHLU(.LA7SEG,19,LA7FS)
+78 IF LA7EII'=""
Begin DoDot:1
+79 SET LA7EII=$$UNESC^LA7VHLU3(LA7EII,LA7FS_LA7ECH)
+80 SET LA7EII=$TRANSLATE(LA7EII,"^",";")
End DoDot:1
+81 ;
+82 ; Process ORU message results for all tests which use this test code.
+83 IF LA7MTYP="ORU"
Begin DoDot:1
+84 ; Set Auto Release flag
SET LA7AUTORELEASE=$$ARSTATUS(LA7OBR49,LA7OBM,LA7624)
+85 SET LA76241=0
+86 FOR
SET LA76241=$ORDER(^LAB(62.4,LA7624,3,"AC",LA7TEST,LA76241))
if 'LA76241
QUIT
DO PROCESS
End DoDot:1
QUIT
+87 ;
+88 IF LA7MTYP="ORM"
IF $GET(LA7696)>0
DO ORESULTS^LA7VIN5B
+89 ;
+90 QUIT
+91 ;
+92 ;
PROCESS ; Process results for a given test code
+1 FOR LA7I=0,1,2
SET LA76241(LA7I)=$GET(^LAB(62.4,LA7624,3,LA76241,LA7I))
+2 ;
+3 ; Chem test fields incorrect
+4 IF LA76241(0)=""
SET LA7ERR=18
SET LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
QUIT
+5 ;
+6 ; No dataname associated with this test - skip
+7 SET LA76304=$PIECE($GET(^LAB(60,+$PIECE(LA76241(0),"^"),.2)),"^")
+8 IF LA76304<1
QUIT
+9 ;
+10 SET LA7VAL=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
+11 IF LA7VTYP="CE"
IF $PIECE(LA7VAL,LA7CS,2)'=""
SET LA7VAL=$PIECE(LA7VAL,LA7CS,2)
+12 IF '$TEST
SET LA7VAL=$PIECE(LA7VAL,LA7CS)
+13 SET LA7VAL=$$UNESC^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
+14 ;
+15 ; Setup LA7RMK(0) variable in case comments (NTE) sent with test results.
+16 SET LA7RMK(0,+LA76241(0))=+$PIECE(LA76241(2),"^",7)_"^"_$PIECE(LA76241(2),"^",8)
+17 ;
+18 ; Set flag for new results alert
+19 IF LA7ORS'?1(1"C",1"D",1"W")
SET ^TMP("LA7-ORU",$JOB,LA76248,LA76249,"CH")=""
+20 ;
+21 ; Set flag to send amended results bulletin
+22 IF LA7INTYP=10
IF LA7ORS?1(1"C",1"D",1"W")
Begin DoDot:1
+23 SET LA7I=$ORDER(^TMP("LA7 AMENDED RESULTS",$JOB,""),-1)
SET LA7I=LA7I+1
+24 SET X=LA7LWL_"^"_LA7ISQN_"^"_LA76304_"^"_LA76248_"^"_LA76249_"^"_LA7ORS_"^"_LA7TEST_"^"_$SELECT(LA7TEST(0)'="":LA7TEST(0),1:LA7TEST(2,0))_"^"_$$P^LA7VHLU(.LA7SEG,9,LA7FS)
+25 SET ^TMP("LA7 AMENDED RESULTS",$JOB,LA7I)=X
+26 IF LA7UID'=""
SET ^LAH("LA7 AMENDED RESULTS",LA7UID,LA76304,LA7LWL,LA7ISQN)=X
End DoDot:1
+27 ;
+28 ; NOTE - this array can be set from inside PARAM 1
+29 KILL LA7XFORM
+30 ;
+31 ; execute PARAM 1 if not a LEDI interface or auto release
+32 IF LA7INTYP'=10
IF LA7AUTORELEASE<1
XECUTE $PIECE(LA76241(0),"^",2)
+33 ;
+34 IF $PIECE(LA76241(2),"^",3)=0
QUIT
+35 IF $PIECE(LA76241(2),"^",3)=2
IF LA7ORS'?1(1"C",1"F",1"U",1"X")
QUIT
+36 ;
+37 ; If OBX indicates no result for this test then store VistA "canc" value.
+38 IF LA7ORS="X"
IF LA7VAL=""
SET LA7VAL="canc"
+39 ;
+40 ; No value found
+41 IF LA7VAL=""
Begin DoDot:1
+42 SET LA7ERR=17
SET LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
End DoDot:1
QUIT
+43 ;
+44 ; Transform result based on fields in file 62.4
+45 DO XFORM^LA7VIN5A
+46 if LA7VAL=""
QUIT
+47 ;
+48 ; Check if result passes input transform on data name
+49 DO CHKDIE^LA7VIN5A
+50 if LA7VAL=""
QUIT
+51 ;
+52 ; Set flag to not store comments if it wasn't explicitly ordered.
+53 IF $GET(LA7LIMIT)=1
Begin DoDot:1
+54 NEW LA76804
+55 KILL LA7LIMIT,LA7TREEN,^TMP("LA7TREE",$JOB)
+56 ; Store all tests accessioned in ^TMP
+57 SET LA76804=0
+58 FOR
SET LA76804=$ORDER(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA76804))
if 'LA76804
QUIT
DO UNWIND^LA7UTIL(LA76804)
+59 ;wasn't ordered
IF '$DATA(^TMP("LA7TREE",$JOB,+LA76241(0)))
SET LA7LIMIT=1
End DoDot:1
+60 IF $GET(LA7LIMIT)
Begin DoDot:1
+61 SET $PIECE(LA7RMK(0,+LA76241(0)),"^",1)=0
+62 KILL LA7LIMIT,^TMP("LA7TREE",$JOB)
End DoDot:1
QUIT
+63 KILL ^TMP("LA7TREE",$JOB)
+64 ;
+65 ; Check point of care interface for matching specimen type for this test in #62.4
+66 IF LA7INTYP>19
IF LA7INTYP<30
Begin DoDot:1
+67 NEW LA70070
+68 SET LA761=""
SET LA7X=$PIECE(LA76241(2),"^",13)
if 'LA7X
QUIT
+69 SET LA70070=$$GET1^DIQ(61,LA7X_",","LEDI HL7:HL7 ABBR")
+70 IF LA70070=LA7SPEC
SET LA761=LA7X
End DoDot:1
if 'LA761
QUIT
+71 ;
+72 ; Set data node=test value
+73 SET $PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^")=LA7VAL
+74 ;
+75 ; Store reference ranges except for UI (LA7INTYP=1) interfaces
+76 DO REFRNG^LA7VIN5A($$P^LA7VHLU(.LA7SEG,8,LA7FS))
+77 ;
+78 ; Store order/result codes/observation method except for UI (LA7INTYP=1) interfaces
+79 IF LA7INTYP'=1
Begin DoDot:1
+80 SET LA7X=$PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",3)
+81 IF LA7ONLT
SET $PIECE(LA7X,"!",1)=LA7ONLT
+82 IF LA7RNLT
SET $PIECE(LA7X,"!",2)=LA7RNLT
+83 IF LA7RLNC
SET $PIECE(LA7X,"!",3)=LA7RLNC
+84 IF LA7OBM
SET $PIECE(LA7X,"!",4)=LA7OBM
+85 SET $PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",3)=LA7X
End DoDot:1
+86 ;
+87 ; Store abnormal flags except for UI (LA7INTYP=1) interfaces.
+88 DO ABFLAG^LA7VIN5A($$P^LA7VHLU(.LA7SEG,9,LA7FS))
+89 ;
+90 ; Store units except for UI non Auto Release (LA7INTYP=1,LA7AUTORELEASE=1) interfaces which pull values from file #60.
+91 IF LA7UNITS'=""
Begin DoDot:1
+92 IF LA7INTYP=1
IF 'LA7AUTORELEASE
QUIT
+93 SET LA7X=$PIECE($GET(^LAH(LA7LWL,1,LA7ISQN,LA76304)),"^",5)
+94 SET $PIECE(LA7X,"!",7)=LA7UNITS
+95 SET $PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=LA7X
End DoDot:1
+96 ;
+97 ; Store responsible observer on Lab UI (1) Auto Release, POC (20), POCA (21) interfaces
+98 IF LA7RO'=""
IF $PIECE(LA7RO,"^",2)
Begin DoDot:1
+99 IF LA7INTYP'?1(1"1",1"20",1"21")
QUIT
+100 IF LA7INTYP=1
IF 'LA7AUTORELEASE
QUIT
+101 SET $PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",4)=$PIECE(LA7RO,"^",2)
End DoDot:1
+102 ;
+103 ; Store specimen type except for UI (LA7INTYP=1) interfaces which pull values from the accession.
+104 IF LA7INTYP'=1
IF $GET(LA761)
Begin DoDot:1
+105 SET X=$PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)
+106 SET $PIECE(X,"!")=LA761
+107 SET $PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=X
End DoDot:1
+108 ;
+109 ; Store where test was performed except for UI (LA7INTYP=1) interfaces
+110 ; also store related filler order number
+111 IF LA7INTYP'=1
Begin DoDot:1
+112 NEW I,LA7X,LA74
+113 SET LA7X=$$P^LA7VHLU(.LA7SEG,24,LA7FS)
SET LA74=""
+114 IF $PIECE(LA7X,LA7CS,6)="CLIA"
Begin DoDot:2
+115 SET LA74=$$IDX^XUAF4("CLIA",$PIECE(LA7X,LA7CS,10))
+116 IF LA74
SET $PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",9)=LA74
+117 IF '$TEST
SET LA74=""
End DoDot:2
+118 IF LA74=""
DO PRDID^LA7VIN5A($$P^LA7VHLU(.LA7SEG,16,LA7FS),LA7SFAC,LA7CS)
+119 IF LA7FID'=""
DO FID
End DoDot:1
+120 ;
+121 ; Store equipment instance identifier
+122 IF LA7EII'=""
DO EII^LA7VIN5A
+123 ;
+124 ; If results for LEDI interface (LA7INTYP=10) and site keeps file #60
+125 ; in sync with reference lab then compare message's units and normals
+126 ; with site's to detect changes(LA7FLAG=1) and notify site.
+127 IF LA7INTYP=10
IF $GET(LA761)
IF $GET(^LAB(60,+$PIECE(LA76241(0),"^"),1,LA761,.1))
Begin DoDot:1
+128 NEW LA760,LA7FLAG,LA7I,LA7Y,LA7X
+129 SET LA760=+$PIECE(LA76241(0),"^")
SET LA7Y=^LAB(60,LA760,1,LA761,0)
SET LA7FLAG=0
+130 SET LA7X=$PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)
+131 IF $PIECE(LA7Y,"^",7)'=$PIECE(LA7X,"!",7)
SET LA7FLAG=1
+132 IF 'LA7FLAG
IF $PIECE(LA7Y,"^",2)=$PIECE(LA7X,"!",2)
IF $PIECE(LA7Y,"^",3)=$PIECE(LA7X,"!",3)
QUIT
+133 IF 'LA7FLAG
Begin DoDot:2
+134 NEW AGE,DOB,PNM,SEX
+135 NEW LRDPF,LRNG,LRNGS,LRNG2,LRNG3,LRNG4,LRNG5,LRTREA,LRWRD,LRX,LRY
+136 IF $GET(LRDFN)
DO DEM^LRX
DO KVAR^VADPT
+137 SET LRNG=LA7Y
DO NORM^LRVER5
+138 SET LA7Y=$TRANSLATE(LRNG,$CHAR(34),"")
SET LA7X=$TRANSLATE(LA7X,$CHAR(34),"")
+139 IF $PIECE(LA7Y,"^",2)=$PIECE(LA7X,"!",2)
IF $PIECE(LA7Y,"^",3)=$PIECE(LA7X,"!",3)
QUIT
+140 SET LA7FLAG=1
End DoDot:2
+141 IF 'LA7FLAG
QUIT
+142 SET LA7I=$ORDER(^TMP("LA7 UNITS/NORMALS CHANGED",$JOB,""),-1)
SET LA7I=LA7I+1
+143 SET X=LA7LWL_"^"_LA7ISQN_"^"_LA76304_"^"_LA76248_"^"_LA76249_"^"_LA7ORS_"^"_LA7TEST_"^"_$SELECT(LA7TEST(0)'="":LA7TEST(0),1:LA7TEST(2,0))_"^"_$$P^LA7VHLU(.LA7SEG,9,LA7FS)_"^"_LA760
+144 SET ^TMP("LA7 UNITS/NORMALS CHANGED",$JOB,LA7I)=X
End DoDot:1
+145 ;
+146 ; If LEDI interface and order status change store which results
+147 ; associated with ordered test. Used to determine if order status
+148 ; changed bulletin needs to be generated.
+149 IF LA7INTYP=10
IF LA7SAC?1(1"A",1"G")
Begin DoDot:1
+150 SET LA7I=$GET(LA7SAC(0))
if 'LA7I
QUIT
+151 SET ^TMP("LA7 ORDER STATUS",$JOB,LA7I,+LA76241(0))=""
End DoDot:1
+152 ;
+153 ; Set flag if Lab UI Auto Release interface to start auto release processing routine when ;**88
+154 ; finished - tasked by LA7VIN before shutdown
+155 IF LA7INTYP=1
IF LA7AUTORELEASE
IF $GET(LA7UID)'=""
Begin DoDot:1
+156 SET LA76249("AR")=LA7AUTORELEASE
+157 SET LA7INTYP("LWL",LA7LWL)=""
+158 SET ^TMP("LA7 AR",$JOB,LA7LWL,1,"AUTOREL",LA7ISQN)=LA7UID_"^"_LA7624
+159 SET ^TMP("LA7 AR",$JOB,LA7LWL,1,"AUTOREL",LA7ISQN,LA76304)=LA7624_"^"_LA7AUTORELEASE
+160 SET ^TMP("LA7 AR",$JOB,LA7LWL,1,"AUTOREL-UID",LA7UID,LA7ISQN,LA76249)=$GET(LA7AAT(1))
End DoDot:1
+161 ;
+162 QUIT
+163 ;
+164 ;
FID ; Store filler id
+1 ;
+2 ;ZEXCEPT: LA7LWL,LA76304,LA7FID,LA7ISQN
+3 NEW LA7STR,LA7X,I
+4 ;
+5 SET LA7STR("^")="~U~"
SET LA7X=LA7FID
+6 ;
+7 IF LA7X["^"
SET LA7X=$$REPLACE^XLFSTR(LA7X,.LA7STR)
+8 ;
+9 FOR I=2:1:4
Begin DoDot:1
+10 IF LA7FID(I)=""
QUIT
+11 IF LA7FID(I)["^"
SET $PIECE(LA7X,"^",I)=$$REPLACE^XLFSTR(LA7FID(I),.LA7STR)
QUIT
+12 SET $PIECE(LA7X,"^",I)=LA7FID(I)
End DoDot:1
+13 ;
+14 SET ^LAH(LA7LWL,1,LA7ISQN,.1,"OBR","FID",LA76304)=LA7X
+15 ;
+16 QUIT
+17 ;
+18 ;
ARSTATUS(LA7OBR49,LA7OBM,LA7624) ; Determine if LAB UI and auto release enabled and results are to be sent to auto release process.
+1 ;
+2 ; Call with LA7OBR49 = result handling code from OBR.49
+3 ; LA7OBM = WKLD Suffix code (file #64.2) from OBX.17 - .9750 = auto verification, .9760 = tech verification.
+4 ; If "-.0000" then from OBR segment before OBX segment processed.
+5 ; LA7624 = ien of entry in AUTO INSTRUMENT file #62.4
+6 ;
+7 NEW LA7X,STATUS
+8 ;
+9 SET STATUS=0
+10 ;
+11 ; Check if auto release master switch parameter is ON (1).
+12 SET LA7X=$$GET^XPAR("SYS^PKG","LA UI AUTO RELEASE MASTER",1,"Q")
+13 ;
+14 IF LA7X=1
IF LA7OBR49="AR"
SET LA7X=LA7X+1
+15 ;
+16 ; Check OBX.17 (LA7OBM) field for WKLD suffix indicating auto or tech verification on middleware.
+17 ; If "-.0000" then from OBR segment before OBX segment processed.
+18 IF LA7X=2
IF $SELECT(LA7OBM=".9750":1,LA7OBM=".9760":1,LA7OBM="-.0000":1,1:"")
SET LA7X=LA7X+1
+19 ;
+20 ; Check if file #62.4 entry is enabled for auto release based on auto or user verify middleware
+21 IF LA7X=3
IF $PIECE($GET(^LAB(62.4,LA7624,9)),U,11)
SET STATUS=$PIECE(^LAB(62.4,LA7624,9),U,11)
+22 ;
+23 QUIT STATUS
