source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVALERTC.m@ 1704

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1WVALERTC ;HCIOFO/FT-Display Report Data from Lab Package ;9/29/04 14:28
2 ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
3 ;
4 ; This routine uses the following IAs:
5 ; #2770 - ^TMP("LRCY",$J) references (controlled)
6 ; #10103 - ^XLFDT calls (supported)
7 ; #10104 - ^XLFSTR calls (supported)
8 ;
9EN ; Move data from ^TMP("LRCY",$J) to ^TMP("WV RPT",$J) for display.
10 ; Called from WVLABWP and WVPROC
11 Q:'$D(^TMP("LRCY",$J))
12 N WVDATE,WVLINE,WVNODE,WVRPTDT,WVSUB2,WVSUB3,WVSUB4,WVTMP
13 S WVDATE=$O(^TMP("LRCY",$J,0)) Q:'WVDATE
14 S WVTMP=$G(^TMP("LRCY",$J,WVDATE,0))
15 S WVLINE=0
16 D ADD
17 S ^TMP("WV RPT",$J,WVLINE,0)=" Collected: "_$P(WVTMP,U,1)
18 D ADD
19 S ^TMP("WV RPT",$J,WVLINE,0)="Lab Accession #: "_$P(WVTMP,U,2)
20 D ADD
21 S WVTMP=$G(^TMP("LRCY",$J,WVDATE,1))
22 S ^TMP("WV RPT",$J,WVLINE,0)=" Specimen: "_$P(WVTMP,U,1)
23 S WVSUB2=0
24 F S WVSUB2=$O(^TMP("LRCY",$J,WVDATE,1,WVSUB2)) Q:'WVSUB2 D
25 .D ADD
26 .S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",17)_^TMP("LRCY",$J,WVDATE,1,WVSUB2)
27 .Q
28 D ADD,BLANK
29 I $P(WVTMP,U,2)'>0 D Q
30 .D ADD
31 .S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",18)_"** REPORT NOT YET RELEASED **"
32 .Q
33 S WVSUB2=1
34 F S WVSUB2=$O(^TMP("LRCY",$J,WVDATE,WVSUB2)) Q:WVSUB2="" D
35 .D @$E(WVSUB2,1,2)
36 .Q
37 ; NOTE: Calling routine should kill ^TMP("LRCY",$J)
38 Q
39AH ; Clinical History
40 D ADD
41 S ^TMP("WV RPT",$J,WVLINE,0)="<Brief Clinical Hx>"
42 S WVSUB3=0
43 F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:'WVSUB3 D
44 .D ADD
45 .S ^TMP("WV RPT",$J,WVLINE,0)=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
46 .Q
47 D ADD,BLANK
48 Q
49G ; Gross Description
50 D ADD
51 S ^TMP("WV RPT",$J,WVLINE,0)="<Gross Description>"
52 S WVSUB3=0
53 F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:'WVSUB3 D
54 .D ADD
55 .S ^TMP("WV RPT",$J,WVLINE,0)=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
56 .Q
57 D ADD,BLANK
58 Q
59MI ; Microscopic exam/diagnosis field
60 D ADD
61 S ^TMP("WV RPT",$J,WVLINE,0)="<Microscopic Exam>"
62 S WVSUB3=0
63 F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:'WVSUB3 D
64 .D ADD
65 .S ^TMP("WV RPT",$J,WVLINE,0)=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
66 .Q
67 D ADD,BLANK
68 Q
69ND ; Cytopathology Dx
70 D ADD
71 S ^TMP("WV RPT",$J,WVLINE,0)="<Cytopathology Dx>"
72 S WVSUB3=0
73 F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:'WVSUB3 D
74 .D ADD
75 .S ^TMP("WV RPT",$J,WVLINE,0)=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
76 .Q
77 D ADD,BLANK
78 Q
79OT ; Topography
80 D ADD
81 S WVSUB3=0
82 S ^TMP("WV RPT",$J,WVLINE,0)="Topography: "_$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
83 F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:WVSUB3="" D @$E(WVSUB3,1)
84 Q
85D ; Disease
86 D ADD
87 S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",8)_$S(WVSUB3="D1":"Diseases: ",1:$$REPEAT^XLFSTR(" ",10))_$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
88 Q
89M ; Morphology
90 D ADD
91 S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",8)_$P($G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)),U,1)
92 S WVSUB4=""
93 F S WVSUB4=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3,WVSUB4)) Q:WVSUB4="" D
94 .D ADD
95 .S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",8)_$S(WVSUB4=1:"Diseases: ",1:$$REPEAT^XLFSTR(" ",10))_$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3,WVSUB4))
96 .Q
97 Q
98P ; Procedure
99 D ADD
100 S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",7)_$S(WVSUB3="P1":"Procedures: ",1:$$REPEAT^XLFSTR(" ",12))_$P($G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)),U,1)
101 Q
102SR ; Supplementary Report
103 S WVSUB3=0
104 F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:'WVSUB3 D
105 .S WVRPTDT=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3,0))
106 .S WVRPTDT=$$FMTE^XLFDT(WVRPTDT,"2P")
107 .D ADD
108 .S ^TMP("WV RPT",$J,WVLINE,0)="Supplementary Rpt: "_WVRPTDT
109 .S WVSUB4=0
110 .F S WVSUB4=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3,WVSUB4)) Q:'WVSUB4 D
111 ..S WVNODE=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3,WVSUB4))
112 ..D ADD
113 ..S ^TMP("WV RPT",$J,WVLINE,0)=WVNODE
114 ..Q
115 .Q
116 Q
117XI ; ICD Diagnoses
118 D ADD
119 S ^TMP("WV RPT",$J,WVLINE,0)="<ICD-9 Diagnoses>"
120 S WVSUB3=0
121 F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:'WVSUB3 D
122 .D ADD
123 .S WVTMP=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
124 .S ^TMP("WV RPT",$J,WVLINE,0)=$P(WVTMP,U,1)_" "_$P(WVTMP,U,2)
125 .Q
126 Q
127ADD ; Bump up line counter
128 S WVLINE=WVLINE+1
129 Q
130BLANK ; Add a blank line
131 S ^TMP("WV RPT",$J,WVLINE,0)=" "
132 Q
Note: See TracBrowser for help on using the repository browser.