source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQQLR.m@ 623

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

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1ORQQLR ; slc/CLA - Functions which return patient lab results ;12/15/97 [ 04/02/97 3:46 PM ]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,143**;Dec 17, 1997
3 ;
4LIST(Y,PT,SDT,EDT,SUBSECT) ; return patient's lab results between start date and stop date for the lab sub section:
5 N I,J,SUB,INVDT,SEQ,DIFF,X,EXTDT,ORSRV
6 S J=1,SUB=0,INVDT=0,SEQ=0
7 S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
8 I '$L($G(SDT)) S Y(1)="^Error in date range." Q
9 I '$L($G(EDT)) D NOW^%DTC S EDT=+% K %
10 S:'$L($G(SUBSECT)) SUBSECT="ALL"
11 K ^TMP("LRRR",$J)
12 D RR^LR7OR1(PT,"",SDT,EDT,SUBSECT)
13 F S SUB=$O(^TMP("LRRR",$J,PT,SUB)) Q:SUB="" D
14 .S INVDT=0 F S INVDT=$O(^TMP("LRRR",$J,PT,SUB,INVDT)) Q:INVDT="" D
15 ..S SEQ=0 F S SEQ=$O(^TMP("LRRR",$J,PT,SUB,INVDT,SEQ)) Q:SEQ=""!(SEQ<1) D
16 ...S X=^(SEQ),Y(J)=$P(X,U)_U_$P(X,U,15)_U_$P(X,U,2)_U_$P(X,U,4)_U_$P(X,U,3)_U
17 ...S EXTDT=$$EXTERNAL^DILFD(4.302,.01,"",9999999-INVDT),Y(J)=Y(J)_EXTDT
18 ...S J=J+1
19 K ^TMP("LRRR",$J)
20 S:+$G(Y(1))<1 Y(1)="^No results found."
21 Q
22 ;
23ORDER(Y,PATIENT,ORDER) ; return patient's lab results for an order:
24 N RSLT
25 S RSLT=$$GETDATA^OCXCACHE(.Y,"ORDERC^ORQQLR(.OCXDATA,"_PATIENT_","_ORDER_")",PATIENT,)
26 Q
27 ;
28ORDERC(Y,PATIENT,ORDER) ; return patient's lab results for an order:
29 N SUB,INVDT,SEQ,RESULT,J,LRORD S SUB="",INVDT=0,SEQ=0,J=1
30 K ^TMP("LRRR",$J)
31 S LRORD=$G(^OR(100,+ORDER,4))
32 Q:'$L(LRORD)
33 D RR^LR7OR1(PATIENT,LRORD,"","","","","")
34 S SUB=$O(^TMP("LRRR",$J,PATIENT,SUB)) Q:SUB=""
35 S INVDT=$O(^TMP("LRRR",$J,PATIENT,SUB,INVDT)) Q:'INVDT
36 F S SEQ=$O(^TMP("LRRR",$J,PATIENT,SUB,INVDT,SEQ)) Q:'SEQ D
37 .S RESULT=^(SEQ),Y(J)=$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_INVDT,J=J+1
38 K ^TMP("LRRR",$J)
39 Q
40DETAIL(LST,DFN,ORDER) ; return lab results for an order
41 N LRORD,SUB,IDT,I,DATE,FLAG,REF,ILST
42 S LST(1)="No detailed information found.",ILST=0
43 S LRORD=$G(^OR(100,+ORDER,4))
44 Q:'$L(LRORD)
45 K ^TMP("LRRR",$J)
46 D RR^LR7OR1(DFN,LRORD,"","","","","")
47 S SUB="" F S SUB=$O(^TMP("LRRR",$J,DFN,SUB)) Q:SUB="" D
48 . S IDT=0 F S IDT=$O(^TMP("LRRR",$J,DFN,SUB,IDT)) Q:'IDT D
49 . . S I=0 F S I=$O(^TMP("LRRR",$J,DFN,SUB,IDT,I)) Q:'I S X=^(I) D
50 . . . S DATE=$$FMTE^XLFDT(9999999-IDT),FLAG=$P(X,U,3)
51 . . . S REF=$P(X,U,5)
52 . . . S:$L(REF) REF="("_$P(X,U,5)_")"
53 . . . S X=$P(X,U,15)_U_$P(X,U,2)_U_$P(X,U,4)_U_FLAG_U_DATE_U_REF
54 . . . S X=$$TABPIECE(X,"1,2,3,4,5,6","9,18,24,27,50")
55 . . . S ILST=ILST+1,LST(ILST)=X
56 K ^TMP("LRRR",$J)
57 Q
58TABPIECE(X,PIECES,TABS) ; return pieces with withspace between them
59 N I,J,Y,APIECE S Y=""
60 F I=1:1:$L(PIECES,",") S APIECE=+$P(PIECES,",",I) D
61 . S Y=Y_$P(X,U,APIECE)
62 . F J=$L(Y):1:+$P(TABS,",",I) S Y=Y_" "
63 Q Y
64ZDETAIL(Y,PATIENT,ORDER) ; return detailed, narrative results for an order:
65 N CR,J,SUB,INVDT,SEQ,RESULT,EXTDT,FLAG,LRORD
66 S CR=$CHAR(13),J=1,SUB="",INVDT=0,SEQ=0
67 S LRORD=$$OETOLAB^ORQQLR1(+ORDER)
68 I '$L($G(LRORD)) S Y(J)="No detailed information found." Q
69 K ^TMP("LRRR",$J)
70 D RR^LR7OR1(PATIENT,LRORD,"","","","","")
71 S SUB=$O(^TMP("LRRR",$J,PATIENT,SUB))
72 I '$L($G(SUB)) S Y(J)="No detailed information found." Q
73 S INVDT=$O(^TMP("LRRR",$J,PATIENT,SUB,INVDT))
74 I '$L($G(INVDT)) S Y(J)="No detailed information found." Q
75 F S SEQ=$O(^TMP("LRRR",$J,PATIENT,SUB,INVDT,SEQ)) Q:'SEQ D
76 .S RESULT=^(SEQ),Y(J)=$P(RESULT,U,15)_" "_$P(RESULT,U,2)_" "_$P(RESULT,U,4),FLAG=$P(RESULT,U,3)
77 .S Y(J)=Y(J)_$S($L($G(FLAG)):" "_FLAG,1:"")
78 .S EXTDT=$$EXTERNAL^DILFD(4.302,.01,"",9999999-INVDT)
79 .S Y(J)=Y(J)_" "_EXTDT_" (ref. "_$P(RESULT,U,5)_")",J=J+1
80 K ^TMP("LRRR",$J)
81 Q
82SROUT(ORY) ;return lab results search date range for an outpatient
83 N DIFF,SDT,EDT,ORSRV
84 S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
85 S DIFF=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORQQLR SEARCH RANGE OUTPT",1,"E")
86 S:+$G(DIFF)<1 DIFF=14 ;if no default defined use 14 days
87 S ORY=DIFF
88 Q
89SRIN(ORY,ORPT) ;return lab results search date range for an inpatient
90 N DIFF,SDT,EDT,ORSRV,ORLOC
91 ;
92 ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
93 ;reliably determined, and many simultaneous outpt locations can occur):
94 I +$G(ORPT)>0 D
95 .N DFN S DFN=ORPT,VA200="" D OERR^VADPT
96 .I +$G(VAIN(4))>0 S ORLOC=+$G(^DIC(42,+$G(VAIN(4)),44))
97 .K VA200,VAIN
98 ;
99 S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
100 S DIFF=$$GET^XPAR("USR^LOC.`"_$G(ORLOC)_"^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORQQLR SEARCH RANGE INPT",1,"E")
101 S:+$G(DIFF)<1 DIFF=2 ;if no default defined use 2 days
102 S ORY=DIFF
103 Q
Note: See TracBrowser for help on using the repository browser.