- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VIN5A.m
r613 r623 1 LA7VIN5A ;DALOI/JMC - Process Incoming UI Msgs, continued ;May 29, 2008 2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,67,72,66**;Sep 27, 1994;Build 30 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 overrides 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 transform. 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 ; Remove units/reference ranges when Lab UI interface 117 ; so file #60 settings always used 118 I $G(LA7INTYP)=1 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)="" Q 119 ; 120 N LA74,LA7I,LA7X,LA7Y 121 ; 122 S LA7X=$P(LA7PRDID,LA7CS,2),LA74="" 123 ; 124 F LA7I=1,4 D Q:LA74 125 . I $P(LA7PRDID,LA7CS,LA7I+2)="99VA4" S LA74=$$LKUP^XUAF4($P(LA7PRDID,LA7CS,LA7I)) 126 . I 'LA74,$P(LA7PRDID,LA7CS,LA7I+2)?1(1"L-CL",1"CLIA",1"99VACLIA") S LA74=$$IDX^XUAF4("CLIA",$P(LA7PRDID,LA7CS,LA7I)) 127 . I 'LA74 S LA74=$$LKUP^XUAF4($P(LA7PRDID,LA7CS,LA7I+1)) 128 . I 'LA74 S LA74=$$FINDSITE^LA7VHLU2($P(LA7PRDID,LA7CS),1,1) 129 . I 'LA74 S LA74=$$FINDSITE^LA7VHLU2($P(LA7SFAC,LA7CS),1,1) 130 ; 131 ; Store producer's id in LAH global with results. 132 I LA74 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",9)=LA74 Q 133 ; 134 ; Don't store producer's id as comment. 135 I '$P(LA76241(2),"^",9) Q 136 ; If unable to identify producer in file #4 137 ; then store as comment if field STORE PRODUCER'S ID (#20) enabled. 138 I LA7X="" Q 139 S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2) 140 S LA7X=$S(LA7Y="":"P",1:"p")_"erformed by "_LA7X 141 D RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y) 142 ; 143 Q 144 ; 145 ; 146 REFRNG(LA7X) ; Process/Store References Range. 147 ; Call with LA7X = reference range to store. 148 ; 149 Q:$G(LA7INTYP)=1 150 N LA7Y,X,Y 151 ; 152 ; Check if site does not want to store reference ranges on POC test. 153 I LA7INTYP>19,LA7INTYP<30,+$P(LA76241(2),"^",10)=0 Q 154 ; 155 ; Remove leading and trailing quotes from reference range. 156 S LA7X=$$TRIM^XLFSTR($G(LA7X),"RL","""") 157 I LA7X="" Q 158 ; 159 S X=$P($G(^LAH(LA7LWL,1,LA7ISQN,LA76304)),"^",5) 160 ; 161 ; >lower limit (no upper limit e.g. >10) - store as low value 162 I LA7X?1">".N.1".".N S $P(X,"!",2)=$TR(LA7X,">",""),LA7X="" 163 ; 164 ; <upper limit (no lower limit e.g. <15) - store as high value 165 I LA7X?1"<".N.1".".N S $P(X,"!",3)=$TR(LA7X,"<",""),LA7X="" 166 ; 167 ; Alphabetic reference with hyphen 168 I LA7X?1.A1"-"1.A S $P(X,"!",2)=$C(34)_LA7X_$C(34),LA7X="" 169 ; 170 ; Lower limit value 171 S Y=$P(LA7X,"-") 172 I Y'="" D 173 . I Y?.N.1".".N S $P(X,"!",2)=Y 174 . E S $P(X,"!",2)=$C(34)_$$UNESC^LA7VHLU3(Y,LA7FS_LA7ECH)_$C(34) 175 ; 176 ; Upper limit value 177 S Y=$P(LA7X,"-",2) 178 I Y'="" D 179 . I Y?.N.1".".N S $P(X,"!",3)=Y 180 . E S $P(X,"!",3)=$C(34)_$$UNESC^LA7VHLU3(Y,LA7FS_LA7ECH)_$C(34) 181 ; 182 ; Store reference range in LAH global with results. 183 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=X 184 ; 185 Q 186 ; 187 ; 188 ABFLAG(LA7X) ; Process/Store Abnormal Flags. 189 ; Call with LA7X = abnormal flags to store. 190 ; Converts flag to interpretation based on HL7 Table 0078. 191 ; If no match store code instead of interpretation 192 ; 193 Q:LA7INTYP=1 194 N I,LA7I,LA7Y,X 195 ; 196 ; Store abnormal flags in LAH global with results. 197 ; Currently only storing high/low and critical flags 198 S LA7Y=$S(LA7X="L":"L",LA7X="H":"H",LA7X="LL":"L*",LA7X="HH":"H*",1:"") 199 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",2)=LA7Y 200 ; 201 ; Critical or designated abnormal tests generate bulletin/alert 202 ; on LEDI (type=10) interfaces. 203 I LA7INTYP=10,LA7Y'="" D 204 . I $E(LA7Y,2)'="*",'$P(LA76241(2),"^",11) Q 205 . S LA7I=$O(^TMP("LA7 ABNORMAL RESULTS",$J,""),-1),LA7I=LA7I+1 206 . S X=LA7LWL_"^"_LA7ISQN_"^"_LA76304_"^"_LA76248_"^"_LA76249_"^"_LA7ORS_"^"_LA7TEST_"^"_$S(LA7TEST(0)'="":LA7TEST(0),1:LA7TEST(2,0))_"^"_$$P^LA7VHLU(.LA7SEG,9,LA7FS) 207 . S ^TMP("LA7 ABNORMAL RESULTS",$J,LA7I)=X 208 ; 209 ; If POC interface and abnormal flag is not handled by VistA above 210 ; then store as comment. 211 I LA7INTYP>19,LA7INTYP<30,LA7Y="",LA7X'="" D 212 . S X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS" 213 . S I=$F(X,LA7X)\3 214 . S LA7Y="normalcy status - "_$P($T(ABFLAGS+I^LA7VHLU1),";;",2) 215 . D RMKSET^LASET(LA7LWL,LA7ISQN,LA7Y,$P(LA7RMK(0,+LA76241(0)),"^",2)) 216 ; 217 Q 218 ; 219 ; 220 EII ; Store equipment instance identifier in LAH global with results. 221 ; 222 N I,LA7X,X 223 ; 224 S LA7X="" 225 F I=1:1:4 D 226 . S X=$P(LA7EII,LA7CS,I) 227 . I X="" Q 228 . S $P(LA7X,"!",I)=$TR(X,"!","~") 229 I LA7X'="" S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",11)=LA7X 230 Q 231 ; 232 ; 233 ORESULTS ; Process results that accompany order (ORM) messages 234 ; 235 N I,LA764,LA7DIE,LA7ERR,LA7I,LA7WP,LA7X,LA7Y,X 236 S LA7WP(1,0)=" ",LA7I=2,X="" 237 I LA7RLNC S X="[LOINC "_$$GET1^DIQ(95.3,LA7RLNC_",",.01)_"] "_$$GET1^DIQ(95.3,LA7RLNC_",",80) 238 I 'LA7RLNC,LA7RNLT D 239 . S LA764=$$FIND1^DIC(64,"","X",LA7RNLT,"E","","LA7ERR") 240 . I 'LA764 S LA7RNLT="" Q 241 . S X="[NLT "_$$GET1^DIQ(64,LA764_",",1)_"] "_$$GET1^DIQ(64,LA764_",",.01,"I") 242 I 'LA7RLNC,'LA7RNLT D 243 . I LA7TEST(0)]""!(LA7TEST]"") S X="["_LA7TEST(0,1)_" "_LA7TEST_"] "_LA7TEST(0) Q 244 . S X="["_LA7TEST(2,1)_" "_LA7TEST(2)_"] "_LA7TEST(2,0) 245 S LA7WP(LA7I,0)="Test result: "_X 246 ; Date value 247 I LA7VTYP="DT" D 248 . S LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS) 249 . S LA7X=$$HL7TFM^XLFDT(LA7X,"L") 250 . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X 251 ; Coded entry 252 I "CECM"[LA7VTYP D 253 . S LA7X=$P($$P^LA7VHLU(.LA7SEG,6,LA7FS),LA7CS,2) 254 . S LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH) 255 . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X_$S(LA7UNITS]"":" "_LA7UNITS,1:"") 256 ; Numeric/ Structured Numeric value 257 I "NMSN"[LA7VTYP D 258 . S LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS) 259 . S LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH) 260 . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X_$S(LA7UNITS]"":" "_LA7UNITS,1:"") 261 ; String Data/ Formatted Text/ Text Data 262 I "FTSTX"[LA7VTYP D 263 . D PA^LA7VHLU(.LA7SEG,6,LA7FS,.LA7X) 264 . D UNESCFT^LA7VHLU3(.LA7X,LA7FS_LA7ECH,.LA7Y) 265 . 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 266 . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value:" 267 . F I=1:1:LA7Y S LA7I=LA7I+1,LA7WP(LA7I,0)=LA7Y(I,0) 268 . I LA7UNITS'="" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test units: "_LA7UNITS 269 ; Normals/ Reference range 270 S LA7X=$$P^LA7VHLU(.LA7SEG,8,LA7FS) 271 I LA7X'="" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test normals: "_LA7X 272 ; Normalcy status 273 S LA7X=$$P^LA7VHLU(.LA7SEG,9,LA7FS) 274 I LA7X'="" D 275 . S X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS" 276 . S I=$F(X,LA7X)\3,LA7X=$P($T(ABFLAGS+I^LA7VHLU1),";;",2) 277 . I LA7X'="" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test normalcy status: "_LA7X 278 I $D(LA7WP) D WP^DIE(69.6,LA7696_",",99,"A","LA7WP","LA7DIE(99)") 279 Q 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
Note:
See TracChangeset
for help on using the changeset viewer.
