| 1 | LA7VIN5A ;DALOI/JMC - Process Incoming UI Msgs, continued ; Jan 12, 2004
|
---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,67,72**;Sep 27, 1994
|
---|
| 3 | ; This routine is a continuation of LA7VIN5.
|
---|
| 4 | ; It is performs processing of fields in OBX segments.
|
---|
| 5 | Q
|
---|
| 6 | ;
|
---|
| 7 | XFORM ; Transform the result based on fields 12,13,14,16,17 in the Chem Test
|
---|
| 8 | ; multiple in the Auto Instrument file (62.4), or set on the fly
|
---|
| 9 | ; from PARAM 1
|
---|
| 10 | N LA7I
|
---|
| 11 | S LA7XFORM=LA76241(2)
|
---|
| 12 | ;
|
---|
| 13 | ; get PARAM 1 overides
|
---|
| 14 | I $D(LA7XFORM(1)),LA7XFORM(1)?1.N S $P(LA7XFORM,"^")=LA7XFORM(1)
|
---|
| 15 | F LA7I=2,3,5,6 I $D(LA7XFORM(LA7I)) S $P(LA7XFORM,"^",LA7I)=LA7XFORM(LA7I)
|
---|
| 16 | ; set up defaults if field was not answered
|
---|
| 17 | ; accept results,yes
|
---|
| 18 | I $P(LA7XFORM,"^",3)="" S $P(LA7XFORM,"^",3)=1
|
---|
| 19 | ; strip spaces,no
|
---|
| 20 | I $P(LA7XFORM,"^",6)="" S $P(LA7XFORM,"^",6)=0
|
---|
| 21 | ; now transform
|
---|
| 22 | ;
|
---|
| 23 | ; Don't accept results
|
---|
| 24 | I '$P(LA7XFORM,"^",3) S LA7VAL="" Q
|
---|
| 25 | ;
|
---|
| 26 | ; Only accept "FINAL" type results
|
---|
| 27 | I $P(LA7XFORM,"^",3)=2,"CFUX"'[LA7ORS S LA7VAL="" Q
|
---|
| 28 | ;
|
---|
| 29 | ; Accept ordered tests only
|
---|
| 30 | ; If LEDI interface (10) and message indicates a reflex ("G") or add-on
|
---|
| 31 | ; test ("A") then process anyway in case it has not been added to
|
---|
| 32 | ; accession.
|
---|
| 33 | I $P(LA7XFORM,"^",5) D
|
---|
| 34 | . I LA7INTYP=10,LA7SAC?1(1"A",1"G") Q
|
---|
| 35 | . S LA7LIMIT=1
|
---|
| 36 | ;
|
---|
| 37 | ; Decimal places if number of places defined
|
---|
| 38 | I $P(LA7XFORM,"^")?1.N D JUSTDEC
|
---|
| 39 | ;
|
---|
| 40 | ; Strip spaces
|
---|
| 41 | I $P(LA7XFORM,"^",6) S LA7VAL=$TR(LA7VAL," ","")
|
---|
| 42 | ;
|
---|
| 43 | ; Make result a comment
|
---|
| 44 | ; Set value to null after making into remark, don't store twice.
|
---|
| 45 | I $P(LA7XFORM,"^",2) D
|
---|
| 46 | . N LA7Y
|
---|
| 47 | . ; Store comment in ^LAH global
|
---|
| 48 | . S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2)
|
---|
| 49 | . D RMKSET^LASET(LA7LWL,LA7ISQN,LA7VAL,LA7Y)
|
---|
| 50 | . S LA7VAL=""
|
---|
| 51 | Q
|
---|
| 52 | ;
|
---|
| 53 | ;
|
---|
| 54 | CHKDIE ; Check if value to be stored passes input transform of field in DD
|
---|
| 55 | N LA7ERR,LA7Y
|
---|
| 56 | ;
|
---|
| 57 | ; If result is on a LEDI interface (type=10) then don't check result
|
---|
| 58 | ; against FileMan input tranform.
|
---|
| 59 | ; VistA sends "canc" as test result when test is cancelled.
|
---|
| 60 | ; DoD sends "PL Canceled" --> change to "canc" for VistA storage.
|
---|
| 61 | I LA7INTYP=10 D Q
|
---|
| 62 | . I LA7VAL="PL Cancelled" S LA7VAL="canc"
|
---|
| 63 | . I LA7VAL="PL Canceled" S LA7VAL="canc"
|
---|
| 64 | . I LA7VAL="PLCanceled" S LA7VAL="canc"
|
---|
| 65 | ;
|
---|
| 66 | ; If value fails data checker then log error and suppress result.
|
---|
| 67 | D CHK^DIE(LA7SUBFL,LA76304,"H",LA7VAL,.LA7Y,"LA7ERR")
|
---|
| 68 | I LA7Y="^" D
|
---|
| 69 | . N LA7X
|
---|
| 70 | . S LA7X=$G(LA7ERR("DIERR",1,"TEXT",1))
|
---|
| 71 | . D CREATE^LA7LOG(37)
|
---|
| 72 | . S LA7VAL=""
|
---|
| 73 | Q
|
---|
| 74 | ;
|
---|
| 75 | ;
|
---|
| 76 | JUSTDEC ; Justify to number of places specified
|
---|
| 77 | ;
|
---|
| 78 | N LA7DDTYP,LA7FMT,LA7I,LA7PRFIX,LA7X
|
---|
| 79 | ;
|
---|
| 80 | ; If LEDI interface (type=10) then skip decimal adjustment
|
---|
| 81 | I LA7INTYP=10 Q
|
---|
| 82 | ;
|
---|
| 83 | ; Get data name field type from DD
|
---|
| 84 | ; Only justify if Vista field is numeric or free text.
|
---|
| 85 | S LA7DDTYP=$$GET1^DID(LA7SUBFL,LA76304,"","TYPE")
|
---|
| 86 | I "NUMERIC^FREE TEXT"'[LA7DDTYP D Q
|
---|
| 87 | . N LA7FLDNM
|
---|
| 88 | . S LA7FLDNM=$$GET1^DID(63.04,LA76304,"","LABEL")
|
---|
| 89 | . D CREATE^LA7LOG(38)
|
---|
| 90 | ;
|
---|
| 91 | S LA7X=LA7VAL,(LA7FMT,LA7PRFIX)=""
|
---|
| 92 | ;
|
---|
| 93 | ; If comma formatted, strip comma and set flag to add back in.
|
---|
| 94 | S LA7X=$TR(LA7X,",","")
|
---|
| 95 | I LA7X'=LA7VAL S LA7FMT="P"
|
---|
| 96 | ;
|
---|
| 97 | ; If "<>=" formatted, strip and save to add back in.
|
---|
| 98 | F LA7I=1:1:$L(LA7X) Q:$E(LA7X,LA7I)'?1(1"<",1">",1"=")
|
---|
| 99 | I LA7I>1 D
|
---|
| 100 | . S LA7PRFIX=$E(LA7X,1,LA7I-1)
|
---|
| 101 | . S LA7X=$E(LA7X,LA7I,$L(LA7X))
|
---|
| 102 | ;
|
---|
| 103 | ; Format if starts with number or decimal point, skip other results.
|
---|
| 104 | I LA7X?1(1.N,.N1"."1.N) D
|
---|
| 105 | . S LA7X=$FN(LA7X,LA7FMT,+LA7XFORM)
|
---|
| 106 | . S LA7VAL=LA7PRFIX_LA7X
|
---|
| 107 | Q
|
---|
| 108 | ;
|
---|
| 109 | ;
|
---|
| 110 | PRDID(LA7PRDID,LA7SFAC,LA7CS) ; Process/Store Producer's ID
|
---|
| 111 | ; Store where test was performed.
|
---|
| 112 | ; Call with LA7PRDID = Producer's ID field
|
---|
| 113 | ; LA7SFAC = sending facility
|
---|
| 114 | ; LA7CS = component encoding character
|
---|
| 115 | ;
|
---|
| 116 | N LA74,LA7I,LA7X,LA7Y
|
---|
| 117 | ;
|
---|
| 118 | S LA7X=$P(LA7PRDID,LA7CS,2),LA74=""
|
---|
| 119 | ;
|
---|
| 120 | F LA7I=1,4 D Q:LA74
|
---|
| 121 | . I $P(LA7PRDID,LA7CS,LA7I+2)="99VA4" S LA74=$$LKUP^XUAF4($P(LA7PRDID,LA7CS,LA7I))
|
---|
| 122 | . I 'LA74 S LA74=$$LKUP^XUAF4($P(LA7PRDID,LA7CS,LA7I+1))
|
---|
| 123 | . I 'LA74 S LA74=$$FINDSITE^LA7VHLU2($P(LA7PRDID,LA7CS),1,1)
|
---|
| 124 | . I 'LA74 S LA74=$$FINDSITE^LA7VHLU2($P(LA7SFAC,LA7CS),1,1)
|
---|
| 125 | ;
|
---|
| 126 | ; Store producer's id in LAH global with results.
|
---|
| 127 | I LA74 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",9)=LA74 Q
|
---|
| 128 | ;
|
---|
| 129 | ; Don't store producer's id as comment.
|
---|
| 130 | I '$P(LA76241(2),"^",9) Q
|
---|
| 131 | ; If unable to identify producer in file #4
|
---|
| 132 | ; then store as comment if field STORE PRODUCER'S ID (#20) enabled.
|
---|
| 133 | I LA7X="" Q
|
---|
| 134 | S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2)
|
---|
| 135 | S LA7X=$S(LA7Y="":"P",1:"p")_"erformed by "_LA7X
|
---|
| 136 | D RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y)
|
---|
| 137 | ;
|
---|
| 138 | Q
|
---|
| 139 | ;
|
---|
| 140 | ;
|
---|
| 141 | REFRNG(LA7X) ; Process/Store References Range.
|
---|
| 142 | ; Call with LA7X = reference range to store.
|
---|
| 143 | ;
|
---|
| 144 | N LA7Y,X,Y
|
---|
| 145 | ;
|
---|
| 146 | ; Check if site does not want to store reference ranges on POC test.
|
---|
| 147 | I LA7INTYP>19,LA7INTYP<30,+$P(LA76241(2),"^",10)=0 Q
|
---|
| 148 | ;
|
---|
| 149 | ; Remove leading and trailing quotes from reference range.
|
---|
| 150 | S LA7X=$$TRIM^XLFSTR($G(LA7X),"RL","""")
|
---|
| 151 | I LA7X="" Q
|
---|
| 152 | ;
|
---|
| 153 | S X=$P($G(^LAH(LA7LWL,1,LA7ISQN,LA76304)),"^",5)
|
---|
| 154 | ;
|
---|
| 155 | ; >lower limit (no upper limit e.g. >10) - store as low value
|
---|
| 156 | I LA7X?1">".N.1".".N S $P(X,"!",2)=$TR(LA7X,">",""),LA7X=""
|
---|
| 157 | ;
|
---|
| 158 | ; <upper limit (no lower limit e.g. <15) - store as high value
|
---|
| 159 | I LA7X?1"<".N.1".".N S $P(X,"!",3)=$TR(LA7X,"<",""),LA7X=""
|
---|
| 160 | ;
|
---|
| 161 | ; Alphabetic reference with hyphen
|
---|
| 162 | I LA7X?1.A1"-"1.A S $P(X,"!",2)=$C(34)_LA7X_$C(34),LA7X=""
|
---|
| 163 | ;
|
---|
| 164 | ; Lower limit value
|
---|
| 165 | S Y=$P(LA7X,"-")
|
---|
| 166 | I Y'="" D
|
---|
| 167 | . I Y?.N.1".".N S $P(X,"!",2)=Y
|
---|
| 168 | . E S $P(X,"!",2)=$C(34)_$$UNESC^LA7VHLU3(Y,LA7FS_LA7ECH)_$C(34)
|
---|
| 169 | ;
|
---|
| 170 | ; Upper limit value
|
---|
| 171 | S Y=$P(LA7X,"-",2)
|
---|
| 172 | I Y'="" D
|
---|
| 173 | . I Y?.N.1".".N S $P(X,"!",3)=Y
|
---|
| 174 | . E S $P(X,"!",3)=$C(34)_$$UNESC^LA7VHLU3(Y,LA7FS_LA7ECH)_$C(34)
|
---|
| 175 | ;
|
---|
| 176 | ; Store reference range in LAH global with results.
|
---|
| 177 | S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=X
|
---|
| 178 | ;
|
---|
| 179 | Q
|
---|
| 180 | ;
|
---|
| 181 | ;
|
---|
| 182 | ABFLAG(LA7X) ; Process/Store Abnormal Flags.
|
---|
| 183 | ; Call with LA7X = abnormal flags to store.
|
---|
| 184 | ; Converts flag to interpretation based on HL7 Table 0078.
|
---|
| 185 | ; If no match store code instead of interpretation
|
---|
| 186 | ;
|
---|
| 187 | N I,LA7I,LA7Y,X
|
---|
| 188 | ;
|
---|
| 189 | ; Store abnormal flags in LAH global with results.
|
---|
| 190 | ; Currently only storing high/low and critical flags
|
---|
| 191 | S LA7Y=$S(LA7X="L":"L",LA7X="H":"H",LA7X="LL":"L*",LA7X="HH":"H*",1:"")
|
---|
| 192 | S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",2)=LA7Y
|
---|
| 193 | ;
|
---|
| 194 | ; Critical or designated abnormal tests generate bulletin/alert
|
---|
| 195 | ; on LEDI (type=10) interfaces.
|
---|
| 196 | I LA7INTYP=10,LA7Y'="" D
|
---|
| 197 | . I $E(LA7Y,2)'="*",'$P(LA76241(2),"^",11) Q
|
---|
| 198 | . S LA7I=$O(^TMP("LA7 ABNORMAL RESULTS",$J,""),-1),LA7I=LA7I+1
|
---|
| 199 | . S X=LA7LWL_"^"_LA7ISQN_"^"_LA76304_"^"_LA76248_"^"_LA76249_"^"_LA7ORS_"^"_LA7TEST_"^"_$S(LA7TEST(0)'="":LA7TEST(0),1:LA7TEST(2,0))_"^"_$$P^LA7VHLU(.LA7SEG,9,LA7FS)
|
---|
| 200 | . S ^TMP("LA7 ABNORMAL RESULTS",$J,LA7I)=X
|
---|
| 201 | ;
|
---|
| 202 | ; If POC interface and abnormal flag is not handled by VistA above
|
---|
| 203 | ; then store as comment.
|
---|
| 204 | I LA7INTYP>19,LA7INTYP<30,LA7Y="",LA7X'="" D
|
---|
| 205 | . S X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
|
---|
| 206 | . S I=$F(X,LA7X)\3
|
---|
| 207 | . S LA7Y="normalcy status - "_$P($T(ABFLAGS+I^LA7VHLU1),";;",2)
|
---|
| 208 | . D RMKSET^LASET(LA7LWL,LA7ISQN,LA7Y,$P(LA7RMK(0,+LA76241(0)),"^",2))
|
---|
| 209 | ;
|
---|
| 210 | Q
|
---|
| 211 | ;
|
---|
| 212 | ;
|
---|
| 213 | EII ; Store equipment instance identifier in LAH global with results.
|
---|
| 214 | ;
|
---|
| 215 | N I,LA7X,X
|
---|
| 216 | ;
|
---|
| 217 | S LA7X=""
|
---|
| 218 | F I=1:1:4 D
|
---|
| 219 | . S X=$P(LA7EII,LA7CS,I)
|
---|
| 220 | . I X="" Q
|
---|
| 221 | . S $P(LA7X,"!",I)=$TR(X,"!","~")
|
---|
| 222 | I LA7X'="" S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",11)=LA7X
|
---|
| 223 | Q
|
---|
| 224 | ;
|
---|
| 225 | ;
|
---|
| 226 | ORESULTS ; Process results that accompany order (ORM) messages
|
---|
| 227 | ;
|
---|
| 228 | N I,LA764,LA7DIE,LA7ERR,LA7I,LA7WP,LA7X,LA7Y,X
|
---|
| 229 | S LA7WP(1,0)=" ",LA7I=2,X=""
|
---|
| 230 | I LA7RLNC S X="[LOINC "_$$GET1^DIQ(95.3,LA7RLNC_",",.01)_"] "_$$GET1^DIQ(95.3,LA7RLNC_",",80)
|
---|
| 231 | I 'LA7RLNC,LA7RNLT D
|
---|
| 232 | . S LA764=$$FIND1^DIC(64,"","X",LA7RNLT,"E","","LA7ERR")
|
---|
| 233 | . I 'LA764 S LA7RNLT="" Q
|
---|
| 234 | . S X="[NLT "_$$GET1^DIQ(64,LA764_",",1)_"] "_$$GET1^DIQ(64,LA764_",",.01,"I")
|
---|
| 235 | I 'LA7RLNC,'LA7RNLT D
|
---|
| 236 | . I LA7TEST(0)]""!(LA7TEST]"") S X="["_LA7TEST(0,1)_" "_LA7TEST_"] "_LA7TEST(0) Q
|
---|
| 237 | . S X="["_LA7TEST(2,1)_" "_LA7TEST(2)_"] "_LA7TEST(2,0)
|
---|
| 238 | S LA7WP(LA7I,0)="Test result: "_X
|
---|
| 239 | ; Date value
|
---|
| 240 | I LA7VTYP="DT" D
|
---|
| 241 | . S LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
|
---|
| 242 | . S LA7X=$$HL7TFM^XLFDT(LA7X,"L")
|
---|
| 243 | . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X
|
---|
| 244 | ; Coded entry
|
---|
| 245 | I "CECM"[LA7VTYP D
|
---|
| 246 | . S LA7X=$P($$P^LA7VHLU(.LA7SEG,6,LA7FS),LA7CS,2)
|
---|
| 247 | . S LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
|
---|
| 248 | . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X_$S(LA7UNITS]"":" "_LA7UNITS,1:"")
|
---|
| 249 | ; Numeric/ Structured Numeric value
|
---|
| 250 | I "NMSN"[LA7VTYP D
|
---|
| 251 | . S LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
|
---|
| 252 | . S LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
|
---|
| 253 | . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X_$S(LA7UNITS]"":" "_LA7UNITS,1:"")
|
---|
| 254 | ; String Data/ Formatted Text/ Text Data
|
---|
| 255 | I "FTSTX"[LA7VTYP D
|
---|
| 256 | . D PA^LA7VHLU(.LA7SEG,6,LA7FS,.LA7X)
|
---|
| 257 | . D UNESCFT^LA7VHLU3(.LA7X,LA7FS_LA7ECH,.LA7Y)
|
---|
| 258 | . 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
|
---|
| 259 | . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value:"
|
---|
| 260 | . F I=1:1:LA7Y S LA7I=LA7I+1,LA7WP(LA7I,0)=LA7Y(I,0)
|
---|
| 261 | . I LA7UNITS'="" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test units: "_LA7UNITS
|
---|
| 262 | ; Normals/ Reference range
|
---|
| 263 | S LA7X=$$P^LA7VHLU(.LA7SEG,8,LA7FS)
|
---|
| 264 | I LA7X'="" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test normals: "_LA7X
|
---|
| 265 | ; Normalcy status
|
---|
| 266 | S LA7X=$$P^LA7VHLU(.LA7SEG,9,LA7FS)
|
---|
| 267 | I LA7X'="" D
|
---|
| 268 | . S X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
|
---|
| 269 | . S I=$F(X,LA7X)\3,LA7X=$P($T(ABFLAGS+I^LA7VHLU1),";;",2)
|
---|
| 270 | . I LA7X'="" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test normalcy status: "_LA7X
|
---|
| 271 | I $D(LA7WP) D WP^DIE(69.6,LA7696_",",99,"A","LA7WP","LA7DIE(99)")
|
---|
| 272 | Q
|
---|