Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7SMU2

LA7SMU2.m

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