LR7OR2 ;DALOI/dcm - Get Lab results (cont.) ; 3/29/19 8:12am
;;5.2;LAB SERVICE;**121,187,219,285,286,372,350,453,519**;Sep 27, 1994;Build 16
;
;
CH(SDATE,EDATE,TEST,COUNT,SPEC,UNVER) ;Get CH subscript data
;
Q:'$D(SDATE) Q:'$D(EDATE) Q:'$D(COUNT) Q:'$D(CT1)
N GOTIT,I,IVDT,ITST,IST,TSTY,X,X0,ORD,Y6,Y12,Y16,Y19
I '($D(^TMP("LRORID",$J))>10) F I="LRPLS","LRPLS-ADDR" K ^TMP(I,$J)
;
I $G(TEST) Q:'$D(^LAB(60,TEST,0)) S X=^(0) Q:$P(X,"^",4)'="CH" D
. I $P(X,"^",5)'="" S TSTY($P($P(X,"^",5),";",2))=TEST
. I $P(X,"^",5)="" D EN^LR7OU1(TEST)
;
S IVDT=SDATE I $D(^LR(LRDFN,"CH",SDATE)) S IVDT=SDATE-.000001
F S IVDT=$O(^LR(LRDFN,"CH",IVDT)) Q:IVDT<1!(IVDT>EDATE)!(CT1>COUNT) D
. S X0=^LR(LRDFN,"CH",IVDT,0),Y6=$S($P(X0,"^",3):"F",1:"P"),Y12=$P(X0,"^",4),Y19=$P(X0,"^",5),Y16=$P(X0,"^",6),ORD=$$ORD(LRDFN,IVDT)
. S GOTIT=0
. I '$G(UNVER),Y6="P" Q ;Unverified data not requested
. I $G(SPEC),Y19'=SPEC Q ;Specimen specified
. I '$D(TSTY) S ITST=1 F S ITST=$O(^LR(LRDFN,"CH",IVDT,ITST)) Q:ITST<1 S X=^(ITST) D SETTST(ITST,X)
. S IST=0 F S IST=$O(TSTY(IST)) Q:IST<1 I $D(^LR(LRDFN,"CH",IVDT,IST)) S X=^(IST) D SETTST(IST,X)
. I $O(^TMP("LRRR",$J,DFN,"CH",IVDT,0)) D NOTE(LRDFN,IVDT)
. Q:'GOTIT
. S CT1=CT1+1
. ; Display ordering provider
. D ORDP($P($G(^LR(LRDFN,"CH",IVDT,0)),"^",10))
. ; Display report released date/time
. D RRDT($P(X0,"^",3))
. ; List performing laboratories
. D PLS
;
I '($D(^TMP("LRORID",$J))>10) F I="LRPLS","LRPLS-ADDR" K ^TMP(I,$J)
Q
;
;
SETTST(ISUB,ZERO) ;Set test data in ^TMP
; ISUB= test subscript
; ZERO= 0th node at ^LR(LRDFN,"CH",IVDT,TST)
N LRX,PORDER,X,Y,Y1,Y2,Y3,Y4,Y5,Y9,Y10,Y11,Y14
S X=ZERO,Y1=ISUB,Y1=$O(^LAB(60,"C","CH;"_Y1_";1",0)),Y2=$P(X,"^"),Y3=$P(X,"^",2)
Q:'Y1 Q:"IN"[$P(^LAB(60,Y1,0),"^",3) S Y15=$P($G(^LAB(60,Y1,.1)),"^")
S (Y9,Y10,Y11,Y14)=""
I $P($G(^LAB(60,Y1,64)),"^") S Y9=$P(^(64),"^"),Y9=$P(^LAM(Y9,0),"^",2),Y10=$P(^(0),"^"),Y11="99NLT"
;
S LRX=$$TSTRES^LRRPU(LRDFN,"CH",IVDT,ISUB,Y1)
S Y2=$P(LRX,"^"),Y3=$P(LRX,"^",2),Y4=$P(LRX,"^",5),Y5=$$EN^LRLRRVF($P(LRX,"^",3),$P(LRX,"^",4))
I $P(LRX,"^",7) S Y14="T"
S Y2=$$TRIM^XLFSTR($$RESULT^LR7OB63(Y1,Y2),"RL"," ")
;
; Determine print order and adjust if duplicate
S PORDER=$P($G(^LAB(60,Y1,.1)),"^",6),PORDER=$S(PORDER:PORDER,1:998+(ISUB/10000000))
I $D(^TMP("LRRR",$J,DFN,"CH",IVDT,PORDER)) F PORDER=PORDER:.00000001 I '$D(^TMP("LRRR",$J,DFN,"CH",IVDT,PORDER)) Q
;
S ^TMP("LRRR",$J,DFN,"CH",IVDT,PORDER)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^^^"_Y9_"^"_Y10_"^"_Y11_"^"_Y12_"^^"_Y14_"^"_Y15_"^"_Y16_"^"_$G(ORD)_"^^"_Y19
I $P(LRX,"^",6) S ^TMP("LRPLS",$J,$P(LRX,"^",6),$P(^LAB(60,Y1,0),"^"))=""
S GOTIT=1
Q
;
;
NOTE(LRDFN,IVDT) ;Get comments
N IFN
S IFN=0
F S IFN=$O(^LR(LRDFN,"CH",IVDT,1,IFN)) Q:IFN<1 S X=^(IFN,0),^TMP("LRRR",$J,DFN,"CH",IVDT,"N",IFN)=X
Q
;
;
TEST(Y,DFN,ORD,SDATE,EDATE,SUB,TEST,FLAG,COUNT) ;Test network calls
; Called from TIU
; COUNT = count of results to send, results with the same date/time count as 1
N IVDT,SSUB,SEQ,CTR
Q:'$G(DFN)
D RR^LR7OR1(DFN,$G(ORD),$G(SDATE),$G(EDATE),$G(SUB),$G(TEST),$G(FLAG),$G(COUNT))
I '$D(^TMP("LRRR",$J)) S Y(1)="No Lab Data" Q
S CTR=0,SSUB="",COUNT=$S($G(COUNT):COUNT,1:9999999)
F S SSUB=$O(^TMP("LRRR",$J,DFN,SSUB)) Q:SSUB="" S IVDT=0 F S IVDT=$O(^TMP("LRRR",$J,DFN,SSUB,IVDT)) Q:IVDT<1 S SEQ=0 F S SEQ=$O(^TMP("LRRR",$J,DFN,SSUB,IVDT,SEQ)) Q:SEQ<1 D
. S CTR=CTR+1,^TMP("LRAPI",$J,CTR)=9999999-IVDT_"^"_SSUB_"^"_^TMP("LRRR",$J,DFN,SSUB,IVDT,SEQ)
S Y=$NA(^TMP("LRAPI",$J))
Q
;
;
T60(Y,IFN) ;Get tests from file 60
; If IFN is not passed then the whole file is sent.
N CTR S CTR=0
I $D(IFN) Q:'$D(^LAB(60,IFN,0)) S Y(1)=IFN_"^"_$P(^LAB(60,IFN,0),"^") Q
S NAME="" F S NAME=$O(^LAB(60,"B",NAME)) Q:NAME="" S IFN=0 F S IFN=$O(^LAB(60,"B",NAME,IFN)) Q:IFN<1 I $D(^LAB(60,IFN,0)) S CTR=CTR+1,Y(CTR)=IFN_"^"_NAME
Q
;
;
T64(Y,IFN) ;Get tests from file 64
; If IFN is not passed then the whole file is sent, if entry has a link to file 60
N CTR S CTR=0
I $D(IFN) Q:'$D(^LAM(IFN,0)) Q:'$D(^LAB(60,"AC",IFN)) S Y(1)=IFN_"^"_$P(^LAM(IFN,0),"^") Q
S NAME="" F S NAME=$O(^LAM("B",NAME)) Q:NAME="" S IFN=0 F S IFN=$O(^LAM("B",NAME,IFN)) Q:IFN<1 I $D(^LAM(IFN,0)),$D(^LAB(60,"AC",IFN)) S CTR=CTR+1,Y(CTR)=IFN_"^"_NAME
Q
;
;
ORD(LRDFN,IVDT) ;Get order # for entry in file 63
; LRDFN=Lab Patient #
; IVDT=Inverse Date/time in 63 (^LR(LRDFN,"CH",IVDT))
Q:'$G(LRDFN) Q:'$G(IVDT)
N X0,X6,X,AC,ACD,ACN
S X0=$G(^LR(LRDFN,"CH",IVDT,0)),X6=$P(X0,"^",6) I X6="" Q ""
S X=$P(X6," "),X=$O(^LRO(68,"B",X,0)) I 'X Q ""
S AC=X,ACD=+$P(X0,"."),ACN=$P(X6," ",3) I '$D(^LRO(68,AC,1,ACD,1,ACN,0)) Q ""
S X=$P($G(^LRO(68,AC,1,ACD,1,ACN,.1)),"^")
Q X
;
;
ORDP(LRPROV) ; Display ordering provider in comment
N LRY,CNT
S LRY=$$NAME^XUSER(LRPROV,"G")
S CNT=$O(^TMP("LRRR",$J,DFN,"CH",IVDT,"N",""),-1)+1
S ^TMP("LRRR",$J,DFN,"CH",IVDT,"N",CNT)="Ordering Provider: "_LRY
Q
;
;
RRDT(LRDT) ; Display report released date/time
N LRY,CNT
I LRDT S LRY=$$FMTE^XLFDT(LRDT,"M")
E S LRY=""
S CNT=$O(^TMP("LRRR",$J,DFN,"CH",IVDT,"N",""),-1)+1
S ^TMP("LRRR",$J,DFN,"CH",IVDT,"N",CNT)="Report Released Date/Time: "_LRY,CNT=CNT+1
Q
;
;
PLS ; List reporting and performing laboratories
; If multiple performing labs then list tests associated with each lab.
;
N CNT,LINE,LLEN,LRPLS,LRX,MPLS,PLS,TESTNAME,X
;
S CNT=$O(^TMP("LRRR",$J,DFN,"CH",IVDT,"N",""),-1)+1
;
; Reporting Laboratory
I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2 D
. S LRX=+$G(^LR(LRDFN,"CH",IVDT,"RF"))
. I LRX<1 Q
. S LINE=$$PLSADDR^LR7OSUM2(LRX)
. S ^TMP("LRRR",$J,DFN,"CH",IVDT,"N",CNT)=" ",CNT=CNT+1
. S ^TMP("LRRR",$J,DFN,"CH",IVDT,"N",CNT)="Reporting Lab: "_$P(LINE,"^"),CNT=CNT+1
. S ^TMP("LRRR",$J,DFN,"CH",IVDT,"N",CNT)=" "_$P(LINE,"^",2),CNT=CNT+1
;
S PLS=$O(^TMP("LRPLS",$J,0)),MPLS=0
I $O(^TMP("LRPLS",$J,PLS)) S MPLS=1 ; multiple performing labs
S LRPLS=0
F S LRPLS=$O(^TMP("LRPLS",$J,LRPLS)) Q:LRPLS<1 D
. S ^TMP("LRRR",$J,DFN,"CH",IVDT,"N",CNT)=" ",CNT=CNT+1
. I MPLS D
. . S TESTNAME="",LINE="For test(s): ",LLEN=13
. . F S TESTNAME=$O(^TMP("LRPLS",$J,LRPLS,TESTNAME)) Q:TESTNAME="" D
. . . S X=$L(TESTNAME)
. . . I (LLEN+X)>240 S ^TMP("LRRR",$J,DFN,"CH",IVDT,"N",CNT)=LINE,CNT=CNT+1,LINE="",LLEN=0
. . . S LINE=LINE_$S(LLEN>13:", ",1:"")_TESTNAME,LLEN=LLEN+X+$S(LLEN>13:2,1:0)
. . I LINE'="" S ^TMP("LRRR",$J,DFN,"CH",IVDT,"N",CNT)=LINE,CNT=CNT+1
. S LINE=$$PLSADDR^LR7OSUM2(LRPLS)
. S ^TMP("LRRR",$J,DFN,"CH",IVDT,"N",CNT)="Performing Lab: "_$P(LINE,"^"),CNT=CNT+1
. S ^TMP("LRRR",$J,DFN,"CH",IVDT,"N",CNT)=" "_$P(LINE,"^",2),CNT=CNT+1
;
S ^TMP("LRRR",$J,DFN,"CH",IVDT,"N",CNT)=" "
;
K ^TMP("LRPLS",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OR2 6885 printed Jan 18, 2025@03:06:03 Page 2
LR7OR2 ;DALOI/dcm - Get Lab results (cont.) ; 3/29/19 8:12am
+1 ;;5.2;LAB SERVICE;**121,187,219,285,286,372,350,453,519**;Sep 27, 1994;Build 16
+2 ;
+3 ;
CH(SDATE,EDATE,TEST,COUNT,SPEC,UNVER) ;Get CH subscript data
+1 ;
+2 if '$DATA(SDATE)
QUIT
if '$DATA(EDATE)
QUIT
if '$DATA(COUNT)
QUIT
if '$DATA(CT1)
QUIT
+3 NEW GOTIT,I,IVDT,ITST,IST,TSTY,X,X0,ORD,Y6,Y12,Y16,Y19
+4 IF '($DATA(^TMP("LRORID",$JOB))>10)
FOR I="LRPLS","LRPLS-ADDR"
KILL ^TMP(I,$JOB)
+5 ;
+6 IF $GET(TEST)
if '$DATA(^LAB(60,TEST,0))
QUIT
SET X=^(0)
if $PIECE(X,"^",4)'="CH"
QUIT
Begin DoDot:1
+7 IF $PIECE(X,"^",5)'=""
SET TSTY($PIECE($PIECE(X,"^",5),";",2))=TEST
+8 IF $PIECE(X,"^",5)=""
DO EN^LR7OU1(TEST)
End DoDot:1
+9 ;
+10 SET IVDT=SDATE
IF $DATA(^LR(LRDFN,"CH",SDATE))
SET IVDT=SDATE-.000001
+11 FOR
SET IVDT=$ORDER(^LR(LRDFN,"CH",IVDT))
if IVDT<1!(IVDT>EDATE)!(CT1>COUNT)
QUIT
Begin DoDot:1
+12 SET X0=^LR(LRDFN,"CH",IVDT,0)
SET Y6=$SELECT($PIECE(X0,"^",3):"F",1:"P")
SET Y12=$PIECE(X0,"^",4)
SET Y19=$PIECE(X0,"^",5)
SET Y16=$PIECE(X0,"^",6)
SET ORD=$$ORD(LRDFN,IVDT)
+13 SET GOTIT=0
+14 ;Unverified data not requested
IF '$GET(UNVER)
IF Y6="P"
QUIT
+15 ;Specimen specified
IF $GET(SPEC)
IF Y19'=SPEC
QUIT
+16 IF '$DATA(TSTY)
SET ITST=1
FOR
SET ITST=$ORDER(^LR(LRDFN,"CH",IVDT,ITST))
if ITST<1
QUIT
SET X=^(ITST)
DO SETTST(ITST,X)
+17 SET IST=0
FOR
SET IST=$ORDER(TSTY(IST))
if IST<1
QUIT
IF $DATA(^LR(LRDFN,"CH",IVDT,IST))
SET X=^(IST)
DO SETTST(IST,X)
+18 IF $ORDER(^TMP("LRRR",$JOB,DFN,"CH",IVDT,0))
DO NOTE(LRDFN,IVDT)
+19 if 'GOTIT
QUIT
+20 SET CT1=CT1+1
+21 ; Display ordering provider
+22 DO ORDP($PIECE($GET(^LR(LRDFN,"CH",IVDT,0)),"^",10))
+23 ; Display report released date/time
+24 DO RRDT($PIECE(X0,"^",3))
+25 ; List performing laboratories
+26 DO PLS
End DoDot:1
+27 ;
+28 IF '($DATA(^TMP("LRORID",$JOB))>10)
FOR I="LRPLS","LRPLS-ADDR"
KILL ^TMP(I,$JOB)
+29 QUIT
+30 ;
+31 ;
SETTST(ISUB,ZERO) ;Set test data in ^TMP
+1 ; ISUB= test subscript
+2 ; ZERO= 0th node at ^LR(LRDFN,"CH",IVDT,TST)
+3 NEW LRX,PORDER,X,Y,Y1,Y2,Y3,Y4,Y5,Y9,Y10,Y11,Y14
+4 SET X=ZERO
SET Y1=ISUB
SET Y1=$ORDER(^LAB(60,"C","CH;"_Y1_";1",0))
SET Y2=$PIECE(X,"^")
SET Y3=$PIECE(X,"^",2)
+5 if 'Y1
QUIT
if "IN"[$PIECE(^LAB(60,Y1,0),"^",3)
QUIT
SET Y15=$PIECE($GET(^LAB(60,Y1,.1)),"^")
+6 SET (Y9,Y10,Y11,Y14)=""
+7 IF $PIECE($GET(^LAB(60,Y1,64)),"^")
SET Y9=$PIECE(^(64),"^")
SET Y9=$PIECE(^LAM(Y9,0),"^",2)
SET Y10=$PIECE(^(0),"^")
SET Y11="99NLT"
+8 ;
+9 SET LRX=$$TSTRES^LRRPU(LRDFN,"CH",IVDT,ISUB,Y1)
+10 SET Y2=$PIECE(LRX,"^")
SET Y3=$PIECE(LRX,"^",2)
SET Y4=$PIECE(LRX,"^",5)
SET Y5=$$EN^LRLRRVF($PIECE(LRX,"^",3),$PIECE(LRX,"^",4))
+11 IF $PIECE(LRX,"^",7)
SET Y14="T"
+12 SET Y2=$$TRIM^XLFSTR($$RESULT^LR7OB63(Y1,Y2),"RL"," ")
+13 ;
+14 ; Determine print order and adjust if duplicate
+15 SET PORDER=$PIECE($GET(^LAB(60,Y1,.1)),"^",6)
SET PORDER=$SELECT(PORDER:PORDER,1:998+(ISUB/10000000))
+16 IF $DATA(^TMP("LRRR",$JOB,DFN,"CH",IVDT,PORDER))
FOR PORDER=PORDER:.00000001
IF '$DATA(^TMP("LRRR",$JOB,DFN,"CH",IVDT,PORDER))
QUIT
+17 ;
+18 SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,PORDER)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^^^"_Y9_"^"_Y10_"^"_Y11_"^"_Y12_"^^"_Y14_"^"_Y15_"^"_Y16_"^"_$GET(ORD)_"^^"_Y19
+19 IF $PIECE(LRX,"^",6)
SET ^TMP("LRPLS",$JOB,$PIECE(LRX,"^",6),$PIECE(^LAB(60,Y1,0),"^"))=""
+20 SET GOTIT=1
+21 QUIT
+22 ;
+23 ;
NOTE(LRDFN,IVDT) ;Get comments
+1 NEW IFN
+2 SET IFN=0
+3 FOR
SET IFN=$ORDER(^LR(LRDFN,"CH",IVDT,1,IFN))
if IFN<1
QUIT
SET X=^(IFN,0)
SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",IFN)=X
+4 QUIT
+5 ;
+6 ;
TEST(Y,DFN,ORD,SDATE,EDATE,SUB,TEST,FLAG,COUNT) ;Test network calls
+1 ; Called from TIU
+2 ; COUNT = count of results to send, results with the same date/time count as 1
+3 NEW IVDT,SSUB,SEQ,CTR
+4 if '$GET(DFN)
QUIT
+5 DO RR^LR7OR1(DFN,$GET(ORD),$GET(SDATE),$GET(EDATE),$GET(SUB),$GET(TEST),$GET(FLAG),$GET(COUNT))
+6 IF '$DATA(^TMP("LRRR",$JOB))
SET Y(1)="No Lab Data"
QUIT
+7 SET CTR=0
SET SSUB=""
SET COUNT=$SELECT($GET(COUNT):COUNT,1:9999999)
+8 FOR
SET SSUB=$ORDER(^TMP("LRRR",$JOB,DFN,SSUB))
if SSUB=""
QUIT
SET IVDT=0
FOR
SET IVDT=$ORDER(^TMP("LRRR",$JOB,DFN,SSUB,IVDT))
if IVDT<1
QUIT
SET SEQ=0
FOR
SET SEQ=$ORDER(^TMP("LRRR",$JOB,DFN,SSUB,IVDT,SEQ))
if SEQ<1
QUIT
Begin DoDot:1
+9 SET CTR=CTR+1
SET ^TMP("LRAPI",$JOB,CTR)=9999999-IVDT_"^"_SSUB_"^"_^TMP("LRRR",$JOB,DFN,SSUB,IVDT,SEQ)
End DoDot:1
+10 SET Y=$NAME(^TMP("LRAPI",$JOB))
+11 QUIT
+12 ;
+13 ;
T60(Y,IFN) ;Get tests from file 60
+1 ; If IFN is not passed then the whole file is sent.
+2 NEW CTR
SET CTR=0
+3 IF $DATA(IFN)
if '$DATA(^LAB(60,IFN,0))
QUIT
SET Y(1)=IFN_"^"_$PIECE(^LAB(60,IFN,0),"^")
QUIT
+4 SET NAME=""
FOR
SET NAME=$ORDER(^LAB(60,"B",NAME))
if NAME=""
QUIT
SET IFN=0
FOR
SET IFN=$ORDER(^LAB(60,"B",NAME,IFN))
if IFN<1
QUIT
IF $DATA(^LAB(60,IFN,0))
SET CTR=CTR+1
SET Y(CTR)=IFN_"^"_NAME
+5 QUIT
+6 ;
+7 ;
T64(Y,IFN) ;Get tests from file 64
+1 ; If IFN is not passed then the whole file is sent, if entry has a link to file 60
+2 NEW CTR
SET CTR=0
+3 IF $DATA(IFN)
if '$DATA(^LAM(IFN,0))
QUIT
if '$DATA(^LAB(60,"AC",IFN))
QUIT
SET Y(1)=IFN_"^"_$PIECE(^LAM(IFN,0),"^")
QUIT
+4 SET NAME=""
FOR
SET NAME=$ORDER(^LAM("B",NAME))
if NAME=""
QUIT
SET IFN=0
FOR
SET IFN=$ORDER(^LAM("B",NAME,IFN))
if IFN<1
QUIT
IF $DATA(^LAM(IFN,0))
IF $DATA(^LAB(60,"AC",IFN))
SET CTR=CTR+1
SET Y(CTR)=IFN_"^"_NAME
+5 QUIT
+6 ;
+7 ;
ORD(LRDFN,IVDT) ;Get order # for entry in file 63
+1 ; LRDFN=Lab Patient #
+2 ; IVDT=Inverse Date/time in 63 (^LR(LRDFN,"CH",IVDT))
+3 if '$GET(LRDFN)
QUIT
if '$GET(IVDT)
QUIT
+4 NEW X0,X6,X,AC,ACD,ACN
+5 SET X0=$GET(^LR(LRDFN,"CH",IVDT,0))
SET X6=$PIECE(X0,"^",6)
IF X6=""
QUIT ""
+6 SET X=$PIECE(X6," ")
SET X=$ORDER(^LRO(68,"B",X,0))
IF 'X
QUIT ""
+7 SET AC=X
SET ACD=+$PIECE(X0,".")
SET ACN=$PIECE(X6," ",3)
IF '$DATA(^LRO(68,AC,1,ACD,1,ACN,0))
QUIT ""
+8 SET X=$PIECE($GET(^LRO(68,AC,1,ACD,1,ACN,.1)),"^")
+9 QUIT X
+10 ;
+11 ;
ORDP(LRPROV) ; Display ordering provider in comment
+1 NEW LRY,CNT
+2 SET LRY=$$NAME^XUSER(LRPROV,"G")
+3 SET CNT=$ORDER(^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",""),-1)+1
+4 SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",CNT)="Ordering Provider: "_LRY
+5 QUIT
+6 ;
+7 ;
RRDT(LRDT) ; Display report released date/time
+1 NEW LRY,CNT
+2 IF LRDT
SET LRY=$$FMTE^XLFDT(LRDT,"M")
+3 IF '$TEST
SET LRY=""
+4 SET CNT=$ORDER(^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",""),-1)+1
+5 SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",CNT)="Report Released Date/Time: "_LRY
SET CNT=CNT+1
+6 QUIT
+7 ;
+8 ;
PLS ; List reporting and performing laboratories
+1 ; If multiple performing labs then list tests associated with each lab.
+2 ;
+3 NEW CNT,LINE,LLEN,LRPLS,LRX,MPLS,PLS,TESTNAME,X
+4 ;
+5 SET CNT=$ORDER(^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",""),-1)+1
+6 ;
+7 ; Reporting Laboratory
+8 IF $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2
Begin DoDot:1
+9 SET LRX=+$GET(^LR(LRDFN,"CH",IVDT,"RF"))
+10 IF LRX<1
QUIT
+11 SET LINE=$$PLSADDR^LR7OSUM2(LRX)
+12 SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",CNT)=" "
SET CNT=CNT+1
+13 SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",CNT)="Reporting Lab: "_$PIECE(LINE,"^")
SET CNT=CNT+1
+14 SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",CNT)=" "_$PIECE(LINE,"^",2)
SET CNT=CNT+1
End DoDot:1
+15 ;
+16 SET PLS=$ORDER(^TMP("LRPLS",$JOB,0))
SET MPLS=0
+17 ; multiple performing labs
IF $ORDER(^TMP("LRPLS",$JOB,PLS))
SET MPLS=1
+18 SET LRPLS=0
+19 FOR
SET LRPLS=$ORDER(^TMP("LRPLS",$JOB,LRPLS))
if LRPLS<1
QUIT
Begin DoDot:1
+20 SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",CNT)=" "
SET CNT=CNT+1
+21 IF MPLS
Begin DoDot:2
+22 SET TESTNAME=""
SET LINE="For test(s): "
SET LLEN=13
+23 FOR
SET TESTNAME=$ORDER(^TMP("LRPLS",$JOB,LRPLS,TESTNAME))
if TESTNAME=""
QUIT
Begin DoDot:3
+24 SET X=$LENGTH(TESTNAME)
+25 IF (LLEN+X)>240
SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",CNT)=LINE
SET CNT=CNT+1
SET LINE=""
SET LLEN=0
+26 SET LINE=LINE_$SELECT(LLEN>13:", ",1:"")_TESTNAME
SET LLEN=LLEN+X+$SELECT(LLEN>13:2,1:0)
End DoDot:3
+27 IF LINE'=""
SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",CNT)=LINE
SET CNT=CNT+1
End DoDot:2
+28 SET LINE=$$PLSADDR^LR7OSUM2(LRPLS)
+29 SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",CNT)="Performing Lab: "_$PIECE(LINE,"^")
SET CNT=CNT+1
+30 SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",CNT)=" "_$PIECE(LINE,"^",2)
SET CNT=CNT+1
End DoDot:1
+31 ;
+32 SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,"N",CNT)=" "
+33 ;
+34 KILL ^TMP("LRPLS",$JOB)
+35 QUIT
