LA7UIIN2 ;DALOI/JRR - Process Incoming UI Msgs, continued ; 12/3/1997
;;5.2;AUTOMATED LAB INSTRUMENTS;**17,23,27,46**;Sep 27, 1994
;This routine is a continuation of LA7UIIN1 and is only called from there.
;It is called to begin processing the NTE & OBX segments.
QUIT
;
NTE ; Process NTE segments that follow the OBR and OBX segments
; These NTE segments contain comments from instruments or other facilities.
; NTE segments following OBR's contain comments which refer to the entire test battery.
; NTE segments following OBX's contain comments which are test specific.
; Test specific comments can be prefaced with a site defined prefix -
; see field REMARK PREFIX (#19) in CHEM TEST multiple of AUTOMATED INSTRUMENT (#62.4 file.
; NTE segments are not allowed anywhere except after the OBR or OBX segments.
; There can be more than one NTE, each will be stored as a comment in ^LAH.
;
F LA762495=LA762495:0 S LA762495=$O(^LAHM(62.49,LA76249,150,LA762495)) Q:'LA762495 S LA7NTE=$G(^(LA762495,0)) Q:$E(LA7NTE,1,3)'="NTE" D
. N LA7,LA7I
. S LA7RMK=$P(LA7NTE,LA7FS,4)
. S LA7=$RE(LA7RMK)
. F LA7I=1:1:$L(LA7) Q:$E(LA7,LA7I)'=" " ; Find start of trailing spaces.
. S LA7RMK=$E(LA7RMK,1,($L(LA7RMK)-LA7I+1)) ; Truncate trailing spaces.
. I LA7RMK=$TR($P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,3)),"^",6),"~") Q ; Don't store remark if same as specimen comment (without "~").
. I LA7RMK=$G(^LR(+$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),.091)) Q ; or patient info (#.091 in file 63) - info previously downloaded
. I LA7RMK="" Q ; No remark to store.
. I $O(LA7RMK(0,0)) D Q ; If test specific, store test name with comments (see below)
. . N LA7I
. . S LA7I=0
. . F S LA7I=$O(LA7RMK(0,LA7I)) Q:'LA7I I $P(LA7RMK(0,LA7I),"^") D RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,$P(LA7RMK(0,LA7I),"^",2))
. I $P(LA7INST,"^",17) D RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,"") ;store comment in 1 node of ^LAH global
K LA7RMK
Q:LA762495="" ;no more segments to process
;
OBX F LA762495=LA762495-1:0 S LA762495=$O(^LAHM(62.49,LA76249,150,LA762495)) Q:'LA762495 K LA7OBX S LA7OBX=^(LA762495,0) Q:$E(LA7OBX,1,3)'="OBX" D
. K LA7RMK
. S LA7TEST=$P($P(LA7OBX,LA7FS,4),LA7CS,1)
. I LA7TEST="" D QUIT
. . D CREATE^LA7LOG(15)
. I '$D(^LAB(62.4,LA7624,3,"AC",LA7TEST)) D QUIT ;test code not found in auto inst file
. . D CREATE^LA7LOG(16)
. S LA76241=0 ; Process results for all tests which use this test code.
. F S LA76241=$O(^LAB(62.4,LA7624,3,"AC",LA7TEST,LA76241)) Q:'LA76241 D
. . S LA7VAL=$P(LA7OBX,LA7FS,6)
. . F LA7I=0,1,2 S LA76241(LA7I)=$G(^LAB(62.4,LA7624,3,LA76241,LA7I))
. . I (LA76241(0)="")!(LA76241(1)="") D QUIT ;chem test fields incorrect
. . . D CREATE^LA7LOG(18)
. . ; 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)
. . K LA7XFORM ;this array can be set from inside PARAM 1
. . X $P(LA76241(0),"^",2) ;execute PARAM 1
. . I LA7VAL="" D QUIT ;no value
. . . D CREATE^LA7LOG(17)
. . D XFORM ;transform result based on fields in file 62.4
. . Q:LA7VAL=""
. . I $G(LA7LIMIT)=1 D ;flag to not store if wasn't explicitly ordered
. . . K LA7LIMIT,LA7TREEN,^TMP("LA7TREE",$J)
. . . F LA76804=0:0 S LA76804=$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA76804)) Q:'LA76804 D UNWIND^LA7UTIL(LA76804) ;store all tests accessioned in ^TMP
. . . I '$D(^TMP("LA7TREE",$J,+LA76241(0))) S LA7LIMIT=1 ;wasn't ordered
. . I $G(LA7LIMIT) D QUIT ;don't store
. . . S $P(LA7RMK(0,+LA76241(0)),"^",1)=0 ; Set flag to not store comments if any.
. . . K LA7LIMIT,^TMP("LA7TREE",$J)
. . K ^TMP("LA7TREE",$J)
. . S LA76304=+$P(LA76241(1),"(",2) ;lab data field
. . I LA76304'>1 D Q ; No dataname for this result
. . . D CREATE^LA7LOG(18)
. . S ^LAH(LA7LWL,1,LA7ISQN,LA76304)=LA7VAL ;set data node=test value
. . D REFRNG($P(LA7OBX,LA7FS,8)) ; Store reference ranges
. . D ABFLAG($P(LA7OBX,LA7FS,9)) ; Store abnormal flags
. . D PRDID($P(LA7OBX,LA7FS,16),LA7CS) ; Store where test was performed.
I $E(LA7OBX,1,3)="NTE" S LA762495=LA762495-1 G NTE
K LA7RMK
Q
;
XFORM ; Transform the result based on fields 12,13,14,16,17 in the Chem Test
; multiple in the Auto Instrument file (62.4), or set on the fly
; from PARAM 1
N LA7I
S LA7XFORM=LA76241(2)
; get PARAM 1 overides
I $D(LA7XFORM(1)),LA7XFORM(1)?1.N S $P(LA7XFORM,"^")=LA7XFORM(1)
F LA7I=2,3,5,6 I $D(LA7XFORM(LA7I)) S $P(LA7XFORM,"^",LA7I)=LA7XFORM(LA7I)
; set up defaults if field was not answered
;
; accept results,yes
I $P(LA7XFORM,"^",3)="" S $P(LA7XFORM,"^",3)=1
; strip spaces,yes
I $P(LA7XFORM,"^",6)="" S $P(LA7XFORM,"^",6)=1
;
; now transform
; don't accept results
I '$P(LA7XFORM,"^",3) S LA7VAL="" Q
; accept ordered tests only
I $P(LA7XFORM,"^",5) S LA7LIMIT=1
; decimal places if result start with number or decimal point
; skip results i.e. ">100".
I $P(LA7XFORM,"^")?1.N,LA7VAL?1(1N.E,1".".E) D
. S LA7VAL=$FN(LA7VAL,"",+LA7XFORM)
; strip spaces
I $P(LA7XFORM,"^",6) S LA7VAL=$TR(LA7VAL," ","")
; make result a comment, store comment in ^LAH global
; set value to null after making into remark, don't store twice.
I $P(LA7XFORM,"^",2) D
. D RMKSET^LASET(LA7LWL,LA7ISQN,LA7VAL,"")
. S LA7VAL=""
Q
;
;
PRDID(LA7PRDID,LA7CS) ; Process/Store Producer's ID
; Store where test was performed.
; Call with LA7PRDID = Producer's ID field
; LA7CS = component encoding character
N LA7X,LA7Y
S LA7PRDID=$G(LA7PRDID),LA7CS=$G(LA7CS)
; Don't store producer's id.
I LA7PRDID=""!('$P(LA76241(2),"^",9))!(LA7CS="") Q
;
S LA7X=$P(LA7PRDID,LA7CS,2)
I $L($P(LA7PRDID,LA7CS)) S LA7X=LA7X_$S($L(LA7X):" ",1:"")_"["_$P(LA7PRDID,LA7CS)_"]"
I LA7X="" Q
S LA7X="results from "_LA7X
S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2)
; If no prefix, use test name.
I '$L(LA7Y) S LA7Y=$P($G(^LAB(60,+LA76241(0),0)),"^")_": "
D RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y)
Q
;
;
REFRNG(LA7X) ; Process/Store References Range.
; Call with LA7X = reference range to store.
N LA7Y
S LA7X=$G(LA7X)
; No ref range or don't store ref range.
I LA7X=""!('$P(LA76241(2),"^",10)) Q
S LA7X="ref range - "_LA7X
S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2)
; If no prefix, use test name.
I '$L(LA7Y) S LA7Y=$P($G(^LAB(60,+LA76241(0),0)),"^")_": "
D RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y)
Q
;
;
ABFLAG(LA7X) ; Process/Store Abnormal Flags.
; Call with LA7X = abnormal flags to store.
; Converts flag to interpretation based on HL7 Table 0078.
; If no match store code instead of interpretation
;
N I,LA7Y,LA7Z
;
S LA7X=$G(LA7X)
; No flag or don't store abnormal flags.
I LA7X=""!('$P(LA76241(2),"^",11)) Q
F I=1:1:18 I LA7X=$P("L^H^LL^HH^<^>^N^A^AA^U^D^B^W^S^R^I^MS^VS","^",I) S LA7X=$P($T(ABFLAGS+I),";;",2) Q
S LA7X="normalcy status - "_LA7X
S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2)
;
; If no prefix, use test name.
I '$L(LA7Y) S LA7Y=$P($G(^LAB(60,+LA76241(0),0)),"^")_": "
;
D RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y)
Q
;
ABFLAGS ;; HL7 Table 0078 Abnormal flags
;;Below low normal;;
;;Above high normal;;
;;Below lower panic limits;;
;;Above upper panic limits;;
;;Below absolute low-off instrument scale;;
;;Above absolute high-off instrument scale;;
;;Normal;;
;;Abnormal;;
;;Very abnormal;;
;;Significant change up;;
;;Significant change down;;
;;Better;;
;;Worse;;
;;Susceptible;;
;;Resistant;;
;;Intermediate;;
;;Moderately susceptible;;
;;Very susceptible;;
LA7UIIN2 ;DALOI/JRR - Process Incoming UI Msgs, continued ; 12/3/1997
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,23,27,46**;Sep 27, 1994
+2 ;This routine is a continuation of LA7UIIN1 and is only called from there.
+3 ;It is called to begin processing the NTE & OBX segments.
+4 QUIT
+5 ;
NTE ; Process NTE segments that follow the OBR and OBX segments
+1 ; These NTE segments contain comments from instruments or other facilities.
+2 ; NTE segments following OBR's contain comments which refer to the entire test battery.
+3 ; NTE segments following OBX's contain comments which are test specific.
+4 ; Test specific comments can be prefaced with a site defined prefix -
+5 ; see field REMARK PREFIX (#19) in CHEM TEST multiple of AUTOMATED INSTRUMENT (#62.4 file.
+6 ; NTE segments are not allowed anywhere except after the OBR or OBX segments.
+7 ; There can be more than one NTE, each will be stored as a comment in ^LAH.
+8 ;
+9 FOR LA762495=LA762495:0
SET LA762495=$ORDER(^LAHM(62.49,LA76249,150,LA762495))
IF 'LA762495
QUIT
SET LA7NTE=$GET(^(LA762495,0))
IF $EXTRACT(LA7NTE,1,3)'="NTE"
QUIT
Begin DoDot:1
+10 NEW LA7,LA7I
+11 SET LA7RMK=$PIECE(LA7NTE,LA7FS,4)
+12 SET LA7=$REVERSE(LA7RMK)
+13 ; Find start of trailing spaces.
FOR LA7I=1:1:$LENGTH(LA7)
IF $EXTRACT(LA7,LA7I)'=" "
QUIT
+14 ; Truncate trailing spaces.
SET LA7RMK=$EXTRACT(LA7RMK,1,($LENGTH(LA7RMK)-LA7I+1))
+15 ; Don't store remark if same as specimen comment (without "~").
IF LA7RMK=$TRANSLATE($PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,3)),"^",6),"~")
QUIT
+16 ; or patient info (#.091 in file 63) - info previously downloaded
IF LA7RMK=$GET(^LR(+$GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),.091))
QUIT
+17 ; No remark to store.
IF LA7RMK=""
QUIT
+18 ; If test specific, store test name with comments (see below)
IF $ORDER(LA7RMK(0,0))
Begin DoDot:2
+19 NEW LA7I
+20 SET LA7I=0
+21 FOR
SET LA7I=$ORDER(LA7RMK(0,LA7I))
IF 'LA7I
QUIT
IF $PIECE(LA7RMK(0,LA7I),"^")
DO RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,$PIECE(LA7RMK(0,LA7I),"^",2))
End DoDot:2
QUIT
+22 ;store comment in 1 node of ^LAH global
IF $PIECE(LA7INST,"^",17)
DO RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,"")
End DoDot:1
+23 KILL LA7RMK
+24 ;no more segments to process
IF LA762495=""
QUIT
+25 ;
OBX FOR LA762495=LA762495-1:0
SET LA762495=$ORDER(^LAHM(62.49,LA76249,150,LA762495))
IF 'LA762495
QUIT
KILL LA7OBX
SET LA7OBX=^(LA762495,0)
IF $EXTRACT(LA7OBX,1,3)'="OBX"
QUIT
Begin DoDot:1
+1 KILL LA7RMK
+2 SET LA7TEST=$PIECE($PIECE(LA7OBX,LA7FS,4),LA7CS,1)
+3 IF LA7TEST=""
Begin DoDot:2
+4 DO CREATE^LA7LOG(15)
End DoDot:2
QUIT
+5 ;test code not found in auto inst file
IF '$DATA(^LAB(62.4,LA7624,3,"AC",LA7TEST))
Begin DoDot:2
+6 DO CREATE^LA7LOG(16)
End DoDot:2
QUIT
+7 ; Process results for all tests which use this test code.
SET LA76241=0
+8 FOR
SET LA76241=$ORDER(^LAB(62.4,LA7624,3,"AC",LA7TEST,LA76241))
IF 'LA76241
QUIT
Begin DoDot:2
+9 SET LA7VAL=$PIECE(LA7OBX,LA7FS,6)
+10 FOR LA7I=0,1,2
SET LA76241(LA7I)=$GET(^LAB(62.4,LA7624,3,LA76241,LA7I))
+11 ;chem test fields incorrect
IF (LA76241(0)="")!(LA76241(1)="")
Begin DoDot:3
+12 DO CREATE^LA7LOG(18)
End DoDot:3
QUIT
+13 ; Setup LA7RMK(0) variable in case comments (NTE) sent with test results.
+14 SET LA7RMK(0,+LA76241(0))=+$PIECE(LA76241(2),"^",7)_"^"_$PIECE(LA76241(2),"^",8)
+15 ;this array can be set from inside PARAM 1
KILL LA7XFORM
+16 ;execute PARAM 1
XECUTE $PIECE(LA76241(0),"^",2)
+17 ;no value
IF LA7VAL=""
Begin DoDot:3
+18 DO CREATE^LA7LOG(17)
End DoDot:3
QUIT
+19 ;transform result based on fields in file 62.4
DO XFORM
+20 IF LA7VAL=""
QUIT
+21 ;flag to not store if wasn't explicitly ordered
IF $GET(LA7LIMIT)=1
Begin DoDot:3
+22 KILL LA7LIMIT,LA7TREEN,^TMP("LA7TREE",$JOB)
+23 ;store all tests accessioned in ^TMP
FOR LA76804=0:0
SET LA76804=$ORDER(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA76804))
IF 'LA76804
QUIT
DO UNWIND^LA7UTIL(LA76804)
+24 ;wasn't ordered
IF '$DATA(^TMP("LA7TREE",$JOB,+LA76241(0)))
SET LA7LIMIT=1
End DoDot:3
+25 ;don't store
IF $GET(LA7LIMIT)
Begin DoDot:3
+26 ; Set flag to not store comments if any.
SET $PIECE(LA7RMK(0,+LA76241(0)),"^",1)=0
+27 KILL LA7LIMIT,^TMP("LA7TREE",$JOB)
End DoDot:3
QUIT
+28 KILL ^TMP("LA7TREE",$JOB)
+29 ;lab data field
SET LA76304=+$PIECE(LA76241(1),"(",2)
+30 ; No dataname for this result
IF LA76304'>1
Begin DoDot:3
+31 DO CREATE^LA7LOG(18)
End DoDot:3
QUIT
+32 ;set data node=test value
SET ^LAH(LA7LWL,1,LA7ISQN,LA76304)=LA7VAL
+33 ; Store reference ranges
DO REFRNG($PIECE(LA7OBX,LA7FS,8))
+34 ; Store abnormal flags
DO ABFLAG($PIECE(LA7OBX,LA7FS,9))
+35 ; Store where test was performed.
DO PRDID($PIECE(LA7OBX,LA7FS,16),LA7CS)
End DoDot:2
End DoDot:1
+36 IF $EXTRACT(LA7OBX,1,3)="NTE"
SET LA762495=LA762495-1
GOTO NTE
+37 KILL LA7RMK
+38 QUIT
+39 ;
XFORM ; Transform the result based on fields 12,13,14,16,17 in the Chem Test
+1 ; multiple in the Auto Instrument file (62.4), or set on the fly
+2 ; from PARAM 1
+3 NEW LA7I
+4 SET LA7XFORM=LA76241(2)
+5 ; get PARAM 1 overides
+6 IF $DATA(LA7XFORM(1))
IF LA7XFORM(1)?1.N
SET $PIECE(LA7XFORM,"^")=LA7XFORM(1)
+7 FOR LA7I=2,3,5,6
IF $DATA(LA7XFORM(LA7I))
SET $PIECE(LA7XFORM,"^",LA7I)=LA7XFORM(LA7I)
+8 ; set up defaults if field was not answered
+9 ;
+10 ; accept results,yes
+11 IF $PIECE(LA7XFORM,"^",3)=""
SET $PIECE(LA7XFORM,"^",3)=1
+12 ; strip spaces,yes
+13 IF $PIECE(LA7XFORM,"^",6)=""
SET $PIECE(LA7XFORM,"^",6)=1
+14 ;
+15 ; now transform
+16 ; don't accept results
+17 IF '$PIECE(LA7XFORM,"^",3)
SET LA7VAL=""
QUIT
+18 ; accept ordered tests only
+19 IF $PIECE(LA7XFORM,"^",5)
SET LA7LIMIT=1
+20 ; decimal places if result start with number or decimal point
+21 ; skip results i.e. ">100".
+22 IF $PIECE(LA7XFORM,"^")?1.N
IF LA7VAL?1(1N.E,1".".E)
Begin DoDot:1
+23 SET LA7VAL=$FNUMBER(LA7VAL,"",+LA7XFORM)
End DoDot:1
+24 ; strip spaces
+25 IF $PIECE(LA7XFORM,"^",6)
SET LA7VAL=$TRANSLATE(LA7VAL," ","")
+26 ; make result a comment, store comment in ^LAH global
+27 ; set value to null after making into remark, don't store twice.
+28 IF $PIECE(LA7XFORM,"^",2)
Begin DoDot:1
+29 DO RMKSET^LASET(LA7LWL,LA7ISQN,LA7VAL,"")
+30 SET LA7VAL=""
End DoDot:1
+31 QUIT
+32 ;
+33 ;
PRDID(LA7PRDID,LA7CS) ; Process/Store Producer's ID
+1 ; Store where test was performed.
+2 ; Call with LA7PRDID = Producer's ID field
+3 ; LA7CS = component encoding character
+4 NEW LA7X,LA7Y
+5 SET LA7PRDID=$GET(LA7PRDID)
SET LA7CS=$GET(LA7CS)
+6 ; Don't store producer's id.
+7 IF LA7PRDID=""!('$PIECE(LA76241(2),"^",9))!(LA7CS="")
QUIT
+8 ;
+9 SET LA7X=$PIECE(LA7PRDID,LA7CS,2)
+10 IF $LENGTH($PIECE(LA7PRDID,LA7CS))
SET LA7X=LA7X_$SELECT($LENGTH(LA7X):" ",1:"")_"["_$PIECE(LA7PRDID,LA7CS)_"]"
+11 IF LA7X=""
QUIT
+12 SET LA7X="results from "_LA7X
+13 SET LA7Y=$PIECE(LA7RMK(0,+LA76241(0)),"^",2)
+14 ; If no prefix, use test name.
+15 IF '$LENGTH(LA7Y)
SET LA7Y=$PIECE($GET(^LAB(60,+LA76241(0),0)),"^")_": "
+16 DO RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y)
+17 QUIT
+18 ;
+19 ;
REFRNG(LA7X) ; Process/Store References Range.
+1 ; Call with LA7X = reference range to store.
+2 NEW LA7Y
+3 SET LA7X=$GET(LA7X)
+4 ; No ref range or don't store ref range.
+5 IF LA7X=""!('$PIECE(LA76241(2),"^",10))
QUIT
+6 SET LA7X="ref range - "_LA7X
+7 SET LA7Y=$PIECE(LA7RMK(0,+LA76241(0)),"^",2)
+8 ; If no prefix, use test name.
+9 IF '$LENGTH(LA7Y)
SET LA7Y=$PIECE($GET(^LAB(60,+LA76241(0),0)),"^")_": "
+10 DO RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y)
+11 QUIT
+12 ;
+13 ;
ABFLAG(LA7X) ; Process/Store Abnormal Flags.
+1 ; Call with LA7X = abnormal flags to store.
+2 ; Converts flag to interpretation based on HL7 Table 0078.
+3 ; If no match store code instead of interpretation
+4 ;
+5 NEW I,LA7Y,LA7Z
+6 ;
+7 SET LA7X=$GET(LA7X)
+8 ; No flag or don't store abnormal flags.
+9 IF LA7X=""!('$PIECE(LA76241(2),"^",11))
QUIT
+10 FOR I=1:1:18
IF LA7X=$PIECE("L^H^LL^HH^<^>^N^A^AA^U^D^B^W^S^R^I^MS^VS","^",I)
SET LA7X=$PIECE($TEXT(ABFLAGS+I),";;",2)
QUIT
+11 SET LA7X="normalcy status - "_LA7X
+12 SET LA7Y=$PIECE(LA7RMK(0,+LA76241(0)),"^",2)
+13 ;
+14 ; If no prefix, use test name.
+15 IF '$LENGTH(LA7Y)
SET LA7Y=$PIECE($GET(^LAB(60,+LA76241(0),0)),"^")_": "
+16 ;
+17 DO RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y)
+18 QUIT
+19 ;
ABFLAGS ;; HL7 Table 0078 Abnormal flags
+1 ;;Below low normal;;
+2 ;;Above high normal;;
+3 ;;Below lower panic limits;;
+4 ;;Above upper panic limits;;
+5 ;;Below absolute low-off instrument scale;;
+6 ;;Above absolute high-off instrument scale;;
+7 ;;Normal;;
+8 ;;Abnormal;;
+9 ;;Very abnormal;;
+10 ;;Significant change up;;
+11 ;;Significant change down;;
+12 ;;Better;;
+13 ;;Worse;;
+14 ;;Susceptible;;
+15 ;;Resistant;;
+16 ;;Intermediate;;
+17 ;;Moderately susceptible;;
+18 ;;Very susceptible;;
