source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVRALINK.m@ 1002

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1WVRALINK ;HCIOFO/FT-RAD/NM-WOMEN'S HEALTH LINK ;6/10/04 14:51
2 ;;1.0;WOMEN'S HEALTH;**3,5,7,9,10,16,18**;Sep 30, 1998
3 ;
4 ; This routine uses the following IAs:
5 ; #2480 - FILE 70 (private)
6 ; #2481 - FILE 71 (private)
7 ; #2482 - FILE 71.2 (private)
8 ; #10035 - FILE 2 (supported)
9 ; #10063 - ^%ZTLOAD (supported)
10 ; #10070 - ^XMD (supported)
11 ; #10141 - ^XPDUTL (supported)
12 ;
13 ;; Original routine created by IHS/ANMC/MWR
14 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
15 ;; CREATE MAMMOGRAM PROCEDURE IN WOMEN'S HEALTH FOR THIS PATIENT.
16 ;; CALLED BY ^RART WHEN A RADIOLOGY REPORT IS VERIFIED.
17 ;; CALLED BY ^RARTE1 WHEN A RADIOLOGY REPORT IS UNVERIFIED.
18 ;; CALLED BY ^WVEXPTRA WHEN EXPORTING HISTORICAL MAMS TO WOMEN'S HEALTH
19 ;
20 ;---> REQUIRED VARIABLES: DFN = DFN OF RADIOLOGY PATIENT.
21 ;---> DATE = INVERSE DATE/TIME OF VISIT.
22 ;---> CASE = IEN OF RADIOLOGY EXAM (CASE).
23 ;
24 ;---> OPTIONAL VARIABLE: WVNEWP = TOTAL NEW WH PATIENTS ADDED.
25 ;---> WVMCNT = TOTAL NEW MAMS PROCEDURES ADDED.
26 ;---> THESE IF CALLED FROM ^WVEXPTRA ROUTINE.
27 ;
28 ;---> GENERATED VARIBLES:
29 ;---> WVPROC = IEN OF RADIOLOGY PROCEDURE (FILE #71), THEN IT
30 ;---> GETS CHANGED TO WOMEN'S HEALTH PROCEDURE TYPE
31 ;---> (FILE #790.2).
32 ;---> WVLOC = WARD/CLINIC/LOCATION (FILE #44).
33 ;---> WVDATE = DATE OF THE PROCEDURE.
34 ;---> WVPROV = ORDERING PROVIDER.
35 ;---> WVMOD = LEFT OR RIGHT, IF IT'S A UNILATERAL MAMMOGRAM.
36 ;---> WVDX = RADIOLOGY DIAGNOSTIC CODE.
37 ;---> WVBWDX = WOMEN'S HEALTH RESULT/DIAGNOSIS.
38 ;
39CREATE(DFN,DATE,CASE) ;
40 Q:'+$$VERSION^XPDUTL("WV")
41 Q:($G(DFN)']"")!($G(DATE)']"")!($G(CASE)']"")
42 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
43 S:'$D(DUZ)#2 DUZ=.5
44 S:'$D(DUZ(2))#2 DUZ(2)=$$KSP^XUPARAM("INST")
45 S ZTRTN="CREATEQ^WVRALINK",ZTDESC="WV CREATE MAMMOGRAM ENTRY"
46 S ZTSAVE("DFN")="",ZTSAVE("DATE")="",ZTSAVE("CASE")=""
47 S ZTIO="",ZTDTH=$H
48 D ^%ZTLOAD
49 Q
50CREATEH(DFN,DATE,CASE,STATUS) ; Entry from ^WVEXPTRA which looks for exams
51 ; created before the WH package was installed.
52 Q:($G(DFN)']"")!($G(DATE)']"")!($G(CASE)']"")!($G(STATUS)']"")
53 ;
54CREATEQ ; Queue data entry creation. Called from CREATE above
55 N WVPROC,WVLOC,WVDATE,WVDR,WVPROV,WVMOD,WVDX,WVBWDX,WVLEFT,WVRIGHT
56 N WVCASE,WVCPT,WVERR,WVCREDIT,WVEXAM0,WVZSTAT
57 ;---> QUIT IF RADIOLOGY DATA IS NOT DEFINED OR ="".
58 I $D(ZTQUEUED) S ZTREQ="@"
59 Q:'$D(^RADPT(DFN,"DT",DATE,"P",CASE,0))
60 ;
61 ;---> QUIT IF THIS PROCEDURE DOES NOT HAVE A MAM CPT CODE.
62 ;---> QUIT IF THIS PROCEDURE DOES NOT HAVE AN ULTRASOUND CPT CODE.
63 ;---> WVEXAM0=ZERO NODE OF RADIOLOGY EXAM.
64 S WVEXAM0=^RADPT(DFN,"DT",DATE,"P",CASE,0)
65 S WVCPT=$$GET1^DIQ(71,$P(WVEXAM0,U,2),9,"I") Q:WVCPT=""
66 S WVPROC=$O(^WV(790.2,"AC",WVCPT,0)) ;cpt code x-ref to get 790.2 ien
67 Q:'WVPROC ;cpt code is not tracked in 790.2
68 Q:$P($G(^WV(790.2,+WVPROC,0)),U,5)'="R" ;cpt is not rad/nm procedure
69 Q:$P($G(^DPT(DFN,0)),U,2)'="F" ;not female
70 ;
71 ;---> QUIT IF NO WOMEN'S HEALTH SITE PARAMETER FILE ON THIS MACHINE.
72 ; OR NO DEFAULT CASE MANAGER
73 Q:'$D(^WV(790.02,DUZ(2)))
74 Q:'$P($G(^WV(790.02,+$G(DUZ(2)),0)),U,2)
75 ;
76 ;---> IF NOT CALLED FROM ^WVEXPTRA (i.e., STATUS is undefined) CHECK
77 ;---> SITE PARAMETER AND QUIT IF "IMPORT MAMMOGRAMS FROM RADIOLOGY"
78 ;---> IS NOT SET TO "YES". CHECK VETERAN STATUS AND ELIGIBILITY CODE.
79 N Y S Y=^WV(790.02,DUZ(2),0)
80 I '$D(STATUS) Q:'$P(Y,U,10)
81 I '$D(STATUS) Q:'$$VNVEC^WVRALIN1() ;vet/non-vet/eligibility code check
82 ;
83 ;---> SET WVZSTAT =THE STATUS (OPEN OR CLOSED) IN WOMEN'S HEALTH.
84 ;---> THAT MAMMOGRAMS SHOULD RECEIVE WHEN COPIED OVER FROM RADIOLOGY.
85 S WVZSTAT=$P(Y,U,23) S:WVZSTAT="" WVZSTAT="o"
86 I $G(STATUS)]"" S WVZSTAT=$G(STATUS) ;status selected in ^WVEXPTRA
87 ;
88 D COPY(WVEXAM0)
89 ;
90EXIT ;EP
91 K I,N,X
92 Q
93 ;
94COPY(Y) ;EP
95 ;---> COPY MAM PROCEDURE DATA FROM RADIOLOGY TO WOMEN'S HEALTH.
96 ;---> VARIABLE DFN=PATIENT
97 ;---> LOCATION=DUZ(2)
98 ;---> WARD/CLINIC/LOCATION
99 N X
100 S WVLOC=$P(Y,U,8)
101 ;
102 ;---> WVDATE=DATE OF THE PROCEDURE.
103 S WVDATE=$P($P(^RADPT(DFN,"DT",DATE,0),U),".")
104 ;
105 ;---> RECONSTRUCT THE FULL CASE# FOR THIS RAD PROCEDURE.
106 ;---> THIS IS USED AS A LINK (XREF) BETWEEN THE RADIOLOGY PROCEDURE
107 ;---> AND THE WOMEN'S HEALTH PROCEDURE.
108 S WVCASE=$E(WVDATE,4,7)_$E(WVDATE,2,3)_"-"_$P(Y,U)
109 ;---> CHECK TO BE SURE THE CASE# XREF IS REALLY DOWN THERE.
110 S:'$D(^RADPT("ADC",WVCASE,DFN,DATE,CASE)) WVCASE="UNKNOWN"
111 ;
112 ;---> QUIT IF THIS PROCEDURE HAS ALREADY BEEN SENT TO WOMEN'S HEALTH.
113 Q:$D(^WV(790.1,"E",WVCASE))
114 ;
115 ;---> REQUESTING PROVIDER/ORDERING PROVIDER
116 S WVPROV=$P(Y,U,14)
117 ;
118 ;---> IF UNILATERAL, ATTEMPT TO PICK UP LEFT OR RIGHT MODIFIER.
119 I WVPROC=26 D
120 .I $D(^RADPT(DFN,"DT",DATE,"P",CASE,"M",0)) D
121 ..N N S N=0
122 ..F S N=$O(^RADPT(DFN,"DT",DATE,"P",CASE,"M",N)) Q:'N D
123 ...S WVMOD=$P(^RADPT(DFN,"DT",DATE,"P",CASE,"M",N,0),U)
124 ...S WVMOD=$$GET1^DIQ(71.2,WVMOD,.01,"I")
125 ...I "LEFTleft"[WVMOD S WVLEFT=1
126 ...I "RIGHTright"[WVMOD S WVRIGHT=1
127 ..Q:$D(WVLEFT)&($D(WVRIGHT))
128 ..I $D(WVLEFT) S WVMOD="l" Q
129 ..I $D(WVRIGHT) S WVMOD="r" Q
130 ;
131 ;---> IF THERE'S A DIAGNOSTIC CODE, ATTEMPT TO PICK UP DIAGNOSIS.
132 ;---> USE "WV DIAGNOSTIC CODE TRANSLATION" FILE #790.32.
133 S WVDX=$P(Y,U,13)
134 I +WVDX I $D(^WV(790.32,"C",WVDX)) S WVBWDX=$O(^WV(790.32,"C",WVDX,0))
135 ;
136 ;---> GET CREDIT METHOD.
137 S WVCREDIT=$P(Y,U,26)
138 ;
139PATIENT ;---> IF PATIENT ISN'T IN WOMEN'S HEALTH DATABASE, ADD HER.
140 S WVERR=1
141 I '$D(^WV(790,DFN,0)) D
142 .D AUTOADD^WVPATE(DFN,DUZ(2),.WVERR)
143 .I $D(WVNEWP) S:WVERR WVNEWP=WVNEWP+1
144 Q:WVERR<0
145 D FIND^WVRALIN1 ;check for 'unlinked' entry in File 790.1
146 Q:$D(^WV(790.1,"E",WVCASE)) ;quit if link was made in WVRALIN1
147PROC ;---> CREATE MAMMOGRAM PROCEDURE IN WV PROCEDURE FILE #790.1.
148 S WVDR=".02////"_DFN_";.04////"_WVPROC
149 S WVDR=WVDR_";.05////"_$G(WVBWDX)_";.07////"_WVPROV
150 S WVDR=WVDR_";.09////"_$G(WVMOD)_";.1////"_DUZ(2)_";.11////"_WVLOC
151 S WVDR=WVDR_";.12////"_WVDATE_";.14////"_WVZSTAT_";.15////"_WVCASE
152 S WVDR=WVDR_";.18////.5;.19////"_DT_";.34////"_$G(DUZ(2))_";.35////"_WVCREDIT
153 ;
154 D NEW2^WVPROC(DFN,WVPROC,WVDATE,WVDR,"","",.WVERR)
155 I $D(WVMCNT) S:WVERR>-1 WVMCNT=WVMCNT+1
156 Q:WVERR<0 ;procedure not added
157 Q:$D(WVMCNT) ;mass import of Rad/NM exams
158 ;Q:$P($G(^WV(790.02,+DUZ(2),0)),U,23)="c" ;Status=closed
159 I (WVCPT=76856)!(WVCPT=76830)!(WVCPT=76645) D Q ;not breast related
160 .D MAIL^WVRADWP(DFN,+Y,WVPROC,WVPROV) ;iens for patient, accession, procedure, provider/requestor
161 .Q
162 D CPRS^WVSNOMED(69,DFN,"",WVPROV,"Mammogram results available.","")
163 Q
164 ;
165DELETE(DFN,DATE,CASE) ;EP
166 ;---> MODIFY WOMEN'S HEALTH PROCEDURE TO REFLECT CHANGE.
167 ;---> CALLED FROM RARTE1 (DELETE A REPORT AND UNVERIFY A REPORT).
168 ;
169 Q:'+$$VERSION^XPDUTL("WV")
170 Q:'$D(DFN)!('$D(DATE))!('$D(CASE))
171 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
172 S ZTRTN="DELETEQ^WVRALINK",ZTDESC="WV MAMMOGRAM RPT CHANGE"
173 S ZTSAVE("DFN")="",ZTSAVE("DATE")="",ZTSAVE("CASE")=""
174 S ZTIO="",ZTDTH=$H
175 D ^%ZTLOAD
176 Q
177DELETEQ ; Modify WV entry when mammogram report is unverified or deleted
178 Q:'$D(^RADPT(DFN,"DT",DATE,"P",CASE,0))
179 N WVIEN,WVDATE,WVCASE,WVCMGR,WVLOOP,WVMSG,WVPROV
180 N XMDUZ,XMSUB,XMTEXT,XMY ;send mail message to case manager
181 I $D(ZTQUEUED) S ZTREQ="@"
182 ;
183 ;---> WVDATE=DATE OF PROCEDURE.
184 S WVDATE=$P($P(^RADPT(DFN,"DT",DATE,0),U),".")
185 S WVCASE=$P(^RADPT(DFN,"DT",DATE,"P",CASE,0),U)
186 ;
187 ;---> WVCASE=RECONSTRUCTED CASE# OF PROCEDURE.
188 S WVCASE=$E(WVDATE,4,7)_$E(WVDATE,2,3)_"-"_WVCASE
189 ;---> QUIT IF NO CASE# XREF IN WOMEN'S HEALTH PROCEDURE FILE.
190 Q:'$D(^WV(790.1,"E",WVCASE))
191 ;
192 S WVIEN=$O(^WV(790.1,"E",WVCASE,0))
193 Q:'$D(^WV(790.1,WVIEN,0))
194 D RADMOD^WVPROC(WVIEN) ;update wh status to "open"
195 S WVPROV=+$$GET1^DIQ(790.1,WVIEN,.07,"I") ;get provider/requestor
196 S WVCMGR=+$$GET1^DIQ(790,DFN,.1,"I") ;get case manager
197 S:WVCMGR XMY(WVCMGR)=""
198 ; if no case manager, then get default case manager(s)
199 I 'WVCMGR S WVLOOP=0 F S WVLOOP=$O(^WV(790.02,WVLOOP)) Q:'WVLOOP D
200 .S WVCMGR=$$GET1^DIQ(790.02,WVLOOP,.02,"I")
201 .S:WVCMGR XMY(WVCMGR)=""
202 .Q
203 Q:$O(XMY(0))'>0 ;no case manager(s)
204 S:WVPROV XMY(WVPROV)=""
205 S XMDUZ=.5 ;message sender
206 S XMSUB="RAD/NM Rpt for WH patient is UNVERIFIED/DELETED"
207 S WVMSG(1)=" Patient: "_$P($G(^DPT(DFN,0)),U,1)_" (SSN: "_$$SSN^WVUTL1(DFN)_")"
208 S WVMSG(2)=" WH Accession #: "_$P($G(^WV(790.1,+WVIEN,0)),U,1)
209 S WVMSG(3)=" RAD/NM Case #: "_WVCASE
210 S WVMSG(4)=" "
211 S WVMSG(5)="NOTE: THIS PROCEDURE HAS BEEN ALTERED IN RADIOLOGY/NM."
212 S WVMSG(6)="Follow-up is required in the WOMEN'S HEALTH package!"
213 S XMTEXT="WVMSG("
214 D ^XMD
215 Q
Note: See TracBrowser for help on using the repository browser.