Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7VIN5A

LA7VIN5A.m

Go to the documentation of this file.
  1. LA7VIN5A ;DALOI/JMC - Process Incoming UI Msgs, continued ;APRIL 4, 2016@16:27
  1. ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,67,72,66,74,88,99**;Sep 27, 1994;Build 3
  1. ;
  1. ; This routine is a continuation of LA7VIN5.
  1. ; It performs processing of fields in OBX segments.
  1. Q
  1. ;
  1. ;
  1. 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 from PARAM 1
  1. ;
  1. N LA7I
  1. S LA7XFORM=LA76241(2)
  1. ;
  1. ; get PARAM 1 overrides
  1. I $D(LA7XFORM(1)),LA7XFORM(1)?1.N S $P(LA7XFORM,"^")=LA7XFORM(1)
  1. F LA7I=2,3,5,6 I $D(LA7XFORM(LA7I)) S $P(LA7XFORM,"^",LA7I)=LA7XFORM(LA7I)
  1. ; set up defaults if field was not answered
  1. ; accept results,yes
  1. I $P(LA7XFORM,"^",3)="" S $P(LA7XFORM,"^",3)=1
  1. ; strip spaces,no
  1. I $P(LA7XFORM,"^",6)="" S $P(LA7XFORM,"^",6)=0
  1. ; now transform
  1. ;
  1. ; Don't accept results
  1. I '$P(LA7XFORM,"^",3) S LA7VAL="" Q
  1. ;
  1. ; Only accept "FINAL" type results
  1. I $P(LA7XFORM,"^",3)=2,"CFUX"'[LA7ORS S LA7VAL="" Q
  1. ;
  1. ; Accept ordered tests only
  1. ; If LEDI interface (10) and message indicates a reflex ("G") or add-on test ("A")
  1. ; then process anyway in case it has not been added to accession.
  1. I $P(LA7XFORM,"^",5) D
  1. . I LA7INTYP=10,LA7SAC?1(1"A",1"G") Q
  1. . S LA7LIMIT=1
  1. ; Check if Lab UI and auto release then always set ordered tests only.
  1. I LA7INTYP=1,LA7AUTORELEASE S LA7LIMIT=1
  1. ;
  1. ; Decimal places if number of places defined
  1. I $P(LA7XFORM,"^")?1.N D JUSTDEC
  1. ;
  1. ; Strip spaces
  1. I $P(LA7XFORM,"^",6) S LA7VAL=$TR(LA7VAL," ","")
  1. ;
  1. ; Make result a comment
  1. ; Set value to null after making into remark, don't store twice.
  1. I $P(LA7XFORM,"^",2) D
  1. . N LA7Y
  1. . ; Store comment in ^LAH global
  1. . S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2)
  1. . D RMKSET^LASET(LA7LWL,LA7ISQN,LA7VAL,LA7Y)
  1. . S LA7VAL=""
  1. Q
  1. ;
  1. ;
  1. CHKDIE ; Check if value to be stored passes input transform of field in DD
  1. N LA7ERR,LA7Y
  1. ;
  1. ; If result is on a LEDI interface (type=10) then don't check result against FileMan input transform.
  1. ; VistA sends "canc" as test result when test is cancelled.
  1. ; DoD sends "PL Canceled" --> change to "canc" for VistA storage.
  1. I LA7INTYP=10 D Q
  1. . I LA7VAL="PL Cancelled" S LA7VAL="canc" Q
  1. . I LA7VAL="PL Canceled" S LA7VAL="canc" Q
  1. . I LA7VAL="PLCanceled" S LA7VAL="canc" Q
  1. ;
  1. ; If canc or comment value received then pass as these are valid results on VistA.
  1. I LA7VAL="canc"!(LA7VAL="comment") Q
  1. ;
  1. ; If value fails data checker then log error and suppress result.
  1. D CHK^DIE(LA7SUBFL,LA76304,"H",LA7VAL,.LA7Y,"LA7ERR")
  1. I LA7Y="^" D
  1. . N LA7X
  1. . S LA7X=$G(LA7ERR("DIERR",1,"TEXT",1))
  1. . S LA7ERR=37,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
  1. . S LA7VAL=""
  1. Q
  1. ;
  1. ;
  1. JUSTDEC ; Justify to number of places specified
  1. ;
  1. N LA7DDTYP,LA7FMT,LA7I,LA7PRFIX,LA7X
  1. ;
  1. ; If LEDI interface (type=10) then skip decimal adjustment
  1. I LA7INTYP=10 Q
  1. ;
  1. ; Get data name field type from DD
  1. ; Only justify if Vista field is numeric or free text.
  1. S LA7DDTYP=$$GET1^DID(LA7SUBFL,LA76304,"","TYPE")
  1. I "NUMERIC^FREE TEXT"'[LA7DDTYP D Q
  1. . N LA7FLDNM
  1. . S LA7FLDNM=$$GET1^DID(63.04,LA76304,"","LABEL")
  1. . S LA7ERR=38,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
  1. ;
  1. S LA7X=LA7VAL,(LA7FMT,LA7PRFIX)=""
  1. ;
  1. ; If comma formatted, strip comma and set flag to add back in.
  1. S LA7X=$TR(LA7X,",","")
  1. I LA7X'=LA7VAL S LA7FMT="P"
  1. ;
  1. ; If "<>=" formatted, strip and save to add back in.
  1. F LA7I=1:1:$L(LA7X) Q:$E(LA7X,LA7I)'?1(1"<",1">",1"=")
  1. I LA7I>1 D
  1. . S LA7PRFIX=$E(LA7X,1,LA7I-1)
  1. . S LA7X=$E(LA7X,LA7I,$L(LA7X))
  1. ;
  1. ; Format if starts with number or decimal point, skip other results.
  1. I LA7X?1(1.N,.N1"."1.N) D
  1. . S LA7X=$FN(LA7X,LA7FMT,+LA7XFORM)
  1. . S LA7VAL=LA7PRFIX_LA7X
  1. Q
  1. ;
  1. ;
  1. PRDID(LA7PRDID,LA7SFAC,LA7CS) ; Process/Store Producer's ID
  1. ; Store where test was performed.
  1. ; Call with LA7PRDID = Producer's ID field
  1. ; LA7SFAC = sending facility
  1. ; LA7CS = component encoding character
  1. ;
  1. ; Remove units/reference ranges when Lab UI interface so file #60 settings always used
  1. I $G(LA7INTYP)=1 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)="" Q
  1. ;
  1. N LA74,LA7I,LA7X,LA7Y
  1. ;
  1. ; Store producer's id in LAH global with results.
  1. ; LA7PRODID set with pointer to file #4 to be used by segments (NTE) that follow OBX's.
  1. S (LA74,LA7PRODID)=$$RESFID^LA7VHLU2(LA7PRDID,LA7SFAC,LA7CS)
  1. I LA74 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",9)=LA74 Q
  1. ;
  1. ; Don't store producer's id as comment.
  1. I '$P(LA76241(2),"^",9) Q
  1. ;
  1. ; If unable to identify producer in file #4 then store as comment if field STORE PRODUCER'S ID (#20) enabled.
  1. S LA7X=$P(LA7PRDID,LA7CS,2)
  1. I LA7X="" Q
  1. S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2)
  1. S LA7X=$S(LA7Y="":"P",1:"p")_"erformed by "_LA7X
  1. D RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y)
  1. ;
  1. Q
  1. ;
  1. ;
  1. REFRNG(LA7X) ; Process/Store References Range.
  1. ; Call with LA7X = reference range to store.
  1. ;
  1. N LA7Y,X,Y
  1. ;
  1. ; Check if Lab UI and not auto release then quit otherwise store ranges.
  1. I LA7INTYP=1,'LA7AUTORELEASE Q
  1. ;
  1. ; Check if site does not want to store reference ranges on POC test.
  1. I LA7INTYP>19,LA7INTYP<30,+$P(LA76241(2),"^",10)=0 Q
  1. ;
  1. ; Remove leading and trailing quotes from reference range.
  1. S LA7X=$$TRIM^XLFSTR($G(LA7X),"RL","""")
  1. I LA7X="" Q
  1. ;
  1. S X=$P($G(^LAH(LA7LWL,1,LA7ISQN,LA76304)),"^",5)
  1. ;
  1. ; Replace "TO" with "-" (Labcorp special)
  1. I LA7X["TO" S LA7X=$P(LA7X,"TO",1)_"-"_$P(LA7X,"TO",2)
  1. ;
  1. ; A single value with minus sign = upper limit
  1. I $E(LA7X)="-",$L(LA7X,"-")=2 S LA7X="<"_$E(LA7X,2,$L(LA7X))
  1. ;
  1. ; >lower limit (no upper limit e.g. >10) - store as low value
  1. I LA7X?1">".N.1".".N S $P(X,"!",2)=$TR(LA7X,">",""),LA7X=""
  1. ;
  1. ; <upper limit (no lower limit e.g. <15) - store as high value
  1. I LA7X?1"<".N.1".".N S $P(X,"!",3)=$TR(LA7X,"<",""),LA7X=""
  1. ;
  1. ; Alphabetic reference with hyphen
  1. I LA7X?1.A1"-"1.A S $P(X,"!",2)=$C(34)_LA7X_$C(34),LA7X=""
  1. ;
  1. S LADASH=0 S:LA7X["-" LADASH=$L(LA7X,"-")
  1. ; Lower limit value
  1. S Y=$S(LADASH:$P(LA7X,"-",1,LADASH-1),1:$P(LA7X,"-"))
  1. I Y'="" D
  1. . I Y?.N.1".".N S $P(X,"!",2)=Y
  1. . E S $P(X,"!",2)=$C(34)_$$UNESC^LA7VHLU3(Y,LA7FS_LA7ECH)_$C(34)
  1. ;
  1. ; Upper limit value
  1. I LADASH<4 S Y=$S(LADASH:$P(LA7X,"-",LADASH),1:$P(LA7X,"-",2))
  1. I LADASH=4 S Y=$P(LA7X,"-",LADASH-1,LADASH)
  1. I Y'="" D
  1. . I Y?.N.1".".N S $P(X,"!",3)=Y
  1. . E S $P(X,"!",3)=$C(34)_$$UNESC^LA7VHLU3(Y,LA7FS_LA7ECH)_$C(34)
  1. K LADASH
  1. ;
  1. ; Store reference range in LAH global with results.
  1. S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=X
  1. ;
  1. Q
  1. ;
  1. ;
  1. ABFLAG(LA7X) ; Process/Store Abnormal Flags.
  1. ; Call with LA7X = abnormal flags to store.
  1. ; Converts flag to interpretation based on HL7 Table 0078.
  1. ; If no match store code instead of interpretation
  1. ;
  1. N I,LA7I,LA7Y,X
  1. ;
  1. ; Check if Lab UI and not auto release then quit otherwise store abnormal flags.
  1. I LA7INTYP=1,'LA7AUTORELEASE Q
  1. ;
  1. ; Store abnormal flags in LAH global with results.
  1. ; Currently only storing high/low and critical flags
  1. S LA7Y=$S(LA7X="L":"L",LA7X="H":"H",LA7X="LL":"L*",LA7X="HH":"H*",1:"")
  1. S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",2)=LA7Y
  1. ;
  1. ; Critical or designated abnormal tests generate bulletin/alert on LEDI (type=10) interfaces.
  1. I LA7INTYP=10,LA7Y'="" D
  1. . I $E(LA7Y,2)'="*",'$P(LA76241(2),"^",11) Q
  1. . S LA7I=$O(^TMP("LA7 ABNORMAL RESULTS",$J,""),-1),LA7I=LA7I+1
  1. . S X=LA7LWL_"^"_LA7ISQN_"^"_LA76304_"^"_LA76248_"^"_LA76249_"^"_LA7ORS_"^"_LA7TEST_"^"_$S(LA7TEST(0)'="":LA7TEST(0),1:LA7TEST(2,0))_"^"_$$P^LA7VHLU(.LA7SEG,9,LA7FS)
  1. . S ^TMP("LA7 ABNORMAL RESULTS",$J,LA7I)=X
  1. ;
  1. ; If LEDI/POC interface and abnormal flag is not handled by VistA above then store as comment.
  1. I LA7INTYP>9,LA7INTYP<30,LA7Y="",LA7X'="",LA7X'="N" D
  1. . S X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
  1. . S I=$F(X,LA7X)\3
  1. . S LA7Y="normalcy status - "_$P($T(ABFLAGS+I^LA7VHLU1),";;",2)
  1. . D RMKSET^LASET(LA7LWL,LA7ISQN,LA7Y,$P(LA7RMK(0,+LA76241(0)),"^",2))
  1. ;
  1. Q
  1. ;
  1. ;
  1. EII ; Store equipment instance identifier in LAH global with results.
  1. ;
  1. N I,LA7X,X
  1. ;
  1. S LA7X=""
  1. F I=1:1:4 D
  1. . S X=$P(LA7EII,LA7CS,I)
  1. . I X="" Q
  1. . S $P(LA7X,"!",I)=$TR(X,"!","~")
  1. I LA7X'="" S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",11)=LA7X
  1. Q