source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPID.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 9.2 KB
Line 
1ORWGAPID ; SLC/STAFF - Graph API Details ;12/21/05 08:19
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
3 ;
4DETAILS(DATA,DFN,DATE1,DATE2,FILEITEM) ; from ORWGAPI (series click)
5 N ITEM,FILE,SUBHEAD,TYPEITEM K SUBHEAD,TYPEITEM
6 K ^TMP("LR7OGX",$J),^TMP("LRC",$J)
7 K ^TMP("ORLRC",$J),^TMP("PSBO",$J),^TMP("TIUVIEW",$J)
8 S FILE=$P(FILEITEM,U)
9 S ITEM=$$UP^ORWGAPIX($P(FILEITEM,U,2))
10 I '$L(ITEM) Q
11 D
12 . I FILE=63 D Q
13 .. D INTERIM^ORWLRR(.DATA,DFN,DATE1,DATE2)
14 .. M ^TMP("ORWGRPC",$J)=^TMP("LR7OGX",$J,"OUTPUT")
15 . I FILE="63MI" D Q
16 .. D MICRO^ORWLRR(.DATA,DFN,DATE1,DATE2)
17 .. M ^TMP("ORWGRPC",$J)=^TMP("LR7OGX",$J,"OUTPUT")
18 . I FILE="63AP" D Q
19 .. S SUBHEAD("CYTOPATHOLOGY")=""
20 .. S SUBHEAD("SURGICAL PATHOLOGY")=""
21 .. S SUBHEAD("EM")=""
22 .. S SUBHEAD("AUTOPSY")=""
23 .. D LABSUM^ORWGAPIA(.DATA,DFN,DATE1,DATE2,.SUBHEAD)
24 .. M ^TMP("ORWGRPC",$J)=^TMP("LRC",$J)
25 . I FILE="63BB" D Q
26 .. D BLR^ORWRP1(.DATA,DFN,"",DATE1,DATE2)
27 .. M ^TMP("ORWGRPC",$J)=^TMP("ORLRC",$J)
28 . I FILE="53.79" D Q
29 .. D BCMA1^ORWRP1A(.DATA,DFN,"",DATE1,DATE2)
30 .. M ^TMP("ORWGRPC",$J)=^TMP("PSBO",$J)
31 . I FILE="8925" D Q
32 .. D NOTE(.DATA,DFN,DATE1,DATE2,ITEM)
33 .. ;M ^TMP("ORWGRPC",$J)=^TMP("TIUVIEW",$J)
34 . S TYPEITEM(1)=FILE_"^0"
35 . D DETAIL(.DATA,DFN,DATE1,DATE2,.TYPEITEM)
36 K ^TMP("LR7OGX",$J),^TMP("LRC",$J)
37 K ^TMP("ORLRC",$J),^TMP("PSBO",$J),^TMP("TIUVIEW",$J)
38 Q
39 ;
40DETAIL(DATA,DFN,DATE1,DATE2,TYPEITEM) ; from ORWGAPI (legend click)
41 N CNT,FILE,GMTSPX1,GMTSPX2,ITEM,TITEMS,TYPE
42 N COMP,NEWITEMS K COMP,NEWITEMS
43 K ^TMP("ORDATA",$J)
44 S DFN=+$G(DFN) I 'DFN Q
45 I '$L($O(TYPEITEM(0))) Q
46 S TYPE=""
47 F S TYPE=$O(TYPEITEM(TYPE)) Q:TYPE="" D
48 . S TITEMS=TYPEITEM(TYPE)
49 . S FILE=$P(TITEMS,U) I '$L(FILE) Q
50 . S ITEM=$P(TITEMS,U,2) I '$L(ITEM) Q
51 . S NEWITEMS(FILE,ITEM)=""
52 S CNT=0
53 S FILE=""
54 F S FILE=$O(NEWITEMS(FILE)) Q:FILE="" D
55 . S CNT=CNT+1
56 . S COMP(CNT)=$$COMPTYPE^ORWGAPIT(FILE)
57 S GMTSPX1=DATE1,GMTSPX2=DATE2
58 D REPORT^ORWRP2(.DATA,.COMP,DFN)
59 M ^TMP("ORWGRPC",$J)=^TMP("ORDATA",$J)
60 K ^TMP("ORDATA",$J)
61 Q
62 ;
63NOTE(DATA,DFN,DATE1,DATE2,ITEM) ;
64 N CNT,DATE,DOC,DOCCLASS,DOCTYPE,DUM,IEN,LINE,NUM,RESULTS K DUM
65 K ^TMP("TIUR",$J),^TMP("TIUVIEW",$J)
66 S CNT=$G(CNT)
67 F DOCTYPE="P","D","C" D
68 . S DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
69 . K ^TMP("TIUR",$J)
70 . D TIU^ORWGAPIA(.DUM,DOCCLASS,5,DFN,DATE1,DATE2)
71 . S DOC=0
72 . F S DOC=$O(^TMP("TIUR",$J,DOC)) Q:DOC<1 D
73 .. S RESULTS=^TMP("TIUR",$J,DOC)
74 .. S IEN=+$P(RESULTS,U)
75 .. K ^TMP("TIUVIEW",$J)
76 .. D GETTIU^ORWGAPIA(.DATA,IEN)
77 .. S NUM=0
78 .. F S NUM=$O(^TMP("TIUVIEW",$J,NUM)) Q:NUM<1 D
79 ... S LINE=$G(^TMP("TIUVIEW",$J,NUM))
80 ... S CNT=CNT+1
81 ... S ^TMP("ORWGRPC",$J,CNT)=LINE
82 .. I CNT>1 D
83 ... S CNT=CNT+1
84 ... S ^TMP("ORWGRPC",$J,CNT)=" "
85 ... S CNT=CNT+1
86 ... S ^TMP("ORWGRPC",$J,CNT)=" "
87 K ^TMP("TIUR",$J),^TMP("TIUVIEW",$J)
88 Q
89 ;
90TAX(DATA,ALL,REMTAX) ; from ORWGAPI
91 N CNT,REM,CODE,NUM,TMP
92 K ^TMP("ORWG TEMP",$J)
93 D RETURN^ORWGAPIU(.TMP,.DATA)
94 S CNT=0
95 S REM=0
96 I ALL F S REM=$O(^PXD(811.2,REM)) Q:REM<1 D TEMP(REM)
97 I 'ALL D
98 . S NUM=0
99 . F S NUM=$O(REMTAX(NUM)) Q:NUM<1 D
100 .. S REM=REMTAX(NUM)
101 .. D TEMP(REM)
102 S CODE=""
103 F S CODE=$O(^TMP("ORWG TEMP",$J,CODE)) Q:CODE="" D
104 . D SETUP^ORWGAPIU(.DATA,CODE,TMP,.CNT)
105 K ^TMP("ORWG TEMP",$J)
106 Q
107 ;
108TEMP(REM) ;
109 N NODE,NUM,SUB
110 I $P($G(^PXD(811.2,REM,0)),U,6)=1 Q
111 F SUB=80,80.1,81 D
112 . S NUM=0
113 . F S NUM=$O(^PXD(811.3,REM,SUB,NUM)) Q:NUM<1 D
114 .. S NODE=+$G(^PXD(811.3,REM,SUB,NUM,0))
115 .. I 'NODE Q
116 .. I SUB=80 D Q
117 ... S ^TMP("ORWG TEMP",$J,"45DX;"_NODE)=""
118 ... S ^TMP("ORWG TEMP",$J,"9000010.07;"_NODE)=""
119 ... S ^TMP("ORWG TEMP",$J,"9000011;"_NODE)=""
120 .. I SUB=80.1 D Q
121 ... S ^TMP("ORWG TEMP",$J,"45OP;"_NODE)=""
122 .. I SUB=81 D Q
123 ... S ^TMP("ORWG TEMP",$J,"9000010.18;"_NODE)=""
124 Q
125 ;
126MED1(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
127 N DATE,ITEM,OK,MEDARRAY,RESULT K MEDARRAY
128 D MEDICINE^ORWGAPIA(.MEDARRAY,DFN)
129 S ITEM=0
130 F S ITEM=$O(MEDARRAY(ITEM)) Q:ITEM<1 D
131 . S OK=0
132 . I FMT=6 D
133 .. S DATE=OLDEST
134 .. F S DATE=$O(MEDARRAY(ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
135 ... S CNT=CNT+1
136 ... S OK=1
137 ... S RESULT=690_U_ITEM
138 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
139 . I FMT'=6 D
140 .. S DATE=$O(MEDARRAY(ITEM,""),-1)
141 .. I 'DATE Q
142 .. S NAME=MEDARRAY(ITEM,DATE)
143 .. I '$L(NAME) Q
144 .. S CNT=CNT+1
145 .. S OK=1
146 .. I FMT=3 S RESULT=690_U_ITEM_"^^"_NAME_"^^"_DATE
147 .. I FMT=0 S RESULT=690_U_ITEM_U_NAME
148 . I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
149 Q
150 ;
151MED3(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
152 N DATE,DATE2,DATESTOP,DATESTRT,DTPLUS1,NODE,RESULT,STATUS,VALUE K VALUE
153 D MEDICINE^ORWGAPIA(.MEDARRAY,DFN)
154 S ITEM=+$G(ITEM)
155 S CNT=$G(CNT)
156 S DATE=""
157 F S DATE=$O(MEDARRAY(ITEM,DATE)) Q:DATE="" D
158 . I DATE>START Q
159 . S RESULT=690_U_ITEM_U_DATE_"^^"
160 . D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
161 Q
162 ;
163NVA1(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
164 N DATA,DATE,DATE1,DATESTRT,DRUG,ITEM,OK,REF,RESULT K DATA
165 S ITEM=""
166 F S ITEM=$O(^PXRMINDX("55NVA","PI",DFN,ITEM)) Q:ITEM="" D
167 . S OK=0
168 . I FMT=6 D
169 .. S DATE=0
170 .. F S DATE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
171 ... S DATE1=""
172 ... F S DATE1=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,DATE1)) Q:DATE1="" D Q:OK
173 .... I DATE1'["U",DATE1<OLDEST Q
174 .... S CNT=CNT+1
175 .... S OK=1
176 .... S RESULT="55NVA"_U_ITEM
177 . I FMT'=6 D
178 .. S DATE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,""),-1)
179 .. I 'DATE Q
180 .. S DATE1=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,""),-1)
181 .. I '$L(DATE1) Q
182 .. S REF=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,DATE1,""),-1)
183 .. I '$L(REF) Q
184 .. D RXNVA^ORWGAPIA(REF,.DATA)
185 .. S DRUG=+$G(DATA("DISPENSE DRUG"))
186 .. S DATESTRT=+$G(DATA("START DATE"))
187 .. I 'DATESTRT Q
188 .. S CNT=CNT+1
189 .. S OK=1
190 .. I FMT=3 S RESULT="55NVA"_U_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,"55NVA",.01)_"^^"_DATESTRT
191 .. I FMT=0 S RESULT="55NVA"_U_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,"55NVA",.01)
192 .. I DRUG S RESULT=RESULT_U_$$DRGCLASS^ORWGAPIA(DRUG)
193 . I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
194 Q
195 ;
196NVA3(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
197 N DATE1,DATE2,DATESTOP,DATESTRT,DTPLUS1,NODE,RESULT,STATUS,VALUE K VALUE
198 S CNT=$G(CNT),DTPLUS1=$$FMADD^ORWGAPIX(DT,1)
199 S DATE1=""
200 F S DATE1=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE1)) Q:DATE1="" D
201 . I DATE1>START Q
202 . S DATE2=""
203 . F S DATE2=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE1,DATE2)) Q:DATE2="" D
204 .. S NODE=""
205 .. F S NODE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE1,DATE2,NODE)) Q:NODE="" D
206 ... D RXNVA^ORWGAPIA(NODE,.VALUE)
207 ... S STATUS=$G(VALUE("STATUS"))
208 ... S DATESTRT=+$G(VALUE("START DATE"))
209 ... I 'DATESTRT Q
210 ... S DATESTOP=+$G(VALUE("DISCONTINUED DATE"))
211 ... I 'DATESTOP S DATESTOP=DTPLUS1
212 ... S STATUS=STATUS_" "_$$NVASIG^ORWGAPIA(NODE)
213 ... S RESULT="55NVA"_U_ITEM_U_DATESTRT_U_DATESTOP_U_STATUS
214 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
215 Q
216 ;
217PLX2(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
218 N DATE,DTPLUS1,ICD9,OK,PRIORITY,RESULT,STATUS
219 K ^TMP("ORWGRPC TEMP",$J)
220 S DTPLUS1=$$FMADD^ORWGAPIX(DT,1)
221 S STATUS=""
222 F S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS="" D
223 . S PRIORITY=""
224 . F S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
225 .. S ITEM=""
226 .. F S ITEM=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM)) Q:ITEM="" D
227 ... S DATE=""
228 ... F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
229 .... S NODE=""
230 .... F S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE="" D
231 ..... D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
232 ..... I 'DTRESOLV S ^TMP("ORWGRPC TEMP",$J,PROBDX,DTONSET)=DTPLUS1 Q
233 ..... S ^TMP("ORWGRPC TEMP",$J,PROBDX,DTONSET)=DTRESOLV
234 S PROB=""
235 F S PROB=$O(^TMP("ORWGRPC TEMP",$J,PROB)) Q:PROB="" D
236 . S VALUE=$$EVALUE^ORWGAPIU(PROB,9000011,.01)
237 . I FMT=0 D
238 .. S CNT=CNT+1
239 .. S RESULT=9999911_U_PROB_U_VALUE
240 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
241 . I FMT=6 D
242 .. S OK=0
243 .. S DATE=0
244 .. F S DATE=$O(^TMP("ORWGRPC TEMP",$J,PROB,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
245 ... S DTRESOLV=^TMP("ORWGRPC TEMP",$J,PROB,DATE)
246 ... I DTRESOLV<OLDEST Q
247 ... S CNT=CNT+1
248 ... S OK=1
249 ... S RESULT=9999911_U_PROB
250 .. I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
251 . I FMT=3 D
252 .. S DATE=$O(^TMP("ORWGRPC TEMP",$J,PROB,""),-1)
253 .. I 'DATE Q
254 .. S CNT=CNT+1
255 .. S RESULT=9999911_U_PROB_"^^"_VALUE_"^^"_DATE
256 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
257 K ^TMP("ORWGRPC TEMP",$J)
258 Q
259 ;
260PROBX4(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
261 N DATE,DTONSET,DTPLUS1,DTRESOLV,ICD9,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
262 K ^TMP("ORWGRPC TEMP",$J)
263 S CNT=$G(CNT),DTPLUS1=$$FMADD^ORWGAPIX(DT,1)
264 S STATUS=""
265 F S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS="" D
266 . S PRIORITY=""
267 . F S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
268 .. S DATE=""
269 .. F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
270 ... I DATE>START Q
271 ... S NODE=""
272 ... F S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE="" D
273 .... S ^TMP("ORWGRPC TEMP",$J,NODE)=""
274 S NODE=""
275 F S NODE=$O(^TMP("ORWGRPC TEMP",$J,NODE)) Q:NODE="" D
276 . D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
277 . I 'DTONSET Q
278 . I 'DTRESOLV S DTRESOLV=DTPLUS1
279 . S RESULT=9999911_U_PROBDX_U_DTONSET_U_DTRESOLV_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
280 . D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
281 K ^TMP("ORWGRPC TEMP",$J)
282 Q
283 ;
Note: See TracBrowser for help on using the repository browser.