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