source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPI3.m@ 635

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1ORWGAPI3 ; SLC/STAFF - Graph Data ;12/21/05 08:17
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
3 ;
4 ;
5ADVERSE(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
6 N ADVERSE,DATE,DATE2,NODE,RESULT,RXN,VALUE
7 S DATE="",DATE2="",CNT=$G(CNT)
8 S ADVERSE=""
9 S VALUE=ITEM_U_ITEM
10 S NODE=""
11 F S NODE=$O(^GMR(120.8,"B",DFN,NODE)) Q:NODE="" D
12 . I '$D(^GMR(120.8,NODE,0)) Q
13 . I $G(^GMR(120.8,NODE,"ER")) Q ; entered in error
14 . I '$P(^GMR(120.8,NODE,0),U,12) Q ; signed
15 . S DATE=+$P($G(^GMR(120.8,NODE,0)),U,4) I 'DATE Q
16 . I DATE>START Q
17 . I ITEM'=$P(^GMR(120.8,NODE,0),U,2) Q
18 . S RXN=0
19 . F S RXN=$O(^GMR(120.8,NODE,10,"B",RXN)) Q:RXN<1 D
20 .. S ADVERSE=ADVERSE_$$EVALUE^ORWGAPIU(RXN,120.8)_", "
21 . I $L(ADVERSE)>0 S ADVERSE=$E(ADVERSE,1,$L(ADVERSE)-2)
22 . S CNT=CNT+1
23 . S RESULT=120.8_U_ITEM_U_DATE_U_DATE2_U_ADVERSE
24 . D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
25 Q
26 ;
27BCMA(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
28 N DATE,NODE,RESULT,VALUE
29 S DATE="",CNT=$G(CNT)
30 F S DATE=$O(^PSB(53.79,"AOIP",DFN,ITEM,DATE)) Q:DATE="" D
31 . I DATE>START Q
32 . S NODE=""
33 . F S NODE=$O(^PSB(53.79,"AOIP",DFN,ITEM,DATE,NODE)) Q:NODE="" D
34 .. S VALUE=$P($G(^PSB(53.79,NODE,0)),U,9) I VALUE'="G" Q
35 .. S RESULT=53.79_U_ITEM_U_DATE_"^^"
36 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
37 Q
38 ;
39DX(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
40 N DATE,DATE2,NODE,NUM,RESULT,VALUE K VALUE
41 K ^TMP("ORWGRPC TEMP",$J)
42 S DATE2="",CNT=$G(CNT)
43 S NUM=""
44 F S NUM=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM)) Q:NUM="" D
45 . S DATE=""
46 . F S DATE=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE)) Q:DATE="" D
47 .. I DATE>START Q
48 .. S NODE=""
49 .. F S NODE=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE,NODE)) Q:NODE="" D
50 ... I '$D(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=NODE_U_NUM
51 S ITEM=""
52 F S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM="" D
53 . S DATE=""
54 . F S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) Q:DATE="" D
55 .. S NODE=$G(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) I '$L(NODE) Q
56 .. S NUM=$P(NODE,U,2)
57 .. S NODE=$P(NODE,U)
58 .. D PTF^ORWGAPIA(NODE,.VALUE) S VALUE=$$EXT^ORWGAPIX($G(VALUE("DISCHARGE STATUS")),45,6)
59 .. I NUM="DXLS" S VALUE="(DXLS) "_VALUE
60 .. S RESULT=45_"DX"_U_ITEM_U_DATE_U_DATE2_U_" "_VALUE
61 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
62 K ^TMP("ORWGRPC TEMP",$J)
63 Q
64 ;
65INRX(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
66 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
67 S DATE="",CNT=$G(CNT)
68 F S DATE=$O(^PXRMINDX(55,"PI",DFN,ITEM,DATE)) Q:DATE="" D
69 . I DATE>START Q
70 . S DATE2=""
71 . F S DATE2=$O(^PXRMINDX(55,"PI",DFN,ITEM,DATE,DATE2)) Q:DATE2="" D
72 .. S NODE=""
73 .. F S NODE=$O(^PXRMINDX(55,"PI",DFN,ITEM,DATE,DATE2,NODE)) Q:NODE="" D
74 ... D RXIN^ORWGAPIA(NODE,.VALUE) S VALUE=VALUE("STAT")
75 ... S VALUE=VALUE_" "_$$INSIG^ORWGAPIA(NODE)
76 ... S RESULT=55_U_ITEM_U_DATE_U_DATE2_U_VALUE
77 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
78 Q
79 ;
80LAB(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
81 N COMMENT,DATE,DATE2,NODE,RESULT,TYPE,VALUE K VALUE
82 S DATE="",DATE2="",CNT=$G(CNT)
83 D
84 . I $E(ITEM)="A" S TYPE="AP" Q
85 . I $E(ITEM)="M" S TYPE="MI" Q
86 . S TYPE="" Q
87 F S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE="" D
88 . I DATE>START Q
89 . S NODE=""
90 . F S NODE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
91 .. K VALUE
92 .. D LAB^ORWGAPIA(.VALUE,NODE,ITEM)
93 .. I TYPE="AP" S RESULT="63AP^"_ITEM_U_DATE_U_DATE2 ;_U_$P(VALUE,U,2)
94 .. I TYPE="MI" S RESULT="63MI^"_ITEM_U_DATE_U_DATE2_U_$P(VALUE,U,4)
95 .. I TYPE="" D
96 ... S COMMENT=""
97 ... I $L($G(VALUE("COMMENTS",1))) S COMMENT=1
98 ... S RESULT="63^"_ITEM_U_DATE_U_DATE2_U_$P(VALUE,U,3)_U_$P(VALUE,U,4)_U_$G(VALUE("SPECIMEN"))_U_COMMENT
99 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
100 Q
101 ;
102MED(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
103 D MED3^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
104 Q
105 ;
106NOTE(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
107 N DATE,DOC,DOCCLASS,DOCTYPE,DUM,IEN,RESULT,RESULTS,TITLE,VALUE K DUM
108 K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
109 S CNT=$G(CNT),ITEM=$$UP^ORWGAPIX(ITEM)
110 F DOCTYPE="P","D","C" D
111 . S DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
112 . K ^TMP("TIUR",$J)
113 . D TIU^ORWGAPIA(.DUM,DOCCLASS,5,DFN)
114 . S DOC=0
115 . F S DOC=$O(^TMP("TIUR",$J,DOC)) Q:DOC<1 D
116 .. S RESULTS=^TMP("TIUR",$J,DOC)
117 .. S IEN=+$P(RESULTS,U)
118 .. S TITLE=$$UP^ORWGAPIX($P(RESULTS,U,2))
119 .. I TITLE'=ITEM Q
120 .. ; do not use admission date S DATE=$P($G(^AUPNVSIT(+$P($G(^TIU(8925,IEN,0)),U,3),0)),U)
121 .. S DATE=$P(RESULTS,U,3)
122 .. I DATE>START Q
123 .. S VALUE=$P(RESULTS,U,7)
124 .. S CNT=CNT+1
125 .. S RESULT=8925_U_TITLE_U_DATE_"^^"_VALUE
126 .. I $D(^TMP("ORWGRPC TEMP",$J,RESULT)) Q
127 .. S ^TMP("ORWGRPC TEMP",$J,RESULT)=""
128 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
129 K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
130 Q
131 ;
132NVAE(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
133 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
134 S DATE="",CNT=$G(CNT)
135 F S DATE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE)) Q:DATE="" D
136 . I DATE>START Q
137 . S DATE2=""
138 . F S DATE2=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,DATE2)) Q:DATE2="" D
139 .. S NODE=""
140 .. F S NODE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,DATE2,NODE)) Q:NODE="" D
141 ... D RXNVA^ORWGAPIA(NODE,.VALUE) S VALUE=$G(VALUE("STATUS"))
142 ... S VALUE=VALUE_" "_$$NVASIG^ORWGAPIA(NODE)
143 ... S RESULT="55NVAE"_U_ITEM_U_DATE_"^^"_VALUE ; DATE2 is not used, NVA defined as an event
144 ... ;S RESULT="55NVAE"_U_ITEM_U_DATE_U_$S(DATE2["U":DT,1:DATE2)_U_VALUE ; DATE2 is not used, NVA defined as an event
145 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
146 Q
147 ;
148NVA(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
149 D NVA3^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
150 Q
151 ;
152ORDER(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
153 N DATE,DATE2,NODE,ORUPCHUK,RESULT,VALUE K ORUPCHUK
154 S DATE="",CNT=$G(CNT)
155 F S DATE=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE)) Q:DATE="" D
156 . I DATE>START Q
157 . S DATE2=""
158 . F S DATE2=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2)) Q:DATE2="" D
159 .. S NODE=""
160 .. F S NODE=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2,NODE)) Q:NODE="" D
161 ... D EN^ORX8($P(NODE,";")) S VALUE=$P($G(ORUPCHUK("ORSTS")),U,2)
162 ... S RESULT=100_U_ITEM_U_DATE_"^^"_VALUE
163 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
164 Q
165 ;
166OUTRX(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
167 N DATE1,DATE2,LNUM,NODE,RESULT,VALUE K VALUE
168 S DATE1="",DATE2="",CNT=$G(CNT)
169 F S DATE1=$O(^PXRMINDX(52,"PI",DFN,ITEM,DATE1)) Q:DATE1="" D
170 . I DATE1>START Q
171 . S DATE2=""
172 . F S DATE2=$O(^PXRMINDX(52,"PI",DFN,ITEM,DATE1,DATE2)) Q:DATE2="" D
173 .. S NODE=""
174 .. F S NODE=$O(^PXRMINDX(52,"PI",DFN,ITEM,DATE1,DATE2,NODE)) Q:NODE="" D
175 ... D RXOUT^ORWGAPIA(NODE,.VALUE) S VALUE=$$EXTERNAL^ORWGAPIX(52,100,"",VALUE("STATUS"))
176 ... S VALUE=VALUE_" "_$$SIG^ORWGAPIA(DFN,+NODE)
177 ... S RESULT=52_U_ITEM_U_DATE1_U_DATE2_U_VALUE
178 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
179 Q
180 ;
181RAD(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
182 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
183 S DATE="",DATE2="",CNT=$G(CNT)
184 F S DATE=$O(^PXRMINDX(70,"PI",DFN,ITEM,DATE)) Q:DATE="" D
185 . I DATE>START Q
186 . S NODE=""
187 . F S NODE=$O(^PXRMINDX(70,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
188 .. D RAD^ORWGAPIA(NODE,.VALUE) S VALUE=$G(VALUE("PDX"))_"-"_$G(VALUE("EXAM STATUS"))
189 .. S RESULT=70_U_ITEM_U_DATE_U_DATE2_U_VALUE
190 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
191 Q
192 ;
Note: See TracBrowser for help on using the repository browser.