158 lines
6.3 KiB
Mathematica
158 lines
6.3 KiB
Mathematica
LA7SMU2 ;DALOI/JMC - Shipping Manifest Utility (Cont'd);5/5/97 14:44
|
|
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
|
|
Q
|
|
;
|
|
DTTO(LA7SCFG,LA7VNLT,LA7HLSC,LA764NCS,LA761NCS,LA7HLPRI,LA7CSC) ; Determine test to order
|
|
; Call with LA7SCFG = ien of Shipping Configuration file #62.9
|
|
; LA7VNLT = NLT code or non-VA test code
|
|
; LA7HLSC = HL7 Specimen Code
|
|
; LA764NCS = HL7 Name of Test Coding System
|
|
; LA761NCS = HL7 Name of Specimen Coding System
|
|
; LA7HLPRI = HL7 Priority Code
|
|
; LA7CSC = collection sample code^name^coding system
|
|
;
|
|
; Returns LA7X = 0^0^0^0^^^ (if unsuccessful)
|
|
; LABORATORY TEST (ien file #60)^TOPOGRAPHY (ien file #61)^COLLECTION SAMPLE (ien file #62)^URGENCY (ien file #62.05)^NLT TEST CODE^NLT TEST NAME
|
|
;
|
|
N LA760,LA7V64,LA7X,X,Y,Z
|
|
;
|
|
; Make sure variables initialized.
|
|
S LA7X="0^0^0^0^^^"
|
|
I LA7VNLT="" Q LA7X
|
|
S LA7SCFG=+$G(LA7SCFG)
|
|
I LA7HLPRI="" S LA7HLPRI="R"
|
|
I LA7HLSC="" S LA7HLSC="XXX"
|
|
;
|
|
; If coding systems not defined then assume
|
|
; HL7 Table 0070 and VA NLT file
|
|
I LA761NCS="0070" S LA761NCS="HL70070"
|
|
I LA761NCS="" S LA761NCS="HL70070"
|
|
I LA764NCS="" S LA764NCS="99VA64"
|
|
I LA764NCS="L",$P(^LAHM(62.9,LA7SCFG,0),"^",15)=0 S LA764NCS="99VA64"
|
|
;
|
|
; Build index of tests if not previously done for this session.
|
|
I '$D(^TMP("LA7TC",$J,LA7SCFG)) D BINDX
|
|
;
|
|
; Found test info with priority
|
|
I LA7HLPRI]"" D
|
|
. I $P(LA7CSC,"^")'="" D Q:LA7X
|
|
. . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT,LA7HLSC,LA7HLPRI,$P(LA7CSC,"^")))
|
|
. . I X S LA7X=X
|
|
. S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT,LA7HLSC,LA7HLPRI))
|
|
. I X S LA7X=X Q
|
|
. S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT,"XXX",LA7HLPRI))
|
|
. I X,"MISPCYEM"[$P(^LAB(60,+X,0),"^",4) S LA7X=X
|
|
;
|
|
; Found test info with no priority specified
|
|
I 'LA7X D
|
|
. I $P(LA7CSC,"^")'="" D Q:LA7X
|
|
. . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT,LA7HLSC,0,$P(LA7CSC,"^")))
|
|
. . I X S LA7X=X
|
|
. S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT,LA7HLSC))
|
|
. I X S LA7X=X Q
|
|
. S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT,"XXX"))
|
|
. I X,"MISPCYEM"[$P(^LAB(60,+X,0),"^",4) S LA7X=X
|
|
;
|
|
; Otherwise get values from files #60 LABORATORY TEST and #61, TOPOGRAPHY
|
|
; Lookup test using NLT code and get first lab test in "AC" for this
|
|
; NLT code that's type (I)nput or (B)oth.
|
|
I 'LA7X,LA764NCS="99VA64" D
|
|
. S LA7V64=$O(^LAM("E",LA7VNLT,0)),Y=0 Q:'LA7V64
|
|
. F S Y=$O(^LAB(60,"AC",LA7V64,Y)) Q:'Y Q:"BI"[$P(^LAB(60,Y,0),"^",3)
|
|
. I Y S $P(LA7X,"^")=Y
|
|
;
|
|
; Get default topography and collection sample for HL7 specimen type.
|
|
; Check file #60 collection samples first, then check first entry in file #61 for match
|
|
; If non-table 0070 then look for "XXX" in table 0070
|
|
I $P(LA7X,"^"),'$P(LA7X,"^",2),LA761NCS="HL70070" D
|
|
. S (X,Y)=0,LA760=$P(LA7X,"^")
|
|
. F S X=$O(^LAB(60,LA760,3,"B",X)) Q:'X D Q:Y
|
|
. . S Z=$P(^LAB(62,X,0),"^",2)
|
|
. . I Z,$D(^LAB(61,"HL7",LA7HLSC,Z)) S Y=Z_"^"_X
|
|
. I Y S $P(LA7X,"^",2,3)=Y
|
|
I '$P(LA7X,"^",2),LA761NCS="HL70070" D
|
|
. S X=$O(^LAB(61,"HL7",LA7HLSC,0)) Q:'X
|
|
. S $P(LA7X,"^",2)=X
|
|
. I '$P(LA7X,"^",3) S $P(LA7X,"^",3)=$P(^LAB(61,X,0),"^",6)
|
|
I $P(LA7X,"^"),'$P(LA7X,"^",2),LA761NCS'="HL70070","MISPCYEM"[$P(^LAB(60,$P(LA7X,"^"),0),"^",4) D
|
|
. S X=$O(^LAB(61,"HL7","XXX",0))
|
|
. I X S $P(LA7X,"^",2)=X
|
|
;
|
|
; No urgency mapping, get last using this HL7 code or site's default urgency from #69.9
|
|
; Find highest non-workload urgency using this priority code else use site's default
|
|
I '$P(LA7X,"^",4) D
|
|
. S X=$O(^LAB(62.05,"HL7",LA7HLPRI,50),-1)
|
|
. I X S $P(LA7X,"^",4)=X
|
|
. E S $P(LA7X,"^",4)=+$P($G(^LAB(69.9,1,3)),"^",2)
|
|
;
|
|
; Check file #60 forced and highest urgency.
|
|
I $P(LA7X,"^"),$P(LA7X,"^",4) D
|
|
. S X=$G(^LAB(60,$P(LA7X,"^"),0))
|
|
. I $P(X,"^",18) S $P(LA7X,"^",4)=$P(X,"^",18)
|
|
. I $P(X,"^",16),$P(LA7X,"^",4)<$P(X,"^",16) S $P(LA7X,"^",4)=$P(X,"^",16)
|
|
;
|
|
Q LA7X
|
|
;
|
|
;
|
|
BINDX ; Build index of tests for a shipping configuration.
|
|
; Called from above.
|
|
;
|
|
I '$D(^LAHM(62.9,LA7SCFG,0)) Q
|
|
N LA760,LA761,LA762,LA76205,LA764,LA7HL,LA7NLT,LA7NLTN,LA7TC,LA7X
|
|
S LA7X=0
|
|
F S LA7X=$O(^LAHM(62.9,LA7SCFG,60,LA7X)) Q:'LA7X D BLD
|
|
Q
|
|
;
|
|
;
|
|
BLD ; Build TMP global for a test
|
|
; Called from above
|
|
;
|
|
S LA7X(0)=$G(^LAHM(62.9,LA7SCFG,60,LA7X,0))
|
|
S LA7X(5)=$G(^LAHM(62.9,LA7SCFG,60,LA7X,5))
|
|
;
|
|
; Laboratory test/collection sample.
|
|
S LA760=$P(LA7X(0),"^"),LA762=$P(LA7X(0),"^",9)
|
|
; Incomplete entry.
|
|
I 'LA760!('LA762) Q
|
|
;
|
|
; Test urgency/HL7 priority code.
|
|
S LA76205=$P(LA7X(0),"^",4),LA76205("HL")=""
|
|
I LA76205 S LA76205("HL")=$$GET1^DIQ(62.05,LA76205_",","LEDI HL7:HL7 ABBR")
|
|
;
|
|
; Topography
|
|
S LA761=$$GET1^DIQ(62,LA762_",",2,"I")
|
|
I 'LA761,"BBCH"[$P(^LAB(60,LA760,0),"^",4) Q ; Incomplete entry.
|
|
; Handle MI with no topography associated with collection sample.
|
|
I 'LA761,$P(^LAB(60,LA760,0),"^",4)="MI" S LA761=+$P(LA7X(0),"^",3)
|
|
;
|
|
; Use HL7 specimen code if using table 0070 else use mapping in 62.9
|
|
S LA7HL=""
|
|
I LA761NCS="HL70070" S LA7HL=$$GET1^DIQ(61,LA761_",","LEDI HL7:HL7 ABBR")
|
|
I LA7HL="" S LA7HL=$P(LA7X(5),"^",3)
|
|
;
|
|
; File #64 ien/NLT code/NLT code test name.
|
|
; Use NLT code if using VA coding else use non-VA test order code.
|
|
S LA764=+$$GET1^DIQ(60,LA760_",",64,"I")
|
|
S LA7NLT=$$GET1^DIQ(64,LA764_",",1)
|
|
S LA7NLTN=$$GET1^DIQ(64,LA764_",",.01)
|
|
I LA764NCS="99VA64" S LA7TC=LA7NLT
|
|
E S LA7TC=$P(LA7X(5),"^")
|
|
;
|
|
; Set TMP global with information
|
|
I LA7HL'="",LA7TC'="" D
|
|
. I "MISPCYEM"[$P(^LAB(60,LA760,0),"^",4),$P(LA7X(5),"^",7)'="" D
|
|
. . S ^TMP("LA7TC",$J,LA7SCFG,LA7TC,LA7HL,0,$P(LA7X(5),"^",7))=LA760_"^"_LA761_"^"_LA762_"^^"_LA7NLT_"^"_LA7NLTN
|
|
. E S ^TMP("LA7TC",$J,LA7SCFG,LA7TC,LA7HL)=LA760_"^"_LA761_"^"_LA762_"^^"_LA7NLT_"^"_LA7NLTN
|
|
. I LA76205("HL")'="" D
|
|
. . I "MISPCYEM"[$P(^LAB(60,LA760,0),"^",4),$P(LA7X(5),"^",7)'="" D
|
|
. . . S ^TMP("LA7TC",$J,LA7SCFG,LA7TC,LA7HL,LA76205("HL"),$P(LA7X(5),"^",7))=LA760_"^"_LA761_"^"_LA762_"^"_LA76205_"^"_LA7NLT_"^"_LA7NLTN
|
|
. . E S ^TMP("LA7TC",$J,LA7SCFG,LA7TC,LA7HL,LA76205("HL"))=LA760_"^"_LA761_"^"_LA762_"^"_LA76205_"^"_LA7NLT_"^"_LA7NLTN
|
|
;
|
|
; Set TMP global when collection sample does not have a topography.
|
|
; Used for "MISPCYEM" subscripts which can have collection sample with no tpopgraphy.
|
|
I LA7TC'="",'LA761,"MISPCYEM"[$P(^LAB(60,LA760,0),"^",4) D
|
|
. S ^TMP("LA7TC",$J,LA7SCFG,LA7TC,"XXX")=LA760_"^"_LA761_"^"_LA762_"^^"_LA7NLT_"^"_LA7NLTN
|
|
. I LA76205("HL")'="" S ^TMP("LA7TC",$J,LA7SCFG,LA7TC,"XXX",LA76205("HL"))=LA760_"^"_LA761_"^"_LA762_"^"_LA76205_"^"_LA7NLT_"^"_LA7NLTN
|
|
;
|
|
Q
|