- 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 Feb 18, 2025@23:06:50 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