source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVLABWPS.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1WVLABWPS ;HCIOFO/FT-Display Surgical Pathology Data from Lab Package ;3/4/99 15:00
2 ;;1.0;WOMEN'S HEALTH;**6**;Sep 30, 1998
3 ;
4EN ; Move data from ^TMP("LRA",$J) to ^TMP("WVLAB",$J) for display
5 ; Called from WVLABWP and WVPROC
6 Q:'$D(^TMP("LRA",$J))
7 N WVLINE,WVNODE,WVDATE,WVRPTDT,WVSUB2,WVSUB3,WVSUB4,WVSUB5,WVTEXT,X
8 K ^TMP("WVLAB",$J)
9 S (WVDATE,WVLINE)=0
10 F S WVDATE=$O(^TMP("LRA",$J,WVDATE)) Q:'WVDATE D
11 .S WVSUB2=""
12 .F S WVSUB2=$O(^TMP("LRA",$J,WVDATE,WVSUB2)) Q:WVSUB2=""!(WVSUB2?1A) S WVNODE=$G(^TMP("LRA",$J,WVDATE,WVSUB2)) D ACCESSN
13 .I $D(^TMP("LRA",$J,WVDATE,1.2)) D SUPRPT
14 .Q
15 ; NOTE: Calling routine should kill ^TMP("LRA",$J)
16 Q
17ACCESSN ; Collection date & Lab Accession#
18 I WVSUB2=0 D
19 .D ADD^WVLABWPC
20 .S ^TMP("WVLAB",$J,WVLINE,0)=" Collected: "_$P(WVNODE,U,1)
21 .D ADD^WVLABWPC
22 .S ^TMP("WVLAB",$J,WVLINE,0)="Lab Accession #: "_$P(WVNODE,U,2)
23 .Q
24 I WVSUB2=.1 D SPEC Q
25 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
26 I WVSUB2=2 D
27 .S WVSUB3=0
28 .F S WVSUB3=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3)) Q:WVSUB3'>0 D
29 ..S X=^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3)
30 ..D WRTTM,WRTP
31 ..Q
32 .Q
33 Q
34SPEC ; Specimen list
35 S WVSUB4=$O(^TMP("LRA",$J,WVDATE,.1,0))
36 D ADD^WVLABWPC
37 S ^TMP("WVLAB",$J,WVLINE,0)="Specimen: "_$G(^TMP("LRA",$J,WVDATE,.1,WVSUB4))
38 F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,.1,WVSUB4)) Q:'WVSUB4 D
39 .D ADD^WVLABWPC
40 .S ^TMP("WVLAB",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",10)_$G(^TMP("LRA",$J,WVDATE,.1,WVSUB4))
41 .Q
42 D ADD^WVLABWPC,BLANK^WVLABWPC
43 Q
44TEXT ; Gross Description & Microscopic Exam/Dx
45 D ADD^WVLABWPC
46 S ^TMP("WVLAB",$J,WVLINE,0)="<"_WVNODE_">"
47 S WVSUB4=0
48 F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB4)) Q:'WVSUB4 D
49 .S WVTEXT=^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB4)
50 .D ADD^WVLABWPC
51 .S ^TMP("WVLAB",$J,WVLINE,0)=WVTEXT
52 .Q
53 Q
54SUPRPT ; Supplementary Report
55 S WVSUB2=0
56 F S WVSUB2=$O(^TMP("LRA",$J,WVDATE,1.2,WVSUB2)) Q:'WVSUB2 D
57 .S WVRPTDT=$G(^TMP("LRA",$J,WVDATE,1.2,WVSUB2,0))
58 .S WVRPTDT=$$FMTE^XLFDT(WVRPTDT,"2P")
59 .D ADD^WVLABWPC
60 .S ^TMP("WVLAB",$J,WVLINE,0)="Supplementary Report: "_WVRPTDT
61 .S WVSUB3=0
62 .F S WVSUB3=$O(^TMP("LRA",$J,WVDATE,1.2,WVSUB2,WVSUB3)) Q:'WVSUB3 D
63 ..D ADD^WVLABWPC
64 ..S ^TMP("WVLAB",$J,WVLINE,0)=$G(^TMP("LRA",$J,WVDATE,1.2,WVSUB2,WVSUB3))
65 ..Q
66 .Q
67 Q
68WRTTM ; Display Topography, Disease, Morphology and Etiology values
69 D ADD^WVLABWPC
70 S ^TMP("WVLAB",$J,WVLINE,0)="Topography: "_$P(X,U,1)
71 S WVSUB4=0
72 F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,1,WVSUB4)) Q:'WVSUB4 D
73 .D ADD^WVLABWPC
74 .S ^TMP("WVLAB",$J,WVLINE,0)=$S(WVSUB4=1:"Disease: ",1:$$REPEAT^XLFSTR(" ",10))_$G(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,1,WVSUB4))
75 .Q
76 D ADD^WVLABWPC
77 S WVSUB4=0
78 F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,2,WVSUB4)) Q:'WVSUB4 D
79 .D ADD^WVLABWPC
80 .S ^TMP("WVLAB",$J,WVLINE,0)="Morphology: "_$G(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,1,WVSUB4))
81 .S WVSUB5=0
82 .F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,2,WVSUB4,2,WVSUB5)) Q:'WVSUB5 D
83 ..D ADD^WVLABWPC
84 ..S ^TMP("WVLAB",$J,WVLINE,0)=$S(WVSUB5=1:"Etiology: ",1:$$REPEAT^XLFSTR(" ",10))_$G(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,2,WVSUB4,1,WVSUB5))
85 ..Q
86 .Q
87 Q
88WRTP ; Display Procedure values
89 Q:'$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,4,0))
90 D ADD^WVLABWPC
91 S ^TMP("WVLAB",$J,WVLINE,0)="<Procedures>"
92 S WVSUB4=0
93 F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,4,WVSUB4)) Q:WVSUB4 D
94 .D ADD^WVLABWPC
95 .S ^TMP("WVLAB",$J,WVLINE,0)=$P($G(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,4,WVSUB4)),U,1)
96 .Q
97 Q
Note: See TracBrowser for help on using the repository browser.