LR7OF5 ;VA/slc/dcm - Setup new order from OE/RR ; 13-Aug-2013 09:16 ; MKK
;;5.2;LAB SERVICE;**223,221,256,1018,419,1033**;NOV 01, 1997
;
;This routine invokes IA #2060, #2835, #2747
;
ORES(LRDFN,SDT,TYPE,SAMP,PROV,LOC,SPEC,ENTERBY) ;Look for match on orders already processed for this session
;SDT=Requested Date time of collection
;TYPE=Collection type
Q:'$D(TYPE) "" Q:'$G(SDT) ""
N EX,REF,X,STRT,ORI,END
S (X,REF)="",(END,STRT)=0
F S STRT=$O(^TMP("OR",$J,"LRES",LRDFN,STRT)) Q:'STRT I $D(^(STRT,TYPE)) S ORI=0 D Q:END
. F S ORI=$O(^TMP("OR",$J,"LRES",LRDFN,STRT,TYPE,ORI)) Q:'ORI S REF=^(ORI) D Q:END
.. I $$ABS^XLFMTH($$FMDIFF^XLFDT(SDT,STRT,2))>600 S REF="" Q
.. I REF D Q
... I $$INDAIR(LRDFN,+REF) S REF="" Q
... S X=$$REF(LRDFN,$P(REF,"^",2),$P(REF,"^",3)),END=1
I 'REF Q ""
I '$L(X) S X="O."_+REF
Q X
FIND(PAT,ODT,SDT,TYPE,SAMP,PROV,LOC,SPEC,ENTERBY) ;Look for match on patient, time, type, specimen, provider
;PAT=LRDFN
;ODT=LRODT
;TYPE=COLLECTION TYPE
;SDT=EST. DATE/TIME OF COLLECTION
;SAMP=COLLECTION SAMPLE
;PROV=PROVIDER
;LOC=LRLLOC (LOCATION)
;SPEC=SPECIMEN
Q:'$D(^LRO(69,"D",PAT,ODT)) ""
N EX,IFN,X,X0,X1,X4,Y,XORD
S IFN=9999999999,X=""
F S IFN=$O(^LRO(69,"D",PAT,ODT,IFN),-1) Q:IFN<1 D Q:$L(X)
. Q:+$G(^LRO(69,ODT,1,IFN,0))'=PAT ;double check for patient match
. Q:$P($G(^LRO(69,ODT,1,IFN,3)),"^") ;cannot add to 'collected' orders
. Q:$$ORD(ODT,IFN) ;cannot add if any part of order's collected
. Q:$L($P($G(^LRO(69,ODT,1,IFN,1)),"^",7)) ;don't add to a combined order
. Q:'$D(^LRO(69,ODT,1,IFN,0)) S X0=^(0),X1=$G(^(.1))
. Q:$P(X0,"^",4)'=TYPE
. ;'LC' collection types must have same collection times
. I TYPE="LC",$P(X0,"^",8)'=SDT Q
. I TYPE'="LC",$P(X0,"^",8),SDT,$$ABS^XLFMTH($$FMDIFF^XLFDT(SDT,$P(X0,"^",8),2))>600 Q ;don't combine if time difference is >10 min
. L +^LRO(69,"C",+X1):$G(DILOCKTM,3)
. I '$T Q
. L -^LRO(69,"C",+X1)
. I '$$GOT^LROE(+X1,ODT) Q ;Don't combine on canceled order
. I $$INDAIR(PAT,+X1,1) S X=" " Q ;Don't combine if duplicate test.
. S X=$$REF(PAT,ODT,IFN)
. S XORD=$S($L(X):"",1:+X1)
S:$G(XORD) X="O."_XORD
S:X=" " X=""
Q X
REF(LRDFN,ODT,IFN) ;Setup codes used for combining
;Returns "" if no match found or:
; O.LRORD=Order # to combine with
; S.LRSN.LRORD=Specimen number to combine with
; C.LRSN.LRORD=Creates new LRSN under this order number so that unique data is retained (ENTERBY,PROVIDER,LOC,SPEC)
N X0,X1,X4,LRORD,LRODT,LRSN,LRCODE,GOT
Q:'$D(^LRO(69,+$G(ODT),1,+$G(IFN),.1)) 0 S LRORD=^(.1),(LRODT,GOT)=0,LRCODE=""
F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:'LRODT!GOT S LRSN=0 F S LRSN=$O(^LRO(69,"C",LRORD,LRODT,LRSN)) Q:'LRSN!GOT D
. Q:'$D(^LRO(69,LRODT,1,LRSN,0)) S X0=^(0),X1=$G(^(.1))
. Q:+X0'=LRDFN ;Patient check
. S X4=$G(^LRO(69,LRODT,1,LRSN,4,1,0))
. I $P(X0,"^",2)=ENTERBY,$P(X0,"^",3)=SAMP,$P(X0,"^",6)=PROV,$P(X0,"^",9)=LOC,X4=SPEC S LRCODE="S."_LRSN_"."_+X1,GOT=1 Q
. I $P(X0,"^",3)=SAMP,X4=SPEC S LRCODE="C."_LRSN_"."_+X1,GOT=1 Q
Q LRCODE
ORD(ODT,SN) ;Check to see if any part of the order's been collected
N LRORD
Q:'$D(^LRO(69,+$G(ODT),1,+$G(SN),.1)) 0 S LRORD=^(.1)
N LRODT,LRSN,GOT
S LRODT=0
F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:'LRODT S LRSN=0 F S LRSN=$O(^LRO(69,"C",LRORD,LRODT,LRSN)) Q:'LRSN D
. I $D(^LRO(69,LRODT,1,LRSN,3)) S GOT=1 Q
Q +$G(GOT)
INDAIR(LRDFN,LRORD,CHK) ;Check for test duplication and tests that require their own order #
;Function returns 0 if test allowed, 1 if not
;CHK=1 if called from FIND, 0 if called from ORES (doesn't check ORES array)
Q:'$G(LRORD) 1
N UTS,X,X4,ODT,LRSN,TST,EX
S ODT=0,EX=0
F S ODT=$O(^LRO(69,"C",LRORD,ODT)) Q:'ODT!(EX) S LRSN=0 F S LRSN=$O(^LRO(69,"C",LRORD,ODT,LRSN)) Q:'LRSN!(EX) D
. I +$G(^LRO(69,LRODT,1,LRSN,0))'=LRDFN S EX=1 Q ;Check for same patient
. S UTS=0 F S UTS=$O(^TMP("OR",$J,"LROT",SDT,TYPE,SAMP,SPEC,UTS)) Q:'UTS S X=^(UTS) D Q:EX
.. S X4=$G(^LRO(69,LRODT,1,LRSN,4,1,0))
.. I X4=SPEC,$D(^LRO(69,ODT,1,LRSN,2,"B",+X)) S EX=1 Q ;Duplicate test
.. I $P($G(^LAB(60,+X,0)),"^",20) S EX=1 Q ;Combining not allowed
.. S TST=0 F S TST=$O(^LRO(69,ODT,1,LRSN,2,"B",TST)) Q:'TST D Q:EX ;Duplicate check for all tests
... I $P($G(^LAB(60,TST,0)),"^",20) S EX=1 Q
... N EXY
... D EXPAND^LR7OU1(TST,.EXY)
... S EXY=0 F S EXY=$O(EX(EXY)) Q:'EXY I $D(^LRO(69,ODT,1,LRSN,2,"B",EXY)) S EX=1 Q ;Check panels for duplicate
... Q:EX
... I $G(CHK) S EX=$$ESTEST(TST,LRXZ,LRSDT)
Q EX
ESTEST(TEST,TYPE,STARTDT) ;Check ORES array for potential duplicates
Q:'$G(TEST) 0 Q:'$D(TYPE) 0 Q:'$G(STARTDT) 0
N IFN,ACT,LRI,ES,X
S ES=0,LRI=""
F S LRI=$O(ORES(LRI)) Q:'LRI!(ES) S IFN=+LRI,ACT=$P(LRI,";",2) I $$VALUE^ORCSAVE2(IFN,"COLLECT")=TYPE D
. I +$P($G(^ORD(101.43,+$$VALUE^ORCSAVE2(IFN,"ORDERABLE"),0)),"^",2)'=TEST S ES=0 Q
. S X=$P($G(^OR(100,IFN,8,ACT,0)),"^")
. I X,$$ABS^XLFMTH($$FMDIFF^XLFDT(X,STARTDT,2))<600 S ES=1 Q
Q ES
LR7OF5 ;VA/slc/dcm - Setup new order from OE/RR ; 13-Aug-2013 09:16 ; MKK
+1 ;;5.2;LAB SERVICE;**223,221,256,1018,419,1033**;NOV 01, 1997
+2 ;
+3 ;This routine invokes IA #2060, #2835, #2747
+4 ;
ORES(LRDFN,SDT,TYPE,SAMP,PROV,LOC,SPEC,ENTERBY) ;Look for match on orders already processed for this session
+1 ;SDT=Requested Date time of collection
+2 ;TYPE=Collection type
+3 IF '$DATA(TYPE)
QUIT ""
IF '$GET(SDT)
QUIT ""
+4 NEW EX,REF,X,STRT,ORI,END
+5 SET (X,REF)=""
SET (END,STRT)=0
+6 FOR
SET STRT=$ORDER(^TMP("OR",$JOB,"LRES",LRDFN,STRT))
IF 'STRT
QUIT
IF $DATA(^(STRT,TYPE))
SET ORI=0
Begin DoDot:1
+7 FOR
SET ORI=$ORDER(^TMP("OR",$JOB,"LRES",LRDFN,STRT,TYPE,ORI))
IF 'ORI
QUIT
SET REF=^(ORI)
Begin DoDot:2
+8 IF $$ABS^XLFMTH($$FMDIFF^XLFDT(SDT,STRT,2))>600
SET REF=""
QUIT
+9 IF REF
Begin DoDot:3
+10 IF $$INDAIR(LRDFN,+REF)
SET REF=""
QUIT
+11 SET X=$$REF(LRDFN,$PIECE(REF,"^",2),$PIECE(REF,"^",3))
SET END=1
End DoDot:3
QUIT
End DoDot:2
IF END
QUIT
End DoDot:1
IF END
QUIT
+12 IF 'REF
QUIT ""
+13 IF '$LENGTH(X)
SET X="O."_+REF
+14 QUIT X
FIND(PAT,ODT,SDT,TYPE,SAMP,PROV,LOC,SPEC,ENTERBY) ;Look for match on patient, time, type, specimen, provider
+1 ;PAT=LRDFN
+2 ;ODT=LRODT
+3 ;TYPE=COLLECTION TYPE
+4 ;SDT=EST. DATE/TIME OF COLLECTION
+5 ;SAMP=COLLECTION SAMPLE
+6 ;PROV=PROVIDER
+7 ;LOC=LRLLOC (LOCATION)
+8 ;SPEC=SPECIMEN
+9 IF '$DATA(^LRO(69,"D",PAT,ODT))
QUIT ""
+10 NEW EX,IFN,X,X0,X1,X4,Y,XORD
+11 SET IFN=9999999999
SET X=""
+12 FOR
SET IFN=$ORDER(^LRO(69,"D",PAT,ODT,IFN),-1)
IF IFN<1
QUIT
Begin DoDot:1
+13 ;double check for patient match
IF +$GET(^LRO(69,ODT,1,IFN,0))'=PAT
QUIT
+14 ;cannot add to 'collected' orders
IF $PIECE($GET(^LRO(69,ODT,1,IFN,3)),"^")
QUIT
+15 ;cannot add if any part of order's collected
IF $$ORD(ODT,IFN)
QUIT
+16 ;don't add to a combined order
IF $LENGTH($PIECE($GET(^LRO(69,ODT,1,IFN,1)),"^",7))
QUIT
+17 IF '$DATA(^LRO(69,ODT,1,IFN,0))
QUIT
SET X0=^(0)
SET X1=$GET(^(.1))
+18 IF $PIECE(X0,"^",4)'=TYPE
QUIT
+19 ;'LC' collection types must have same collection times
+20 IF TYPE="LC"
IF $PIECE(X0,"^",8)'=SDT
QUIT
+21 ;don't combine if time difference is >10 min
IF TYPE'="LC"
IF $PIECE(X0,"^",8)
IF SDT
IF $$ABS^XLFMTH($$FMDIFF^XLFDT(SDT,$PIECE(X0,"^",8),2))>600
QUIT
+22 LOCK +^LRO(69,"C",+X1):$GET(DILOCKTM,3)
+23 IF '$TEST
QUIT
+24 LOCK -^LRO(69,"C",+X1)
+25 ;Don't combine on canceled order
IF '$$GOT^LROE(+X1,ODT)
QUIT
+26 ;Don't combine if duplicate test.
IF $$INDAIR(PAT,+X1,1)
SET X=" "
QUIT
+27 SET X=$$REF(PAT,ODT,IFN)
+28 SET XORD=$SELECT($LENGTH(X):"",1:+X1)
End DoDot:1
IF $LENGTH(X)
QUIT
+29 IF $GET(XORD)
SET X="O."_XORD
+30 IF X=" "
SET X=""
+31 QUIT X
REF(LRDFN,ODT,IFN) ;Setup codes used for combining
+1 ;Returns "" if no match found or:
+2 ; O.LRORD=Order # to combine with
+3 ; S.LRSN.LRORD=Specimen number to combine with
+4 ; C.LRSN.LRORD=Creates new LRSN under this order number so that unique data is retained (ENTERBY,PROVIDER,LOC,SPEC)
+5 NEW X0,X1,X4,LRORD,LRODT,LRSN,LRCODE,GOT
+6 IF '$DATA(^LRO(69,+$GET(ODT),1,+$GET(IFN),.1))
QUIT 0
SET LRORD=^(.1)
SET (LRODT,GOT)=0
SET LRCODE=""
+7 FOR
SET LRODT=$ORDER(^LRO(69,"C",LRORD,LRODT))
IF 'LRODT!GOT
QUIT
SET LRSN=0
FOR
SET LRSN=$ORDER(^LRO(69,"C",LRORD,LRODT,LRSN))
IF 'LRSN!GOT
QUIT
Begin DoDot:1
+8 IF '$DATA(^LRO(69,LRODT,1,LRSN,0))
QUIT
SET X0=^(0)
SET X1=$GET(^(.1))
+9 ;Patient check
IF +X0'=LRDFN
QUIT
+10 SET X4=$GET(^LRO(69,LRODT,1,LRSN,4,1,0))
+11 IF $PIECE(X0,"^",2)=ENTERBY
IF $PIECE(X0,"^",3)=SAMP
IF $PIECE(X0,"^",6)=PROV
IF $PIECE(X0,"^",9)=LOC
IF X4=SPEC
SET LRCODE="S."_LRSN_"."_+X1
SET GOT=1
QUIT
+12 IF $PIECE(X0,"^",3)=SAMP
IF X4=SPEC
SET LRCODE="C."_LRSN_"."_+X1
SET GOT=1
QUIT
End DoDot:1
+13 QUIT LRCODE
ORD(ODT,SN) ;Check to see if any part of the order's been collected
+1 NEW LRORD
+2 IF '$DATA(^LRO(69,+$GET(ODT),1,+$GET(SN),.1))
QUIT 0
SET LRORD=^(.1)
+3 NEW LRODT,LRSN,GOT
+4 SET LRODT=0
+5 FOR
SET LRODT=$ORDER(^LRO(69,"C",LRORD,LRODT))
IF 'LRODT
QUIT
SET LRSN=0
FOR
SET LRSN=$ORDER(^LRO(69,"C",LRORD,LRODT,LRSN))
IF 'LRSN
QUIT
Begin DoDot:1
+6 IF $DATA(^LRO(69,LRODT,1,LRSN,3))
SET GOT=1
QUIT
End DoDot:1
+7 QUIT +$GET(GOT)
INDAIR(LRDFN,LRORD,CHK) ;Check for test duplication and tests that require their own order #
+1 ;Function returns 0 if test allowed, 1 if not
+2 ;CHK=1 if called from FIND, 0 if called from ORES (doesn't check ORES array)
+3 IF '$GET(LRORD)
QUIT 1
+4 NEW UTS,X,X4,ODT,LRSN,TST,EX
+5 SET ODT=0
SET EX=0
+6 FOR
SET ODT=$ORDER(^LRO(69,"C",LRORD,ODT))
IF 'ODT!(EX)
QUIT
SET LRSN=0
FOR
SET LRSN=$ORDER(^LRO(69,"C",LRORD,ODT,LRSN))
IF 'LRSN!(EX)
QUIT
Begin DoDot:1
+7 ;Check for same patient
IF +$GET(^LRO(69,LRODT,1,LRSN,0))'=LRDFN
SET EX=1
QUIT
+8 SET UTS=0
FOR
SET UTS=$ORDER(^TMP("OR",$JOB,"LROT",SDT,TYPE,SAMP,SPEC,UTS))
IF 'UTS
QUIT
SET X=^(UTS)
Begin DoDot:2
+9 SET X4=$GET(^LRO(69,LRODT,1,LRSN,4,1,0))
+10 ;Duplicate test
IF X4=SPEC
IF $DATA(^LRO(69,ODT,1,LRSN,2,"B",+X))
SET EX=1
QUIT
+11 ;Combining not allowed
IF $PIECE($GET(^LAB(60,+X,0)),"^",20)
SET EX=1
QUIT
+12 ;Duplicate check for all tests
SET TST=0
FOR
SET TST=$ORDER(^LRO(69,ODT,1,LRSN,2,"B",TST))
IF 'TST
QUIT
Begin DoDot:3
+13 IF $PIECE($GET(^LAB(60,TST,0)),"^",20)
SET EX=1
QUIT
+14 NEW EXY
+15 DO EXPAND^LR7OU1(TST,.EXY)
+16 ;Check panels for duplicate
SET EXY=0
FOR
SET EXY=$ORDER(EX(EXY))
IF 'EXY
QUIT
IF $DATA(^LRO(69,ODT,1,LRSN,2,"B",EXY))
SET EX=1
QUIT
+17 IF EX
QUIT
+18 IF $GET(CHK)
SET EX=$$ESTEST(TST,LRXZ,LRSDT)
End DoDot:3
IF EX
QUIT
End DoDot:2
IF EX
QUIT
End DoDot:1
+19 QUIT EX
ESTEST(TEST,TYPE,STARTDT) ;Check ORES array for potential duplicates
+1 IF '$GET(TEST)
QUIT 0
IF '$DATA(TYPE)
QUIT 0
IF '$GET(STARTDT)
QUIT 0
+2 NEW IFN,ACT,LRI,ES,X
+3 SET ES=0
SET LRI=""
+4 FOR
SET LRI=$ORDER(ORES(LRI))
IF 'LRI!(ES)
QUIT
SET IFN=+LRI
SET ACT=$PIECE(LRI,";",2)
IF $$VALUE^ORCSAVE2(IFN,"COLLECT")=TYPE
Begin DoDot:1
+5 IF +$PIECE($GET(^ORD(101.43,+$$VALUE^ORCSAVE2(IFN,"ORDERABLE"),0)),"^",2)'=TEST
SET ES=0
QUIT
+6 SET X=$PIECE($GET(^OR(100,IFN,8,ACT,0)),"^")
+7 IF X
IF $$ABS^XLFMTH($$FMDIFF^XLFDT(X,STARTDT,2))<600
SET ES=1
QUIT
End DoDot:1
+8 QUIT ES
