| [613] | 1 | LA7VIN5 ;DALOI/JMC - Process Incoming UI Msgs, continued ; 01/14/99
 | 
|---|
 | 2 |  ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
 | 
|---|
 | 3 |  ; This routine is a continuation of LA7VIN1 and is only called from there.
 | 
|---|
 | 4 |  ; It is called to process OBX segments for "CH" subscript tests.
 | 
|---|
 | 5 |  Q
 | 
|---|
 | 6 |  ;
 | 
|---|
 | 7 | OBX ;
 | 
|---|
 | 8 |  ;
 | 
|---|
 | 9 |  N LA76241,LA76304,LA7EII,LA7I,LA7LIMIT,LA7OBM,LA7SUBFL,LA7TEST,LA7TREEN,LA7UNITS,LA7VAL,LA7VTYP,LA7X,LA7XFORM,LA7Y
 | 
|---|
 | 10 |  ;
 | 
|---|
 | 11 |  K LA7RMK,^TMP("LA7TREE",$J)
 | 
|---|
 | 12 |  ;
 | 
|---|
 | 13 |  S LA7SUBFL=63.04
 | 
|---|
 | 14 |  ;
 | 
|---|
 | 15 |  ; OBX Set ID
 | 
|---|
 | 16 |  S LA7SOBX=$$P^LA7VHLU(.LA7SEG,2,LA7FS)
 | 
|---|
 | 17 |  ;
 | 
|---|
 | 18 |  ; Value type - type of data from Table 0125
 | 
|---|
 | 19 |  S LA7VTYP=$P($$P^LA7VHLU(.LA7SEG,3,LA7FS),LA7CS)
 | 
|---|
 | 20 |  ;
 | 
|---|
 | 21 |  ; Determine test result codes - check for primary and alternate codes
 | 
|---|
 | 22 |  ; For DoD/CHCS interface - do NOT process test codes using 99LRT as coding system per DoD/July 2002.
 | 
|---|
 | 23 |  S LA7X=$$P^LA7VHLU(.LA7SEG,4,LA7FS),(LA7RNLT,LA7RLNC)=""
 | 
|---|
 | 24 |  S LA7TEST=$P(LA7X,LA7CS)
 | 
|---|
 | 25 |  S LA7TEST(0)=$$UNESC^LA7VHLU3($P(LA7X,LA7CS,2),LA7FS_LA7ECH)
 | 
|---|
 | 26 |  I LA7TEST(0)["^" S LA7TEST(0)=$TR(LA7TEST(0),"^","~")
 | 
|---|
 | 27 |  S LA7TEST(0,1)=$P(LA7X,LA7CS,3)
 | 
|---|
 | 28 |  S LA7TEST(2)=$P(LA7X,LA7CS,4)
 | 
|---|
 | 29 |  S LA7TEST(2,0)=$$UNESC^LA7VHLU3($P(LA7X,LA7CS,5),LA7FS_LA7ECH)
 | 
|---|
 | 30 |  I LA7TEST(2,0)["^" S LA7TEST(2,0)=$TR(LA7TEST(2,0),"^","~")
 | 
|---|
 | 31 |  S LA7TEST(2,1)=$P(LA7X,LA7CS,6)
 | 
|---|
 | 32 |  F I=3,6 D
 | 
|---|
 | 33 |  . S LA7Y=$P(LA7X,LA7CS,I-2)
 | 
|---|
 | 34 |  . I $P(LA7X,LA7CS,I)="LN" D  Q
 | 
|---|
 | 35 |  . . I $$GET1^DIQ(95.3,+LA7Y_",",.01)=LA7Y S LA7RLNC=+LA7Y
 | 
|---|
 | 36 |  . I $P(LA7X,LA7CS,I)="99VA64" D  Q
 | 
|---|
 | 37 |  . . I $$FIND1^DIC(64,"","OMX",LA7Y) S LA7RNLT=LA7Y
 | 
|---|
 | 38 |  . I $P(LA7X,LA7CS,I)="99LRT" D  Q
 | 
|---|
 | 39 |  . . I LA7TEST(0)="",LA7TEST(2,0)'="" S LA7TEST(0)=LA7TEST(2,0)
 | 
|---|
 | 40 |  . . I LA7TEST(2,0)="",LA7TEST(0)'="" S LA7TEST(2,0)=LA7TEST(0)
 | 
|---|
 | 41 |  . . I I=3 S (LA7TEST,LA7TEST(0),LA7TEST(0,1))="" Q
 | 
|---|
 | 42 |  . . I I=6 S (LA7TEST(2),LA7TEST(2,0),LA7TEST(2,1))="" Q
 | 
|---|
 | 43 |  I LA7TEST="",LA7TEST(2)'="" D
 | 
|---|
 | 44 |  . S LA7TEST=LA7TEST(2),LA7TEST(0)=LA7TEST(2,0),LA7TEST(0,1)=LA7TEST(2,1)
 | 
|---|
 | 45 |  . S (LA7TEST(2),LA7TEST(2,0),LA7TEST(2,1))=""
 | 
|---|
 | 46 |  ;
 | 
|---|
 | 47 |  ; No test code in message
 | 
|---|
 | 48 |  I LA7TEST="",LA7TEST(2)="" D  Q
 | 
|---|
 | 49 |  . N LA7OBX
 | 
|---|
 | 50 |  . S LA7OBX=LA7SEG(0)
 | 
|---|
 | 51 |  . D CREATE^LA7LOG(15)
 | 
|---|
 | 52 |  ;
 | 
|---|
 | 53 |  ; Test code not found in auto inst file, also check alternate codes,
 | 
|---|
 | 54 |  ; and log error if none found.
 | 
|---|
 | 55 |  I LA7MTYP="ORU" D  Q:LA7TEST=""
 | 
|---|
 | 56 |  . I LA7TEST'="",$D(^LAB(62.4,LA7624,3,"AC",LA7TEST)) Q
 | 
|---|
 | 57 |  . I LA7TEST(2)'="",$D(^LAB(62.4,LA7624,3,"AC",LA7TEST(2))) D  Q
 | 
|---|
 | 58 |  . . S LA7TEST=LA7TEST(2),LA7TEST(0)=LA7TEST(2,0),LA7TEST(0,1)=LA7TEST(2,1)
 | 
|---|
 | 59 |  . D CREATE^LA7LOG(16) S LA7TEST=""
 | 
|---|
 | 60 |  ;
 | 
|---|
 | 61 |  ; Units - trim leading/trailing spaces
 | 
|---|
 | 62 |  S LA7UNITS=$$P^LA7VHLU(.LA7SEG,7,LA7FS)
 | 
|---|
 | 63 |  I LA7UNITS]"" S LA7UNITS=$$TRIM^XLFSTR(LA7UNITS,"LR"," ")
 | 
|---|
 | 64 |  ;
 | 
|---|
 | 65 |  ; Observation result status - Table 0085
 | 
|---|
 | 66 |  S LA7ORS=$$P^LA7VHLU(.LA7SEG,12,LA7FS)
 | 
|---|
 | 67 |  ;
 | 
|---|
 | 68 |  ; Responsible observer
 | 
|---|
 | 69 |  S LA7RO=$$XCNTFM^LA7VHLU4($$P^LA7VHLU(.LA7SEG,17,LA7FS),LA7ECH)
 | 
|---|
 | 70 |  ;
 | 
|---|
 | 71 |  ; Observation method
 | 
|---|
 | 72 |  S LA7X=$$P^LA7VHLU(.LA7SEG,18,LA7FS),LA7OBM=""
 | 
|---|
 | 73 |  I $P(LA7X,LA7CS,3)="99VA64_2" S LA7OBM=$P($P(LA7X,LA7CS,1),".",2)
 | 
|---|
 | 74 |  ;
 | 
|---|
 | 75 |  ; Equipment instance identifier
 | 
|---|
 | 76 |  S LA7EII=$$P^LA7VHLU(.LA7SEG,19,LA7FS)
 | 
|---|
 | 77 |  I LA7EII'="" D
 | 
|---|
 | 78 |  . S LA7EII=$$UNESC^LA7VHLU3(LA7EII,LA7FS_LA7ECH)
 | 
|---|
 | 79 |  . S LA7EII=$TR(LA7EII,"^",";")
 | 
|---|
 | 80 |  ;
 | 
|---|
 | 81 |  ; Process ORU message results for all tests which use this test code.
 | 
|---|
 | 82 |  I LA7MTYP="ORU" D  Q
 | 
|---|
 | 83 |  . S LA76241=0
 | 
|---|
 | 84 |  . F  S LA76241=$O(^LAB(62.4,LA7624,3,"AC",LA7TEST,LA76241)) Q:'LA76241  D PROCESS
 | 
|---|
 | 85 |  ;
 | 
|---|
 | 86 |  I LA7MTYP="ORM",$G(LA7696)>0 D ORESULTS^LA7VIN5A
 | 
|---|
 | 87 |  ;
 | 
|---|
 | 88 |  Q
 | 
|---|
 | 89 |  ;
 | 
|---|
 | 90 |  ;
 | 
|---|
 | 91 | PROCESS ; Process results for a given test code
 | 
|---|
 | 92 |  S LA7VAL=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
 | 
|---|
 | 93 |  I LA7VTYP="CE",$P(LA7VAL,LA7CS,2)'="" S LA7VAL=$P(LA7VAL,LA7CS,2)
 | 
|---|
 | 94 |  E  S LA7VAL=$P(LA7VAL,LA7CS)
 | 
|---|
 | 95 |  ;
 | 
|---|
 | 96 |  F LA7I=0,1,2 S LA76241(LA7I)=$G(^LAB(62.4,LA7624,3,LA76241,LA7I))
 | 
|---|
 | 97 |  ;
 | 
|---|
 | 98 |  ; Chem test fields incorrect
 | 
|---|
 | 99 |  I (LA76241(0)="")!(LA76241(1)="") D  Q
 | 
|---|
 | 100 |  . D CREATE^LA7LOG(18)
 | 
|---|
 | 101 |  ;
 | 
|---|
 | 102 |  ; Setup LA7RMK(0) variable in case comments (NTE) sent with test results.
 | 
|---|
 | 103 |  S LA7RMK(0,+LA76241(0))=+$P(LA76241(2),"^",7)_"^"_$P(LA76241(2),"^",8)
 | 
|---|
 | 104 |  ;
 | 
|---|
 | 105 |  S LA76304=+$P(LA76241(1),"(",2) ;lab data field
 | 
|---|
 | 106 |  ; No dataname for this result
 | 
|---|
 | 107 |  I LA76304'>1 D  Q
 | 
|---|
 | 108 |  . D CREATE^LA7LOG(18)
 | 
|---|
 | 109 |  ;
 | 
|---|
 | 110 |  ; Set flag for new results alert
 | 
|---|
 | 111 |  I "CDW"'[LA7ORS S ^TMP("LA7-ORU",$J,LA76248,LA76249)=""
 | 
|---|
 | 112 |  ;
 | 
|---|
 | 113 |  ; Set flag to send amended results bulletin
 | 
|---|
 | 114 |  I "CDW"[LA7ORS D
 | 
|---|
 | 115 |  . S LA7I=$O(^TMP("LA7 AMENDED RESULTS",$J,""),-1),LA7I=LA7I+1
 | 
|---|
 | 116 |  . S X=LA7LWL_"^"_LA7ISQN_"^"_LA76304_"^"_LA76248_"^"_LA76249_"^"_LA7ORS_"^"_LA7TEST_"^"_$S(LA7TEST(0)'="":LA7TEST(0),1:LA7TEST(2,0))_"^"_$$P^LA7VHLU(.LA7SEG,9,LA7FS)
 | 
|---|
 | 117 |  . S ^TMP("LA7 AMENDED RESULTS",$J,LA7I)=X
 | 
|---|
 | 118 |  . I LA7UID'="" S ^LAH("LA7 AMENDED RESULTS",LA7UID,LA76304,LA7LWL,LA7ISQN)=X
 | 
|---|
 | 119 |  ;
 | 
|---|
 | 120 |  ; NOTE - this array can be set from inside PARAM 1
 | 
|---|
 | 121 |  K LA7XFORM
 | 
|---|
 | 122 |  ; execute PARAM 1 if not a LEDI interface
 | 
|---|
 | 123 |  I LA7INTYP'=10 X $P(LA76241(0),"^",2)
 | 
|---|
 | 124 |  I $P(LA76241(2),"^",3)=0 Q
 | 
|---|
 | 125 |  I $P(LA76241(2),"^",3)=2,"CFUX"'[LA7ORS Q
 | 
|---|
 | 126 |  ;
 | 
|---|
 | 127 |  ; No value found
 | 
|---|
 | 128 |  I LA7VAL="" D  Q
 | 
|---|
 | 129 |  . D CREATE^LA7LOG(17)
 | 
|---|
 | 130 |  ;
 | 
|---|
 | 131 |  ; Transform result based on fields in file 62.4
 | 
|---|
 | 132 |  D XFORM^LA7VIN5A
 | 
|---|
 | 133 |  Q:LA7VAL=""
 | 
|---|
 | 134 |  ;
 | 
|---|
 | 135 |  ; Check if result passes input transform on data name
 | 
|---|
 | 136 |  D CHKDIE^LA7VIN5A
 | 
|---|
 | 137 |  Q:LA7VAL=""
 | 
|---|
 | 138 |  ;
 | 
|---|
 | 139 |  ; Set flag to not store comments if it wasn't explicitly ordered.
 | 
|---|
 | 140 |  I $G(LA7LIMIT)=1 D
 | 
|---|
 | 141 |  . N LA76804
 | 
|---|
 | 142 |  . K LA7LIMIT,LA7TREEN,^TMP("LA7TREE",$J)
 | 
|---|
 | 143 |  . ; Store all tests accessioned in ^TMP
 | 
|---|
 | 144 |  . S LA76804=0
 | 
|---|
 | 145 |  . F  S LA76804=$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA76804)) Q:'LA76804  D UNWIND^LA7UTIL(LA76804)
 | 
|---|
 | 146 |  . I '$D(^TMP("LA7TREE",$J,+LA76241(0))) S LA7LIMIT=1 ;wasn't ordered
 | 
|---|
 | 147 |  I $G(LA7LIMIT) D  Q
 | 
|---|
 | 148 |  . S $P(LA7RMK(0,+LA76241(0)),"^",1)=0
 | 
|---|
 | 149 |  . K LA7LIMIT,^TMP("LA7TREE",$J)
 | 
|---|
 | 150 |  K ^TMP("LA7TREE",$J)
 | 
|---|
 | 151 |  ;
 | 
|---|
 | 152 |  ; Check point of care interface for matching specimen type
 | 
|---|
 | 153 |  ; for this test in #62.4
 | 
|---|
 | 154 |  I LA7INTYP>19,LA7INTYP<30 D  Q:'LA761
 | 
|---|
 | 155 |  . N LA70070
 | 
|---|
 | 156 |  . S LA761="",LA7X=$P(LA76241(2),"^",13) Q:'LA7X
 | 
|---|
 | 157 |  . S LA70070=$$GET1^DIQ(61,LA7X_",","LEDI HL7:HL7 ABBR")
 | 
|---|
 | 158 |  . I LA70070=LA7SPEC S LA761=LA7X
 | 
|---|
 | 159 |  ;
 | 
|---|
 | 160 |  ; Set data node=test value
 | 
|---|
 | 161 |  S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^")=LA7VAL
 | 
|---|
 | 162 |  ;
 | 
|---|
 | 163 |  ; Store reference ranges
 | 
|---|
 | 164 |  D REFRNG^LA7VIN5A($$P^LA7VHLU(.LA7SEG,8,LA7FS))
 | 
|---|
 | 165 |  ;
 | 
|---|
 | 166 |  ; Store order/result codes/observation method
 | 
|---|
 | 167 |  S LA7X=$P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",3)
 | 
|---|
 | 168 |  I LA7ONLT S $P(LA7X,"!",1)=LA7ONLT
 | 
|---|
 | 169 |  I LA7RNLT S $P(LA7X,"!",2)=LA7RNLT
 | 
|---|
 | 170 |  I LA7RLNC S $P(LA7X,"!",3)=LA7RLNC
 | 
|---|
 | 171 |  I LA7OBM S $P(LA7X,"!",4)=LA7OBM
 | 
|---|
 | 172 |  S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",3)=LA7X
 | 
|---|
 | 173 |  ; 
 | 
|---|
 | 174 |  ; Store abnormal flags
 | 
|---|
 | 175 |  D ABFLAG^LA7VIN5A($$P^LA7VHLU(.LA7SEG,9,LA7FS))
 | 
|---|
 | 176 |  ;
 | 
|---|
 | 177 |  ; Store units
 | 
|---|
 | 178 |  I LA7UNITS'="" D
 | 
|---|
 | 179 |  . S LA7X=$P($G(^LAH(LA7LWL,1,LA7ISQN,LA76304)),"^",5)
 | 
|---|
 | 180 |  . S $P(LA7X,"!",7)=LA7UNITS
 | 
|---|
 | 181 |  . S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=LA7X
 | 
|---|
 | 182 |  ;
 | 
|---|
 | 183 |  ; Store responsible observer on POC interfaces
 | 
|---|
 | 184 |  I LA7RO'="",LA7INTYP>19,LA7INTYP<30 D
 | 
|---|
 | 185 |  . I $P(LA7RO,"^",2) S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",4)=$P(LA7RO,"^",2)
 | 
|---|
 | 186 |  ;
 | 
|---|
 | 187 |  ; Store specimen type
 | 
|---|
 | 188 |  I $G(LA761) D
 | 
|---|
 | 189 |  . S X=$P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)
 | 
|---|
 | 190 |  . S $P(X,"!")=LA761
 | 
|---|
 | 191 |  . S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=X
 | 
|---|
 | 192 |  ;
 | 
|---|
 | 193 |  ; Store where test was performed.
 | 
|---|
 | 194 |  D PRDID^LA7VIN5A($$P^LA7VHLU(.LA7SEG,16,LA7FS),LA7SFAC,LA7CS)
 | 
|---|
 | 195 |  ;
 | 
|---|
 | 196 |  ; Store equipment instance identifier
 | 
|---|
 | 197 |  I LA7EII'="" D EII^LA7VIN5A
 | 
|---|
 | 198 |  ;
 | 
|---|
 | 199 |  ; If results for LEDI interface (LA7INTYP=10) and site keeps file #60
 | 
|---|
 | 200 |  ; in sync with reference lab then compare message's units and normals
 | 
|---|
 | 201 |  ; with site's to detect changes(LA7FLAG=1) and notify site.
 | 
|---|
 | 202 |  I LA7INTYP=10,$G(LA761),$G(^LAB(60,+$P(LA76241(0),"^"),1,LA761,.1)) D
 | 
|---|
 | 203 |  . N LA760,LA7FLAG,LA7I,LA7Y,LA7X
 | 
|---|
 | 204 |  . S LA760=+$P(LA76241(0),"^"),LA7Y=^LAB(60,LA760,1,LA761,0),LA7FLAG=0
 | 
|---|
 | 205 |  . S LA7X=$P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)
 | 
|---|
 | 206 |  . I $P(LA7Y,"^",7)'=$P(LA7X,"!",7) S LA7FLAG=1
 | 
|---|
 | 207 |  . I 'LA7FLAG,$P(LA7Y,"^",2)=$P(LA7X,"!",2),$P(LA7Y,"^",3)=$P(LA7X,"!",3) Q
 | 
|---|
 | 208 |  . I 'LA7FLAG D
 | 
|---|
 | 209 |  . . N AGE,DOB,PNM,SEX
 | 
|---|
 | 210 |  . . N LRDPF,LRNG,LRNGS,LRNG2,LRNG3,LRNG4,LRNG5,LRTREA,LRWRD,LRX,LRY
 | 
|---|
 | 211 |  . . I $G(LRDFN) D DEM^LRX,KVAR^VADPT
 | 
|---|
 | 212 |  . . S LRNG=LA7Y D NORM^LRVER5
 | 
|---|
 | 213 |  . . S LA7Y=$TR(LRNG,$C(34),""),LA7X=$TR(LA7X,$C(34),"")
 | 
|---|
 | 214 |  . . I $P(LA7Y,"^",2)=$P(LA7X,"!",2),$P(LA7Y,"^",3)=$P(LA7X,"!",3) Q
 | 
|---|
 | 215 |  . . S LA7FLAG=1
 | 
|---|
 | 216 |  . I 'LA7FLAG Q
 | 
|---|
 | 217 |  . S LA7I=$O(^TMP("LA7 UNITS/NORMALS CHANGED",$J,""),-1),LA7I=LA7I+1
 | 
|---|
 | 218 |  . S X=LA7LWL_"^"_LA7ISQN_"^"_LA76304_"^"_LA76248_"^"_LA76249_"^"_LA7ORS_"^"_LA7TEST_"^"_$S(LA7TEST(0)'="":LA7TEST(0),1:LA7TEST(2,0))_"^"_$$P^LA7VHLU(.LA7SEG,9,LA7FS)_"^"_LA760
 | 
|---|
 | 219 |  . S ^TMP("LA7 UNITS/NORMALS CHANGED",$J,LA7I)=X
 | 
|---|
 | 220 |  ;
 | 
|---|
 | 221 |  ; If LEDI interface and order status change store which results
 | 
|---|
 | 222 |  ; associated with ordered test. Used to determine if order status
 | 
|---|
 | 223 |  ; changed bulletin needs to be generated.
 | 
|---|
 | 224 |  I LA7INTYP=10,LA7SAC?1(1"A",1"G") D
 | 
|---|
 | 225 |  . S LA7I=$G(LA7SAC(0)) Q:'LA7I
 | 
|---|
 | 226 |  . S ^TMP("LA7 ORDER STATUS",$J,LA7I,+LA76241(0))=""
 | 
|---|
 | 227 |  Q
 | 
|---|