source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQQLR1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1ORQQLR1 ; slc/CLA - Extrinsic functions and procedures which return patient lab results ;7/23/96 12:47
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,51,74,143**;Dec 17, 1997
3OETOLAB(ORNUM) ;extrinsic funct to get a lab order number from an oe/rr number
4 N LRNUM
5 S LRNUM=$G(^OR(100,ORNUM,4))
6 Q +LRNUM
7 ;
8PRINTNAM(LRIEN) ;extrinsic function to return the print name for an entry in the Lab file [#60]
9 Q:+$G(LRIEN)<1 ""
10 N NODE,NAME
11 S NODE=$G(^LAB(60,LRIEN,.1))
12 Q:'$L(NODE) ""
13 S NAME=$P(NODE,U)
14 Q NAME
15 ;
16OIRES(PT,OILR,SPEC) ;extrinsic function to return pt's most recent lab results for a lab orderable item in the format:
17 ; test id^abbrev test name^result^units^flag^collection d/t
18 N RSLT,ORZ
19 S ORZ=""
20 S RSLT=$$GETDATA^OCXCACHE(.ORZ,"$$OIRESC^ORQQLR1("_PT_","_OILR_","_SPEC_")",PT,)
21 Q ORZ
22 ;
23OIRESC(PT,OILR,SPEC) ;extrinsic function to return pt's most recent lab results for a lab orderable item in the format:
24 ; test id^abbrev test name^result^units^flag^collection d/t
25 N ORY,ORX,ORN,ORLR,SUB,INVDT,SEQ,ORDG,RESULT
26 S SUB="",INVDT=0,SEQ=0,ORY=""
27 ;check to make sure the OI is in DG lab
28 Q:'$L($G(PT))!('$L($G(OILR))) ORY
29 Q:'$L($G(^ORD(101.43,OILR,0))) ORY
30 I +$G(SPEC)<1 S SPEC=""
31 S ORDG=$$DG^ORQOR1("LAB")
32 Q:'$L($G(ORDG)) ORY
33 Q:$P(^ORD(101.43,OILR,0),U,5)'=ORDG ORY ;quit if display grp is not lab
34 ;get lab test ien
35 S ORX=$P(^ORD(101.43,OILR,0),U,2)
36 S ORLR=$S(ORX["~":$P(ORX,"~"),1:$P(ORX,";"))
37 ;get lab results
38 K ^TMP("LRRR",$J)
39 D RR^LR7OR1(PT,"","","","",ORLR,"L",1,SPEC) I $D(^TMP("LRRR",$J,PT)) D
40 .S SUB=$O(^TMP("LRRR",$J,PT,SUB)) Q:SUB=""
41 .S INVDT=$O(^TMP("LRRR",$J,PT,SUB,INVDT)) Q:'INVDT
42 .S SEQ=$O(^TMP("LRRR",$J,PT,SUB,INVDT,SEQ)) Q:'SEQ D
43 ..S RESULT=^(SEQ),ORY=$P(RESULT,U)_U_$P(RESULT,U,15)_U_$P(RESULT,U,2)_U_$P(RESULT,U,4)_U_$P(RESULT,U,3)_U_$P(RESULT,U,5)_U_(9999999-INVDT)
44 K ^TMP("LRRR",$J)
45 Q ORY
46 ;
47NATL(PT,NID,SPEC) ;extrinsic function to return pt's most recent lab results for a lab national id in the format:
48 ; test id^abbrev test name^result^units^flag^collection d/t
49 N RSLT,ORZ
50 S ORZ=""
51 S RSLT=$$GETDATA^OCXCACHE(.ORZ,"$$NATLC^ORQQLR1("_PT_","_NID_","_SPEC_")",PT,)
52 Q ORZ
53 ;
54NATLC(PT,NID,SPEC) ;extrinsic function to return pt's most recent lab results for a lab national id in the format:
55 ; test id^abbrev test name^result^units^flag^collection d/t
56 N ORY,ORX,ORN,ORLR,SUB,INVDT,SEQ,ORDG
57 S SUB="",INVDT=0,SEQ=0,ORY=""
58 I +$G(SPEC)<1 S SPEC=""
59 ;get lab results
60 K ^TMP("LRRR",$J)
61 D RR^LR7OR1(PT,"","","","",NID,"N",1,SPEC) I $D(^TMP("LRRR",$J,PT)) D
62 .S SUB=$O(^TMP("LRRR",$J,PT,SUB)) Q:SUB=""
63 .S INVDT=$O(^TMP("LRRR",$J,PT,SUB,INVDT)) Q:'INVDT
64 .S SEQ=$O(^TMP("LRRR",$J,PT,SUB,INVDT,SEQ)) Q:'SEQ D
65 ..S RESULT=^(SEQ),ORY=$P(RESULT,U)_U_$P(RESULT,U,15)_U_$P(RESULT,U,2)_U_$P(RESULT,U,4)_U_$P(RESULT,U,3)_U_$P(RESULT,U,5)_U_(9999999-INVDT)
66 K ^TMP("LRRR",$J)
67 Q ORY
68 ;
69LOCL(PT,LID,SPEC) ;extrinsic function to return pt's most recent lab results for a lab local id in the format:
70 ; test id^abbrev test name^result^units^flag^collection d/t
71 N RSLT,ORZ
72 S ORZ=""
73 S RSLT=$$GETDATA^OCXCACHE(.ORZ,"$$LOCLC^ORQQLR1("_PT_","_LID_","_SPEC_")",PT,)
74 Q ORZ
75 ;
76LOCLC(PT,LID,SPEC) ;extrinsic function to return pt's most recent lab results for a lab local id in the format:
77 ; test id^abbrev test name^result^units^flag^collection d/t
78 N ORY,ORX,SUB,INVDT,SEQ,RESULT
79 S SUB="",INVDT=0,SEQ=0,ORY=""
80 ;get lab results
81 I +$G(SPEC)<1 S SPEC=""
82 K ^TMP("LRRR",$J)
83 D RR^LR7OR1(PT,"","","","",LID,"L",1,SPEC) I $D(^TMP("LRRR",$J,PT)) D
84 .S SUB=$O(^TMP("LRRR",$J,PT,SUB)) Q:SUB=""
85 .S INVDT="" F S INVDT=$O(^TMP("LRRR",$J,PT,SUB,INVDT)) Q:'INVDT D
86 ..S SEQ="" F S SEQ=$O(^TMP("LRRR",$J,PT,SUB,INVDT,SEQ)) Q:'SEQ!(+$G(RESULT)>0) D
87 ...S ORX=^(SEQ)
88 ...I $P(ORX,U,2)'="canc" D ;if results were not cancelled in lab:
89 ....S RESULT=$P(ORX,U,2)
90 ....S ORY=$P(ORX,U)_U_$P(ORX,U,15)_U_$P(ORX,U,2)_U_$P(ORX,U,4)
91 ....S ORY=ORY_U_$P(ORX,U,3)_U_$P(ORX,U,5)_U_(9999999-INVDT)
92 K ^TMP("LRRR",$J)
93 Q ORY
94 ;
95LOCLFORM(PT,LID,SPEC) ;extrinsic function to return formatted most recnt lab
96 ;rtn format: 1 (if results)^<print name> <value> <units> <high/low flag>
97 ; (<reference range>) <collection date/time>
98 N FRCNT,X
99 S X=$$LOCL(PT,LID,SPEC)
100 Q:'$L(X) "^No results found."
101 S FRCNT="1^"_$P(X,U,2)_" "_$P(X,U,3)_" "_$P(X,U,4)_" "_$P(X,U,5)
102 S FRCNT=FRCNT_" ("_$P(X,U,6)_") "_$$FMTE^XLFDT($P(X,U,7),"2P")
103 Q FRCNT
Note: See TracBrowser for help on using the repository browser.