LR7OR2 ;VA/DALOI/dcm - Get Lab results (cont.) ; 17-Oct-2014 09:22 ; MKK
;;5.2;LAB SERVICE;**121,187,219,285,286,372,1027,1034**;NOV 01, 1997;Build 88
;
; IHS/MSC/MKK - LR*5.2*1034 - Naked References removed
;
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,IVDT,ITST,IST,TSTY,X,X0,ORD,Y6,Y12,Y16,Y19
; I $G(TEST) Q:'$D(^LAB(60,TEST,0)) S X=^(0) Q:$P(X,"^",4)'="CH" D
I $G(TEST) Q:'$D(^LAB(60,TEST,0)) S X=$G(^(0)) Q:$P(X,"^",4)'="CH" D ; IHS/MSC/MKK - LR*5.2*1034
. I $L($P(X,"^",5)) S TSTY($P($P(X,"^",5),";",2))=TEST
. I '$L($P(X,"^",5)) D EN^LR7OU1(TEST)
S IVDT=SDATE
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 X0=$G(^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) ; IHS/MSC/MKK - LR*5.2*1034
. 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)
. I '$D(TSTY) S ITST=1 F S ITST=$O(^LR(LRDFN,"CH",IVDT,ITST)) Q:ITST<1 S X=$G(^(ITST)) D SETTST(ITST,X) ; IHS/MSC/MKK - LR*5.2*1034
. ; 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)
. S IST=0 F S IST=$O(TSTY(IST)) Q:IST<1 I $D(^LR(LRDFN,"CH",IVDT,IST)) S X=$G(^(IST)) D SETTST(IST,X) ; IHS/MSC/MKK - LR*5.2*1034
. I $O(^TMP("LRRR",$J,DFN,"CH",IVDT,0)) D NOTE(LRDFN,IVDT)
. I GOTIT S CT1=CT1+1
Q
;
;
SETTST(ISUB,ZERO) ;Set test data in ^TMP
;ISUB= test subscript
;ZERO= 0th node at ^LR(LRDFN,"CH",IVDT,TST)
N LRX,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"
I $P($G(^LAB(60,Y1,64)),"^") S Y9=$P($G(^(64)),"^"),Y9=$P($G(^LAM(Y9,0)),"^",2),Y10=$P($G(^(0)),"^"),Y11="99NLT" ; IHS/MSC/MKK - LR*5.2*1034
;D UNIT^LR7OB63(Y1,$P(X0,"^",5),SEX,DOB,AGE)
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"," ")
S ^TMP("LRRR",$J,DFN,"CH",IVDT,ISUB)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^^^"_Y9_"^"_Y10_"^"_Y11_"^"_Y12_"^^"_Y14_"^"_Y15_"^"_Y16_"^"_$G(ORD)_"^^"_Y19
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
S IFN=0 F S IFN=$O(^LR(LRDFN,"CH",IVDT,1,IFN)) Q:IFN<1 S X=$G(^(IFN,0)),^TMP("LRRR",$J,DFN,"CH",IVDT,"N",IFN)=X ; IHS/MSC/MKK - LR*5.2*1034
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 '$L(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
LR7OR2 ;VA/DALOI/dcm - Get Lab results (cont.) ; 17-Oct-2014 09:22 ; MKK
+1 ;;5.2;LAB SERVICE;**121,187,219,285,286,372,1027,1034**;NOV 01, 1997;Build 88
+2 ;
+3 ; IHS/MSC/MKK - LR*5.2*1034 - Naked References removed
+4 ;
CH(SDATE,EDATE,TEST,COUNT,SPEC,UNVER) ;Get CH subscript data
+1 IF '$DATA(SDATE)
QUIT
IF '$DATA(EDATE)
QUIT
IF '$DATA(COUNT)
QUIT
IF '$DATA(CT1)
QUIT
+2 NEW GOTIT,IVDT,ITST,IST,TSTY,X,X0,ORD,Y6,Y12,Y16,Y19
+3 ; I $G(TEST) Q:'$D(^LAB(60,TEST,0)) S X=^(0) Q:$P(X,"^",4)'="CH" D
+4 ; IHS/MSC/MKK - LR*5.2*1034
IF $GET(TEST)
IF '$DATA(^LAB(60,TEST,0))
QUIT
SET X=$GET(^(0))
IF $PIECE(X,"^",4)'="CH"
QUIT
Begin DoDot:1
+5 IF $LENGTH($PIECE(X,"^",5))
SET TSTY($PIECE($PIECE(X,"^",5),";",2))=TEST
+6 IF '$LENGTH($PIECE(X,"^",5))
DO EN^LR7OU1(TEST)
End DoDot:1
+7 SET IVDT=SDATE
+8 FOR
SET IVDT=$ORDER(^LR(LRDFN,"CH",IVDT))
IF IVDT<1!(IVDT>EDATE)!(CT1>COUNT)
QUIT
Begin DoDot:1
+9 ; 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)
+10 ; IHS/MSC/MKK - LR*5.2*1034
SET X0=$GET(^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)
+11 SET GOTIT=0
+12 ; Unverified data not requested
IF '$GET(UNVER)
IF Y6="P"
QUIT
+13 ; Specimen specified
IF $GET(SPEC)
IF Y19'=SPEC
QUIT
+14 ; 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)
+15 ; IHS/MSC/MKK - LR*5.2*1034
IF '$DATA(TSTY)
SET ITST=1
FOR
SET ITST=$ORDER(^LR(LRDFN,"CH",IVDT,ITST))
IF ITST<1
QUIT
SET X=$GET(^(ITST))
DO SETTST(ITST,X)
+16 ; 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)
+17 ; IHS/MSC/MKK - LR*5.2*1034
SET IST=0
FOR
SET IST=$ORDER(TSTY(IST))
IF IST<1
QUIT
IF $DATA(^LR(LRDFN,"CH",IVDT,IST))
SET X=$GET(^(IST))
DO SETTST(IST,X)
+18 IF $ORDER(^TMP("LRRR",$JOB,DFN,"CH",IVDT,0))
DO NOTE(LRDFN,IVDT)
+19 IF GOTIT
SET CT1=CT1+1
End DoDot:1
+20 QUIT
+21 ;
+22 ;
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,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 ; I $P($G(^LAB(60,Y1,64)),"^") S Y9=$P(^(64),"^"),Y9=$P(^LAM(Y9,0),"^",2),Y10=$P(^(0),"^"),Y11="99NLT"
+8 ; IHS/MSC/MKK - LR*5.2*1034
IF $PIECE($GET(^LAB(60,Y1,64)),"^")
SET Y9=$PIECE($GET(^(64)),"^")
SET Y9=$PIECE($GET(^LAM(Y9,0)),"^",2)
SET Y10=$PIECE($GET(^(0)),"^")
SET Y11="99NLT"
+9 ;D UNIT^LR7OB63(Y1,$P(X0,"^",5),SEX,DOB,AGE)
+10 SET LRX=$$TSTRES^LRRPU(LRDFN,"CH",IVDT,ISUB,Y1)
+11 SET Y2=$PIECE(LRX,"^")
SET Y3=$PIECE(LRX,"^",2)
SET Y4=$PIECE(LRX,"^",5)
SET Y5=$$EN^LRLRRVF($PIECE(LRX,"^",3),$PIECE(LRX,"^",4))
+12 IF $PIECE(LRX,"^",7)
SET Y14="T"
+13 SET Y2=$$TRIM^XLFSTR($$RESULT^LR7OB63(Y1,Y2),"RL"," ")
+14 SET ^TMP("LRRR",$JOB,DFN,"CH",IVDT,ISUB)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^^^"_Y9_"^"_Y10_"^"_Y11_"^"_Y12_"^^"_Y14_"^"_Y15_"^"_Y16_"^"_$GET(ORD)_"^^"_Y19
+15 SET GOTIT=1
+16 QUIT
+17 ;
+18 ;
NOTE(LRDFN,IVDT) ;Get comments
+1 NEW IFN
+2 ; 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
+3 ; IHS/MSC/MKK - LR*5.2*1034
SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"CH",IVDT,1,IFN))
IF IFN<1
QUIT
SET X=$GET(^(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
+3 ; count as 1
+4 NEW IVDT,SSUB,SEQ,CTR
+5 IF '$GET(DFN)
QUIT
+6 DO RR^LR7OR1(DFN,$GET(ORD),$GET(SDATE),$GET(EDATE),$GET(SUB),$GET(TEST),$GET(FLAG),$GET(COUNT))
+7 IF '$DATA(^TMP("LRRR",$JOB))
SET Y(1)="No Lab Data"
QUIT
+8 SET CTR=0
SET SSUB=""
SET COUNT=$SELECT($GET(COUNT):COUNT,1:9999999)
+9 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
+10 SET CTR=CTR+1
SET ^TMP("LRAPI",$JOB,CTR)=9999999-IVDT_"^"_SSUB_"^"_^TMP("LRRR",$JOB,DFN,SSUB,IVDT,SEQ)
End DoDot:1
+11 SET Y=$NAME(^TMP("LRAPI",$JOB))
+12 QUIT
+13 ;
+14 ;
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 '$LENGTH(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
