HLCSRPT3 ;ISC-SF/RAH-TRANS LOG MESSAGE SEARCH ;08/25/2010
;;1.6;HEALTH LEVEL SEVEN;**50,57,145,151**;Oct 13, 1995;Build 1
;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
ADVSRCH ; Entry point for message search. (from HLCSRPT)
S (HLCSLS,HLSCES,HLCSSC)=0
D GETTIME Q:$D(STOP)
D DT2IEN Q:$D(STOP)
D STATCHK Q:$D(STOP)
D LNKSRCH Q:$D(STOP)
D EVNSRCH Q:$D(STOP)
D SEARCH
D EXIT
S STOP=1
Q
GETTIME ;
W @IOF,! S HLCSHDR="Start/Stop Time Selection" D HLCSBAR
GETSTART ;
W !!," Enter START Date and Time. Date is required.",!
S DIR(0)="D^::AEPSTX",DIR("?")="^D HELP^%DTC",DIR("B")="T"
D ^DIR S:$D(DIRUT)!(X="") STOP=1 I $D(STOP) K DIR,X,Y Q
I Y'["." S Y=Y_".000001"
S HLCSST=Y K DIR,X,Y
GETEND ;
W !!," Enter END Date and Time. Date is required.",!
S DIR(0)="D^::AESTX",DIR("?")="^D HELP^%DTC",DIR("B")="NOW"
D ^DIR S:$D(DIRUT)!(X="") STOP=1 I $D(STOP) K DIR,X,Y Q
I Y'["." S Y=Y_".235959"
S HLCSET=Y K DIR,X,Y
Q
;
DT2IEN ;
;set variable to HLCSST-.0000001
;$O thru ^HL(772,"B",dt)
;get ien from "B" xref.
; that's starting value for $O(^HLMA("B",772ien,ien))
S HLCSI=HLCSST-.0000001
S HLCSI=$O(^HL(772,"B",HLCSI))
I HLCSI="" S STOP=1 W !!,HLCSNREC,!! S DIR(0)="E" D ^DIR K DIR Q
S HLCSJ=0 S HLCSJ=$O(^HL(772,"B",HLCSI,HLCSJ))
S HLCSST=HLCSJ
;set variable to HLCSET+.0000001
;reverse $O thru ^HL(772,"B",dt)
;get ien fron "B" xref.
;that's ending value for the $O thru ^HLMA("B"
S HLCSI=HLCSET+.0000001
S HLCSI=$O(^HL(772,"B",HLCSI),-1)
S HLCSJ="Z" S HLCSJ=$O(^HL(772,"B",HLCSI,HLCSJ),-1)
S HLCSET=HLCSJ
Q
;
DISPLAY ; common display method
; clean-up here
S HLCSPTR=$P(^TMP("TLOG",$J,1)," "),HLCSK=$O(^HLMA("C",HLCSPTR,0))
S HLCSPTR=+$P($G(^HLMA(+HLCSK,0)),U)
I VERS22'="YES" D DOCLIST^DDBR("^TMP($J,""LIST"")","NR")
E D BROWSE^DDBR("^TMP(""TLOG"",$J)","NA",HLCSTITL)
Q
;
SEARCH ;
W !!," . . . PLEASE WAIT, THIS CAN TAKE AWHILE . . .",!
S HLCSI=HLCSST-.1 S HLCSLN=0
F I=HLCSST:1:HLCSET S HLCSI=$O(^HLMA("B",HLCSI)) Q:HLCSI>HLCSET!(HLCSI="") D
. S HLCSN=HLCSI,HLCSJ=0 F S HLCSJ=$O(^HLMA("B",HLCSI,HLCSJ)) Q:(HLCSJ="") D
.. Q:'$D(^HLMA(HLCSJ,0)) S HLCSX=^(0),HLCSDTP=$P($G(^("S")),U)
.. ;must have a status
.. Q:'$G(^HLMA(HLCSJ,"P")) S HLCSSTC=$P(^("P"),U)
.. ;check for only one status, if not the status we want, quit
.. I HLCSSC=1,(HLCSTSTC'=HLCSSTC) Q
.. S HLCSLINK=$P(HLCSX,U,7) S HLCSLNK=" "
.. I HLCSLINK'="",($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^HLCSRPT1(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
.. I HLCSLS>0,(HLCSTLNK'=HLCSLNK) Q
.. I HLCSES>0,(HLCSES1=1)&(HLCSTEV1'=HLCSEVN1) Q
.. I HLCSES>0,(HLCSES2=2)&(HLCSTEV2'=HLCSEVN2) Q
.. I HLCSSC=1,(HLCSTSTC'=HLCSSTC) Q
.. D FORMAT
.. 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^HLCSRPT1
D DISPLAY K ^TMP("TLOG",$J)
Q
;
LNKSRCH ; Report all messages on A logical link between start and end date/time
W ! ;S HLCSHDR="Logical Link Selection" D HLCSBAR
S DIR(0)="PAO^870:AERO",DIR("A")="Select Logical Link for Report: ALL//"
D ^DIR S:($D(DUOUT)!$D(DTOUT)) STOP=1 Q:$D(STOP)
I X'="",(Y=-1) W !,X_" NOT VALID " K X,Y G LNKSRCH
I X="" S HLCSLS=0 K DIR,X,Y Q
S HLCSLNK=$P(Y,U,2),HLCSTLNK=HLCSLNK K DIR,X,Y
S HLCSLS=1
Q
;
EVNSRCH ; Reports matching Message and Event Types for a logical link.
W ! ;S HLCSHDR="Message/Event Type Search" D HLCSBAR
S HLCSES1=1,HLCSES2=2
S DIR(0)="PAO^771.2:AEO",DIR("A")="Select Message Type for Report: ALL//"
D ^DIR S:$D(DUOUT)!($D(DTOUT)) STOP=1 Q:$D(STOP)
I X'="",(Y=-1) W !,X_" NOT VALID " K X,Y G EVNSRCH
I X="" S Y="^",HLCSES1=0
S HLCSTEV1=$P(Y,U,2) K DIR,X,Y
W !
S DIR(0)="PAO^779.001:AEO",DIR("A")="Select Event Type for Report: ALL//"
D ^DIR S:$D(DUOUT)!($D(DTOUT)) STOP=1 Q:$D(STOP)
I X'="",(Y=-1) W !,X_" NOT VALID " K X,Y G EVNSRCH
I X="" S Y="^",HLCSES2=0
S HLCSTEV2=$P(Y,U,2) K DIR,X,Y
I HLCSTEV1="" S HLCSTEV1=" "
I HLCSTEV2="" S HLCSTEV2=" "
S HLCSTEVN=HLCSTEV1_":"_HLCSTEV2,HLCSES=+HLCSES1+(+HLCSES2)
Q
;
STATCHK ; Determine whether a specific stauts is desired.
W @IOF,! S HLCSHDR="Message Criteria for Search" D HLCSBAR
S HLCSSC=1
S DIR(0)="PAO^771.6:AEO",DIR("A")="Select Status Code for Report: ALL//"
D ^DIR S:$D(DUOUT)!($D(DTOUT)) STOP=1 Q:$D(STOP)
I X'="",(Y=-1) W !,X_" NOT VALID " K DIR,X,Y G STATCHK
I X="" S Y="^",HLCSSC=0 K DIR,X,Y Q
S HLCSTAT=$P(Y,U,2),HLCSTSTC=$P(Y,U,1)
K DIR,X,Y
Q
FORMAT ; Format a report line
S HLCSY=""
S HLCSRNO=HLCSJ,SPACE20=" "
I VERS22'="YES" D
. S HLCSRNO=HLCSRNO_SPACE20 S HLCSRNO=$E(HLCSRNO,1,14) S HLCSY=HLCSRNO_" "
. S HLCSMID=$P(HLCSX,U,2),HLCSMX=HLCSMID,HLCSPTR=$P(HLCSX,U,1)
. S HLCSMID=HLCSMID_SPACE20 S HLCSMID=$E(HLCSMID,1,20)
. S HLCSY=HLCSY_HLCSMID_" "
I VERS22="YES" D
. S HLCSMID=$P(HLCSX,U,2),HLCSMX=HLCSMID,HLCSPTR=$P(HLCSX,U,1)
. S HLCSMID="$.%$CREF$^TMP($J,""MESSAGE"","_HLCSRNO_")$CREF$^"_HLCSMX_"$.%"
. S Y=$L(HLCSMX),X=$E(SPACE20,1,20-Y) S HLCSMID=HLCSMID_X K X,Y
. S HLCSY=HLCSMID_" "
. S HLCSDTE=$P(HLCSX,U,1)
. S HLCSDTE=$P(^HL(772,HLCSDTE,0),U,1)
. S YR=$E(HLCSDTE,2,3),MO=$E(HLCSDTE,4,5),DAY=$E(HLCSDTE,6,7)
. S HLCSDTE=MO_DAY_YR_"."_$P(HLCSDTE,".",2)
. S HLCSDTE=HLCSDTE_SPACE20,HLCSDTE=$E(HLCSDTE,1,14)
. S HLCSY=HLCSY_HLCSDTE_" "
S HLCSY=HLCSY_$E(HLCSLNK_SPACE20,1,10)_" "
S HLCSY=HLCSY_HLCSEVN_" "
S HLCSTYP=$P(HLCSX,U,3) S:HLCSTYP="O" HLCSTYP="OT" S:HLCSTYP="I" HLCSTYP="IN"
S HLCSY=HLCSY_$E(HLCSTYP_SPACE20,1,2)_" "
S HLCSSRVR=$P(HLCSX,U,11) I HLCSSRVR'="" S HLCSSRVR=$P(^HL(771,HLCSSRVR,0),U,1)
S HLCSY=HLCSY_$E(HLCSSRVR_SPACE20,1,8)_" "
S HLCSCLNT=$P(HLCSX,U,12) I HLCSCLNT'="" S HLCSCLNT=$P(^HL(771,HLCSCLNT,0),U,1)
S HLCSY=HLCSY_$E(HLCSCLNT_SPACE20,1,8)
S HLCSLN=HLCSLN+1
I VERS22'="YES" S HLCSY=HLCSY_" " I $D(^HLMA(HLCSJ,"MSH",1,0)) S HLCSY=HLCSY_^HLMA(HLCSJ,"MSH",1,0)
S ^TMP("TLOG",$J,HLCSLN)=HLCSY
I VERS22="YES" S ^TMP($J,"MESSAGE",HLCSJ)="$XC$^D SHOWMSG^HLCSRPT1("_HLCSJ_","_HLCSPTR_")$XC$^MESSAGE"
Q
;
HLCSBAR ; Center Title on Top Line of Screen
W RVON,?(80-$L(HLCSHDR)\2),HLCSHDR,$E(SPACE,$X,77),RVOFF,!
Q
;
EXIT ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSRPT3 7092 printed Nov 22, 2024@17:07:07 Page 2
HLCSRPT3 ;ISC-SF/RAH-TRANS LOG MESSAGE SEARCH ;08/25/2010
+1 ;;1.6;HEALTH LEVEL SEVEN;**50,57,145,151**;Oct 13, 1995;Build 1
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
ADVSRCH ; Entry point for message search. (from HLCSRPT)
+1 SET (HLCSLS,HLSCES,HLCSSC)=0
+2 DO GETTIME
if $DATA(STOP)
QUIT
+3 DO DT2IEN
if $DATA(STOP)
QUIT
+4 DO STATCHK
if $DATA(STOP)
QUIT
+5 DO LNKSRCH
if $DATA(STOP)
QUIT
+6 DO EVNSRCH
if $DATA(STOP)
QUIT
+7 DO SEARCH
+8 DO EXIT
+9 SET STOP=1
+10 QUIT
GETTIME ;
+1 WRITE @IOF,!
SET HLCSHDR="Start/Stop Time Selection"
DO HLCSBAR
GETSTART ;
+1 WRITE !!," Enter START Date and Time. Date is required.",!
+2 SET DIR(0)="D^::AEPSTX"
SET DIR("?")="^D HELP^%DTC"
SET DIR("B")="T"
+3 DO ^DIR
if $DATA(DIRUT)!(X="")
SET STOP=1
IF $DATA(STOP)
KILL DIR,X,Y
QUIT
+4 IF Y'["."
SET Y=Y_".000001"
+5 SET HLCSST=Y
KILL DIR,X,Y
GETEND ;
+1 WRITE !!," Enter END Date and Time. Date is required.",!
+2 SET DIR(0)="D^::AESTX"
SET DIR("?")="^D HELP^%DTC"
SET DIR("B")="NOW"
+3 DO ^DIR
if $DATA(DIRUT)!(X="")
SET STOP=1
IF $DATA(STOP)
KILL DIR,X,Y
QUIT
+4 IF Y'["."
SET Y=Y_".235959"
+5 SET HLCSET=Y
KILL DIR,X,Y
+6 QUIT
+7 ;
DT2IEN ;
+1 ;set variable to HLCSST-.0000001
+2 ;$O thru ^HL(772,"B",dt)
+3 ;get ien from "B" xref.
+4 ; that's starting value for $O(^HLMA("B",772ien,ien))
+5 SET HLCSI=HLCSST-.0000001
+6 SET HLCSI=$ORDER(^HL(772,"B",HLCSI))
+7 IF HLCSI=""
SET STOP=1
WRITE !!,HLCSNREC,!!
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+8 SET HLCSJ=0
SET HLCSJ=$ORDER(^HL(772,"B",HLCSI,HLCSJ))
+9 SET HLCSST=HLCSJ
+10 ;set variable to HLCSET+.0000001
+11 ;reverse $O thru ^HL(772,"B",dt)
+12 ;get ien fron "B" xref.
+13 ;that's ending value for the $O thru ^HLMA("B"
+14 SET HLCSI=HLCSET+.0000001
+15 SET HLCSI=$ORDER(^HL(772,"B",HLCSI),-1)
+16 SET HLCSJ="Z"
SET HLCSJ=$ORDER(^HL(772,"B",HLCSI,HLCSJ),-1)
+17 SET HLCSET=HLCSJ
+18 QUIT
+19 ;
DISPLAY ; common display method
+1 ; clean-up here
+2 SET HLCSPTR=$PIECE(^TMP("TLOG",$JOB,1)," ")
SET HLCSK=$ORDER(^HLMA("C",HLCSPTR,0))
+3 SET HLCSPTR=+$PIECE($GET(^HLMA(+HLCSK,0)),U)
+4 IF VERS22'="YES"
DO DOCLIST^DDBR("^TMP($J,""LIST"")","NR")
+5 IF '$TEST
DO BROWSE^DDBR("^TMP(""TLOG"",$J)","NA",HLCSTITL)
+6 QUIT
+7 ;
SEARCH ;
+1 WRITE !!," . . . PLEASE WAIT, THIS CAN TAKE AWHILE . . .",!
+2 SET HLCSI=HLCSST-.1
SET HLCSLN=0
+3 FOR I=HLCSST:1:HLCSET
SET HLCSI=$ORDER(^HLMA("B",HLCSI))
if HLCSI>HLCSET!(HLCSI="")
QUIT
Begin DoDot:1
+4 SET HLCSN=HLCSI
SET HLCSJ=0
FOR
SET HLCSJ=$ORDER(^HLMA("B",HLCSI,HLCSJ))
if (HLCSJ="")
QUIT
Begin DoDot:2
+5 if '$DATA(^HLMA(HLCSJ,0))
QUIT
SET HLCSX=^(0)
SET HLCSDTP=$PIECE($GET(^("S")),U)
+6 ;must have a status
+7 if '$GET(^HLMA(HLCSJ,"P"))
QUIT
SET HLCSSTC=$PIECE(^("P"),U)
+8 ;check for only one status, if not the status we want, quit
+9 IF HLCSSC=1
IF (HLCSTSTC'=HLCSSTC)
QUIT
+10 SET HLCSLINK=$PIECE(HLCSX,U,7)
SET HLCSLNK=" "
+11 IF HLCSLINK'=""
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^HLCSRPT1(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 IF HLCSLS>0
IF (HLCSTLNK'=HLCSLNK)
QUIT
+26 IF HLCSES>0
IF (HLCSES1=1)&(HLCSTEV1'=HLCSEVN1)
QUIT
+27 IF HLCSES>0
IF (HLCSES2=2)&(HLCSTEV2'=HLCSEVN2)
QUIT
+28 IF HLCSSC=1
IF (HLCSTSTC'=HLCSSTC)
QUIT
+29 DO FORMAT
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 IF '$DATA(^TMP("TLOG",$JOB,1))
WRITE !!,HLCSNREC,!!
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+33 IF VERS22'="YES"
SET HLCSTITL="IEN RECORD # MESSAGE ID # Log Link Msg:Evn IO Sndg Apl Rcvr Apl HDR"
+34 IF '$TEST
SET HLCSTITL="MESSAGE ID # D/T Entered Log Link Msg:Evn IO Sndg Apl Rcvr Apl "
+35 IF VERS22'="YES"
DO FAKR^HLCSRPT1
+36 DO DISPLAY
KILL ^TMP("TLOG",$JOB)
+37 QUIT
+38 ;
LNKSRCH ; Report all messages on A logical link between start and end date/time
+1 ;S HLCSHDR="Logical Link Selection" D HLCSBAR
WRITE !
+2 SET DIR(0)="PAO^870:AERO"
SET DIR("A")="Select Logical Link for Report: ALL//"
+3 DO ^DIR
if ($DATA(DUOUT)!$DATA(DTOUT))
SET STOP=1
if $DATA(STOP)
QUIT
+4 IF X'=""
IF (Y=-1)
WRITE !,X_" NOT VALID "
KILL X,Y
GOTO LNKSRCH
+5 IF X=""
SET HLCSLS=0
KILL DIR,X,Y
QUIT
+6 SET HLCSLNK=$PIECE(Y,U,2)
SET HLCSTLNK=HLCSLNK
KILL DIR,X,Y
+7 SET HLCSLS=1
+8 QUIT
+9 ;
EVNSRCH ; Reports matching Message and Event Types for a logical link.
+1 ;S HLCSHDR="Message/Event Type Search" D HLCSBAR
WRITE !
+2 SET HLCSES1=1
SET HLCSES2=2
+3 SET DIR(0)="PAO^771.2:AEO"
SET DIR("A")="Select Message Type for Report: ALL//"
+4 DO ^DIR
if $DATA(DUOUT)!($DATA(DTOUT))
SET STOP=1
if $DATA(STOP)
QUIT
+5 IF X'=""
IF (Y=-1)
WRITE !,X_" NOT VALID "
KILL X,Y
GOTO EVNSRCH
+6 IF X=""
SET Y="^"
SET HLCSES1=0
+7 SET HLCSTEV1=$PIECE(Y,U,2)
KILL DIR,X,Y
+8 WRITE !
+9 SET DIR(0)="PAO^779.001:AEO"
SET DIR("A")="Select Event Type for Report: ALL//"
+10 DO ^DIR
if $DATA(DUOUT)!($DATA(DTOUT))
SET STOP=1
if $DATA(STOP)
QUIT
+11 IF X'=""
IF (Y=-1)
WRITE !,X_" NOT VALID "
KILL X,Y
GOTO EVNSRCH
+12 IF X=""
SET Y="^"
SET HLCSES2=0
+13 SET HLCSTEV2=$PIECE(Y,U,2)
KILL DIR,X,Y
+14 IF HLCSTEV1=""
SET HLCSTEV1=" "
+15 IF HLCSTEV2=""
SET HLCSTEV2=" "
+16 SET HLCSTEVN=HLCSTEV1_":"_HLCSTEV2
SET HLCSES=+HLCSES1+(+HLCSES2)
+17 QUIT
+18 ;
STATCHK ; Determine whether a specific stauts is desired.
+1 WRITE @IOF,!
SET HLCSHDR="Message Criteria for Search"
DO HLCSBAR
+2 SET HLCSSC=1
+3 SET DIR(0)="PAO^771.6:AEO"
SET DIR("A")="Select Status Code for Report: ALL//"
+4 DO ^DIR
if $DATA(DUOUT)!($DATA(DTOUT))
SET STOP=1
if $DATA(STOP)
QUIT
+5 IF X'=""
IF (Y=-1)
WRITE !,X_" NOT VALID "
KILL DIR,X,Y
GOTO STATCHK
+6 IF X=""
SET Y="^"
SET HLCSSC=0
KILL DIR,X,Y
QUIT
+7 SET HLCSTAT=$PIECE(Y,U,2)
SET HLCSTSTC=$PIECE(Y,U,1)
+8 KILL DIR,X,Y
+9 QUIT
FORMAT ; Format a report line
+1 SET HLCSY=""
+2 SET HLCSRNO=HLCSJ
SET SPACE20=" "
+3 IF VERS22'="YES"
Begin DoDot:1
+4 SET HLCSRNO=HLCSRNO_SPACE20
SET HLCSRNO=$EXTRACT(HLCSRNO,1,14)
SET HLCSY=HLCSRNO_" "
+5 SET HLCSMID=$PIECE(HLCSX,U,2)
SET HLCSMX=HLCSMID
SET HLCSPTR=$PIECE(HLCSX,U,1)
+6 SET HLCSMID=HLCSMID_SPACE20
SET HLCSMID=$EXTRACT(HLCSMID,1,20)
+7 SET HLCSY=HLCSY_HLCSMID_" "
End DoDot:1
+8 IF VERS22="YES"
Begin DoDot:1
+9 SET HLCSMID=$PIECE(HLCSX,U,2)
SET HLCSMX=HLCSMID
SET HLCSPTR=$PIECE(HLCSX,U,1)
+10 SET HLCSMID="$.%$CREF$^TMP($J,""MESSAGE"","_HLCSRNO_")$CREF$^"_HLCSMX_"$.%"
+11 SET Y=$LENGTH(HLCSMX)
SET X=$EXTRACT(SPACE20,1,20-Y)
SET HLCSMID=HLCSMID_X
KILL X,Y
+12 SET HLCSY=HLCSMID_" "
+13 SET HLCSDTE=$PIECE(HLCSX,U,1)
+14 SET HLCSDTE=$PIECE(^HL(772,HLCSDTE,0),U,1)
+15 SET YR=$EXTRACT(HLCSDTE,2,3)
SET MO=$EXTRACT(HLCSDTE,4,5)
SET DAY=$EXTRACT(HLCSDTE,6,7)
+16 SET HLCSDTE=MO_DAY_YR_"."_$PIECE(HLCSDTE,".",2)
+17 SET HLCSDTE=HLCSDTE_SPACE20
SET HLCSDTE=$EXTRACT(HLCSDTE,1,14)
+18 SET HLCSY=HLCSY_HLCSDTE_" "
End DoDot:1
+19 SET HLCSY=HLCSY_$EXTRACT(HLCSLNK_SPACE20,1,10)_" "
+20 SET HLCSY=HLCSY_HLCSEVN_" "
+21 SET HLCSTYP=$PIECE(HLCSX,U,3)
if HLCSTYP="O"
SET HLCSTYP="OT"
if HLCSTYP="I"
SET HLCSTYP="IN"
+22 SET HLCSY=HLCSY_$EXTRACT(HLCSTYP_SPACE20,1,2)_" "
+23 SET HLCSSRVR=$PIECE(HLCSX,U,11)
IF HLCSSRVR'=""
SET HLCSSRVR=$PIECE(^HL(771,HLCSSRVR,0),U,1)
+24 SET HLCSY=HLCSY_$EXTRACT(HLCSSRVR_SPACE20,1,8)_" "
+25 SET HLCSCLNT=$PIECE(HLCSX,U,12)
IF HLCSCLNT'=""
SET HLCSCLNT=$PIECE(^HL(771,HLCSCLNT,0),U,1)
+26 SET HLCSY=HLCSY_$EXTRACT(HLCSCLNT_SPACE20,1,8)
+27 SET HLCSLN=HLCSLN+1
+28 IF VERS22'="YES"
SET HLCSY=HLCSY_" "
IF $DATA(^HLMA(HLCSJ,"MSH",1,0))
SET HLCSY=HLCSY_^HLMA(HLCSJ,"MSH",1,0)
+29 SET ^TMP("TLOG",$JOB,HLCSLN)=HLCSY
+30 IF VERS22="YES"
SET ^TMP($JOB,"MESSAGE",HLCSJ)="$XC$^D SHOWMSG^HLCSRPT1("_HLCSJ_","_HLCSPTR_")$XC$^MESSAGE"
+31 QUIT
+32 ;
HLCSBAR ; Center Title on Top Line of Screen
+1 WRITE RVON,?(80-$LENGTH(HLCSHDR)\2),HLCSHDR,$EXTRACT(SPACE,$X,77),RVOFF,!
+2 QUIT
+3 ;
EXIT ;
+1 QUIT
+2 ;
