LA7UTILA ;VA/DALOI/JMC - Browse UI message ; 22-Oct-2013 09:22 ; MKK
;;5.2;AUTOMATED LAB INSTRUMENTS;**23,27,46,1018,64,1027,1033**;NOV 01, 1997
;
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.
. . . ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1033
. . . I $L($P(X,"^",4))'>74 S J=J+1,^TMP("DDB",$J,LA7DOC,J)="Text: "_$P(X,"^",4)
. . . I $L($P(X,"^",4))>74 D MULTI($P(X,"^",4),.J)
. . . ; ----- END IHS/OIT/MKK - LR*5.2*1033
. . . 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
;
; ------- BEGIN IHS/OIT/MKK - LR*5.2*1033
MULTI(STR,LINE) ; EP - Text line needs to be "wrapped"
NEW LM,DIWL,DIWR,DIWF,DIWPLINE
;
S RIGHTM=70 ; Right Margin
;
; Use FileMan DIWP routine to "wrap" text
S LM=0
S X=STR
K ^UTILITY($J,"W")
S DIWL=LM,DIWR="",DIWF="C"_RIGHTM
D ^DIWP
;
; Put wrapped string into BROWSER "array"
S LINE=LINE+1,DIWPLINE=1
S ^TMP("DDB",$J,LA7DOC,LINE)="Text: "_$$TRIM^XLFSTR($G(^UTILITY($J,"W",LM,DIWPLINE,0)),"LR"," ")
;
F S DIWPLINE=$O(^UTILITY($J,"W",LM,DIWPLINE)) Q:DIWPLINE<1 D
. S LINE=LINE+1
. S ^TMP("DDB",$J,LA7DOC,LINE)=$$TRIM^XLFSTR($G(^UTILITY($J,"W",LM,DIWPLINE,0)),"LR"," ")
;
K ^UTILITY($J,"W")
Q
; ------- END IHS/OIT/MKK - LR*5.2*1033
;
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
LA7UTILA ;VA/DALOI/JMC - Browse UI message ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**23,27,46,1018,64,1027,1033**;NOV 01, 1997
+2 ;
EN ; Select a Universal Interface message to browse.
+1 ; Housekeeping before we start.
DO EXIT
+2 SET DIC="^LAHM(62.49,"
SET DIC("W")="W "" "",$P(^(0),U,6)"
+3 SET VAUTVB="LA7LIST"
SET VAUTSTR="Message"
SET VAUTNI=2
SET VAUTNALL=1
+4 DO FIRST^VAUTOMA
+5 IF Y<1!('$ORDER(LA7LIST(0)))
DO EXIT
QUIT
+6 ;
DEV ; Called from LA7UXQA - when viewing message via alert system.
+1 SET DIR(0)="YO"
SET DIR("A")="Parse message fields based on HL7 segments"
SET DIR("B")="NO"
+2 DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO EXIT
QUIT
+4 ; Save flag to parse message.
SET LA7PARS=+Y
+5 IF LA7PARS
Begin DoDot:1
+6 SET DIR(0)="YO"
SET DIR("A")="Suppress blank segments"
SET DIR("B")="YES"
+7 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
+8 SET $PIECE(LA7PARS,"^",2)=+Y
End DoDot:1
IF $DATA(DIRUT)
DO EXIT
QUIT
+9 ; Ask device and task if requested.
+10 SET %ZIS="Q"
DO ^%ZIS
KILL %ZIS
+11 IF POP
DO EXIT
QUIT
+12 IF $DATA(IO("Q"))
Begin DoDot:1
+13 ; Tasked - not a CRT.
SET LA7TEST=0
+14 SET ZTRTN="DQ^LA7UTILA"
SET ZTDESC="Print LA7 UI Messages"
SET ZTSAVE("LA7*")=""
+15 DO ^%ZTLOAD
+16 WRITE !,"Request ",$SELECT($DATA(ZTSK):"",1:"NOT "),"Queued"
+17 KILL IO("Q")
End DoDot:1
GOTO EXIT
+18 USE IO(0)
+19 ;
+20 ; Flag to determine if okay to use browser (default=true).
+21 SET LA7TEST=1
+22 ;
+23 ; Home device not current device or using non-CRT terminal type.
+24 IF IO'=IO(0)!($EXTRACT(IOST,1,2)'="C-")
SET LA7TEST=0
+25 ;
+26 ; If not queued and home device then test for browser
+27 IF LA7TEST
IF '$$TEST^DDBRT
Begin DoDot:1
+28 ; Unable to use browser.
SET LA7TEST=0
+29 WRITE !,$CHAR(7),"This terminal does not support the needed functionality to use the Browser!"
+30 WRITE !,"Will use standard FileMan Data Display.",!
End DoDot:1
+31 IF LA7TEST
Begin DoDot:1
+32 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+33 SET DIR(0)="YO"
SET DIR("A")="Use Browser to display message(s)"
SET DIR("B")="YES"
+34 DO ^DIR
+35 IF $DATA(DIRUT)
SET LA7TEST=-1
QUIT
+36 SET LA7TEST=+Y
End DoDot:1
+37 IF LA7TEST<0
DO EXIT
QUIT
+38 DO WAIT^DICD
+39 ;
DQ ; Dequeue entry point.
+1 USE IO
+2 KILL ^TMP($JOB),^TMP("DDB",$JOB)
+3 SET LA7IEN=0
+4 FOR
SET LA7IEN=$ORDER(LA7LIST(LA7IEN))
IF 'LA7IEN
QUIT
SET LA7J=1
DO BRO("LA7 UI Message Display",LA7IEN,LA7IEN)
+5 ; Display using browser.
IF LA7TEST
Begin DoDot:1
+6 DO DOCLIST^DDBR("^TMP($J,""LIST"")","R")
+7 DO EXIT
End DoDot:1
QUIT
+8 SET (LA7IEN,LA7QUIT)=0
+9 SET HDR=""
+10 FOR
SET HDR=$ORDER(^TMP($JOB,"LIST",HDR))
IF HDR=""
QUIT
Begin DoDot:1
+11 IF IOST["C-"
WRITE @IOF
+12 WRITE $$CJ^XLFSTR(HDR,IOM," "),!
+13 SET LA7ROOT=^TMP($JOB,"LIST",HDR)
SET LA7ROOT=$EXTRACT(LA7ROOT,1,$LENGTH(LA7ROOT)-1)
+14 ; Flag to determine if line has been continue on followng line.
SET LA7CONT=0
+15 SET I=0
+16 FOR
SET I=$ORDER(@(LA7ROOT_","_I_")"))
IF 'I
QUIT
Begin DoDot:2
+17 SET LA7X=^(I)
+18 ; Print blank separator line
IF LA7X=""
WRITE !
QUIT
+19 FOR
SET LA7Y=$EXTRACT(LA7X,1,IOM-1)
IF LA7Y=""
QUIT
Begin DoDot:3
+20 SET LA7X=$EXTRACT(LA7X,IOM,$LENGTH(LA7X))
+21 IF $LENGTH(LA7X)
SET LA7CONT=1
SET LA7X="--->"_LA7X
+22 WRITE !,LA7Y
+23 IF $Y+7>IOSL
DO EOP
WRITE @IOF
IF LA7QUIT
QUIT
End DoDot:3
IF LA7QUIT
QUIT
End DoDot:2
IF LA7QUIT
QUIT
+24 IF 'LA7QUIT
DO EOP
+25 WRITE !!
End DoDot:1
IF LA7QUIT
QUIT
+26 DO EXIT
+27 QUIT
+28 ;
BRO(LA7HDR,LA7DOC,LA7IEN,LA7J) ; Setup text for browser.
+1 ; Called from above.
+2 NEW LA7,LA7DT,LA7X,I,J,K,X,Y
+3 ; Retrieve data from file 62.49
DO GETS^DIQ(62.49,LA7IEN,".01:149;160;161","ENR","LA7")
+4 SET J=$GET(LA7J,1)
+5 SET ^TMP("DDB",$JOB,LA7DOC,J)=" ["_$$CJ^XLFSTR(" Message Statistics ",IOM-4,"*")_"]"
+6 SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=" "
+7 SET I="LA7(62.49)"
SET K=0
SET J(0)=J
+8 FOR
SET I=$QUERY(@I)
IF I=""
QUIT
IF $QSUBSCRIPT(I,1)'=62.49
QUIT
Begin DoDot:1
+9 SET X=$QSUBSCRIPT(I,3)_": "_@I
+10 IF K=0
IF $LENGTH(X)>((IOM\2)-1)
SET K=1
SET Y=""
+11 IF K=0
SET K=1
SET Y=$$LJ^XLFSTR(X,(IOM\2)+2)
+12 IF '$TEST
SET K=0
SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=Y_$QSUBSCRIPT(I,3)_": "_@I
End DoDot:1
+13 IF K=1
SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=Y
+14 IF J(0)=J
SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=$$CJ^XLFSTR(" [None Found]",IOM-1)
+15 SET LA7X=$GET(^LAHM(62.49,LA7IEN,0))
+16 ; Date/time message received
SET LA7DT=$PIECE(LA7X,"^",5)
+17 ; Date message received.
SET LA7DT(0)=LA7DT\1
+18 ; Time message received.
SET LA7DT(1)=LA7DT#1
+19 SET K="LA7ERR^"_(LA7DT(0)-.1)
+20 SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=" "
+21 SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=" ["_$$CJ^XLFSTR(" Error Message ",IOM-4,"*")_"]"
+22 SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=" "
+23 ; Save value of "J", determine if any error message found.
SET J(0)=J
+24 FOR
SET K=$ORDER(^XTMP(K))
IF K=""!($PIECE(K,"^")'="LA7ERR")
QUIT
Begin DoDot:1
+25 ; Start looking after date/time of message.
IF LA7DT(0)=$PIECE(K,"^",2)
SET I=LA7DT(1)-.00000001
+26 IF '$TEST
SET I=0
+27 FOR
SET I=$ORDER(^XTMP(K,I))
IF 'I
QUIT
Begin DoDot:2
+28 SET X=^XTMP(K,I)
+29 IF $PIECE(X,"^",2)=LA7IEN
Begin DoDot:3
+30 SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)="Date: "_$$FMTE^XLFDT($PIECE(K,"^",2)+I,1)
+31 ; S J=J+1,^TMP("DDB",$J,LA7DOC,J)="Text: "_$P(X,"^",4) ; Get error message.
+32 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1033
+33 IF $LENGTH($PIECE(X,"^",4))'>74
SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)="Text: "_$PIECE(X,"^",4)
+34 IF $LENGTH($PIECE(X,"^",4))>74
DO MULTI($PIECE(X,"^",4),.J)
+35 ; ----- END IHS/OIT/MKK - LR*5.2*1033
+36 SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=" "
End DoDot:3
End DoDot:2
End DoDot:1
+37 IF J(0)=J
SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=$$CJ^XLFSTR("[None Found]",IOM-1)
+38 SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=" "
+39 SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=" ["_$$CJ^XLFSTR(" Text of Message ",IOM-4,"*")_"]"
+40 SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=" "
+41 ;
+42 ; Retrieve text of message from 62.49.
+43 SET I=0
SET J(0)=J
+44 FOR
SET I=$ORDER(^LAHM(62.49,LA7IEN,150,I))
IF 'I
QUIT
Begin DoDot:1
+45 SET J=J+1
+46 SET ^TMP("DDB",$JOB,LA7DOC,J)=$GET(^LAHM(62.49,LA7IEN,150,I,0))
+47 ; Parse each message segment.
+48 IF '$GET(LA7PARS)
QUIT
+49 SET X=$GET(^LAHM(62.49,LA7IEN,150,I,0))
+50 ; Obtain field separator and encoding characters.
+51 IF $EXTRACT(X,1,3)="MSH"
SET HLFS=$EXTRACT(X,4)
SET HLECH=$EXTRACT(X,5,8)
+52 ; Segement ID code.
+53 SET Y=$PIECE(X,HLFS)
+54 ; Parse fields.
+55 DO PF
End DoDot:1
+56 ;
+57 IF J(0)=J
SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=$$CJ^XLFSTR("[None Found]",IOM-1)
+58 ;
+59 ; If linked to another entry go pasrse that entry also
+60 IF $PIECE(LA7X,"^",7)
DO BRO("LA7 UI Message Display",LA7DOC,$PIECE(LA7X,"^",7),J)
+61 ;
+62 ; Setup document list.
+63 SET LA7HDR=LA7HDR_" Msg #"_LA7DOC_" - "_$PIECE(^LAHM(62.49,LA7DOC,0),"^",6)
+64 SET ^TMP($JOB,"LIST",LA7HDR)="^TMP(""DDB"",$J,"_LA7DOC_")"
+65 QUIT
+66 ;
+67 ; ------- BEGIN IHS/OIT/MKK - LR*5.2*1033
MULTI(STR,LINE) ; EP - Text line needs to be "wrapped"
+1 NEW LM,DIWL,DIWR,DIWF,DIWPLINE
+2 ;
+3 ; Right Margin
SET RIGHTM=70
+4 ;
+5 ; Use FileMan DIWP routine to "wrap" text
+6 SET LM=0
+7 SET X=STR
+8 KILL ^UTILITY($JOB,"W")
+9 SET DIWL=LM
SET DIWR=""
SET DIWF="C"_RIGHTM
+10 DO ^DIWP
+11 ;
+12 ; Put wrapped string into BROWSER "array"
+13 SET LINE=LINE+1
SET DIWPLINE=1
+14 SET ^TMP("DDB",$JOB,LA7DOC,LINE)="Text: "_$$TRIM^XLFSTR($GET(^UTILITY($JOB,"W",LM,DIWPLINE,0)),"LR"," ")
+15 ;
+16 FOR
SET DIWPLINE=$ORDER(^UTILITY($JOB,"W",LM,DIWPLINE))
IF DIWPLINE<1
QUIT
Begin DoDot:1
+17 SET LINE=LINE+1
+18 SET ^TMP("DDB",$JOB,LA7DOC,LINE)=$$TRIM^XLFSTR($GET(^UTILITY($JOB,"W",LM,DIWPLINE,0)),"LR"," ")
End DoDot:1
+19 ;
+20 KILL ^UTILITY($JOB,"W")
+21 QUIT
+22 ; ------- END IHS/OIT/MKK - LR*5.2*1033
+23 ;
PF ; Parse message fields
+1 ;
+2 FOR K=$SELECT(Y="MSH":1,1:2):1:$LENGTH(X,HLFS)
Begin DoDot:1
+3 SET Z=$PIECE(X,HLFS,K)
+4 ; Don't display blank segments.
+5 IF $PIECE(LA7PARS,"^",2)
IF Z=""
QUIT
+6 SET J=J+1
+7 IF Y="MSH"
SET V=Y_"-"_K_" = "_$SELECT(K=1:HLFS,1:$PIECE(X,HLFS,K))
+8 IF '$TEST
SET V=Y_"-"_(K-1)_" = "_$PIECE(X,HLFS,K)
+9 SET ^TMP("DDB",$JOB,LA7DOC,J)=V
+10 ; Don't parse blank segments.
IF Z=""
QUIT
+11 ; Don't parse MSH-1/2.
IF Y="MSH"
IF K<3
QUIT
+12 ; Parse components.
+13 DO PC
End DoDot:1
+14 ; Separate segments with blank line.
+15 SET J=J+1
SET ^TMP("DDB",$JOB,LA7DOC,J)=" "
+16 QUIT
+17 ;
PC ; Parse field components
+1 ;
+2 FOR L=1:1:$LENGTH(Z,$EXTRACT(HLECH,1))
Begin DoDot:1
+3 SET V=$PIECE(Z,$EXTRACT(HLECH,1),L)
IF V=""
QUIT
+4 IF Z[$EXTRACT(HLECH,1)
Begin DoDot:2
+5 SET J=J+1
+6 SET ^TMP("DDB",$JOB,LA7DOC,J)=Y_"-"_($SELECT(Y="MSH":K,1:K-1))_"-"_L_" = "_V
End DoDot:2
+7 IF V'[$EXTRACT(HLECH,2)
QUIT
+8 ; Parse repetition of components.
+9 FOR M=1:1:$LENGTH(V,$EXTRACT(HLECH,2))
Begin DoDot:2
+10 SET J=J+1
+11 SET ^TMP("DDB",$JOB,LA7DOC,J)=Y_"-"_($SELECT(Y="MSH":K,1:K-1))_"-"_L_"-"_M_" = "_$PIECE(V,$EXTRACT(HLECH,2),M)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
EOP ; End of page.
+1 IF LA7CONT
WRITE !!,"NOTE: '--->' indicates continuation of previous line."
SET LA7CONT=0
+2 IF $DATA(ZTQUEUED)!(IOST'["C-")
QUIT
+3 SET DIR(0)="E"
DO ^DIR
KILL DIR
IF Y'=1
SET LA7QUIT=1
+4 QUIT
+5 ;
EXIT ; Clean up.
+1 WRITE @IOF
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 IF '$TEST
DO ^%ZISC
+4 KILL ^TMP($JOB),^TMP("DDB",$JOB)
+5 KILL LA7CONT,LA7IEN,LA7J,LA7LIST,LA7PARS,LA7QUIT,LA7ROOT,LA7TEST,LA7X,LA7Y
+6 KILL DIC,DIR,HDR,HLECH,HLFS,I,J,K,L,M,V,X,Y,Z
+7 KILL VAUTVB,VAUTNI,VAUTSTR,VAUTNALL
+8 QUIT
+9 ;
+10 ;
FMT(LA76249) ; Perform test to determine storage format, each segment on one
+1 ; node or segment has continuation nodes separated with null "" nodes.
+2 ; Call with LA76249 = ien of entry in file #62.49
+3 ; Returns LA7Y = 0-old format, 1-new format
+4 ;
+5 NEW LA7END,LA7Y,LA7ROOT
+6 SET (LA7END,LA7Y)=0
SET LA7ROOT="^LAHM(62.49,LA76249,150,0)"
+7 FOR
SET LA7ROOT=$QUERY(@LA7ROOT)
IF LA7END
QUIT
Begin DoDot:1
+8 IF $QSUBSCRIPT(LA7ROOT,1)'="62.49"!($QSUBSCRIPT(LA7ROOT,2)'=LA76249)!($QSUBSCRIPT(LA7ROOT,3)'=150)
SET LA7END=1
QUIT
+9 IF @LA7ROOT=""
SET (LA7Y,LA7END)=1
End DoDot:1
+10 QUIT LA7Y
