source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OF5.m@ 969

Last change on this file since 969 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1LR7OF5 ;slc/dcm - Setup new order from OE/RR ;2/4/99 06:42
2 ;;5.2;LAB SERVICE;**223,221,256**;Sep 27, 1994
3 ;
4 ;This routine invokes IA #2060, #2835, #2747
5 ;
6ORES(LRDFN,SDT,TYPE,SAMP,PROV,LOC,SPEC,ENTERBY) ;Look for match on orders already processed for this session
7 ;SDT=Requested Date time of collection
8 ;TYPE=Collection type
9 Q:'$D(TYPE) "" Q:'$G(SDT) ""
10 N EX,REF,X,STRT,ORI,END
11 S (X,REF)="",(END,STRT)=0
12 F S STRT=$O(^TMP("OR",$J,"LRES",LRDFN,STRT)) Q:'STRT I $D(^(STRT,TYPE)) S ORI=0 D Q:END
13 . F S ORI=$O(^TMP("OR",$J,"LRES",LRDFN,STRT,TYPE,ORI)) Q:'ORI S REF=^(ORI) D Q:END
14 .. I $$ABS^XLFMTH($$FMDIFF^XLFDT(SDT,STRT,2))>600 S REF="" Q
15 .. I REF D Q
16 ... I $$INDAIR(LRDFN,+REF) S REF="" Q
17 ... S X=$$REF(LRDFN,$P(REF,"^",2),$P(REF,"^",3)),END=1
18 I 'REF Q ""
19 I '$L(X) S X="O."_+REF
20 Q X
21FIND(PAT,ODT,SDT,TYPE,SAMP,PROV,LOC,SPEC,ENTERBY) ;Look for match on patient, time, type, specimen, provider
22 ;PAT=LRDFN
23 ;ODT=LRODT
24 ;TYPE=COLLECTION TYPE
25 ;SDT=EST. DATE/TIME OF COLLECTION
26 ;SAMP=COLLECTION SAMPLE
27 ;PROV=PROVIDER
28 ;LOC=LRLLOC (LOCATION)
29 ;SPEC=SPECIMEN
30 Q:'$D(^LRO(69,"D",PAT,ODT)) ""
31 N EX,IFN,X,X0,X1,X4,Y,XORD
32 S IFN=9999999999,X=""
33 F S IFN=$O(^LRO(69,"D",PAT,ODT,IFN),-1) Q:IFN<1 D Q:$L(X)
34 . Q:+$G(^LRO(69,ODT,1,IFN,0))'=PAT ;double check for patient match
35 . Q:$P($G(^LRO(69,ODT,1,IFN,3)),"^") ;cannot add to 'collected' orders
36 . Q:$$ORD(ODT,IFN) ;cannot add if any part of order's collected
37 . Q:$L($P($G(^LRO(69,ODT,1,IFN,1)),"^",7)) ;don't add to a combined order
38 . Q:'$D(^LRO(69,ODT,1,IFN,0)) S X0=^(0),X1=$G(^(.1))
39 . Q:$P(X0,"^",4)'=TYPE
40 . ;'LC' collection types must have same collection times
41 . I TYPE="LC",$P(X0,"^",8)'=SDT Q
42 . 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
43 . L +^LRO(69,"C",+X1):0
44 . I '$T Q
45 . L -^LRO(69,"C",+X1)
46 . I '$$GOT^LROE(+X1,ODT) Q ;Don't combine on canceled order
47 . I $$INDAIR(PAT,+X1,1) S X=" " Q ;Don't combine if duplicate test.
48 . S X=$$REF(PAT,ODT,IFN)
49 . S XORD=$S($L(X):"",1:+X1)
50 S:$G(XORD) X="O."_XORD
51 S:X=" " X=""
52 Q X
53REF(LRDFN,ODT,IFN) ;Setup codes used for combining
54 ;Returns "" if no match found or:
55 ; O.LRORD=Order # to combine with
56 ; S.LRSN.LRORD=Specimen number to combine with
57 ; C.LRSN.LRORD=Creates new LRSN under this order number so that unique data is retained (ENTERBY,PROVIDER,LOC,SPEC)
58 N X0,X1,X4,LRORD,LRODT,LRSN,LRCODE,GOT
59 Q:'$D(^LRO(69,+$G(ODT),1,+$G(IFN),.1)) 0 S LRORD=^(.1),(LRODT,GOT)=0,LRCODE=""
60 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
61 . Q:'$D(^LRO(69,LRODT,1,LRSN,0)) S X0=^(0),X1=$G(^(.1))
62 . Q:+X0'=LRDFN ;Patient check
63 . S X4=$G(^LRO(69,LRODT,1,LRSN,4,1,0))
64 . 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
65 . I $P(X0,"^",3)=SAMP,X4=SPEC S LRCODE="C."_LRSN_"."_+X1,GOT=1 Q
66 Q LRCODE
67ORD(ODT,SN) ;Check to see if any part of the order's been collected
68 N LRORD
69 Q:'$D(^LRO(69,+$G(ODT),1,+$G(SN),.1)) 0 S LRORD=^(.1)
70 N LRODT,LRSN,GOT
71 S LRODT=0
72 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
73 . I $D(^LRO(69,LRODT,1,LRSN,3)) S GOT=1 Q
74 Q +$G(GOT)
75INDAIR(LRDFN,LRORD,CHK) ;Check for test duplication and tests that require their own order #
76 ;Function returns 0 if test allowed, 1 if not
77 ;CHK=1 if called from FIND, 0 if called from ORES (doesn't check ORES array)
78 Q:'$G(LRORD) 1
79 N UTS,X,X4,ODT,LRSN,TST,EX
80 S ODT=0,EX=0
81 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
82 . I +$G(^LRO(69,LRODT,1,LRSN,0))'=LRDFN Q ;Check for same patient
83 . S UTS=0 F S UTS=$O(^TMP("OR",$J,"LROT",SDT,TYPE,SAMP,SPEC,UTS)) Q:'UTS S X=^(UTS) D Q:EX
84 .. S X4=$G(^LRO(69,LRODT,1,LRSN,4,1,0))
85 .. I X4=SPEC,$D(^LRO(69,ODT,1,LRSN,2,"B",+X)) S EX=1 Q ;Duplicate test
86 .. I $P($G(^LAB(60,+X,0)),"^",20) S EX=1 Q ;Combining not allowed
87 .. 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
88 ... I $P($G(^LAB(60,TST,0)),"^",20) S EX=1 Q
89 ... N EXY
90 ... D EXPAND^LR7OU1(TST,.EXY)
91 ... 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
92 ... Q:EX
93 ... I $G(CHK) S EX=$$ESTEST(TST,LRXZ,LRSDT)
94 Q EX
95ESTEST(TEST,TYPE,STARTDT) ;Check ORES array for potential duplicates
96 Q:'$G(TEST) 0 Q:'$D(TYPE) 0 Q:'$G(STARTDT) 0
97 N IFN,ACT,LRI,ES,X
98 S ES=0,LRI=""
99 F S LRI=$O(ORES(LRI)) Q:'LRI!(ES) S IFN=+LRI,ACT=$P(LRI,";",2) I $$VALUE^ORCSAVE2(IFN,"COLLECT")=TYPE D
100 . I +$P($G(^ORD(101.43,+$$VALUE^ORCSAVE2(IFN,"ORDERABLE"),0)),"^",2)'=TEST S ES=0 Q
101 . S X=$P($G(^OR(100,IFN,8,ACT,0)),"^")
102 . I X,$$ABS^XLFMTH($$FMDIFF^XLFDT(X,STARTDT,2))<600 S ES=1 Q
103 Q ES
Note: See TracBrowser for help on using the repository browser.