source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSLM2.m@ 1705

Last change on this file since 1705 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.9 KB
Line 
1GMRCSLM2 ;SLC/DCM - LM Detailed display and printing ;12/17/01 23:19
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,18,15,17,23,22**;DEC 27,1997
3 ;
4 ; This routine invokes IA #616,#872,#875,#2467,#2638,#2693,#2925,#3138
5 ; #2849,#10040,#10060
6 ; DBIA 2638 ;ORDER STATUS
7 ; DBIA 2849 ;PROTOCOL
8 ; DBIA 10040 ;SCHEDULING
9 ; DBIA 10060 ;NEW PERSON
10 ;
11DT(GMRCO,GMRCIERR) ;;Entry point to set-up detailed display.
12 ;;Pass in GMRCO as +GMRCO - a number only. GMRCO=IEN from of consult from file 123
13 ;;Results are placed in ^TMP("GMRCR",$J,"DT",
14 ;;Pass in variable GMRCOER=2 if calling from the GUI, GMRCOER=1 if call is from CPRS consults tab
15 ;;Pass in variable GMRCOER=0 (or as <UNDEFINED>) if call is from consults routines
16 K GMRCQUT
17 N DFN,GMRCD,GMRCDA,ORIFN,GMRCSF S GMRCDVDL="",$P(GMRCDVDL,"-",80)=""
18 I $S('GMRCO:1,'$D(^GMR(123,+GMRCO,0)):1,1:0) D:$S('$D(GMRCOER):1,'GMRCOER:1,1:0) S GMRCQUT=1 Q
19 .S GMRCMSG="The consult entry selected for the Detailed Display is unknown." D EXAC^GMRCADC(GMRCMSG) K GMRCMSG
20 .Q
21 K ^TMP("GMRCR",$J,"DT") S TAB="",$P(TAB," ",30)="",GMRCCT=1
22 S GMRCO(0)=^GMR(123,+GMRCO,0),ORIFN=$P(GMRCO(0),"^",3),DFN=$P(GMRCO(0),"^",2)
23 S X="SDUTL3" X ^%ZOSF("TEST") I D
24 .N PR S PR=$$OUTPTPR^SDUTL3(DFN) I $L(PR) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Current PC Provider: "_$P(PR,"^",2),GMRCCT=GMRCCT+1
25 .S PR=$$OUTPTTM^SDUTL3(DFN) I $L(PR) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Current PC Team: "_$P(PR,"^",2),GMRCCT=GMRCCT+1
26 .Q
27 N VAIN,VAEL
28 D INP^VADPT S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Current Pat. Status: "_$S(+VAIN(8):"Inpatient",1:"Outpatient"),GMRCCT=GMRCCT+1
29 I $D(VAIN(4)),$L($P(VAIN(4),"^",2)) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Ward:"_$E(TAB,1,18)_$P(VAIN(4),"^",2),GMRCCT=GMRCCT+1
30 D ELIG^VADPT
31 I $L($P(VAEL(1),"^",2)) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Primary Eligibility:"_$E(TAB,1,11)_$P(VAEL(1),"^",2),GMRCCT=GMRCCT+1
32 S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
33 S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Order Information",GMRCCT=GMRCCT+1
34 S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="To Service:"_$E(TAB,1,12)_$P($G(^GMR(123.5,+$P(GMRCO(0),"^",5),0)),"^"),GMRCCT=GMRCCT+1
35 I $P(GMRCO(0),"^",11) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Attention:"_$E(TAB,1,13)_$P($G(^VA(200,$P(GMRCO(0),"^",11),0)),"^"),GMRCCT=GMRCCT+1
36 S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="From Service:"_$E(TAB,1,10)_$P($G(^SC(+$P(GMRCO(0),"^",6),0)),"^"),GMRCCT=GMRCCT+1
37 S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Requesting Provider: "_$E(TAB,1,2)_$S($P(GMRCO(0),"^",14)]"":$P($G(^VA(200,$P(GMRCO(0),"^",14),0)),"^",1),1:""),GMRCCT=GMRCCT+1
38 I $L($P(GMRCO(0),"^",18)) D
39 .S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Service is to be rendered on an "_$S($P(GMRCO(0),"^",18)="I":"INPATIENT",1:"OUTPATIENT")_" basis",GMRCCT=GMRCCT+1
40 .Q
41 I $P(GMRCO(0),"^",10) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Place:"_$E(TAB,1,17)_$P($G(^ORD(101,+$P(GMRCO(0),"^",10),0)),"^",2),GMRCCT=GMRCCT+1
42 S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Urgency:"_$E(TAB,1,15)_$S($L($P(GMRCO(0),"^",9)):$P($G(^ORD(101,+$P(GMRCO(0),"^",9),0)),"^",2),1:""),GMRCCT=GMRCCT+1
43 S X="ORX8" X ^%ZOSF("TEST") I D
44 .N GMRCOITM S GMRCOITM=$$OI^ORX8(ORIFN)
45 .S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Orderable Item:"_$E(TAB,1,8)_$P(GMRCOITM,U,2),GMRCCT=GMRCCT+1
46 .Q
47 S GMRCPRNM=$P(GMRCO(0),"^",8),GMRCPROC=$S(+GMRCPRNM:$P($G(^GMR(123.3,+GMRCPRNM,0)),"^"),1:"Consult Request")
48 I $L(GMRCPROC) D
49 .N GMRCLN
50 .S GMRCTYPE=$S($P(GMRCO(0),U,17)="P":"Procedure",1:"Consult")
51 .S GMRCLN=GMRCTYPE_":"_$E(TAB,1,22-$L(GMRCTYPE))_GMRCPROC
52 .S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCLN
53 .S GMRCCT=GMRCCT+1
54 .I $G(^GMR(123,+GMRCO,1)) D
55 .. S GMRCLN=""
56 .. S GMRCLN="Clinical Procedure:"_$E(TAB,1,4)
57 .. S GMRCLN=GMRCLN_$$GET1^DIQ(123,+GMRCO,1.01,"E")
58 .. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCLN
59 .. S GMRCCT=GMRCCT+1
60 .Q
61 S GMRCD=$G(^GMR(123,+GMRCO,30)) I $L(GMRCD) D
62 . I $L(GMRCD)>54 D
63 .. N SEG,I S I=2
64 .. F S SEG=$P(GMRCD," ",1,I) Q:$L(SEG)>54 S I=I+1
65 .. S SEG=$P(GMRCD," ",1,(I-1))
66 .. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Provisional Diagnosis: "_SEG
67 .. S GMRCCT=GMRCCT+1
68 .. S SEG=$$REPEAT^XLFSTR(" ",22)_$E(GMRCD,$L(SEG)+1,80)
69 .. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=SEG S GMRCD=""
70 .. S GMRCCT=GMRCCT+1
71 I GMRCD'="" D
72 . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Provisional Diagnosis: "_GMRCD
73 . S GMRCCT=GMRCCT+1
74 I $D(^GMR(123,+GMRCO,20,0)) D
75 .I $O(^GMR(123,+GMRCO,20,0)) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Reason For Request:",GMRCCT=GMRCCT+1 D Q
76 .. S LN=0
77 .. F S LN=$O(^GMR(123,+GMRCO,20,LN)) Q:LN="" D
78 ... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=^GMR(123,+GMRCO,20,LN,0)
79 ... I $G(GMRCIERR) D
80 .... N TXT S TXT=^TMP("GMRCR",$J,"DT",GMRCCT,0)_"..."
81 .... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=TXT
82 .... S LN=9999 ;quit with just one line
83 ... S GMRCCT=GMRCCT+1
84 .. Q
85 . Q
86 S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=" ",GMRCCT=GMRCCT+1
87 ; get inter-facility consult info
88 S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Inter-facility Information",GMRCCT=GMRCCT+1
89 I '$P(GMRCO(0),"^",23) D
90 . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="This is not an inter-facility consult request.",GMRCCT=GMRCCT+1
91 E D
92 . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=$$REPEAT^XLFSTR("-",27)
93 . S GMRCCT=GMRCCT+1
94 . N GMRCOP
95 . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Remote Facility:"_$E(TAB,1,6)_$P($G(^DIC(4,+$P(GMRCO(0),"^",23),0)),"^"),GMRCCT=GMRCCT+1
96 . S GMRCO(12)=$G(^GMR(123,+GMRCO,12))
97 . I $L($P(GMRCO(12),U,6)) D
98 .. S GMRCOP=$P(GMRCO(12),U,6)
99 . I '$D(GMRCOP) S GMRCOP=$$GET1^DIQ(200,+$P(GMRCO(0),U,14),.01)
100 . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Ordering Provider:"_$E(TAB,1,5)_GMRCOP,GMRCCT=GMRCCT+1
101 . S GMRCO(13)=$G(^GMR(123,+GMRCO,13)) I $L($P(GMRCO(13),U,2,3))>1 D
102 .. N LINE
103 .. S LINE=$P(GMRCO(13),U,2) I $L(LINE) S LINE=LINE_$E(TAB,1,5) D
104 ... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Ordering Provider phone: "_LINE
105 ... S GMRCCT=GMRCCT+1
106 .. S LINE=$P(GMRCO(13),U,3) I $L(LINE) S LINE=LINE_$E(TAB,1,5) D
107 ... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Ordering Provider pager: "_LINE
108 ... S GMRCCT=GMRCCT+1
109 . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Remote Consult #"_$E(TAB)_$P(GMRCO(0),"^",22),GMRCCT=GMRCCT+1
110 . I $L($P(GMRCO(13),U)) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Remote Service name: "_$E(TAB)_$P(GMRCO(13),U),GMRCCT=GMRCCT+1
111 . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Role: "_$E(TAB,1,10)_$S($P(GMRCO(12),U,5)="P":"Requesting facility",1:"Consulting facility"),GMRCCT=GMRCCT+1
112 S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
113 ;get status, last action, and significant findings
114 S STS=$P(GMRCO(0),"^",12),^TMP("GMRCR",$J,"DT",GMRCCT,0)="Status: "_$E(TAB,1,14)_$S($D(^ORD(100.01,+STS,0)):$P(^(0),"^",1),1:$P(^ORD(100.01,6,0),"^",1)),GMRCCT=GMRCCT+1
115 S GMRCA=$P(^GMR(123,+GMRCO,0),"^",13),^TMP("GMRCR",$J,"DT",GMRCCT,0)="Last Action:"_$E(TAB,1,11)_$S(+GMRCA:$P($G(^GMR(123.1,GMRCA,0)),"^",1),1:""),GMRCCT=GMRCCT+1
116 I $L($P(GMRCO(0),"^",19)) D
117 .S GMRCSF=$P(GMRCO(0),"^",19)
118 .S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Significant Findings: "_$S(GMRCSF="Y":"YES",GMRCSF="N":"NO",1:"Unknown")
119 .S GMRCCT=GMRCCT+1
120 .Q
121 I $G(GMRCIERR) Q ;don't need results or activities on IFC errors
122 D ACTLOG^GMRCSLM4(+GMRCO)
123 ; any inter-facility results?
124 I $P(GMRCO(0),"^",23) D
125 . N GMRCIFRS,X S GMRCIFRS=0,X=""
126 . F S X=$O(^GMR(123,GMRCO,51,"B",X)) Q:X="" S GMRCIFRS=GMRCIFRS+1
127 . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
128 . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Inter-facility Results: "_$S(GMRCIFRS>0:"Results are available via Display Results action.",1:"No results available for this consult request."),GMRCCT=GMRCCT+2
129 ;get local results
130 D GETRSLT^GMRCART($NA(^TMP("GMRCRT",$J)),1)
131 N NXT S NXT=0
132 F S NXT=$O(^TMP("GMRCRT",$J,NXT)) Q:'NXT D
133 . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=$G(^TMP("GMRCRT",$J,NXT,0))
134 . S GMRCCT=GMRCCT+1
135 . Q
136 K ^TMP("GMRCRT",$J)
137 I $S('$D(GMRCOER):1,'GMRCOER:1,1:0),$D(VALMAR) D CLEAN^VALM10
138 S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",$P(^(0),"=",80)="",^(0)=$E(^(0),1,36)_" END "_$E(^(0),43,80)
139DTQ K X,LN,PL,TO,WP,FLG,SEX,STS,URG,WRD,BKLN,DATA,WRD,PROC,LINE,GMRC(0),GMRC(40),GMRCD,GMRCDVDL,GMRCO,GMRCAR,GMRCRB,GMRCLA,GMRCSR,GMRCTO,MCFILE,MCPROC,DSPLINE,GMRCLA1,GMRCPRNM,GMRCPROC,GMRCTYPE,GMRCWARD
140 I $D(GMRCOER),'GMRCOER D:$D(VALMEVL) KILL^VALM10() D:$D(VALMAR) CLEAN^VALM10
141 Q
Note: See TracBrowser for help on using the repository browser.