source: FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLEX1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1RAHLEX1 ;HIRMFO/REL,CRT - RAD/NUC MED HL7 Voice Reporting Exception Protocols ; 02/02/99
2 ;;5.0;Radiology/Nuclear Medicine;**12**;Mar 16, 1998
3 ; Last Edited by CRT
4 ;
5 Q
6EN ; Print Exception List Protocol - Called from ListMan ONLY
7 ;
8 D CLEAR^VALM1
9 ;
10DEVICE ; Select device to print report
11 ;
12 S %ZIS="Q",%ZIS("B")="",%ZIS("A")="Select Device: "
13 D ^%ZIS K %ZIS I POP K DTOUT,DUOUT,POP G END
14 ;
15 I '$D(IO("Q")) G PRINT
16 ;
17 S ZTRTN="PRINT^RAHLEX1"
18 S ZTDESC="Rad/Nuc Med HL7 Voice Reprting Errors List."
19 ;
20 S ZTSAVE("RAHL7SDT")=""
21 S ZTSAVE("RAHL7EDT")=""
22 S ZTSAVE("^TMP($J,""RAHLAPP"",")=""
23 S ZTSAVE("^TMP($J,""RAHLUSR"",")=""
24 ;S ZTSAVE("^TMP($J,""RAHLSRT"",")="" ; Causes Subscript error !?!?!?!
25 ;
26 D ^%ZTLOAD
27 I +$G(ZTSK("D"))>0 W !?5,"Request Queued, Task #: "_$G(ZTSK)
28 I +$G(ZTSK("D"))=0 W !?5,"Request Cancelled"
29 H 1.5
30 D ^%ZISC,HOME^%ZIS K %X,%Y,%XX,%YY,IO("Q")
31 G END
32 ;
33PRINT ; Start printing the report to the requested device - using ^TMP
34 ; RAPN = Page Number
35 ; WAIT = "^" if user has requested to quit prematurely
36 ;
37 I $D(ZTQUEUED) D
38 .S ZTREQ="@"
39 .S RAHLSRT="^TMP($J,""RAHLSRT"")"
40 .S RAHLUSR="^TMP($J,""RAHLUSR"")"
41 .S RAHLAPP="^TMP($J,""RAHLAPP"")"
42 S WAIT="",RAPN=0,RAPL=0
43 I '$D(@RAHLSRT) D SETTMP^RAHLEX
44 ;
45 U IO
46 ;
47 S RASEND="" F S RASEND=$O(@RAHLSRT@(RASEND)) Q:(RASEND="")!(WAIT="^") D
48 .S RAPN=RAPN+1 D:RAPN'=1 WAIT^RAHLEX1 Q:WAIT="^" D HEADER^RAHLEX1
49 .S RADATE="" F S RADATE=$O(@RAHLSRT@(RASEND,RADATE)) Q:(RADATE="")!(WAIT="^") D
50 ..S RADPT="" F S RADPT=$O(@RAHLSRT@(RASEND,RADATE,RADPT)) Q:(RADPT="")!(WAIT="^") D
51 ...S RACN="" F S RACN=$O(@RAHLSRT@(RASEND,RADATE,RADPT,RACN)) Q:(RACN="")!(WAIT="^") D
52 ....S RAUSER="" F S RAUSER=$O(@RAHLSRT@(RASEND,RADATE,RADPT,RACN,RAUSER)) Q:(RAUSER="")!(WAIT="^") D
53 .....I $Y+5>IOSL S RAPN=RAPN+1 D WAIT^RAHLEX1 Q:WAIT="^" D HEADER^RAHLEX1
54 .....S RAEXCP=@RAHLSRT@(RASEND,RADATE,RADPT,RACN,RAUSER,"ERR")
55 .....I $D(ZTQUEUED) D STOPCHK^RAUTL9 I $G(ZTSTOP)=1 S WAIT="^" Q
56 .....D FORMAT^RAHLEX1
57 ;
58 I $Y+3>IOSL S RAPN=RAPN+1 D WAIT^RAHLEX1 G END:WAIT="^" D HEADER^RAHLEX1
59 D EN^DDIOL("** End of Report **","","!?19")
60 D EN^DDIOL("","","!")
61 D WAIT^RAHLEX1
62 ;
63END ;
64 I $D(ZTQUEUED) D
65 .K @RAHLSRT,RAHLSRT,@RAHLUSR,RAHLUSR,@RAHLAPP,RAHLAPP
66 K X,Y,NOW,%,RASEND,RAUSER,RADATE,RADPT,RACN,RAEXCP,RAPN,RAPL
67 K DTOUT,DUOUT,ZTRTN,ZTDESC,ZTSAVE,ZTSK,WAIT,ZTSTOP
68 D CLOSE^RAUTL
69 D HOME^%ZIS
70 S VALMBCK="R"
71 Q
72 ;
73 ;
74WAIT ; Prompt user to hit RETURN for next page
75 ;
76 I $E(IOST,1,2)'="C-" S WAIT="" Q ; Don't prompt if report queued
77 ;
78 S DIR(0)="E"
79 S (DIR("?"),DIR("??"))=""
80 D ^DIR K DIR
81 I Y=""!(Y=0) S WAIT="^"
82 Q
83 ;
84HEADER ; Report/Page Header
85 ;
86 K RAHDR
87 I '($D(ZTQUEUED)&(RAPN=1)) W @IOF
88 S RAHDR(1)=$$REPEAT^XLFSTR("=",80)
89 S RAHDR(1,"F")=""
90 D NOW^%DTC,YX^%DTC S NOW="Printed: "_$P(Y,"@")_" "_$E($P(Y,"@",2),1,5)
91 S TITLE="HL7 Voice Reporting Errors "
92 S PAGE="Page: "_RAPN
93 S RAHDR(2)=TITLE
94 S RAHDR(2,"F")="!?1" ; Left Justified
95 S RAHDR(3)=PAGE
96 S RAHDR(3,"F")="?"_(78-$L(PAGE)) ; Right Justified
97 S TITLE="("_RASEND_" - RADIOLOGY/NUCLEAR MEDICINE)"
98 S RAHDR(4)=TITLE
99 S RAHDR(4,"F")="!?1" ; Left Justified
100 S RAHDR(5)=NOW
101 S RAHDR(5,"F")="?"_(78-$L(NOW)) ; Right Justified
102 S RAHDR(6)=$$REPEAT^XLFSTR("=",78)
103 S RAHDR(6,"F")="!?1"
104 S RAHDR(7)=""
105 D EN^DDIOL(.RAHDR)
106 K RAHDR,PAGE,TITLE,NOW
107 Q
108 ;
109FORMAT ; Format of Report
110 ;
111 K RADSP
112 D DISDATE^RAHLEX(" at ")
113 S RADSP(1)="Exception Date: "_XRADATE
114 S RADSP(1,"F")="!?1"
115 S RADSP(2)="User: "_$E(RAUSER,1,24)
116 S RADSP(2,"F")="?50"
117 S RADSP(3)="Patient Name: "_RADPT
118 S RADSP(3,"F")="!?1"
119 S RADSP(4)="Case: "_RACN
120 S RADSP(4,"F")="?50"
121 S RADSP(5)="Reason Rejected: "_RAEXCP
122 S RADSP(5,"F")="!?1"
123 S RADSP(6)=""
124 D EN^DDIOL(.RADSP)
125 K RADSP,XRADATE
126 Q
127 ;
128 ; =================================================================
129 ;
130NXTAPP(DIR) ; Next or Previous Exception Protocol
131 ; VALMLST = Last ListMan Line Displayed
132 ; VALMBG = First ListMan Line Displayed
133 ;
134 S DIR=$G(DIR)
135 S VALMBCK=""
136 I DIR=1 D G NEND ; Next Exception forward
137 .S RALINE=VALMLST
138 .I '$D(@RAHLSEL@(RALINE)) D
139 ..S RALINE=$O(@RAHLSEL@(RALINE))
140 ..S:RALINE="" RALINE=VALMLST
141 .S RALINE=RALINE-14
142 .S:RALINE<1 RALINE=1
143 .I VALMBG'=RALINE S VALMBG=RALINE,VALMBCK="R"
144 ; Previous Exception
145 S RALINE=$O(@RAHLSEL@(VALMBG),-1)
146 S:('RALINE) RALINE=1
147 I RALINE'=VALMBG S VALMBG=RALINE,VALMBCK="R"
148 ;
149NEND K RALINE,DIR
150 Q
151 ;
152 ; =================================================================
153 ;
154RESEND ; Re-Submit an HL7 Message Protocol
155 ;
156 K VALMSG
157 D EN^DDIOL(" ","","!!!")
158 I HL7EX<1 D Q
159 .S VALMSG="Function not available - no messages to re-submit"
160 .S VALMBCK=""
161 .W $C(7)
162RESEND1 K DIR
163 S DIR(0)="NAO^1:"_HL7EX_":0"
164 S DIR("A")="Select HL7 Exception (1-"_HL7EX_") :"
165 S DIR("?")="Select one of the exceptions to Re-submit"
166 S DIR("??")="^D RESH^RAHLEX1"
167 D ^DIR K DIR I $D(DTOUT)!(Y="")!(Y="^") S VALMBCK="R" Q
168 ;
169 S RAXIEN="" F RAI=1:1:Y S RAXIEN=$O(@RAHLSEL@(RAXIEN))
170 S RALINE=RAXIEN
171 I @RAHLEX@(RALINE+1,0)'["Error:" D G RESEND1
172 .W $C(7)
173 .D EN^DDIOL("Message already re-submitted or deleted. Not available for selection","","!?5")
174 ;
175 S RAXIEN=@RAHLSEL@(RAXIEN)
176 S HLIEN=$$GET1^DIQ(79.3,RAXIEN,.05,"I")
177 D EN^DDIOL("Re-sending Message #"_HLIEN_"...","","!?5")
178 H 1.5
179 ;
180 S RESEND=$$REPROC^HLUTIL(HLIEN,"RAHLTCPB")
181 I RESEND'=0 D ; Fail !!
182 .W $C(7)
183 .S VALMSG="Error - Original message may have been purged"
184 I RESEND=0 D ; Success !!
185 .S HLMTIENS=HLIEN
186 .S PURGE=$$SETPURG^HLUTIL(0)
187 .I PURGE'=0 W $C(7) S VALMSG="Cannot change purge flag for message"
188 .S %H=$H D YX^%DTC
189 .S @RAHLEX@(RALINE+1,0)=IOINHI_" Message Re-submitted on "_Y_IOINORM
190 .S DIK="^RA(79.3,",DA=RAXIEN D ^DIK ; Remove old report entry
191 ;
192REND K RAI,RAXIEN,RALINE,RESEND,HLMTIENS,HLIEN,PURGE,DA,DIK,Y,%H
193 ; Also HLUTIL calls
194 K HL,HLA,HLARYTYP,HLECH,HLEID,HLFORMAT,HLFS,HLHDR,HLQ,HLRESLTA
195 K VA,VADM,HLEIDS
196 S VALMBCK="R"
197 Q
198 ;
199RESH ; Extended help
200 D EN^DDIOL("Select one of the HL7 exceptions to Re-submit","","!")
201 D EN^DDIOL("(If re-submitted successfully the exception will be deleted from file)","","!")
202 Q
203 ;
204 ; =================================================================
205 ;
206DELETE ; Function to delete Exception Node
207 ;
208 K VALMSG
209 D EN^DDIOL(" ","","!!!")
210 I HL7EX<1 D Q
211 .S VALMSG="Function not available - No messages to delete"
212 .S VALMBCK=""
213 .W $C(7)
214DELETE1 K DIR
215 S DIR(0)="NAO^1:"_HL7EX_":0"
216 S DIR("A")="Select HL7 Exception (1-"_HL7EX_") :"
217 S DIR("?")="Select one of the exceptions to Delete"
218 S DIR("??")="^D DELH^RAHLEX1"
219 D ^DIR K DIR I $D(DTOUT)!(Y="")!(Y="^") S VALMBCK="R" Q
220 ;
221 S RAXIEN="" F RAI=1:1:Y S RAXIEN=$O(@RAHLSEL@(RAXIEN))
222 S RALINE=RAXIEN
223 I @RAHLEX@(RALINE+1,0)'["Error:" D G DELETE1
224 .W $C(7)
225 .D EN^DDIOL("Exception already re-submitted or deleted. Not available for selection","","!?5")
226 ;
227 S RAXIEN=@RAHLSEL@(RAXIEN)
228 S HLIEN=$$GET1^DIQ(79.3,RAXIEN,.05,"I")
229 D EN^DDIOL("Deleting Exception...","","!?5")
230 H 1.5
231 ;
232 S DIK="^RA(79.3,",DA=RAXIEN D ^DIK
233 ;
234 S %H=$H D YX^%DTC
235 S @RAHLEX@(RALINE+1,0)=IOINHI_" Reported Exception Deleted on "_Y_IOINORM
236 ;
237DEND K RAI,RAXIEN,DA,DIK,HLIEN,RALINE,%H,Y
238 S VALMBCK="R"
239 Q
240 ;
241DELH D EN^DDIOL("Select one of the HL7 exceptions to Delete","","!")
242 D EN^DDIOL("(Note: Re-submitting a message is a more effective way to delete an exception)","","!")
243 Q
244 ;
245 ; =================================================================
Note: See TracBrowser for help on using the repository browser.