source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7UTL02.m@ 1458

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

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1LA7UTL02 ;HOIFO/BH - Cytopathology Query Utility ; 10/28/03 8:40am
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**69**;Sep 27, 1994
3CYPATH(LRDFN,IEN,RET,ERR) ; Returns data for a Cytopathology Encounter
4 ;
5 ; Input:
6 ;
7 ; LRDFN - Patient Lab DFN (Required)
8 ; IEN - IEN of CY entry (Required)
9 ; RET - Array reference for passing back data (Required)
10 ; ERR - Error array to pass back (Not required)
11 ;
12 ; Output:
13 ;
14 ; '0' - If the API encountered an Error along with @ERR array
15 ;
16 ; '1' - if the API ran successfully and the following data if it exists
17 ;
18 ; Visit Date field .01 and Accession Number field .06 of file 63.09.
19 ; @RET("DEMO",ien of visit)=Visit Date^Accession Number
20 ;
21 ; Specimen field .01 of sub file 63.902.
22 ; @RET("SPEC",ien of Specimen entry)=Specimen Data
23 ;
24 ; Clinical History field .01 of sub file 63.913.
25 ; @RET("CHIS",ien of the Clinical History entry)=Clinical His.
26 ;
27 ; Pre Operative Diagnosis field .01 of sub file 63.914.
28 ; @RET@("PREDX",ien of the Pre. Op. Diagnosis entry)=Pre Op Diag.
29 ;
30 ; Operative Diagnosis field .01 of sub file 63.905.
31 ; @RET@("OPERDX",ien of the Op. Diagnosis entry)=Op Diag.
32 ;
33 ; Post Opertive Diagnosis field .01 of sub file 63.906.
34 ; @RET@("POSTDX,ien of the Post. Op Diagnosis entry)=Pst. Op Diag.
35 ;
36 ; Cytopathology Diagnosis field .01 of sub file 63.903.
37 ; @RET@("CYTODX",ien of the Cytopathology Diagnosis entry)=Cyto Dx
38 ;
39 ; Microscopic Examination field .01 of sub file 63.911.
40 ; @RET@("MICRO",ien of the Microscopic Examination entry)=Micro. Exam
41 ;
42 ; ICD field .01 of sub file 63.901.
43 ; @RET@("ICD9",ien of Cyto ien entry)=ICD9 (external)
44 ;
45 ; ---------------------------------------------------------------------
46 ;
47 K @RET
48 K @ERR
49 I $G(LRDFN)="" D Q 0
50 . I $G(ERR)'="" S @ERR@("-1")="No Lab DFN." Q
51 ;
52 I $G(IEN)="" D Q 0
53 . I $G(ERR)'="" S @ERR@("-1")="No Cytopathology record IEN." Q
54 ;
55 I $G(RET)="" D Q 0
56 . I $G(ERR)'="" S @ERR@("-1")="No results array reference passed." Q
57 ;
58 N QUIT
59 D DEMO
60 I 'QUIT D SPECIMEN
61 I 'QUIT D HISTORY
62 I 'QUIT D PDIAG
63 I 'QUIT D OPDIAG
64 I 'QUIT D POSTDIAG
65 I 'QUIT D CYTOPATH
66 I 'QUIT D MICRO
67 I 'QUIT D ICD
68 I QUIT Q 0
69 Q 1
70 ;
71 ;
72DEMO ; Get basic demographics
73 N VDATE S QUIT=0
74 S VDATE=$$GET1^DIQ(63.09,IEN_","_LRDFN,.01,"I")
75 I VDATE=""!($G(DIERR)) S QUIT=1 Q
76 S ANUM=$$GET1^DIQ(63.09,IEN_","_LRDFN,.06,"I")
77 I $G(DIERR) S QUIT=1 Q
78 S @RET@("DEMO",IEN)=VDATE_"^"_ANUM
79 Q
80 ;
81 ;
82SPECIMEN ;
83 N SPIENS,SPIEN,SPECIMEN S SPIEN="0"
84 F S SPIEN=$O(^LR(LRDFN,"CY",IEN,.1,SPIEN)) Q:'SPIEN!(QUIT) D
85 . Q:QUIT
86 . S SPIENS=SPIEN_","_IEN_","_LRDFN_","
87 . S SPECIMEN=$$GET1^DIQ(63.902,SPIENS,.01,"I")
88 . I $G(DIERR) D Q
89 . . K @RET
90 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Specimen data)."
91 . . S QUIT=1
92 . I SPECIMEN="" Q
93 . S @RET@("SPEC",SPIEN)=SPECIMEN
94 Q
95 ;
96 ;
97HISTORY N CHIENS,CHIEN,HISTORY S CHIEN="0"
98 F S CHIEN=$O(^LR(LRDFN,"CY",IEN,.2,CHIEN)) Q:'CHIEN!(QUIT) D
99 . Q:QUIT
100 . S CHIENS=CHIEN_","_IEN_","_LRDFN_","
101 . S HISTORY=$$GET1^DIQ(63.913,CHIENS,.01,"I")
102 . I $G(DIERR) D Q
103 . . K @RET
104 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Clinical History data)."
105 . . S QUIT=1
106 . I HISTORY="" Q
107 . S @RET@("CHIS",CHIEN)=HISTORY
108 Q
109 ;
110PDIAG N PDIENS,PDIEN,PREOPDX S PDIEN="0"
111 F S PDIEN=$O(^LR(LRDFN,"CY",IEN,.3,PDIEN)) Q:'PDIEN!(QUIT) D
112 . Q:QUIT
113 . S PDIENS=PDIEN_","_IEN_","_LRDFN_","
114 . S PREOPDX=$$GET1^DIQ(63.914,PDIENS,.01,"I")
115 . I $G(DIERR) D Q
116 . . K @RET
117 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Pre Operative Diagnosis data)."
118 . . S QUIT=1
119 . I PREOPDX="" Q
120 . S @RET@("PREDX",PDIEN)=PREOPDX
121 Q
122 ;
123 ;
124OPDIAG N ODIENS,ODIEN,OPERDX S ODIEN="0"
125 F S ODIEN=$O(^LR(LRDFN,"CY",IEN,.4,ODIEN)) Q:'ODIEN!(QUIT) D
126 . Q:QUIT
127 . S ODIENS=ODIEN_","_IEN_","_LRDFN_","
128 . S OPERDX=$$GET1^DIQ(63.905,ODIENS,.01,"I")
129 . I $G(DIERR) D Q
130 . . K @RET
131 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Operative Diagnosis data)."
132 . . S QUIT=1
133 . I OPERDX="" Q
134 . S @RET@("OPERDX",ODIEN)=OPERDX
135 Q
136 ;
137 ;
138POSTDIAG ;
139 N PSDIENS,PSDIEN,POSTDX S PSDIEN="0"
140 F S PSDIEN=$O(^LR(LRDFN,"CY",IEN,.5,PSDIEN)) Q:'PSDIEN!(QUIT) D
141 . Q:QUIT
142 . S PSDIENS=PSDIEN_","_IEN_","_LRDFN_","
143 . S POSTDX=$$GET1^DIQ(63.906,PSDIENS,.01,"I")
144 . I $G(DIERR) D Q
145 . . K @RET
146 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Post Operative Diagnosis data)."
147 . . S QUIT=1
148 . I POSTDX="" Q
149 . S @RET@("POSTDX",PSDIEN)=POSTDX
150 Q
151 ;
152CYTOPATH ; - Cyto Pathology
153 N CYIENS,CYIEN,CYTODX S CYIEN="0"
154 F S CYIEN=$O(^LR(LRDFN,"CY",IEN,1.4,CYIEN)) Q:'CYIEN!(QUIT) D
155 . Q:QUIT
156 . S CYIENS=CYIEN_","_IEN_","_LRDFN_","
157 . S CYTODX=$$GET1^DIQ(63.903,CYIENS,.01,"I")
158 . I $G(DIERR) D Q
159 . . K @RET
160 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Cytopathology diagnosis data)."
161 . . S QUIT=1
162 . I CYTODX="" Q
163 . S @RET@("CYTODX",CYIEN)=CYTODX
164 Q
165 ;
166MICRO ; - Microscopic Exam
167 N MICIENS,MICEXAM,MICIEN S MICIEN="0"
168 F S MICIEN=$O(^LR(LRDFN,"CY",IEN,1.1,MICIEN)) Q:'MICIEN!(QUIT) D
169 . Q:QUIT
170 . S MICIENS=MICIEN_","_IEN_","_LRDFN_","
171 . S MICEXAM=$$GET1^DIQ(63.911,MICIENS,.01,"I")
172 . I $G(DIERR) D Q
173 . . K @RET
174 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Cytopathology Microscopic Examination)"
175 . . S QUIT=1
176 . I MICEXAM="" Q
177 . S @RET@("MICRO",MICIEN)=MICEXAM
178 Q
179 ;
180 ;
181ICD ; - Get ICD Data
182 N ICDIENS,ICDIEN,ICD9 S ICDIEN="0"
183 F S ICDIEN=$O(^LR(LRDFN,"CY",IEN,3,ICDIEN)) Q:'ICDIEN!(QUIT) D
184 . Q:QUIT
185 . S ICDIENS=ICDIEN_","_IEN_","_LRDFN_","
186 . S ICD9=$$GET1^DIQ(63.901,ICDIENS,.01,"E")
187 . I $G(DIERR) D Q
188 . . K @RET
189 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (ICD9 data)."
190 . . S QUIT=1
191 . I ICD9="" Q
192 . S @RET@("ICD9",ICDIEN)=ICD9
193 Q
194 ;
Note: See TracBrowser for help on using the repository browser.