WVRALINK ;HCIOFO/FT-RAD/NM-WOMEN'S HEALTH LINK  ;6/10/04  14:51
 ;;1.0;WOMEN'S HEALTH;**3,5,7,9,10,16,18**;Sep 30, 1998
 ;
 ; This routine uses the following IAs:
 ; #2480  - FILE 70         (private)
 ; #2481  - FILE 71         (private)
 ; #2482  - FILE 71.2       (private)
 ; #10035 - FILE 2          (supported)
 ; #10063 - ^%ZTLOAD        (supported)
 ; #10070 - ^XMD            (supported)
 ; #10141 - ^XPDUTL         (supported)
 ;
 ;;  Original routine created by IHS/ANMC/MWR
 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
 ;;  CREATE MAMMOGRAM PROCEDURE IN WOMEN'S HEALTH FOR THIS PATIENT.
 ;;  CALLED BY ^RART WHEN A RADIOLOGY REPORT IS VERIFIED.
 ;;  CALLED BY ^RARTE1 WHEN A RADIOLOGY REPORT IS UNVERIFIED.
 ;;  CALLED BY ^WVEXPTRA WHEN EXPORTING HISTORICAL MAMS TO WOMEN'S HEALTH
 ;
 ;---> REQUIRED VARIABLES: DFN  = DFN OF RADIOLOGY PATIENT.
 ;--->                     DATE = INVERSE DATE/TIME OF VISIT.
 ;--->                     CASE = IEN OF RADIOLOGY EXAM (CASE).
 ;
 ;---> OPTIONAL VARIABLE:  WVNEWP = TOTAL NEW WH PATIENTS ADDED.
 ;--->                     WVMCNT = TOTAL NEW MAMS PROCEDURES ADDED.
 ;--->                     THESE IF CALLED FROM ^WVEXPTRA ROUTINE.
 ;
 ;---> GENERATED VARIBLES:
 ;---> WVPROC = IEN OF RADIOLOGY PROCEDURE (FILE #71), THEN IT
 ;--->          GETS CHANGED TO WOMEN'S HEALTH PROCEDURE TYPE
 ;--->                                   (FILE #790.2).
 ;---> WVLOC  = WARD/CLINIC/LOCATION (FILE #44).
 ;---> WVDATE = DATE OF THE PROCEDURE.
 ;---> WVPROV = ORDERING PROVIDER.
 ;---> WVMOD  = LEFT OR RIGHT, IF IT'S A UNILATERAL MAMMOGRAM.
 ;---> WVDX   = RADIOLOGY DIAGNOSTIC CODE.
 ;---> WVBWDX = WOMEN'S HEALTH RESULT/DIAGNOSIS.
 ;
CREATE(DFN,DATE,CASE) ;
 Q:'+$$VERSION^XPDUTL("WV")
 Q:($G(DFN)']"")!($G(DATE)']"")!($G(CASE)']"")
 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
 S:'$D(DUZ)#2 DUZ=.5
 S:'$D(DUZ(2))#2 DUZ(2)=$$KSP^XUPARAM("INST")
 S ZTRTN="CREATEQ^WVRALINK",ZTDESC="WV CREATE MAMMOGRAM ENTRY"
 S ZTSAVE("DFN")="",ZTSAVE("DATE")="",ZTSAVE("CASE")=""
 S ZTIO="",ZTDTH=$H
 D ^%ZTLOAD
 Q
CREATEH(DFN,DATE,CASE,STATUS) ; Entry from ^WVEXPTRA which looks for exams
 ; created before the WH package was installed.
 Q:($G(DFN)']"")!($G(DATE)']"")!($G(CASE)']"")!($G(STATUS)']"")
 ; 
CREATEQ ; Queue data entry creation. Called from CREATE above
 N WVPROC,WVLOC,WVDATE,WVDR,WVPROV,WVMOD,WVDX,WVBWDX,WVLEFT,WVRIGHT
 N WVCASE,WVCPT,WVERR,WVCREDIT,WVEXAM0,WVZSTAT
 ;---> QUIT IF RADIOLOGY DATA IS NOT DEFINED OR ="".
 I $D(ZTQUEUED) S ZTREQ="@"
 Q:'$D(^RADPT(DFN,"DT",DATE,"P",CASE,0))
 ;
 ;---> QUIT IF THIS PROCEDURE DOES NOT HAVE A MAM CPT CODE.
 ;---> QUIT IF THIS PROCEDURE DOES NOT HAVE AN ULTRASOUND CPT CODE.
 ;---> WVEXAM0=ZERO NODE OF RADIOLOGY EXAM.
 S WVEXAM0=^RADPT(DFN,"DT",DATE,"P",CASE,0)
 S WVCPT=$$GET1^DIQ(71,$P(WVEXAM0,U,2),9,"I") Q:WVCPT=""
 S WVPROC=$O(^WV(790.2,"AC",WVCPT,0)) ;cpt code x-ref to get 790.2 ien
 Q:'WVPROC  ;cpt code is not tracked in 790.2
 Q:$P($G(^WV(790.2,+WVPROC,0)),U,5)'="R"  ;cpt is not rad/nm procedure
 Q:$P($G(^DPT(DFN,0)),U,2)'="F"  ;not female
 ;
 ;---> QUIT IF NO WOMEN'S HEALTH SITE PARAMETER FILE ON THIS MACHINE.
 ;     OR NO DEFAULT CASE MANAGER
 Q:'$D(^WV(790.02,DUZ(2)))
 Q:'$P($G(^WV(790.02,+$G(DUZ(2)),0)),U,2)
 ;
 ;---> IF NOT CALLED FROM ^WVEXPTRA (i.e., STATUS is undefined) CHECK
 ;---> SITE PARAMETER AND QUIT IF "IMPORT MAMMOGRAMS FROM RADIOLOGY"
 ;---> IS NOT SET TO "YES". CHECK VETERAN STATUS AND ELIGIBILITY CODE.
 N Y S Y=^WV(790.02,DUZ(2),0)
 I '$D(STATUS) Q:'$P(Y,U,10)
 I '$D(STATUS) Q:'$$VNVEC^WVRALIN1()  ;vet/non-vet/eligibility code check
 ;
 ;---> SET WVZSTAT =THE STATUS (OPEN OR CLOSED) IN WOMEN'S HEALTH.
 ;---> THAT MAMMOGRAMS SHOULD RECEIVE WHEN COPIED OVER FROM RADIOLOGY.
 S WVZSTAT=$P(Y,U,23) S:WVZSTAT="" WVZSTAT="o"
 I $G(STATUS)]"" S WVZSTAT=$G(STATUS) ;status selected in ^WVEXPTRA
 ;
 D COPY(WVEXAM0)
 ;
EXIT ;EP
 K I,N,X
 Q
 ;
COPY(Y) ;EP
 ;---> COPY MAM PROCEDURE DATA FROM RADIOLOGY TO WOMEN'S HEALTH.
 ;---> VARIABLE DFN=PATIENT
 ;---> LOCATION=DUZ(2)
 ;---> WARD/CLINIC/LOCATION
 N X
 S WVLOC=$P(Y,U,8)
 ;
 ;---> WVDATE=DATE OF THE PROCEDURE.
 S WVDATE=$P($P(^RADPT(DFN,"DT",DATE,0),U),".")
 ;
 ;---> RECONSTRUCT THE FULL CASE# FOR THIS RAD PROCEDURE.
 ;---> THIS IS USED AS A LINK (XREF) BETWEEN THE RADIOLOGY PROCEDURE
 ;---> AND THE WOMEN'S HEALTH PROCEDURE.
 S WVCASE=$E(WVDATE,4,7)_$E(WVDATE,2,3)_"-"_$P(Y,U)
 ;---> CHECK TO BE SURE THE CASE# XREF IS REALLY DOWN THERE.
 S:'$D(^RADPT("ADC",WVCASE,DFN,DATE,CASE)) WVCASE="UNKNOWN"
 ;
 ;---> QUIT IF THIS PROCEDURE HAS ALREADY BEEN SENT TO WOMEN'S HEALTH.
 Q:$D(^WV(790.1,"E",WVCASE))
 ;
 ;---> REQUESTING PROVIDER/ORDERING PROVIDER
 S WVPROV=$P(Y,U,14)
 ;
 ;---> IF UNILATERAL, ATTEMPT TO PICK UP LEFT OR RIGHT MODIFIER.
 I WVPROC=26 D
 .I $D(^RADPT(DFN,"DT",DATE,"P",CASE,"M",0)) D
 ..N N S N=0
 ..F  S N=$O(^RADPT(DFN,"DT",DATE,"P",CASE,"M",N)) Q:'N  D
 ...S WVMOD=$P(^RADPT(DFN,"DT",DATE,"P",CASE,"M",N,0),U)
 ...S WVMOD=$$GET1^DIQ(71.2,WVMOD,.01,"I")
 ...I "LEFTleft"[WVMOD S WVLEFT=1
 ...I "RIGHTright"[WVMOD S WVRIGHT=1
 ..Q:$D(WVLEFT)&($D(WVRIGHT))
 ..I $D(WVLEFT) S WVMOD="l" Q
 ..I $D(WVRIGHT) S WVMOD="r" Q
 ;
 ;---> IF THERE'S A DIAGNOSTIC CODE, ATTEMPT TO PICK UP DIAGNOSIS.
 ;---> USE "WV DIAGNOSTIC CODE TRANSLATION" FILE #790.32.
 S WVDX=$P(Y,U,13)
 I +WVDX I $D(^WV(790.32,"C",WVDX)) S WVBWDX=$O(^WV(790.32,"C",WVDX,0))
 ;
 ;---> GET CREDIT METHOD.
 S WVCREDIT=$P(Y,U,26)
 ;
PATIENT ;---> IF PATIENT ISN'T IN WOMEN'S HEALTH DATABASE, ADD HER.
 S WVERR=1
 I '$D(^WV(790,DFN,0)) D
 .D AUTOADD^WVPATE(DFN,DUZ(2),.WVERR)
 .I $D(WVNEWP) S:WVERR WVNEWP=WVNEWP+1
 Q:WVERR<0
 D FIND^WVRALIN1 ;check for 'unlinked' entry in File 790.1
 Q:$D(^WV(790.1,"E",WVCASE))  ;quit if link was made in WVRALIN1
PROC ;---> CREATE MAMMOGRAM PROCEDURE IN WV PROCEDURE FILE #790.1.
 S WVDR=".02////"_DFN_";.04////"_WVPROC
 S WVDR=WVDR_";.05////"_$G(WVBWDX)_";.07////"_WVPROV
 S WVDR=WVDR_";.09////"_$G(WVMOD)_";.1////"_DUZ(2)_";.11////"_WVLOC
 S WVDR=WVDR_";.12////"_WVDATE_";.14////"_WVZSTAT_";.15////"_WVCASE
 S WVDR=WVDR_";.18////.5;.19////"_DT_";.34////"_$G(DUZ(2))_";.35////"_WVCREDIT
 ;
 D NEW2^WVPROC(DFN,WVPROC,WVDATE,WVDR,"","",.WVERR)
 I $D(WVMCNT) S:WVERR>-1 WVMCNT=WVMCNT+1
 Q:WVERR<0  ;procedure not added
 Q:$D(WVMCNT)  ;mass import of Rad/NM exams
 ;Q:$P($G(^WV(790.02,+DUZ(2),0)),U,23)="c"  ;Status=closed
 I (WVCPT=76856)!(WVCPT=76830)!(WVCPT=76645) D  Q  ;not breast related
 .D MAIL^WVRADWP(DFN,+Y,WVPROC,WVPROV) ;iens for patient, accession, procedure, provider/requestor
 .Q
 D CPRS^WVSNOMED(69,DFN,"",WVPROV,"Mammogram results available.","")
 Q
 ;
DELETE(DFN,DATE,CASE) ;EP
 ;---> MODIFY WOMEN'S HEALTH PROCEDURE TO REFLECT CHANGE.
 ;---> CALLED FROM RARTE1 (DELETE A REPORT AND UNVERIFY A REPORT).
 ;
 Q:'+$$VERSION^XPDUTL("WV")
 Q:'$D(DFN)!('$D(DATE))!('$D(CASE))
 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
 S ZTRTN="DELETEQ^WVRALINK",ZTDESC="WV MAMMOGRAM RPT CHANGE"
 S ZTSAVE("DFN")="",ZTSAVE("DATE")="",ZTSAVE("CASE")=""
 S ZTIO="",ZTDTH=$H
 D ^%ZTLOAD
 Q
DELETEQ ; Modify WV entry when mammogram report is unverified or deleted
 Q:'$D(^RADPT(DFN,"DT",DATE,"P",CASE,0))
 N WVIEN,WVDATE,WVCASE,WVCMGR,WVLOOP,WVMSG,WVPROV
 N XMDUZ,XMSUB,XMTEXT,XMY ;send mail message to case manager
 I $D(ZTQUEUED) S ZTREQ="@"
 ;
 ;---> WVDATE=DATE OF PROCEDURE.
 S WVDATE=$P($P(^RADPT(DFN,"DT",DATE,0),U),".")
 S WVCASE=$P(^RADPT(DFN,"DT",DATE,"P",CASE,0),U)
 ;
 ;---> WVCASE=RECONSTRUCTED CASE# OF PROCEDURE.
 S WVCASE=$E(WVDATE,4,7)_$E(WVDATE,2,3)_"-"_WVCASE
 ;---> QUIT IF NO CASE# XREF IN WOMEN'S HEALTH PROCEDURE FILE.
 Q:'$D(^WV(790.1,"E",WVCASE))
 ;
 S WVIEN=$O(^WV(790.1,"E",WVCASE,0))
 Q:'$D(^WV(790.1,WVIEN,0))
 D RADMOD^WVPROC(WVIEN) ;update wh status to "open"
 S WVPROV=+$$GET1^DIQ(790.1,WVIEN,.07,"I") ;get provider/requestor
 S WVCMGR=+$$GET1^DIQ(790,DFN,.1,"I") ;get case manager
 S:WVCMGR XMY(WVCMGR)=""
 ; if no case manager, then get default case manager(s)
 I 'WVCMGR S WVLOOP=0 F  S WVLOOP=$O(^WV(790.02,WVLOOP)) Q:'WVLOOP  D
 .S WVCMGR=$$GET1^DIQ(790.02,WVLOOP,.02,"I")
 .S:WVCMGR XMY(WVCMGR)=""
 .Q
 Q:$O(XMY(0))'>0  ;no case manager(s)
 S:WVPROV XMY(WVPROV)=""
 S XMDUZ=.5 ;message sender
 S XMSUB="RAD/NM Rpt for WH patient is UNVERIFIED/DELETED"
 S WVMSG(1)="        Patient: "_$P($G(^DPT(DFN,0)),U,1)_" (SSN: "_$$SSN^WVUTL1(DFN)_")"
 S WVMSG(2)=" WH Accession #: "_$P($G(^WV(790.1,+WVIEN,0)),U,1)
 S WVMSG(3)="  RAD/NM Case #: "_WVCASE
 S WVMSG(4)=" "
 S WVMSG(5)="NOTE: THIS PROCEDURE HAS BEEN ALTERED IN RADIOLOGY/NM."
 S WVMSG(6)="Follow-up is required in the WOMEN'S HEALTH package!"
 S XMTEXT="WVMSG("
 D ^XMD
 Q