source: FOIAVistA/tag/r/WOMENS_HEALTH-WV/WVRADWP.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1WVRADWP ;HCIOFO/FT-Display Report Data from Related Packages ;9/29/04 14:35
2 ;;1.0;WOMEN'S HEALTH;**4,5,7,15,16**;Sep 30, 1998
3 ;
4 ; This routine uses the following IAs:
5 ; #2479 - FILE 74 fields (private)
6 ; #2480 - FILE 70 fileds (private)
7 ; #10035 - ^DPT( references (supported)
8 ; #10070 - ^XMD (supported)
9 ;
10EN ; Determine which report to show (i.e., radiology/nuclear medicine)
11 ; Called from Edit a Procedure option screen form.
12 D EX
13 Q:'$G(DA)
14 Q:'$D(^WV(790.1,+DA,0))
15 N WV7901
16 S WV7901=$E(^WV(790.1,+DA,0),1,2) ;first 2 characters of accession code
17 Q:WV7901=""
18 I "^BU^MB^MS^MU^PU^VU^"[WV7901 D EN1 Q ;show rad/nm report data
19 Q
20EN1 ; Set up radiology report data and call FM Browser
21 N LOOP,WVDUP,WVIENS,WVLCNT,WVRADCSE,WVRADDFN,WVRADDTE,WVRADIEN,WVRPTIEN
22 N WVJCN,WVJCN1
23 S WVRADIEN=$P(^WV(790.1,DA,0),U,15)
24 Q:WVRADIEN="" ;no 'radiology mam case #'
25 S WVRADDFN=$P(^WV(790.1,DA,0),U,2)
26 Q:'WVRADDFN ;no dfn
27 S WVRADDTE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,0))
28 Q:'WVRADDTE ;no inverse exam date
29 S WVRADCSE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,WVRADDTE,0))
30 Q:'WVRADCSE ;no case number
31 S WVRPTIEN=+$P(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0),U,17)
32 Q:'WVRPTIEN ;no report in File 74
33 K ^TMP($J,"WV RADRPT"),^TMP("WV RADRPT",$J),^TMP($J,"WV CH")
34 S WVIENS=WVRADCSE_","_WVRADDTE_","_WVRADDFN_"," ;iens for FILE 70 entry
35 ; get clincal history from FILE 70
36 D GETS^DIQ(70.03,WVIENS,400,"EIZ","^TMP($J,""WV CH"")")
37 ; get data from FILE 74
38 D GETS^DIQ(74,WVRPTIEN_",","*","EI","^TMP($J,""WV RADRPT"")")
39 S ^TMP("WV RADRPT",$J,1,0)=" DAY-CASE #: "_$G(^TMP($J,"WV RADRPT",74,WVRPTIEN_",",.01,"E"))_$S($$AMEND(WVRPTIEN):" (AMENDED REPORT)",1:"")
40 S ^TMP("WV RADRPT",$J,2,0)=" EXAM DATE/TIME: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",3,"E")
41 S ^TMP("WV RADRPT",$J,3,0)=" VERIFYING PHYSICIAN: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",9,"E")
42 S ^TMP("WV RADRPT",$J,4,0)=" PROCEDURE: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",102,"E")
43 S ^TMP("WV RADRPT",$J,5,0)=" CATEGORY OF EXAM: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",104,"E")
44 S ^TMP("WV RADRPT",$J,6,0)=" WARD: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",106,"E")
45 S ^TMP("WV RADRPT",$J,7,0)=" TREATING SERVICE (INPATIENT): "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",107,"E")
46 S ^TMP("WV RADRPT",$J,8,0)=" PRINCIPAL CLINIC: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",108,"E")
47 S ^TMP("WV RADRPT",$J,9,0)=" CONTRACT SHARING SOURCE: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",109,"E")
48 S ^TMP("WV RADRPT",$J,10,0)="PRIMARY INTERPRETING RESIDENT: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",112,"E")
49 S ^TMP("WV RADRPT",$J,11,0)=" PRIMARY INTERPRETING STAFF: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",115,"E")
50 S ^TMP("WV RADRPT",$J,12,0)=" PRIMARY DIAGNOSIS: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",113,"E")
51 S ^TMP("WV RADRPT",$J,13,0)=" REQUESTING PHYSICIAN: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",114,"E")
52 S ^TMP("WV RADRPT",$J,14,0)=" COMPLICATION: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",116,"E")
53 S ^TMP("WV RADRPT",$J,15,0)=" "
54 S ^TMP("WV RADRPT",$J,16,0)="CLINICAL HISTORY:"
55 S LOOP=0,WVLCNT=16
56 S WVDUP=$$COMPARE()
57 I WVDUP=1 D ;Clinical History text in files 70 & 74 are different
58 .S LOOP=0
59 .F S LOOP=$O(^TMP($J,"WV CH",70.03,WVIENS,400,LOOP)) Q:'LOOP D
60 ..S WVLCNT=WVLCNT+1
61 ..S ^TMP("WV RADRPT",$J,WVLCNT,0)=^TMP($J,"WV CH",70.03,WVIENS,400,LOOP,0)
62 ..Q
63 .I WVLCNT>16 D ;insert blank line if different texts exist
64 ..S WVLCNT=WVLCNT+1
65 ..S ^TMP("WV RADRPT",$J,WVLCNT,0)=" "
66 ..Q
67 .S LOOP=0
68 .F S LOOP=$O(^TMP($J,"WV RADRPT",74,WVRPTIEN_",",400,LOOP)) Q:'LOOP D
69 ..S WVLCNT=WVLCNT+1
70 ..S ^TMP("WV RADRPT",$J,WVLCNT,0)=^TMP($J,"WV RADRPT",74,WVRPTIEN_",",400,LOOP)
71 ..Q
72 .Q
73 I WVDUP=0 D ;Clinical History field is same
74 .S LOOP=0
75 .F S LOOP=$O(^TMP($J,"WV RADRPT",74,WVRPTIEN_",",400,LOOP)) Q:'LOOP D
76 ..S WVLCNT=WVLCNT+1
77 ..S ^TMP("WV RADRPT",$J,WVLCNT,0)=^TMP($J,"WV RADRPT",74,WVRPTIEN_",",400,LOOP)
78 ..Q
79 .Q
80 S WVLCNT=WVLCNT+1
81 S ^TMP("WV RADRPT",$J,WVLCNT,0)=" "
82 S WVLCNT=WVLCNT+1
83 S ^TMP("WV RADRPT",$J,WVLCNT,0)="IMPRESSION TEXT:"
84 S LOOP=0
85 F S LOOP=$O(^TMP($J,"WV RADRPT",74,WVRPTIEN_",",300,LOOP)) Q:'LOOP D
86 .S WVLCNT=WVLCNT+1
87 .S ^TMP("WV RADRPT",$J,WVLCNT,0)=^TMP($J,"WV RADRPT",74,WVRPTIEN_",",300,LOOP)
88 .Q
89 S WVLCNT=WVLCNT+1
90 S ^TMP("WV RADRPT",$J,WVLCNT,0)=" "
91 S WVLCNT=WVLCNT+1
92 S ^TMP("WV RADRPT",$J,WVLCNT,0)="REPORT TEXT:"
93 S LOOP=0
94 F S LOOP=$O(^TMP($J,"WV RADRPT",74,WVRPTIEN_",",200,LOOP)) Q:'LOOP D
95 .S WVLCNT=WVLCNT+1
96 .S ^TMP("WV RADRPT",$J,WVLCNT,0)=^TMP($J,"WV RADRPT",74,WVRPTIEN_",",200,LOOP)
97 .Q
98 K ^TMP($J,"WV RADRPT"),WVLCNT,^WV(790.1,DA,9)
99 S WVJCN=0 F S WVJCN=$O(^TMP("WV RADRPT",$J,WVJCN)) Q:WVJCN'>0 D
100 .S ^WV(790.1,DA,9,WVJCN,0)=$G(^TMP("WV RADRPT",$J,WVJCN,0)) S WVJCN1=WVJCN
101 S ^WV(790.1,DA,9,0)="^^"_WVJCN1_"^"_WVJCN1
102 K ^TMP("WV RADRPT",$J),^TMP($J,"WV CH")
103 Q
104EX ; delete existing radiology report text stored in WH
105 K ^WV(790.1,DA,9)
106 Q
107MAIL(DFN,WVACCESS,WVPROC,WVPROV) ; Send mail message to case manager when
108 ; Radiology procedure is added to WH Procedure file (#790.1).
109 ; Called from WVRALINK
110 ; DFN -> Patient ien
111 ; WVACCESS -> File 790.1 ien (procedure entry)
112 ; WVPROC -> File 790.2 ien (procedure type)
113 ; WVPROV -> File 200 IEN (provider/requestor)
114 Q:'$G(DFN)!('$G(WVACCESS))!('$G(WVPROC))
115 N WVCMGR,WVLOOP,WVMSG,XMDUZ,XMSUB,XMTEXT,XMY
116 S WVCMGR=+$$GET1^DIQ(790,DFN,.1,"I") ;get case manager
117 S:WVCMGR XMY(WVCMGR)=""
118 ; if no case manager, then get default case manager(s)
119 I 'WVCMGR S WVLOOP=0 F S WVLOOP=$O(^WV(790.02,WVLOOP)) Q:'WVLOOP D
120 .S WVCMGR=$$GET1^DIQ(790.02,WVLOOP,.02,"I")
121 .S:WVCMGR XMY(WVCMGR)=""
122 .Q
123 Q:$O(XMY(0))'>0 ;no case manager(s)
124 ;S:WVPROV XMY(WVPROV)=""
125 S XMDUZ=.5 ;message sender
126 S XMSUB="RAD/NM added a procedure for a WH patient"
127 S WVMSG(1)=" Patient: "_$P($G(^DPT(DFN,0)),U,1)_" (SSN: "_$$SSN^WVUTL1(DFN)_")"
128 S WVMSG(2)=" WH Accession #: "_$P($G(^WV(790.1,+WVACCESS,0)),U,1)
129 S WVMSG(3)=" Procedure: "_$P($G(^WV(790.2,+WVPROC,0)),U,1)
130 S WVMSG(4)=" "
131 S WVMSG(5)="Please use the 'Edit a Procedure' option in the WOMEN'S"
132 S WVMSG(6)="HEALTH package to complete/close this procedure."
133 I ($E($P(WVMSG(2),"#: ",2),1,2)="MB")!($E($P(WVMSG(2),"#: ",2),1,2)="MS")!($E($P(WVMSG(2),"#: ",2),1,2)="MU") D
134 .S WVMSG(5)="Please use CPRS to resolve the Clinical Reminder for this procedure and"
135 .S WVMSG(6)="complete the result."
136 .Q
137 S XMTEXT="WVMSG("
138 D ^XMD
139 Q
140AMEND(WVRPTIEN) ; Check if RAD/NM report is amended.
141 ; WVRPTIEN - File 74 ien
142 N WVAMEND
143 K ^TMP("DILIST",$J),^TMP("DIERR",$J)
144 D LIST^DIC(74.06,","_WVRPTIEN_",",.01)
145 S WVAMEND=$O(^TMP("DILIST",$J,0))
146 K ^TMP("DILIST",$J),^TMP("DIERR",$J)
147 Q WVAMEND
148 ;
149COMPARE() ; Compares Clincal History fields in files 70 & 74
150 ; Returns 1 (different) or 0 (same)
151 N LOOP,WVFLAG,WV70CNT,WV70IEN,WV74CNT,WV74IEN,WVNODE70,WVNODE74
152 S (LOOP,WV70CNT,WV74CNT,WVFLAG)=0
153 S WV70IEN=WVIENS,WV74IEN=WVRPTIEN_","
154 I '$O(^TMP($J,"WV CH",70.03,WV70IEN,400,0)) S WVFLAG=WVFLAG+1
155 I '$O(^TMP($J,"WV RADRPT",74,WV74IEN,400,0)) S WVFLAG=WVFLAG+1
156 I WVFLAG=1 Q 1 ;different (field was purged in one file, exists in
157 ; the other file)
158 I WVFLAG=2 Q 0 ;same (field was purged in 70 & 74)
159 F S LOOP=$O(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP)) Q:'LOOP D
160 .S WV70CNT=WV70CNT+1
161 .Q
162 S LOOP=0
163 F S LOOP=$O(^TMP($J,"WV RADRPT",74,WV74IEN,400,LOOP)) Q:'LOOP D
164 .S WV74CNT=WV74CNT+1
165 .Q
166 I WV70CNT'=WV74CNT Q 1 ;line counts are different
167 S LOOP=0
168 F S LOOP=$O(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP)) Q:'LOOP!(WVFLAG=1) D
169 .S WVNODE70=$G(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP,0))
170 .S WVNODE74=$G(^TMP($J,"WV RADRPT",74,WV74IEN,400,LOOP))
171 .I WVNODE70'=WVNODE74 S WVFLAG=1
172 .Q
173 Q WVFLAG
174 ;
Note: See TracBrowser for help on using the repository browser.