LRSRVR9 ;BPFO/DTG - LAB NTRT DATA SERVER CONT'D MISSING VUID EXTRACT ;02/10/2016
;;5.2;LAB SERVICE;**468**;FEB 10 2016;Build 64
;
; Based on LRSRVR2,LRSRVR2A
;
EN ; Called by option [LR NTRT MLTF EXTRACT]
; Entry point for the option - user must capture output
N DIR,DIRUT,LREND,LRCNT,LRSUB,LRVAL,LRST,LRSTN,LRTXT,X,Y
S DIR(0)="Y",DIR("A")="Ready to Capture",DIR("B")="Yes"
D ^DIR
I $D(DIRUT) Q
D WAIT^DICD
W !,"... Excuse Me This May Take a Few Moments ..."
;
S LRSUB="MLTF",LRTXT=1
D BUILD
W !
S LRL=0
F S LRL=$O(^TMP($J,"LRDATA",LRL)) Q:LRL<1 W !,^(LRL)
D CLEAN^LRSRVR9A
K LRSUB
Q
;
;
SERVER ; Server entry Point
N I,LRCNT,LREND,LRL,LRMSUBJ,LRTXT,LRX,LRY
S LRTXT=0
D BUILD
S LRMSUBJ=LRST_" "_LRSTN_" MLTF "_$$HTE^XLFDT($H,"1M")
D MAILSEND^LRSRVR9A(LRMSUBJ)
D CLEAN^LRSRVR9A
Q
;
;
BUILD ; Build extract
N I,LR6206,LR64,LRCNT,LRCRLF,LRLEN,LRQUIT,LRROOT,LRSTNOTE,LRSS,LRSTR,LRSTUB,LRVAL
N LSITE,LRNT,LRNTI,AR,LRSUBSCRIPT,LRTYPER,LRVLOINC,LA7TREE,LRMISP,A
N LR60IEN,LR60NM,LRCDEF,LRCREATE,LREXPY,LRINACT,LRLNC,LRLNC80,LRLNCN,LRLNCX,LRNODE,LRR64,LRSPEC60,LRSPECCT,LRSPECN,LRSPECTA,LRUNIT
D GET664
; to show missing specimens set LRMISP=1
S LRMISP=0
S LRVAL=$$SITE^VASITE,LRST=$P(LRVAL,"^",3),LRSTN=$P(LRVAL,"^",2)
S LRSUBSCRIPT=$G(LRNTI(.07,"I")) I LRSUBSCRIPT="" S LRSUBSCRIPT=1 ; default to CH only
I LRST="" S LRST="???"
K ^TMP($J,"LRDATA"),^TMP($J,"LR60")
S LRCNT=0,LRCRLF=$C(13,10),LRSTR=""
F I=0,1,2,3,4 S LRCNT(I)=0
D HDR^LRSRVR9A
;
; Step down the B X-ref - exclude synomyms
S LRROOT="^LAB(60,""B"")"
F S LRROOT=$Q(@LRROOT) Q:LRROOT="" Q:$QS(LRROOT,2)'="B" D
. Q:$G(@LRROOT)
. D TEST
;
; Process microbiology antibiotics
S LR6206=0,LRSS="MI"
F S LR6206=$O(^LAB(62.06,LR6206)) Q:'LR6206 D
. S LR64=$$GET1^DIQ(62.06,LR6206_",",64,"I")
. S LRX=$$MICRO(LR64)
. I $P(LRX,"|",5)="" S $P(LRX,"|",5)=$$GET1^DIQ(62.06,LR6206_",",.01)
. S LRSTUB="",$P(LRSTUB,"|",29)="",$P(LRSTUB,"|",($S(LRMISP=1:29,1:28)))="1.1"
. S $P(LRSTUB,"|",1)=$P(LRX,"|",5),$P(LRSTUB,"|",5)=$P(LRX,"|",3)
. S $P(LRSTUB,"|",6)=$P(LRX,"|",1),$P(LRSTUB,"|",9)=$P(LRX,"|",20),$P(LRSTUB,"|",10)=$P(LRX,"|",19)
. I LR64 S $P(LRSTUB,"|",25)=$$GET1^DIQ(64,LR64_",",25)
. S LRSTR=LRSTR_LRST_"-"_LR64_"-"_"AB"_LR6206_"|"_LRSTUB
. I 'LRTXT S LRSTR=LRSTR_LRCRLF
. D SETDATA S LRCNT=LRCNT+1,LRCNT(3)=LRCNT(3)+1
;
;
; Set the final info into the ^TMP message global
I 'LRTXT D
. S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
. I LRSTR'="" S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR9A(LRSTR)
. S ^TMP($J,"LRDATA",LRNODE+1)=" "
. S ^TMP($J,"LRDATA",LRNODE+2)="end"
;
S ^TMP($J,"LRDATA",6)="Total number of records: "_$J(LRCNT,5)
S ^TMP($J,"LRDATA",7)="Total number of tests..: "_$J(LRCNT(0),5)
S ^TMP($J,"LRDATA",8)="Tests with MLTF'S.......: "_$J(LRCNT(1),5)
S ^TMP($J,"LRDATA",9)="Tests with Mapped LOINC.: "_$J(LRCNT(4),5)
S ^TMP($J,"LRDATA",10)="Tests with NLT code....: "_$J(LRCNT(2),5)
S ^TMP($J,"LRDATA",11)="Antimicrobials.........: "_$J(LRCNT(3),5)
;
Q
;
;
TEST ; Pull out test info
N LA7TREE,LR60,LRBATTY,LRBATTYN,LRTSTTYP
K LROUT,LRSPEC,ERR
S LR60NM=$QS(LRROOT,3),LR60IEN=$QS(LRROOT,4)
S LR60NM=$$TRIM^XLFSTR(LR60NM,"RL"," ")
S LRTSTTYP=$P(^LAB(60,LR60IEN,0),"^",3)
;
; Bypass "neither" type tests.
I LRTSTTYP="N"!(LRTSTTYP="D") Q
; Bypass "workload" type tests.
S LRTYPER=$P(^LAB(60,LR60IEN,0),"^",4)
S A=$P($P(^LAB(60,LR60IEN,0),"^",5),";",1)
I LRTYPER=""&(A'="") G TESTGOOD
I LRTYPER="" Q
I LRTYPER="WK" Q
;I LRTYPER="CH"&((LRSUBSCRIPT=1)!(LRSUBSCRIPT=7)!(LRSUBSCRIPT=8)) G TESTGOOD
;I LRTYPER="MI"&((LRSUBSCRIPT=2)!(LRSUBSCRIPT=7)!(LRSUBSCRIPT=8)) G TESTGOOD
;I LRTYPER="EM"&((LRSUBSCRIPT=3)!(LRSUBSCRIPT=8)) G TESTGOOD
;I LRTYPER="SP"&((LRSUBSCRIPT=4)!(LRSUBSCRIPT=8)) G TESTGOOD
;I LRTYPER="CY"&((LRSUBSCRIPT=5)!(LRSUBSCRIPT=8)) G TESTGOOD
;I LRTYPER="AU"&((LRSUBSCRIPT=6)!(LRSUBSCRIPT=8)) G TESTGOOD
; Q ; doesn't match up
;
TESTGOOD ;
S LRBATTY=LRST_"-"_LR60IEN,LRBATTYN=LR60NM
S LRBATTY=$$TRIM^XLFSTR(LRBATTY,"RL"," ")
; Panel test
; Bypass "output panel" type tests - usually used for display only.
I $O(^LAB(60,LR60IEN,2,0)) D Q
. I $P(^LAB(60,LR60IEN,0),"^",3)="O" Q
. D UNWIND^LRSRVR9A(LR60IEN,9,0)
. S LR60=0
. F S LR60=$O(LA7TREE(LR60)) Q:'LR60 D
. . I $D(^TMP($J,"LR60",LR60)) Q
. . S LR60IEN=LR60,LR60NM=$P(^LAB(60,LR60IEN,0),"^")
. . S LRTSTTYP=$P(^LAB(60,LR60IEN,0),"^",3)
. . ; Bypass "neither" type tests.
. . I LRTSTTYP="N"!(LRTSTTYP="D") Q
. . ; Bypass "workload" type tests.
. . I $P(^LAB(60,LR60IEN,0),"^",4)="WK" Q
. . ;I $P(^LAB(60,LR60IEN,0),"^",4)'="CH" Q
. . S LRR64=+$P($G(^LAB(60,+LR60IEN,64)),U,2)
. . D SPEC
;
I $D(^TMP($J,"LR60",LR60IEN)) Q
; Not a panel test
; Get result NLT code
S LRR64=+$P($G(^LAB(60,+LR60IEN,64)),U,2)
D SPEC
Q
;
;
SPEC ; Check each specimen for this test
K LRSPEC,LROUT
S (LRCDEF,LRSPEC,LRSPECN,LRLNC,LRLNCN,LRLNCX,LRLNC80,LRUNIT,Y)=""
D SITENOTE^LRSRVR9A
D SYNNOTE
S LRSPEC60=0,LRSPECCT=0
F S LRSPEC60=$O(^LAB(60,+LR60IEN,1,LRSPEC60)) Q:'LRSPEC60 S LRSPECCT=LRSPECCT+1 D
. Q:'($D(^LAB(60,+LR60IEN,1,LRSPEC60,0))#2)
. S LRUNIT=$P(^LAB(60,+LR60IEN,1,LRSPEC60,0),U,7)
. S X=$G(^LAB(61,LRSPEC60,0))
. S LRSPECN=$P(X,"^"),LRSPECTA=$P(X,"^",10)
. S LRSPEC(LRSPEC60_"-0")=LRSPEC60_U_LRSPECN_U_LRSPECTA_U_LRUNIT_U_LRR64
. I LRR64,$P($$GET1^DIQ(64,LRR64_",",1,"E"),".",2)="0000" D SUFFIX^LRSRVR9A
I LRSPECCT=0&(LRMISP=1) D NOSPEC Q
D SPECLOOP
Q
;
;
SPECLOOP ; Check to see if specimen has been linked to LOINC
;
N LR64,LR6421,LRINDX,LRLNTA,LRRNLT,LRTA,LRX,X,LRVUID,AAA,LRVUIDN,LRVUIDAN,LRVLOINC,LRSUBMIT,LRSCREATE
S LRINDX=0,(LRVUID,LRVUIDAN,LRVLOINC,LRVUIDN,LRSUBMIT,LRSCREATE)=""
F S LRINDX=$O(LRSPEC(LRINDX)) Q:'LRINDX D
. S X=LRSPEC(LRINDX)
. S LRSPEC=$P(X,U),LRSPECN=$P(X,U,2),LRLNTA=$P(X,U,3),LR64=$P(X,U,5),LRUNIT=$$TRIM^XLFSTR($P(X,U,4),"RL"," ")
. S (LR6421,LRLNC,LRRNLT,LRTA)="",(LRVUID,LRVUIDAN,LRVLOINC,LRVUIDN,LRSUBMIT,LRSCREATE)=""
. S AAA=+LR60IEN
. S LRVUID=$$GET1^DIQ(60.01,LRSPEC_","_AAA,30,"I")
. I LRVUID'="" S LRVUIDAN=$$GET1^DIQ(66.3,LRVUID_",",.02),LRVLOINC=$$GET1^DIQ(66.3,LRVUID_",",.04),LRVUIDN=$$GET1^DIQ(66.3,LRVUID,.01,"E")
. S LRSUBMIT=$$GET1^DIQ(60.01,LRSPEC_","_AAA,34,"I")
. I LR64 D
. . S LRRNLT=$$GET1^DIQ(64,LR64_",",1,"E")
. . S LR6421=$$GET1^DIQ(64,LR64_",",13,"I")
. . S AAA=+LR60IEN
. . S LRCREATE=$$GET1^DIQ(60.01,LRSPEC_","_AAA,35,"I"),LRCREATE=$S(LRCREATE'="":"Y",1:"")
. . S LREXPY=$$GET1^DIQ(60.01,LRSPEC_","_AAA,34,"I")
. . S LRINACT=$$GET1^DIQ(60.01,LRSPEC_","_AAA,32,"I")
. . S LRX=""
. . I LRSPEC,LRLNTA S LRX=$P($G(^LAM(LR64,5,LRSPEC,1,LRLNTA,1)),"^")
. . I LRX="",LRSPEC D
. . . S X=$O(^LAM(LR64,5,LRSPEC,1,0))
. . . I X S LRLNTA=X,LRX=$P($G(^LAM(LR64,5,LRSPEC,1,X,1)),"^")
. . I LRX'="" S LRLNC=$$GET1^DIQ(95.3,LRX_",",.01,"E")
. . I LRLNTA S LRTA=$$GET1^DIQ(64.061,LRLNTA_",",.01,"E")
. D WRT
Q
;
;
NOSPEC ; for test without specimens
N LRSS,II,III,LRNOS,AA,BB
S ^TMP($J,"LR60",LR60IEN)=""
S LRNOS="^TMP($J,""LRNOSPEC"")"
K @LRNOS
F II=1:1:30 S @LRNOS@(II)=""
S @LRNOS@(29)="MISSING SPECIMEN"
S @LRNOS@(30)="1.1"
S LRSS=$$GET1^DIQ(60,LR60IEN_",",4,"I")
S @LRNOS@(1)=LRST_"-"_LR60IEN
S @LRNOS@(2)=LR60NM
;S LRSTR=LRSTR_LRST_"-"_LR60IEN_"|"_LR60NM_"|||||||"
S @LRNOS@(11)=$$GET1^DIQ(60,LR60IEN_",",4,"I")
; Test info - data type, help prompt
I LRSS="CH" S X=$$TSTTYP^LRSRVR9A($$GET1^DIQ(60,LR60IEN_",",13)),@LRNOS@(12)=$P(X,"|"),@LRNOS@(13)=$P(X,"|",2)
; Send site's test notes on first record for this test.
I LRSTNOTE D
. ;D SETDATA
. S LRJ="LRSTNOTE"
. F III=1:1 S LRJ=$Q(@LRJ) Q:LRJ="" D
. . S X=@LRJ I X["|" S X=$TR(X,"|","~")
. . S @LRNOS@(19,III)=X
. S LRSTNOTE=0
;
; Send site's test synonym's on first record for this test.
I LRSTSYN D
. S LRJ="LRSTSYN"
. F III=1:1 S LRJ=$Q(@LRJ) Q:LRJ="" S @LRNOS@(20,III)=LRJ_"^" ;S LRSTR=LRSTR_@LRJ_"^" D SETDATA
. S LRSTSYN=0
;
; Send file #60 test type
S @LRNOS@(21)=LRTSTTYP
;
S LRSTR=LRSTR_$G(@LRNOS@(1)),AA=1
F S AA=$O(@LRNOS@(AA)) Q:'AA S BB=$G(@LRNOS@(AA)) D
. I AA=19!(AA=20) D SETDATA,NOSPEC1 Q
. S LRSTR=LRSTR_"|"_BB D SETDATA
;
S LRSTR=LRSTR_"|"
I 'LRTXT S LRSTR=LRSTR_LRCRLF
D SETDATA
;
S LRCNT=LRCNT+1,LRCNT(0)=LRCNT(0)+1
K @LRNOS
K II,III,LRNOS,AA,BB
Q
;
NOSPEC1 ; Process site notes
N CC,DD
S CC=0 F S CC=$O(@LRNOS@(AA,CC)) Q:'CC S DD=$G(@LRNOS@(AA,CC)) D
. S LRSTR=LRSTR_DD D SETDATA
S LRSTR=LRSTR_"|"
K CC,DD
Q
;
WRT ; Set ^TMP( with extracted data
N LRJ,LREN,LRQUIT,LRSS,X,Y
;
; Set flag that this file #60 test has been processed - avoid duplicate
; processing as component of panel and individual test
S ^TMP($J,"LR60",LR60IEN)=""
;
S LRSTR=LRSTR_LRST_"-"_LR60IEN_"-"_LRINDX
S LRSTR=LRSTR_"|"_LR60NM_"|"_LRSPECN_"|"_LRTA_"|"_LRUNIT_"|"_LRLNC_"|"_LRRNLT_"|"_LRBATTY_"|"_LRBATTYN_"|"
;
; Lab section specified for this NLT code.
S LRSTR=LRSTR_$S($G(LR6421)>0:$$GET1^DIQ(64.21,LR6421_",",1),1:"")_"|"
;
; Subscript
S LRSS=$$GET1^DIQ(60,LR60IEN_",",4,"I")
S LRSTR=LRSTR_LRSS_"|"
; Test info - data type, help prompt
I LRSS'="CH" S LRSTR=LRSTR_"||"
I LRSS="CH" S X=$$TSTTYP^LRSRVR9A($$GET1^DIQ(60,LR60IEN_",",13)) S LRSTR=LRSTR_$P(X,"|")_"|"_$P(X,"|",2)_"|"
;
; Test reference low|reference high|therapeutic low|therapeutic high|
S X=$G(^LAB(60,LR60IEN,1,LRSPEC,0))
S Y=$P(X,"^",2)_"|"_$P(X,"^",3)_"|"_$P(X,"^",11)_"|"_$P(X,"^",12)
S LRSTR=LRSTR_$TR(Y,$C(34),"")
; Use for reference lab testing
S X=$G(^LAB(60,LR60IEN,1,LRSPEC,.1))
S LRSTR=LRSTR_"|"_$S($P(X,"^")=1:"YES",1:"NO")_"|"
;
; Send site's test notes on first record for this test.
I LRSTNOTE D
. D SETDATA
. S LRJ="LRSTNOTE"
. F S LRJ=$Q(@LRJ) Q:LRJ="" D
. . S X=@LRJ I X["|" S X=$TR(X,"|","~")
. . S LRSTR=LRSTR_X D SETDATA
. S LRSTNOTE=0
S LRSTR=LRSTR_"|"
;
; Send site's test synonym's on first record for this test.
I LRSTSYN D
. D SETDATA
. S LRJ="LRSTSYN"
. F S LRJ=$Q(@LRJ) Q:LRJ="" S LRSTR=LRSTR_@LRJ_"^" D SETDATA
. S LRSTSYN=0
;
; Send file #60 test type
S LRSTR=LRSTR_"|"_LRTSTTYP_"|"
;
; mltf info
I LRVUID'="" D
. S LRSTR=LRSTR_LRVUID D SETDATA
S LRSTR=LRSTR_"|"
I LRVLOINC'="" D
. S LRSTR=LRSTR_LRVLOINC D SETDATA
S LRSTR=LRSTR_"|"
I LRVUIDN'="" D
. ;D SETDATA
. S LRSTR=LRSTR_LRVUIDN D SETDATA
S LRSTR=LRSTR_"|"
I LRVUIDAN'="" D
. ;D SETDATA
. S LRSTR=LRSTR_LRVUIDAN D SETDATA
S LRSTR=LRSTR_"|"
;
D SETDATA
; Send default LOINC code
I LR64 S LRSTR=LRSTR_$$GET1^DIQ(64,LR64_",",25)
S LRSTR=LRSTR_"|"
;submited to ntrt
S LRSTR=LRSTR_LRSUBMIT_"|"
;create date
S LRSTR=LRSTR_LRSCREATE_"|"
;
; Set extract version number
S LRSTR=LRSTR_($S(LRMISP=1:"|",1:""))_"1.1|"
;S LRSTR=LRSTR_"|1.1|"
;
I 'LRTXT S LRSTR=LRSTR_LRCRLF
D SETDATA
;
S LRCNT=LRCNT+1,LRCNT(0)=LRCNT(0)+1
I LRVUID'="" S LRCNT(1)=LRCNT(1)+1
I LRLNC'="" S LRCNT(4)=LRCNT(4)+1
I LR64 S LRCNT(2)=LRCNT(2)+1
Q
;
;
SETDATA ; Set data into report structure
S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
I LRTXT S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=LRSTR,LRSTR="" Q
I 'LRTXT D ENCODE^LRSRVR9A(.LRSTR)
Q
;
SYNNOTE ; Build site's test synonym's for first record
;
K LRSTSYN
S LRSTSYN=0
M LRSTSYN=^LAB(60,LR60IEN,5)
K LRSTSYN(0),LRSTSYN("B")
I $D(LRSTSYN) S LRSTSYN=1
Q
;
MICRO(LR64) ;
N LOINCDTB,LR6421,LRPNTB,LRSTUB
S LRSTUB=""
D GETS^DIQ(64,LR64,".01;1;13;25;25.5","IE","LOINCDTB","LRERR")
D GETS^DIQ(64,LR64,"20*","IE","LOINCDTA","LRERR")
S LRPNTB=$O(LOINCDTB(64,"")) Q:LRPNTB="" LRSTUB
;
; NLT Code/Procedure
S LRSTUB=$G(LOINCDTB(64,LRPNTB,1,"E"))
S $P(LRSTUB,"|",2)=$G(LOINCDTB(64,LRPNTB,.01,"I"))
;
; Default LOINC code/name
S $P(LRSTUB,"|",3)=$G(LOINCDTB(64,LRPNTB,25,"E"))
S $P(LRSTUB,"|",4)=$G(^LAB(95.3,+$G(LOINCDTB(64,LRPNTB,25,"I")),81))
;
; Anti-microbial Suscept (62.06,.01)
S $P(LRSTUB,"|",5)=$$GET1^DIQ(62.06,LR6206_",",.01)
;
; Lab subscript/section
S $P(LRSTUB,"|",19)=LRSS
I $G(LOINCDTB(64,LRPNTB,13,"I")) D ; Lab section
. S LR6421=LOINCDTB(64,LRPNTB,13,"I")
. S $P(LRSTUB,"|",20)=$$GET1^DIQ(64.21,LR6421_",",1)
;
Q LRSTUB
;
GET664 ; get file 66.4 info
S LSITE=$$SITE^VASITE,LSITE=$P(LSITE,U,1)
S LRNT=$O(^LAB(66.4,"B",LSITE,0))
D GETS^DIQ(66.4,LRNT_",","**","IE","AR")
M LRNTI=AR("66.4",LRNT_",") K AR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRSRVR9 12545 printed Oct 16, 2024@18:21:40 Page 2
LRSRVR9 ;BPFO/DTG - LAB NTRT DATA SERVER CONT'D MISSING VUID EXTRACT ;02/10/2016
+1 ;;5.2;LAB SERVICE;**468**;FEB 10 2016;Build 64
+2 ;
+3 ; Based on LRSRVR2,LRSRVR2A
+4 ;
EN ; Called by option [LR NTRT MLTF EXTRACT]
+1 ; Entry point for the option - user must capture output
+2 NEW DIR,DIRUT,LREND,LRCNT,LRSUB,LRVAL,LRST,LRSTN,LRTXT,X,Y
+3 SET DIR(0)="Y"
SET DIR("A")="Ready to Capture"
SET DIR("B")="Yes"
+4 DO ^DIR
+5 IF $DATA(DIRUT)
QUIT
+6 DO WAIT^DICD
+7 WRITE !,"... Excuse Me This May Take a Few Moments ..."
+8 ;
+9 SET LRSUB="MLTF"
SET LRTXT=1
+10 DO BUILD
+11 WRITE !
+12 SET LRL=0
+13 FOR
SET LRL=$ORDER(^TMP($JOB,"LRDATA",LRL))
if LRL<1
QUIT
WRITE !,^(LRL)
+14 DO CLEAN^LRSRVR9A
+15 KILL LRSUB
+16 QUIT
+17 ;
+18 ;
SERVER ; Server entry Point
+1 NEW I,LRCNT,LREND,LRL,LRMSUBJ,LRTXT,LRX,LRY
+2 SET LRTXT=0
+3 DO BUILD
+4 SET LRMSUBJ=LRST_" "_LRSTN_" MLTF "_$$HTE^XLFDT($HOROLOG,"1M")
+5 DO MAILSEND^LRSRVR9A(LRMSUBJ)
+6 DO CLEAN^LRSRVR9A
+7 QUIT
+8 ;
+9 ;
BUILD ; Build extract
+1 NEW I,LR6206,LR64,LRCNT,LRCRLF,LRLEN,LRQUIT,LRROOT,LRSTNOTE,LRSS,LRSTR,LRSTUB,LRVAL
+2 NEW LSITE,LRNT,LRNTI,AR,LRSUBSCRIPT,LRTYPER,LRVLOINC,LA7TREE,LRMISP,A
+3 NEW LR60IEN,LR60NM,LRCDEF,LRCREATE,LREXPY,LRINACT,LRLNC,LRLNC80,LRLNCN,LRLNCX,LRNODE,LRR64,LRSPEC60,LRSPECCT,LRSPECN,LRSPECTA,LRUNIT
+4 DO GET664
+5 ; to show missing specimens set LRMISP=1
+6 SET LRMISP=0
+7 SET LRVAL=$$SITE^VASITE
SET LRST=$PIECE(LRVAL,"^",3)
SET LRSTN=$PIECE(LRVAL,"^",2)
+8 ; default to CH only
SET LRSUBSCRIPT=$GET(LRNTI(.07,"I"))
IF LRSUBSCRIPT=""
SET LRSUBSCRIPT=1
+9 IF LRST=""
SET LRST="???"
+10 KILL ^TMP($JOB,"LRDATA"),^TMP($JOB,"LR60")
+11 SET LRCNT=0
SET LRCRLF=$CHAR(13,10)
SET LRSTR=""
+12 FOR I=0,1,2,3,4
SET LRCNT(I)=0
+13 DO HDR^LRSRVR9A
+14 ;
+15 ; Step down the B X-ref - exclude synomyms
+16 SET LRROOT="^LAB(60,""B"")"
+17 FOR
SET LRROOT=$QUERY(@LRROOT)
if LRROOT=""
QUIT
if $QSUBSCRIPT(LRROOT,2)'="B"
QUIT
Begin DoDot:1
+18 if $GET(@LRROOT)
QUIT
+19 DO TEST
End DoDot:1
+20 ;
+21 ; Process microbiology antibiotics
+22 SET LR6206=0
SET LRSS="MI"
+23 FOR
SET LR6206=$ORDER(^LAB(62.06,LR6206))
if 'LR6206
QUIT
Begin DoDot:1
+24 SET LR64=$$GET1^DIQ(62.06,LR6206_",",64,"I")
+25 SET LRX=$$MICRO(LR64)
+26 IF $PIECE(LRX,"|",5)=""
SET $PIECE(LRX,"|",5)=$$GET1^DIQ(62.06,LR6206_",",.01)
+27 SET LRSTUB=""
SET $PIECE(LRSTUB,"|",29)=""
SET $PIECE(LRSTUB,"|",($SELECT(LRMISP=1:29,1:28)))="1.1"
+28 SET $PIECE(LRSTUB,"|",1)=$PIECE(LRX,"|",5)
SET $PIECE(LRSTUB,"|",5)=$PIECE(LRX,"|",3)
+29 SET $PIECE(LRSTUB,"|",6)=$PIECE(LRX,"|",1)
SET $PIECE(LRSTUB,"|",9)=$PIECE(LRX,"|",20)
SET $PIECE(LRSTUB,"|",10)=$PIECE(LRX,"|",19)
+30 IF LR64
SET $PIECE(LRSTUB,"|",25)=$$GET1^DIQ(64,LR64_",",25)
+31 SET LRSTR=LRSTR_LRST_"-"_LR64_"-"_"AB"_LR6206_"|"_LRSTUB
+32 IF 'LRTXT
SET LRSTR=LRSTR_LRCRLF
+33 DO SETDATA
SET LRCNT=LRCNT+1
SET LRCNT(3)=LRCNT(3)+1
End DoDot:1
+34 ;
+35 ;
+36 ; Set the final info into the ^TMP message global
+37 IF 'LRTXT
Begin DoDot:1
+38 SET LRNODE=$ORDER(^TMP($JOB,"LRDATA",""),-1)
+39 IF LRSTR'=""
SET LRNODE=LRNODE+1
SET ^TMP($JOB,"LRDATA",LRNODE)=$$UUEN^LRSRVR9A(LRSTR)
+40 SET ^TMP($JOB,"LRDATA",LRNODE+1)=" "
+41 SET ^TMP($JOB,"LRDATA",LRNODE+2)="end"
End DoDot:1
+42 ;
+43 SET ^TMP($JOB,"LRDATA",6)="Total number of records: "_$JUSTIFY(LRCNT,5)
+44 SET ^TMP($JOB,"LRDATA",7)="Total number of tests..: "_$JUSTIFY(LRCNT(0),5)
+45 SET ^TMP($JOB,"LRDATA",8)="Tests with MLTF'S.......: "_$JUSTIFY(LRCNT(1),5)
+46 SET ^TMP($JOB,"LRDATA",9)="Tests with Mapped LOINC.: "_$JUSTIFY(LRCNT(4),5)
+47 SET ^TMP($JOB,"LRDATA",10)="Tests with NLT code....: "_$JUSTIFY(LRCNT(2),5)
+48 SET ^TMP($JOB,"LRDATA",11)="Antimicrobials.........: "_$JUSTIFY(LRCNT(3),5)
+49 ;
+50 QUIT
+51 ;
+52 ;
TEST ; Pull out test info
+1 NEW LA7TREE,LR60,LRBATTY,LRBATTYN,LRTSTTYP
+2 KILL LROUT,LRSPEC,ERR
+3 SET LR60NM=$QSUBSCRIPT(LRROOT,3)
SET LR60IEN=$QSUBSCRIPT(LRROOT,4)
+4 SET LR60NM=$$TRIM^XLFSTR(LR60NM,"RL"," ")
+5 SET LRTSTTYP=$PIECE(^LAB(60,LR60IEN,0),"^",3)
+6 ;
+7 ; Bypass "neither" type tests.
+8 IF LRTSTTYP="N"!(LRTSTTYP="D")
QUIT
+9 ; Bypass "workload" type tests.
+10 SET LRTYPER=$PIECE(^LAB(60,LR60IEN,0),"^",4)
+11 SET A=$PIECE($PIECE(^LAB(60,LR60IEN,0),"^",5),";",1)
+12 IF LRTYPER=""&(A'="")
GOTO TESTGOOD
+13 IF LRTYPER=""
QUIT
+14 IF LRTYPER="WK"
QUIT
+15 ;I LRTYPER="CH"&((LRSUBSCRIPT=1)!(LRSUBSCRIPT=7)!(LRSUBSCRIPT=8)) G TESTGOOD
+16 ;I LRTYPER="MI"&((LRSUBSCRIPT=2)!(LRSUBSCRIPT=7)!(LRSUBSCRIPT=8)) G TESTGOOD
+17 ;I LRTYPER="EM"&((LRSUBSCRIPT=3)!(LRSUBSCRIPT=8)) G TESTGOOD
+18 ;I LRTYPER="SP"&((LRSUBSCRIPT=4)!(LRSUBSCRIPT=8)) G TESTGOOD
+19 ;I LRTYPER="CY"&((LRSUBSCRIPT=5)!(LRSUBSCRIPT=8)) G TESTGOOD
+20 ;I LRTYPER="AU"&((LRSUBSCRIPT=6)!(LRSUBSCRIPT=8)) G TESTGOOD
+21 ; Q ; doesn't match up
+22 ;
TESTGOOD ;
+1 SET LRBATTY=LRST_"-"_LR60IEN
SET LRBATTYN=LR60NM
+2 SET LRBATTY=$$TRIM^XLFSTR(LRBATTY,"RL"," ")
+3 ; Panel test
+4 ; Bypass "output panel" type tests - usually used for display only.
+5 IF $ORDER(^LAB(60,LR60IEN,2,0))
Begin DoDot:1
+6 IF $PIECE(^LAB(60,LR60IEN,0),"^",3)="O"
QUIT
+7 DO UNWIND^LRSRVR9A(LR60IEN,9,0)
+8 SET LR60=0
+9 FOR
SET LR60=$ORDER(LA7TREE(LR60))
if 'LR60
QUIT
Begin DoDot:2
+10 IF $DATA(^TMP($JOB,"LR60",LR60))
QUIT
+11 SET LR60IEN=LR60
SET LR60NM=$PIECE(^LAB(60,LR60IEN,0),"^")
+12 SET LRTSTTYP=$PIECE(^LAB(60,LR60IEN,0),"^",3)
+13 ; Bypass "neither" type tests.
+14 IF LRTSTTYP="N"!(LRTSTTYP="D")
QUIT
+15 ; Bypass "workload" type tests.
+16 IF $PIECE(^LAB(60,LR60IEN,0),"^",4)="WK"
QUIT
+17 ;I $P(^LAB(60,LR60IEN,0),"^",4)'="CH" Q
+18 SET LRR64=+$PIECE($GET(^LAB(60,+LR60IEN,64)),U,2)
+19 DO SPEC
End DoDot:2
End DoDot:1
QUIT
+20 ;
+21 IF $DATA(^TMP($JOB,"LR60",LR60IEN))
QUIT
+22 ; Not a panel test
+23 ; Get result NLT code
+24 SET LRR64=+$PIECE($GET(^LAB(60,+LR60IEN,64)),U,2)
+25 DO SPEC
+26 QUIT
+27 ;
+28 ;
SPEC ; Check each specimen for this test
+1 KILL LRSPEC,LROUT
+2 SET (LRCDEF,LRSPEC,LRSPECN,LRLNC,LRLNCN,LRLNCX,LRLNC80,LRUNIT,Y)=""
+3 DO SITENOTE^LRSRVR9A
+4 DO SYNNOTE
+5 SET LRSPEC60=0
SET LRSPECCT=0
+6 FOR
SET LRSPEC60=$ORDER(^LAB(60,+LR60IEN,1,LRSPEC60))
if 'LRSPEC60
QUIT
SET LRSPECCT=LRSPECCT+1
Begin DoDot:1
+7 if '($DATA(^LAB(60,+LR60IEN,1,LRSPEC60,0))#2)
QUIT
+8 SET LRUNIT=$PIECE(^LAB(60,+LR60IEN,1,LRSPEC60,0),U,7)
+9 SET X=$GET(^LAB(61,LRSPEC60,0))
+10 SET LRSPECN=$PIECE(X,"^")
SET LRSPECTA=$PIECE(X,"^",10)
+11 SET LRSPEC(LRSPEC60_"-0")=LRSPEC60_U_LRSPECN_U_LRSPECTA_U_LRUNIT_U_LRR64
+12 IF LRR64
IF $PIECE($$GET1^DIQ(64,LRR64_",",1,"E"),".",2)="0000"
DO SUFFIX^LRSRVR9A
End DoDot:1
+13 IF LRSPECCT=0&(LRMISP=1)
DO NOSPEC
QUIT
+14 DO SPECLOOP
+15 QUIT
+16 ;
+17 ;
SPECLOOP ; Check to see if specimen has been linked to LOINC
+1 ;
+2 NEW LR64,LR6421,LRINDX,LRLNTA,LRRNLT,LRTA,LRX,X,LRVUID,AAA,LRVUIDN,LRVUIDAN,LRVLOINC,LRSUBMIT,LRSCREATE
+3 SET LRINDX=0
SET (LRVUID,LRVUIDAN,LRVLOINC,LRVUIDN,LRSUBMIT,LRSCREATE)=""
+4 FOR
SET LRINDX=$ORDER(LRSPEC(LRINDX))
if 'LRINDX
QUIT
Begin DoDot:1
+5 SET X=LRSPEC(LRINDX)
+6 SET LRSPEC=$PIECE(X,U)
SET LRSPECN=$PIECE(X,U,2)
SET LRLNTA=$PIECE(X,U,3)
SET LR64=$PIECE(X,U,5)
SET LRUNIT=$$TRIM^XLFSTR($PIECE(X,U,4),"RL"," ")
+7 SET (LR6421,LRLNC,LRRNLT,LRTA)=""
SET (LRVUID,LRVUIDAN,LRVLOINC,LRVUIDN,LRSUBMIT,LRSCREATE)=""
+8 SET AAA=+LR60IEN
+9 SET LRVUID=$$GET1^DIQ(60.01,LRSPEC_","_AAA,30,"I")
+10 IF LRVUID'=""
SET LRVUIDAN=$$GET1^DIQ(66.3,LRVUID_",",.02)
SET LRVLOINC=$$GET1^DIQ(66.3,LRVUID_",",.04)
SET LRVUIDN=$$GET1^DIQ(66.3,LRVUID,.01,"E")
+11 SET LRSUBMIT=$$GET1^DIQ(60.01,LRSPEC_","_AAA,34,"I")
+12 IF LR64
Begin DoDot:2
+13 SET LRRNLT=$$GET1^DIQ(64,LR64_",",1,"E")
+14 SET LR6421=$$GET1^DIQ(64,LR64_",",13,"I")
+15 SET AAA=+LR60IEN
+16 SET LRCREATE=$$GET1^DIQ(60.01,LRSPEC_","_AAA,35,"I")
SET LRCREATE=$SELECT(LRCREATE'="":"Y",1:"")
+17 SET LREXPY=$$GET1^DIQ(60.01,LRSPEC_","_AAA,34,"I")
+18 SET LRINACT=$$GET1^DIQ(60.01,LRSPEC_","_AAA,32,"I")
+19 SET LRX=""
+20 IF LRSPEC
IF LRLNTA
SET LRX=$PIECE($GET(^LAM(LR64,5,LRSPEC,1,LRLNTA,1)),"^")
+21 IF LRX=""
IF LRSPEC
Begin DoDot:3
+22 SET X=$ORDER(^LAM(LR64,5,LRSPEC,1,0))
+23 IF X
SET LRLNTA=X
SET LRX=$PIECE($GET(^LAM(LR64,5,LRSPEC,1,X,1)),"^")
End DoDot:3
+24 IF LRX'=""
SET LRLNC=$$GET1^DIQ(95.3,LRX_",",.01,"E")
+25 IF LRLNTA
SET LRTA=$$GET1^DIQ(64.061,LRLNTA_",",.01,"E")
End DoDot:2
+26 DO WRT
End DoDot:1
+27 QUIT
+28 ;
+29 ;
NOSPEC ; for test without specimens
+1 NEW LRSS,II,III,LRNOS,AA,BB
+2 SET ^TMP($JOB,"LR60",LR60IEN)=""
+3 SET LRNOS="^TMP($J,""LRNOSPEC"")"
+4 KILL @LRNOS
+5 FOR II=1:1:30
SET @LRNOS@(II)=""
+6 SET @LRNOS@(29)="MISSING SPECIMEN"
+7 SET @LRNOS@(30)="1.1"
+8 SET LRSS=$$GET1^DIQ(60,LR60IEN_",",4,"I")
+9 SET @LRNOS@(1)=LRST_"-"_LR60IEN
+10 SET @LRNOS@(2)=LR60NM
+11 ;S LRSTR=LRSTR_LRST_"-"_LR60IEN_"|"_LR60NM_"|||||||"
+12 SET @LRNOS@(11)=$$GET1^DIQ(60,LR60IEN_",",4,"I")
+13 ; Test info - data type, help prompt
+14 IF LRSS="CH"
SET X=$$TSTTYP^LRSRVR9A($$GET1^DIQ(60,LR60IEN_",",13))
SET @LRNOS@(12)=$PIECE(X,"|")
SET @LRNOS@(13)=$PIECE(X,"|",2)
+15 ; Send site's test notes on first record for this test.
+16 IF LRSTNOTE
Begin DoDot:1
+17 ;D SETDATA
+18 SET LRJ="LRSTNOTE"
+19 FOR III=1:1
SET LRJ=$QUERY(@LRJ)
if LRJ=""
QUIT
Begin DoDot:2
+20 SET X=@LRJ
IF X["|"
SET X=$TRANSLATE(X,"|","~")
+21 SET @LRNOS@(19,III)=X
End DoDot:2
+22 SET LRSTNOTE=0
End DoDot:1
+23 ;
+24 ; Send site's test synonym's on first record for this test.
+25 IF LRSTSYN
Begin DoDot:1
+26 SET LRJ="LRSTSYN"
+27 ;S LRSTR=LRSTR_@LRJ_"^" D SETDATA
FOR III=1:1
SET LRJ=$QUERY(@LRJ)
if LRJ=""
QUIT
SET @LRNOS@(20,III)=LRJ_"^"
+28 SET LRSTSYN=0
End DoDot:1
+29 ;
+30 ; Send file #60 test type
+31 SET @LRNOS@(21)=LRTSTTYP
+32 ;
+33 SET LRSTR=LRSTR_$GET(@LRNOS@(1))
SET AA=1
+34 FOR
SET AA=$ORDER(@LRNOS@(AA))
if 'AA
QUIT
SET BB=$GET(@LRNOS@(AA))
Begin DoDot:1
+35 IF AA=19!(AA=20)
DO SETDATA
DO NOSPEC1
QUIT
+36 SET LRSTR=LRSTR_"|"_BB
DO SETDATA
End DoDot:1
+37 ;
+38 SET LRSTR=LRSTR_"|"
+39 IF 'LRTXT
SET LRSTR=LRSTR_LRCRLF
+40 DO SETDATA
+41 ;
+42 SET LRCNT=LRCNT+1
SET LRCNT(0)=LRCNT(0)+1
+43 KILL @LRNOS
+44 KILL II,III,LRNOS,AA,BB
+45 QUIT
+46 ;
NOSPEC1 ; Process site notes
+1 NEW CC,DD
+2 SET CC=0
FOR
SET CC=$ORDER(@LRNOS@(AA,CC))
if 'CC
QUIT
SET DD=$GET(@LRNOS@(AA,CC))
Begin DoDot:1
+3 SET LRSTR=LRSTR_DD
DO SETDATA
End DoDot:1
+4 SET LRSTR=LRSTR_"|"
+5 KILL CC,DD
+6 QUIT
+7 ;
WRT ; Set ^TMP( with extracted data
+1 NEW LRJ,LREN,LRQUIT,LRSS,X,Y
+2 ;
+3 ; Set flag that this file #60 test has been processed - avoid duplicate
+4 ; processing as component of panel and individual test
+5 SET ^TMP($JOB,"LR60",LR60IEN)=""
+6 ;
+7 SET LRSTR=LRSTR_LRST_"-"_LR60IEN_"-"_LRINDX
+8 SET LRSTR=LRSTR_"|"_LR60NM_"|"_LRSPECN_"|"_LRTA_"|"_LRUNIT_"|"_LRLNC_"|"_LRRNLT_"|"_LRBATTY_"|"_LRBATTYN_"|"
+9 ;
+10 ; Lab section specified for this NLT code.
+11 SET LRSTR=LRSTR_$SELECT($GET(LR6421)>0:$$GET1^DIQ(64.21,LR6421_",",1),1:"")_"|"
+12 ;
+13 ; Subscript
+14 SET LRSS=$$GET1^DIQ(60,LR60IEN_",",4,"I")
+15 SET LRSTR=LRSTR_LRSS_"|"
+16 ; Test info - data type, help prompt
+17 IF LRSS'="CH"
SET LRSTR=LRSTR_"||"
+18 IF LRSS="CH"
SET X=$$TSTTYP^LRSRVR9A($$GET1^DIQ(60,LR60IEN_",",13))
SET LRSTR=LRSTR_$PIECE(X,"|")_"|"_$PIECE(X,"|",2)_"|"
+19 ;
+20 ; Test reference low|reference high|therapeutic low|therapeutic high|
+21 SET X=$GET(^LAB(60,LR60IEN,1,LRSPEC,0))
+22 SET Y=$PIECE(X,"^",2)_"|"_$PIECE(X,"^",3)_"|"_$PIECE(X,"^",11)_"|"_$PIECE(X,"^",12)
+23 SET LRSTR=LRSTR_$TRANSLATE(Y,$CHAR(34),"")
+24 ; Use for reference lab testing
+25 SET X=$GET(^LAB(60,LR60IEN,1,LRSPEC,.1))
+26 SET LRSTR=LRSTR_"|"_$SELECT($PIECE(X,"^")=1:"YES",1:"NO")_"|"
+27 ;
+28 ; Send site's test notes on first record for this test.
+29 IF LRSTNOTE
Begin DoDot:1
+30 DO SETDATA
+31 SET LRJ="LRSTNOTE"
+32 FOR
SET LRJ=$QUERY(@LRJ)
if LRJ=""
QUIT
Begin DoDot:2
+33 SET X=@LRJ
IF X["|"
SET X=$TRANSLATE(X,"|","~")
+34 SET LRSTR=LRSTR_X
DO SETDATA
End DoDot:2
+35 SET LRSTNOTE=0
End DoDot:1
+36 SET LRSTR=LRSTR_"|"
+37 ;
+38 ; Send site's test synonym's on first record for this test.
+39 IF LRSTSYN
Begin DoDot:1
+40 DO SETDATA
+41 SET LRJ="LRSTSYN"
+42 FOR
SET LRJ=$QUERY(@LRJ)
if LRJ=""
QUIT
SET LRSTR=LRSTR_@LRJ_"^"
DO SETDATA
+43 SET LRSTSYN=0
End DoDot:1
+44 ;
+45 ; Send file #60 test type
+46 SET LRSTR=LRSTR_"|"_LRTSTTYP_"|"
+47 ;
+48 ; mltf info
+49 IF LRVUID'=""
Begin DoDot:1
+50 SET LRSTR=LRSTR_LRVUID
DO SETDATA
End DoDot:1
+51 SET LRSTR=LRSTR_"|"
+52 IF LRVLOINC'=""
Begin DoDot:1
+53 SET LRSTR=LRSTR_LRVLOINC
DO SETDATA
End DoDot:1
+54 SET LRSTR=LRSTR_"|"
+55 IF LRVUIDN'=""
Begin DoDot:1
+56 ;D SETDATA
+57 SET LRSTR=LRSTR_LRVUIDN
DO SETDATA
End DoDot:1
+58 SET LRSTR=LRSTR_"|"
+59 IF LRVUIDAN'=""
Begin DoDot:1
+60 ;D SETDATA
+61 SET LRSTR=LRSTR_LRVUIDAN
DO SETDATA
End DoDot:1
+62 SET LRSTR=LRSTR_"|"
+63 ;
+64 DO SETDATA
+65 ; Send default LOINC code
+66 IF LR64
SET LRSTR=LRSTR_$$GET1^DIQ(64,LR64_",",25)
+67 SET LRSTR=LRSTR_"|"
+68 ;submited to ntrt
+69 SET LRSTR=LRSTR_LRSUBMIT_"|"
+70 ;create date
+71 SET LRSTR=LRSTR_LRSCREATE_"|"
+72 ;
+73 ; Set extract version number
+74 SET LRSTR=LRSTR_($SELECT(LRMISP=1:"|",1:""))_"1.1|"
+75 ;S LRSTR=LRSTR_"|1.1|"
+76 ;
+77 IF 'LRTXT
SET LRSTR=LRSTR_LRCRLF
+78 DO SETDATA
+79 ;
+80 SET LRCNT=LRCNT+1
SET LRCNT(0)=LRCNT(0)+1
+81 IF LRVUID'=""
SET LRCNT(1)=LRCNT(1)+1
+82 IF LRLNC'=""
SET LRCNT(4)=LRCNT(4)+1
+83 IF LR64
SET LRCNT(2)=LRCNT(2)+1
+84 QUIT
+85 ;
+86 ;
SETDATA ; Set data into report structure
+1 SET LRNODE=$ORDER(^TMP($JOB,"LRDATA",""),-1)
+2 IF LRTXT
SET LRNODE=LRNODE+1
SET ^TMP($JOB,"LRDATA",LRNODE)=LRSTR
SET LRSTR=""
QUIT
+3 IF 'LRTXT
DO ENCODE^LRSRVR9A(.LRSTR)
+4 QUIT
+5 ;
SYNNOTE ; Build site's test synonym's for first record
+1 ;
+2 KILL LRSTSYN
+3 SET LRSTSYN=0
+4 MERGE LRSTSYN=^LAB(60,LR60IEN,5)
+5 KILL LRSTSYN(0),LRSTSYN("B")
+6 IF $DATA(LRSTSYN)
SET LRSTSYN=1
+7 QUIT
+8 ;
MICRO(LR64) ;
+1 NEW LOINCDTB,LR6421,LRPNTB,LRSTUB
+2 SET LRSTUB=""
+3 DO GETS^DIQ(64,LR64,".01;1;13;25;25.5","IE","LOINCDTB","LRERR")
+4 DO GETS^DIQ(64,LR64,"20*","IE","LOINCDTA","LRERR")
+5 SET LRPNTB=$ORDER(LOINCDTB(64,""))
if LRPNTB=""
QUIT LRSTUB
+6 ;
+7 ; NLT Code/Procedure
+8 SET LRSTUB=$GET(LOINCDTB(64,LRPNTB,1,"E"))
+9 SET $PIECE(LRSTUB,"|",2)=$GET(LOINCDTB(64,LRPNTB,.01,"I"))
+10 ;
+11 ; Default LOINC code/name
+12 SET $PIECE(LRSTUB,"|",3)=$GET(LOINCDTB(64,LRPNTB,25,"E"))
+13 SET $PIECE(LRSTUB,"|",4)=$GET(^LAB(95.3,+$GET(LOINCDTB(64,LRPNTB,25,"I")),81))
+14 ;
+15 ; Anti-microbial Suscept (62.06,.01)
+16 SET $PIECE(LRSTUB,"|",5)=$$GET1^DIQ(62.06,LR6206_",",.01)
+17 ;
+18 ; Lab subscript/section
+19 SET $PIECE(LRSTUB,"|",19)=LRSS
+20 ; Lab section
IF $GET(LOINCDTB(64,LRPNTB,13,"I"))
Begin DoDot:1
+21 SET LR6421=LOINCDTB(64,LRPNTB,13,"I")
+22 SET $PIECE(LRSTUB,"|",20)=$$GET1^DIQ(64.21,LR6421_",",1)
End DoDot:1
+23 ;
+24 QUIT LRSTUB
+25 ;
GET664 ; get file 66.4 info
+1 SET LSITE=$$SITE^VASITE
SET LSITE=$PIECE(LSITE,U,1)
+2 SET LRNT=$ORDER(^LAB(66.4,"B",LSITE,0))
+3 DO GETS^DIQ(66.4,LRNT_",","**","IE","AR")
+4 MERGE LRNTI=AR("66.4",LRNT_",")
KILL AR
+5 QUIT
