source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPI4.m@ 613

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

initial load of WorldVistAEHR
File size: 7.9 KB
Line 
1ORWGAPI4 ; SLC/STAFF - Graph Data, indexed ;8/21/06 07:52
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243**;Dec 17, 1997;Build 242
3 ;
4EDU(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
5 N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
6 S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
7 F S DATE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE)) Q:DATE="" D
8 . I DATE>START Q
9 . I DATE<BACKTO Q
10 . S NODE=""
11 . F S NODE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
12 .. D EDU^ORWGAPIA(NODE,.VALUE,.VALUES)
13 .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.16,.06)_U_VALUES ;*****************************
14 .. S RESULT=9000010.16_U_ITEM_U_DATE_"^^" ;_VALUE
15 .. S RESULT=9000010.16_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
16 .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
17 Q
18 ;
19EXAM(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
20 N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
21 S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
22 F S DATE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE)) Q:DATE="" D
23 . I DATE>START Q
24 . I DATE<BACKTO Q
25 . S NODE=""
26 . F S NODE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
27 .. D EXAM^ORWGAPIA(NODE,.VALUE,.VALUES)
28 .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.13,.04)_U_VALUES ;*****************************
29 .. S RESULT=9000010.13_U_ITEM_U_DATE_U_DATE2_U_VALUE
30 .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
31 Q
32 ;
33HF(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
34 N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
35 S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
36 F S DATE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE)) Q:DATE="" D
37 . I DATE>START Q
38 . I DATE<BACKTO Q
39 . S NODE=""
40 . F S NODE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
41 .. D HF^ORWGAPIA(NODE,.VALUE,.VALUES)
42 .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.23,.04)_U_VALUES ;*****************************
43 .. S RESULT=9000010.23_U_ITEM_U_DATE_U_DATE2_U_VALUE
44 .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
45 Q
46 ;
47IMM(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
48 N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
49 S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
50 F S DATE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE)) Q:DATE="" D
51 . I DATE>START Q
52 . I DATE<BACKTO Q
53 . S NODE=""
54 . F S NODE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
55 .. D IMM^ORWGAPIA(NODE,.VALUE,.VALUES)
56 .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.11,.04)_U_VALUES ;*****************************
57 .. S CNT=CNT+1
58 .. S RESULT=9000010.11_U_ITEM_U_DATE_U_DATE2_U_VALUE
59 .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
60 Q
61 ;
62MH(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
63 N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
64 S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
65 F S DATE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE)) Q:DATE="" D
66 . I DATE>START Q
67 . I DATE<BACKTO Q
68 . S NODE=""
69 . F S NODE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
70 .. D MH^ORWGAPIA(.VALUE,NODE,.VALUES) S VALUE=$P($G(VALUE(2)),U,2,3)_U_VALUES ;*****************************
71 .. S RESULT=601.2_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
72 .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
73 Q
74 ;
75OP(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
76 N DATE,DATE2,NODE,NUM,RESULT,VALUE,VALUES K VALUE
77 S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO),VALUES=""
78 S NUM=""
79 F S NUM=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM)) Q:NUM="" D
80 . S DATE=""
81 . F S DATE=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE)) Q:DATE="" D
82 .. I DATE>START Q
83 .. I DATE<BACKTO Q
84 .. S NODE=""
85 .. F S NODE=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE,NODE)) Q:NODE="" D
86 ... I '$L($G(^DGPT(+NODE,0))) Q ; ****** remove this when PTF patch is released **********
87 ... D PTF^ORWGAPIA(NODE,.VALUE,.VALUES) S VALUE=$G(VALUE("DISCHARGE STATUS"))_U_VALUES ;*****************************
88 ... S RESULT=45_"OP"_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
89 ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
90 Q
91 ;
92POV(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
93 N DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES K VALUE
94 S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
95 S TYPE=""
96 F S TYPE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE)) Q:TYPE="" D
97 . S DATE=""
98 . F S DATE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
99 .. I DATE>START Q
100 .. I DATE<BACKTO Q
101 .. S NODE=""
102 .. F S NODE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE="" D
103 ... D POV^ORWGAPIA(NODE,.VALUE,.VALUES)
104 ... S VALUE=VALUE("CLINICAL TERM"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.07,.15)_U_VALUES ;*****************************
105 ... S CNT=CNT+1
106 ... S RESULT=9000010.07_U_ITEM_U_DATE_U_DATE2_U_VALUE
107 ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
108 Q
109 ;
110PROB(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
111 N DATE,DATE2,DTONSET,DTRESOLV,ICD9,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
112 K ^TMP("ORWGRPC TEMP",$J)
113 S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
114 S STATUS=""
115 F S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS="" D
116 . S PRIORITY=""
117 . F S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
118 .. S DATE=""
119 .. F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
120 ... I DATE>START Q
121 ... I DATE<BACKTO Q
122 ... S NODE=""
123 ... F S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE="" D
124 .... S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE,NODE)=""
125 S ICD9=""
126 F S ICD9=$O(^TMP("ORWGRPC TEMP",$J,ICD9)) Q:ICD9="" D
127 . S DATE=""
128 . F S DATE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE)) Q:DATE="" D
129 .. S NODE=""
130 .. F S NODE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE,NODE)) Q:NODE="" D
131 ... D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
132 ... S RESULT=9000011_U_ITEM_U_DTONSET_U_DATE2_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
133 ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
134 K ^TMP("ORWGRPC TEMP",$J)
135 Q
136 ;
137PROBX(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
138 D PROBX4^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
139 Q
140 ;
141PROC(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
142 N DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES K VALUE
143 S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
144 S TYPE=""
145 F S TYPE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE)) Q:TYPE="" D
146 . S DATE=""
147 . F S DATE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
148 .. I DATE>START Q
149 .. I DATE<BACKTO Q
150 .. S NODE=""
151 .. F S NODE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE="" D
152 ... D CPT^ORWGAPIA(NODE,.VALUE,.VALUES)
153 ... S VALUE=VALUE("PRINCIPAL PROCEDURE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.18,.07)_U_VALUES ;*****************************
154 ... S RESULT=9000010.18_U_ITEM_U_DATE_U_DATE2_U_VALUE
155 ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
156 Q
157 ;
158SKIN(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
159 N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
160 S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
161 F S DATE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE)) Q:DATE="" D
162 . I DATE>START Q
163 . I DATE<BACKTO Q
164 . S NODE=""
165 . F S NODE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
166 .. D SKIN^ORWGAPIA(NODE,.VALUE,.VALUES)
167 .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.12,.04)_U_VALUES ;*****************************
168 .. S CNT=CNT+1
169 .. S RESULT=9000010.12_U_ITEM_U_DATE_U_DATE2_U_VALUE
170 .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
171 Q
172 ;
173VITAL(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
174 I ITEM=99999 D BMIDATA^ORWGAPIX(.DATA,ITEM,START,DFN,.CNT,TMP) Q
175 N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
176 S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
177 F S DATE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE)) Q:DATE="" D
178 . I DATE>START Q
179 . I DATE<BACKTO Q
180 . S NODE=""
181 . F S NODE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
182 .. D VITAL^ORWGAPIA(.VALUE,NODE,.VALUES) S VALUE=$P($G(VALUE(7)),U)
183 .. I $P($G(VALUE(3)),U,2)="PAIN",VALUE=99 S VALUE="(99)"
184 .. S RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_VALUE_U_U_VALUES ;*****************************
185 .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
186 Q
187 ;
Note: See TracBrowser for help on using the repository browser.