1 | WVRADWP ;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 | ;
|
---|
10 | EN ; 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
|
---|
20 | EN1 ; 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
|
---|
104 | EX ; delete existing radiology report text stored in WH
|
---|
105 | K ^WV(790.1,DA,9)
|
---|
106 | Q
|
---|
107 | MAIL(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
|
---|
140 | AMEND(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 | ;
|
---|
149 | COMPARE() ; 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 | ;
|
---|