source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVALERTR.m@ 1420

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1WVALERTR ;HIOFO/FT-RETURN RADIOLOGY/NM REPORT IN TMP GLOBAL ;1/2/04 11:09
2 ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
3 ;
4 ; This routine uses the following IAs:
5 ; #2479 - FILE 74 fields (private)
6 ; #2480 - FILE 70 fields (private)
7 ;
8EN ; Set up radiology report data
9 N LOOP,WVDUP,WVERR,WVIENS,WVJCN,WVJCN1,WVLCNT,WVRADCSE,WVRADDFN
10 N WVRADDTE,WVRADIEN,WVRPTIEN
11 S WVRADIEN=$P(^WV(790.1,WVIEN,0),U,15)
12 Q:WVRADIEN="" ;no 'radiology mam case #'
13 S WVRADDFN=$P(^WV(790.1,WVIEN,0),U,2)
14 Q:'WVRADDFN ;no dfn
15 S WVRADDTE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,0))
16 Q:'WVRADDTE ;no inverse exam date
17 S WVRADCSE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,WVRADDTE,0))
18 Q:'WVRADCSE ;no case number
19 S WVRPTIEN=+$P(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0),U,17)
20 Q:'WVRPTIEN ;no report in File 74
21 K ^TMP($J,"WV RPT"),^TMP($J,"WV CH")
22 S WVIENS=WVRADCSE_","_WVRADDTE_","_WVRADDFN_"," ;iens for FILE 70 entry
23 ; get clincal history from FILE 70
24 D GETS^DIQ(70.03,WVIENS,400,"EIZ","^TMP($J,""WV CH"")","WVERR")
25 ; get data from FILE 74
26 K WVERR
27 D GETS^DIQ(74,WVRPTIEN_",","*","EI","^TMP($J,""WV RPT"")","WVERR")
28 S ^TMP("WV RPT",$J,1,0)=" DAY-CASE #: "_$G(^TMP($J,"WV RPT",74,WVRPTIEN_",",.01,"E"))_$S($$AMEND(WVRPTIEN):" (AMENDED REPORT)",1:"")
29 S ^TMP("WV RPT",$J,2,0)=" EXAM DATE/TIME: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",3,"E")
30 S ^TMP("WV RPT",$J,3,0)=" VERIFYING PHYSICIAN: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",9,"E")
31 S ^TMP("WV RPT",$J,4,0)=" PROCEDURE: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",102,"E")
32 S ^TMP("WV RPT",$J,5,0)=" CATEGORY OF EXAM: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",104,"E")
33 S ^TMP("WV RPT",$J,6,0)=" WARD: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",106,"E")
34 S ^TMP("WV RPT",$J,7,0)=" TREATING SERVICE (INPATIENT): "_^TMP($J,"WV RPT",74,WVRPTIEN_",",107,"E")
35 S ^TMP("WV RPT",$J,8,0)=" PRINCIPAL CLINIC: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",108,"E")
36 S ^TMP("WV RPT",$J,9,0)=" CONTRACT SHARING SOURCE: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",109,"E")
37 S ^TMP("WV RPT",$J,10,0)="PRIMARY INTERPRETING RESIDENT: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",112,"E")
38 S ^TMP("WV RPT",$J,11,0)=" PRIMARY INTERPRETING STAFF: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",115,"E")
39 S ^TMP("WV RPT",$J,12,0)=" PRIMARY DIAGNOSIS: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",113,"E")
40 S ^TMP("WV RPT",$J,13,0)=" REQUESTING PHYSICIAN: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",114,"E")
41 S ^TMP("WV RPT",$J,14,0)=" COMPLICATION: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",116,"E")
42 S ^TMP("WV RPT",$J,15,0)=" "
43 S ^TMP("WV RPT",$J,16,0)="CLINICAL HISTORY:"
44 S LOOP=0,WVLCNT=16
45 S WVDUP=$$COMPARE()
46 I WVDUP=1 D ;Clinical History text in files 70 & 74 are different
47 .S LOOP=0
48 .F S LOOP=$O(^TMP($J,"WV CH",70.03,WVIENS,400,LOOP)) Q:'LOOP D
49 ..S WVLCNT=WVLCNT+1
50 ..S ^TMP("WV RPT",$J,WVLCNT,0)=^TMP($J,"WV CH",70.03,WVIENS,400,LOOP,0)
51 ..Q
52 .I WVLCNT>16 D ;insert blank line if different texts exist
53 ..S WVLCNT=WVLCNT+1
54 ..S ^TMP("WV RPT",$J,WVLCNT,0)=" "
55 ..Q
56 .S LOOP=0
57 .F S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)) Q:'LOOP D
58 ..S WVLCNT=WVLCNT+1
59 ..S ^TMP("WV RPT",$J,WVLCNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)
60 ..Q
61 .Q
62 I WVDUP=0 D ;Clinical History field is same
63 .S LOOP=0
64 .F S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)) Q:'LOOP D
65 ..S WVLCNT=WVLCNT+1
66 ..S ^TMP("WV RPT",$J,WVLCNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)
67 ..Q
68 .Q
69 S WVLCNT=WVLCNT+1
70 S ^TMP("WV RPT",$J,WVLCNT,0)=" "
71 S WVLCNT=WVLCNT+1
72 S ^TMP("WV RPT",$J,WVLCNT,0)="IMPRESSION TEXT:"
73 S LOOP=0
74 F S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",300,LOOP)) Q:'LOOP D
75 .S WVLCNT=WVLCNT+1
76 .S ^TMP("WV RPT",$J,WVLCNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",300,LOOP)
77 .Q
78 S WVLCNT=WVLCNT+1
79 S ^TMP("WV RPT",$J,WVLCNT,0)=" "
80 S WVLCNT=WVLCNT+1
81 S ^TMP("WV RPT",$J,WVLCNT,0)="REPORT TEXT:"
82 S LOOP=0
83 F S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",200,LOOP)) Q:'LOOP D
84 .S WVLCNT=WVLCNT+1
85 .S ^TMP("WV RPT",$J,WVLCNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",200,LOOP)
86 .Q
87 K ^TMP($J,"WV RPT"),^TMP($J,"WV CH")
88 Q
89AMEND(WVRPTIEN) ; Check if RAD/NM report is amended.
90 ; WVRPTIEN - File 74 ien
91 N WVAMEND
92 K ^TMP("DILIST",$J),^TMP("DIERR",$J)
93 D LIST^DIC(74.06,","_WVRPTIEN_",",.01)
94 S WVAMEND=$O(^TMP("DILIST",$J,0))
95 K ^TMP("DILIST",$J),^TMP("DIERR",$J)
96 Q WVAMEND
97 ;
98COMPARE() ; Compares Clincal History fields in files 70 & 74
99 ; Returns 1 (different) or 0 (same)
100 N LOOP,WVFLAG,WV70CNT,WV70IEN,WV74CNT,WV74IEN,WVNODE70,WVNODE74
101 S (LOOP,WV70CNT,WV74CNT,WVFLAG)=0
102 S WV70IEN=WVIENS,WV74IEN=WVRPTIEN_","
103 I '$O(^TMP($J,"WV CH",70.03,WV70IEN,400,0)) S WVFLAG=WVFLAG+1
104 I '$O(^TMP($J,"WV RPT",74,WV74IEN,400,0)) S WVFLAG=WVFLAG+1
105 I WVFLAG=1 Q 1 ;different (field was purged in one file, exists in
106 ; the other file)
107 I WVFLAG=2 Q 0 ;same (field was purged in 70 & 74)
108 F S LOOP=$O(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP)) Q:'LOOP D
109 .S WV70CNT=WV70CNT+1
110 .Q
111 S LOOP=0
112 F S LOOP=$O(^TMP($J,"WV RPT",74,WV74IEN,400,LOOP)) Q:'LOOP D
113 .S WV74CNT=WV74CNT+1
114 .Q
115 I WV70CNT'=WV74CNT Q 1 ;line counts are different
116 S LOOP=0
117 F S LOOP=$O(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP)) Q:'LOOP!(WVFLAG=1) D
118 .S WVNODE70=$G(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP,0))
119 .S WVNODE74=$G(^TMP($J,"WV RPT",74,WV74IEN,400,LOOP))
120 .I WVNODE70'=WVNODE74 S WVFLAG=1
121 .Q
122 Q WVFLAG
123 ;
Note: See TracBrowser for help on using the repository browser.