source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLEVUTI0.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1HLEVUTI0 ;O-OIFO/LJA - Event Monitor UTILITIES ;02/04/2004 14:42
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
3 ;
4SENDATA ; Interactively asks for 772 entry and returns Mailman message...
5 ;
6 N CT,IEN,IEN772,RECIP,SCRN,TXT,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
7 ;
8 D HDASK,EXASK
9 ;
10 S SCRN=0
11 ;
12 KILL ^TMP($J,"HLIEN"),^TMP($J,"HLMAIL")
13 ;
14S0 W !!,"The most recent 772 IEN is... ",$O(^HL(772,":"),-1)
15 W !
16 ;
17S1 F D I 'IEN772 Q:'$D(^TMP($J,"HLIEN")) W ! S X=$$YN^HLCSRPT4("Stop entering 772 IENs") W:'X ! Q:X
18 . S IEN772=$$ASK772 QUIT:IEN772'>0 ;->
19 . S ^TMP($J,"HLIEN",+IEN772)=""
20 ;
21S2 I '$D(^TMP($J,"HLIEN")) D QUIT ;->
22 . W " no entries selected..."
23 ;
24S3 W !
25 F D I RECIP']"" W ! S X=$$YN^HLCSRPT4("Stop entering recipients") W:'X ! Q:X
26 . S RECIP=$$FT("Enter RECIPIENT","O") QUIT:RECIP']"" ;->
27 . S XMY(RECIP)=""
28 . W " added..."
29 ;
30S4 I '$D(XMY) D I 'SCRN KILL ^TMP($J,"HLIEN") QUIT ;->
31 . W !!,"No recipients were entered. You may just display the data on-screen."
32 . W !
33 . S SCRN=$$YN^HLCSRPT4("Display to screen","Yes")
34 ;
35S5 W !
36 I 'SCRN QUIT:$$BTE^HLCSMON("Press RETURN to send message, or '^' to exit... ") ;->
37 ;
38 I SCRN W @IOF
39 ;
40 ; Collect data...
41S6 S IEN=0
42 F S IEN=$O(^TMP($J,"HLIEN",IEN)) Q:'IEN D
43 . S IEN(1)=0,TXT="Requested 772#: "_IEN_" ",CT=0
44 . F S IEN(1)=$O(^HLMA("B",+IEN,IEN(1))) Q:'IEN(1) D
45 . . S ^TMP($J,"HLIEN",IEN,IEN(1))=""
46 . . S CT=CT+1
47 . . S TXT=TXT_$S(CT=1:"[773 #s: ",1:",")_IEN(1)
48 . I CT>0 S TXT=TXT_"]"
49 . D ADD(TXT)
50 ;
51S7 D ADD(""),ADD($$CJ^XLFSTR(" Requested Data ",74,"="))
52 S IEN=0
53 F S IEN=$O(^TMP($J,"HLIEN",IEN)) Q:'IEN D
54 . D COLLECT^HLEVUTI1(IEN)
55 ;
56 I SCRN D G SENDATA ;->
57 . W !
58 . S X=$$BTE^HLCSMON("Press RETURN to continue... ")
59 ;
60 ; Email message...
61 S XMTEXT="^TMP("_$J_",""HLMAIL"",",XMDUZ=DUZ
62 S X=$$SITE^VASITE,XMSUB="HL7 Data - "_$P(X,U,2)_" ["_$P(X,U,3)_"]"
63 ;
64S8 D ^XMD
65 ;
66S9 W " ",$S($G(XMZ):" msg# "_XMZ_"...",1:"no msg sent...")
67 ;
68 KILL ^TMP($J,"HLIEN"),^TMP($J,"HLMAIL")
69 ;
70 Q
71 ;
72ADD(TXT) D ADD^HLEVUTI1(TXT)
73 Q
74 ;
75ASK772() ; Ask user for IENs...
76 N CT,I773,IEN,POSX
77ASK7721 S IEN=$$ASKNUM("Enter 772 IEN") QUIT:'IEN "" ;->
78 I $D(^HL(772,+IEN,0)),$O(^HLMA("B",IEN,0))>0 D
79 . W:$X>55 ! W " Adding 773s... "
80 . S POSX=$X
81 . S I773=0,CT=0
82 . F S I773=$O(^HLMA("B",+IEN,I773)) Q:'I773 D
83 . . S CT=CT+1
84 . . I ($X+$L(I773)+3)>IOM S CT=0 W !
85 . . W:$X<POSX ?POSX
86 . . W $S(CT>1:", ",1:"")
87 . . W I773
88 QUIT:$D(^HL(772,+IEN,0)) IEN ;->
89 W " entry not found..."
90 G ASK7721 ;->
91 ;
92FT(PMT,WAY,DEF,LF) ; Free-text DIR request...
93 N DIR,DIRUT,DTOUT,DUOUT,I,X,Y
94 F I=1:1:$G(LF) Q:($Y+3)>IOSL W !
95 S DIR(0)="F"_$G(WAY),DIR("A")=PMT
96 D ^DIR
97 QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) "" ;->
98 Q Y
99 ;
100ASKNUM(PMT,DEF) ; Ask user for a number via DIR...
101 N DIR,DIRUT,DTOUT,DUOUT,IEN,X,Y
102 S DIR(0)="NOA^1:999999999999999999",DIR("A")=PMT_": "
103 I $G(DEF)]"",DEF=+DEF S DIR("B")=DEF
104 D ^DIR
105 QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) "" ;->
106 I $L(Y,773)=3,$P(Y,773,2)>0 D QUIT Y
107 . S IEN=$P(Y,773,2) ; 773 ien...
108 . S IEN=+$G(^HLMA(+IEN,0)) QUIT:'IEN ;->
109 . S Y=IEN
110 . W " selecting 772# ",IEN,"..."
111 Q +Y
112 ;
113HDASK W @IOF,$$CJ^XLFSTR("Send File 772 & 773 Data to Remote Recipient(s)",IOM)
114 W !,$$REPEAT^XLFSTR("=",IOM)
115 QUIT
116 ;
117EXASK N I,T F I=1:1 S T=$T(EXASK+I) QUIT:T'[";;" W !,$P(T,";;",2,99)
118 ;;This utility collects data from the HL Message Text file (#772) and the
119 ;;HL Message Administration file (#773) and forwards the data to local and
120 ;;remote recipients.
121 ;;
122 ;;Before starting this utility you must know the file# 772 internal entry
123 ;;number(s) (IEN). When data is collected for file# 772 entries you have
124 ;;entered, any file# 773 data linked to the selected 772 entries will also be
125 ;;automatically collected and included in the transmitted message.
126 QUIT
127 ;
128GENREP(GBLS,GBLR,NOSUB,SEQ) ; Generic report generator...
129 ; GBLS = Global source...
130 ; GBLR = Global report location...
131 ; NOSUB = # subscript levels...
132 ; --- Must be 2 to 4
133 ; --- 1st subscript must be descriptive of problem, and <15 characters.
134 ; It will be placed in a field of 15 characters.
135 ; --- 2nd subscript must be descriptive of entry, and <15 characters.
136 ; It will be placed in a field of 15 characters.
137 ; If the 2nd subscript is the last subscript, entries at this level
138 ; will be concatenated.
139 ; --- Last subscript must identify entry, and will be concatenated.
140 ; (See RECORD^HLEVX000 for example of data creation.)
141 ; SEQ = Sequential & Numeric. 0/1
142 ; --- If the last subscript is required to be numeric and sequential,
143 ; (like the 870 in and out queues), then combine iens into range
144 ; statements... eg, 25123-25131(#9)
145 ;
146 ; Stop all event monitoring to enable on-site debugging...
147 QUIT:$G(^TMP("HLEVFLAG",$J))["STOP" ;->
148 ;
149 S SEQ=+$G(SEQ)
150 ;
151 ; Make sure you don't return "leftovers" from before...
152 KILL @GBLR
153 ;
154 ; Checks...
155 QUIT:'$D(@GBLS)!($G(NOSUB)'>1) ;->
156 ;
157 ; Create header...
158 S TXT="List of problems" D STORE(0)
159 S TXT=$$REPEAT^XLFSTR("-",74) D STORE(0)
160 S TXT=""
161 ;
162 ; Setup & looping...
163 S PROBL="",TXT="",PNO=0
164 F S PROBL=$O(@GBLS@(PROBL)) Q:PROBL']"" D
165 . S PNO=PNO+1
166 . S TXT=$E(PROBL_$$REPEAT^XLFSTR(" ",15),1,15)
167 . S SUB2=""
168 . F S SUB2=$O(@GBLS@(PROBL,SUB2)) Q:SUB2']"" D
169 . . I NOSUB=2 D CONCAT($$SUBSTORE(PROBL,SUB2),15) QUIT ;->
170 . . S TXT=$E($E(TXT,1,15)_$E(SUB2,1,15)_$$REPEAT^XLFSTR(" ",30),1,30)
171 . . I SEQ,NOSUB=3 D CONDENSE(PROBL,SUB2)
172 . . S SUB3=""
173 . . F S SUB3=$O(@GBLS@(PROBL,SUB2,SUB3)) Q:SUB3']"" D
174 . . . I NOSUB=3 D CONCAT($$SUBSTORE(PROBL,SUB2,SUB3),30) QUIT ;->
175 . . . S TXT=$E($E(TXT,1,30)_$E(SUB3,1,30)_$$REPEAT^XLFSTR(" ",45),1,45)
176 . . . X "F I=$L(TXT):-1:1 Q:$E(TXT,I)'="" """ S POSX=I+2
177 . . . S TXT=$E(TXT_$$REPEAT^XLFSTR(" ",45),1,POSX)
178 . . . I SEQ,NOSUB=4 D CONDENSE(PROBL,SUB2,SUB3)
179 . . . S SUB4=""
180 . . . F S SUB4=$O(@GBLS@(PROBL,SUB2,SUB3,SUB4)) Q:SUB4']"" D
181 . . . . D CONCAT($$SUBSTORE(PROBL,SUB2,SUB3,SUB4),POSX)
182 . . . . ;Subscript limit!
183 . . . I TXT]"" D STORE(POSX)
184 . . I TXT]"" D STORE(30)
185 . I TXT]"" D STORE(15)
186 I TXT D STORE(0)
187 ;
188 S TXT="" D STORE(0)
189 S TXT="Problem totals" D STORE(0)
190 S TXT=$$REPEAT^XLFSTR("-",74) D STORE(0)
191 ;
192 S PROBL=""
193 F S PROBL=$O(@GBLS@(PROBL)) Q:PROBL']"" D
194 . S NUM=$G(@GBLS@(PROBL)) Q:NUM']"" ;->
195 . S TXT=$E(PROBL_$$REPEAT^XLFSTR(" ",15),1,15)_" #"_NUM
196 . D STORE(30)
197 ;
198 Q
199 ;
200SUBSTORE(S1,S2,S3,S4) ; Should subscript be stored, or condensed value?
201 ; GBLS -- req
202 N VAL
203 ;
204 I $G(S4)]"" D QUIT S4 ;->
205 . S VAL=$G(@GBLS@(S1,S2,S3,S4)) QUIT:VAL']"" ;->
206 . S S4=VAL
207 ;
208 I $G(S3)]"" D QUIT S3 ;->
209 . S VAL=$G(@GBLS@(S1,S2,S3)) QUIT:VAL']"" ;->
210 . S S3=VAL
211 ;
212 I $G(S2)]"" D QUIT S2 ;->
213 . S VAL=$G(@GBLS@(S1,S2)) QUIT:VAL']"" ;->
214 . S S2=VAL
215 ;
216 Q S2
217 ;
218CONDENSE(PROBL,SUB2,SUB3) ; Condense sequential numerics...
219 N DIFF,FIRST,GBL,IEN,LAST,NO
220 ;
221 I $G(SUB3)']"" S GBL=$$COND2GBL(PROBL,SUB2)
222 I $G(SUB3)]"" S GBL=$$COND3GBL(PROBL,SUB2,SUB3)
223 ;
224 S (FIRST,LAST)=$O(@GBL@(0)) Q:LAST'>0 ;->
225 S IEN=0
226 F S IEN=$O(@GBL@(IEN)) Q:'IEN D
227 .
228 . QUIT:IEN=LAST ;-> Must be first $O...
229 .
230 . ; If IEN isn't one more than the last IEN, seq string broken
231 . I IEN'=(LAST+1) D SEQBR
232 .
233 . ; Record the last IEN found...
234 . S LAST=IEN
235 ;
236 ; If the last entry is not one more # than the first entry...
237 I LAST'=(FIRST+1) D SEQBR
238 ;
239 Q
240 ;
241SEQBR ; Sequence BRoken actions...
242 ; FIRST,GBL,IEN,LAST -- req --> FIRST,@GBL[S] (reset)
243 N DIFF,VAL
244 S DIFF=LAST-FIRST+1 ; # IENs difference...
245 S VAL=FIRST_":"_LAST_"(#"_DIFF_")"
246 I (($L(LAST)*DIFF)+(DIFF))<$L(VAL) D QUIT ;-> No space savings
247 . S FIRST=IEN
248 S @GBL@(FIRST)=VAL
249 F NO=FIRST+1:1:LAST KILL @GBL@(NO)
250 S FIRST=IEN
251 Q
252 ;
253COND2GBL(PROBL,SUB2) ; Return global for NOSUB=2 looping...
254 ; GBLS -- req
255 N GBL
256 S GBL=$E(GBLS,1,$L(GBLS)-1)_","_$$AQ(PROBL)_","_$$AQ(SUB2)_")"
257 Q GBL
258 ;
259COND3GBL(PROBL,SUB2,SUB3) ; Return global for NOSUM=3 looping...
260 ; GBLS -- req
261 N GBL
262 S GBL=$E(GBLS,1,$L(GBLS)-1)_","_$$AQ(PROBL)_","_$$AQ(SUB2)_","_$$AQ(SUB3)_")"
263 Q GBL
264 ;
265AQ(VAL) ; Add quotes around non-numeric values...
266 QUIT:VAL=+VAL VAL ;-> Numeric...
267 QUIT """"_VAL_""""
268 ;
269CONCAT(VAL,PAD) ; Concatenate, separated w/commas, the VALs
270 ; TXT -- req
271 I ($L(TXT)+$L(VAL)+1)>74 D STORE(PAD)
272 S TXT=TXT_$S($L(TXT)>PAD:",",1:"")_VAL
273 Q
274 ;
275STORE(PAD) ; Store data in @GBLR@ in report-ready format
276 ; GBLR,TXT -- req
277 N NO
278 S NO=$O(@GBLR@(":"),-1)+1
279 S @GBLR@(+NO)=TXT
280 S TXT=$$REPEAT^XLFSTR(" ",PAD)
281 Q
282 ;
283EOR ;HLEVUTI0 - Event Monitor UTILITIES ;5/16/03 14:42
Note: See TracBrowser for help on using the repository browser.