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

LA7VOBX1.m

Go to the documentation of this file. 
  1. LA7VOBX1 ;VA/DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd ; 13-Aug-2013 09:09 ; MKK
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63,1018,64,1027,72,1031,68,1033**;NOV 1, 1997
  1.  ;
  1. CH ; Observation/Result segment for "CH" subscript results.
  1.  ; Called by LA7VOBX
  1.  ;
  1.  N LA760,LA76304,LA7ALT,LA7DDERR,LA7DIV,LA7I,LA7RS,LA7X,LA7Y,X
  1.  ;
  1.  ; "CH" subscript requires a dataname
  1.  I '$G(LRSB) Q
  1.  ;
  1.  ; get result node from LR global.
  1.  S LA76304(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
  1.  S LA7RS=$P(LRSB,"^",2),LRSB=$P(LRSB,"^")
  1.  S LA7VAL=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
  1.  ; If previous results have been corrected then send corrected status
  1.  I LA7RS="",$P(LA7VAL,"^",10)=2 S LA7RS="C"
  1.  ;
  1.  ; Check if test is OK to send - (O)utput or (B)oth
  1.  S LA7X=$P(LA7VAL,"^",12)
  1.  I LA7X]"","BO"'[LA7X Q
  1.  I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",7)) Q
  1.  ;
  1.  ; If no result NLT or LOINC try to determine from file #60
  1.  S LA7X=$P(LA7VAL,"^",3)
  1.  I $P(LA7X,"!",2)=""!($P(LA7X,"!",3)="") S $P(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$P(LA76304(0),"^",5))
  1.  ; No result NLT code - log error
  1.  I $P($P(LA7VAL,"^",3),"!",2)="" D
  1.  . N LA7X
  1.  . S LA7X="["_LRSB_"]"_$$GET1^DID(63.04,LRSB,"","LABEL")
  1.  . D CREATE^LA7LOG(36)
  1.  ;
  1.  ; something missing - No result.
  1.  I $P(LA7VAL,"^")="" Q
  1.  ;
  1.  ; Check for missing units/reference ranges
  1.  D CHECK
  1.  ;
  1.  ; Initialize OBX segment
  1.  S LA7OBX(0)="OBX"
  1.  S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
  1.  ;
  1.  ; Value type
  1.  ; If result is "cancel", "comment" or "pending" then data type is ST - string data
  1.  S LA7X=$S("canccommentpending"[$P(LA7VAL,"^"):1,1:0)
  1.  I LA7X,LA7INTYP'=30 S LA7OBX(2)="ST"
  1.  E  S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB)
  1.  I LA7OBX(2)'="NM",$P(LA7VAL,"^")?1(1.N,.N1"."1.N) S LA7OBX(2)="NM"
  1.  ;
  1.  ; Observation identifer
  1.  ; build alternate code based on dataname from file #63 in case it's needed
  1.  S LA7X=$P(LA7VAL,"^",3)
  1.  S LA7ALT="CH"_LRSB_"^"_$$GET1^DID(63.04,LRSB,"","LABEL")_"^99VA63"
  1.  I $P(LA7X,"!",7) S LA760=$P(LA7X,"!",7)
  1.  E  S LA760=+$O(^LAB(60,"C","CH;"_LRSB_";1",0))
  1.  I LA760 S $P(LA7ALT,"^",4,6)=LA760_"^"_$P(^LAB(60,LA760,0),"^")_"^99VA60"
  1.  S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH,$G(LA7INTYP))
  1.  ;
  1.  ; Build sub-id to aid in linking updates to previous transmissions.
  1.  S LA7OBX(4)=$$OBX4^LA7VOBX("CH"_LRSB,LA7FS,LA7ECH)
  1.  ;
  1.  ; Test value
  1.  ; If DoD and "canc" then report "PL Cancelled" per Lab Interop ICD.
  1.  S LA7X=$P(LA7VAL,"^") K LA7DDERR
  1.  I LA7X'="canc",$$GET1^DID(63.04,LRSB,"","TYPE","","LA7DDERR")="SET" D
  1.  . S LA7X=$$EXTERNAL^DILFD(63.04,LRSB,"",LA7X)
  1.  . I LA7X="" S LA7X=$P(LA7VAL,"^")
  1.  I $G(LA7NVAF)=1,LA7X="canc" S LA7X="PL Cancelled"
  1.  S LA7OBX(5)=$$OBX5^LA7VOBX(LA7X,LA7OBX(2),LA7FS,LA7ECH)
  1.  ; Log exception when data dictionary appears corrupt.
  1.  I $D(LA7DDERR) D CREATE^LA7LOG(121) K LA7DDERR
  1.  ;
  1.  ; Suppress "pending" results when sending to HDR
  1.  I LA7INTYP=30,$P(LA7VAL,"^")="pending" S LA7OBX(2)="",LA7OBX(5)=""
  1.  ;
  1.  ; Units
  1.  S LA7X=$P(LA7VAL,"^",5)
  1.  S LA7OBX(6)=$$OBX6^LA7VOBX($P(LA7X,"!",7),"",LA7FS,LA7ECH,$G(LA7INTYP))
  1.  ;
  1.  ; Reference range - use therapeutic low/high if present.
  1.  K LA7Y
  1.  I $P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
  1.  . S LA7Y("LOW")=$P(LA7X,"!",2)
  1.  . S LA7Y("HIGH")=$P(LA7X,"!",3)
  1.  E  D
  1.  . S LA7Y("LOW")=$P(LA7X,"!",11)
  1.  . S LA7Y("HIGH")=$P(LA7X,"!",12)
  1.  ;
  1.  S LA7OBX(7)=$$OBX7^LA7VOBX(LA7Y("LOW"),LA7Y("HIGH"),LA7FS,LA7ECH)
  1.  K LA7Y
  1.  ;
  1.  ; Abnormal flags
  1.  S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,"^",2))
  1.  ;
  1.  ; "P"artial or "F"inal results
  1.  S LA7X=$S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F")
  1.  I LA7RS="C" D
  1.  . S LA7X=LA7RS
  1.  . I LA7INTYP=30,$P(LA7VAL,"^")="pending" S LA7X="W",LA7OBX(5)=""""""
  1.  S LA7OBX(11)=$$OBX11^LA7VOBX(LA7X)
  1.  I LA7INTYP=30,$P(LA7VAL,"^")="canc",LA7OBX(11)="X" S LA7OBX(2)="",LA7OBX(5)=""
  1.  ;
  1.  ; Observation date/time - collection date/time per HL7 standard
  1.  S LA7X=$P(LA76304(0),"^") S:$P(LA76304(0),"^",2) LA7X=$P(LA7X,".")
  1.  I LA7X S LA7OBX(14)=$$OBX14^LA7VOBX(LA7X)
  1.  ;
  1.  S LA7DIV=$P(LA7VAL,"^",9)
  1.  I LA7DIV="" S LA7DIV=$P($G(^LR(LRDFN,LRSS,LRIDT,"RF")),"^")
  1.  I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA7VAL,"^",4)) S LA7DIV=$O(LA7DIV(0))
  1.  ;
  1.  ; Facility that performed the testing
  1.  S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
  1.  ;
  1.  ; Person that verified the test
  1.  S LA7OBX(16)=$$OBX16^LA7VOBX($P(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH)
  1.  ;
  1.  ; Observation method - workkload suffix (LA7X) and result NLT code (LA7Y)
  1.  S LA7X=$P($P(LA7VAL,"^",3),"!",4),LA7Y=$P($P(LA7VAL,"^",3),"!",2)
  1.  I LA7X'=""!(LA7Y="") S LA7OBX(17)=$$OBX17^LA7VOBX(LA7X,LA7Y,LA7FS,LA7ECH)
  1.  ;
  1.  ; Equipment entity identifier
  1.  I $P(LA7VAL,"^",11)'="" S LA7OBX(18)=$$OBX18^LA7VOBX($P(LA7VAL,"^",11),LA7FS,LA7ECH)
  1.  ;
  1.  ; Date/time of the analysis
  1.  I $P(LA7VAL,"^",6)'="" S LA7OBX(19)=$$OBX19^LA7VOBX($P(LA7VAL,"^",6))
  1.  ;
  1.  ; Performing organization name/address
  1.  I LA7DIV'="" D
  1.  . N LA7DT
  1.  . S LA7OBX(23)=$$OBX23^LA7VOBX(4,LA7DIV,LA7FS,LA7ECH)
  1.  . S LA7DT=$S($P(LA7VAL,"^",6):$P(LA7VAL,"^",6),$P(LA76304(0),"^",3):$P(LA76304(0),"^",3),1:$$NOW^XLFDT)
  1.  . S LA7OBX(24)=$$OBX24^LA7VOBX(4,LA7DIV,LA7DT,LA7FS,LA7ECH)
  1.  ;
  1.  D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. CHECK ; Check for missing units/reference ranges
  1.  ;
  1.  N LA7I,LA7X,LA7FLAG
  1.  S LA7X=$P(LA7VAL,"^",5)
  1.  ;
  1.  ; If flag (NPC>1) indicates units/ranges are stored but pieces 5-9 are null then use values from file #60
  1.  ; - some class III software still does not store this info in file #63 when NPC>1
  1.  S LA7FLAG=0
  1.  I $G(^LR(LRDFN,LRSS,LRIDT,"NPC"))>1 D
  1.  . F LA7I=5:1:9 I $P(LA7VAL,"^",LA7I)'="" S LA7FLAG=1 Q
  1.  I 'LA7FLAG D BUNR
  1.  ;
  1.  ; Evaluate low/high reference ranges in case M code in these fields.
  1.  S:$G(SEX)="" SEX="M" S:$G(AGE)="" AGE=99
  1.  F LA7I=2,3,11,12 I $E($P(LA7X,"!",LA7I),1,3)="$S(" D
  1.  . S @("X="_$P(LA7X,"!",LA7I))
  1.  . S $P(LA7X,"!",LA7I)=X
  1.  ;
  1.  ; Put units/reference ranges back in variable LA7VAL
  1.  S $P(LA7VAL,"^",5)=LA7X
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. BUNR ; Build units/normal ranges from file #60
  1.  ;
  1.  N LA7Y
  1.  S LA7Y=$$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5))
  1.  ;
  1.  ; Results missing units, use value from file #60
  1.  I $P(LA7X,"!",7)="" S $P(LA7X,"!",7)=$P(LA7Y,"^",3)
  1.  ;
  1.  ; If results missing reference ranges, use values from file #60.
  1.  I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="",$P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
  1.  . I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="" D
  1.  . . S $P(LA7X,"!",2)=$P(LA7Y,"^")
  1.  . . S $P(LA7X,"!",3)=$P(LA7Y,"^",2)
  1.  . I $P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
  1.  . . S $P(LA7X,"!",11)=$P(LA7Y,"^",6)
  1.  . . S $P(LA7X,"!",12)=$P(LA7Y,"^",7)
  1.  Q