1 | WVALERTS ;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 | ;
|
---|
13 | UPDATE(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
|
---|
27 | RESULTS(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
|
---|
72 | EXIT ;
|
---|
73 | Q
|
---|
74 | HS ; 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
|
---|
81 | CY ; 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
|
---|
95 | WEEDCY ; 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
|
---|
105 | CYTO ; 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
|
---|
115 | SP ; 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
|
---|
130 | WEEDSP ; 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
|
---|
140 | PATH ; 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
|
---|
152 | ACCESSN ; 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
|
---|
158 | SPEC ; 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 | ;
|
---|
163 | RAD ; 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
|
---|