source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVLABWPC.m@ 1361

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

initial load of WorldVistAEHR

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