LA7UTILA ;DALOI/JMC - Browse UI message ;05/01/09 16:43
;;5.2;AUTOMATED LAB INSTRUMENTS;**23,27,46,64,74**;Sep 27, 1994;Build 229
;
EN ; Select a Universal Interface message to browse.
N LA7LIST,DIC,DIR,DIRUT,DTOUR,DUOUT,PARAM,X
D EXIT ; Housekeeping before we start.
S PARAM("SHOIDS")=$$GET^XPAR("USR^SYS","LA7UTILA SHOIDS",1,"Q")
S PARAM("SHOIDS LAST")=$$GET^XPAR("USR^SYS","LA7UTILA SHOIDS LAST",1,"Q")
S X=PARAM("SHOIDS")
I X="L" S X=PARAM("SHOIDS LAST")
I X="" S X=PARAM("SHOIDS")
I X="" S X=1
I X'=+X S X=$S(X="Y":1,X="N":0,1:1)
K PARAM
S DIR("B")=$S(X:"YES",1:"NO")
S DIR(0)="Y",DIR("A")="Display identifiers during message selection"
D ^DIR
I $D(DIRUT) D EXIT Q
I Y<1 S DIC("W")="D DICW^LA7UTILA"
; save PARAM setting
D EN^XPAR("USR","LA7UTILA SHOIDS LAST",1,$S(+Y>0:1,1:0))
S DIC="^LAHM(62.49,"
S DIC(0)="EQMZ"
S X=$$SELECT^LRUTIL(.DIC,.LA7LIST,"Message",10,0,1,1)
K DIC,DIR
I '$O(LA7LIST(0)) D EXIT Q
D DEV
Q
;
DEV ; Called from LA7UXQA - when viewing message via alert system.
N PARAM,DIR,X
; DFLT = N,Y,L (no,yes,last)
S PARAM("PARSE")=$$GET^XPAR("USR^SYS","LA7UTILA PARSE",1,"Q")
S PARAM("PARSE LAST")=$$GET^XPAR("USR^SYS","LA7UTILA PARSE LAST",1,"Q")
S DIR(0)="YO"
S DIR("A")="Parse message fields based on HL7 segments"
S X=PARAM("PARSE")
I X="L" S X=PARAM("PARSE LAST")
I X="" S X=PARAM("PARSE")
I X="" S X=1
I X'=+X S X=$S(X="Y":1,X="N":0,1:1)
S DIR("B")=$S(X:"YES",1:"NO")
D ^DIR K DIR
I $D(DIRUT) D EXIT Q
D EN^XPAR("USR","LA7UTILA PARSE LAST",1,$S(+Y>0:1,1:0))
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
. K PARAM
. S PARAM("BROWSER")=$$GET^XPAR("USR^SYS","LA7UTILA USE BROWSER",1,"Q")
. S PARAM("BROWSER LAST")=$$GET^XPAR("USR^SYS","LA7UTILA USE BROWSER LAST",1,"Q")
. S X=PARAM("BROWSER")
. I X="L" S X=PARAM("BROWSER LAST")
. I X="" S X=PARAM("BROWSER")
. I X="" S X=1
. I X'=+X S X=$S(X="Y":1,X="N":0,1:1)
. ;S X=$$GET^XPAR("USR^SYS","LA7UTILA USE BROWSER",1,"Q")
. S DIR(0)="YO",DIR("A")="Use Browser to display message(s)"
. S DIR("B")=$S(X:"YES",1:"NO")
. D ^DIR
. I $D(DIRUT) S LA7TEST=-1 Q
. D EN^XPAR("USR","LA7UTILA USE BROWSER LAST",1,$S(+Y>0:1,1:0))
. 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 D
. S LA7J=1
. D BRO^LA7UTILC("LA7 UI Message Display",LA7IEN,LA7IEN)
;
; Display using browser.
I LA7TEST D Q
. 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 if line is continued on following 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
;
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.
I $G(IOF)'="" W @IOF
I $D(ZTQUEUED) S ZTREQ="@"
E D ^%ZISC
K ^TMP($J),^TMP("DDB",$J)
K ^TMP("LA7UTILC")
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
;
DICW ;
; Private method for EN above.
; Displays certain identifier for lookup.
; Called by ^DIC through DIC("W")
N LADATA,LAY,LAX,LAF1,LAF3,LAF4,LAF103,LAF105
; Y = IEN of entry DIC is at.
; ^(0) is at the global level @(DIC_"Y,0)"
S LAX=""
S LADATA=^(0)
S LAF1=$P(LADATA,U,2)
S:LAF1="" LAF1="?"
S LAF3=$$LOW^XLFSTR($P(LADATA,U,3))
S:LAF3="" LAF3="-"
S LAF4=$P(LADATA,U,5)
S LAY=$P(LADATA,U,6)
I LAY'="" D ; Instrument name
. S LAX=LAY
I LAX="" D ;
. S LAY=$G(^LAHM(62.49,Y,.5))
. S LAY=$P(LAY,U,1)
. Q:LAY=""
. S LAY=$G(^LAHM(62.48,LAY,0))
. S LAY=$P(LAY,U,1)
. I LAY'="" D ; Config name
. . S LAX=LAY
. ;
S LADATA=$G(^LAHM(62.49,Y,100))
S LAF103=$P(LADATA,U,4) ;sending fac
S LAF105=$P(LADATA,U,6) ;receiving fac
S LAY=""
I LAF1="I" I LAF103'="" S LAY=" "_LAF103
I LAF1="O" I LAF105'="" S LAY=" "_LAF105
W " "_LAF1_LAF3_" "_LAX_LAY_" "_$$FMTE^XLFDT(LAF4,5)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7UTILA 6161 printed Apr 09, 2024@20:45:34 Page 2
LA7UTILA ;DALOI/JMC - Browse UI message ;05/01/09 16:43
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**23,27,46,64,74**;Sep 27, 1994;Build 229
+2 ;
EN ; Select a Universal Interface message to browse.
+1 NEW LA7LIST,DIC,DIR,DIRUT,DTOUR,DUOUT,PARAM,X
+2 ; Housekeeping before we start.
DO EXIT
+3 SET PARAM("SHOIDS")=$$GET^XPAR("USR^SYS","LA7UTILA SHOIDS",1,"Q")
+4 SET PARAM("SHOIDS LAST")=$$GET^XPAR("USR^SYS","LA7UTILA SHOIDS LAST",1,"Q")
+5 SET X=PARAM("SHOIDS")
+6 IF X="L"
SET X=PARAM("SHOIDS LAST")
+7 IF X=""
SET X=PARAM("SHOIDS")
+8 IF X=""
SET X=1
+9 IF X'=+X
SET X=$SELECT(X="Y":1,X="N":0,1:1)
+10 KILL PARAM
+11 SET DIR("B")=$SELECT(X:"YES",1:"NO")
+12 SET DIR(0)="Y"
SET DIR("A")="Display identifiers during message selection"
+13 DO ^DIR
+14 IF $DATA(DIRUT)
DO EXIT
QUIT
+15 IF Y<1
SET DIC("W")="D DICW^LA7UTILA"
+16 ; save PARAM setting
+17 DO EN^XPAR("USR","LA7UTILA SHOIDS LAST",1,$SELECT(+Y>0:1,1:0))
+18 SET DIC="^LAHM(62.49,"
+19 SET DIC(0)="EQMZ"
+20 SET X=$$SELECT^LRUTIL(.DIC,.LA7LIST,"Message",10,0,1,1)
+21 KILL DIC,DIR
+22 IF '$ORDER(LA7LIST(0))
DO EXIT
QUIT
+23 DO DEV
+24 QUIT
+25 ;
DEV ; Called from LA7UXQA - when viewing message via alert system.
+1 NEW PARAM,DIR,X
+2 ; DFLT = N,Y,L (no,yes,last)
+3 SET PARAM("PARSE")=$$GET^XPAR("USR^SYS","LA7UTILA PARSE",1,"Q")
+4 SET PARAM("PARSE LAST")=$$GET^XPAR("USR^SYS","LA7UTILA PARSE LAST",1,"Q")
+5 SET DIR(0)="YO"
+6 SET DIR("A")="Parse message fields based on HL7 segments"
+7 SET X=PARAM("PARSE")
+8 IF X="L"
SET X=PARAM("PARSE LAST")
+9 IF X=""
SET X=PARAM("PARSE")
+10 IF X=""
SET X=1
+11 IF X'=+X
SET X=$SELECT(X="Y":1,X="N":0,1:1)
+12 SET DIR("B")=$SELECT(X:"YES",1:"NO")
+13 DO ^DIR
KILL DIR
+14 IF $DATA(DIRUT)
DO EXIT
QUIT
+15 DO EN^XPAR("USR","LA7UTILA PARSE LAST",1,$SELECT(+Y>0:1,1:0))
+16 ; Save flag to parse message.
SET LA7PARS=+Y
+17 IF LA7PARS
Begin DoDot:1
+18 SET DIR(0)="YO"
SET DIR("A")="Suppress blank segments"
SET DIR("B")="YES"
+19 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+20 SET $PIECE(LA7PARS,"^",2)=+Y
End DoDot:1
IF $DATA(DIRUT)
DO EXIT
QUIT
+21 ; Ask device and task if requested.
+22 SET %ZIS="Q"
DO ^%ZIS
KILL %ZIS
+23 IF POP
DO EXIT
QUIT
+24 IF $DATA(IO("Q"))
Begin DoDot:1
+25 ; Tasked - not a CRT.
SET LA7TEST=0
+26 SET ZTRTN="DQ^LA7UTILA"
SET ZTDESC="Print LA7 UI Messages"
SET ZTSAVE("LA7*")=""
+27 DO ^%ZTLOAD
+28 WRITE !,"Request ",$SELECT($DATA(ZTSK):"",1:"NOT "),"Queued"
+29 KILL IO("Q")
End DoDot:1
GOTO EXIT
+30 USE IO(0)
+31 ;
+32 ; Flag to determine if okay to use browser (default=true).
+33 SET LA7TEST=1
+34 ;
+35 ; Home device not current device or using non-CRT terminal type.
+36 IF IO'=IO(0)!($EXTRACT(IOST,1,2)'="C-")
SET LA7TEST=0
+37 ;
+38 ; If not queued and home device then test for browser
+39 IF LA7TEST
IF '$$TEST^DDBRT
Begin DoDot:1
+40 ; Unable to use browser.
SET LA7TEST=0
+41 WRITE !,$CHAR(7),"This terminal does not support the needed functionality to use the Browser!"
+42 WRITE !,"Will use standard FileMan Data Display.",!
End DoDot:1
+43 IF LA7TEST
Begin DoDot:1
+44 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+45 KILL PARAM
+46 SET PARAM("BROWSER")=$$GET^XPAR("USR^SYS","LA7UTILA USE BROWSER",1,"Q")
+47 SET PARAM("BROWSER LAST")=$$GET^XPAR("USR^SYS","LA7UTILA USE BROWSER LAST",1,"Q")
+48 SET X=PARAM("BROWSER")
+49 IF X="L"
SET X=PARAM("BROWSER LAST")
+50 IF X=""
SET X=PARAM("BROWSER")
+51 IF X=""
SET X=1
+52 IF X'=+X
SET X=$SELECT(X="Y":1,X="N":0,1:1)
+53 ;S X=$$GET^XPAR("USR^SYS","LA7UTILA USE BROWSER",1,"Q")
+54 SET DIR(0)="YO"
SET DIR("A")="Use Browser to display message(s)"
+55 SET DIR("B")=$SELECT(X:"YES",1:"NO")
+56 DO ^DIR
+57 IF $DATA(DIRUT)
SET LA7TEST=-1
QUIT
+58 DO EN^XPAR("USR","LA7UTILA USE BROWSER LAST",1,$SELECT(+Y>0:1,1:0))
+59 SET LA7TEST=+Y
End DoDot:1
+60 IF LA7TEST<0
DO EXIT
QUIT
+61 DO WAIT^DICD
+62 ;
DQ ; Dequeue entry point.
+1 USE IO
+2 KILL ^TMP($JOB),^TMP("DDB",$JOB)
+3 ;
+4 SET LA7IEN=0
+5 FOR
SET LA7IEN=$ORDER(LA7LIST(LA7IEN))
if 'LA7IEN
QUIT
Begin DoDot:1
+6 SET LA7J=1
+7 DO BRO^LA7UTILC("LA7 UI Message Display",LA7IEN,LA7IEN)
End DoDot:1
+8 ;
+9 ; Display using browser.
+10 IF LA7TEST
Begin DoDot:1
+11 DO DOCLIST^DDBR("^TMP($J,""LIST"")","R")
+12 DO EXIT
End DoDot:1
QUIT
+13 ;
+14 SET (LA7IEN,LA7QUIT)=0
+15 SET HDR=""
+16 FOR
SET HDR=$ORDER(^TMP($JOB,"LIST",HDR))
if HDR=""
QUIT
Begin DoDot:1
+17 IF IOST["C-"
WRITE @IOF
+18 WRITE $$CJ^XLFSTR(HDR,IOM," "),!
+19 SET LA7ROOT=^TMP($JOB,"LIST",HDR)
SET LA7ROOT=$EXTRACT(LA7ROOT,1,$LENGTH(LA7ROOT)-1)
+20 ; Flag if line is continued on following line.
SET LA7CONT=0
+21 SET I=0
+22 FOR
SET I=$ORDER(@(LA7ROOT_","_I_")"))
if 'I
QUIT
Begin DoDot:2
+23 SET LA7X=^(I)
+24 ; Print blank separator line
IF LA7X=""
WRITE !
QUIT
+25 FOR
SET LA7Y=$EXTRACT(LA7X,1,IOM-1)
if LA7Y=""
QUIT
Begin DoDot:3
+26 SET LA7X=$EXTRACT(LA7X,IOM,$LENGTH(LA7X))
+27 IF $LENGTH(LA7X)
SET LA7CONT=1
SET LA7X="--->"_LA7X
+28 WRITE !,LA7Y
+29 IF $Y+7>IOSL
DO EOP
WRITE @IOF
if LA7QUIT
QUIT
End DoDot:3
if LA7QUIT
QUIT
End DoDot:2
if LA7QUIT
QUIT
+30 IF 'LA7QUIT
DO EOP
+31 WRITE !!
End DoDot:1
if LA7QUIT
QUIT
+32 DO EXIT
+33 QUIT
+34 ;
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 IF $GET(IOF)'=""
WRITE @IOF
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 IF '$TEST
DO ^%ZISC
+4 KILL ^TMP($JOB),^TMP("DDB",$JOB)
+5 KILL ^TMP("LA7UTILC")
+6 KILL LA7CONT,LA7IEN,LA7J,LA7LIST,LA7PARS,LA7QUIT,LA7ROOT,LA7TEST,LA7X,LA7Y
+7 KILL DIC,DIR,HDR,HLECH,HLFS,I,J,K,L,M,V,X,Y,Z
+8 KILL VAUTVB,VAUTNI,VAUTSTR,VAUTNALL
+9 QUIT
+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
+11 ;
DICW ;
+1 ; Private method for EN above.
+2 ; Displays certain identifier for lookup.
+3 ; Called by ^DIC through DIC("W")
+4 NEW LADATA,LAY,LAX,LAF1,LAF3,LAF4,LAF103,LAF105
+5 ; Y = IEN of entry DIC is at.
+6 ; ^(0) is at the global level @(DIC_"Y,0)"
+7 SET LAX=""
+8 SET LADATA=^(0)
+9 SET LAF1=$PIECE(LADATA,U,2)
+10 if LAF1=""
SET LAF1="?"
+11 SET LAF3=$$LOW^XLFSTR($PIECE(LADATA,U,3))
+12 if LAF3=""
SET LAF3="-"
+13 SET LAF4=$PIECE(LADATA,U,5)
+14 SET LAY=$PIECE(LADATA,U,6)
+15 ; Instrument name
IF LAY'=""
Begin DoDot:1
+16 SET LAX=LAY
End DoDot:1
+17 ;
IF LAX=""
Begin DoDot:1
+18 SET LAY=$GET(^LAHM(62.49,Y,.5))
+19 SET LAY=$PIECE(LAY,U,1)
+20 if LAY=""
QUIT
+21 SET LAY=$GET(^LAHM(62.48,LAY,0))
+22 SET LAY=$PIECE(LAY,U,1)
+23 ; Config name
IF LAY'=""
Begin DoDot:2
+24 SET LAX=LAY
End DoDot:2
+25 ;
End DoDot:1
+26 SET LADATA=$GET(^LAHM(62.49,Y,100))
+27 ;sending fac
SET LAF103=$PIECE(LADATA,U,4)
+28 ;receiving fac
SET LAF105=$PIECE(LADATA,U,6)
+29 SET LAY=""
+30 IF LAF1="I"
IF LAF103'=""
SET LAY=" "_LAF103
+31 IF LAF1="O"
IF LAF105'=""
SET LAY=" "_LAF105
+32 WRITE " "_LAF1_LAF3_" "_LAX_LAY_" "_$$FMTE^XLFDT(LAF4,5)
+33 QUIT
