Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7UTILA

LA7UTILA.m

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