source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7UTILA.m@ 1674

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1LA7UTILA ;DALOI/JMC - Browse UI message ; 6/19/96 09:00
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**23,27,46,64**;Sep 27, 1994
3 ;
4EN ; Select a Universal Interface message to browse.
5 D EXIT ; Housekeeping before we start.
6 S DIC="^LAHM(62.49,",DIC("W")="W "" "",$P(^(0),U,6)"
7 S VAUTVB="LA7LIST",VAUTSTR="Message",VAUTNI=2,VAUTNALL=1
8 D FIRST^VAUTOMA
9 I Y<1!('$O(LA7LIST(0))) D EXIT Q
10 ;
11DEV ; Called from LA7UXQA - when viewing message via alert system.
12 S DIR(0)="YO",DIR("A")="Parse message fields based on HL7 segments",DIR("B")="NO"
13 D ^DIR K DIR
14 I $D(DIRUT) D EXIT Q
15 S LA7PARS=+Y ; Save flag to parse message.
16 I LA7PARS D I $D(DIRUT) D EXIT Q
17 . S DIR(0)="YO",DIR("A")="Suppress blank segments",DIR("B")="YES"
18 . D ^DIR K DIR Q:$D(DIRUT)
19 . S $P(LA7PARS,"^",2)=+Y
20 ; Ask device and task if requested.
21 S %ZIS="Q" D ^%ZIS K %ZIS
22 I POP D EXIT Q
23 I $D(IO("Q")) D G EXIT
24 . S LA7TEST=0 ; Tasked - not a CRT.
25 . S ZTRTN="DQ^LA7UTILA",ZTDESC="Print LA7 UI Messages",ZTSAVE("LA7*")=""
26 . D ^%ZTLOAD
27 . W !,"Request ",$S($D(ZTSK):"",1:"NOT "),"Queued"
28 . K IO("Q")
29 U IO(0)
30 ;
31 ; Flag to determine if okay to use browser (default=true).
32 S LA7TEST=1
33 ;
34 ; Home device not current device or using non-CRT terminal type.
35 I IO'=IO(0)!($E(IOST,1,2)'="C-") S LA7TEST=0
36 ;
37 ; If not queued and home device then test for browser
38 I LA7TEST,'$$TEST^DDBRT D
39 . S LA7TEST=0 ; Unable to use browser.
40 . W !,$C(7),"This terminal does not support the needed functionality to use the Browser!"
41 . W !,"Will use standard FileMan Data Display.",!
42 I LA7TEST D
43 . N DIR,DIRUT,DTOUT,DUOUT,X,Y
44 . S DIR(0)="YO",DIR("A")="Use Browser to display message(s)",DIR("B")="YES"
45 . D ^DIR
46 . I $D(DIRUT) S LA7TEST=-1 Q
47 . S LA7TEST=+Y
48 I LA7TEST<0 D EXIT Q
49 D WAIT^DICD
50 ;
51DQ ; Dequeue entry point.
52 U IO
53 K ^TMP($J),^TMP("DDB",$J)
54 S LA7IEN=0
55 F S LA7IEN=$O(LA7LIST(LA7IEN)) Q:'LA7IEN S LA7J=1 D BRO("LA7 UI Message Display",LA7IEN,LA7IEN)
56 I LA7TEST D Q ; Display using browser.
57 . D DOCLIST^DDBR("^TMP($J,""LIST"")","R")
58 . D EXIT
59 S (LA7IEN,LA7QUIT)=0
60 S HDR=""
61 F S HDR=$O(^TMP($J,"LIST",HDR)) Q:HDR="" D Q:LA7QUIT
62 . I IOST["C-" W @IOF
63 . W $$CJ^XLFSTR(HDR,IOM," "),!
64 . S LA7ROOT=^TMP($J,"LIST",HDR),LA7ROOT=$E(LA7ROOT,1,$L(LA7ROOT)-1)
65 . S LA7CONT=0 ; Flag to determine if line has been continue on followng line.
66 . S I=0
67 . F S I=$O(@(LA7ROOT_","_I_")")) Q:'I D Q:LA7QUIT
68 . . S LA7X=^(I)
69 . . I LA7X="" W ! Q ; Print blank separator line
70 . . F S LA7Y=$E(LA7X,1,IOM-1) Q:LA7Y="" D Q:LA7QUIT
71 . . . S LA7X=$E(LA7X,IOM,$L(LA7X))
72 . . . I $L(LA7X) S LA7CONT=1,LA7X="--->"_LA7X
73 . . . W !,LA7Y
74 . . . I $Y+7>IOSL D EOP W @IOF Q:LA7QUIT
75 . I 'LA7QUIT D EOP
76 . W !!
77 D EXIT
78 Q
79 ;
80BRO(LA7HDR,LA7DOC,LA7IEN,LA7J) ; Setup text for browser.
81 ; Called from above.
82 N LA7,LA7DT,LA7X,I,J,K,X,Y
83 D GETS^DIQ(62.49,LA7IEN,".01:149;160;161","ENR","LA7") ; Retrieve data from file 62.49
84 S J=$G(LA7J,1)
85 S ^TMP("DDB",$J,LA7DOC,J)=" ["_$$CJ^XLFSTR(" Message Statistics ",IOM-4,"*")_"]"
86 S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
87 S I="LA7(62.49)",K=0,J(0)=J
88 F S I=$Q(@I) Q:I="" Q:$QS(I,1)'=62.49 D
89 . S X=$QS(I,3)_": "_@I
90 . I K=0,$L(X)>((IOM\2)-1) S K=1,Y=""
91 . I K=0 S K=1,Y=$$LJ^XLFSTR(X,(IOM\2)+2)
92 . E S K=0,J=J+1,^TMP("DDB",$J,LA7DOC,J)=Y_$QS(I,3)_": "_@I
93 I K=1 S J=J+1,^TMP("DDB",$J,LA7DOC,J)=Y
94 I J(0)=J S J=J+1,^TMP("DDB",$J,LA7DOC,J)=$$CJ^XLFSTR(" [None Found]",IOM-1)
95 S LA7X=$G(^LAHM(62.49,LA7IEN,0))
96 S LA7DT=$P(LA7X,"^",5) ; Date/time message received
97 S LA7DT(0)=LA7DT\1 ; Date message received.
98 S LA7DT(1)=LA7DT#1 ; Time message received.
99 S K="LA7ERR^"_(LA7DT(0)-.1)
100 S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
101 S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" ["_$$CJ^XLFSTR(" Error Message ",IOM-4,"*")_"]"
102 S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
103 S J(0)=J ; Save value of "J", determine if any error message found.
104 F S K=$O(^XTMP(K)) Q:K=""!($P(K,"^")'="LA7ERR") D
105 . I LA7DT(0)=$P(K,"^",2) S I=LA7DT(1)-.00000001 ; Start looking after date/time of message.
106 . E S I=0
107 . F S I=$O(^XTMP(K,I)) Q:'I D
108 . . S X=^XTMP(K,I)
109 . . I $P(X,"^",2)=LA7IEN D
110 . . . S J=J+1,^TMP("DDB",$J,LA7DOC,J)="Date: "_$$FMTE^XLFDT($P(K,"^",2)+I,1)
111 . . . S J=J+1,^TMP("DDB",$J,LA7DOC,J)="Text: "_$P(X,"^",4) ; Get error message.
112 . . . S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
113 I J(0)=J S J=J+1,^TMP("DDB",$J,LA7DOC,J)=$$CJ^XLFSTR("[None Found]",IOM-1)
114 S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
115 S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" ["_$$CJ^XLFSTR(" Text of Message ",IOM-4,"*")_"]"
116 S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
117 ;
118 ; Retrieve text of message from 62.49.
119 S I=0,J(0)=J
120 F S I=$O(^LAHM(62.49,LA7IEN,150,I)) Q:'I D
121 . S J=J+1
122 . S ^TMP("DDB",$J,LA7DOC,J)=$G(^LAHM(62.49,LA7IEN,150,I,0))
123 . ; Parse each message segment.
124 . I '$G(LA7PARS) Q
125 . S X=$G(^LAHM(62.49,LA7IEN,150,I,0))
126 . ; Obtain field separator and encoding characters.
127 . I $E(X,1,3)="MSH" S HLFS=$E(X,4),HLECH=$E(X,5,8)
128 . ; Segement ID code.
129 . S Y=$P(X,HLFS)
130 . ; Parse fields.
131 . D PF
132 ;
133 I J(0)=J S J=J+1,^TMP("DDB",$J,LA7DOC,J)=$$CJ^XLFSTR("[None Found]",IOM-1)
134 ;
135 ; If linked to another entry go pasrse that entry also
136 I $P(LA7X,"^",7) D BRO("LA7 UI Message Display",LA7DOC,$P(LA7X,"^",7),J)
137 ;
138 ; Setup document list.
139 S LA7HDR=LA7HDR_" Msg #"_LA7DOC_" - "_$P(^LAHM(62.49,LA7DOC,0),"^",6)
140 S ^TMP($J,"LIST",LA7HDR)="^TMP(""DDB"",$J,"_LA7DOC_")"
141 Q
142 ;
143PF ; Parse message fields
144 ;
145 F K=$S(Y="MSH":1,1:2):1:$L(X,HLFS) D
146 . S Z=$P(X,HLFS,K)
147 . ; Don't display blank segments.
148 . I $P(LA7PARS,"^",2),Z="" Q
149 . S J=J+1
150 . I Y="MSH" S V=Y_"-"_K_" = "_$S(K=1:HLFS,1:$P(X,HLFS,K))
151 . E S V=Y_"-"_(K-1)_" = "_$P(X,HLFS,K)
152 . S ^TMP("DDB",$J,LA7DOC,J)=V
153 . I Z="" Q ; Don't parse blank segments.
154 . I Y="MSH",K<3 Q ; Don't parse MSH-1/2.
155 . ; Parse components.
156 . D PC
157 ; Separate segments with blank line.
158 S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
159 Q
160 ;
161PC ; Parse field components
162 ;
163 F L=1:1:$L(Z,$E(HLECH,1)) D
164 . S V=$P(Z,$E(HLECH,1),L) Q:V=""
165 . I Z[$E(HLECH,1) D
166 . . S J=J+1
167 . . S ^TMP("DDB",$J,LA7DOC,J)=Y_"-"_($S(Y="MSH":K,1:K-1))_"-"_L_" = "_V
168 . I V'[$E(HLECH,2) Q
169 . ; Parse repetition of components.
170 . F M=1:1:$L(V,$E(HLECH,2)) D
171 . . S J=J+1
172 . . S ^TMP("DDB",$J,LA7DOC,J)=Y_"-"_($S(Y="MSH":K,1:K-1))_"-"_L_"-"_M_" = "_$P(V,$E(HLECH,2),M)
173 Q
174 ;
175EOP ; End of page.
176 I LA7CONT W !!,"NOTE: '--->' indicates continuation of previous line." S LA7CONT=0
177 I $D(ZTQUEUED)!(IOST'["C-") Q
178 S DIR(0)="E" D ^DIR K DIR S:Y'=1 LA7QUIT=1
179 Q
180 ;
181EXIT ; Clean up.
182 W @IOF
183 I $D(ZTQUEUED) S ZTREQ="@"
184 E D ^%ZISC
185 K ^TMP($J),^TMP("DDB",$J)
186 K LA7CONT,LA7IEN,LA7J,LA7LIST,LA7PARS,LA7QUIT,LA7ROOT,LA7TEST,LA7X,LA7Y
187 K DIC,DIR,HDR,HLECH,HLFS,I,J,K,L,M,V,X,Y,Z
188 K VAUTVB,VAUTNI,VAUTSTR,VAUTNALL
189 Q
190 ;
191 ;
192FMT(LA76249) ; Perform test to determine storage format, each segment on one
193 ; node or segment has continuation nodes separated with null "" nodes.
194 ; Call with LA76249 = ien of entry in file #62.49
195 ; Returns LA7Y = 0-old format, 1-new format
196 ;
197 N LA7END,LA7Y,LA7ROOT
198 S (LA7END,LA7Y)=0,LA7ROOT="^LAHM(62.49,LA76249,150,0)"
199 F S LA7ROOT=$Q(@LA7ROOT) Q:LA7END D
200 . I $QS(LA7ROOT,1)'="62.49"!($QS(LA7ROOT,2)'=LA76249)!($QS(LA7ROOT,3)'=150) S LA7END=1 Q
201 . I @LA7ROOT="" S (LA7Y,LA7END)=1
202 Q LA7Y
Note: See TracBrowser for help on using the repository browser.