source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OR2.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1LR7OR2 ;DALOI/dcm - Get Lab results (cont.) ;8/11/97
2 ;;5.2;LAB SERVICE;**121,187,219,285,286**;Sep 27, 1994
3 ;
4 ;
5CH(SDATE,EDATE,TEST,COUNT,SPEC,UNVER) ;Get CH subscript data
6 Q:'$D(SDATE) Q:'$D(EDATE) Q:'$D(COUNT) Q:'$D(CT1)
7 N GOTIT,IVDT,ITST,IST,TSTY,X,X0,ORD,Y6,Y12,Y16,Y19
8 I $G(TEST) Q:'$D(^LAB(60,TEST,0)) S X=^(0) Q:$P(X,"^",4)'="CH" D
9 . I $L($P(X,"^",5)) S TSTY($P($P(X,"^",5),";",2))=TEST
10 . I '$L($P(X,"^",5)) D EN^LR7OU1(TEST)
11 S IVDT=SDATE
12 F S IVDT=$O(^LR(LRDFN,"CH",IVDT)) Q:IVDT<1!(IVDT>EDATE)!(CT1>COUNT) D
13 . 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)
14 . S GOTIT=0
15 . I '$G(UNVER),Y6="P" Q ;Unverified data not requested
16 . I $G(SPEC),Y19'=SPEC Q ;Specimen specified
17 . 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)
18 . 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)
19 . I $O(^TMP("LRRR",$J,DFN,"CH",IVDT,0)) D NOTE(LRDFN,IVDT)
20 . I GOTIT S CT1=CT1+1
21 Q
22 ;
23 ;
24SETTST(ISUB,ZERO) ;Set test data in ^TMP
25 ;ISUB= test subscript
26 ;ZERO= 0th node at ^LR(LRDFN,"CH",IVDT,TST)
27 N LRX,X,Y,Y1,Y2,Y3,Y4,Y5,Y9,Y10,Y11,Y14
28 S X=ZERO,Y1=ISUB,Y1=$O(^LAB(60,"C","CH;"_Y1_";1",0)),Y2=$P(X,"^"),Y3=$P(X,"^",2)
29 Q:'Y1 Q:"IN"[$P(^LAB(60,Y1,0),"^",3) S Y15=$P($G(^LAB(60,Y1,.1)),"^")
30 S (Y9,Y10,Y11,Y14)=""
31 I $P($G(^LAB(60,Y1,64)),"^") S Y9=$P(^(64),"^"),Y9=$P(^LAM(Y9,0),"^",2),Y10=$P(^(0),"^"),Y11="99NLT"
32 ;D UNIT^LR7OB63(Y1,$P(X0,"^",5),SEX,DOB,AGE)
33 S LRX=$$TSTRES^LRRPU(LRDFN,"CH",IVDT,ISUB,Y1)
34 S Y2=$P(LRX,"^"),Y3=$P(LRX,"^",2),Y4=$P(LRX,"^",5),Y5=$P(LRX,"^",3)_$S($P(LRX,"^",4)'="":"-"_$P(LRX,"^",4),1:"")
35 I $P(LRX,"^",7) S Y14="T"
36 S Y2=$$TRIM^XLFSTR($$RESULT^LR7OB63(Y1,Y2),"RL"," ")
37 S ^TMP("LRRR",$J,DFN,"CH",IVDT,ISUB)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^^^"_Y9_"^"_Y10_"^"_Y11_"^"_Y12_"^^"_Y14_"^"_Y15_"^"_Y16_"^"_$G(ORD)_"^^"_Y19
38 S GOTIT=1
39 Q
40 ;
41 ;
42NOTE(LRDFN,IVDT) ;Get comments
43 N IFN
44 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
45 Q
46 ;
47 ;
48TEST(Y,DFN,ORD,SDATE,EDATE,SUB,TEST,FLAG,COUNT) ;Test network calls
49 ;Called from TIU
50 ;COUNT = count of results to send, results with the same date/time
51 ; count as 1
52 N IVDT,SSUB,SEQ,CTR
53 Q:'$G(DFN)
54 D RR^LR7OR1(DFN,$G(ORD),$G(SDATE),$G(EDATE),$G(SUB),$G(TEST),$G(FLAG),$G(COUNT))
55 I '$D(^TMP("LRRR",$J)) S Y(1)="No Lab Data" Q
56 S CTR=0,SSUB="",COUNT=$S($G(COUNT):COUNT,1:9999999)
57 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
58 . S CTR=CTR+1,^TMP("LRAPI",$J,CTR)=9999999-IVDT_"^"_SSUB_"^"_^TMP("LRRR",$J,DFN,SSUB,IVDT,SEQ)
59 S Y=$NA(^TMP("LRAPI",$J))
60 Q
61 ;
62 ;
63T60(Y,IFN) ;Get tests from file 60
64 ;If IFN is not passed then the whole file is sent.
65 N CTR S CTR=0
66 I $D(IFN) Q:'$D(^LAB(60,IFN,0)) S Y(1)=IFN_"^"_$P(^LAB(60,IFN,0),"^") Q
67 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
68 Q
69 ;
70 ;
71T64(Y,IFN) ;Get tests from file 64
72 ;If IFN is not passed then the whole file is sent, if entry has a link to file 60
73 N CTR S CTR=0
74 I $D(IFN) Q:'$D(^LAM(IFN,0)) Q:'$D(^LAB(60,"AC",IFN)) S Y(1)=IFN_"^"_$P(^LAM(IFN,0),"^") Q
75 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
76 Q
77 ;
78 ;
79ORD(LRDFN,IVDT) ;Get order # for entry in file 63
80 ;LRDFN=Lab Patient #
81 ;IVDT=Inverse Date/time in 63 (^LR(LRDFN,"CH",IVDT))
82 Q:'$G(LRDFN) Q:'$G(IVDT)
83 N X0,X6,X,AC,ACD,ACN
84 S X0=$G(^LR(LRDFN,"CH",IVDT,0)),X6=$P(X0,"^",6) I '$L(X6) Q ""
85 S X=$P(X6," "),X=$O(^LRO(68,"B",X,0)) I 'X Q ""
86 S AC=X,ACD=+$P(X0,"."),ACN=$P(X6," ",3) I '$D(^LRO(68,AC,1,ACD,1,ACN,0)) Q ""
87 S X=$P($G(^LRO(68,AC,1,ACD,1,ACN,.1)),"^")
88 Q X
Note: See TracBrowser for help on using the repository browser.