LA7VCN5A ;VHA/DALOI/JMC - Process Incoming UI Msgs, continued ; 22-Oct-2013 09:22 ; MAW
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,1027,1033**;NOV 01, 1997
; This routine is a continuation of LA7VIN5.
; It is performs processing of fields in OBX segments.
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,no
I $P(LA7XFORM,"^",6)="" S $P(LA7XFORM,"^",6)=0
; now transform
;
; Don't accept results
I '$P(LA7XFORM,"^",3) S LA7VAL="" Q
;
; Only accept "FINAL" type results
I $P(LA7XFORM,"^",3)=2,"CFU"'[LA7ORS S LA7VAL="" Q
;
; Accept ordered tests only
; If LEDI interface (10) and message indicates a reflex ("G") or add-on
; test ("A") then process anyway in case it has not been added to
; accession.
I $P(LA7XFORM,"^",5) D
. I LA7INTYP=10,LA7SAC?1(1"A",1"G") Q
. S LA7LIMIT=1
;
; Decimal places if number of places defined
I $P(LA7XFORM,"^")?1.N D JUSTDEC
;
; Strip spaces
I $P(LA7XFORM,"^",6) S LA7VAL=$TR(LA7VAL," ","")
;
; Make result a comment
; Set value to null after making into remark, don't store twice.
I $P(LA7XFORM,"^",2) D
. N LA7Y
. ; Store comment in ^LAH global
. S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2)
. D RMKSET^LASET(LA7LWL,LA7ISQN,LA7VAL,LA7Y)
. S LA7VAL=""
Q
;
;
CHKDIE ; Check if value to be stored passes input transform of field in DD
N LA7ERR,LA7Y
;
; If result is on a LEDI interface (type=10) then don't check result
; against FileMan input tranform.
; VistA sends "canc" as test result when test is cancelled.
; DoD sends "PL Canceled" --> change to "canc" for VistA storage.
I LA7INTYP=10 D Q
. I LA7VAL="PL Cancelled" S LA7VAL="canc"
. I LA7VAL="PL Canceled" S LA7VAL="canc"
. I LA7VAL="PLCanceled" S LA7VAL="canc"
;
; If value fails data checker then log error and suppress result.
D CHK^DIE(LA7SUBFL,LA76304,"H",LA7VAL,.LA7Y,"LA7ERR")
I LA7Y="^" D
. N LA7X
. S LA7X=$G(LA7ERR("DIERR",1,"TEXT",1))
. D CREATE^LA7LOG(37)
. S LA7VAL=""
Q
;
;
JUSTDEC ; Justify to number of places specified
;
N LA7DDTYP,LA7FMT,LA7I,LA7PRFIX,LA7X
;
; If LEDI interface (type=10) then skip decimal adjustment
I LA7INTYP=10 Q
;
; Get data name field type from DD
; Only justify if Vista field is numeric or free text.
S LA7DDTYP=$$GET1^DID(LA7SUBFL,LA76304,"","TYPE")
I "NUMERIC^FREE TEXT"'[LA7DDTYP D Q
. N LA7FLDNM
. S LA7FLDNM=$$GET1^DID(63.04,LA76304,"","LABEL")
. D CREATE^LA7LOG(38)
;
S LA7X=LA7VAL,(LA7FMT,LA7PRFIX)=""
;
; If comma formatted, strip comma and set flag to add back in.
S LA7X=$TR(LA7X,",","")
I LA7X'=LA7VAL S LA7FMT="P"
;
; If "<>=" formatted, strip and save to add back in.
F LA7I=1:1:$L(LA7X) Q:$E(LA7X,LA7I)'?1(1"<",1">",1"=")
I LA7I>1 D
. S LA7PRFIX=$E(LA7X,1,LA7I-1)
. S LA7X=$E(LA7X,LA7I,$L(LA7X))
;
; Format if starts with number or decimal point, skip other results.
I LA7X?1(1.N,.N1"."1.N) D
. S LA7X=$FN(LA7X,LA7FMT,+LA7XFORM)
. S LA7VAL=LA7PRFIX_LA7X
Q
;
;
PRDID(LA7PRDID,LA7SFAC,LA7CS) ; Process/Store Producer's ID
; Store where test was performed.
; Call with LA7PRDID = Producer's ID field
; LA7SFAC = sending facility
; LA7CS = component encoding character
;
N LA74,LA7X,LA7Y
;
S LA7X=$P(LA7PRDID,LA7CS,2),LA74=""
;
I $P(LA7PRDID,LA7CS,3)="99VA4" S LA74=$$FIND1^DIC(4,"","OMX",$P(LA7PRDID,LA7CS))
I 'LA74 S LA74=$$FINDSITE^LA7VHLU2($P(LA7PRDID,LA7CS),1,1)
I 'LA74 S LA74=$$FINDSITE^LA7VHLU2($P(LA7SFAC,LA7CS),1,1)
;
; Store producer's id in LAH global with results.
I LA74 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",9)=LA74
;
Q
;
;
RPTFAC(LA7PRDID,LA7SFAC,LA7CS) ; Process/Store Producer's ID
; Store where test was performed.
; Call with LA7PRDID = Producer's ID field
; LA7SFAC = sending facility
; LA7CS = component encoding character
;
N LA74,LA7X,LA7Y
;
;S LA7X=$P(LA7PRDID,LA7CS,2),LA74=""
S LA7X=LA7PRDID,LA74=""
;
I $P(LA7PRDID,LA7CS,3)="99VA4" S LA74=$$FIND1^DIC(4,"","OMX",$P(LA7PRDID,LA7CS))
I 'LA74 S LA74=$$FINDSITE^LA7VHLU2($P(LA7PRDID,LA7CS),1,1)
;I 'LA74 S LA74=$$FINDSITE^LA7VHLU2($P(LA7SFAC,LA7CS),1,1)
;
; Store producer's id in LAH global with results.
I LA74 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",9)=LA74
;
Q
;
;
REFRNG(LA7X) ; Process/Store References Range.
; Call with LA7X = reference range to store.
;
N LA7Y,X,Y
;
; Remove leading and trailing quotes from reference range.
S LA7X=$$TRIM^XLFSTR($G(LA7X),"RL","""")
I LA7X="" Q
;
S X=$P($G(^LAH(LA7LWL,1,LA7ISQN,LA76304)),"^",5)
;
; >lower limit (no upper limit e.g. >10) - store as low value
I LA7X?1">".N.1".".N S $P(X,"!",2)=$TR(LA7X,">",""),LA7X=""
;
; <upper limit (no lower limit e.g. <15) - store as high value
I LA7X?1"<".N.1".".N S $P(X,"!",3)=$TR(LA7X,"<",""),LA7X=""
;
; Alphabetic reference with hyphen
I LA7X?1.A1"-"1.A S $P(X,"!",2)=$C(34)_LA7X_$C(34),LA7X=""
;
; Lower limit value
S Y=$P(LA7X,"-")
I Y'="" D
. I Y?.N.1".".N S $P(X,"!",2)=Y
. E S $P(X,"!",2)=$C(34)_$$UNESC^LA7VHLU3(Y,LA7FS_LA7ECH)_$C(34)
;
; Upper limit value
S Y=$P(LA7X,"-",2)
I Y'="" D
. I Y?.N.1".".N S $P(X,"!",3)=Y
. E S $P(X,"!",3)=$C(34)_$$UNESC^LA7VHLU3(Y,LA7FS_LA7ECH)_$C(34)
;
; Store reference range in LAH global with results.
S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=X
;
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 LA7I,LA7Y,X
;
; Store abnormal flags in LAH global with results.
; Currently only storing high/low and critical flags
;S LA7Y=$S(LA7X="L":"L",LA7X="H":"H",LA7X="LL":"L*",LA7X="HH":"H*",1:"")
S LA7Y=LA7X ;ihs/cmi/maw MU2 pass through
S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",2)=LA7Y
;
; Critical or designated abnormal tests generate bulletin/alert
; on LEDI (type=10) interfaces.
I LA7INTYP=10,LA7Y'="" D
. I $E(LA7Y,2)'="*",'$P(LA76241(2),"^",11) Q
. S LA7I=$O(^TMP("LA7 ABNORMAL 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 ABNORMAL RESULTS",$J,LA7I)=X
;
Q
;
;
EII ; Store equipment instance identifier in LAH global with results.
;
N I,LA7X,X
;
S LA7X=""
F I=1:1:4 D
. S X=$P(LA7EII,LA7CS,I)
. I X="" Q
. S $P(LA7X,"!",I)=$TR(X,"!","~")
I LA7X]"" S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",11)=LA7X
Q
;
;
ORESULTS ; Process results that accompany order (ORM) messages
;
N I,LA764,LA7DIE,LA7ERR,LA7I,LA7WP,LA7X,LA7Y,X
S LA7WP(1,0)=" ",LA7I=2,X=""
I LA7RLNC S X="[LOINC "_$$GET1^DIQ(95.3,LA7RLNC_",",.01)_"] "_$$GET1^DIQ(95.3,LA7RLNC_",",80)
I 'LA7RLNC,LA7RNLT D
. S LA764=$$FIND1^DIC(64,"","X",LA7RNLT,"E","","LA7ERR")
. I 'LA764 S LA7RNLT="" Q
. S X="[NLT "_$$GET1^DIQ(64,LA764_",",1)_"] "_$$GET1^DIQ(64,LA764_",",.01,"I")
I 'LA7RLNC,'LA7RNLT D
. I LA7TEST(0)]""!(LA7TEST]"") S X="["_LA7TEST(0,1)_" "_LA7TEST_"] "_LA7TEST(0) Q
. S X="["_LA7TEST(2,1)_" "_LA7TEST(2)_"] "_LA7TEST(2,0)
S LA7WP(LA7I,0)="Test result: "_X
; Date value
I LA7VTYP="DT" D
. S LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
. S LA7X=$$HL7TFM^XLFDT(LA7X,"L")
. S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X
; Coded entry
I "CECM"[LA7VTYP D
. S LA7X=$P($$P^LA7VHLU(.LA7SEG,6,LA7FS),LA7CS,2)
. S LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
. S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X_$S(LA7UNITS]"":" "_LA7UNITS,1:"")
; Numeric/ Structured Numeric value
I "NMSN"[LA7VTYP D
. S LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
. S LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
. S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X_$S(LA7UNITS]"":" "_LA7UNITS,1:"")
; String Data/ Formatted Text/ Text Data
I "FTSTX"[LA7VTYP D
. D PA^LA7VHLU(.LA7SEG,6,LA7FS,.LA7X)
. D UNESCFT^LA7VHLU3(.LA7X,LA7FS_LA7ECH,.LA7Y)
. I LA7Y=1,(($L(LA7Y(1,0))+$L(LA7UNITS))<225) S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7Y(1,0)_$S(LA7UNITS]"":" "_LA7UNITS,1:"") Q
. S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value:"
. F I=1:1:LA7Y S LA7I=LA7I+1,LA7WP(LA7I,0)=LA7Y(I,0)
. I LA7UNITS]"" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test units: "_LA7UNITS
; Normals/ Reference range
S LA7X=$$P^LA7VHLU(.LA7SEG,8,LA7FS)
I LA7X]"" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test normals: "_LA7X
; Normalcy status
S LA7X=$$P^LA7VHLU(.LA7SEG,9,LA7FS)
I LA7X]"" D
. S X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
. S I=$F(X,LA7X)\3,LA7X=$P($T(ABFLAGS+I^LA7VHLU1),";;",2)
. I LA7X]"" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test normalcy status: "_LA7X
I $D(LA7WP) D WP^DIE(69.6,LA7696_",",99,"A","LA7WP","LA7DIE(99)")
Q
LA7VCN5A ;VHA/DALOI/JMC - Process Incoming UI Msgs, continued ; 22-Oct-2013 09:22 ; MAW
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,1027,1033**;NOV 01, 1997
+2 ; This routine is a continuation of LA7VIN5.
+3 ; It is performs processing of fields in OBX segments.
+4 QUIT
+5 ;
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 ;
+6 ; get PARAM 1 overides
+7 IF $DATA(LA7XFORM(1))
IF LA7XFORM(1)?1.N
SET $PIECE(LA7XFORM,"^")=LA7XFORM(1)
+8 FOR LA7I=2,3,5,6
IF $DATA(LA7XFORM(LA7I))
SET $PIECE(LA7XFORM,"^",LA7I)=LA7XFORM(LA7I)
+9 ; set up defaults if field was not answered
+10 ; accept results,yes
+11 IF $PIECE(LA7XFORM,"^",3)=""
SET $PIECE(LA7XFORM,"^",3)=1
+12 ; strip spaces,no
+13 IF $PIECE(LA7XFORM,"^",6)=""
SET $PIECE(LA7XFORM,"^",6)=0
+14 ; now transform
+15 ;
+16 ; Don't accept results
+17 IF '$PIECE(LA7XFORM,"^",3)
SET LA7VAL=""
QUIT
+18 ;
+19 ; Only accept "FINAL" type results
+20 IF $PIECE(LA7XFORM,"^",3)=2
IF "CFU"'[LA7ORS
SET LA7VAL=""
QUIT
+21 ;
+22 ; Accept ordered tests only
+23 ; If LEDI interface (10) and message indicates a reflex ("G") or add-on
+24 ; test ("A") then process anyway in case it has not been added to
+25 ; accession.
+26 IF $PIECE(LA7XFORM,"^",5)
Begin DoDot:1
+27 IF LA7INTYP=10
IF LA7SAC?1(1"A",1"G")
QUIT
+28 SET LA7LIMIT=1
End DoDot:1
+29 ;
+30 ; Decimal places if number of places defined
+31 IF $PIECE(LA7XFORM,"^")?1.N
DO JUSTDEC
+32 ;
+33 ; Strip spaces
+34 IF $PIECE(LA7XFORM,"^",6)
SET LA7VAL=$TRANSLATE(LA7VAL," ","")
+35 ;
+36 ; Make result a comment
+37 ; Set value to null after making into remark, don't store twice.
+38 IF $PIECE(LA7XFORM,"^",2)
Begin DoDot:1
+39 NEW LA7Y
+40 ; Store comment in ^LAH global
+41 SET LA7Y=$PIECE(LA7RMK(0,+LA76241(0)),"^",2)
+42 DO RMKSET^LASET(LA7LWL,LA7ISQN,LA7VAL,LA7Y)
+43 SET LA7VAL=""
End DoDot:1
+44 QUIT
+45 ;
+46 ;
CHKDIE ; Check if value to be stored passes input transform of field in DD
+1 NEW LA7ERR,LA7Y
+2 ;
+3 ; If result is on a LEDI interface (type=10) then don't check result
+4 ; against FileMan input tranform.
+5 ; VistA sends "canc" as test result when test is cancelled.
+6 ; DoD sends "PL Canceled" --> change to "canc" for VistA storage.
+7 IF LA7INTYP=10
Begin DoDot:1
+8 IF LA7VAL="PL Cancelled"
SET LA7VAL="canc"
+9 IF LA7VAL="PL Canceled"
SET LA7VAL="canc"
+10 IF LA7VAL="PLCanceled"
SET LA7VAL="canc"
End DoDot:1
QUIT
+11 ;
+12 ; If value fails data checker then log error and suppress result.
+13 DO CHK^DIE(LA7SUBFL,LA76304,"H",LA7VAL,.LA7Y,"LA7ERR")
+14 IF LA7Y="^"
Begin DoDot:1
+15 NEW LA7X
+16 SET LA7X=$GET(LA7ERR("DIERR",1,"TEXT",1))
+17 DO CREATE^LA7LOG(37)
+18 SET LA7VAL=""
End DoDot:1
+19 QUIT
+20 ;
+21 ;
JUSTDEC ; Justify to number of places specified
+1 ;
+2 NEW LA7DDTYP,LA7FMT,LA7I,LA7PRFIX,LA7X
+3 ;
+4 ; If LEDI interface (type=10) then skip decimal adjustment
+5 IF LA7INTYP=10
QUIT
+6 ;
+7 ; Get data name field type from DD
+8 ; Only justify if Vista field is numeric or free text.
+9 SET LA7DDTYP=$$GET1^DID(LA7SUBFL,LA76304,"","TYPE")
+10 IF "NUMERIC^FREE TEXT"'[LA7DDTYP
Begin DoDot:1
+11 NEW LA7FLDNM
+12 SET LA7FLDNM=$$GET1^DID(63.04,LA76304,"","LABEL")
+13 DO CREATE^LA7LOG(38)
End DoDot:1
QUIT
+14 ;
+15 SET LA7X=LA7VAL
SET (LA7FMT,LA7PRFIX)=""
+16 ;
+17 ; If comma formatted, strip comma and set flag to add back in.
+18 SET LA7X=$TRANSLATE(LA7X,",","")
+19 IF LA7X'=LA7VAL
SET LA7FMT="P"
+20 ;
+21 ; If "<>=" formatted, strip and save to add back in.
+22 FOR LA7I=1:1:$LENGTH(LA7X)
IF $EXTRACT(LA7X,LA7I)'?1(1"<",1">",1"=")
QUIT
+23 IF LA7I>1
Begin DoDot:1
+24 SET LA7PRFIX=$EXTRACT(LA7X,1,LA7I-1)
+25 SET LA7X=$EXTRACT(LA7X,LA7I,$LENGTH(LA7X))
End DoDot:1
+26 ;
+27 ; Format if starts with number or decimal point, skip other results.
+28 IF LA7X?1(1.N,.N1"."1.N)
Begin DoDot:1
+29 SET LA7X=$FNUMBER(LA7X,LA7FMT,+LA7XFORM)
+30 SET LA7VAL=LA7PRFIX_LA7X
End DoDot:1
+31 QUIT
+32 ;
+33 ;
PRDID(LA7PRDID,LA7SFAC,LA7CS) ; Process/Store Producer's ID
+1 ; Store where test was performed.
+2 ; Call with LA7PRDID = Producer's ID field
+3 ; LA7SFAC = sending facility
+4 ; LA7CS = component encoding character
+5 ;
+6 NEW LA74,LA7X,LA7Y
+7 ;
+8 SET LA7X=$PIECE(LA7PRDID,LA7CS,2)
SET LA74=""
+9 ;
+10 IF $PIECE(LA7PRDID,LA7CS,3)="99VA4"
SET LA74=$$FIND1^DIC(4,"","OMX",$PIECE(LA7PRDID,LA7CS))
+11 IF 'LA74
SET LA74=$$FINDSITE^LA7VHLU2($PIECE(LA7PRDID,LA7CS),1,1)
+12 IF 'LA74
SET LA74=$$FINDSITE^LA7VHLU2($PIECE(LA7SFAC,LA7CS),1,1)
+13 ;
+14 ; Store producer's id in LAH global with results.
+15 IF LA74
SET $PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",9)=LA74
+16 ;
+17 QUIT
+18 ;
+19 ;
RPTFAC(LA7PRDID,LA7SFAC,LA7CS) ; Process/Store Producer's ID
+1 ; Store where test was performed.
+2 ; Call with LA7PRDID = Producer's ID field
+3 ; LA7SFAC = sending facility
+4 ; LA7CS = component encoding character
+5 ;
+6 NEW LA74,LA7X,LA7Y
+7 ;
+8 ;S LA7X=$P(LA7PRDID,LA7CS,2),LA74=""
+9 SET LA7X=LA7PRDID
SET LA74=""
+10 ;
+11 IF $PIECE(LA7PRDID,LA7CS,3)="99VA4"
SET LA74=$$FIND1^DIC(4,"","OMX",$PIECE(LA7PRDID,LA7CS))
+12 IF 'LA74
SET LA74=$$FINDSITE^LA7VHLU2($PIECE(LA7PRDID,LA7CS),1,1)
+13 ;I 'LA74 S LA74=$$FINDSITE^LA7VHLU2($P(LA7SFAC,LA7CS),1,1)
+14 ;
+15 ; Store producer's id in LAH global with results.
+16 IF LA74
SET $PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",9)=LA74
+17 ;
+18 QUIT
+19 ;
+20 ;
REFRNG(LA7X) ; Process/Store References Range.
+1 ; Call with LA7X = reference range to store.
+2 ;
+3 NEW LA7Y,X,Y
+4 ;
+5 ; Remove leading and trailing quotes from reference range.
+6 SET LA7X=$$TRIM^XLFSTR($GET(LA7X),"RL","""")
+7 IF LA7X=""
QUIT
+8 ;
+9 SET X=$PIECE($GET(^LAH(LA7LWL,1,LA7ISQN,LA76304)),"^",5)
+10 ;
+11 ; >lower limit (no upper limit e.g. >10) - store as low value
+12 IF LA7X?1">".N.1".".N
SET $PIECE(X,"!",2)=$TRANSLATE(LA7X,">","")
SET LA7X=""
+13 ;
+14 ; <upper limit (no lower limit e.g. <15) - store as high value
+15 IF LA7X?1"<".N.1".".N
SET $PIECE(X,"!",3)=$TRANSLATE(LA7X,"<","")
SET LA7X=""
+16 ;
+17 ; Alphabetic reference with hyphen
+18 IF LA7X?1.A1"-"1.A
SET $PIECE(X,"!",2)=$CHAR(34)_LA7X_$CHAR(34)
SET LA7X=""
+19 ;
+20 ; Lower limit value
+21 SET Y=$PIECE(LA7X,"-")
+22 IF Y'=""
Begin DoDot:1
+23 IF Y?.N.1".".N
SET $PIECE(X,"!",2)=Y
+24 IF '$TEST
SET $PIECE(X,"!",2)=$CHAR(34)_$$UNESC^LA7VHLU3(Y,LA7FS_LA7ECH)_$CHAR(34)
End DoDot:1
+25 ;
+26 ; Upper limit value
+27 SET Y=$PIECE(LA7X,"-",2)
+28 IF Y'=""
Begin DoDot:1
+29 IF Y?.N.1".".N
SET $PIECE(X,"!",3)=Y
+30 IF '$TEST
SET $PIECE(X,"!",3)=$CHAR(34)_$$UNESC^LA7VHLU3(Y,LA7FS_LA7ECH)_$CHAR(34)
End DoDot:1
+31 ;
+32 ; Store reference range in LAH global with results.
+33 SET $PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=X
+34 ;
+35 QUIT
+36 ;
+37 ;
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 LA7I,LA7Y,X
+6 ;
+7 ; Store abnormal flags in LAH global with results.
+8 ; Currently only storing high/low and critical flags
+9 ;S LA7Y=$S(LA7X="L":"L",LA7X="H":"H",LA7X="LL":"L*",LA7X="HH":"H*",1:"")
+10 ;ihs/cmi/maw MU2 pass through
SET LA7Y=LA7X
+11 SET $PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",2)=LA7Y
+12 ;
+13 ; Critical or designated abnormal tests generate bulletin/alert
+14 ; on LEDI (type=10) interfaces.
+15 IF LA7INTYP=10
IF LA7Y'=""
Begin DoDot:1
+16 IF $EXTRACT(LA7Y,2)'="*"
IF '$PIECE(LA76241(2),"^",11)
QUIT
+17 SET LA7I=$ORDER(^TMP("LA7 ABNORMAL RESULTS",$JOB,""),-1)
SET LA7I=LA7I+1
+18 SET X=LA7LWL_"^"_LA7ISQN_"^"_LA76304_"^"_LA76248_"^"_LA76249_"^"_LA7ORS_"^"_LA7TEST_"^"_$SELECT(LA7TEST(0)'="":LA7TEST(0),1:LA7TEST(2,0))_"^"_$$P^LA7VHLU(.LA7SEG,9,LA7FS)
+19 SET ^TMP("LA7 ABNORMAL RESULTS",$JOB,LA7I)=X
End DoDot:1
+20 ;
+21 QUIT
+22 ;
+23 ;
EII ; Store equipment instance identifier in LAH global with results.
+1 ;
+2 NEW I,LA7X,X
+3 ;
+4 SET LA7X=""
+5 FOR I=1:1:4
Begin DoDot:1
+6 SET X=$PIECE(LA7EII,LA7CS,I)
+7 IF X=""
QUIT
+8 SET $PIECE(LA7X,"!",I)=$TRANSLATE(X,"!","~")
End DoDot:1
+9 IF LA7X]""
SET $PIECE(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",11)=LA7X
+10 QUIT
+11 ;
+12 ;
ORESULTS ; Process results that accompany order (ORM) messages
+1 ;
+2 NEW I,LA764,LA7DIE,LA7ERR,LA7I,LA7WP,LA7X,LA7Y,X
+3 SET LA7WP(1,0)=" "
SET LA7I=2
SET X=""
+4 IF LA7RLNC
SET X="[LOINC "_$$GET1^DIQ(95.3,LA7RLNC_",",.01)_"] "_$$GET1^DIQ(95.3,LA7RLNC_",",80)
+5 IF 'LA7RLNC
IF LA7RNLT
Begin DoDot:1
+6 SET LA764=$$FIND1^DIC(64,"","X",LA7RNLT,"E","","LA7ERR")
+7 IF 'LA764
SET LA7RNLT=""
QUIT
+8 SET X="[NLT "_$$GET1^DIQ(64,LA764_",",1)_"] "_$$GET1^DIQ(64,LA764_",",.01,"I")
End DoDot:1
+9 IF 'LA7RLNC
IF 'LA7RNLT
Begin DoDot:1
+10 IF LA7TEST(0)]""!(LA7TEST]"")
SET X="["_LA7TEST(0,1)_" "_LA7TEST_"] "_LA7TEST(0)
QUIT
+11 SET X="["_LA7TEST(2,1)_" "_LA7TEST(2)_"] "_LA7TEST(2,0)
End DoDot:1
+12 SET LA7WP(LA7I,0)="Test result: "_X
+13 ; Date value
+14 IF LA7VTYP="DT"
Begin DoDot:1
+15 SET LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
+16 SET LA7X=$$HL7TFM^XLFDT(LA7X,"L")
+17 SET LA7I=LA7I+1
SET LA7WP(LA7I,0)=" Test value: "_LA7X
End DoDot:1
+18 ; Coded entry
+19 IF "CECM"[LA7VTYP
Begin DoDot:1
+20 SET LA7X=$PIECE($$P^LA7VHLU(.LA7SEG,6,LA7FS),LA7CS,2)
+21 SET LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
+22 SET LA7I=LA7I+1
SET LA7WP(LA7I,0)=" Test value: "_LA7X_$SELECT(LA7UNITS]"":" "_LA7UNITS,1:"")
End DoDot:1
+23 ; Numeric/ Structured Numeric value
+24 IF "NMSN"[LA7VTYP
Begin DoDot:1
+25 SET LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
+26 SET LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
+27 SET LA7I=LA7I+1
SET LA7WP(LA7I,0)=" Test value: "_LA7X_$SELECT(LA7UNITS]"":" "_LA7UNITS,1:"")
End DoDot:1
+28 ; String Data/ Formatted Text/ Text Data
+29 IF "FTSTX"[LA7VTYP
Begin DoDot:1
+30 DO PA^LA7VHLU(.LA7SEG,6,LA7FS,.LA7X)
+31 DO UNESCFT^LA7VHLU3(.LA7X,LA7FS_LA7ECH,.LA7Y)
+32 IF LA7Y=1
IF (($LENGTH(LA7Y(1,0))+$LENGTH(LA7UNITS))<225)
SET LA7I=LA7I+1
SET LA7WP(LA7I,0)=" Test value: "_LA7Y(1,0)_$SELECT(LA7UNITS]"":" "_LA7UNITS,1:"")
QUIT
+33 SET LA7I=LA7I+1
SET LA7WP(LA7I,0)=" Test value:"
+34 FOR I=1:1:LA7Y
SET LA7I=LA7I+1
SET LA7WP(LA7I,0)=LA7Y(I,0)
+35 IF LA7UNITS]""
SET LA7I=LA7I+1
SET LA7WP(LA7I,0)=" Test units: "_LA7UNITS
End DoDot:1
+36 ; Normals/ Reference range
+37 SET LA7X=$$P^LA7VHLU(.LA7SEG,8,LA7FS)
+38 IF LA7X]""
SET LA7I=LA7I+1
SET LA7WP(LA7I,0)=" Test normals: "_LA7X
+39 ; Normalcy status
+40 SET LA7X=$$P^LA7VHLU(.LA7SEG,9,LA7FS)
+41 IF LA7X]""
Begin DoDot:1
+42 SET X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
+43 SET I=$FIND(X,LA7X)\3
SET LA7X=$PIECE($TEXT(ABFLAGS+I^LA7VHLU1),";;",2)
+44 IF LA7X]""
SET LA7I=LA7I+1
SET LA7WP(LA7I,0)=" Test normalcy status: "_LA7X
End DoDot:1
+45 IF $DATA(LA7WP)
DO WP^DIE(69.6,LA7696_",",99,"A","LA7WP","LA7DIE(99)")
+46 QUIT
