source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRAPBR1.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1LRAPBR1 ;DALOI/WTY/KLL;AP Browser Print Cont.;11/08/01
2 ;;5.2;LAB SERVICE;**259,317,363**;Sep 27, 1994;Build 3
3 ;
4 ;
5ENTER ;from LRAPBR
6 N LRCNT,LRTMP,LRA1,LRADESC,LRLENG1,LRLENG2,LRFILE,LRAPMD
7 N LRFLD,LRV,LRV1,LRV2,LRB1,LRTEXT,LRSPCE,LRIENS,LRAPMR
8 Q:'$D(^LR(LRDFN,LRSS,LRI,0))
9 S:'LRTIU GROOT="^TMP(""LRAPBR"",$J,"
10 S:LRTIU GROOT="^TMP(""TIUP"",$J,"
11 D INP^VADPT S LRPRAC=+VAIN(2)
12 S:'LRPRAC LRPRAC(1)=""
13 I LRPRAC S X=LRPRAC D D^LRUA S LRPRAC(1)=X
14 S LRQ=0 D ^LRUA,HEADER
15 S LR("F")=1
16 D DASH
17 D:LRTIU GLENTRY("$TEXT",,1)
18 D GLENTRY("Submitted by: "_LRW(5),"",1)
19 D GLENTRY("Date obtained: "_LRTK,44)
20 D:LRA DASH
21MAIN ;
22 D SPEC
23 D MODCHK
24 D SUPBNNR
25 D DIAG
26 D DOC
27 D WPFLD
28 D SUPRPT
29 D SSJR
30 Q
31SPEC ;List specimens
32 D GLENTRY("Specimen (Received "_LRTK(1)_"):","",1)
33 S LRCNT=$P(^LR(LRDFN,LRSS,LRI,.1,0),U,4)
34 Q:'LRCNT
35 S LRFILE=+$$GET1^DID(LRSF,.012,"","SPECIFIER")
36 S LRIENS=LRI_","_LRDFN_","
37 S LRCT2=0
38 F LRB1=1:1 D Q:LRCT2=LRCNT
39 .D GETS^DIQ(LRFILE,LRB1_","_LRIENS,.01,"","LRTMP("_LRB1_")")
40 .I $D(LRTMP(LRB1)) S LRCT2=LRCT2+1
41 S LRA1=0 F S LRA1=$O(LRTMP(LRA1)) Q:'LRA1 D
42 .S LRTEXT=LRTMP(LRA1,LRFILE,LRA1_","_LRIENS,.01)
43 .D GLENTRY(LRTEXT,"",1)
44 Q
45MODCHK ;Display modified banner if required
46 S LRAPMR=$$GET1^DIQ(LRSF,LRIENS,.17,"I")
47 Q:'LRAPMR
48 S LRAPMD=$$GET1^DIQ(LRSF,LRIENS,.172,"I")
49 D GLENTRY("","",1)
50 S LRTEXT=""
51 F LRCNT=1:1:$S(LRAPMD:14,1:15) D
52 .S LRTEXT=LRTEXT_"*+"
53 S LRTEXT=LRTEXT_" MODIFIED "
54 S LRTEXT=LRTEXT_$S(LRAPMD:"DIAGNOSIS ",1:"REPORT ")
55 F LRCNT=1:1:$S(LRAPMD:14,1:15) D
56 .S LRTEXT=LRTEXT_"*+"
57 D GLENTRY(LRTEXT,"",1)
58 D GLENTRY("","",1)
59 Q
60SUPBNNR ;Display supplementary report header if one or more has been added
61 I $P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4) D
62 .S LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED *+*"
63 .D GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
64 .S LRTEXT="*+* REFER TO BOTTOM OF REPORT *+*"
65 .D GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
66 .D GLENTRY("","",1)
67 Q
68DIAG ;
69 ;Display the Brief Clinical History, Preoperative Diagnosis,
70 ;Operative Findings, and Postoperative Diagnosis
71 S LRFILE=LRSF,LRCNT=0,LRIENS=LRI_","_LRDFN_","
72 F LRFLD=.013:.001:.016 D
73 .D:LRA DASH
74 .S LRCNT=LRCNT+1
75 .D GLENTRY($P($T(TEXT1+LRCNT),";",2),"",1)
76 .D WP
77 Q
78DOC ;
79 ;Pathologist information
80 D GLENTRY("","",1)
81 D GLENTRY("Surgeon/physician: "_LRMD,27,1)
82 D:LRA GLENTRY(LR("%1"),"",1)
83 D DASH
84 D HEADER2
85 D:LRA DASH
86 I LRRC="" D
87 .D GLENTRY("+*+* REPORT INCOMPLETE *+*+",20,1)
88 .D GLENTRY("","",1)
89 D GLENTRY("","",1)
90 I LRRMD'="" D
91 .S LRCNT=0 F LRA1="SP","CY","EM" D
92 ..S LRCNT=LRCNT+1
93 ..S LRTMP(LRA1)=$P($T(TEXT2+LRCNT),";",3)
94 .S LRTMP=LRTMP(LRSS)
95 .D GLENTRY(LRTMP_" "_LRRMD,31)
96 Q
97WPFLD ;
98 ;Display Frozen Section, Gross Description, Microscopic Description
99 ;and Surgical Path Diagnosis
100 F LRCNT=1:1:4 D
101 .S X=$T(FIELDS+LRCNT)
102 .S LRV=$P(X,";",2),LRV1=$P(X,";",3),LRV2=$P(X,";",4)
103 .D TEXTCHK
104 .I $P($G(^LR(LRDFN,LRSS,LRI,LRV,0)),U,4) D
105 ..D GLENTRY("","",1),GLENTRY(LR(69.2,LRV1),"",1)
106 ..S LRFILE=LRSF,LRIENS=LRI_","_LRDFN_",",LRFLD=LRV
107 ..I $P($G(^LR(LRDFN,LRSS,LRI,LRV2,0)),U,4) D
108 ...S LRFILE1=+$$GET1^DID(LRSF,LRV2,"","SPECIFIER")
109 ...D GLENTRY("*+* MODIFIED REPORT *+*",28,1)
110 ...D GLENTRY("(Last modified: ","",1)
111 ...S (LRA1,LRB1)=0
112 ...F S LRA1=$O(^LR(LRDFN,LRSS,LRI,LRV2,LRA1)) Q:'LRA1 S LRB1=LRA1
113 ...Q:'$D(^LR(LRDFN,LRSS,LRI,LRV2,LRB1,0))
114 ...S LRSR1=$$GET1^DIQ(LRFILE1,LRB1_","_LRIENS,.01)
115 ...S LRSR2=$$GET1^DIQ(LRFILE1,LRB1_","_LRIENS,.02)
116 ...S LRTEXT=LRSR1_" typed by "_LRSR2_")"
117 ...D GLENTRY(LRTEXT,BTAB)
118 ..D WP
119 Q
120SUPRPT ;Supplementary Report
121 I $P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4) D
122 .S LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
123 .S LRIENS1=LRI_","_LRDFN_","
124 .D GLENTRY("","",1),GLENTRY("SUPPLEMENTARY REPORT(S):","",1)
125 .S LRV=0 F S LRV=$O(^LR(LRDFN,LRSS,LRI,1.2,LRV)) Q:'LRV D
126 ..S LRIENS=LRV_","_LRIENS1
127 ..S LRSR1=$$GET1^DIQ(LRFILE,LRIENS,.01)
128 ..S LRSR2=+$$GET1^DIQ(LRFILE,LRIENS,.02)
129 ..D GLENTRY("Supplementary Report Date: "_LRSR1,3,1)
130 ..I $D(LR("R")),'LRSR2 D GLENTRY(" not verified",BTAB) Q
131 ..I $P($G(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,0)),U,4) D
132 ...S LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED/MODIFIED *+*"
133 ...D GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
134 ...D GLENTRY("(Added/Last","",1)
135 ...S (LRA1,LRB1)=0
136 ...F S LRA1=$O(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,LRA1)) Q:'LRA1 D
137 ....S LRB1=LRA1
138 ...Q:'$D(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,LRB1,0))
139 ...S LRA2=^(0),Y=+LRA2,LRA2A=$P(LRA2,"^",2),LRSGN=" Typed by ",LRDSC=" modified: "
140 ...I $P(LRA2,"^",3) S LRSGN=" Signed by ",LRDSC=" released: ",LRA2A=$P(LRA2,"^",3),Y=$P(LRA2,"^",4)
141 ...S LRA2A=$S($D(^VA(200,LRA2A,0)):$P(^(0),"^"),1:LRA2A)
142 ...D D^LRU
143 ...D GLENTRY(LRDSC_Y_LRSGN_LRA2A_")",BTAB)
144 ..S LRFLD=1 D WP
145 ..D GLENTRY("","",1)
146 Q
147SSJR ;Print special studies/journal references
148 D ^LRAPBR3
149 S LREFLG=1
150 Q
151WP ;Display word procesing fields
152 K LRTMP,^UTILITY($J,"W")
153 N X,DIWR,DIWL,LRINC
154 S X=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","LRTMP",)
155 S DIWR=IOM-5,DIWL=5,DIWF=""
156 S X=+$$GET1^DID(LRFILE,LRFLD,"","SPECIFIER")
157 I $$GET1^DID(X,.01,"","SPECIFIER")["L" S DIWF="N"
158 S LRINC=0
159 F S LRINC=$O(LRTMP(LRINC)) Q:'LRINC S X=LRTMP(LRINC) D ^DIWP
160 S LRINC=0
161 F S LRINC=$O(^UTILITY($J,"W",DIWL,LRINC)) Q:'LRINC D
162 .D GLENTRY(^UTILITY($J,"W",DIWL,LRINC,0),DIWL,1)
163 K ^UTILITY($J,"W")
164 Q
165HEADER ;
166 D:LRTIU GLENTRY("$APHDR",,1)
167 D GLENTRY("","",1)
168 D DASH
169 D GLENTRY("MEDICAL RECORD |",5,1)
170 D GLENTRY(LRAA1,40)
171 D DASH
172HEADER2 ;
173 S LRADESC="Accession No. "_$S(LRQ(8)]"":LRQ(8)_LRW(1)_" "_LRAC,1:LRAC)
174 S LRLENG1=$L(LRQ(1)),LRLENG2=$L(LRADESC),LRSPCE=IOM-LRLENG2-14
175 S:LRLENG1>LRSPCE LRQ(1)=$E(LRQ(1),1,LRSPCE)
176 D GLENTRY("PATHOLOGY REPORT",30,1)
177 D GLENTRY("Laboratory: "_LRQ(1),"",1)
178 D GLENTRY(LRADESC,IOM-LRLENG2-1)
179 Q
180FOOTER ;Footer-called from ^LRAPBR
181 D:LRTIU GLENTRY("$FTR",,1)
182 D DASH
183 S LRTEXT=$S('$D(LR("W")):"",1:"See signed copy in chart")
184 D GLENTRY(LRTEXT,"",1)
185 S LRTEXT="("_$S($D(LREFLG):"End of report",1:"See next page")_")"
186 D GLENTRY(LRTEXT,57)
187 D GLENTRY(LRPMD,"",1),GLENTRY(LRW(9),52),GLENTRY("| Date "_LRRC,55)
188 D DASH
189 D GLENTRY(LRP,"",1)
190 S LRTEXT=$S('$D(LR("W")):"STANDARD FORM 515",1:"WORK COPY ONLY !!")
191 D GLENTRY(LRTEXT,50)
192 D GLENTRY("ID:"_SSN,"",1)
193 D GLENTRY("SEX:"_SEX,16),GLENTRY(" DOB:"_DOB,BTAB)
194 I AGE D
195 .S LRTEXT=$S($G(VADM(6))]"":" AGE AT DEATH: ",1:" AGE: ")_AGE
196 .D GLENTRY(LRTEXT,BTAB)
197 D GLENTRY(" LOC:"_LRLLOC,BTAB)
198 D GLENTRY("","",1)
199 D:$L(LRADM) GLENTRY("ADM:"_$P(LRADM,"@"),BTAB)
200 D:$L(LRADX) GLENTRY("DX:"_$E(LRADX,1,26),17)
201 D GLENTRY("PCP:",46)
202 D:$L(LRPRAC) GLENTRY($E(LRPRAC(1),1,28),51)
203 Q
204ESIGLN ;Write signature block name, title, and date of signature
205 D GLENTRY(,,1)
206 I $D(^VA(200,DUZ,0)) D
207 .S LRFILE=200,LRFLD=20.2,LRFLD2=20.3
208 .S X=$$GET1^DIQ(LRFILE,DUZ,LRFLD)
209 ;Compare DUZ to pathologist, if different, use proxy signature
210 S:LRSS="AU" LRPATH=$$GET1^DIQ(63,LRDFN,13.6,"I")
211 I LRSS'="AU" D
212 .S LRFL2=$S(LRSS="EM":63.02,LRSS="CY":63.09,LRSS="SP":63.08,1:0)
213 .S LRIENS=LRI_","_LRDFN_","
214 .S LRPATH=$$GET1^DIQ(LRFL2,LRIENS,.02,"I")
215 S LRPATH2=""
216 S:LRPATH'=DUZ LRPATH2=" FOR "_$$GET1^DIQ(LRFILE,LRPATH,LRFLD)
217 S LRTEXT="/es/ "_X_LRPATH2
218 ;S LRTEXT="/es/ "_X
219 D GLENTRY(LRTEXT,,1)
220 S X=$$GET1^DIQ(LRFILE,DUZ,LRFLD2)
221 S LRTEXT=X
222 D GLENTRY(LRTEXT,,1)
223 S Y=LRNTIME D DD^%DT
224 S LRTEXT="Signed "_Y
225 D GLENTRY(LRTEXT,,1)
226 Q
227DASH ;Display a line of dashes
228 D GLENTRY(LR("%"),"",1)
229 Q
230GLENTRY(LRPR1,LRPR2,LRPR3) ;Write to global
231 ;LRPR1 = Text to be written to global
232 ;LRPR2 = Tab position
233 ;LRPR3 = 1 means start a new line. Othewise, write an current line.
234 S LRPR1=$G(LRPR1)
235 S LRPR2=+$G(LRPR2)
236 S LRPR3=+$G(LRPR3)
237 D:LRPR3 NEWLN^LRAPUTL(LRPR1,LRPR2)
238 D:'LRPR3 GLBWRT^LRAPUTL(LRPR1,LRPR2)
239 Q
240TEXT1 ;Text for top of report
241 ;BRIEF CLINICAL HISTORY:
242 ;PREOPERATIVE DIAGNOSIS:
243 ;OPERATIVE FINDINGS:
244 ;POSTOPERATIVE DIAGNOSIS:
245TEXT2 ;Descriptive text based on section
246 ;SP;Pathology Resident:
247 ;CY;Screened by:
248 ;EM;Prepared by:
249FIELDS ;Field numbers for word processing fields
250 ;1.3;.13;6
251 ;1;.03;7
252 ;1.1;.04;4
253 ;1.4;.14;5
254TEXTCHK ; update text line counter if it is missing (Remedy 116253)
255 N I,X,DATA
256 S I=0
257 K ^TMP("WP",$J)
258 S X=$G(^LR(LRDFN,LRSS,LRI,LRV,0))
259 I X'="",$L(X,"^")=1 D
260 . F S I=$O(^LR(LRDFN,LRSS,LRI,LRV,I)) Q:I="" D
261 . . S DATA=$G(^LR(LRDFN,LRSS,LRI,LRV,I,0))
262 . . S ^TMP("WP",$J,I,0)=DATA
263 I $D(^TMP("WP",$J)) D
264 . D WP^DIE(63.08,LRI_","_LRDFN_",",LRV,"","^TMP(""WP"",$J)")
265 . K ^TMP("WP",$J)
266 Q
Note: See TracBrowser for help on using the repository browser.