source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVALERTF.m@ 724

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1WVALERTF ;HIOFO/FT-WV APIs ;9/29/04 14:29
2 ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
3 ;
4 ; This routine uses the following IAs:
5 ; #2770 - ^GMTSLRPE calls and ^TMP("LRCY" references (controlled)
6 ; #2771 - ^GMTSLRAE calls and ^TMP("LRA" references (controlled)
7 ;
8 ; This routine supports the following IAs:
9 ; RESULTS - 4106
10 ;
11 ;
12RESULTS(RESULT,WVIEN) ; Returns the most recent unprocessed entry
13 ; from the WV PROCEDURE file (790.1) for the procedure type selected.
14 ; Input: RESULT - Array name to return data in.
15 ; WVIEN - FILE 790.1 IEN
16 ;
17 ; Output: RESULT=^TMP("WV RPT",$J)
18 ; where: ^TMP("WV RPT",$J,n,0)=report text
19 ;
20 N WVDATE,WVDFN,WVFLAG,WVMSG,WVNODE,WVPTYPE,WVX,X,Y
21 K ^TMP("WV RPT",$J)
22 S WVFLAG=0,WVMSG=""
23 I '+$G(WVIEN) S ^TMP("WV RPT",$J,1,0)="-1^^Entry not defined." G EXIT
24 I $G(WVIEN)>0 D
25 .S WVIEN=+WVIEN
26 .S WVNODE=$G(^WV(790.1,WVIEN,0))
27 .I WVNODE="" S WVMSG="Entry not found.",WVFLAG=1 Q
28 .S WVDFN=$P(WVNODE,U,2)
29 .S WVDATE=$P(WVNODE,U,12)
30 .S WVX=$E($P(WVNODE,U,1),1,2) ;WH accession prefix
31 .S WVPTYPE=$S(WVX="MB":"M",WVX="MU":"M",WVX="MS":"M",WVX="BU":"U",WVX="PS":"P",1:"")
32 .I WVPTYPE="" S WVFLAG=1,WVMSG="Entry is not a pap smear, mammogram or breast ultrasound" Q
33 .I WVPTYPE="M",$P(WVNODE,U,15)="" S WVFLAG=1,WVMSG="No link to a Radiology report"
34 .I WVPTYPE="U",$P(WVNODE,U,15)="" S WVFLAG=1,WVMSG="No link to a Radiology report"
35 .I WVPTYPE="P",$P($G(^WV(790.1,WVIEN,2)),U,17)="" S WVFLAG=1,WVMSG="No link to a Lab report"
36 .Q
37 I WVFLAG D G EXIT
38 .S ^TMP("WV RPT",$J,1,0)="-1^^"_WVMSG
39 .Q
40 I WVPTYPE="M"!(WVPTYPE="U") D EN^WVALERTR G EXIT ;mammogram/ultrasound
41 ;handle pap smear
42 N LRDFN,LRSS,WVLABACC,WVNODE2
43 S WVNODE=$G(^WV(790.1,WVIEN,0))
44 Q:WVNODE=""
45 S WVNODE2=$G(^WV(790.1,WVIEN,2))
46 Q:WVNODE2=""
47 S WVLABACC=$P(WVNODE2,U,17) ;lab accession number (e.g., CY 99 1)
48 Q:WVLABACC=""
49 S WVDATE=$P(WVNODE2,U,19) ;lab accession date (reverse date/time)
50 Q:'WVDATE
51 S LRDFN=$P(WVNODE2,U,18) ;lab patient ien
52 Q:'LRDFN
53 S LRSS=$P(WVNODE2,U,20) ;lab patient subscript
54 Q:LRSS=""
55 D HS
56EXIT ; set RESULT equal to TMP global reference
57 S RESULT=$NA(^TMP("WV RPT",$J))
58 Q
59HS ; Health Summary variable setup
60 N GMTS1,GMTS2,MAX
61 S GMTS1=WVDATE-1,GMTS2=WVDATE+1,MAX=100
62 I LRSS="CY" D CY ;cytology
63 I LRSS="SP" D SP ;surgical pathology
64 K ^TMP("LRA",$J),^TMP("LRCY",$J)
65 Q
66CY ; Call Health Summary extract routine GMTSLRPE to get cytology data.
67 ; Input: LRDFN - FILE 63 ien
68 ; GMTS1 - reverse start date/time (most recent date)
69 ; GMTS2 - reverse end date/time (least recent date)
70 ; MAX - maximum # of occurrences to return
71 ; Returns ^TMP("LRCY",$J)
72 K ^TMP("LRCY",$J)
73 I $T(XTRCT^GMTSLRPE)']"" Q ;HS routine doesn't exist
74 D XTRCT^GMTSLRPE
75 Q:'$D(^TMP("LRCY",$J))
76 D WEEDCY
77 Q:'$D(^TMP("LRCY",$J))
78 D ^WVALERTC ;move data from HS array to WH array
79 Q
80WEEDCY ; Weed out reports, save only report for lab accession number
81 ; associated with this WH entry.
82 N WVLOOP
83 S WVLOOP=0
84 F S WVLOOP=$O(^TMP("LRCY",$J,WVLOOP)) Q:'WVLOOP D
85 .I $P($G(^TMP("LRCY",$J,WVLOOP,0)),U,2)'=WVLABACC D
86 ..K ^TMP("LRCY",$J,WVLOOP)
87 ..Q
88 .Q
89 Q
90SP ; Call Health Summary extract routine GMTSLRAE to get surgical
91 ; pathology data.
92 ; Input: LRDFN - FILE 63 ien
93 ; GMTS1 - reverse start date/time (most recent date)
94 ; GMTS2 - reverse end date/time (least recent date)
95 ; MAX - maximum # of occurrences to return
96 ; Returns ^TMP("LRA",$J)
97 K ^TMP("LRA",$J)
98 I $T(XTRCT^GMTSLRAE)']"" Q ;HS routine doesn't exist
99 D XTRCT^GMTSLRAE
100 Q:'$D(^TMP("LRA",$J))
101 D WEEDSP
102 Q:'$D(^TMP("LRA",$J))
103 D ^WVALERTP ;move data from HS array to WH array
104 Q
105WEEDSP ; Weed out reports, save only report for lab accession number
106 ; associated with this WH entry.
107 N WVLOOP
108 S WVLOOP=0
109 F S WVLOOP=$O(^TMP("LRA",$J,WVLOOP)) Q:'WVLOOP D
110 .I $P($G(^TMP("LRA",$J,WVLOOP,0)),U,2)'=WVLABACC D
111 ..K ^TMP("LRA",$J,WVLOOP)
112 ..Q
113 .Q
114 Q
Note: See TracBrowser for help on using the repository browser.