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