source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVALERTS.m@ 1535

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

initial load of FOIAVistA 6/30/08 version

File size: 6.4 KB
Line 
1WVALERTS ;HIOFO/FT-WV ALERTS APIs ;2/19/04 13:56
2 ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
3 ;
4 ; This routine uses the following IAs:
5 ; #2480 - ^RADPT references (private)
6 ; #2770 - ^GMTSLRPE calls and ^TMP("LRCY" references (private)
7 ; #2771 - ^GMTSLRAE calls and ^TMP("LRA" references (private)
8 ;
9 ; This routine supports the following IAs:
10 ; RESULTS - 4102
11 ;
12 ;
13UPDATE(WVIEN) ; Updates the FILE 790.1 entry identified in WVIEN to
14 ; show it was processed by a Clinical Reminder.
15 ; Input: WVIEN - FILE 790.1 IEN
16 ; Output: <none>
17 Q:'$G(WVIEN)
18 N WVDXFLAG,WVERR,WVFAC,WVFDA
19 I '$D(^WV(790.1,WVIEN,0)) Q
20 ; Check 'update results/dx?' parameter
21 S WVFAC=+$P($G(^WV(790.1,+WVIEN,0)),U,10)
22 S WVDXFLAG=$P($G(^WV(790.02,+WVFAC,0)),U,11)
23 Q:'WVDXFLAG
24 S WVFDA(790.1,WVIEN_",",.16)=1
25 D FILE^DIE("","WVFDA","WVERR")
26 Q
27RESULTS(RESULT,WVIEN) ; Returns limited amount of information from the
28 ; WV PROCEDURE file (790.1) for the IEN selected.
29 ; Input: RESULT - Array name to return data in.
30 ; WVIEN - FILE 790.1 IEN
31 ;
32 ; Output: RESULT(0)
33 ; where: RESULT(0)=FILE 790.1 IEN^DFN^"Pap Smear" OR "Mammogram" OR
34 ; "Breast Ultrasound"^Date/Time
35 ;
36 N WVDX,WVDATE,WVDFN,WVLIST,WVNODE,WVPROC,WVPTYPE,WVYES
37 I +$G(WVIEN)'>0 S RESULT(0)="-1^^IEN not defined." G EXIT
38 S WVNODE=$G(^WV(790.1,WVIEN,0))
39 I WVNODE="" S RESULT(0)="-1^^No unprocessed procedure results in WH package." G EXIT
40 S WVDFN=$P(WVNODE,U,2)
41 S WVPTYPE=$E($P(WVNODE,U,1),1,2)
42 S WVYES=$S(WVPTYPE="PS":1,WVPTYPE="MS":1,WVPTYPE="MB":1,WVPTYPE="MU":1,WVPTYPE="BU":1,1:0)
43 I WVYES=0 S RESULT(0)="-1^"_WVDFN_"^Wrong procedure type." G EXIT
44 S WVPTYPE=$S(WVPTYPE="PS":"P",WVPTYPE="BU":"U",1:"M")
45 S WVDATE=$P(WVNODE,U,12)
46 S RESULT(0)=WVIEN_U_WVDFN_U_$S(WVPTYPE="U":"Breast Ultrasound",WVPTYPE="P":"Pap Smear",1:"Mammogram")_U_WVDATE
47 ; process mam or bu
48 I WVPTYPE="M"!(WVPTYPE="U") D G EXIT
49 .S (WVDX,WVLIST,WVPROC)=""
50 .D RAD
51 .; add rad procedure name^primary diagnosis^modifier 1~modifier n
52 .S RESULT(0)=RESULT(0)_U_WVPROC_U_WVDX_U_WVLIST
53 .Q
54 ; pap smear
55 N LRDFN,LRSS,WVCOLLDT,WVLABACC,WVLACCN,WVNODE2,WVSPEC
56 S WVNODE=$G(^WV(790.1,+WVIEN,0))
57 Q:WVNODE=""
58 S WVNODE2=$G(^WV(790.1,+WVIEN,2))
59 Q:WVNODE2=""
60 S WVLABACC=$P(WVNODE2,U,17) ;lab accession number (e.g., CY 99 1)
61 Q:WVLABACC=""
62 S WVDATE=$P(WVNODE2,U,19) ;lab accession date (reverse date/time)
63 Q:'WVDATE
64 S LRDFN=$P(WVNODE2,U,18) ;lab patient ien
65 Q:'LRDFN
66 S LRSS=$P(WVNODE2,U,20) ;lab patient subscript
67 Q:LRSS=""
68 S (WVCOLLDT,WVLACCN,WVSPEC)=""
69 D HS
70 ; add collection date^lab accession#^specimen
71 S RESULT(0)=RESULT(0)_"^^^^"_WVCOLLDT_U_WVLACCN_U_WVSPEC
72EXIT ;
73 Q
74HS ; Health Summary variable setup
75 N GMTS1,GMTS2,MAX
76 S GMTS1=WVDATE-1,GMTS2=WVDATE+1,MAX=100
77 I LRSS="CY" D CY ;cytology
78 I LRSS="SP" D SP ;surgical pathology
79 K ^TMP("LRA",$J),^TMP("LRCY",$J)
80 Q
81CY ; Call Health Summary extract routine GMTSLRPE to get cytology data.
82 ; Input: LRDFN - FILE 63 ien
83 ; GMTS1 - reverse start date/time (most recent date)
84 ; GMTS2 - reverse end date/time (least recent date)
85 ; MAX - maximum # of occurrences to return
86 ; Returns ^TMP("LRCY",$J)
87 K ^TMP("LRCY",$J)
88 I $T(XTRCT^GMTSLRPE)']"" Q ;HS routine doesn't exist
89 D XTRCT^GMTSLRPE
90 Q:'$D(^TMP("LRCY",$J))
91 D WEEDCY
92 Q:'$D(^TMP("LRCY",$J))
93 D CYTO ;move data from HS array to WH array
94 Q
95WEEDCY ; Weed out reports, save only report for lab accession number
96 ; associated with this WH entry.
97 N WVLOOP
98 S WVLOOP=0
99 F S WVLOOP=$O(^TMP("LRCY",$J,WVLOOP)) Q:'WVLOOP D
100 .I $P($G(^TMP("LRCY",$J,WVLOOP,0)),U,2)'=WVLABACC D
101 ..K ^TMP("LRCY",$J,WVLOOP)
102 ..Q
103 .Q
104 Q
105CYTO ; Move data from ^TMP("LRCY",$J) to RESULT for display.
106 Q:'$D(^TMP("LRCY",$J))
107 N WVTMP
108 S WVDATE=$O(^TMP("LRCY",$J,0)) Q:'WVDATE
109 S WVTMP=$G(^TMP("LRCY",$J,WVDATE,0))
110 S WVCOLLDT=$P(WVTMP,U,1) ;collection date
111 S WVLACCN=$P(WVTMP,U,2) ;accession #
112 S WVTMP=$G(^TMP("LRCY",$J,WVDATE,1,1))
113 S WVSPEC=$P(WVTMP,U,1) ;specimen
114 Q
115SP ; Call Health Summary extract routine GMTSLRAE to get surgical
116 ; pathology data.
117 ; Input: LRDFN - FILE 63 ien
118 ; GMTS1 - reverse start date/time (most recent date)
119 ; GMTS2 - reverse end date/time (least recent date)
120 ; MAX - maximum # of occurrences to return
121 ; Returns ^TMP("LRA",$J)
122 K ^TMP("LRA",$J)
123 I $T(XTRCT^GMTSLRAE)']"" Q ;HS routine doesn't exist
124 D XTRCT^GMTSLRAE
125 Q:'$D(^TMP("LRA",$J))
126 D WEEDSP
127 Q:'$D(^TMP("LRA",$J))
128 D PATH ;move data from HS array to WH array
129 Q
130WEEDSP ; Weed out reports, save only report for lab accession number
131 ; associated with this WH entry.
132 N WVLOOP
133 S WVLOOP=0
134 F S WVLOOP=$O(^TMP("LRA",$J,WVLOOP)) Q:'WVLOOP D
135 .I $P($G(^TMP("LRA",$J,WVLOOP,0)),U,2)'=WVLABACC D
136 ..K ^TMP("LRA",$J,WVLOOP)
137 ..Q
138 .Q
139 Q
140PATH ; Move data from ^TMP("LRA",$J) to RESULT for display
141 Q:'$D(^TMP("LRA",$J))
142 N WVNODE,WVDATE,WVSUB2,WVSUB4,X,Y
143 S WVDATE=0
144 F S WVDATE=$O(^TMP("LRA",$J,WVDATE)) Q:'WVDATE D
145 .S WVSUB2=""
146 .S WVSUB2=$O(^TMP("LRA",$J,WVDATE,WVSUB2))
147 .Q:WVSUB2=""!(WVSUB2?1A)
148 .S WVNODE=$G(^TMP("LRA",$J,WVDATE,WVSUB2))
149 .D ACCESSN
150 .Q
151 Q
152ACCESSN ; Collection date & Lab Accession#
153 I WVSUB2=0 D
154 .S WVCOLLDT=$P(WVNODE,U,1) ;collection date
155 .S WVLACCN=$P(WVNODE,U,2) ;accession #
156 .Q
157 Q
158SPEC ; Specimen list
159 S WVSUB4=$O(^TMP("LRA",$J,WVDATE,.1,0))
160 S WVSPEC=$G(^TMP("LRA",$J,WVDATE,.1,WVSUB4))
161 Q
162 ;
163RAD ; get radiology report data
164 N LOOP,WVDUP,WVERR,WVIENS,WVJCN,WVJCN1,WVLCNT,WVMOD,WVMODS
165 N WVRADCSE,WVRADDFN,WVRADDTE,WVRADIEN,WVRPTIEN
166 S WVRADIEN=$P(^WV(790.1,WVIEN,0),U,15)
167 Q:WVRADIEN="" ;no 'radiology mam case #'
168 S WVRADDFN=$P(^WV(790.1,WVIEN,0),U,2)
169 Q:'WVRADDFN ;no dfn
170 S WVRADDTE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,0))
171 Q:'WVRADDTE ;no inverse exam date
172 S WVRADCSE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,WVRADDTE,0))
173 Q:'WVRADCSE ;no case number
174 S WVRPTIEN=+$P(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0),U,17)
175 Q:'WVRPTIEN ;no report in File 74
176 K ^TMP($J,"WV RPT")
177 S WVIENS=WVRADCSE_","_WVRADDTE_","_WVRADDFN_"," ;iens for FILE 70 entry
178 D GETS^DIQ(70.03,WVIENS,"125*","EI","WVMODS","WVERR")
179 ; get data from FILE 74
180 K WVERR
181 D GETS^DIQ(74,WVRPTIEN_",","*","EI","^TMP($J,""WV RPT"")","WVERR")
182 S WVPROC=^TMP($J,"WV RPT",74,WVRPTIEN_",",102,"E")
183 S WVDX=^TMP($J,"WV RPT",74,WVRPTIEN_",",113,"E")
184 ; get procedure modifiers
185 S (LOOP,WVLIST)=""
186 F S LOOP=$O(WVMODS(70.1,LOOP)) Q:LOOP="" D
187 .S WVMOD=$G(WVMODS(70.1,LOOP,.01,"E"))
188 .Q:WVMOD=""
189 .S WVLIST=WVLIST_"~"_WVMOD
190 .Q
191 I $E(WVLIST)="~" S WVLIST=$E(WVLIST,2,$L(WVLIST))
192 K ^TMP($J,"WV RPT")
193 Q
Note: See TracBrowser for help on using the repository browser.