203 lines
7.0 KiB
Mathematica
203 lines
7.0 KiB
Mathematica
LA7UTILA ;DALOI/JMC - Browse UI message ; 6/19/96 09:00
|
|
;;5.2;AUTOMATED LAB INSTRUMENTS;**23,27,46,64**;Sep 27, 1994
|
|
;
|
|
EN ; Select a Universal Interface message to browse.
|
|
D EXIT ; Housekeeping before we start.
|
|
S DIC="^LAHM(62.49,",DIC("W")="W "" "",$P(^(0),U,6)"
|
|
S VAUTVB="LA7LIST",VAUTSTR="Message",VAUTNI=2,VAUTNALL=1
|
|
D FIRST^VAUTOMA
|
|
I Y<1!('$O(LA7LIST(0))) D EXIT Q
|
|
;
|
|
DEV ; Called from LA7UXQA - when viewing message via alert system.
|
|
S DIR(0)="YO",DIR("A")="Parse message fields based on HL7 segments",DIR("B")="NO"
|
|
D ^DIR K DIR
|
|
I $D(DIRUT) D EXIT Q
|
|
S LA7PARS=+Y ; Save flag to parse message.
|
|
I LA7PARS D I $D(DIRUT) D EXIT Q
|
|
. S DIR(0)="YO",DIR("A")="Suppress blank segments",DIR("B")="YES"
|
|
. D ^DIR K DIR Q:$D(DIRUT)
|
|
. S $P(LA7PARS,"^",2)=+Y
|
|
; Ask device and task if requested.
|
|
S %ZIS="Q" D ^%ZIS K %ZIS
|
|
I POP D EXIT Q
|
|
I $D(IO("Q")) D G EXIT
|
|
. S LA7TEST=0 ; Tasked - not a CRT.
|
|
. S ZTRTN="DQ^LA7UTILA",ZTDESC="Print LA7 UI Messages",ZTSAVE("LA7*")=""
|
|
. D ^%ZTLOAD
|
|
. W !,"Request ",$S($D(ZTSK):"",1:"NOT "),"Queued"
|
|
. K IO("Q")
|
|
U IO(0)
|
|
;
|
|
; Flag to determine if okay to use browser (default=true).
|
|
S LA7TEST=1
|
|
;
|
|
; Home device not current device or using non-CRT terminal type.
|
|
I IO'=IO(0)!($E(IOST,1,2)'="C-") S LA7TEST=0
|
|
;
|
|
; If not queued and home device then test for browser
|
|
I LA7TEST,'$$TEST^DDBRT D
|
|
. S LA7TEST=0 ; Unable to use browser.
|
|
. W !,$C(7),"This terminal does not support the needed functionality to use the Browser!"
|
|
. W !,"Will use standard FileMan Data Display.",!
|
|
I LA7TEST D
|
|
. N DIR,DIRUT,DTOUT,DUOUT,X,Y
|
|
. S DIR(0)="YO",DIR("A")="Use Browser to display message(s)",DIR("B")="YES"
|
|
. D ^DIR
|
|
. I $D(DIRUT) S LA7TEST=-1 Q
|
|
. S LA7TEST=+Y
|
|
I LA7TEST<0 D EXIT Q
|
|
D WAIT^DICD
|
|
;
|
|
DQ ; Dequeue entry point.
|
|
U IO
|
|
K ^TMP($J),^TMP("DDB",$J)
|
|
S LA7IEN=0
|
|
F S LA7IEN=$O(LA7LIST(LA7IEN)) Q:'LA7IEN S LA7J=1 D BRO("LA7 UI Message Display",LA7IEN,LA7IEN)
|
|
I LA7TEST D Q ; Display using browser.
|
|
. D DOCLIST^DDBR("^TMP($J,""LIST"")","R")
|
|
. D EXIT
|
|
S (LA7IEN,LA7QUIT)=0
|
|
S HDR=""
|
|
F S HDR=$O(^TMP($J,"LIST",HDR)) Q:HDR="" D Q:LA7QUIT
|
|
. I IOST["C-" W @IOF
|
|
. W $$CJ^XLFSTR(HDR,IOM," "),!
|
|
. S LA7ROOT=^TMP($J,"LIST",HDR),LA7ROOT=$E(LA7ROOT,1,$L(LA7ROOT)-1)
|
|
. S LA7CONT=0 ; Flag to determine if line has been continue on followng line.
|
|
. S I=0
|
|
. F S I=$O(@(LA7ROOT_","_I_")")) Q:'I D Q:LA7QUIT
|
|
. . S LA7X=^(I)
|
|
. . I LA7X="" W ! Q ; Print blank separator line
|
|
. . F S LA7Y=$E(LA7X,1,IOM-1) Q:LA7Y="" D Q:LA7QUIT
|
|
. . . S LA7X=$E(LA7X,IOM,$L(LA7X))
|
|
. . . I $L(LA7X) S LA7CONT=1,LA7X="--->"_LA7X
|
|
. . . W !,LA7Y
|
|
. . . I $Y+7>IOSL D EOP W @IOF Q:LA7QUIT
|
|
. I 'LA7QUIT D EOP
|
|
. W !!
|
|
D EXIT
|
|
Q
|
|
;
|
|
BRO(LA7HDR,LA7DOC,LA7IEN,LA7J) ; Setup text for browser.
|
|
; Called from above.
|
|
N LA7,LA7DT,LA7X,I,J,K,X,Y
|
|
D GETS^DIQ(62.49,LA7IEN,".01:149;160;161","ENR","LA7") ; Retrieve data from file 62.49
|
|
S J=$G(LA7J,1)
|
|
S ^TMP("DDB",$J,LA7DOC,J)=" ["_$$CJ^XLFSTR(" Message Statistics ",IOM-4,"*")_"]"
|
|
S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
|
|
S I="LA7(62.49)",K=0,J(0)=J
|
|
F S I=$Q(@I) Q:I="" Q:$QS(I,1)'=62.49 D
|
|
. S X=$QS(I,3)_": "_@I
|
|
. I K=0,$L(X)>((IOM\2)-1) S K=1,Y=""
|
|
. I K=0 S K=1,Y=$$LJ^XLFSTR(X,(IOM\2)+2)
|
|
. E S K=0,J=J+1,^TMP("DDB",$J,LA7DOC,J)=Y_$QS(I,3)_": "_@I
|
|
I K=1 S J=J+1,^TMP("DDB",$J,LA7DOC,J)=Y
|
|
I J(0)=J S J=J+1,^TMP("DDB",$J,LA7DOC,J)=$$CJ^XLFSTR(" [None Found]",IOM-1)
|
|
S LA7X=$G(^LAHM(62.49,LA7IEN,0))
|
|
S LA7DT=$P(LA7X,"^",5) ; Date/time message received
|
|
S LA7DT(0)=LA7DT\1 ; Date message received.
|
|
S LA7DT(1)=LA7DT#1 ; Time message received.
|
|
S K="LA7ERR^"_(LA7DT(0)-.1)
|
|
S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
|
|
S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" ["_$$CJ^XLFSTR(" Error Message ",IOM-4,"*")_"]"
|
|
S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
|
|
S J(0)=J ; Save value of "J", determine if any error message found.
|
|
F S K=$O(^XTMP(K)) Q:K=""!($P(K,"^")'="LA7ERR") D
|
|
. I LA7DT(0)=$P(K,"^",2) S I=LA7DT(1)-.00000001 ; Start looking after date/time of message.
|
|
. E S I=0
|
|
. F S I=$O(^XTMP(K,I)) Q:'I D
|
|
. . S X=^XTMP(K,I)
|
|
. . I $P(X,"^",2)=LA7IEN D
|
|
. . . S J=J+1,^TMP("DDB",$J,LA7DOC,J)="Date: "_$$FMTE^XLFDT($P(K,"^",2)+I,1)
|
|
. . . S J=J+1,^TMP("DDB",$J,LA7DOC,J)="Text: "_$P(X,"^",4) ; Get error message.
|
|
. . . S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
|
|
I J(0)=J S J=J+1,^TMP("DDB",$J,LA7DOC,J)=$$CJ^XLFSTR("[None Found]",IOM-1)
|
|
S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
|
|
S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" ["_$$CJ^XLFSTR(" Text of Message ",IOM-4,"*")_"]"
|
|
S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
|
|
;
|
|
; Retrieve text of message from 62.49.
|
|
S I=0,J(0)=J
|
|
F S I=$O(^LAHM(62.49,LA7IEN,150,I)) Q:'I D
|
|
. S J=J+1
|
|
. S ^TMP("DDB",$J,LA7DOC,J)=$G(^LAHM(62.49,LA7IEN,150,I,0))
|
|
. ; Parse each message segment.
|
|
. I '$G(LA7PARS) Q
|
|
. S X=$G(^LAHM(62.49,LA7IEN,150,I,0))
|
|
. ; Obtain field separator and encoding characters.
|
|
. I $E(X,1,3)="MSH" S HLFS=$E(X,4),HLECH=$E(X,5,8)
|
|
. ; Segement ID code.
|
|
. S Y=$P(X,HLFS)
|
|
. ; Parse fields.
|
|
. D PF
|
|
;
|
|
I J(0)=J S J=J+1,^TMP("DDB",$J,LA7DOC,J)=$$CJ^XLFSTR("[None Found]",IOM-1)
|
|
;
|
|
; If linked to another entry go pasrse that entry also
|
|
I $P(LA7X,"^",7) D BRO("LA7 UI Message Display",LA7DOC,$P(LA7X,"^",7),J)
|
|
;
|
|
; Setup document list.
|
|
S LA7HDR=LA7HDR_" Msg #"_LA7DOC_" - "_$P(^LAHM(62.49,LA7DOC,0),"^",6)
|
|
S ^TMP($J,"LIST",LA7HDR)="^TMP(""DDB"",$J,"_LA7DOC_")"
|
|
Q
|
|
;
|
|
PF ; Parse message fields
|
|
;
|
|
F K=$S(Y="MSH":1,1:2):1:$L(X,HLFS) D
|
|
. S Z=$P(X,HLFS,K)
|
|
. ; Don't display blank segments.
|
|
. I $P(LA7PARS,"^",2),Z="" Q
|
|
. S J=J+1
|
|
. I Y="MSH" S V=Y_"-"_K_" = "_$S(K=1:HLFS,1:$P(X,HLFS,K))
|
|
. E S V=Y_"-"_(K-1)_" = "_$P(X,HLFS,K)
|
|
. S ^TMP("DDB",$J,LA7DOC,J)=V
|
|
. I Z="" Q ; Don't parse blank segments.
|
|
. I Y="MSH",K<3 Q ; Don't parse MSH-1/2.
|
|
. ; Parse components.
|
|
. D PC
|
|
; Separate segments with blank line.
|
|
S J=J+1,^TMP("DDB",$J,LA7DOC,J)=" "
|
|
Q
|
|
;
|
|
PC ; Parse field components
|
|
;
|
|
F L=1:1:$L(Z,$E(HLECH,1)) D
|
|
. S V=$P(Z,$E(HLECH,1),L) Q:V=""
|
|
. I Z[$E(HLECH,1) D
|
|
. . S J=J+1
|
|
. . S ^TMP("DDB",$J,LA7DOC,J)=Y_"-"_($S(Y="MSH":K,1:K-1))_"-"_L_" = "_V
|
|
. I V'[$E(HLECH,2) Q
|
|
. ; Parse repetition of components.
|
|
. F M=1:1:$L(V,$E(HLECH,2)) D
|
|
. . S J=J+1
|
|
. . S ^TMP("DDB",$J,LA7DOC,J)=Y_"-"_($S(Y="MSH":K,1:K-1))_"-"_L_"-"_M_" = "_$P(V,$E(HLECH,2),M)
|
|
Q
|
|
;
|
|
EOP ; End of page.
|
|
I LA7CONT W !!,"NOTE: '--->' indicates continuation of previous line." S LA7CONT=0
|
|
I $D(ZTQUEUED)!(IOST'["C-") Q
|
|
S DIR(0)="E" D ^DIR K DIR S:Y'=1 LA7QUIT=1
|
|
Q
|
|
;
|
|
EXIT ; Clean up.
|
|
W @IOF
|
|
I $D(ZTQUEUED) S ZTREQ="@"
|
|
E D ^%ZISC
|
|
K ^TMP($J),^TMP("DDB",$J)
|
|
K LA7CONT,LA7IEN,LA7J,LA7LIST,LA7PARS,LA7QUIT,LA7ROOT,LA7TEST,LA7X,LA7Y
|
|
K DIC,DIR,HDR,HLECH,HLFS,I,J,K,L,M,V,X,Y,Z
|
|
K VAUTVB,VAUTNI,VAUTSTR,VAUTNALL
|
|
Q
|
|
;
|
|
;
|
|
FMT(LA76249) ; Perform test to determine storage format, each segment on one
|
|
; node or segment has continuation nodes separated with null "" nodes.
|
|
; Call with LA76249 = ien of entry in file #62.49
|
|
; Returns LA7Y = 0-old format, 1-new format
|
|
;
|
|
N LA7END,LA7Y,LA7ROOT
|
|
S (LA7END,LA7Y)=0,LA7ROOT="^LAHM(62.49,LA76249,150,0)"
|
|
F S LA7ROOT=$Q(@LA7ROOT) Q:LA7END D
|
|
. I $QS(LA7ROOT,1)'="62.49"!($QS(LA7ROOT,2)'=LA76249)!($QS(LA7ROOT,3)'=150) S LA7END=1 Q
|
|
. I @LA7ROOT="" S (LA7Y,LA7END)=1
|
|
Q LA7Y
|