source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCART.m@ 654

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1GMRCART ;SLC/DCM,DLT,JFR - Result display logic ;12/17/01 22:39
2 ;;3.0;CONSULT/REQUEST TRACKING;**4,15,17,23,22,38**;DEC 27, 1997
3 ;
4 ; This routine invokes IA #2638,#10060
5 ;
6RT(GMRCO) ;Result Display logic - called from GMRCA1
7 N GMRCCT,GMRCTMP,GMRCSR,GMRCTUFN,GMRCSTS,GMRCMSG
8 ;
9 S GMRCSR=$P($G(^GMR(123,+GMRCO,0)),"^",15),GMRCTUFN=$P(^(0),"^",20)
10 S GMRCSTS=$P($G(^GMR(123,+GMRCO,0)),"^",12)
11 I '$$RESOLUS^GMRCAU(GMRCSTS),('+GMRCSR&('GMRCTUFN)) S GMRCMSG="No results available for review." D EXAC^GMRCADC(GMRCMSG),END S GMRCQUT=1 Q
12 ;
13 W !,"Compiling Result Display..."
14 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
15 K ^TMP("GMRCR",$J,"DT") S GMRCCT=1
16 S XQORM("A")="Select Action: "
17 S:$D(VALMAR) GMRCVAL=VALMAR
18 S GMRCTMP="^TMP(""GMRCR"",$J,""DT"")"
19 S GMRCDVL="",$P(GMRCDVL,"-",41)=""
20 ;
21 D GETRSLT(GMRCTMP)
22 ;
23 D EN^VALM("GMRC RESULTS DISPLAY")
24 S:$D(GMRCVAL) VALMAR=GMRCVAL S:$D(LNCT) VALMCNT=LNCT
25 D KILL^VALM10()
26 K OREND,ORAGE,ORIO,ORDOB,ORFT,ORHI,ORIFN,ORNP,ORL,ORPD,ORPNM,ORPV,ORSEQ,ORSEX,ORWARD,ORDG
27 K GMRCDVL,GMRCLCT,GMRCRPT,GMRCTUFN,GMRCVAL,MCFILE,MCPROC,GMRCX,GMRCTO,GMRCPRNM
28 D END
29 Q
30 ;
31GETRSLT(TMPGLOB,GMRCDET) ;load the results into global defined in TMPGLOB
32 ;used for GUI formated results and list manager
33 ;
34 ;I GMRCDET=1 coming from a detailed display not results display
35 ;
36 N GMRCCT,GMRCCTS,SF,TAB
37 S TAB="",$P(TAB," ",31)=""
38 S GMRCDVL="",$P(GMRCDVL,"-",41)=""
39 K @TMPGLOB,^TMP("GMRCR",$J,"CP")
40 S GMRCCT=1
41 S:'$D(GMRCDET) GMRCDET=0
42 I $L($P(^GMR(123,GMRCO,0),"^",19)) S SF=$P(^(0),"^",19),@TMPGLOB@(GMRCCT,0)="Significant Findings: "_$S(SF="Y":"**Yes**",SF="N":"No",1:"Unknown"),GMRCCT=GMRCCT+1
43 ;S @TMPGLOB@(GMRCCT,0)=GMRCDVL_GMRCDVL,GMRCCT=GMRCCT+1 ;GMRCDVL_GMRCDVL
44 D PRINT^GMRCTIUP(GMRCO,GMRCCT,1,GMRCDET)
45 S GMRCCTS=GMRCCT ;save the line count before printing med and TIU notes
46 D GETMCAR
47 D GETCP
48 D GETRES
49 ; I '$D(GMRCDET) D GETREMOT(GMRCO,TMPGLOB,.GMRCCT)
50 I GMRCCT=GMRCCTS D ;check if count changed for notes or med results
51 . S:+$L($G(SF)) @TMPGLOB@(GMRCCT,0)=GMRCDVL_GMRCDVL,GMRCCT=GMRCCT+1 ;GMRCDVL_GMRCDVL
52 . S @TMPGLOB@(GMRCCT,0)="No local TIU results or Medicine results available for this consult"
53 . S GMRCCT=GMRCCT+1
54 ;
55 I '$D(GMRCDET) D GETCOM
56 I GMRCCT>2 S @TMPGLOB@(GMRCCT,0)="",$P(@TMPGLOB@(GMRCCT,0),"=",81)="",GMRCCT=GMRCCT+1
57 Q
58 ;
59GETMCAR ;load the medicine results into TMPGLOB
60 Q:'$O(^TMP("GMRCR",$J,"MCAR",0))
61 N ND,ND1
62 S ND=0 F S ND=$O(^TMP("GMRCR",$J,"MCAR",ND)) Q:ND=""!(ND?1A.E) D
63 .S @TMPGLOB@(GMRCCT,0)="",$P(^(0),"-",80)="",GMRCCT=GMRCCT+1
64 .S @TMPGLOB@(GMRCCT,0)=TAB_"Medicine Package Report",GMRCCT=GMRCCT+1
65 .S ND1=0 F S ND1=$O(^TMP("GMRCR",$J,"MCAR",ND,ND1)) Q:ND1="" S @TMPGLOB@(GMRCCT,0)=^TMP("GMRCR",$J,"MCAR",ND,ND1,0),GMRCCT=GMRCCT+1
66 .Q
67 K ^TMP("GMRCR",$J,"MCAR")
68 Q
69 ;
70GETCP ; Load up any Clin. Proc. results
71 Q:'$O(^TMP("GMRCR",$J,"CP",0))
72 N ND,ND1
73 S ND=0 F S ND=$O(^TMP("GMRCR",$J,"CP",ND)) Q:ND=""!(ND?1A.E) D
74 .S @TMPGLOB@(GMRCCT,0)="",$P(^(0),"-",80)="",GMRCCT=GMRCCT+1
75 .S @TMPGLOB@(GMRCCT,0)=TAB_"Clinical Procedure Report",GMRCCT=GMRCCT+1
76 .S ND1=0 F S ND1=$O(^TMP("GMRCR",$J,"CP",ND,ND1)) Q:ND1="" D
77 .. S @TMPGLOB@(GMRCCT,0)=^TMP("GMRCR",$J,"CP",ND,ND1,0),GMRCCT=GMRCCT+1
78 .Q
79 K ^TMP("GMRCR",$J,"CP")
80 Q
81 ;
82GETRES ;load the TIU notes into TMPGLOB
83 Q:'+$O(^TMP("GMRCR",$J,"RES",0))
84 ;
85 N ND,ND1
86 S ND=0 F S ND=$O(^TMP("GMRCR",$J,"RES",ND)) Q:(ND="")!(ND?1A.E) D
87 . I $D(^TMP("GMRCR",$J,"RES",ND,"TEXT","GMRCRPT")) D
88 . . S @TMPGLOB@(GMRCCT,0)="",GMRCCT=GMRCCT+1
89 . . S @TMPGLOB@(GMRCCT,0)=$E(GMRCDVL,1,80-$L(^TMP("GMRCR",$J,"RES",ND,"TEXT","GMRCRPT"))\2)_^("GMRCRPT")_$E(GMRCDVL,1,80-$L(^("GMRCRPT"))\2)
90 . . S GMRCCT=GMRCCT+1
91 . S:'$D(^TMP("GMRCR",$J,"RES",ND,"TEXT","GMRCRPT")) @TMPGLOB@(GMRCCT,0)=GMRCDVL_GMRCDVL,GMRCCT=GMRCCT+1
92 . S:$O(^TMP("GMRCR",$J,"RES",ND,"TEXT",0)) @TMPGLOB@(GMRCCT,0)="",GMRCCT=GMRCCT+1
93 . S ND1=0 F S ND1=$O(^TMP("GMRCR",$J,"RES",ND,"TEXT",ND1)) Q:ND1?1A.E!(ND1="") S @TMPGLOB@(GMRCCT,0)=^TMP("GMRCR",$J,"RES",ND,"TEXT",ND1,0),GMRCCT=GMRCCT+1
94 . I $O(^TMP("GMRCR",$J,"RES",ND,"ADD",0)) S ND1=0 F S ND1=$O(^TMP("GMRCR",$J,"RES",ND,"ADD",ND1)) Q:ND1="" D
95 . . S @TMPGLOB@(GMRCCT,0)="",GMRCCT=GMRCCT+1
96 . . S @TMPGLOB@(GMRCCT,0)=TAB_"ADDENDUM TO REPORT",GMRCCT=GMRCCT+1
97 . . S ND2=0 F S ND2=$O(^TMP("GMRCR",$J,"RES",ND,"ADD",ND1,ND2)) Q:ND2=""!(ND2?1A.E) S @TMPGLOB@(GMRCCT,0)=^TMP("GMRCR",$J,"RES",ND,"ADD",ND1,ND2,0),GMRCCT=GMRCCT+1
98 . . Q
99 . Q
100 K ^TMP("GMRCR",$J,"RES")
101 Q
102 ;
103GETCOM ;Get the comments for resolution actions
104 S GMRCSTS=$P($G(^GMR(123,+GMRCO,0)),"^",12)
105 Q:'$$RESOLUS^GMRCAU(+GMRCSTS)
106 ;
107 ;Loop thru actions to find the resolution type actions
108 N ND,ND1,ND2
109 S ND="" F S ND=$O(^GMR(123,+GMRCO,40,"B",ND)) Q:ND="" S ND1=$O(^GMR(123,+GMRCO,40,"B",ND,"")) D
110 . ;
111 . ;Check for resulting action types:complete,sig finding,dc,cancel
112 . N GMRCAIEN
113 . S GMRCAIEN=$P($G(^GMR(123,+GMRCO,40,ND1,0)),"^",2)
114 . I '$$RESOLUA^GMRCAU(GMRCAIEN) Q
115 . ;
116 . ;save the action header info in case there are comments
117 . N GMRCAHDR,GMRCPROV,GMRCENBY,GMRCENDT
118 . D SAVEHDR
119 . ;
120 . ;check for comments, print header on first pass
121 . S ND2=0
122 . F S ND2=$O(^GMR(123,GMRCO,40,ND1,1,ND2)) Q:ND2="" D
123 . . I +$G(GMRCAHDR) D GETHDR ;GMRCAHDR will =1 on first pass
124 . . S @TMPGLOB@(GMRCCT,0)=^GMR(123,GMRCO,40,ND1,1,ND2,0),GMRCCT=GMRCCT+1
125 . . Q
126 . Q
127 Q
128 ;
129SAVEHDR ;Save the action header info to print later if there are comments
130 S GMRCAHDR=1 ;flag to print action header on first pass of comments
131 ;save the provider, entered by and date
132 S GMRCPROV=$P(^GMR(123,GMRCO,40,ND1,0),"^",4),GMRCENBY=$P(^(0),"^",5)
133 S GMRCENDT=$$FMTE^XLFDT($P($G(^GMR(123,GMRCO,40,ND1,0)),"^",3))
134 Q
135 ;
136GETHDR ;Print the comment header if the action had a comment
137 S @TMPGLOB@(GMRCCT,0)="",GMRCCT=GMRCCT+1
138 S @TMPGLOB@(GMRCCT,0)=$$CENTER^GMRCP5D("("_$P($G(^GMR(123.1,GMRCAIEN,0)),"^",8)_" Comment)"),GMRCCT=GMRCCT+1
139 S @TMPGLOB@(GMRCCT,0)=" Entered by: "_$S($L(GMRCENBY):$P(^VA(200,GMRCENBY,0),"^",1),1:"")_" - "_GMRCENDT,GMRCCT=GMRCCT+1
140 I +GMRCPROV S @TMPGLOB@(GMRCCT,0)=" Responsible Clinician: "_$P($G(^VA(200,GMRCPROV,0)),"^",1),GMRCCT=GMRCCT+1
141 K GMRCAHDR
142 Q
143 ;
144GETREMOT(GMRCDA,GMRCAR,GMRCNT) ;retrieve remote results and load up in display
145 ; Input:
146 ; GMRCDA = consult ien from file 123
147 ; GMRCAR = array to return results in (e.g. $NA(^TMP("GMRCAR",$J)) )
148 ; GMRCNT = number within GMRCAR to start placing results (pass by ref)
149 ;
150 ;Output:
151 ; array containing remote results in format:
152 ; ^TMP("GMRCAR",$J,1,0)= result text line 1
153 ; ^TMP("GMRCAR",$J,2,0)= result text line 2
154 ;
155 I '$O(^GMR(123,GMRCDA,51,0)) Q ;no remote results
156 N HDR,GMRCREM,GMRCDATA,FTR,GMRCIO
157 S @GMRCAR@(GMRCNT,0)="",GMRCNT=GMRCNT+1
158 S HDR=$$REPEAT^XLFSTR("*",31)_" REMOTE RESULTS "_$$REPEAT^XLFSTR("*",31)
159 S FTR=$$REPEAT^XLFSTR("*",27)_" END OF REMOTE RESULTS "_$$REPEAT^XLFSTR("*",28)
160 S @GMRCAR@(GMRCNT,0)=HDR,GMRCNT=GMRCNT+1
161 S @GMRCAR@(GMRCNT,0)="",GMRCNT=GMRCNT+1
162 S GMRCREM=0 F S GMRCREM=$O(^GMR(123,GMRCDA,51,GMRCREM)) Q:'GMRCREM D
163 . N GMRCSITE,GMRCRES,GMRCSTA,GMRCRPC,GMRCREM0
164 . S GMRCREM0=^GMR(123,GMRCDA,51,GMRCREM,0) Q:'$L(GMRCREM0)
165 . S GMRCSTA=$$STA^XUAF4($P(GMRCREM0,U,3))
166 . D F4^XUAF4(GMRCSTA,.GMRCSITE) I '+GMRCSITE Q
167 . S GMRCRES=$P(GMRCREM0,U,2)_","
168 . I GMRCRES["TIU" S GMRCRPC="TIU GET RECORD TEXT",GMRCRES=+GMRCRES
169 . I GMRCRES["MCAR" S GMRCRPC="ORQQCN GET MED RESULT DETAILS"
170 . D SAVDEV^%ZISUTL("GMRCIO") ; save off current device settings
171 . D DIRECT^XWB2HL7(.GMRCDATA,GMRCSTA,GMRCRPC,"0",GMRCRES)
172 . D USE^%ZISUTL("GMRCIO") ; restore IO to previous settings
173 . D RMDEV^%ZISUTL("GMRCIO") ; kills data saved in GMRCIO
174 . I '$D(GMRCDATA) Q
175 . S @GMRCAR@(GMRCNT,0)=$$CJ^XLFSTR($S(GMRCRES["MCAR":"Medicine report from:",1:"TIU Document from:"),80),GMRCNT=GMRCNT+1
176 . S @GMRCAR@(GMRCNT,0)=$$CJ^XLFSTR(GMRCSITE("NAME"),80)
177 . S GMRCNT=GMRCNT+1
178 . S @GMRCAR@(GMRCNT,0)=$$CJ^XLFSTR("Associated on: "_$$FMTE^XLFDT(+GMRCREM0),80),GMRCNT=GMRCNT+1
179 . S @GMRCAR@(GMRCNT,0)="",GMRCNT=GMRCNT+1
180 . N GMRCQT S GMRCQT=0
181 . I '$L($G(GMRCDATA)) D
182 .. N I S I="" F S I=$O(GMRCDATA(I)) Q:I=""!(GMRCQT) D
183 ... I $P(GMRCDATA(I),U)=-1 D S GMRCQT=1 Q
184 .... S @GMRCAR@(GMRCNT,0)="Report not currently available"
185 .... S GMRCNT=GMRCNT+1
186 ... S @GMRCAR@(GMRCNT,0)=GMRCDATA(I),GMRCNT=GMRCNT+1
187 . I $L($G(GMRCDATA)),$D(@GMRCDATA) D
188 .. N I S I="" F S I=$O(@GMRCDATA@(I)) Q:I=""!(GMRCQT) D
189 ... I $P(@GMRCDATA@(I),U)=-1 D S GMRCQT=1 Q
190 .... S @GMRCAR@(GMRCNT,0)="Report not currently available"
191 .... S GMRCNT=GMRCNT+1
192 ... S @GMRCAR@(GMRCNT,0)=@GMRCDATA@(I),GMRCNT=GMRCNT+1
193 .. K @GMRCDATA
194 . K GMRCDATA
195 . Q
196 S @GMRCAR@(GMRCNT,0)="",GMRCNT=GMRCNT+1
197 S @GMRCAR@(GMRCNT,0)=FTR,GMRCNT=GMRCNT+1
198 S @GMRCAR@(GMRCNT,0)=""
199 Q
200 ;
201END ;kill off variables and exit
202 I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
203 K DTOUT,DIROUT,DUOUT
204 S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
205 Q
Note: See TracBrowser for help on using the repository browser.