Changeset 623 for WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVRALINK.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVRALINK.m (modified) (1 diff)

WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVRALINK.m

@@ -1 @@
-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,23**;Sep 30, 1998;Build 5
-        ;
-        ; 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)
-        ; #2541  - ^XUPARAM        (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.",DATE_"~"_CASE)
-        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
+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