HLCSRPT1 ;ISC-SF/RAH-TRANS LOG PENDING MSG LIST;03/01/2010 14:59 ;08/25/2010
;;1.6;HEALTH LEVEL SEVEN;**19,50,107,145,151**;Oct 13, 1995;Build 1
;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
EN ; Entry Point for Pending Message Search.
D LNKSRCH Q:$D(STOP)
I HLCSLS=1 D SEARCH1 Q
D SEARCH2
Q
;
;
SEARCH1 ;
W !!," . . . PLEASE WAIT, THIS CAN TAKE AWHILE . . .",!
S HLCSI=0,HLCSIO="" S HLCSLN=0
F S HLCSIO=$O(^HLMA("AC",HLCSIO)) Q:(HLCSIO="") D
. S HLCSN=HLCSI,HLCSJ=0
. F S HLCSJ=$O(^HLMA("AC",HLCSIO,HLCSLINK,HLCSJ)) Q:(HLCSJ="") D
.. I '$D(^HLMA(HLCSJ,0)) Q
.. I '$D(^HLMA("AG",1,HLCSJ)) Q
.. S HLCSX=^HLMA(HLCSJ,0),HLCSDTE=$P(HLCSX,U,1)
.. S HLCSLNK=" "
.. I $D(^HLCS(870,HLCSLINK,0)) S HLCSLNK=$P(^HLCS(870,HLCSLINK,0),U,1)
.. ; patch HL*1.6*145 start
.. ; S HLCSEVN1=$P(HLCSX,U,13) I HLCSEVN1'="",($D(^HL(771.2,HLCSEVN1,0))) S HLCSEVN1=$P(^HL(771.2,HLCSEVN1,0),U,1)
.. ; S HLCSEVN2=$P(HLCSX,U,14) I HLCSEVN2'="",($D(^HL(779.001,HLCSEVN2,0))) S HLCSEVN2=$P(^HL(779.001,HLCSEVN2,0),U,1)
.. N SEG
.. D HEADSEG(HLCSJ,.SEG)
.. S HLCSEVN1=$G(SEG("MESSAGE TYPE"))
.. S HLCSEVN2=$G(SEG("EVENT TYPE"))
.. ; patch HL*1.6*145 end
.. I HLCSEVN1="" S HLCSEVN1=" "
.. I HLCSEVN2="" S HLCSEVN2=" "
.. I $L(HLCSEVN1)<3 S HLCSEVN1=HLCSEVN1_" ",HLCSEVN1=$E(HLCSEVN1,1,3)
.. I $L(HLCSEVN2)<3 S HLCSEVN2=HLCSEVN2_" ",HLCSEVN2=$E(HLCSEVN2,1,3)
.. S HLCSEVN=HLCSEVN1_":"_HLCSEVN2
.. D FORMAT^HLCSRPT
.. Q
. Q
I '$D(^TMP("TLOG",$J,1)) W !!,HLCSNREC,!! S DIR(0)="E" D ^DIR K DIR Q
I VERS22'="YES" S HLCSTITL="IEN RECORD # MESSAGE ID # Log Link Msg:Evn IO Sndg Apl Rcvr Apl HDR"
E S HLCSTITL="MESSAGE ID # D/T Entered Log Link Msg:Evn IO Sndg Apl Rcvr Apl "
I VERS22'="YES" D FAKR
D DISPLAY^HLCSRPT K ^TMP("TLOG",$J)
Q
;
SEARCH2 ;
W !!," . . . PLEASE WAIT, THIS CAN TAKE AWHILE . . .",!
S HLCSI=0,HLCSIO="" S HLCSLN=0
F S HLCSIO=$O(^HLMA("AC",HLCSIO)) Q:(HLCSIO="") D
. S HLCSN=HLCSI,HLCSJ=0,HLCSLINK=0
. F S HLCSLINK=$O(^HLMA("AC",HLCSIO,HLCSLINK)) Q:(HLCSLINK="") D
.. F S HLCSJ=$O(^HLMA("AC",HLCSIO,HLCSLINK,HLCSJ)) Q:(HLCSJ="") D
... I '$D(^HLMA(HLCSJ,0)) Q
... I '$D(^HLMA("AG",1,HLCSJ)) Q
... S HLCSX=^HLMA(HLCSJ,0),HLCSDTE=$P(HLCSX,U,1)
... S HLCSLNK=" "
... I $D(^HLCS(870,HLCSLINK,0)) S HLCSLNK=$P(^HLCS(870,HLCSLINK,0),U,1)
... ; patch HL*1.6*145 start
... ; S HLCSEVN1=$P(HLCSX,U,13) I HLCSEVN1'="",($D(^HL(771.2,HLCSEVN1,0))) S HLCSEVN1=$P(^HL(771.2,HLCSEVN1,0),U,1)
... ; S HLCSEVN2=$P(HLCSX,U,14) I HLCSEVN2'="",($D(^HL(779.001,HLCSEVN2,0))) S HLCSEVN2=$P(^HL(779.001,HLCSEVN2,0),U,1)
... N SEG
... D HEADSEG(HLCSJ,.SEG)
... S HLCSEVN1=$G(SEG("MESSAGE TYPE"))
... S HLCSEVN2=$G(SEG("EVENT TYPE"))
... ; patch HL*1.6*145 end
... I HLCSEVN1="" S HLCSEVN1=" "
... I HLCSEVN2="" S HLCSEVN2=" "
... I $L(HLCSEVN1)<3 S HLCSEVN1=HLCSEVN1_" ",HLCSEVN1=$E(HLCSEVN1,1,3)
... I $L(HLCSEVN2)<3 S HLCSEVN2=HLCSEVN2_" ",HLCSEVN2=$E(HLCSEVN2,1,3)
... S HLCSEVN=HLCSEVN1_":"_HLCSEVN2
... D FORMAT^HLCSRPT
... Q
.. Q
. Q
I '$D(^TMP("TLOG",$J,1)) W !!,HLCSNREC,!! S DIR(0)="E" D ^DIR K DIR Q
I VERS22'="YES" S HLCSTITL="IEN RECORD # MESSAGE ID # Log Link Msg:Evn IO Sndg Apl Rcvr Apl HDR"
E S HLCSTITL="MESSAGE ID # D/T Entered Log Link Msg:Evn IO Sndg Apl Rcvr Apl "
I VERS22'="YES" D FAKR
D DISPLAY^HLCSRPT K ^TMP("TLOG",$J)
Q
;
LNKSRCH ; Report pending messages on A logical link.
W @IOF,! S HLCSHDR="Logical Link Selection" D HLCSBAR
S DIR(0)="PAO^870:AEO",DIR("A")="Select Logical Link: ALL//"
D ^DIR S:($D(DTOUT)!($D(DUOUT))) STOP=1 Q:$D(STOP)
I X="" S HLCSLS="" K DIR,X,Y Q
I Y=-1 W !,X_" NOT VALID " K X,Y G LNKSRCH
S HLCSLINK=$P(Y,U,1),HLCSLNK=$P(Y,U,2) K DIR,X,Y
S HLCSLS=1
Q
;
FAKR ; Build fake record to pass FM21 Browser edits.
S HLCSJ=^TMP("TLOG",$J,1)
S HLCSJ=+$P(HLCSJ," ",1)
S ^TMP($J,"MESSAGE",HLCSJ,0)="^^1^1"
S ^TMP($J,"MESSAGE",HLCSJ,1,0)=" Fake Record to pass Browser edits. "
S HLCSRNO=HLCSJ
Q
;
SHOWMSG(XXY,XXZ) ;
; Each node, ^tmp($j,"message",record_ien), invokes this code
; to compile a 'virtual w-p document' when a message is browsed.
I $D(^HLMA(XXY,"MSH",0)) D
. S ^TMP($J,"MESSAGE",XXY,0)=^HLMA(XXY,"MSH",0)
. S YY1=$P(^HLMA(XXY,"MSH",0),U,3),YY2=$P(^HLMA(XXY,"MSH",0),U,4)
E S ^TMP($J,"MESSAGE",XXY,0)="1^1"
S XLINE=^HLMA(XXY,0)
S LINE="Record #: "_XXY_" ",LINE=$E(LINE,1,30)
S LINE=LINE_"Message #: "_$P(XLINE,U,2)
S ^TMP($J,"MESSAGE",XXY,1,0)=LINE
S DTE=$P(XLINE,U,1) I $P($G(^HL(772,DTE,0)),U,1)'="" S DTE=$P(^HL(772,DTE,0),U,1),DTE=$E(DTE,4,7)_$E(DTE,2,3)_"."_$P(DTE,".",2)_" "
I $D(^HLMA(XXY,"S")),$P(^HLMA(XXY,"S"),U,1)'="" S DTP=$P(^HLMA(XXY,"S"),U,1) S DTP=$E(DTP,4,7)_$E(DTP,2,3)_"."_$P(DTP,".",2)
E S DTP=" "
S LINE="D/T Entered: "_DTE,LINE=$E(LINE,1,30)_"D/T Processed: "_DTP
S ^TMP($J,"MESSAGE",XXY,2,0)=LINE K DTE,DTP
S LINE="Logical Link: " I $P(XLINE,U,7)'="",($D(^HLCS(870,$P(XLINE,U,7),0))) S LINE=LINE_$P(^HLCS(870,$P(XLINE,U,7),0),U,1)
S LINE=LINE_" ",LINE=$E(LINE,1,30)
S LINE=LINE_"Ack To MSG#: " I $P(XLINE,U,6)'="",($D(^HLMA($P(XLINE,U,6),0))) S LINE=LINE_$P(^HLMA($P(XLINE,U,6),0),U,2)
S ^TMP($J,"MESSAGE",XXY,3,0)=LINE
S DTS="" I $P($G(^HLMA(XXY,"P")),U,2)'="" S DTS=$P(^HLMA(XXY,"P"),U,2),DTS=$E(DTS,4,7)_$E(DTS,2,3)_"."_$P(DTS,".",2)
S LINE="D/T STATUS: "_DTS_" ",LINE=$E(LINE,1,30),LINE=LINE_"STATUS: "
I $P(^HLMA(XXY,"P"),U,1)'="" S LINE=LINE_$P(^HL(771.6,+$P(^HLMA(XXY,"P"),U,1),0),U,1)
S ^TMP($J,"MESSAGE",XXY,4,0)=LINE K DTS
S LINE="ERR MSG: " I $P(^HLMA(XXY,"P"),U,3)'="" S LINE=LINE_$E($P(^HLMA(XXY,"P"),U,3),1,20)
S LINE=LINE_" ",LINE=$E(LINE,1,30)_"ERR TYPE: "
I $P(^HLMA(XXY,"P"),U,4)'="" S LINE=LINE_$P(^HL(771.7,+$P(^HLMA(XXY,"P"),U,4),0),U,1)
S ^TMP($J,"MESSAGE",XXY,5,0)=LINE
S LINE="Sending Appl: " I $P(XLINE,U,11)'="",($D(^HL(771,$P(XLINE,U,11),0))) S LINE=LINE_$P(^HL(771,$P(XLINE,U,11),0),U,1)
S ^TMP($J,"MESSAGE",XXY,6,0)=LINE
S LINE="Receiving Appl: " I $P(XLINE,U,12)'="",($D(^HL(771,$P(XLINE,U,12),0))) S LINE=LINE_$P(^HL(771,$P(XLINE,U,12),0),U,1)
S ^TMP($J,"MESSAGE",XXY,7,0)=LINE
; patch HL*1.6*145 start
; S LINE="Message Type: " I $P(XLINE,U,13)'="",($D(^HL(771.2,$P(XLINE,U,13),0))) S LINE=LINE_$P(^HL(771.2,$P(XLINE,U,13),0),U,1)
N SEG
D HEADSEG(XXY,.SEG)
S LINE="Message Type: "_$G(SEG("MESSAGE TYPE"))
S LINE=LINE_" ",LINE=$E(LINE,1,30)_"Event Type: "
; I $P(XLINE,U,14)'="",($D(^HL(779.001,$P(XLINE,U,14),0))) S LINE=LINE_$P(^HL(779.001,$P(XLINE,U,14),0),U,1)
S LINE=LINE_$G(SEG("EVENT TYPE"))
; patch HL*1.6*145 end
S ^TMP($J,"MESSAGE",XXY,8,0)=LINE K LINE,XLINE
S ^TMP($J,"MESSAGE",XXY,9,0)="MESSAGE HEADER: "
S LN1=.5,LN2=10
I $D(^HLMA(XXY,"MSH",0)) D
. F S LN1=$O(^HLMA(XXY,"MSH",LN1)) Q:LN1="" D
.. S ^TMP($J,"MESSAGE",XXY,LN2,0)=^HLMA(XXY,"MSH",LN1,0)
.. ;HL*1.6*107 start: to fix the multiple lines per segment
.. ;S LN2=LN2+1,LN1=LN1+1
.. S LN2=LN2+1
.. ;HL*1.6*107 end
..Q
S LN1=.5
S ^TMP($J,"MESSAGE",XXY,LN2,0)="MESSAGE TEXT: ",LN2=LN2+1
I $D(^HL(772,XXZ,"IN",0)) D
. F S LN1=$O(^HL(772,XXZ,"IN",LN1)) Q:(LN1="") D
.. S ^TMP($J,"MESSAGE",XXY,LN2,0)=^HL(772,XXZ,"IN",LN1,0)
.. ;HL*1.6*107 start: to fix the multiple lines per segment
.. ;S LN2=LN2+1,LN1=LN1+1
.. S LN2=LN2+1
.. ;HL*1.6*107 end
..Q
S (YY1,YY2)=LN2-1
S Y1Y2=YY1_"^"_YY2
S $P(^TMP($J,"MESSAGE",XXY,0),U,3,4)=Y1Y2
K LN1,LN2,Y1Y2,YY1,YY2
Q
;
HLCSBAR ; Center Title on Top Line of Screen
W RVON,?(80-$L(HLCSHDR)\2),HLCSHDR,$E(SPACE,$X,77),RVOFF,!
Q
;
HEADSEG(IEN,SEG) ;
; patch HL*1.6*145
; input:
; IEN: ien of message in file #773
; SEG: passing by reference
; output:
; SEG
;
Q:'$G(IEN)
K SEG
S SEG=$G(^HLMA(IEN,"MSH",1,0))_$G(^HLMA(IEN,"MSH",2,0))
Q:SEG']""
S SEG("CODE")=$E(SEG,1,3)
Q:$L(SEG("CODE"))'=3
S SEG("FIELD")=$E(SEG,4)
Q:SEG("FIELD")=""
S SEG("COMPONENT")=$E(SEG,5)
Q:SEG("COMPONENT")=""
S SEG("SUB-COMPONENT")=$E(SEG,8)
S SEG("ECH-2")=$E(SEG,6)
;
S SEG("MESSAGE TYPE")=""
S SEG("EVENT TYPE")=""
;
I SEG("CODE")="MSH" D
. S SEG("SEG-9")=$P(SEG,SEG("FIELD"),9)
. S SEG("MESSAGE TYPE")=$P(SEG("SEG-9"),SEG("COMPONENT"))
. S SEG("EVENT TYPE")=$P(SEG("SEG-9"),SEG("COMPONENT"),2)
;
I SEG("CODE")="BHS" D
. S SEG("SEG-9")=$P(SEG,SEG("FIELD"),9)
. I SEG("SEG-9")]"" D
.. S SEG("SEG-9-2")=$P(SEG("SEG-9"),SEG("COMPONENT"),3)
.. S SEG("MESSAGE TYPE")=SEG("SEG-9-2")
.. I SEG("SEG-9-2")]"",$L(SEG("ECH-2")),(SEG("SEG-9-2")[SEG("ECH-2")) D
... S SEG("MESSAGE TYPE")=$P(SEG("SEG-9-2"),SEG("ECH-2"))
... S SEG("EVENT TYPE")=$P(SEG("SEG-9-2"),SEG("ECH-2"),2)
.. ;
.. Q:SEG("SUB-COMPONENT")=""
.. I SEG("SEG-9-2")]"",(SEG("SEG-9-2")[SEG("SUB-COMPONENT")) D
... S SEG("MESSAGE TYPE")=$P(SEG("SEG-9-2"),SEG("SUB-COMPONENT"))
... S SEG("EVENT TYPE")=$P(SEG("SEG-9-2"),SEG("SUB-COMPONENT"),2)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSRPT1 9100 printed Dec 13, 2024@01:56:58 Page 2
HLCSRPT1 ;ISC-SF/RAH-TRANS LOG PENDING MSG LIST;03/01/2010 14:59 ;08/25/2010
+1 ;;1.6;HEALTH LEVEL SEVEN;**19,50,107,145,151**;Oct 13, 1995;Build 1
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; Entry Point for Pending Message Search.
+1 DO LNKSRCH
if $DATA(STOP)
QUIT
+2 IF HLCSLS=1
DO SEARCH1
QUIT
+3 DO SEARCH2
+4 QUIT
+5 ;
+6 ;
SEARCH1 ;
+1 WRITE !!," . . . PLEASE WAIT, THIS CAN TAKE AWHILE . . .",!
+2 SET HLCSI=0
SET HLCSIO=""
SET HLCSLN=0
+3 FOR
SET HLCSIO=$ORDER(^HLMA("AC",HLCSIO))
if (HLCSIO="")
QUIT
Begin DoDot:1
+4 SET HLCSN=HLCSI
SET HLCSJ=0
+5 FOR
SET HLCSJ=$ORDER(^HLMA("AC",HLCSIO,HLCSLINK,HLCSJ))
if (HLCSJ="")
QUIT
Begin DoDot:2
+6 IF '$DATA(^HLMA(HLCSJ,0))
QUIT
+7 IF '$DATA(^HLMA("AG",1,HLCSJ))
QUIT
+8 SET HLCSX=^HLMA(HLCSJ,0)
SET HLCSDTE=$PIECE(HLCSX,U,1)
+9 SET HLCSLNK=" "
+10 IF $DATA(^HLCS(870,HLCSLINK,0))
SET HLCSLNK=$PIECE(^HLCS(870,HLCSLINK,0),U,1)
+11 ; patch HL*1.6*145 start
+12 ; S HLCSEVN1=$P(HLCSX,U,13) I HLCSEVN1'="",($D(^HL(771.2,HLCSEVN1,0))) S HLCSEVN1=$P(^HL(771.2,HLCSEVN1,0),U,1)
+13 ; S HLCSEVN2=$P(HLCSX,U,14) I HLCSEVN2'="",($D(^HL(779.001,HLCSEVN2,0))) S HLCSEVN2=$P(^HL(779.001,HLCSEVN2,0),U,1)
+14 NEW SEG
+15 DO HEADSEG(HLCSJ,.SEG)
+16 SET HLCSEVN1=$GET(SEG("MESSAGE TYPE"))
+17 SET HLCSEVN2=$GET(SEG("EVENT TYPE"))
+18 ; patch HL*1.6*145 end
+19 IF HLCSEVN1=""
SET HLCSEVN1=" "
+20 IF HLCSEVN2=""
SET HLCSEVN2=" "
+21 IF $LENGTH(HLCSEVN1)<3
SET HLCSEVN1=HLCSEVN1_" "
SET HLCSEVN1=$EXTRACT(HLCSEVN1,1,3)
+22 IF $LENGTH(HLCSEVN2)<3
SET HLCSEVN2=HLCSEVN2_" "
SET HLCSEVN2=$EXTRACT(HLCSEVN2,1,3)
+23 SET HLCSEVN=HLCSEVN1_":"_HLCSEVN2
+24 DO FORMAT^HLCSRPT
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
+27 IF '$DATA(^TMP("TLOG",$JOB,1))
WRITE !!,HLCSNREC,!!
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+28 IF VERS22'="YES"
SET HLCSTITL="IEN RECORD # MESSAGE ID # Log Link Msg:Evn IO Sndg Apl Rcvr Apl HDR"
+29 IF '$TEST
SET HLCSTITL="MESSAGE ID # D/T Entered Log Link Msg:Evn IO Sndg Apl Rcvr Apl "
+30 IF VERS22'="YES"
DO FAKR
+31 DO DISPLAY^HLCSRPT
KILL ^TMP("TLOG",$JOB)
+32 QUIT
+33 ;
SEARCH2 ;
+1 WRITE !!," . . . PLEASE WAIT, THIS CAN TAKE AWHILE . . .",!
+2 SET HLCSI=0
SET HLCSIO=""
SET HLCSLN=0
+3 FOR
SET HLCSIO=$ORDER(^HLMA("AC",HLCSIO))
if (HLCSIO="")
QUIT
Begin DoDot:1
+4 SET HLCSN=HLCSI
SET HLCSJ=0
SET HLCSLINK=0
+5 FOR
SET HLCSLINK=$ORDER(^HLMA("AC",HLCSIO,HLCSLINK))
if (HLCSLINK="")
QUIT
Begin DoDot:2
+6 FOR
SET HLCSJ=$ORDER(^HLMA("AC",HLCSIO,HLCSLINK,HLCSJ))
if (HLCSJ="")
QUIT
Begin DoDot:3
+7 IF '$DATA(^HLMA(HLCSJ,0))
QUIT
+8 IF '$DATA(^HLMA("AG",1,HLCSJ))
QUIT
+9 SET HLCSX=^HLMA(HLCSJ,0)
SET HLCSDTE=$PIECE(HLCSX,U,1)
+10 SET HLCSLNK=" "
+11 IF $DATA(^HLCS(870,HLCSLINK,0))
SET HLCSLNK=$PIECE(^HLCS(870,HLCSLINK,0),U,1)
+12 ; patch HL*1.6*145 start
+13 ; S HLCSEVN1=$P(HLCSX,U,13) I HLCSEVN1'="",($D(^HL(771.2,HLCSEVN1,0))) S HLCSEVN1=$P(^HL(771.2,HLCSEVN1,0),U,1)
+14 ; S HLCSEVN2=$P(HLCSX,U,14) I HLCSEVN2'="",($D(^HL(779.001,HLCSEVN2,0))) S HLCSEVN2=$P(^HL(779.001,HLCSEVN2,0),U,1)
+15 NEW SEG
+16 DO HEADSEG(HLCSJ,.SEG)
+17 SET HLCSEVN1=$GET(SEG("MESSAGE TYPE"))
+18 SET HLCSEVN2=$GET(SEG("EVENT TYPE"))
+19 ; patch HL*1.6*145 end
+20 IF HLCSEVN1=""
SET HLCSEVN1=" "
+21 IF HLCSEVN2=""
SET HLCSEVN2=" "
+22 IF $LENGTH(HLCSEVN1)<3
SET HLCSEVN1=HLCSEVN1_" "
SET HLCSEVN1=$EXTRACT(HLCSEVN1,1,3)
+23 IF $LENGTH(HLCSEVN2)<3
SET HLCSEVN2=HLCSEVN2_" "
SET HLCSEVN2=$EXTRACT(HLCSEVN2,1,3)
+24 SET HLCSEVN=HLCSEVN1_":"_HLCSEVN2
+25 DO FORMAT^HLCSRPT
+26 QUIT
End DoDot:3
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 IF '$DATA(^TMP("TLOG",$JOB,1))
WRITE !!,HLCSNREC,!!
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+30 IF VERS22'="YES"
SET HLCSTITL="IEN RECORD # MESSAGE ID # Log Link Msg:Evn IO Sndg Apl Rcvr Apl HDR"
+31 IF '$TEST
SET HLCSTITL="MESSAGE ID # D/T Entered Log Link Msg:Evn IO Sndg Apl Rcvr Apl "
+32 IF VERS22'="YES"
DO FAKR
+33 DO DISPLAY^HLCSRPT
KILL ^TMP("TLOG",$JOB)
+34 QUIT
+35 ;
LNKSRCH ; Report pending messages on A logical link.
+1 WRITE @IOF,!
SET HLCSHDR="Logical Link Selection"
DO HLCSBAR
+2 SET DIR(0)="PAO^870:AEO"
SET DIR("A")="Select Logical Link: ALL//"
+3 DO ^DIR
if ($DATA(DTOUT)!($DATA(DUOUT)))
SET STOP=1
if $DATA(STOP)
QUIT
+4 IF X=""
SET HLCSLS=""
KILL DIR,X,Y
QUIT
+5 IF Y=-1
WRITE !,X_" NOT VALID "
KILL X,Y
GOTO LNKSRCH
+6 SET HLCSLINK=$PIECE(Y,U,1)
SET HLCSLNK=$PIECE(Y,U,2)
KILL DIR,X,Y
+7 SET HLCSLS=1
+8 QUIT
+9 ;
FAKR ; Build fake record to pass FM21 Browser edits.
+1 SET HLCSJ=^TMP("TLOG",$JOB,1)
+2 SET HLCSJ=+$PIECE(HLCSJ," ",1)
+3 SET ^TMP($JOB,"MESSAGE",HLCSJ,0)="^^1^1"
+4 SET ^TMP($JOB,"MESSAGE",HLCSJ,1,0)=" Fake Record to pass Browser edits. "
+5 SET HLCSRNO=HLCSJ
+6 QUIT
+7 ;
SHOWMSG(XXY,XXZ) ;
+1 ; Each node, ^tmp($j,"message",record_ien), invokes this code
+2 ; to compile a 'virtual w-p document' when a message is browsed.
+3 IF $DATA(^HLMA(XXY,"MSH",0))
Begin DoDot:1
+4 SET ^TMP($JOB,"MESSAGE",XXY,0)=^HLMA(XXY,"MSH",0)
+5 SET YY1=$PIECE(^HLMA(XXY,"MSH",0),U,3)
SET YY2=$PIECE(^HLMA(XXY,"MSH",0),U,4)
End DoDot:1
+6 IF '$TEST
SET ^TMP($JOB,"MESSAGE",XXY,0)="1^1"
+7 SET XLINE=^HLMA(XXY,0)
+8 SET LINE="Record #: "_XXY_" "
SET LINE=$EXTRACT(LINE,1,30)
+9 SET LINE=LINE_"Message #: "_$PIECE(XLINE,U,2)
+10 SET ^TMP($JOB,"MESSAGE",XXY,1,0)=LINE
+11 SET DTE=$PIECE(XLINE,U,1)
IF $PIECE($GET(^HL(772,DTE,0)),U,1)'=""
SET DTE=$PIECE(^HL(772,DTE,0),U,1)
SET DTE=$EXTRACT(DTE,4,7)_$EXTRACT(DTE,2,3)_"."_$PIECE(DTE,".",2)_" "
+12 IF $DATA(^HLMA(XXY,"S"))
IF $PIECE(^HLMA(XXY,"S"),U,1)'=""
SET DTP=$PIECE(^HLMA(XXY,"S"),U,1)
SET DTP=$EXTRACT(DTP,4,7)_$EXTRACT(DTP,2,3)_"."_$PIECE(DTP,".",2)
+13 IF '$TEST
SET DTP=" "
+14 SET LINE="D/T Entered: "_DTE
SET LINE=$EXTRACT(LINE,1,30)_"D/T Processed: "_DTP
+15 SET ^TMP($JOB,"MESSAGE",XXY,2,0)=LINE
KILL DTE,DTP
+16 SET LINE="Logical Link: "
IF $PIECE(XLINE,U,7)'=""
IF ($DATA(^HLCS(870,$PIECE(XLINE,U,7),0)))
SET LINE=LINE_$PIECE(^HLCS(870,$PIECE(XLINE,U,7),0),U,1)
+17 SET LINE=LINE_" "
SET LINE=$EXTRACT(LINE,1,30)
+18 SET LINE=LINE_"Ack To MSG#: "
IF $PIECE(XLINE,U,6)'=""
IF ($DATA(^HLMA($PIECE(XLINE,U,6),0)))
SET LINE=LINE_$PIECE(^HLMA($PIECE(XLINE,U,6),0),U,2)
+19 SET ^TMP($JOB,"MESSAGE",XXY,3,0)=LINE
+20 SET DTS=""
IF $PIECE($GET(^HLMA(XXY,"P")),U,2)'=""
SET DTS=$PIECE(^HLMA(XXY,"P"),U,2)
SET DTS=$EXTRACT(DTS,4,7)_$EXTRACT(DTS,2,3)_"."_$PIECE(DTS,".",2)
+21 SET LINE="D/T STATUS: "_DTS_" "
SET LINE=$EXTRACT(LINE,1,30)
SET LINE=LINE_"STATUS: "
+22 IF $PIECE(^HLMA(XXY,"P"),U,1)'=""
SET LINE=LINE_$PIECE(^HL(771.6,+$PIECE(^HLMA(XXY,"P"),U,1),0),U,1)
+23 SET ^TMP($JOB,"MESSAGE",XXY,4,0)=LINE
KILL DTS
+24 SET LINE="ERR MSG: "
IF $PIECE(^HLMA(XXY,"P"),U,3)'=""
SET LINE=LINE_$EXTRACT($PIECE(^HLMA(XXY,"P"),U,3),1,20)
+25 SET LINE=LINE_" "
SET LINE=$EXTRACT(LINE,1,30)_"ERR TYPE: "
+26 IF $PIECE(^HLMA(XXY,"P"),U,4)'=""
SET LINE=LINE_$PIECE(^HL(771.7,+$PIECE(^HLMA(XXY,"P"),U,4),0),U,1)
+27 SET ^TMP($JOB,"MESSAGE",XXY,5,0)=LINE
+28 SET LINE="Sending Appl: "
IF $PIECE(XLINE,U,11)'=""
IF ($DATA(^HL(771,$PIECE(XLINE,U,11),0)))
SET LINE=LINE_$PIECE(^HL(771,$PIECE(XLINE,U,11),0),U,1)
+29 SET ^TMP($JOB,"MESSAGE",XXY,6,0)=LINE
+30 SET LINE="Receiving Appl: "
IF $PIECE(XLINE,U,12)'=""
IF ($DATA(^HL(771,$PIECE(XLINE,U,12),0)))
SET LINE=LINE_$PIECE(^HL(771,$PIECE(XLINE,U,12),0),U,1)
+31 SET ^TMP($JOB,"MESSAGE",XXY,7,0)=LINE
+32 ; patch HL*1.6*145 start
+33 ; S LINE="Message Type: " I $P(XLINE,U,13)'="",($D(^HL(771.2,$P(XLINE,U,13),0))) S LINE=LINE_$P(^HL(771.2,$P(XLINE,U,13),0),U,1)
+34 NEW SEG
+35 DO HEADSEG(XXY,.SEG)
+36 SET LINE="Message Type: "_$GET(SEG("MESSAGE TYPE"))
+37 SET LINE=LINE_" "
SET LINE=$EXTRACT(LINE,1,30)_"Event Type: "
+38 ; I $P(XLINE,U,14)'="",($D(^HL(779.001,$P(XLINE,U,14),0))) S LINE=LINE_$P(^HL(779.001,$P(XLINE,U,14),0),U,1)
+39 SET LINE=LINE_$GET(SEG("EVENT TYPE"))
+40 ; patch HL*1.6*145 end
+41 SET ^TMP($JOB,"MESSAGE",XXY,8,0)=LINE
KILL LINE,XLINE
+42 SET ^TMP($JOB,"MESSAGE",XXY,9,0)="MESSAGE HEADER: "
+43 SET LN1=.5
SET LN2=10
+44 IF $DATA(^HLMA(XXY,"MSH",0))
Begin DoDot:1
+45 FOR
SET LN1=$ORDER(^HLMA(XXY,"MSH",LN1))
if LN1=""
QUIT
Begin DoDot:2
+46 SET ^TMP($JOB,"MESSAGE",XXY,LN2,0)=^HLMA(XXY,"MSH",LN1,0)
+47 ;HL*1.6*107 start: to fix the multiple lines per segment
+48 ;S LN2=LN2+1,LN1=LN1+1
+49 SET LN2=LN2+1
+50 ;HL*1.6*107 end
+51 QUIT
End DoDot:2
End DoDot:1
+52 SET LN1=.5
+53 SET ^TMP($JOB,"MESSAGE",XXY,LN2,0)="MESSAGE TEXT: "
SET LN2=LN2+1
+54 IF $DATA(^HL(772,XXZ,"IN",0))
Begin DoDot:1
+55 FOR
SET LN1=$ORDER(^HL(772,XXZ,"IN",LN1))
if (LN1="")
QUIT
Begin DoDot:2
+56 SET ^TMP($JOB,"MESSAGE",XXY,LN2,0)=^HL(772,XXZ,"IN",LN1,0)
+57 ;HL*1.6*107 start: to fix the multiple lines per segment
+58 ;S LN2=LN2+1,LN1=LN1+1
+59 SET LN2=LN2+1
+60 ;HL*1.6*107 end
+61 QUIT
End DoDot:2
End DoDot:1
+62 SET (YY1,YY2)=LN2-1
+63 SET Y1Y2=YY1_"^"_YY2
+64 SET $PIECE(^TMP($JOB,"MESSAGE",XXY,0),U,3,4)=Y1Y2
+65 KILL LN1,LN2,Y1Y2,YY1,YY2
+66 QUIT
+67 ;
HLCSBAR ; Center Title on Top Line of Screen
+1 WRITE RVON,?(80-$LENGTH(HLCSHDR)\2),HLCSHDR,$EXTRACT(SPACE,$X,77),RVOFF,!
+2 QUIT
+3 ;
HEADSEG(IEN,SEG) ;
+1 ; patch HL*1.6*145
+2 ; input:
+3 ; IEN: ien of message in file #773
+4 ; SEG: passing by reference
+5 ; output:
+6 ; SEG
+7 ;
+8 if '$GET(IEN)
QUIT
+9 KILL SEG
+10 SET SEG=$GET(^HLMA(IEN,"MSH",1,0))_$GET(^HLMA(IEN,"MSH",2,0))
+11 if SEG']""
QUIT
+12 SET SEG("CODE")=$EXTRACT(SEG,1,3)
+13 if $LENGTH(SEG("CODE"))'=3
QUIT
+14 SET SEG("FIELD")=$EXTRACT(SEG,4)
+15 if SEG("FIELD")=""
QUIT
+16 SET SEG("COMPONENT")=$EXTRACT(SEG,5)
+17 if SEG("COMPONENT")=""
QUIT
+18 SET SEG("SUB-COMPONENT")=$EXTRACT(SEG,8)
+19 SET SEG("ECH-2")=$EXTRACT(SEG,6)
+20 ;
+21 SET SEG("MESSAGE TYPE")=""
+22 SET SEG("EVENT TYPE")=""
+23 ;
+24 IF SEG("CODE")="MSH"
Begin DoDot:1
+25 SET SEG("SEG-9")=$PIECE(SEG,SEG("FIELD"),9)
+26 SET SEG("MESSAGE TYPE")=$PIECE(SEG("SEG-9"),SEG("COMPONENT"))
+27 SET SEG("EVENT TYPE")=$PIECE(SEG("SEG-9"),SEG("COMPONENT"),2)
End DoDot:1
+28 ;
+29 IF SEG("CODE")="BHS"
Begin DoDot:1
+30 SET SEG("SEG-9")=$PIECE(SEG,SEG("FIELD"),9)
+31 IF SEG("SEG-9")]""
Begin DoDot:2
+32 SET SEG("SEG-9-2")=$PIECE(SEG("SEG-9"),SEG("COMPONENT"),3)
+33 SET SEG("MESSAGE TYPE")=SEG("SEG-9-2")
+34 IF SEG("SEG-9-2")]""
IF $LENGTH(SEG("ECH-2"))
IF (SEG("SEG-9-2")[SEG("ECH-2"))
Begin DoDot:3
+35 SET SEG("MESSAGE TYPE")=$PIECE(SEG("SEG-9-2"),SEG("ECH-2"))
+36 SET SEG("EVENT TYPE")=$PIECE(SEG("SEG-9-2"),SEG("ECH-2"),2)
End DoDot:3
+37 ;
+38 if SEG("SUB-COMPONENT")=""
QUIT
+39 IF SEG("SEG-9-2")]""
IF (SEG("SEG-9-2")[SEG("SUB-COMPONENT"))
Begin DoDot:3
+40 SET SEG("MESSAGE TYPE")=$PIECE(SEG("SEG-9-2"),SEG("SUB-COMPONENT"))
+41 SET SEG("EVENT TYPE")=$PIECE(SEG("SEG-9-2"),SEG("SUB-COMPONENT"),2)
End DoDot:3
End DoDot:2
End DoDot:1
+42 QUIT
+43 ;
