LRSRVR2 ;VA/DALIO/FHS - LAB DATA SERVER CONT'D RELMA EXTRACT ; 17-Oct-2014 09:22 ; MKK
;;5.2;LAB SERVICE;**303,346,1027,1034**;NOV 01, 1997;Build 88
; Produces LOINC RELMA extract - via LRLABSERVER or option
;
EN ; Called by option [LR LOINC EXTRACT RELMA FORMAT]
; 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
S LRSUB="RELMA",LRTXT=1
D BUILD
W !
S LRL=0
F S LRL=$O(^TMP($J,"LRDATA",LRL)) Q:LRL<1 W !,^(LRL)
D CLEAN^LRSRVR2A
Q
;
;
SERVER ; Server entry Point
N I,LRCNT,LREND,LRL,LRMSUBJ,LRTXT,LRX,LRY
S LRTXT=0
D BUILD
S LRMSUBJ=LRST_" "_LRSTN_" RELMA EXTRACT "_$$HTE^XLFDT($H,"1M")
D MAILSEND^LRSRVR6(LRMSUBJ)
D CLEAN^LRSRVR2A
Q
;
;
BUILD ; Build extract
N I,LR6206,LR64,LRCNT,LRCRLF,LRLEN,LRQUIT,LRROOT,LRSTNOTE,LRSS,LRSTR,LRSTUB,LRVAL
S LRVAL=$$SITE^VASITE,LRST=$P(LRVAL,"^",3),LRSTN=$P(LRVAL,"^",2)
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 S LRCNT(I)=0
D HDR^LRSRVR2A
;
; 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^LRSRVR3(LR64)
. S LRSTUB=$P(LRX,"|",5)_"||||"_$P(LRX,"|",3)_"|"_$P(LRX,"|",1)_"|||"_$P(LRX,"|",20)_"|"_$P(LRX,"|",19)_"|||||||||||"
. I LR64 S LRSTUB=LRSTUB_$$GET1^DIQ(64,LR64_",",25)
. S LRSTUB=LRSTUB_"|1.1|" ; Set extract version number
. 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^LRSRVR4(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 LOINC code..: "_$J(LRCNT(1),5)
S ^TMP($J,"LRDATA",9)="Tests with NLT code....: "_$J(LRCNT(2),5)
S ^TMP($J,"LRDATA",10)="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" Q
; Bypass "workload" type tests.
I $P(^LAB(60,LR60IEN,0),"^",4)="WK" Q
;
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^LA7ADL1(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" Q
. . ; Bypass "workload" type tests.
. . I $P(^LAB(60,LR60IEN,0),"^",4)="WK" 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^LRSRVR2A
D SYNNOTE^LRSRVR2A
S LRSPEC60=0
F S LRSPEC60=$O(^LAB(60,+LR60IEN,1,LRSPEC60)) Q:'LRSPEC60 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^LRSRVR2A
D SPECLOOP
Q
;
;
SPECLOOP ; Check to see if specimen has been linked to LOINC
;
N LR64,LR6421,LRINDX,LRLNTA,LRRNLT,LRTA,LRX,X
S LRINDX=0
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)=""
. I LR64 D
. . S LRRNLT=$$GET1^DIQ(64,LR64_",",1,"E")
. . S LR6421=$$GET1^DIQ(64,LR64_",",13,"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
;
;
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^LRSRVR3($$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_"|"
;
; Send default LOINC code
I LR64 S LRSTR=LRSTR_$$GET1^DIQ(64,LR64_",",25)
;
; Set extract version number
S LRSTR=LRSTR_"|1.1|"
;
I 'LRTXT S LRSTR=LRSTR_LRCRLF
D SETDATA
;
S LRCNT=LRCNT+1,LRCNT(0)=LRCNT(0)+1
I LRLNC'="" S LRCNT(1)=LRCNT(1)+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^LRSRVR4(.LRSTR)
Q
LRSRVR2 ;VA/DALIO/FHS - LAB DATA SERVER CONT'D RELMA EXTRACT ; 17-Oct-2014 09:22 ; MKK
+1 ;;5.2;LAB SERVICE;**303,346,1027,1034**;NOV 01, 1997;Build 88
+2 ; Produces LOINC RELMA extract - via LRLABSERVER or option
+3 ;
EN ; Called by option [LR LOINC EXTRACT RELMA FORMAT]
+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 SET LRSUB="RELMA"
SET LRTXT=1
+8 DO BUILD
+9 WRITE !
+10 SET LRL=0
+11 FOR
SET LRL=$ORDER(^TMP($JOB,"LRDATA",LRL))
IF LRL<1
QUIT
WRITE !,^(LRL)
+12 DO CLEAN^LRSRVR2A
+13 QUIT
+14 ;
+15 ;
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_" RELMA EXTRACT "_$$HTE^XLFDT($HOROLOG,"1M")
+5 DO MAILSEND^LRSRVR6(LRMSUBJ)
+6 DO CLEAN^LRSRVR2A
+7 QUIT
+8 ;
+9 ;
BUILD ; Build extract
+1 NEW I,LR6206,LR64,LRCNT,LRCRLF,LRLEN,LRQUIT,LRROOT,LRSTNOTE,LRSS,LRSTR,LRSTUB,LRVAL
+2 SET LRVAL=$$SITE^VASITE
SET LRST=$PIECE(LRVAL,"^",3)
SET LRSTN=$PIECE(LRVAL,"^",2)
+3 IF LRST=""
SET LRST="???"
+4 KILL ^TMP($JOB,"LRDATA"),^TMP($JOB,"LR60")
+5 SET LRCNT=0
SET LRCRLF=$CHAR(13,10)
SET LRSTR=""
+6 FOR I=0,1,2,3
SET LRCNT(I)=0
+7 DO HDR^LRSRVR2A
+8 ;
+9 ; Step down the B X-ref - exclude synomyms
+10 SET LRROOT="^LAB(60,""B"")"
+11 FOR
SET LRROOT=$QUERY(@LRROOT)
IF LRROOT=""
QUIT
IF $QSUBSCRIPT(LRROOT,2)'="B"
QUIT
Begin DoDot:1
+12 IF $GET(@LRROOT)
QUIT
+13 DO TEST
End DoDot:1
+14 ;
+15 ; Process microbiology antibiotics
+16 SET LR6206=0
SET LRSS="MI"
+17 FOR
SET LR6206=$ORDER(^LAB(62.06,LR6206))
IF 'LR6206
QUIT
Begin DoDot:1
+18 SET LR64=$$GET1^DIQ(62.06,LR6206_",",64,"I")
+19 SET LRX=$$MICRO^LRSRVR3(LR64)
+20 SET LRSTUB=$PIECE(LRX,"|",5)_"||||"_$PIECE(LRX,"|",3)_"|"_$PIECE(LRX,"|",1)_"|||"_$PIECE(LRX,"|",20)_"|"_$PIECE(LRX,"|",19)_"|||||||||||"
+21 IF LR64
SET LRSTUB=LRSTUB_$$GET1^DIQ(64,LR64_",",25)
+22 ; Set extract version number
SET LRSTUB=LRSTUB_"|1.1|"
+23 SET LRSTR=LRSTR_LRST_"-"_LR64_"-"_"AB"_LR6206_"|"_LRSTUB
+24 IF 'LRTXT
SET LRSTR=LRSTR_LRCRLF
+25 DO SETDATA
SET LRCNT=LRCNT+1
SET LRCNT(3)=LRCNT(3)+1
End DoDot:1
+26 ;
+27 ; Set the final info into the ^TMP message global
+28 IF 'LRTXT
Begin DoDot:1
+29 SET LRNODE=$ORDER(^TMP($JOB,"LRDATA",""),-1)
+30 IF LRSTR'=""
SET LRNODE=LRNODE+1
SET ^TMP($JOB,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR)
+31 SET ^TMP($JOB,"LRDATA",LRNODE+1)=" "
+32 SET ^TMP($JOB,"LRDATA",LRNODE+2)="end"
End DoDot:1
+33 ;
+34 SET ^TMP($JOB,"LRDATA",6)="Total number of records: "_$JUSTIFY(LRCNT,5)
+35 SET ^TMP($JOB,"LRDATA",7)="Total number of tests..: "_$JUSTIFY(LRCNT(0),5)
+36 SET ^TMP($JOB,"LRDATA",8)="Tests with LOINC code..: "_$JUSTIFY(LRCNT(1),5)
+37 SET ^TMP($JOB,"LRDATA",9)="Tests with NLT code....: "_$JUSTIFY(LRCNT(2),5)
+38 SET ^TMP($JOB,"LRDATA",10)="Antimicrobials.........: "_$JUSTIFY(LRCNT(3),5)
+39 ;
+40 QUIT
+41 ;
+42 ;
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"
QUIT
+9 ; Bypass "workload" type tests.
+10 IF $PIECE(^LAB(60,LR60IEN,0),"^",4)="WK"
QUIT
+11 ;
+12 SET LRBATTY=LRST_"-"_LR60IEN
SET LRBATTYN=LR60NM
+13 SET LRBATTY=$$TRIM^XLFSTR(LRBATTY,"RL"," ")
+14 ; Panel test
+15 ; Bypass "output panel" type tests - usually used for display only.
+16 IF $ORDER(^LAB(60,LR60IEN,2,0))
Begin DoDot:1
+17 IF $PIECE(^LAB(60,LR60IEN,0),"^",3)="O"
QUIT
+18 DO UNWIND^LA7ADL1(LR60IEN,9,0)
+19 SET LR60=0
+20 FOR
SET LR60=$ORDER(LA7TREE(LR60))
IF 'LR60
QUIT
Begin DoDot:2
+21 IF $DATA(^TMP($JOB,"LR60",LR60))
QUIT
+22 SET LR60IEN=LR60
SET LR60NM=$PIECE(^LAB(60,LR60IEN,0),"^")
+23 SET LRTSTTYP=$PIECE(^LAB(60,LR60IEN,0),"^",3)
+24 ; Bypass "neither" type tests.
+25 IF LRTSTTYP="N"
QUIT
+26 ; Bypass "workload" type tests.
+27 IF $PIECE(^LAB(60,LR60IEN,0),"^",4)="WK"
QUIT
+28 SET LRR64=+$PIECE($GET(^LAB(60,+LR60IEN,64)),U,2)
+29 DO SPEC
End DoDot:2
End DoDot:1
QUIT
+30 ;
+31 IF $DATA(^TMP($JOB,"LR60",LR60IEN))
QUIT
+32 ; Not a panel test
+33 ; Get result NLT code
+34 SET LRR64=+$PIECE($GET(^LAB(60,+LR60IEN,64)),U,2)
+35 DO SPEC
+36 QUIT
+37 ;
+38 ;
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^LRSRVR2A
+4 DO SYNNOTE^LRSRVR2A
+5 SET LRSPEC60=0
+6 FOR
SET LRSPEC60=$ORDER(^LAB(60,+LR60IEN,1,LRSPEC60))
IF 'LRSPEC60
QUIT
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^LRSRVR2A
End DoDot:1
+13 DO SPECLOOP
+14 QUIT
+15 ;
+16 ;
SPECLOOP ; Check to see if specimen has been linked to LOINC
+1 ;
+2 NEW LR64,LR6421,LRINDX,LRLNTA,LRRNLT,LRTA,LRX,X
+3 SET LRINDX=0
+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)=""
+8 IF LR64
Begin DoDot:2
+9 SET LRRNLT=$$GET1^DIQ(64,LR64_",",1,"E")
+10 SET LR6421=$$GET1^DIQ(64,LR64_",",13,"I")
+11 SET LRX=""
+12 IF LRSPEC
IF LRLNTA
SET LRX=$PIECE($GET(^LAM(LR64,5,LRSPEC,1,LRLNTA,1)),"^")
+13 IF LRX=""
IF LRSPEC
Begin DoDot:3
+14 SET X=$ORDER(^LAM(LR64,5,LRSPEC,1,0))
+15 IF X
SET LRLNTA=X
SET LRX=$PIECE($GET(^LAM(LR64,5,LRSPEC,1,X,1)),"^")
End DoDot:3
+16 IF LRX'=""
SET LRLNC=$$GET1^DIQ(95.3,LRX_",",.01,"E")
+17 IF LRLNTA
SET LRTA=$$GET1^DIQ(64.061,LRLNTA_",",.01,"E")
End DoDot:2
+18 DO WRT
End DoDot:1
+19 QUIT
+20 ;
+21 ;
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^LRSRVR3($$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 ; Send default LOINC code
+49 IF LR64
SET LRSTR=LRSTR_$$GET1^DIQ(64,LR64_",",25)
+50 ;
+51 ; Set extract version number
+52 SET LRSTR=LRSTR_"|1.1|"
+53 ;
+54 IF 'LRTXT
SET LRSTR=LRSTR_LRCRLF
+55 DO SETDATA
+56 ;
+57 SET LRCNT=LRCNT+1
SET LRCNT(0)=LRCNT(0)+1
+58 IF LRLNC'=""
SET LRCNT(1)=LRCNT(1)+1
+59 IF LR64
SET LRCNT(2)=LRCNT(2)+1
+60 QUIT
+61 ;
+62 ;
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^LRSRVR4(.LRSTR)
+4 QUIT
