- LR7OF5 ;slc/dcm - Setup new order from OE/RR ;2/4/99 06:42
- ;;5.2;LAB SERVICE;**223,221,256,419**;Sep 27, 1994;Build 1
- ;
- ;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OF5 4999 printed Jan 18, 2025@03:05:44 Page 2
- LR7OF5 ;slc/dcm - Setup new order from OE/RR ;2/4/99 06:42
- +1 ;;5.2;LAB SERVICE;**223,221,256,419**;Sep 27, 1994;Build 1
- +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