source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXVB.m@ 1499

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

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1ORWDXVB ;slc/dcm - Order dialog utilities for Blood Bank ;12/7/05 17:11
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17 1997
3 ;
4 ; DBIA 2503 RR^LR7OR1 ^TMP("LRRR",$J)
5 ;
6GETPAT(ORX,DFN,ORL) ;Get Patient data from VBECS
7 ;Needs patient DFN and Location (ORL)
8 N ORSTN,DIV
9 S DIV=+$P($G(^SC(+$G(ORL),0)),U,15),ORSTN=$P($$SITE^VASITE(DT,DIV),U,3)
10 D OEAPI^VBECA3(.ORX,DFN,ORSTN)
11 Q
12PTINFO(OROOT,ORX) ;Format patient BB info
13 Q:'$D(ORX)
14 D PTINFO^ORWDXVB1
15 Q
16RESULTS(OROOT,DFN,ORX) ;Get test results
17 Q:'$O(ORX(0)) ;ORX contains a list of tests to retrieve results for
18 N ORCOM,ORT,ORTST,ORTDT,ORTMP,GCNT,CCNT,GIOSL,GIOM,I,ORZ
19 S GCNT=0,CCNT=1,GIOSL=999999,GIOM=80
20 S OROOT=$NA(^TMP("ORVBEC",$J))
21 K ^TMP("ORVBEC",$J)
22 D LN
23 S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"RECENT LAB RESULTS:",.CCNT)
24 D LN
25 S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"Test Result Units Range Collected Accession Sts",.CCNT)
26 D LN
27 S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"---- ------ ----- ----- --------- --------- ---",.CCNT)
28 S ORT=0 F S ORT=$O(ORX(ORT)) Q:'ORT S ORTST=$P(ORX(ORT),"^",1) D
29 . K ^TMP("LRRR",$J) D RR^LR7OR1(DFN,,,,,ORTST,,1) ;DBIA 2503
30 . S ORTMP="^TMP(""LRRR"",$J,DFN)",ORTMP=$Q(@ORTMP)
31 . Q:$P(ORTMP,",",1,3)'=("^TMP(""LRRR"","_$J_","_DFN)
32 . S ORTDT=9999999-+$P(ORTMP,",",5),ORZ=@ORTMP
33 . D LN
34 . S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,$P(ORZ,"^",15),.CCNT)_$$S^ORU4(8,CCNT,$J($P(ORZ,"^",2),7),.CCNT)_$$S^ORU4(16,CCNT,$P(ORZ,"^",3),.CCNT)_$$S^ORU4(19,CCNT,$P(ORZ,"^",4),.CCNT)_$$S^ORU4(30,CCNT,$P(ORZ,"^",5),.CCNT)
35 . S ^(0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(40,CCNT,$$DATETIME^ORCHTAB(ORTDT),.CCNT)_$$S^ORU4(56,CCNT,$P(ORZ,"^",16),.CCNT)_$$S^ORU4(71,CCNT,$P(ORZ,"^",6),.CCNT)
36 . S ORCOM=$P(ORTMP,",",1,5)_",""N""" ;check for comments
37 . F S ORTMP=$Q(@ORTMP) Q:$P(ORTMP,",",1,6)'=ORCOM D
38 .. D LN
39 .. S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,@ORTMP,.CCNT)
40 K ^TMP("LRRR",$J)
41 Q
42RAW(OROOT,DFN,ORX) ;Get RAW test results
43 Q:'$O(ORX(0)) ;ORX contains a list of tests to retrieve results for
44 N ORCOM,ORT,ORTST,ORTDT,ORTMP,GCNT,CCNT,GIOSL,GIOM,I
45 S GCNT=0,CCNT=1,GIOSL=999999,GIOM=80
46 S OROOT=$NA(^TMP("ORVBEC",$J))
47 K ^TMP("ORVBEC",$J)
48 S ORT=0 F S ORT=$O(ORX(ORT)) Q:'ORT S ORTST=$P(ORX(ORT),"^",1) D
49 . K ^TMP("LRRR",$J) D RR^LR7OR1(DFN,,,,,ORTST,,1)
50 . S ORTMP="^TMP(""LRRR"",$J,DFN)",ORTMP=$Q(@ORTMP)
51 . Q:$P(ORTMP,",",1,3)'=("^TMP(""LRRR"","_$J_","_DFN)
52 . S ORTDT=9999999-+$P(ORTMP,",",5),ORZ=@ORTMP
53 . D LN
54 . S ^TMP("ORVBEC",$J,GCNT,0)=$P(ORZ,"^",1,6)_"^"_ORTDT
55 K ^TMP("LRRR",$J)
56 Q
57SURG(OROOT,ORX) ;Get list of surgeries
58 N I,CNT,X
59 S (I,CNT)=0
60 F S I=$O(ORX("SURGERY",I)) Q:'I S X=$G(ORX("SURGERY",I)) D
61 . S CNT=CNT+1,OROOT(CNT)=X_U_X
62 Q
63LN ;Increment counts
64 S GCNT=GCNT+1,CCNT=1
65 Q
66PATINFO(OROOT,DFN,LOC) ;Test ^TMP global output
67 N ORX
68 D GETPAT(.ORX,DFN,LOC)
69 I $L($G(ORX("SPECIMEN"))) S:$P(ORX("SPECIMEN"),"^") $P(ORX("SPECIMEN"),"^")=$$HL7TFM^XLFDT($P(ORX("SPECIMEN"),"^"))
70 D PTINFO(.OROOT,.ORX)
71 ;S I=0 F S I=$O(@OROOT@(I)) Q:'I W !,^(I,0)
72 ;K @OROOT
73 Q
74GETALL(OROOT,DFN,LOC) ;Get all data in one call and let the GUI divide it up
75 N ORX,INFO,CNT,I,J,K
76 S OROOT=$NA(^TMP("ORVBECINFO",$J)),CNT=1
77 D GETPAT(.ORX,DFN,LOC)
78 ;S ^TMP("ORVBECINFO",$J,CNT)="~RAWDATA",I=0
79 ;F S I=$O(ORX(I)) Q:'I S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)=ORX(I)
80 I $L($G(ORX("SPECIMEN"))) S:$P(ORX("SPECIMEN"),"^") $P(ORX("SPECIMEN"),"^")=$$HL7TFM^XLFDT($P(ORX("SPECIMEN"),"^")) S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~SPECIMEN",CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_ORX("SPECIMEN")
81 I $L($G(ORX("ABORH"))) S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~ABORH",CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_ORX("ABORH")
82 S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~TYPE AND SCREEN",CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_$O(^ORD(101.43,"S.VBEC","TYPE & SCREEN",0))
83 S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~SPECIMENS",I=0
84 F S I=$O(ORX(I)) Q:'I S J="" F S J=$O(ORX(I,J)) Q:J="" I J="SPECIMEN" S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_I_"^"_ORX(I,J)
85 S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~TESTS",I=0
86 F S I=$O(ORX(I)) Q:'I S J="" F S J=$O(ORX(I,J)) Q:J="" I J="TEST" S K=0 F S K=$O(ORX(I,J,K)) Q:'K S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_I_"^"_K_"^"_ORX(I,J,K)
87 S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~MSBOS",I=0
88 F S I=$O(ORX(I)) Q:'I S J="" F S J=$O(ORX(I,J)) Q:J="" I J="MSBOS" S K=0 F S K=$O(ORX(I,J,K)) Q:'K S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_I_"^"_K_"^"_ORX(I,J,K),$P(^(CNT),"^",4)=+$P(ORX(I,J,K),"^",2)
89 S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~SURGERIES",I=0
90 F S I=$O(ORX("SURGERY",I)) Q:'I S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_I_"^"_ORX("SURGERY",I)
91 S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~URGENCIES",I=""
92 F S I=$O(^ORD(101.42,"S.VBEC",I)) Q:I="" S J=0 F S J=$O(^ORD(101.42,"S.VBEC",I,J)) Q:'J S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_J_"^"_I
93 S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~MODIFIERS",I=""
94 N ORMODS D GETLST^XPAR(.ORMODS,"ALL","OR VBECS MODIFIERS","I")
95 F S I=$O(ORMODS(I)) Q:'I S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_ORMODS(I)
96 ;F I="W^Washed","I^Irradiated","L^Leuko Reduced","V^Volume Reduced","D^Divided","E^Leuko Reduced/Irradiated" S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_I
97 S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~INFO",I=0
98 D PTINFO(.INFO,.ORX)
99 F S I=$O(^TMP("ORVBEC",$J,I)) Q:'I S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_^TMP("ORVBEC",$J,I,0)
100 K ^TMP("ORVBEC",$J)
101 Q
102STATALOW(OROOT,DFN) ;Allow stat for ORES ORELSE users
103 S OROOT=$D(^XUSEC("ORES",DUZ))!($D(^XUSEC("ORELSE",DUZ)))
104 Q
105COMPORD(OROOT) ;Get sequence order of Blood Components
106 N ORLIST,I,X
107 D GETLST^XPAR(.ORLIST,"ALL","OR VBECS COMPONENT ORDER")
108 S I=0 F S I=$O(ORLIST(I)) Q:'I S X=ORLIST(I) I $D(^ORD(101.43,$P(X,"^",2),0)) S OROOT(I)=$P(X,"^",2)_"^"_$P(^(0),"^",1)_"^"_$P(^(0),"^",1)
109 Q
110TESTR ;Test results call
111 N ORX
112 S ORX(3)="3" ;HGB
113 S ORX(4)="4" ;HCT
114 S ORX(1)="1" ;WBC
115 S ORX(113)="113" ;FERRITIN
116 D RESULTS(.OROOT,66,.ORX)
117 S I=0 F S I=$O(@OROOT@(I)) Q:'I W !,^(I,0)
118 K @OROOT
119 Q
Note: See TracBrowser for help on using the repository browser.