source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPBR5.m@ 1005

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

initial load of WorldVistAEHR

File size: 6.6 KB
Line 
1LRAPBR5 ;DALOI/WTY;AUTOPSY BROWSER DISPLAY/TIU STORAGE;6/5/2001
2 ;;5.2;LAB SERVICE;**259**;Sep 27, 1994
3 ;
4 ;This routine was copied from ^LRAPT2. It was updated with FileMan
5 ;DBS calls and modified to be used for browser display and storage
6 ;of the SF515 in TIU.
7 ;
8MAIN ;
9 N LRLLOC,LRDTDIED,LRTMP,LRNUM,LRINC,LRINC1
10 S LRQUIT=0
11 S:'$D(LRIENS) LRIENS=LRDFN_","
12 D HEADER
13 Q:LRQUIT
14 D WEIGHTS
15 D SPCSTD
16 D JRNLREF
17 D:'LRAU DIAGS
18 Q
19HEADER ;
20 D GLENTRY("","",1)
21 D GLENTRY(LRP,"",1)
22 D GLENTRY(SSN,32)
23 D GLENTRY("DOB: "_DOB,52)
24 S LR("F")=1
25 I 'LRTIU,'+$$GET1^DIQ(63,LRIENS,14.7,"I") D Q
26 .D GLENTRY("","",1)
27 .D GLENTRY("Autopsy protocol report not verified.","",1)
28 .S LRQUIT=1
29 S LRLLOC=$$GET1^DIQ(63,LRIENS,14.5,"E")
30 S DA=LRDFN D D^LRAUAW S Y=LR(63,12) D D^LRU S LRDTDIED=Y
31 D GLENTRY("Acc: "_$$GET1^DIQ(63,LRIENS,14),"",1)
32 D GLENTRY("AUTOPSY DATA",32)
33 D GLENTRY("Age: "_$J($$GET1^DIQ(63,LRIENS,12.5),3),52)
34 D GLENTRY("Date/time Died","",1)
35 D GLENTRY("Date/time of Autopsy",52)
36 D GLENTRY(LRDTDIED,"",1)
37 D GLENTRY($E($$GET1^DIQ(63,LRIENS,13.7,"E"),1,18),32)
38 D GLENTRY($$GET1^DIQ(63,LRIENS,11,"E"),52)
39 D GLENTRY("Resident: "_$$GET1^DIQ(63,LRIENS,13.5,"E"),"",1)
40 D GLENTRY("Senior: "_$E($$GET1^DIQ(63,LRIENS,13.6,"E"),1,19),52)
41 Q
42WEIGHTS ;Display/Store Weights & Measures
43 D GLENTRY("","",1)
44 I $D(^LR(LRDFN,"AW")) D
45 .S LRTMP="Rt--Lung--Lt Liver Spleen Rt--Kidney--Lt Brain Body "
46 .S LRTMP=LRTMP_"Wt(lb) Ht(in)"
47 .D GLENTRY(LRTMP,"",1)
48 .D GLENTRY($J($$GET1^DIQ(63,LRIENS,18),4),"",1)
49 .D GLENTRY($J($$GET1^DIQ(63,LRIENS,19),4),8)
50 .D GLENTRY($J($$GET1^DIQ(63,LRIENS,20),5),14)
51 .D GLENTRY($J($$GET1^DIQ(63,LRIENS,21),5),21)
52 .D GLENTRY($J($$GET1^DIQ(63,LRIENS,22),4),28)
53 .D GLENTRY($J($$GET1^DIQ(63,LRIENS,23),4),38)
54 .D GLENTRY($J($$GET1^DIQ(63,LRIENS,25),4),45)
55 .D GLENTRY($$GET1^DIQ(63,LRIENS,17),55)
56 .D GLENTRY($$GET1^DIQ(63,LRIENS,16),68)
57 F LRINC=1:1:2 D GLENTRY("","",1)
58 D:$D(^LR(LRDFN,"AW")) GLENTRY("Heart(gm)",BTAB)
59 I $D(^LR(LRDFN,"AV")) D
60 .D GLENTRY("TV(cm) PV(cm) MV(cm) AV(cm) RV(cm) LV(cm)",12)
61 D GLENTRY("","",1)
62 D GLENTRY($J($$GET1^DIQ(63,LRIENS,24),5),BTAB)
63 I $D(^LR(LRDFN,"AV")) D
64 .S LRNUM=12
65 .F LRINC=26:1:31 D
66 ..D GLENTRY($J($$GET1^DIQ(63,LRIENS,LRINC),4),LRNUM)
67 ..S LRNUM=LRNUM+8
68 .D GLENTRY("","",1)
69 .S LRTMP="Cavities(ml): Rt--Pleural--Lt Pericardial Peritoneal"
70 .D GLENTRY(LRTMP,"",1)
71 .D GLENTRY($J($$GET1^DIQ(63,LRIENS,31.2),4),14,1)
72 .D GLENTRY($J($$GET1^DIQ(63,LRIENS,31.1),4),25)
73 .D GLENTRY($J($$GET1^DIQ(63,LRIENS,31.3),4),33)
74 .D GLENTRY($J($$GET1^DIQ(63,LRIENS,31.4),4),45)
75 I $D(^LR(LRDFN,"AW")) D
76 .D GLENTRY("","",1)
77 .F LRINC=1:1:8 D
78 ..S LRTMP=$$GET1^DIQ(63,LRIENS,"25."_LRINC)
79 ..Q:LRTMP=""
80 ..D GLENTRY($$GET1^DID(63,"25."_LRINC,"","LABEL")_": "_LRTMP,"",1)
81 I $D(^LR(LRDFN,"AWI")) D
82 .D GLENTRY("","",1)
83 .F LRINC=1:1:5 D
84 ..S LRNUM=$S(LRINC=1:25.9,1:25.9_(LRINC-1))
85 ..S LRTMP=$$GET1^DIQ(63,LRIENS,LRNUM)
86 ..Q:LRTMP=""
87 ..D GLENTRY($$GET1^DID(63,LRNUM,"","LABEL")_": "_LRTMP,"",1)
88 Q
89SPCSTD ;Display/store special studies
90 N LRARR,LRSPC,LRORGTS,LRIENS1,LRFLG,LRTEXT,LRCNT
91 D GLENTRY("","",1)
92 S (LRFLG,LRINC)=0
93 F S LRINC=$O(^LR(LRDFN,"AY",LRINC)) Q:'LRINC D
94 .S LRORGTS=$$GET1^DIQ(63.2,LRINC_","_LRIENS,".01:.01")
95 .S LRINC1=0
96 .F S LRINC1=$O(^LR(LRDFN,"AY",LRINC,5,LRINC1)) Q:'LRINC1 D
97 ..S LRIENS1=LRINC1_","_LRINC_","_LRIENS
98 ..D GETS^DIQ(63.26,LRIENS1,".01;.03","","LRARR")
99 ..M LRSPC=LRARR(63.26,LRIENS1)
100 ..S LRSPC(.02)=$$GET1^DIQ(63.26,LRIENS1,.02,"E")
101 ..I 'LRFLG D
102 ...D GLENTRY("","",1)
103 ...D GLENTRY(LRORGTS,BTAB)
104 ...S LRFLG=1
105 ..S LRTEXT=LRSPC(.01)_" "_LRSPC(.03)_" Date: "_LRSPC(.02)
106 ..D GLENTRY(LRTEXT,"",1)
107 ..K ^UTILITY($J,"W"),LRTMP
108 ..S X=$$GET1^DIQ(63.26,LRIENS1,1,"","LRTMP")
109 ..S DIWR=IOM-10,DIWL=10,DIWF=""
110 ..S X=+$$GET1^DID(63.27,1,"","SPECIFIER","LRDBERR")
111 ..I $$GET1^DID(X,.01,"","SPECIFIER")["L" S DIWF="N"
112 ..S LRCNT=0 F S LRCNT=$O(LRTMP(LRCNT)) Q:'LRCNT D
113 ...S X=LRTMP(LRCNT) D ^DIWP
114 ..S LRCNT=0 F S LRCNT=$O(^UTILITY($J,"W",DIWL,LRCNT)) Q:'LRCNT D
115 ...D GLENTRY(^UTILITY($J,"W",DIWL,LRCNT,0),DIWL,1)
116 ..K ^UTILITY($J,"W")
117 ..D GLENTRY("","",1)
118 Q
119JRNLREF ;Print journal references
120 N LRFL,LRM,LRN,LRTP,LRIENS1,LRIENS2,LRIENS3,LRFILE1,LRFILE3,LRFILE4
121 D GLENTRY(,,1)
122 S LRINC1=0,LRFILE=63.2
123 F S LRINC1=$O(^LR(LRDFN,"AY",LRINC1)) Q:'LRINC1 D
124 .S LRIENS1=LRINC1_","_LRIENS
125 .S LRTP=$$GET1^DIQ(LRFILE,LRIENS1,.01,"I")
126 .;Topography
127 .N LRN
128 .S LRFL=LRTP,LRFILE1=61 D JREFPRT
129 .;Morphology
130 .S LRFILE1=61.1,LRFILE3=+$$GET1^DID(LRFILE,4,"","SPECIFIER")
131 .S LRM=0 F S LRM=$O(^LR(LRDFN,"AY",LRINC1,2,LRM)) Q:'LRM D
132 ..S LRIENS2=LRM_","_LRIENS1
133 ..S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
134 ..D JREFPRT
135 ..;Etiology
136 ..S LRFILE1=61.2,LRFILE4=+$$GET1^DID(LRFILE3,1,"","SPECIFIER")
137 ..S LRN=0 F S LRN=$O(^LR(LRDFN,"AY",LRINC1,2,LRM,1,LRN)) Q:'LRN D
138 ...S LRIENS3=LRN_","_LRIENS2
139 ...S LRFL=$$GET1^DIQ(LRFILE4,LRIENS3,.01,"I")
140 ...D JREFPRT
141 .;Disease
142 .S LRFILE1=61.4,LRFILE3=+$$GET1^DID(LRFILE,3,"","SPECIFIER")
143 .S LRM=0 F S LRM=$O(^LR(LRDFN,"AY",LRINC1,1,LRM)) Q:'LRM D
144 ..S LRIENS2=LRM_","_LRIENS1
145 ..S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
146 ..D JREFPRT
147 .;Function
148 .S LRFILE1=61.3,LRFILE3=+$$GET1^DID(LRFILE,1,"","SPECIFIER")
149 .S LRM=0 F S LRM=$O(^LR(LRDFN,"AY",LRINC1,3,LRM)) Q:'LRM D
150 ..S LRIENS2=LRM_","_LRIENS1
151 ..S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
152 ..D JREFPRT
153 .S LRFILE1=61.5,LRFILE3=+$$GET1^DID(LRFILE,1.5,"","SPECIFIER")
154 .S LRM=0 F S LRM=$O(^LR(LRDFN,"AY",LRINC1,4,LRM)) Q:'LRM D
155 ..S LRIENS2=LRM_","_LRIENS1
156 ..S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
157 ..D JREFPRT
158 Q
159JREFPRT ;
160 ; Print journal reference on the patient report if the
161 ; reference is flagged for printing.
162 N LRJR,LRINC
163 S LRFILE2=+$$GET1^DID(LRFILE1,5,"","SPECIFIER")
164 S LRJR=0 F S LRJR=$O(^LAB(LRFILE1,LRFL,"JR",LRJR)) Q:'LRJR D
165 .S LRJR(.01)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",.01)
166 .F LRINC=1:1:5 D
167 ..S LRJR(LRINC)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",LRINC)
168 .S LRJR(6)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",6,"I")
169 .Q:'LRJR(6)
170 .D GLENTRY(,,1),GLENTRY("Reference: ",,1)
171 .D GLENTRY(LRJR(.01),,1)
172 .D GLENTRY(LRJR(1),,1),GLENTRY(,,1)
173 .I LRJR(2)'="" D
174 ..D GLENTRY(LRJR(2)_" vol."_LRJR(3),BTAB)
175 ..D GLENTRY(" pg."_LRJR(4),BTAB)
176 .D GLENTRY(" Date: "_LRJR(5),BTAB)
177 Q
178DIAGS ;
179 N LRV
180 D GLENTRY("","",1)
181 F LRV=81,82 D
182 .D GLENTRY("","",1)
183 .D:LRV=81 GLENTRY(LRAU(1),BTAB)
184 .D:LRV=82 GLENTRY(LRAU(2),BTAB)
185 .S LRFILE=63
186 .S LRFIELD=$S(LRV=81:32.2,1:32.3)
187 .D WP^LRAPBR4
188 .D GLENTRY("","",1)
189 Q
190GLENTRY(LRPR1,LRPR2,LRPR3) ;Write to global
191 ;LRPR1 = Text to be written to global
192 ;LRPR2 = Tab position
193 ;LRPR3 = 1 means start a new line. Othewise, write an current line.
194 S LRPR1=$G(LRPR1),LRPR2=+$G(LRPR2),LRPR3=+$G(LRPR3)
195 D:LRPR3 NEWLN^LRAPUTL(LRPR1,LRPR2)
196 D:'LRPR3 GLBWRT^LRAPUTL(LRPR1,LRPR2)
197 Q
Note: See TracBrowser for help on using the repository browser.