- BLRRIIN2 ;VA/DALOI/JRR - Process Incoming UI Msgs, continued ;JUL 06, 2010 3:14 PM
- ;;5.2;IHS LABORATORY;**1027**;NOV 01, 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)
- . . Q:$G(LA7VAL)="DNR" ;cmi/anch/maw 8/16/2007 don't process DNR's
- . . 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 UNITS($P(LA7OBX,LA7FS,7)) ;Store Units cmi/maw 2/29/2008
- . . 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
- ;
- UNITS(LA7X) ;Process/Store Units cmi/maw 2/29/2008 store units if parameter set to yes
- N LA7Y
- S LA7X=$G(LA7X) ;units
- I LA7X=""!('$P(LA76241(2),"^",15)) Q ;quit if units blank or p15 of 2 array in AUTO INSTRUMENT CHEM TEST multiple set to NO
- S LA7X="Units - "_LA7X
- S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2) ;test prefix
- ; If no prefix, use test name.
- I '$L(LA7Y) S LA7Y=$P($G(^LAB(60,+LA76241(0),0)),"^")_": " ;use test name if no prefix
- 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;;
- BLRRIIN2 ;VA/DALOI/JRR - Process Incoming UI Msgs, continued ;JUL 06, 2010 3:14 PM
- +1 ;;5.2;IHS LABORATORY;**1027**;NOV 01, 1997
- +2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,23,27,46**;Sep 27, 1994
- +3 ;This routine is a continuation of LA7UIIN1 and is only called from there.
- +4 ;It is called to begin processing the NTE & OBX segments.
- +5 QUIT
- +6 ;
- 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 ;cmi/anch/maw 8/16/2007 don't process DNR's
- IF $GET(LA7VAL)="DNR"
- QUIT
- +11 FOR LA7I=0,1,2
- SET LA76241(LA7I)=$GET(^LAB(62.4,LA7624,3,LA76241,LA7I))
- +12 ;chem test fields incorrect
- IF (LA76241(0)="")!(LA76241(1)="")
- Begin DoDot:3
- +13 DO CREATE^LA7LOG(18)
- End DoDot:3
- QUIT
- +14 ; Setup LA7RMK(0) variable in case comments (NTE) sent with test results.
- +15 SET LA7RMK(0,+LA76241(0))=+$PIECE(LA76241(2),"^",7)_"^"_$PIECE(LA76241(2),"^",8)
- +16 ;this array can be set from inside PARAM 1
- KILL LA7XFORM
- +17 ;execute PARAM 1
- XECUTE $PIECE(LA76241(0),"^",2)
- +18 ;no value
- IF LA7VAL=""
- Begin DoDot:3
- +19 DO CREATE^LA7LOG(17)
- End DoDot:3
- QUIT
- +20 ;transform result based on fields in file 62.4
- DO XFORM
- +21 IF LA7VAL=""
- QUIT
- +22 ;flag to not store if wasn't explicitly ordered
- IF $GET(LA7LIMIT)=1
- Begin DoDot:3
- +23 KILL LA7LIMIT,LA7TREEN,^TMP("LA7TREE",$JOB)
- +24 ;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)
- +25 ;wasn't ordered
- IF '$DATA(^TMP("LA7TREE",$JOB,+LA76241(0)))
- SET LA7LIMIT=1
- End DoDot:3
- +26 ;don't store
- IF $GET(LA7LIMIT)
- Begin DoDot:3
- +27 ; Set flag to not store comments if any.
- SET $PIECE(LA7RMK(0,+LA76241(0)),"^",1)=0
- +28 KILL LA7LIMIT,^TMP("LA7TREE",$JOB)
- End DoDot:3
- QUIT
- +29 KILL ^TMP("LA7TREE",$JOB)
- +30 ;lab data field
- SET LA76304=+$PIECE(LA76241(1),"(",2)
- +31 ; No dataname for this result
- IF LA76304'>1
- Begin DoDot:3
- +32 DO CREATE^LA7LOG(18)
- End DoDot:3
- QUIT
- +33 ;set data node=test value
- SET ^LAH(LA7LWL,1,LA7ISQN,LA76304)=LA7VAL
- +34 ; Store reference ranges
- DO REFRNG($PIECE(LA7OBX,LA7FS,8))
- +35 ; Store abnormal flags
- DO ABFLAG($PIECE(LA7OBX,LA7FS,9))
- +36 ;Store Units cmi/maw 2/29/2008
- DO UNITS($PIECE(LA7OBX,LA7FS,7))
- +37 ; Store where test was performed.
- DO PRDID($PIECE(LA7OBX,LA7FS,16),LA7CS)
- End DoDot:2
- End DoDot:1
- +38 IF $EXTRACT(LA7OBX,1,3)="NTE"
- SET LA762495=LA762495-1
- GOTO NTE
- +39 KILL LA7RMK
- +40 QUIT
- +41 ;
- 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 ;
- UNITS(LA7X) ;Process/Store Units cmi/maw 2/29/2008 store units if parameter set to yes
- +1 NEW LA7Y
- +2 ;units
- SET LA7X=$GET(LA7X)
- +3 ;quit if units blank or p15 of 2 array in AUTO INSTRUMENT CHEM TEST multiple set to NO
- IF LA7X=""!('$PIECE(LA76241(2),"^",15))
- QUIT
- +4 SET LA7X="Units - "_LA7X
- +5 ;test prefix
- SET LA7Y=$PIECE(LA7RMK(0,+LA76241(0)),"^",2)
- +6 ; If no prefix, use test name.
- +7 ;use test name if no prefix
- IF '$LENGTH(LA7Y)
- SET LA7Y=$PIECE($GET(^LAB(60,+LA76241(0),0)),"^")_": "
- +8 DO RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y)
- +9 QUIT
- +10 ;
- +11 ;
- 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;;
