source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPID.m@ 621

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

initial load of WorldVistAEHR
File size: 6.9 KB
Line 
1ORWGAPID ; SLC/STAFF - Graph API Details ;12/21/05 08:19
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
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^ORWGAPIC(.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) ***** BA 12/14/07
30 .. D BCMA1^ORWRP1A(.DATA,DFN,"",DATE2,DATE1)
31 .. M ^TMP("ORWGRPC",$J)=^TMP("PSBO",$J)
32 . I FILE="8925" D Q
33 .. D NOTE(.DATA,DFN,DATE1,DATE2,ITEM)
34 .. ;M ^TMP("ORWGRPC",$J)=^TMP("TIUVIEW",$J)
35 . S TYPEITEM(1)=FILE_"^0"
36 . D DETAIL(.DATA,DFN,DATE1,DATE2,.TYPEITEM)
37 K ^TMP("LR7OGX",$J),^TMP("LRC",$J)
38 K ^TMP("ORLRC",$J),^TMP("PSBO",$J),^TMP("TIUVIEW",$J)
39 Q
40 ;
41DETAIL(DATA,DFN,DATE1,DATE2,TYPEITEM) ; from ORWGAPI (legend click)
42 N CNT,FILE,GMTSPX1,GMTSPX2,ITEM,TITEMS,TYPE
43 N COMP,NEWITEMS K COMP,NEWITEMS
44 K ^TMP("ORDATA",$J)
45 S DFN=+$G(DFN) I 'DFN Q
46 I '$L($O(TYPEITEM(0))) Q
47 S TYPE=""
48 F S TYPE=$O(TYPEITEM(TYPE)) Q:TYPE="" D
49 . S TITEMS=TYPEITEM(TYPE)
50 . S FILE=$P(TITEMS,U) I '$L(FILE) Q
51 . S ITEM=$P(TITEMS,U,2) I '$L(ITEM) Q
52 . S NEWITEMS(FILE,ITEM)=""
53 S CNT=0
54 S FILE=""
55 F S FILE=$O(NEWITEMS(FILE)) Q:FILE="" D
56 . S CNT=CNT+1
57 . S COMP(CNT)=$$COMPTYPE^ORWGAPIT(FILE)
58 S GMTSPX1=DATE1,GMTSPX2=DATE2
59 D REPORT^ORWRP2(.DATA,.COMP,DFN)
60 M ^TMP("ORWGRPC",$J)=^TMP("ORDATA",$J)
61 ;K ^TMP("ORDATA",$J)
62 ;Q
63 ;
64 S CNT=0
65 S TYPE=""
66 F S TYPE=$O(TYPEITEM(TYPE)) Q:TYPE="" D
67 . S TITEMS=TYPEITEM(TYPE)
68 . S CNT=CNT+1
69 . S ^TMP("ORWGRPC",$J,CNT/10000)="~~~^"_TITEMS
70 ;
71 K ^TMP("ORDATA",$J)
72 Q
73 ;
74GETDATES(DATA,REPORTID) ; from ORWGAPI
75 N DAT,TMP K DAT
76 D RETURN^ORWGAPIW(.TMP,.DATA)
77 S DAT(1)="S^Date Range..."
78 S DAT(2)="1^Today"
79 S DAT(3)="2^One Week"
80 S DAT(4)="3^Two Weeks"
81 S DAT(5)="4^One Month"
82 S DAT(6)="5^Six Months"
83 S DAT(7)="6^One Year"
84 S DAT(8)="7^Two Years"
85 S DAT(9)="8^All Results"
86 D DATES^ORWGAPIP(.DAT,REPORTID)
87 I TMP M ^TMP(DATA,$J)=DAT
88 I 'TMP M DATA=DAT
89 Q
90 ;
91NOTE(DATA,DFN,DATE1,DATE2,ITEM) ;
92 N CNT,DATE,DOC,DOCCLASS,DOCTYPE,DUM,IEN,LINE,NUM,RESULTS K DUM
93 K ^TMP("TIUR",$J),^TMP("TIUVIEW",$J)
94 S CNT=$G(CNT)
95 F DOCTYPE="P","D","C" D
96 . S DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
97 . K ^TMP("TIUR",$J)
98 . D TIU^ORWGAPIA(.DUM,DOCCLASS,5,DFN,DATE1,DATE2)
99 . S DOC=0
100 . F S DOC=$O(^TMP("TIUR",$J,DOC)) Q:DOC<1 D
101 .. S RESULTS=^TMP("TIUR",$J,DOC)
102 .. S IEN=+$P(RESULTS,U)
103 .. K ^TMP("TIUVIEW",$J)
104 .. D GETTIU^ORWGAPIA(.DATA,IEN)
105 .. S NUM=0
106 .. F S NUM=$O(^TMP("TIUVIEW",$J,NUM)) Q:NUM<1 D
107 ... S LINE=$G(^TMP("TIUVIEW",$J,NUM))
108 ... S CNT=CNT+1
109 ... S ^TMP("ORWGRPC",$J,CNT)=LINE
110 .. I CNT>1 D
111 ... S CNT=CNT+1
112 ... S ^TMP("ORWGRPC",$J,CNT)=" "
113 ... S CNT=CNT+1
114 ... S ^TMP("ORWGRPC",$J,CNT)=" "
115 ... S ^TMP("ORWGRPC",$J,CNT/10000)="~~~^"_^TMP("TIUR",$J,DOC)
116 K ^TMP("TIUR",$J),^TMP("TIUVIEW",$J)
117 Q
118 ;
119TAX(DATA,ALL,REMTAX) ; from ORWGAPI
120 N CNT,REM,CODE,NUM,TMP
121 K ^TMP("ORWG TEMP",$J)
122 D RETURN^ORWGAPIW(.TMP,.DATA)
123 S CNT=0
124 S REM=0
125 I ALL F S REM=$O(^PXD(811.2,REM)) Q:REM<1 D TEMP(REM)
126 I 'ALL D
127 . S NUM=0
128 . F S NUM=$O(REMTAX(NUM)) Q:NUM<1 D
129 .. S REM=REMTAX(NUM)
130 .. D TEMP(REM)
131 S CODE=""
132 F S CODE=$O(^TMP("ORWG TEMP",$J,CODE)) Q:CODE="" D
133 . D SETUP^ORWGAPIW(.DATA,CODE,TMP,.CNT)
134 K ^TMP("ORWG TEMP",$J)
135 Q
136 ;
137TEMP(REM) ;
138 N NODE,NUM,SUB
139 I $P($G(^PXD(811.2,REM,0)),U,6)=1 Q
140 F SUB=80,80.1,81 D
141 . S NUM=0
142 . F S NUM=$O(^PXD(811.3,REM,SUB,NUM)) Q:NUM<1 D
143 .. S NODE=+$G(^PXD(811.3,REM,SUB,NUM,0))
144 .. I 'NODE Q
145 .. I SUB=80 D Q
146 ... S ^TMP("ORWG TEMP",$J,"45DX;"_NODE)=""
147 ... S ^TMP("ORWG TEMP",$J,"9000010.07;"_NODE)=""
148 ... S ^TMP("ORWG TEMP",$J,"9000011;"_NODE)=""
149 .. I SUB=80.1 D Q
150 ... S ^TMP("ORWG TEMP",$J,"45OP;"_NODE)=""
151 .. I SUB=81 D Q
152 ... S ^TMP("ORWG TEMP",$J,"9000010.18;"_NODE)=""
153 Q
154 ;
155PLX2(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
156 N DATE,DTONSET,DTPLUS1,DTRESOLV,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
157 K ^TMP("ORWGRPC TEMP",$J)
158 S DTPLUS1=$$FMADD^ORWGAPIX(DT,1)
159 S STATUS=""
160 F S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS="" D
161 . S PRIORITY=""
162 . F S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
163 .. S ITEM=""
164 .. F S ITEM=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM)) Q:ITEM="" D
165 ... S DATE=""
166 ... F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
167 .... S NODE=""
168 .... F S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE="" D
169 ..... D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
170 ..... I 'DTRESOLV S ^TMP("ORWGRPC TEMP",$J,PROBDX,DTONSET)=DTPLUS1 Q
171 ..... S ^TMP("ORWGRPC TEMP",$J,PROBDX,DTONSET)=DTRESOLV
172 S PROB=""
173 F S PROB=$O(^TMP("ORWGRPC TEMP",$J,PROB)) Q:PROB="" D
174 . S VALUE=$$EVALUE^ORWGAPIU(PROB,9000011,.01)
175 . I FMT=0 D
176 .. S CNT=CNT+1
177 .. S RESULT=9999911_U_PROB_U_VALUE
178 .. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
179 . I FMT=6 D
180 .. S OK=0
181 .. S DATE=0
182 .. F S DATE=$O(^TMP("ORWGRPC TEMP",$J,PROB,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
183 ... S DTRESOLV=^TMP("ORWGRPC TEMP",$J,PROB,DATE)
184 ... I DTRESOLV<OLDEST Q
185 ... S CNT=CNT+1
186 ... S OK=1
187 ... S RESULT=9999911_U_PROB
188 .. I OK D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
189 . I FMT=3 D
190 .. S DATE=$O(^TMP("ORWGRPC TEMP",$J,PROB,""),-1)
191 .. I 'DATE Q
192 .. S CNT=CNT+1
193 .. S RESULT=9999911_U_PROB_"^^"_VALUE_"^^"_DATE
194 .. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
195 K ^TMP("ORWGRPC TEMP",$J)
196 Q
197 ;
198PROBX4(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
199 N DATE,DTONSET,DTPLUS1,DTRESOLV,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
200 K ^TMP("ORWGRPC TEMP",$J)
201 S CNT=$G(CNT),DTPLUS1=$$FMADD^ORWGAPIX(DT,1)
202 S STATUS=""
203 F S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS="" D
204 . S PRIORITY=""
205 . F S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
206 .. S DATE=""
207 .. F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
208 ... I DATE>START Q
209 ... S NODE=""
210 ... F S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE="" D
211 .... S ^TMP("ORWGRPC TEMP",$J,NODE)=""
212 S NODE=""
213 F S NODE=$O(^TMP("ORWGRPC TEMP",$J,NODE)) Q:NODE="" D
214 . D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
215 . I 'DTONSET Q
216 . I 'DTRESOLV S DTRESOLV=DTPLUS1
217 . S RESULT=9999911_U_PROBDX_U_DTONSET_U_DTRESOLV_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
218 . D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
219 K ^TMP("ORWGRPC TEMP",$J)
220 Q
221 ;
Note: See TracBrowser for help on using the repository browser.