Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: WVLABWP

WVLABWP.m

Go to the documentation of this file. 
  1. WVLABWP ;HCIOFO/FT-Display Report Data from Lab Package  ;4/6/99  14:02
  1.  ;;1.0;WOMEN'S HEALTH;**6**;Sep 30, 1998
  1.  ;
  1. EN7901 ; Determine which report to show (i.e., Cytology or Surgical Pathology)
  1.  ; Called from WVPROC
  1.  D EX^WVRADWP ;kill any previous report text that might be leftover
  1.  Q:'$G(DA)
  1.  N LRDFN,LRSS,WVDATE,WVLABACC,WVNODE,WVNODE2
  1.  S WVNODE=$G(^WV(790.1,+DA,0))
  1.  Q:WVNODE=""
  1.  S WVNODE2=$G(^WV(790.1,+DA,2))
  1.  Q:WVNODE2=""
  1.  S WVLABACC=$P(WVNODE2,U,17) ;lab accession number (e.g., CY 99 1)
  1.  Q:WVLABACC=""
  1.  S WVDATE=$P(WVNODE2,U,19) ;lab accession date (reverse date/time)
  1.  Q:'WVDATE
  1.  S LRDFN=$P(WVNODE2,U,18) ;lab patient ien
  1.  Q:'LRDFN
  1.  S LRSS=$P(WVNODE2,U,20) ;lab patient subscript
  1.  Q:LRSS=""
  1.  D HS
  1.  Q
  1. HS ; Health Summary variable setup
  1.  N GMTS1,GMTS2,MAX
  1.  S GMTS1=WVDATE-1,GMTS2=WVDATE+1,MAX=100
  1.  I LRSS="CY" D CY ;cytology
  1.  I LRSS="SP" D SP ;surgical pathology
  1.  K ^TMP("LRA",$J),^TMP("LRCY",$J)
  1.  Q
  1. CY ; Call Health Summary extract routine GMTSLRPE to get cytology data.
  1.  ; Input: LRDFN - FILE 63 ien
  1.  ;        GMTS1 - reverse start date/time (most recent date)
  1.  ;        GMTS2 - reverse end date/time   (least recent date)
  1.  ;          MAX - maximum # of occurences to return
  1.  ; Returns ^TMP("LRCY",$J)
  1.  K ^TMP("LRCY",$J)
  1.  I $T(XTRCT^GMTSLRPE)']"" Q  ;HS routine doesn't exist
  1.  D XTRCT^GMTSLRPE
  1.  Q:'$D(^TMP("LRCY",$J))
  1.  D WEEDCY
  1.  Q:'$D(^TMP("LRCY",$J))
  1.  D ^WVLABWPC ;move data from HS array to WH array
  1.  Q
  1. WEEDCY ; Weed out reports, save only report for lab accession number
  1.  ; associated with this WH entry.
  1.  N WVLOOP
  1.  S WVLOOP=0
  1.  F  S WVLOOP=$O(^TMP("LRCY",$J,WVLOOP)) Q:'WVLOOP  D
  1.  .I $P($G(^TMP("LRCY",$J,WVLOOP,0)),U,2)'=WVLABACC D
  1.  ..K ^TMP("LRCY",$J,WVLOOP)
  1.  ..Q
  1.  .Q
  1.  Q
  1. SP ; Call Health Summary extract routine GMTSLRAE to get surgical
  1.  ; pathology data.
  1.  ; Input: LRDFN - FILE 63 ien
  1.  ;        GMTS1 - reverse start date/time (most recent date)
  1.  ;        GMTS2 - reverse end date/time   (least recent date)
  1.  ;          MAX - maximum # of occurences to return
  1.  ; Returns ^TMP("LRA",$J)
  1.  K ^TMP("LRA",$J)
  1.  I $T(XTRCT^GMTSLRAE)']"" Q  ;HS routine doesn't exist
  1.  D XTRCT^GMTSLRAE
  1.  Q:'$D(^TMP("LRA",$J))
  1.  D WEEDSP
  1.  Q:'$D(^TMP("LRA",$J))
  1.  D ^WVLABWPS ;move data from HS array to WH array
  1.  Q
  1. WEEDSP ; Weed out reports, save only report for lab accession number
  1.  ; associated with this WH entry.
  1.  N WVLOOP
  1.  S WVLOOP=0
  1.  F  S WVLOOP=$O(^TMP("LRA",$J,WVLOOP)) Q:'WVLOOP  D
  1.  .I $P($G(^TMP("LRA",$J,WVLOOP,0)),U,2)'=WVLABACC D
  1.  ..K ^TMP("LRA",$J,WVLOOP)
  1.  ..Q
  1.  .Q
  1.  Q
  1. MAIL(DFN,WVLABAN,WVPROV,LRSS) ; Send mail message to case manager when
  1.  ; lab test is added to WV LAB TESTS file (#790.08).
  1.  ; Called from WVLRLINK
  1.  ;      DFN -> Patient ien
  1.  ;  WVLABAN -> Lab Accession# (e.g., CY 99 1)
  1.  ;   WVPROV -> File 200   IEN (provider/requestor)
  1.  ;     LRSS -> File 63 subscript (e.g., CY or SP)
  1.  Q:'$G(DFN)!($G(WVLABAN)="")!($G(LRSS)="")
  1.  N WVCMGR,WVLOOP,WVMSG,XMDUZ,XMSUB,XMTEXT
  1.  S WVCMGR=+$$GET1^DIQ(790,DFN,.1,"I") ;get case manager
  1.  S:WVCMGR XMY(WVCMGR)=""
  1.  ; if no case manager, then get default case manager(s)
  1.  I 'WVCMGR S WVLOOP=0 F  S WVLOOP=$O(^WV(790.02,WVLOOP)) Q:'WVLOOP  D
  1.  .S WVCMGR=$$GET1^DIQ(790.02,WVLOOP,.02,"I")
  1.  .S:WVCMGR XMY(WVCMGR)=""
  1.  .Q
  1.  Q:$O(XMY(0))'>0  ;no case manager(s)
  1.  S XMDUZ=.5 ;message sender
  1.  S XMSUB="Lab test released for a WH patient"
  1.  S WVMSG(1)="A "_$S(LRSS="CY":"Cytology ",LRSS="SP":"Surgical Pathology ",1:"")_"lab test was verified for:"
  1.  S WVMSG(2)=" "
  1.  S WVMSG(3)="                Patient: "_$P($G(^DPT(DFN,0)),U,1)_" (SSN: "_$$SSN^WVUTL1(DFN)_")"
  1.  S WVMSG(4)="        LAB Accession #: "_WVLABAN
  1.  S WVMSG(5)="Test Requestor/Provider: "_$S(+WVPROV:$$GET1^DIQ(200,+WVPROV,.01,"E"),1:"UNKNOWN")
  1.  S WVMSG(6)=" "
  1.  S WVMSG(7)="Please use the 'Save Lab Test as Procedure' option in the WOMEN'S"
  1.  S WVMSG(8)="HEALTH package to save this lab test data as a WH procedure or"
  1.  S WVMSG(9)="remove it from the list of lab tests to address."
  1.  S XMTEXT="WVMSG("
  1.  D ^XMD
  1.  Q
  1. MOVE(WVDFN,WVNODE,WVNIEN) ; Send mail message when a lab accession is
  1.  ; moved from one patient to another.
  1.  ;  WVDFN -> DFN
  1.  ; WVNODE -> zero node of File 790.1
  1.  ; WVNIEN -> ien of File 790.4 entry (i.e., notification entry exists)
  1.  N WVCMGR,WVLOOP,WVPN,WVMSG
  1.  N XMDUZ,XMSUB,XMTEXT,XMY
  1.  S WVCMGR=+$$GET1^DIQ(790,WVDFN,.1,"I") ;get case manager
  1.  S:WVCMGR XMY(WVCMGR)=""
  1.  ; if no case manager, then get default case manager(s)
  1.  I 'WVCMGR S WVLOOP=0 F  S WVLOOP=$O(^WV(790.02,WVLOOP)) Q:'WVLOOP  D
  1.  .S WVCMGR=$$GET1^DIQ(790.02,WVLOOP,.02,"I")
  1.  .S:WVCMGR XMY(WVCMGR)=""
  1.  .Q
  1.  Q:$O(XMY(0))'>0  ;no case manager(s)
  1.  S WVPN=$E($P(WVNODE,U,1),1,2),WVPN=$$PN^WVLRLINK(WVPN) ;procedure name
  1.  S XMDUZ=.5 ;message sender
  1.  S XMSUB="Lab Accession Patient Switch"
  1.  ;
  1.  S WVMSG(1)="The wrong patient was originally associated with a lab test. That lab test"
  1.  S WVMSG(2)="was saved as a Women's Health procedure entry. Lab personnel have corrected"
  1.  S WVMSG(3)="the lab test entry by associating the correct patient to that test."
  1.  S WVMSG(4)="This message is to inform you that the following Women's Health procedure"
  1.  S WVMSG(5)="is no longer associated with a lab test."
  1.  S WVMSG(6)=" "
  1.  S WVMSG(7)="        Patient: "_$P($G(^DPT(WVDFN,0)),U,1)_" (SSN: "_$$SSN^WVUTL1(WVDFN)_")"
  1.  S WVMSG(8)=" WH Accession #: "_$P(WVNODE,U,1)_"  Procedure Type: "_$S(WVPN]"":WVPN,1:"Unknown")
  1.  S WVMSG(9)=" "
  1.  S WVMSG(10)="The RESULT/DIAGNOSIS value for this entry was changed to 'Error/disregard'."
  1.  S WVMSG(11)="Please use the 'Edit a Procedure' option in the WOMEN'S HEALTH package to"
  1.  S WVMSG(12)="review this procedure entry and make any necessary changes/notes."
  1.  I WVNIEN D
  1.  .S WVMSG(13)=" "
  1.  .S WVMSG(14)="Also, a notification entry was created for this procedure. Please use the"
  1.  .S WVMSG(15)="'Edit a Notification' option in the WOMEN'S HEALTH package to edit this"
  1.  .S WVMSG(16)="notification entry."
  1.  .Q
  1.  S XMTEXT="WVMSG("
  1.  D ^XMD
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  Q