source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVALERTP.m

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1WVALERTP ;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 ;
9EN ; 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
21ACCESSN ; 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
38SPEC ; 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
48TEXT ; 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
58SUPRPT ; 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
72WRTTM ; 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
92WRTP ; 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
Note: See TracBrowser for help on using the repository browser.