LA7SMU2 ;VA/DALOI/JMC - Shipping Manifest Utility (Cont'd);JUL 06, 2010 3:14 PM
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,1027**;NOV 01, 1997
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
LA7SMU2 ;VA/DALOI/JMC - Shipping Manifest Utility (Cont'd);JUL 06, 2010 3:14 PM
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,1027**;NOV 01, 1997
+2 QUIT
+3 ;
DTTO(LA7SCFG,LA7VNLT,LA7HLSC,LA764NCS,LA761NCS,LA7HLPRI,LA7CSC) ; Determine test to order
+1 ; Call with LA7SCFG = ien of Shipping Configuration file #62.9
+2 ; LA7VNLT = NLT code or non-VA test code
+3 ; LA7HLSC = HL7 Specimen Code
+4 ; LA764NCS = HL7 Name of Test Coding System
+5 ; LA761NCS = HL7 Name of Specimen Coding System
+6 ; LA7HLPRI = HL7 Priority Code
+7 ; LA7CSC = collection sample code^name^coding system
+8 ;
+9 ; Returns LA7X = 0^0^0^0^^^ (if unsuccessful)
+10 ; 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
+11 ;
+12 NEW LA760,LA7V64,LA7X,X,Y,Z
+13 ;
+14 ; Make sure variables initialized.
+15 SET LA7X="0^0^0^0^^^"
+16 IF LA7VNLT=""
QUIT LA7X
+17 SET LA7SCFG=+$GET(LA7SCFG)
+18 IF LA7HLPRI=""
SET LA7HLPRI="R"
+19 IF LA7HLSC=""
SET LA7HLSC="XXX"
+20 ;
+21 ; If coding systems not defined then assume
+22 ; HL7 Table 0070 and VA NLT file
+23 IF LA761NCS="0070"
SET LA761NCS="HL70070"
+24 IF LA761NCS=""
SET LA761NCS="HL70070"
+25 IF LA764NCS=""
SET LA764NCS="99VA64"
+26 IF LA764NCS="L"
IF $PIECE(^LAHM(62.9,LA7SCFG,0),"^",15)=0
SET LA764NCS="99VA64"
+27 ;
+28 ; Build index of tests if not previously done for this session.
+29 IF '$DATA(^TMP("LA7TC",$JOB,LA7SCFG))
DO BINDX
+30 ;
+31 ; Found test info with priority
+32 IF LA7HLPRI]""
Begin DoDot:1
+33 IF $PIECE(LA7CSC,"^")'=""
Begin DoDot:2
+34 SET X=$GET(^TMP("LA7TC",$JOB,LA7SCFG,LA7VNLT,LA7HLSC,LA7HLPRI,$PIECE(LA7CSC,"^")))
+35 IF X
SET LA7X=X
End DoDot:2
IF LA7X
QUIT
+36 SET X=$GET(^TMP("LA7TC",$JOB,LA7SCFG,LA7VNLT,LA7HLSC,LA7HLPRI))
+37 IF X
SET LA7X=X
QUIT
+38 SET X=$GET(^TMP("LA7TC",$JOB,LA7SCFG,LA7VNLT,"XXX",LA7HLPRI))
+39 IF X
IF "MISPCYEM"[$PIECE(^LAB(60,+X,0),"^",4)
SET LA7X=X
End DoDot:1
+40 ;
+41 ; Found test info with no priority specified
+42 IF 'LA7X
Begin DoDot:1
+43 IF $PIECE(LA7CSC,"^")'=""
Begin DoDot:2
+44 SET X=$GET(^TMP("LA7TC",$JOB,LA7SCFG,LA7VNLT,LA7HLSC,0,$PIECE(LA7CSC,"^")))
+45 IF X
SET LA7X=X
End DoDot:2
IF LA7X
QUIT
+46 SET X=$GET(^TMP("LA7TC",$JOB,LA7SCFG,LA7VNLT,LA7HLSC))
+47 IF X
SET LA7X=X
QUIT
+48 SET X=$GET(^TMP("LA7TC",$JOB,LA7SCFG,LA7VNLT,"XXX"))
+49 IF X
IF "MISPCYEM"[$PIECE(^LAB(60,+X,0),"^",4)
SET LA7X=X
End DoDot:1
+50 ;
+51 ; Otherwise get values from files #60 LABORATORY TEST and #61, TOPOGRAPHY
+52 ; Lookup test using NLT code and get first lab test in "AC" for this
+53 ; NLT code that's type (I)nput or (B)oth.
+54 IF 'LA7X
IF LA764NCS="99VA64"
Begin DoDot:1
+55 SET LA7V64=$ORDER(^LAM("E",LA7VNLT,0))
SET Y=0
IF 'LA7V64
QUIT
+56 FOR
SET Y=$ORDER(^LAB(60,"AC",LA7V64,Y))
IF 'Y
QUIT
IF "BI"[$PIECE(^LAB(60,Y,0),"^",3)
QUIT
+57 IF Y
SET $PIECE(LA7X,"^")=Y
End DoDot:1
+58 ;
+59 ; Get default topography and collection sample for HL7 specimen type.
+60 ; Check file #60 collection samples first, then check first entry in file #61 for match
+61 ; If non-table 0070 then look for "XXX" in table 0070
+62 IF $PIECE(LA7X,"^")
IF '$PIECE(LA7X,"^",2)
IF LA761NCS="HL70070"
Begin DoDot:1
+63 SET (X,Y)=0
SET LA760=$PIECE(LA7X,"^")
+64 FOR
SET X=$ORDER(^LAB(60,LA760,3,"B",X))
IF 'X
QUIT
Begin DoDot:2
+65 SET Z=$PIECE(^LAB(62,X,0),"^",2)
+66 IF Z
IF $DATA(^LAB(61,"HL7",LA7HLSC,Z))
SET Y=Z_"^"_X
End DoDot:2
IF Y
QUIT
+67 IF Y
SET $PIECE(LA7X,"^",2,3)=Y
End DoDot:1
+68 IF '$PIECE(LA7X,"^",2)
IF LA761NCS="HL70070"
Begin DoDot:1
+69 SET X=$ORDER(^LAB(61,"HL7",LA7HLSC,0))
IF 'X
QUIT
+70 SET $PIECE(LA7X,"^",2)=X
+71 IF '$PIECE(LA7X,"^",3)
SET $PIECE(LA7X,"^",3)=$PIECE(^LAB(61,X,0),"^",6)
End DoDot:1
+72 IF $PIECE(LA7X,"^")
IF '$PIECE(LA7X,"^",2)
IF LA761NCS'="HL70070"
IF "MISPCYEM"[$PIECE(^LAB(60,$PIECE(LA7X,"^"),0),"^",4)
Begin DoDot:1
+73 SET X=$ORDER(^LAB(61,"HL7","XXX",0))
+74 IF X
SET $PIECE(LA7X,"^",2)=X
End DoDot:1
+75 ;
+76 ; No urgency mapping, get last using this HL7 code or site's default urgency from #69.9
+77 ; Find highest non-workload urgency using this priority code else use site's default
+78 IF '$PIECE(LA7X,"^",4)
Begin DoDot:1
+79 SET X=$ORDER(^LAB(62.05,"HL7",LA7HLPRI,50),-1)
+80 IF X
SET $PIECE(LA7X,"^",4)=X
+81 IF '$TEST
SET $PIECE(LA7X,"^",4)=+$PIECE($GET(^LAB(69.9,1,3)),"^",2)
End DoDot:1
+82 ;
+83 ; Check file #60 forced and highest urgency.
+84 IF $PIECE(LA7X,"^")
IF $PIECE(LA7X,"^",4)
Begin DoDot:1
+85 SET X=$GET(^LAB(60,$PIECE(LA7X,"^"),0))
+86 IF $PIECE(X,"^",18)
SET $PIECE(LA7X,"^",4)=$PIECE(X,"^",18)
+87 IF $PIECE(X,"^",16)
IF $PIECE(LA7X,"^",4)<$PIECE(X,"^",16)
SET $PIECE(LA7X,"^",4)=$PIECE(X,"^",16)
End DoDot:1
+88 ;
+89 QUIT LA7X
+90 ;
+91 ;
BINDX ; Build index of tests for a shipping configuration.
+1 ; Called from above.
+2 ;
+3 IF '$DATA(^LAHM(62.9,LA7SCFG,0))
QUIT
+4 NEW LA760,LA761,LA762,LA76205,LA764,LA7HL,LA7NLT,LA7NLTN,LA7TC,LA7X
+5 SET LA7X=0
+6 FOR
SET LA7X=$ORDER(^LAHM(62.9,LA7SCFG,60,LA7X))
IF 'LA7X
QUIT
DO BLD
+7 QUIT
+8 ;
+9 ;
BLD ; Build TMP global for a test
+1 ; Called from above
+2 ;
+3 SET LA7X(0)=$GET(^LAHM(62.9,LA7SCFG,60,LA7X,0))
+4 SET LA7X(5)=$GET(^LAHM(62.9,LA7SCFG,60,LA7X,5))
+5 ;
+6 ; Laboratory test/collection sample.
+7 SET LA760=$PIECE(LA7X(0),"^")
SET LA762=$PIECE(LA7X(0),"^",9)
+8 ; Incomplete entry.
+9 IF 'LA760!('LA762)
QUIT
+10 ;
+11 ; Test urgency/HL7 priority code.
+12 SET LA76205=$PIECE(LA7X(0),"^",4)
SET LA76205("HL")=""
+13 IF LA76205
SET LA76205("HL")=$$GET1^DIQ(62.05,LA76205_",","LEDI HL7:HL7 ABBR")
+14 ;
+15 ; Topography
+16 SET LA761=$$GET1^DIQ(62,LA762_",",2,"I")
+17 ; Incomplete entry.
IF 'LA761
IF "BBCH"[$PIECE(^LAB(60,LA760,0),"^",4)
QUIT
+18 ; Handle MI with no topography associated with collection sample.
+19 IF 'LA761
IF $PIECE(^LAB(60,LA760,0),"^",4)="MI"
SET LA761=+$PIECE(LA7X(0),"^",3)
+20 ;
+21 ; Use HL7 specimen code if using table 0070 else use mapping in 62.9
+22 SET LA7HL=""
+23 IF LA761NCS="HL70070"
SET LA7HL=$$GET1^DIQ(61,LA761_",","LEDI HL7:HL7 ABBR")
+24 IF LA7HL=""
SET LA7HL=$PIECE(LA7X(5),"^",3)
+25 ;
+26 ; File #64 ien/NLT code/NLT code test name.
+27 ; Use NLT code if using VA coding else use non-VA test order code.
+28 SET LA764=+$$GET1^DIQ(60,LA760_",",64,"I")
+29 SET LA7NLT=$$GET1^DIQ(64,LA764_",",1)
+30 SET LA7NLTN=$$GET1^DIQ(64,LA764_",",.01)
+31 IF LA764NCS="99VA64"
SET LA7TC=LA7NLT
+32 IF '$TEST
SET LA7TC=$PIECE(LA7X(5),"^")
+33 ;
+34 ; Set TMP global with information
+35 IF LA7HL'=""
IF LA7TC'=""
Begin DoDot:1
+36 IF "MISPCYEM"[$PIECE(^LAB(60,LA760,0),"^",4)
IF $PIECE(LA7X(5),"^",7)'=""
Begin DoDot:2
+37 SET ^TMP("LA7TC",$JOB,LA7SCFG,LA7TC,LA7HL,0,$PIECE(LA7X(5),"^",7))=LA760_"^"_LA761_"^"_LA762_"^^"_LA7NLT_"^"_LA7NLTN
End DoDot:2
+38 IF '$TEST
SET ^TMP("LA7TC",$JOB,LA7SCFG,LA7TC,LA7HL)=LA760_"^"_LA761_"^"_LA762_"^^"_LA7NLT_"^"_LA7NLTN
+39 IF LA76205("HL")'=""
Begin DoDot:2
+40 IF "MISPCYEM"[$PIECE(^LAB(60,LA760,0),"^",4)
IF $PIECE(LA7X(5),"^",7)'=""
Begin DoDot:3
+41 SET ^TMP("LA7TC",$JOB,LA7SCFG,LA7TC,LA7HL,LA76205("HL"),$PIECE(LA7X(5),"^",7))=LA760_"^"_LA761_"^"_LA762_"^"_LA76205_"^"_LA7NLT_"^"_LA7NLTN
End DoDot:3
+42 IF '$TEST
SET ^TMP("LA7TC",$JOB,LA7SCFG,LA7TC,LA7HL,LA76205("HL"))=LA760_"^"_LA761_"^"_LA762_"^"_LA76205_"^"_LA7NLT_"^"_LA7NLTN
End DoDot:2
End DoDot:1
+43 ;
+44 ; Set TMP global when collection sample does not have a topography.
+45 ; Used for "MISPCYEM" subscripts which can have collection sample with no tpopgraphy.
+46 IF LA7TC'=""
IF 'LA761
IF "MISPCYEM"[$PIECE(^LAB(60,LA760,0),"^",4)
Begin DoDot:1
+47 SET ^TMP("LA7TC",$JOB,LA7SCFG,LA7TC,"XXX")=LA760_"^"_LA761_"^"_LA762_"^^"_LA7NLT_"^"_LA7NLTN
+48 IF LA76205("HL")'=""
SET ^TMP("LA7TC",$JOB,LA7SCFG,LA7TC,"XXX",LA76205("HL"))=LA760_"^"_LA761_"^"_LA762_"^"_LA76205_"^"_LA7NLT_"^"_LA7NLTN
End DoDot:1
+49 ;
+50 QUIT
