source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVLABWP.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.7 KB
Line 
1WVLABWP ;HCIOFO/FT-Display Report Data from Lab Package ;4/6/99 14:02
2 ;;1.0;WOMEN'S HEALTH;**6**;Sep 30, 1998
3 ;
4EN7901 ; Determine which report to show (i.e., Cytology or Surgical Pathology)
5 ; Called from WVPROC
6 D EX^WVRADWP ;kill any previous report text that might be leftover
7 Q:'$G(DA)
8 N LRDFN,LRSS,WVDATE,WVLABACC,WVNODE,WVNODE2
9 S WVNODE=$G(^WV(790.1,+DA,0))
10 Q:WVNODE=""
11 S WVNODE2=$G(^WV(790.1,+DA,2))
12 Q:WVNODE2=""
13 S WVLABACC=$P(WVNODE2,U,17) ;lab accession number (e.g., CY 99 1)
14 Q:WVLABACC=""
15 S WVDATE=$P(WVNODE2,U,19) ;lab accession date (reverse date/time)
16 Q:'WVDATE
17 S LRDFN=$P(WVNODE2,U,18) ;lab patient ien
18 Q:'LRDFN
19 S LRSS=$P(WVNODE2,U,20) ;lab patient subscript
20 Q:LRSS=""
21 D HS
22 Q
23HS ; Health Summary variable setup
24 N GMTS1,GMTS2,MAX
25 S GMTS1=WVDATE-1,GMTS2=WVDATE+1,MAX=100
26 I LRSS="CY" D CY ;cytology
27 I LRSS="SP" D SP ;surgical pathology
28 K ^TMP("LRA",$J),^TMP("LRCY",$J)
29 Q
30CY ; Call Health Summary extract routine GMTSLRPE to get cytology data.
31 ; Input: LRDFN - FILE 63 ien
32 ; GMTS1 - reverse start date/time (most recent date)
33 ; GMTS2 - reverse end date/time (least recent date)
34 ; MAX - maximum # of occurences to return
35 ; Returns ^TMP("LRCY",$J)
36 K ^TMP("LRCY",$J)
37 I $T(XTRCT^GMTSLRPE)']"" Q ;HS routine doesn't exist
38 D XTRCT^GMTSLRPE
39 Q:'$D(^TMP("LRCY",$J))
40 D WEEDCY
41 Q:'$D(^TMP("LRCY",$J))
42 D ^WVLABWPC ;move data from HS array to WH array
43 Q
44WEEDCY ; Weed out reports, save only report for lab accession number
45 ; associated with this WH entry.
46 N WVLOOP
47 S WVLOOP=0
48 F S WVLOOP=$O(^TMP("LRCY",$J,WVLOOP)) Q:'WVLOOP D
49 .I $P($G(^TMP("LRCY",$J,WVLOOP,0)),U,2)'=WVLABACC D
50 ..K ^TMP("LRCY",$J,WVLOOP)
51 ..Q
52 .Q
53 Q
54SP ; Call Health Summary extract routine GMTSLRAE to get surgical
55 ; pathology data.
56 ; Input: LRDFN - FILE 63 ien
57 ; GMTS1 - reverse start date/time (most recent date)
58 ; GMTS2 - reverse end date/time (least recent date)
59 ; MAX - maximum # of occurences to return
60 ; Returns ^TMP("LRA",$J)
61 K ^TMP("LRA",$J)
62 I $T(XTRCT^GMTSLRAE)']"" Q ;HS routine doesn't exist
63 D XTRCT^GMTSLRAE
64 Q:'$D(^TMP("LRA",$J))
65 D WEEDSP
66 Q:'$D(^TMP("LRA",$J))
67 D ^WVLABWPS ;move data from HS array to WH array
68 Q
69WEEDSP ; Weed out reports, save only report for lab accession number
70 ; associated with this WH entry.
71 N WVLOOP
72 S WVLOOP=0
73 F S WVLOOP=$O(^TMP("LRA",$J,WVLOOP)) Q:'WVLOOP D
74 .I $P($G(^TMP("LRA",$J,WVLOOP,0)),U,2)'=WVLABACC D
75 ..K ^TMP("LRA",$J,WVLOOP)
76 ..Q
77 .Q
78 Q
79MAIL(DFN,WVLABAN,WVPROV,LRSS) ; Send mail message to case manager when
80 ; lab test is added to WV LAB TESTS file (#790.08).
81 ; Called from WVLRLINK
82 ; DFN -> Patient ien
83 ; WVLABAN -> Lab Accession# (e.g., CY 99 1)
84 ; WVPROV -> File 200 IEN (provider/requestor)
85 ; LRSS -> File 63 subscript (e.g., CY or SP)
86 Q:'$G(DFN)!($G(WVLABAN)="")!($G(LRSS)="")
87 N WVCMGR,WVLOOP,WVMSG,XMDUZ,XMSUB,XMTEXT
88 S WVCMGR=+$$GET1^DIQ(790,DFN,.1,"I") ;get case manager
89 S:WVCMGR XMY(WVCMGR)=""
90 ; if no case manager, then get default case manager(s)
91 I 'WVCMGR S WVLOOP=0 F S WVLOOP=$O(^WV(790.02,WVLOOP)) Q:'WVLOOP D
92 .S WVCMGR=$$GET1^DIQ(790.02,WVLOOP,.02,"I")
93 .S:WVCMGR XMY(WVCMGR)=""
94 .Q
95 Q:$O(XMY(0))'>0 ;no case manager(s)
96 S XMDUZ=.5 ;message sender
97 S XMSUB="Lab test released for a WH patient"
98 S WVMSG(1)="A "_$S(LRSS="CY":"Cytology ",LRSS="SP":"Surgical Pathology ",1:"")_"lab test was verified for:"
99 S WVMSG(2)=" "
100 S WVMSG(3)=" Patient: "_$P($G(^DPT(DFN,0)),U,1)_" (SSN: "_$$SSN^WVUTL1(DFN)_")"
101 S WVMSG(4)=" LAB Accession #: "_WVLABAN
102 S WVMSG(5)="Test Requestor/Provider: "_$S(+WVPROV:$$GET1^DIQ(200,+WVPROV,.01,"E"),1:"UNKNOWN")
103 S WVMSG(6)=" "
104 S WVMSG(7)="Please use the 'Save Lab Test as Procedure' option in the WOMEN'S"
105 S WVMSG(8)="HEALTH package to save this lab test data as a WH procedure or"
106 S WVMSG(9)="remove it from the list of lab tests to address."
107 S XMTEXT="WVMSG("
108 D ^XMD
109 Q
110MOVE(WVDFN,WVNODE,WVNIEN) ; Send mail message when a lab accession is
111 ; moved from one patient to another.
112 ; WVDFN -> DFN
113 ; WVNODE -> zero node of File 790.1
114 ; WVNIEN -> ien of File 790.4 entry (i.e., notification entry exists)
115 N WVCMGR,WVLOOP,WVPN,WVMSG
116 N XMDUZ,XMSUB,XMTEXT,XMY
117 S WVCMGR=+$$GET1^DIQ(790,WVDFN,.1,"I") ;get case manager
118 S:WVCMGR XMY(WVCMGR)=""
119 ; if no case manager, then get default case manager(s)
120 I 'WVCMGR S WVLOOP=0 F S WVLOOP=$O(^WV(790.02,WVLOOP)) Q:'WVLOOP D
121 .S WVCMGR=$$GET1^DIQ(790.02,WVLOOP,.02,"I")
122 .S:WVCMGR XMY(WVCMGR)=""
123 .Q
124 Q:$O(XMY(0))'>0 ;no case manager(s)
125 S WVPN=$E($P(WVNODE,U,1),1,2),WVPN=$$PN^WVLRLINK(WVPN) ;procedure name
126 S XMDUZ=.5 ;message sender
127 S XMSUB="Lab Accession Patient Switch"
128 ;
129 S WVMSG(1)="The wrong patient was originally associated with a lab test. That lab test"
130 S WVMSG(2)="was saved as a Women's Health procedure entry. Lab personnel have corrected"
131 S WVMSG(3)="the lab test entry by associating the correct patient to that test."
132 S WVMSG(4)="This message is to inform you that the following Women's Health procedure"
133 S WVMSG(5)="is no longer associated with a lab test."
134 S WVMSG(6)=" "
135 S WVMSG(7)=" Patient: "_$P($G(^DPT(WVDFN,0)),U,1)_" (SSN: "_$$SSN^WVUTL1(WVDFN)_")"
136 S WVMSG(8)=" WH Accession #: "_$P(WVNODE,U,1)_" Procedure Type: "_$S(WVPN]"":WVPN,1:"Unknown")
137 S WVMSG(9)=" "
138 S WVMSG(10)="The RESULT/DIAGNOSIS value for this entry was changed to 'Error/disregard'."
139 S WVMSG(11)="Please use the 'Edit a Procedure' option in the WOMEN'S HEALTH package to"
140 S WVMSG(12)="review this procedure entry and make any necessary changes/notes."
141 I WVNIEN D
142 .S WVMSG(13)=" "
143 .S WVMSG(14)="Also, a notification entry was created for this procedure. Please use the"
144 .S WVMSG(15)="'Edit a Notification' option in the WOMEN'S HEALTH package to edit this"
145 .S WVMSG(16)="notification entry."
146 .Q
147 S XMTEXT="WVMSG("
148 D ^XMD
149 I $D(ZTQUEUED) S ZTREQ="@"
150 Q
Note: See TracBrowser for help on using the repository browser.