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

LA7COBXA.m

Go to the documentation of this file. 
  1. LA7COBXA ;VA/DALOI/JMC - LAB OBX Segment message builder (cont'd) ; 22-Oct-2013 09:22 ; MAW
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,70,64,1027,68,1033**;NOV 01, 1997
  1.  ;
  1.  Q
  1.  ;
  1. OBX2 ; Build OBX-2 sequence - Value type
  1.  ;
  1.  ; default value - string data
  1.  N TST
  1.  S LA7VAL="SN"
  1.  S LA7TYP="",LA7FILE=$G(LA7FILE),LA7FIELD=$G(LA7FIELD)
  1.  ;
  1.  I LA7FILE,LA7FIELD S LA7TYP=$$GET1^DID(LA7FILE,LA7FIELD,"","TYPE","","LA7ERR")
  1.  ;
  1.  I LA7TYP="DATE/TIME" S LA7VAL="TS"
  1.  I LA7TYP="FREE TEXT" S LA7VAL="SN"  ;MU2 from ST
  1.  I LA7TYP="FREE TEXT",$G(LA7INPT) S LA7VAL="TX"  ;mu2 inpatient
  1.  I LA7VAL="TX",$G(LRSS)="MI" S LA7VAL="SN"  ;mu2 inpatient micro
  1.  I LA7TYP="WORD-PROCESSING" S LA7VAL="FT"
  1.  I LA7TYP="WORD-PROCESSING",$G(LA7INPT) S LA7VAL="TX"  ;mu2 inpatient
  1.  I LA7TYP="NUMERIC" S LA7VAL="SN"  ;MU2
  1.  I LA7TYP="NUMERIC",$G(LA7INPT) S LA7VAL="NM"  ;mu2 inpatient
  1.  I LA7TYP="SET" S LA7VAL="CWE"  ;MU2
  1.  I LA7TYP="POINTER" S LA7VAL="ST"
  1.  I $G(LA7VAL)="" S LA7VAL="SN"
  1.  I LA7VAL="SN",$G(LA7INPT)="SN" S LA7VAL="NM"  ;mu2 inpatient no SN's
  1.  ;put in code here to look at a field in file 60 and use that value over anything else
  1.  I $G(LA7INPT) D
  1.  .S TST=$O(^LAB(60,"C",LRSS_";"_LA7FIELD_";"_1,0))
  1.  .Q:'$G(TST)
  1.  .I $P($G(^LAB(60,TST,.1)),U,2)]"" S LA7VAL=$P($G(^LAB(60,TST,.1)),U,2)  ;override with MU2 value
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. OBX3 ; Build OBX-3 sequence - Observation identifier field
  1.  ;
  1.  ; Initialize variables 
  1.  S LA7J=1,LA7Y="",LA7INTYP=$G(LA7INTYP)
  1.  ;
  1.  ; Build sequence using LOINC codes. LOINC code/code name/"LN"
  1.  ; VA VUID in 2nd triplet when sending to VA HDR. Use VA Display name (field #82) for VUID test name
  1.  I LA7953'="" D
  1.  . N LA7IENS,LA7Z
  1.  . S LA7953=$P(LA7953,"-"),LA7IENS=LA7953_","
  1.  . D GETS^DIQ(95.3,LA7IENS,".01;80;99.99","E","LA7X")
  1.  . ; Invalid code???
  1.  . I $G(LA7X(95.3,LA7IENS,.01,"E"))="" Q
  1.  . S LA7Z=LA7X(95.3,LA7IENS,.01,"E")
  1.  . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
  1.  . S $P(LA7Y,$E(LA7ECH,1),LA7J)=LA7Z
  1.  . S LA7Z=$G(LA7X(95.3,LA7IENS,80,"E"))
  1.  . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
  1.  . S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=LA7Z
  1.  . S $P(LA7Y,$E(LA7ECH,1),LA7J+2)="LN"
  1.  . S LA7J=4
  1.  . I LA7INTYP=30,$G(LA7X(95.3,LA7IENS,99.99,"E"))'="" D
  1.  . . S $P(LA7Y,$E(LA7ECH,1),LA7J)=LA7X(95.3,LA7IENS,99.99,"E")
  1.  . . I $$VFIELD^DILFD(95.3,82) D
  1.  . . . S LA7Z=$$GET1^DIQ(95.3,LA7IENS,82)
  1.  . . . I LA7Z'="" S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
  1.  . . S $P(LA7Y,$E(LA7ECH,1),LA7J+2)="L"
  1.  . . S LA7J=9
  1.  . I $G(LA7LNCVR)="" S LA7LNCVR=$$GET1^DID(95.3,"","","PACKAGE REVISION DATA")
  1.  . I LA7J>1 S $P(LA7Y,$E(LA7ECH,1),7)=LA7LNCVR
  1.  . I LA7J=9 S $P(LA7Y,$E(LA7ECH,1),8)=LA7LNCVR
  1.  ;
  1.  ; Build sequence using NLT codes - file #64 NLT code/NLT code name/"99VA64"
  1.  ; If LOINC is primary make NLT alternate, otherwise NLT primary.
  1.  ; Only on non-HDR type interfaces.
  1.  I LA7NLT'="",LA7INTYP'=30,LA7J<9 D
  1.  . N LA7642,LA7Z
  1.  . S LA764=$O(^LAM("E",LA7NLT,0)),LA7Z=""
  1.  . I LA764 S LA7Z=$$GET1^DIQ(64,LA764_",",.01,"I")
  1.  . I LA7Z="" D
  1.  . . S LA764=$O(^LAM("E",$P(LA7NLT,".")_".0000",0))
  1.  . . I LA764 S LA7Z=$$GET1^DIQ(64,LA764_",",.01,"I")
  1.  . . S LA7642=$O(^LAB(64.2,"C","."_$P(LA7NLT,".",2),0))
  1.  . . I LA764,LA7642 S LA7Z=LA7Z_"~"_$$GET1^DIQ(64.2,LA7642_",",.01,"I")
  1.  . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
  1.  . S $P(LA7Y,$E(LA7ECH,1),LA7J)=LA7NLT
  1.  . S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=LA7Z
  1.  . S $P(LA7Y,$E(LA7ECH,1),LA7J+2)="L"
  1.  . S LA7Z=$$GET1^DID(64,"","","PACKAGE REVISION DATA")
  1.  . S $P(LA7Y,$E(LA7ECH,1),$S(LA7J=1:7,1:8))=LA7Z
  1.  . S LA7J=LA7J+3
  1.  ;
  1.  ; Non-standard/non-VA code
  1.  ; If alternate is a non-VA code then use as alternate code.
  1.  I LA7ALT="" Q
  1.  I LA7INTYP'=30,$P(LA7ALT,"^",3)'="99VA63",LA7J>4 S LA7J=4
  1.  I LA7J<7 D
  1.  . S $P(LA7Y,$E(LA7ECH,1),LA7J)=$$CHKDATA^LA7VHLU3($P(LA7ALT,"^"),LA7FS_LA7ECH)
  1.  . S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=$$CHKDATA^LA7VHLU3($P(LA7ALT,"^",2),LA7FS_LA7ECH)
  1.  . S $P(LA7Y,$E(LA7ECH,1),LA7J+2)=$$CHKDATA^LA7VHLU3($P(LA7ALT,"^",3),LA7FS_LA7ECH)
  1.  . I $P(LA7ALT,"^",3)="99VA63" S $P(LA7Y,$E(LA7ECH,1),$S(LA7J=1:7,1:8))="5.2"
  1.  ;
  1.  ; Put local test name in local text (9th component)
  1.  I $E($P(LA7ALT,"^",6),1,5)="99VA6",$P(LA7ALT,"^",6)'="99VA64" D
  1.  . N I,LA7Z
  1.  . S LA7Z=$$TRIM^XLFSTR($P(LA7ALT,"^",5),"LR"," ")
  1.  . I LA7Z="" Q
  1.  . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
  1.  . S $P(LA7Y,$E(LA7ECH,1),9)=LA7Z
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. OBX5 ; Build OBX-5 sequence - Observation value
  1.  ; Removes trailing spaces on string and text results.
  1.  ; Removes leading & trailing spaces on numeric results.
  1.  ;
  1.  S LA7Y=""
  1.  ;
  1.  I $G(LA7OBX2)="" S LA7OBX2="ST" ; default value type
  1.  I LA7OBX2="ST"!(LA7OBX2="TX") D
  1.  . S LA7VAL=$$TRIM^XLFSTR(LA7VAL,"R"," ")
  1.  . S LA7Y=$$CHKDATA^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
  1.  ;I LA7OBX2="SN" S LA7Y=$$TRIM^XLFSTR(LA7VAL,"RL"," ")  ;MU2
  1.  I LA7OBX2="TS" D
  1.  . S LA7VAL=$$CHKDT^LA7VHLU1(LA7VAL)
  1.  . S LA7Y=$$FMTHL7^XLFDT(LA7VAL)
  1.  I LA7OBX2?1(1"CE",1"CNE",1"CWE") D
  1.  . N LA7I,LA7J,X
  1.  . S LA7J=$S(LA7OBX2="CE":6,1:9)
  1.  . F LA7I=1:1:LA7J I $P(LA7VAL,"^",LA7I)'="" S $P(LA7Y,$E(LA7ECH),LA7I)=$$CHKDATA^LA7VHLU3($P(LA7VAL,"^",LA7I),LA7FS_LA7ECH)
  1.  I LA7OBX2="SN" D  ;mu2
  1.  . N LA7I
  1.  . S $P(LA7Y,$E(LA7ECH))="="
  1.  . S $P(LA7Y,$E(LA7ECH),2)=LA7VAL
  1.  . I $E(LA7VAL)="<" D
  1.  .. S $P(LA7Y,$E(LA7ECH))="<"
  1.  .. S $P(LA7Y,$E(LA7ECH),2)=$P(LA7VAL,"<",2)
  1.  . I $E(LA7VAL,1,2)="<=" D
  1.  .. S $P(LA7Y,$E(LA7ECH))="<="
  1.  .. S $P(LA7Y,$E(LA7ECH),2)=$P(LA7VAL,"<=",2)
  1.  . I $E(LA7VAL)=">" D
  1.  .. S $P(LA7Y,$E(LA7ECH))=">"
  1.  .. S $P(LA7Y,$E(LA7ECH),2)=$P(LA7VAL,">",2)
  1.  . ;S $P(LA7Y,$E(LA7ECH))=$S($E(LA7VAL)="<":"<=",$E(LA7VAL)=">":">=",1:"=")
  1.  . ;S $P(LA7Y,$E(LA7ECH),2)=$S($E(LA7VAL)="<":$P(LA7VAL,"<",2),$E(LA7VAL)=">":$P(LA7VAL,">",2),1:LA7VAL)
  1.  . I LA7Y[":" D
  1.  .. N LA7Z
  1.  .. S LA7Z=$P(LA7Y,$E(LA7ECH),2)
  1.  .. S $P(LA7Y,$E(LA7ECH))=""
  1.  .. S $P(LA7Y,$E(LA7ECH),2)=$P(LA7Z,":")
  1.  .. S $P(LA7Y,$E(LA7ECH),3)=":"
  1.  .. S $P(LA7Y,$E(LA7ECH),4)=$P(LA7Z,":",2)
  1.  . I $P(LA7Y," ")["/" D
  1.  .. N LA7Z
  1.  .. S LA7Z=$P(LA7Y,$E(LA7ECH),2)
  1.  .. S $P(LA7Y,$E(LA7ECH))="="
  1.  .. S $P(LA7Y,$E(LA7ECH),2)=$P(LA7Z,"/")
  1.  .. S $P(LA7Y,$E(LA7ECH),3)="/"
  1.  .. S $P(LA7Y,$E(LA7ECH),4)=$P($P(LA7Z,"/",2)," ")_" "_$P(LA7Z," ",2)
  1.  . ;F LA7I=1:1:9 I $P(LA7VAL,"^",LA7I)'="" S $P(LA7Y,$E(LA7ECH),LA7I)=$$CHKDATA^LA7VHLU3($P(LA7VAL,"^",LA7I),LA7FS_LA7ECH)
  1.  I LA7OBX2="NM" S LA7Y=LA7VAL
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. OBX5M ; Build OBX-5 sequence - Observation value - multi-line textual result
  1.  ;
  1.  K LA7WP
  1.  ;
  1.  S LA7WP=""
  1.  S LA7TYPE=$$GET1^DID(LA7FN,LA7FLD,"","TYPE","LA7ERR(1)")
  1.  ;
  1.  ; Process word-processing type field.
  1.  ; Check and encode data
  1.  I LA7TYPE="WORD-PROCESSING" D  Q
  1.  . N DIWF,DIWL,DIWR,X
  1.  . S LA7WP=$$GET1^DIQ(LA7FN,LA7IENS,LA7FLD,"","LA7WP","LA7ERR(2)")
  1.  . K ^UTILITY($J,"W")
  1.  . S DIWL=1,DIWR=245,DIWF="",LA7I=0
  1.  . I $$GET1^DID(+$$GET1^DID(LA7FN,LA7FLD,"","SPECIFIER","LA7ERR(1)"),.01,"","SPECIFIER","LA7ERR(3)")["L" S DIWF="N"
  1.  . F  S LA7I=$O(LA7WP(LA7I)) Q:'LA7I  S X=LA7WP(LA7I) D ^DIWP
  1.  . K LA7WP
  1.  . S LA7I=0
  1.  . F  S LA7I=$O(^UTILITY($J,"W",DIWL,LA7I)) Q:'LA7I  D
  1.  . . S LA7WP(LA7I)=$$CHKDATA^LA7VHLU3(^UTILITY($J,"W",DIWL,LA7I,0),LA7FS_LA7ECH)
  1.  . . I LA7I>1 S LA7WP(LA7I)=$E(LA7ECH,3)_".br"_$E(LA7ECH,3)_LA7WP(LA7I)
  1.  . K ^UTILITY($J,"W")
  1.  ;
  1.  ; Free text, assumes multiple valued
  1.  I LA7TYPE="FREE TEXT" D
  1.  . D GETS^DIQ(LA7FN,LA7IENS,LA7FLD_"*","","LA7WP","LA7ERR")
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. OBX5R ; Build OBX-5 sequence with repetition - Observation value
  1.  ;
  1.  S (LA7I,LA7Y)=""
  1.  F  S LA7I=$O(LA7VAL(LA7I)) Q:'LA7I  D
  1.  . S LA7Y=LA7Y_$$OBX5^LA7VOBX(LA7VAL(LA7I),LA7OBX2,LA7FS,LA7ECH)_$E(LA7ECH,2)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. OBX6 ; Build OBX-6 sequence - Units
  1.  ;
  1.  S LA7ECH=$G(LA7ECH),LA7Y=""
  1.  ;
  1.  ; Units - remove leading and trailing spaces
  1.  ; If HDR interface (LA7INTYP=30) then add coding system (L) to units.
  1.  I $G(LA7VAL)'="" D
  1.  . S LA7Y=$$TRIM^XLFSTR(LA7VAL,"LR"," ")
  1.  . I $G(LA7INTYP)=30 D
  1.  . . S $P(LA7Y,$E(LA7ECH,1),2)=LA7Y
  1.  . . S $P(LA7Y,$E(LA7ECH,1),3)="L"
  1.  ;
  1.  ; Build sequence using LOINC codes only
  1.  ; LOINC code/code name/"LN"
  1.  I $G(LA764061) D
  1.  . N LA7IENS,LA7X,LA7Z
  1.  . S LA7IENS=LA764061_","
  1.  . D GETS^DIQ(64.061,LA7IENS,"1;8","E","LA7X")
  1.  . ; LOINC code
  1.  . S LA7Z=$G(LA7X(64.061,LA7IENS,1,"E"))
  1.  . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
  1.  . S $P(LA7Y,$E(LA7ECH,1),1)=LA7Z
  1.  . ; LOINC code name
  1.  . S LA7Z=$G(LA7X(64.061,LA7IENS,8,"E"))
  1.  . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
  1.  . S $P(LA7Y,$E(LA7ECH,1),2)=LA7Z
  1.  . S $P(LA7Y,$E(LA7ECH,1),3)="LN"
  1.  ;
  1.  S $P(LA7Y,$E(LA7ECH,1),2)=LA7VAL
  1.  S $P(LA7Y,$E(LA7ECH,1),3)="UCUM"
  1.  S $P(LA7Y,$E(LA7ECH,1),4)=LA7VAL
  1.  S $P(LA7Y,$E(LA7ECH,1),5)=LA7VAL
  1.  S $P(LA7Y,$E(LA7ECH,1),6)="L"
  1.  S $P(LA7Y,$E(LA7ECH,1),7)="1.1"
  1.  S $P(LA7Y,$E(LA7ECH,1),8)="1.0"
  1.  Q
  1.  ;
  1.  ;
  1. OBX7 ; Build OBX-7 sequence - Reference range
  1.  ; Removes leading and trailing quote marks ("").
  1.  ;
  1.  S LA7Y=""
  1.  ;
  1.  I $G(LA7LOW)'="" D
  1.  . S LA7LOW=$$TRIM^XLFSTR(LA7LOW,"RL","""")
  1.  . I LA7LOW?1A.E S LA7Y=LA7Y_LA7LOW Q  ; alphabetic value
  1.  . I $G(LA7HIGH)="",$E(LA7LOW)'=">" S LA7Y=">"
  1.  . S LA7Y=LA7Y_LA7LOW
  1.  ;
  1.  I $G(LA7HIGH)'="" D
  1.  . S LA7HIGH=$$TRIM^XLFSTR(LA7HIGH,"RL","""")
  1.  . I LA7HIGH?1A.E S LA7Y=LA7Y_LA7HIGH Q  ; alphabetic value
  1.  . I $G(LA7LOW)="" D  Q
  1.  . . I $E(LA7HIGH)'="<" S LA7Y="<"
  1.  . . S LA7Y=LA7Y_LA7HIGH
  1.  . S LA7Y=LA7Y_"-"_LA7HIGH
  1.  ;
  1.  S LA7Y=$$CHKDATA^LA7VHLU3(LA7Y,LA7FS_LA7ECH)_" "_$P($P(LA7VAL,U,5),"!",7)  ;mu2 added units to the end
  1.  I $G(LA7INPT) S LA7Y=$E(LA7Y,1,60)  ;mu2 inpatient
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. OBX17 ; Build OBX-17 sequence - Observation method field
  1.  ;
  1.  ; method suffix code maybe stored without leading decimal,
  1.  ;  add "." back for lookup, also add trailing space for lookup in x-ref.
  1.  I LA7VAL>1 S LA7VAL="."_LA7VAL
  1.  S LA7X=$O(^LAB(64.2,"C",LA7VAL_" ",0)),LA7Y=""
  1.  I LA7X D
  1.  . S LA7X(.01)=$P($G(^LAB(64.2,LA7X,0)),"^")
  1.  . S LA7X(.01)=$$CHKDATA^LA7VHLU3(LA7X(.01),LA7FS_LA7ECH)
  1.  . S LA7Y=LA7VAL_$E(LA7ECH)_LA7X(.01)_$E(LA7ECH)_"OBSMETHOD"
  1.  . ;S LA7X=$$GET1^DID(64.2,"","","PACKAGE REVISION DATA")
  1.  . ;S $P(LA7Y,$E(LA7ECH,1),7)=LA7X
  1.  ;
  1.  ; Send NLT result code
  1.  I LA7NLT'="" D
  1.  . S LA764=$O(^LAM("E",LA7NLT,0)),LA7Z=""
  1.  . I LA764 S LA7X=$P($G(^LAM(LA764,0)),"^")
  1.  . S LA7X=$$CHKDATA^LA7VHLU3(LA7X,LA7FS_LA7ECH)
  1.  . S $P(LA7Z,$E(LA7ECH,1),1)=LA7NLT
  1.  . S $P(LA7Z,$E(LA7ECH,1),2)=LA7X
  1.  . S $P(LA7Z,$E(LA7ECH,1),3)="L"
  1.  . ;S LA7X=$$GET1^DID(64,"","","PACKAGE REVISION DATA")
  1.  . ;S $P(LA7Z,$E(LA7ECH,1),7)=LA7X
  1.  . I LA7Y'="" S LA7Y=LA7Y_$E(LA7ECH)
  1.  . S LA7Y=LA7Y_LA7Z
  1.  . S $P(LA7Y,$E(LA7ECH),7)=20090501
  1.  . S $P(LA7Y,$E(LA7ECH),8)=LA7VER
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. OBX18 ; Build OBX-18 sequence - Equipment entity identifier field
  1.  ;
  1.  S LA7X="",LA7J=$L(LA7VAL,"!")
  1.  F LA7I=1:1:LA7J D
  1.  . S LA7Y=$P(LA7VAL,"!",LA7I)
  1.  . I LA7Y="" Q
  1.  . S $P(LA7X,$E(LA7ECH,1),LA7I)=$$CHKDATA^LA7VHLU3(LA7Y,LA7FS_LA7ECH)
  1.  ;
  1.  Q