1 | WVALERTP ;HIOFO/FT-RETURN SURGICAL PATHOLOGY REPORT IN TMP GLOBAL ;9/29/04 14:30
|
---|
2 | ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
|
---|
3 | ;
|
---|
4 | ; This routine uses the following IAs:
|
---|
5 | ; #2771 - ^TMP("LRA",$J) references (controlled)
|
---|
6 | ; #10103 - ^XLFDT calls (supported)
|
---|
7 | ; #10104 - ^XLFSTR calls (supported)
|
---|
8 | ;
|
---|
9 | EN ; Move data from ^TMP("LRA",$J) to ^TMP("WV RPT",$J) for display
|
---|
10 | ; Called from WVLABWP and WVPROC
|
---|
11 | Q:'$D(^TMP("LRA",$J))
|
---|
12 | N WVLINE,WVNODE,WVDATE,WVRPTDT,WVSUB2,WVSUB3,WVSUB4,WVSUB5,WVTEXT,X
|
---|
13 | S (WVDATE,WVLINE)=0
|
---|
14 | F S WVDATE=$O(^TMP("LRA",$J,WVDATE)) Q:'WVDATE D
|
---|
15 | .S WVSUB2=""
|
---|
16 | .F S WVSUB2=$O(^TMP("LRA",$J,WVDATE,WVSUB2)) Q:WVSUB2=""!(WVSUB2?1A) S WVNODE=$G(^TMP("LRA",$J,WVDATE,WVSUB2)) D ACCESSN
|
---|
17 | .I $D(^TMP("LRA",$J,WVDATE,1.2)) D SUPRPT
|
---|
18 | .Q
|
---|
19 | ; NOTE: Calling routine should kill ^TMP("LRA",$J)
|
---|
20 | Q
|
---|
21 | ACCESSN ; Collection date & Lab Accession#
|
---|
22 | I WVSUB2=0 D
|
---|
23 | .D ADD^WVLABWPC
|
---|
24 | .S ^TMP("WV RPT",$J,WVLINE,0)=" Collected: "_$P(WVNODE,U,1)
|
---|
25 | .D ADD^WVLABWPC
|
---|
26 | .S ^TMP("WV RPT",$J,WVLINE,0)="Lab Accession #: "_$P(WVNODE,U,2)
|
---|
27 | .Q
|
---|
28 | I WVSUB2=.1 D SPEC Q
|
---|
29 | I $S(WVSUB2=.2:1,WVSUB2=1:1,WVSUB2=1.1:1,WVSUB2=1.3:1,WVSUB2=1.4:1,1:0) D TEXT Q
|
---|
30 | I WVSUB2=2 D
|
---|
31 | .S WVSUB3=0
|
---|
32 | .F S WVSUB3=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3)) Q:WVSUB3'>0 D
|
---|
33 | ..S X=^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3)
|
---|
34 | ..D WRTTM,WRTP
|
---|
35 | ..Q
|
---|
36 | .Q
|
---|
37 | Q
|
---|
38 | SPEC ; Specimen list
|
---|
39 | S WVSUB4=$O(^TMP("LRA",$J,WVDATE,.1,0))
|
---|
40 | D ADD^WVLABWPC
|
---|
41 | S ^TMP("WV RPT",$J,WVLINE,0)="Specimen: "_$G(^TMP("LRA",$J,WVDATE,.1,WVSUB4))
|
---|
42 | F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,.1,WVSUB4)) Q:'WVSUB4 D
|
---|
43 | .D ADD^WVLABWPC
|
---|
44 | .S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",10)_$G(^TMP("LRA",$J,WVDATE,.1,WVSUB4))
|
---|
45 | .Q
|
---|
46 | D ADD^WVLABWPC,BLANK^WVLABWPC
|
---|
47 | Q
|
---|
48 | TEXT ; Gross Description & Microscopic Exam/Dx
|
---|
49 | D ADD^WVLABWPC
|
---|
50 | S ^TMP("WV RPT",$J,WVLINE,0)="<"_WVNODE_">"
|
---|
51 | S WVSUB4=0
|
---|
52 | F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB4)) Q:'WVSUB4 D
|
---|
53 | .S WVTEXT=^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB4)
|
---|
54 | .D ADD^WVLABWPC
|
---|
55 | .S ^TMP("WV RPT",$J,WVLINE,0)=WVTEXT
|
---|
56 | .Q
|
---|
57 | Q
|
---|
58 | SUPRPT ; Supplementary Report
|
---|
59 | S WVSUB2=0
|
---|
60 | F S WVSUB2=$O(^TMP("LRA",$J,WVDATE,1.2,WVSUB2)) Q:'WVSUB2 D
|
---|
61 | .S WVRPTDT=$G(^TMP("LRA",$J,WVDATE,1.2,WVSUB2,0))
|
---|
62 | .S WVRPTDT=$$FMTE^XLFDT(WVRPTDT,"2P")
|
---|
63 | .D ADD^WVLABWPC
|
---|
64 | .S ^TMP("WV RPT",$J,WVLINE,0)="Supplementary Report: "_WVRPTDT
|
---|
65 | .S WVSUB3=0
|
---|
66 | .F S WVSUB3=$O(^TMP("LRA",$J,WVDATE,1.2,WVSUB2,WVSUB3)) Q:'WVSUB3 D
|
---|
67 | ..D ADD^WVLABWPC
|
---|
68 | ..S ^TMP("WV RPT",$J,WVLINE,0)=$G(^TMP("LRA",$J,WVDATE,1.2,WVSUB2,WVSUB3))
|
---|
69 | ..Q
|
---|
70 | .Q
|
---|
71 | Q
|
---|
72 | WRTTM ; Display Topography, Disease, Morphology and Etiology values
|
---|
73 | D ADD^WVLABWPC
|
---|
74 | S ^TMP("WV RPT",$J,WVLINE,0)="Topography: "_$P(X,U,1)
|
---|
75 | S WVSUB4=0
|
---|
76 | F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,1,WVSUB4)) Q:'WVSUB4 D
|
---|
77 | .D ADD^WVLABWPC
|
---|
78 | .S ^TMP("WV RPT",$J,WVLINE,0)=$S(WVSUB4=1:"Disease: ",1:$$REPEAT^XLFSTR(" ",10))_$G(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,1,WVSUB4))
|
---|
79 | .Q
|
---|
80 | D ADD^WVLABWPC
|
---|
81 | S WVSUB4=0
|
---|
82 | F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,2,WVSUB4)) Q:'WVSUB4 D
|
---|
83 | .D ADD^WVLABWPC
|
---|
84 | .S ^TMP("WV RPT",$J,WVLINE,0)="Morphology: "_$G(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,1,WVSUB4))
|
---|
85 | .S WVSUB5=0
|
---|
86 | .F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,2,WVSUB4,2,WVSUB5)) Q:'WVSUB5 D
|
---|
87 | ..D ADD^WVLABWPC
|
---|
88 | ..S ^TMP("WV RPT",$J,WVLINE,0)=$S(WVSUB5=1:"Etiology: ",1:$$REPEAT^XLFSTR(" ",10))_$G(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,2,WVSUB4,1,WVSUB5))
|
---|
89 | ..Q
|
---|
90 | .Q
|
---|
91 | Q
|
---|
92 | WRTP ; Display Procedure values
|
---|
93 | Q:'$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,4,0))
|
---|
94 | D ADD^WVLABWPC
|
---|
95 | S ^TMP("WV RPT",$J,WVLINE,0)="<Procedures>"
|
---|
96 | S WVSUB4=0
|
---|
97 | F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,4,WVSUB4)) Q:WVSUB4 D
|
---|
98 | .D ADD^WVLABWPC
|
---|
99 | .S ^TMP("WV RPT",$J,WVLINE,0)=$P($G(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,4,WVSUB4)),U,1)
|
---|
100 | .Q
|
---|
101 | Q
|
---|