source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORRECP1.m@ 1618

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

initial load of WorldVistAEHR
File size: 8.7 KB
RevLine 
[613]1ORRECP1 ; BSL - VOE RECORD PRINT UTILITY; 11/02/06 [11/02/06 01:43am]
2 ;;1.0;ORDER ENTRY/RESULTS PRINTING;****;Nov 02, 2006;Build 1
3 ;Two primary tags one for all of today's data (TODAY) and one for date range (HIST)
4 ;
5PRINT ;
6 N AMDATA,AMDTL,AMID,L,LNCT,I,ORRET,NOTELN,ORNXT,ORID,ORDT,ORIEN,ORALID,TEXT,TIUDA,TIUY
7 N STATION,RET,RESNUM,PRBID,PDET,PAGE,ORRLST,ORRESNUM,ORPRBID,ORPDET,ORNUM,ORLST,Y
8 K ^TMP("ORDATA",$J)
9 S PAGE=1
10 S LNCT=1
11 S ^TMP("ORDATA",$J,1,"LABS")=""
12 S ^TMP("ORDATA",$J,1,"ORDERS")=""
13 ;
14 ;Format Active Medications for output
15 K ORRET S ORRET=""
16 M ORRET=ORTMP("ACTIVE")
17 S TEXT="Active Medications"
18 S $P(^TMP("ORDATA",$J,1,"ACTIVE",LNCT)," ",(80-$L(TEXT)/2))=TEXT
19 S LNCT=LNCT+1
20 S ORNXT=0
21 F S ORNXT=$O(ORRET(ORNXT)) Q:ORNXT="" D AMP
22 ;
23 ;Format Allergies for output
24 K ORRET S ORRET=""
25 M ORRET=ORTMP("ALLERGIES")
26 S ^TMP("ORDATA",$J,1,"ALLERGIES",LNCT)=""
27 S LNCT=LNCT+1
28 S TEXT="Allergies"
29 S $P(^TMP("ORDATA",$J,1,"ALLERGIES",LNCT)," ",(80-$L(TEXT)/2))=TEXT
30 S LNCT=LNCT+1
31 S ^TMP("ORDATA",$J,1,"ALLERGIES",LNCT)=""
32 S LNCT=LNCT+1
33 S ORNXT=0
34 F S ORNXT=$O(ORRET(ORNXT)) Q:ORNXT="" D
35 . K X S X=""
36 . S ORALID=$P($G(ORRET(ORNXT)),U,1)
37 . D DETAIL^ORQQAL(.X,ORDFN,ORALID)
38 . S I=""
39 . F S I=$O(X(I)) Q:I="" D
40 .. S ^TMP("ORDATA",$J,1,"ALLERGIES",LNCT)=$G(X(I))
41 .. S LNCT=LNCT+1
42 . Q
43 S ^TMP("ORDATA",$J,1,"ALLERGIES",LNCT)=""
44 S LNCT=LNCT+1
45 ;
46 ;Format Clinical Reminders for output
47 K ORRET S ORRET=""
48 M ORRET=ORTMP("CR")
49 S ^TMP("ORDATA",$J,1,"CR",LNCT)=""
50 S LNCT=LNCT+1
51 S TEXT="Clinical Reminders"
52 S $P(^TMP("ORDATA",$J,1,"CR",LNCT)," ",(80-$L(TEXT)/2))=TEXT
53 S LNCT=LNCT+1
54 S ^TMP("ORDATA",$J,1,"CR",LNCT)=""
55 S LNCT=LNCT+1
56 S ORNXT=0
57 F S ORNXT=$O(ORRET(ORNXT)) Q:ORNXT="" D
58 . S ORIEN=$G(ORRET(ORNXT))
59 . K ORCRDET S ORCRDET=""
60 . D REMDET^ORQQPXRM(.ORCRDET,ORDFN,ORIEN)
61 . S I=""
62 . F S I=$O(ORCRDET(I)) Q:I="" D
63 .. S ^TMP("ORDATA",$J,1,"CR",LNCT)=$G(ORCRDET(I))
64 .. S LNCT=LNCT+1
65 . Q
66 S ^TMP("ORDATA",$J,1,"CR",LNCT)=""
67 S LNCT=LNCT+1
68 ;
69 ;Format Discharge Summaries for output
70 K ORRET S ORRET=""
71 M ORRET=ORTMP("DC")
72 S ^TMP("ORDATA",$J,1,"DC",LNCT)=""
73 S LNCT=LNCT+1
74 S TEXT="Discharge Summaries"
75 S $P(^TMP("ORDATA",$J,1,"DC",LNCT)," ",(80-$L(TEXT)/2))=TEXT
76 S LNCT=LNCT+1
77 S ^TMP("ORDATA",$J,1,"DC",LNCT)=""
78 S LNCT=LNCT+1
79 S ORNXT=0
80 F S ORNXT=$O(ORRET(ORNXT)) Q:ORNXT="" D
81 . S ^TMP("ORDATA",$J,1,"DC",LNCT)=$G(ORRET(ORNXT))
82 . S LNCT=LNCT+1
83 . Q
84 S ^TMP("ORDATA",$J,1,"DC",LNCT)=""
85 S LNCT=LNCT+1 ;
86 ;
87 ;Format Immunizations for output
88 N SNIMM,IDT,PXIEN,IMREC,IMREC0,IMREC1,IMDT,ORSPC
89 D IMMUN^PXRHS03(ORDFN)
90 S ORSPC=""
91 S TEXT="Immunizations"
92 S $P(^TMP("ORDATA",$J,1,"IMMUN",LNCT)," ",(80-$L(TEXT)/2))=TEXT
93 S LNCT=LNCT+1
94 S ^TMP("ORDATA",$J,1,"IMMUN",LNCT)=""
95 S LNCT=LNCT+1
96 F I=1:1:80 S ORSPC=ORSPC_" "
97 I $D(^TMP("PXI",$J)) D
98 . S ^TMP("ORDATA",$J,1,"IMMUN",LNCT)="Immunization Series Date Facility Reaction"
99 . S LNCT=LNCT+1
100 . S ^TMP("ORDATA",$J,1,"IMMUN",LNCT)=""
101 . S LNCT=LNCT+1
102 . S SNIMM=""
103 . F S SNIMM=$O(^TMP("PXI",$J,SNIMM)) Q:SNIMM="" D
104 .. S IDT=""
105 .. F S IDT=$O(^TMP("PXI",$J,SNIMM,IDT)) Q:IDT="" D
106 ... S PXIEN=""
107 ... F S PXIEN=$O(^TMP("PXI",$J,SNIMM,IDT,PXIEN)) Q:PXIEN="" D
108 .... S IMREC0=$G(^TMP("PXI",$J,SNIMM,IDT,PXIEN,0))
109 .... S IMREC1=$G(^TMP("PXI",$J,SNIMM,IDT,PXIEN,1))
110 .... S Y=$P(IMREC0,U,3),Y=$P(Y,".") D DD^%DT S IMDT=Y
111 .... S IMREC=""
112 .... S IMREC=$P(IMREC0,U,2)
113 .... S IMREC=IMREC_$E(ORSPC,1,17-$L(IMREC))_$P(IMREC0,U,4)
114 .... S IMREC=IMREC_$E(ORSPC,1,22-$L(IMREC))_IMDT
115 .... S IMREC=IMREC_$E(ORSPC,1,36-$L(IMREC))_$P(IMREC1,U,1)
116 .... S IMREC=IMREC_$E(ORSPC,1,51-$L(IMREC))_$P(IMREC0,U,6)
117 .... S ^TMP("ORDATA",$J,1,"IMMUN",LNCT)=IMREC
118 .... S LNCT=LNCT+1
119 . Q
120 I '$D(^TMP("PXI",$J)) D
121 . S ^TMP("ORDATA",$J,1,"IMMUN",LNCT)=""
122 . S LNCT=LNCT+1
123 . S ^TMP("ORDATA",$J,1,"IMMUN",LNCT)="No Immunizations found."
124 . S LNCT=LNCT+1
125 . S ^TMP("ORDATA",$J,1,"IMMUN",LNCT)=""
126 . S LNCT=LNCT+1
127 . Q
128 S ^TMP("ORDATA",$J,1,"IMMUN",LNCT)=""
129 S LNCT=LNCT+1
130 ;
131 ;Format Labs for output
132 K ORRET S ORRET=""
133 M ORRET=ORTMP("LABS")
134 S ^TMP("ORDATA",$J,1,"LABS",LNCT)=""
135 S LNCT=LNCT+1
136 S TEXT="Labs"
137 S $P(^TMP("ORDATA",$J,1,"LABS",LNCT)," ",(80-$L(TEXT)/2))=TEXT
138 S LNCT=LNCT+1
139 S ^TMP("ORDATA",$J,1,"LABS",LNCT)=""
140 S LNCT=LNCT+1
141 S ORNXT=0
142 F S ORNXT=$O(^TMP("LR7OGX",$J,"OUTPUT",ORNXT)) Q:ORNXT="" D
143 . S ^TMP("ORDATA",$J,1,"LABS",LNCT)=$G(^TMP("LR7OGX",$J,"OUTPUT",ORNXT))
144 . S LNCT=LNCT+1
145 . Q
146 S ^TMP("ORDATA",$J,1,"LABS",LNCT)=""
147 S LNCT=LNCT+1
148 ;
149 ;Format Notes for output
150 K ORRET S ORRET=""
151 M ORRET=ORTMP("NOTES")
152 S TEXT="Notes"
153 S $P(^TMP("ORDATA",$J,1,"NOTES",LNCT)," ",(80-$L(TEXT)/2))=TEXT
154 S LNCT=LNCT+1
155 S ORNXT=0 D NOTEP
156 ;
157 ;Format Orders for output
158 K ORRET S ORRET=""
159 M ORRET=ORTMP("ORDERS")
160 S TEXT="Orders"
161 S $P(^TMP("ORDATA",$J,1,"ORDERS",LNCT)," ",(80-$L(TEXT)/2))=TEXT
162 S LNCT=LNCT+1
163 S ORDT="",ORNUM="",ORRLST=0
164 F S ORDT=$O(^TMP("ORR",$J,ORDT)) Q:ORDT="" D
165 . F S ORNUM=$O(^TMP("ORR",$J,ORDT,ORNUM)) Q:ORNUM="" D
166 .. S ORRLST=ORRLST+1,ORLST(ORRLST)=$P($G(^TMP("ORR",$J,ORDT,ORNUM)),U,1)
167 .. Q
168 . Q
169 S ORNUM=0
170 S ^TMP("ORDATA",$J,1,"ORDERS",LNCT)=""
171 S LNCT=LNCT+1
172 F S ORNUM=$O(ORLST(ORNUM)) Q:ORNUM="" D
173 . K ORRET S ORRET=""
174 . S ORID=$G(ORLST(ORNUM))
175 . D DETAIL^ORWOR(.ORRET,ORID,ORDFN)
176 . S ORRESNUM=0
177 . F S ORRESNUM=$O(^TMP("ORTXT",$J,ORRESNUM)) Q:ORRESNUM="" D
178 .. S ^TMP("ORDATA",$J,1,"ORDERS",LNCT)=$G(^TMP("ORTXT",$J,ORRESNUM))
179 .. S LNCT=LNCT+1
180 . Q
181 S ^TMP("ORDATA",$J,1,"ORDERS",LNCT)=""
182 S LNCT=LNCT+1
183 ;
184 ;Format Problems for output
185 K ORRET S ORRET=""
186 M ORRET=ORTMP("PROB")
187 S TEXT="Problems"
188 S $P(^TMP("ORDATA",$J,1,"PROB",LNCT)," ",(80-$L(TEXT)/2))=TEXT
189 S LNCT=LNCT+1
190 S ^TMP("ORDATA",$J,1,"PROB",LNCT)=""
191 S LNCT=LNCT+1
192 S ORNXT=0
193 F S ORNXT=$O(ORRET(ORNXT)) Q:ORNXT=""!($G(ORRET(ORNXT))="") D
194 . S ORPRBID=$P($G(ORRET(ORNXT)),U,1)
195 . S ORPDET=""
196 . D DETAIL^ORQQPL(.ORPDET,ORDFN,ORPRBID,"")
197 . F I=1:1:$O(ORPDET(""),-1) D
198 .. S ^TMP("ORDATA",$J,1,"PROB",LNCT)=ORPDET(I)
199 .. S LNCT=LNCT+1
200 . Q
201 S ^TMP("ORDATA",$J,1,"PROB",LNCT)=""
202 S LNCT=LNCT+1
203 ;
204 ;Format Visits for output
205 K ORRET S ORRET=""
206 M ORRET=ORTMP("VISITS")
207 S ^TMP("ORDATA",$J,1,"VISITS",LNCT)=""
208 S LNCT=LNCT+1
209 S TEXT="Visits"
210 S $P(^TMP("ORDATA",$J,1,"VISITS",LNCT)," ",(80-$L(TEXT)/2))=TEXT
211 S LNCT=LNCT+1
212 S ^TMP("ORDATA",$J,1,"VISITS",LNCT)=""
213 S LNCT=LNCT+1
214 S ORNXT=0
215 F S ORNXT=$O(ORRET(ORNXT)) Q:ORNXT="" D
216 . S ^TMP("ORDATA",$J,1,"VISITS",LNCT)=$G(ORRET(ORNXT))
217 . S LNCT=LNCT+1
218 . Q
219 S ^TMP("ORDATA",$J,1,"VISITS",LNCT)=""
220 S LNCT=LNCT+1
221 ;
222 ;Format Vitals for output
223 K ORRET S ORRET=""
224 M ORRET=ORTMP("VITALS")
225 S ^TMP("ORDATA",$J,1,"VITALS",LNCT)=""
226 S LNCT=LNCT+1
227 S TEXT="Vitals"
228 S $P(^TMP("ORDATA",$J,1,"VITALS",LNCT)," ",(80-$L(TEXT)/2))=TEXT
229 S LNCT=LNCT+1
230 S ^TMP("ORDATA",$J,1,"VITALS",LNCT)=""
231 S LNCT=LNCT+1
232 S ORNXT=0
233 F S ORNXT=$O(ORRET(ORNXT)) Q:ORNXT="" D
234 . S ^TMP("ORDATA",$J,1,"VITALS",LNCT)=$G(ORRET(ORNXT))
235 . S LNCT=LNCT+1
236 . Q
237 S ^TMP("ORDATA",$J,1,"VITALS",LNCT)=""
238 S LNCT=LNCT+1
239 ;
240 K ORTMP
241 Q
242 ;
243AMP ;special routine for printing active medications
244 S AMDATA=$G(ORRET(ORNXT))
245 I $E(AMDATA,1)="~" D
246 . S ^TMP("ORDATA",$J,1,"ACTIVE",LNCT)=""
247 . S LNCT=LNCT+1
248 . S ^TMP("ORDATA",$J,1,"ACTIVE",LNCT)=""
249 . S LNCT=LNCT+1
250 . S AMID=$P($G(AMDATA),U,2)
251 . S AMDTL=""
252 . D DETAIL^ORWPS(.AMDTL,ORDFN,AMID)
253 . F I=1:1:$O(^TMP("ORXPND",$J,""),-1) D
254 .. S ^TMP("ORDATA",$J,1,"ACTIVE",LNCT)=^TMP("ORXPND",$J,I,0)
255 .. S LNCT=LNCT+1
256 Q
257 ;
258NOTEP ;special routine for printing notes.
259 F S ORNXT=$O(ORRET(ORNXT)) Q:ORNXT="" D
260 . S ^TMP("ORDATA",$J,1,"NOTES",LNCT)=""
261 . S LNCT=LNCT+1
262 . S TIUY=""
263 . S TIUDA=$G(ORRET(ORNXT))
264 . D TGET^TIUSRVR1(.TIUY,TIUDA)
265 . S NOTELN=0
266 . F S NOTELN=$O(^TMP("TIUVIEW",$J,NOTELN)) Q:NOTELN="" D
267 .. S ^TMP("ORDATA",$J,1,"NOTES",LNCT)=^TMP("TIUVIEW",$J,NOTELN)
268 .. S LNCT=LNCT+1
269 . S ^TMP("ORDATA",$J,1,"NOTES",LNCT)=""
270 . S LNCT=LNCT+1
271 . Q
272 Q
273 ;
274PROBP ;special routine for printing problems.
275 S TEXT="Patient Record Print / Problems"
276 D HEAD^ORWRPP1(ORDFN,PAGE,TEXT,$G(STATION))
277 S ORNXT=""
278 F S ORNXT=$O(^TMP("ORDATA",$J,1,L,ORNXT)) Q:ORNXT="" D
279 . S PRBID=$P($G(^TMP("ORDATA",$J,1,L,ORNXT)),U,1)
280 . S PDET=""
281 . D DETAIL^ORQQPL(.PDET,ORDFN,PRBID,"")
282 . F I=1:1:$O(PDET(""),-1) W !?10,PDET(I)
283 . Q
284 Q
285 ;
286ORDP ;special routine for printing orders
287 S TEXT="Patient Record Print / Orders"
288 D HEAD^ORWRPP1(ORDFN,PAGE,TEXT,$G(STATION)) W !
289 ;N ORLST,RET
290 S ORDT="",ORNUM="",ORRLST=0
291 F S ORDT=$O(^TMP("ORR",$J,ORDT)) Q:ORDT="" D
292 . F S ORNUM=$O(^TMP("ORR",$J,ORDT,ORNUM)) Q:ORNUM="" D
293 .. S ORRLST=ORRLST+1,ORLST(ORRLST)=$P($G(^TMP("ORR",$J,ORDT,ORNUM)),U,1)
294 .. Q
295 . Q
296 ;D GET4V11^ORWORR(.RET,2,-1,.ORLST)
297 S ORNUM=0
298 W !
299 F S ORNUM=$O(ORLST(ORNUM)) Q:ORNUM="" D
300 . S RET=""
301 . S ORID=$G(ORLST(ORNUM))
302 . D DETAIL^ORWOR(.RET,ORID,ORDFN)
303 . S RESNUM=0
304 . F S RESNUM=$O(^TMP("ORTXT",$J,RESNUM)) Q:RESNUM="" W !?10,^(RESNUM)
305 . Q
306 Q
Note: See TracBrowser for help on using the repository browser.