HLQPURGE ;ALB/CJM/ -PURGING A LINK ;02/14/2011
;;1.6;HEALTH LEVEL SEVEN;**153**;Oct 13, 1995;Build 11
;Per VHA Directive 2004-038, this routine should not be modified.
;
ASKPURGE ;
N LINKIEN,END,LINKNAME,QUIT
S LINKIEN=$$ASKLINK
;W !,"LINKIEN=",LINKIEN
Q:'LINKIEN
S LINKNAME=$P($G(^HLCS(870,LINKIEN,0)),"^")
I '$P($G(^HLCS(870,LINKIEN,0)),"^",15) W !!,LINKNAME_" must be shutdown before it can be cleared of pending messages!" Q
S PROMPT="Are you sure you want to purge "_LINKNAME
Q:'$$ASKYESNO(PROMPT,"NO")
S QUIT=0
;;; Added the following instuctional message. - RBN
W !!,"There are two purging options: ALL or Before a particular DT/TM",!
S PROMPT="Do you want to purge all messages queued to that link"
I '$$ASKYESNO(PROMPT,"NO") D Q:QUIT
.S PROMPT="Do you want to purge messages before a particular DT/TM"
.I '$$ASKYESNO(PROMPT,"YES") W !,"Sorry, those are the only options!" S QUIT=1 QUIT
.S END=$$ASKEND
.I 'END S QUIT=1
I '$G(END) S END=0
D QPURGE(LINKIEN,END)
S $P(^HLCS(870,LINKIEN,"OUT QUEUE FRONT POINTER"),"^")=0
S $P(^HLCS(870,LINKIEN,"OUT QUEUE BACK POINTER"),"^")=$$COUNT(LINKIEN)
Q
RESET ;Resets the counters for a TCP queue
N LINKIEN,STATE
S LINKIEN=$$ASKLINK
Q:'LINKIEN
S $P(^HLCS(870,LINKIEN,"OUT QUEUE FRONT POINTER"),"^")=0
S $P(^HLCS(870,LINKIEN,"OUT QUEUE BACK POINTER"),"^")=$$COUNT(LINKIEN)
S $P(^HLCS(870,LINKIEN,"IN QUEUE FRONT POINTER"),"^")=0
S $P(^HLCS(870,LINKIEN,"IN QUEUE BACK POINTER"),"^")=$$COUNT(LINKIEN,"I")
S STATE=$P(^HLCS(870,LINKIEN,0),U,5)
I +STATE,$P(STATE," ",2)="server" S STATE="0 server"
Q
;
QPURGE(LINKIEN,END) ;
N MSGIEN,QUIT,DOTCNT,MSGCNT
S (QUIT,MSGIEN,DOTCNT,DOTCNT,MSGCNT)=0
I $D(^HLMA("AC","O",LINKIEN)) D
. W !
E W !,"There are no messages to purge!" Q
F S MSGIEN=$O(^HLMA("AC","O",LINKIEN,MSGIEN)) Q:'MSGIEN D Q:QUIT
.I END S QUIT=0 D Q:QUIT
..N TIME,BODY
..S BODY=$P($G(^HLMA(MSGIEN,0)),"^")
..Q:'BODY
..S TIME=$P($G(^HL(772,BODY,0)),"^")
..I TIME>END S QUIT=1
.;
.; Added counter to decrease the number of dots printed - RBN
.; Added counter to display the number of messages processed - RBN
.;
.;W "."
.;
.I '(DOTCNT#1000) D
..W "."
.S DOTCNT=DOTCNT+1
.S MSGCNT=MSGCNT+1
.K ^HLMA("AC","O",LINKIEN,MSGIEN)
.S $P(^HLMA(MSGIEN,"P"),"^",1)="4"
.S $P(^HLMA(MSGIEN,"P"),"^",2)=$$NOW^XLFDT
.S $P(^HLMA(MSGIEN,"P"),"^",3)="Cancelled by application"
.D PURGE(MSGIEN)
W !,"DONE: "_MSGCNT_" messages processed."
Q
;
PURGE(IEN) ;sets the AI x-ref on file 773 and the FAST PURGE DT/TM fields in file 772 and 773
;Input: IEN is the ien of record in file 773
;
Q:'$G(IEN)
;
;
N NODE,WHEN,CHILD
;
;also not if DON'T PURGE field is set
Q:$P($G(^HLMA(IEN,2)),"^")=1
;
;also not if this isn't the initial message
S NODE=$G(^HLMA(IEN,0))
I $P(NODE,"^",6),$P(NODE,"^",6)'=IEN Q
;
;This record can be purged via FAST PURGE
;determine the dt/tm the record can be purged
S WHEN=$$NOW^XLFDT
S WHEN=$$FMADD^XLFDT(WHEN,3)
;
;set the FAST PURGE DT/TM and x-ref, and do the same for file 772 record
D SET(IEN,WHEN,+NODE)
;
;All the records in file 773 that point to this record (children) should be purged at the same time
S CHILD=0
F S CHILD=$O(^HLMA("AF",IEN,CHILD)) Q:'CHILD D:(CHILD'=IEN) SET(CHILD,WHEN,+$G(^HLMA(CHILD,0)))
Q
;
SET(IEN773,WHEN,IEN772) ;sets FAST PURGE DT/TM for and the AI x~ref for both file 772 & 773
;Input:
; IEN773 - ien of record to be purged in file 773
; WHEN - date/time to purge
; IEN772 - ien of corresponding record in file 772
;
N OLDWHEN
;if the fast purge dt/tm changed, kill the old xref
S OLDWHEN=$P($G(^HLMA(IEN773,2)),"^",2)
I $L(OLDWHEN) K ^HLMA("AI",OLDWHEN,773,IEN773)
;
;set the FAST PURGE DATE
S $P(^HLMA(IEN773,2),"^",2)=WHEN
;
;set the AI x-ref
S ^HLMA("AI",WHEN,773,IEN773)=""
;
;do the same for the corresponding entry in file 772
I IEN772,$D(^HL(772,IEN772,0)) D
.;if the fast purge dt/tm changed, kill the old xref
.S OLDWHEN=$P($G(^HL(772,IEN772,2)),"^",2)
.I $L(OLDWHEN) K ^HLMA("AI",OLDWHEN,772,IEN772)
.;set the FAST PURGE DATE
.S $P(^HL(772,IEN772,2),"^",2)=WHEN
.;
.;set the AI x-ref
.S ^HLMA("AI",WHEN,772,IEN772)=""
Q
;
ASKYESNO(PROMPT,DEFAULT) ;
;Description: Displays PROMPT, appending '?'. Expects a YES NO response
;Input:
; PROMPT - text to display as prompt. Appends '?'
; DEFAULT - (optional) YES or NO. If not passed, defaults to YES
;Output:
; Function value: 1 if yes, 0 if no, "" if '^' entered or timeout
;
N DIR,Y
S DIR(0)="Y"
S DIR("A")=PROMPT
S DIR("B")=$S($G(DEFAULT)="NO":"NO",1:"YES")
D ^DIR
Q:$D(DIRUT) ""
Q Y
;
ASKLINK() ;
N DIC,TCP,X,Y,DTOUT,DUOUT
S DIC=870
S DIC(0)="AENQ"
S TCP=$O(^HLCS(869.1,"B","TCP",0))
S DIC("A")="Select a TCP link:"
S DIC("S")="I $P(^(0),U,3)=TCP"
D ^DIC
I +Y'=-1,'$D(DTOUT),'$D(DUOUT) Q $P(Y,"^")
Q ""
;
ASKEND() ;
;
N %DT
S %DT="AEST"
S %DT("A")="Enter the ending date/time: "
S %DT(0)="-NOW"
Q:$D(DTOUT) 0
D ^%DT
I Y=-1 Q 0
Q Y
COUNT(LINKIEN,DIR) ;
N MSG,COUNT
I $G(DIR)="" S DIR="O"
S (MSG,COUNT)=0
F S MSG=$O(^HLMA("AC",DIR,LINKIEN,MSG)) Q:'MSG S COUNT=COUNT+1
Q COUNT
SHOWTCP ;
N Q,H,F,NM,HDR,LINE,QUIT,CRT
S QUIT=0
S CRT=$S($E(IOST,1,2)="C-":1,1:0)
W @IOF
S HDR(1)="Link(ien) Dir/Dev/Auto First Message Count State"
S HDR(2)="========= ============ =============== ========= =========="
D LINE(HDR(1))
D LINE(HDR(2))
F Q="I","O" D
.S H=0
.F S H=$O(^HLMA("AC",Q,H)) Q:'H Q:QUIT D
..N NODE0
..S NODE0=$G(^HLCS(870,H,0))
..S F=$O(^HLMA("AC",Q,H,0))
..S NM=$P(NODE0,"^")
..S:NM="" NM="ORPHAN"
..S LINE=$$LJ(NM_"("_H_")",14)_" "_$$LJ(Q_"/"_$$LJ($P(NODE0,"^",4),2)_"/"_$S($P(NODE0,"^",6):" ",1:"No"),15)_" "_$$LJ($S($P($G(^HLMA(F,"P")),"^",1)'=1:"*",1:"")_F,18)_$$RJ($$COUNT(H,Q),10)_" "_$P(NODE0,"^",5)
..D LINE(LINE)
Q
;
PAUSE ;
;First scrolls to the bottom of the page, then does a screen pause. Sets QUIT=1 if user decides to quit.
;
D PAUSE2
Q:QUIT
W HDR(1),!,HDR(2)
Q
PAUSE2 ;
;Screen pause without scrolling. Sets QUIT=1 if user decides to quit.
;
N DIR,X,Y
S DIR(0)="E"
D ^DIR
I ('(+Y))!$D(DIRUT) S QUIT=1
Q
;
LINE(LINE) ;Prints a line.
;
I CRT,($Y>(IOSL-4)) D
.D PAUSE
.Q:QUIT
.W @IOF
.W HDR(1),!,HDR(2),!
.W LINE
;
E I ('CRT),($Y>(IOSL-2)) D
.W @IOF
.W HDR(1),!,HDR(2)
.W LINE
E W !,LINE
Q
;
LJ(STRING,LEN) ;
Q $$LJ^XLFSTR($E(STRING,1,LEN),LEN)
RJ(STRING,LEN) ;
Q $$RJ^XLFSTR($E(STRING,1,LEN),LEN)
ONETCP ;Display one TCP link
N IEN,DA,MSG,DIC,DIR,QUIT
S QUIT=0
S IEN=$$ASKLINK
Q:'IEN
Q:QUIT
F DIR="I","O" D Q:QUIT
.S MSG=$O(^HLMA("AC",DIR,IEN,0))
.I MSG D
..W @IOF,!!,"Count of messages on ",$S(DIR="I":"incoming",1:"outgoing")," queue: ",$$COUNT(IEN,DIR)
..W !!,"First pending message follows:",!
..S DIC="^HLMA("
..S DA=MSG
..D EN^DIQ
..D PAUSE2
Q:QUIT
W @IOF,!!,"Here is the TCP link:",!
S DIC="^HLCS(870,"
S DA=IEN
D EN^DIQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLQPURGE 7129 printed Oct 16, 2024@18:00:36 Page 2
HLQPURGE ;ALB/CJM/ -PURGING A LINK ;02/14/2011
+1 ;;1.6;HEALTH LEVEL SEVEN;**153**;Oct 13, 1995;Build 11
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
ASKPURGE ;
+1 NEW LINKIEN,END,LINKNAME,QUIT
+2 SET LINKIEN=$$ASKLINK
+3 ;W !,"LINKIEN=",LINKIEN
+4 if 'LINKIEN
QUIT
+5 SET LINKNAME=$PIECE($GET(^HLCS(870,LINKIEN,0)),"^")
+6 IF '$PIECE($GET(^HLCS(870,LINKIEN,0)),"^",15)
WRITE !!,LINKNAME_" must be shutdown before it can be cleared of pending messages!"
QUIT
+7 SET PROMPT="Are you sure you want to purge "_LINKNAME
+8 if '$$ASKYESNO(PROMPT,"NO")
QUIT
+9 SET QUIT=0
+10 ;;; Added the following instuctional message. - RBN
+11 WRITE !!,"There are two purging options: ALL or Before a particular DT/TM",!
+12 SET PROMPT="Do you want to purge all messages queued to that link"
+13 IF '$$ASKYESNO(PROMPT,"NO")
Begin DoDot:1
+14 SET PROMPT="Do you want to purge messages before a particular DT/TM"
+15 IF '$$ASKYESNO(PROMPT,"YES")
WRITE !,"Sorry, those are the only options!"
SET QUIT=1
QUIT
+16 SET END=$$ASKEND
+17 IF 'END
SET QUIT=1
End DoDot:1
if QUIT
QUIT
+18 IF '$GET(END)
SET END=0
+19 DO QPURGE(LINKIEN,END)
+20 SET $PIECE(^HLCS(870,LINKIEN,"OUT QUEUE FRONT POINTER"),"^")=0
+21 SET $PIECE(^HLCS(870,LINKIEN,"OUT QUEUE BACK POINTER"),"^")=$$COUNT(LINKIEN)
+22 QUIT
RESET ;Resets the counters for a TCP queue
+1 NEW LINKIEN,STATE
+2 SET LINKIEN=$$ASKLINK
+3 if 'LINKIEN
QUIT
+4 SET $PIECE(^HLCS(870,LINKIEN,"OUT QUEUE FRONT POINTER"),"^")=0
+5 SET $PIECE(^HLCS(870,LINKIEN,"OUT QUEUE BACK POINTER"),"^")=$$COUNT(LINKIEN)
+6 SET $PIECE(^HLCS(870,LINKIEN,"IN QUEUE FRONT POINTER"),"^")=0
+7 SET $PIECE(^HLCS(870,LINKIEN,"IN QUEUE BACK POINTER"),"^")=$$COUNT(LINKIEN,"I")
+8 SET STATE=$PIECE(^HLCS(870,LINKIEN,0),U,5)
+9 IF +STATE
IF $PIECE(STATE," ",2)="server"
SET STATE="0 server"
+10 QUIT
+11 ;
QPURGE(LINKIEN,END) ;
+1 NEW MSGIEN,QUIT,DOTCNT,MSGCNT
+2 SET (QUIT,MSGIEN,DOTCNT,DOTCNT,MSGCNT)=0
+3 IF $DATA(^HLMA("AC","O",LINKIEN))
Begin DoDot:1
+4 WRITE !
End DoDot:1
+5 IF '$TEST
WRITE !,"There are no messages to purge!"
QUIT
+6 FOR
SET MSGIEN=$ORDER(^HLMA("AC","O",LINKIEN,MSGIEN))
if 'MSGIEN
QUIT
Begin DoDot:1
+7 IF END
SET QUIT=0
Begin DoDot:2
+8 NEW TIME,BODY
+9 SET BODY=$PIECE($GET(^HLMA(MSGIEN,0)),"^")
+10 if 'BODY
QUIT
+11 SET TIME=$PIECE($GET(^HL(772,BODY,0)),"^")
+12 IF TIME>END
SET QUIT=1
End DoDot:2
if QUIT
QUIT
+13 ;
+14 ; Added counter to decrease the number of dots printed - RBN
+15 ; Added counter to display the number of messages processed - RBN
+16 ;
+17 ;W "."
+18 ;
+19 IF '(DOTCNT#1000)
Begin DoDot:2
+20 WRITE "."
End DoDot:2
+21 SET DOTCNT=DOTCNT+1
+22 SET MSGCNT=MSGCNT+1
+23 KILL ^HLMA("AC","O",LINKIEN,MSGIEN)
+24 SET $PIECE(^HLMA(MSGIEN,"P"),"^",1)="4"
+25 SET $PIECE(^HLMA(MSGIEN,"P"),"^",2)=$$NOW^XLFDT
+26 SET $PIECE(^HLMA(MSGIEN,"P"),"^",3)="Cancelled by application"
+27 DO PURGE(MSGIEN)
End DoDot:1
if QUIT
QUIT
+28 WRITE !,"DONE: "_MSGCNT_" messages processed."
+29 QUIT
+30 ;
PURGE(IEN) ;sets the AI x-ref on file 773 and the FAST PURGE DT/TM fields in file 772 and 773
+1 ;Input: IEN is the ien of record in file 773
+2 ;
+3 if '$GET(IEN)
QUIT
+4 ;
+5 ;
+6 NEW NODE,WHEN,CHILD
+7 ;
+8 ;also not if DON'T PURGE field is set
+9 if $PIECE($GET(^HLMA(IEN,2)),"^")=1
QUIT
+10 ;
+11 ;also not if this isn't the initial message
+12 SET NODE=$GET(^HLMA(IEN,0))
+13 IF $PIECE(NODE,"^",6)
IF $PIECE(NODE,"^",6)'=IEN
QUIT
+14 ;
+15 ;This record can be purged via FAST PURGE
+16 ;determine the dt/tm the record can be purged
+17 SET WHEN=$$NOW^XLFDT
+18 SET WHEN=$$FMADD^XLFDT(WHEN,3)
+19 ;
+20 ;set the FAST PURGE DT/TM and x-ref, and do the same for file 772 record
+21 DO SET(IEN,WHEN,+NODE)
+22 ;
+23 ;All the records in file 773 that point to this record (children) should be purged at the same time
+24 SET CHILD=0
+25 FOR
SET CHILD=$ORDER(^HLMA("AF",IEN,CHILD))
if 'CHILD
QUIT
if (CHILD'=IEN)
DO SET(CHILD,WHEN,+$GET(^HLMA(CHILD,0)))
+26 QUIT
+27 ;
SET(IEN773,WHEN,IEN772) ;sets FAST PURGE DT/TM for and the AI x~ref for both file 772 & 773
+1 ;Input:
+2 ; IEN773 - ien of record to be purged in file 773
+3 ; WHEN - date/time to purge
+4 ; IEN772 - ien of corresponding record in file 772
+5 ;
+6 NEW OLDWHEN
+7 ;if the fast purge dt/tm changed, kill the old xref
+8 SET OLDWHEN=$PIECE($GET(^HLMA(IEN773,2)),"^",2)
+9 IF $LENGTH(OLDWHEN)
KILL ^HLMA("AI",OLDWHEN,773,IEN773)
+10 ;
+11 ;set the FAST PURGE DATE
+12 SET $PIECE(^HLMA(IEN773,2),"^",2)=WHEN
+13 ;
+14 ;set the AI x-ref
+15 SET ^HLMA("AI",WHEN,773,IEN773)=""
+16 ;
+17 ;do the same for the corresponding entry in file 772
+18 IF IEN772
IF $DATA(^HL(772,IEN772,0))
Begin DoDot:1
+19 ;if the fast purge dt/tm changed, kill the old xref
+20 SET OLDWHEN=$PIECE($GET(^HL(772,IEN772,2)),"^",2)
+21 IF $LENGTH(OLDWHEN)
KILL ^HLMA("AI",OLDWHEN,772,IEN772)
+22 ;set the FAST PURGE DATE
+23 SET $PIECE(^HL(772,IEN772,2),"^",2)=WHEN
+24 ;
+25 ;set the AI x-ref
+26 SET ^HLMA("AI",WHEN,772,IEN772)=""
End DoDot:1
+27 QUIT
+28 ;
ASKYESNO(PROMPT,DEFAULT) ;
+1 ;Description: Displays PROMPT, appending '?'. Expects a YES NO response
+2 ;Input:
+3 ; PROMPT - text to display as prompt. Appends '?'
+4 ; DEFAULT - (optional) YES or NO. If not passed, defaults to YES
+5 ;Output:
+6 ; Function value: 1 if yes, 0 if no, "" if '^' entered or timeout
+7 ;
+8 NEW DIR,Y
+9 SET DIR(0)="Y"
+10 SET DIR("A")=PROMPT
+11 SET DIR("B")=$SELECT($GET(DEFAULT)="NO":"NO",1:"YES")
+12 DO ^DIR
+13 if $DATA(DIRUT)
QUIT ""
+14 QUIT Y
+15 ;
ASKLINK() ;
+1 NEW DIC,TCP,X,Y,DTOUT,DUOUT
+2 SET DIC=870
+3 SET DIC(0)="AENQ"
+4 SET TCP=$ORDER(^HLCS(869.1,"B","TCP",0))
+5 SET DIC("A")="Select a TCP link:"
+6 SET DIC("S")="I $P(^(0),U,3)=TCP"
+7 DO ^DIC
+8 IF +Y'=-1
IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
QUIT $PIECE(Y,"^")
+9 QUIT ""
+10 ;
ASKEND() ;
+1 ;
+2 NEW %DT
+3 SET %DT="AEST"
+4 SET %DT("A")="Enter the ending date/time: "
+5 SET %DT(0)="-NOW"
+6 if $DATA(DTOUT)
QUIT 0
+7 DO ^%DT
+8 IF Y=-1
QUIT 0
+9 QUIT Y
COUNT(LINKIEN,DIR) ;
+1 NEW MSG,COUNT
+2 IF $GET(DIR)=""
SET DIR="O"
+3 SET (MSG,COUNT)=0
+4 FOR
SET MSG=$ORDER(^HLMA("AC",DIR,LINKIEN,MSG))
if 'MSG
QUIT
SET COUNT=COUNT+1
+5 QUIT COUNT
SHOWTCP ;
+1 NEW Q,H,F,NM,HDR,LINE,QUIT,CRT
+2 SET QUIT=0
+3 SET CRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
+4 WRITE @IOF
+5 SET HDR(1)="Link(ien) Dir/Dev/Auto First Message Count State"
+6 SET HDR(2)="========= ============ =============== ========= =========="
+7 DO LINE(HDR(1))
+8 DO LINE(HDR(2))
+9 FOR Q="I","O"
Begin DoDot:1
+10 SET H=0
+11 FOR
SET H=$ORDER(^HLMA("AC",Q,H))
if 'H
QUIT
if QUIT
QUIT
Begin DoDot:2
+12 NEW NODE0
+13 SET NODE0=$GET(^HLCS(870,H,0))
+14 SET F=$ORDER(^HLMA("AC",Q,H,0))
+15 SET NM=$PIECE(NODE0,"^")
+16 if NM=""
SET NM="ORPHAN"
+17 SET LINE=$$LJ(NM_"("_H_")",14)_" "_$$LJ(Q_"/"_$$LJ($PIECE(NODE0,"^",4),2)_"/"_$SELECT($PIECE(NODE0,"^",6):" ",1:"No"),15)_" "_$$LJ($SELECT($PIECE($GET(^HLMA(F,"P")),"^",1)'=1:"*",1:"")_F,18)_$$RJ($$COUNT(H,Q),10)_" "_$PIECE(
NODE0,"^",5)
+18 DO LINE(LINE)
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
PAUSE ;
+1 ;First scrolls to the bottom of the page, then does a screen pause. Sets QUIT=1 if user decides to quit.
+2 ;
+3 DO PAUSE2
+4 if QUIT
QUIT
+5 WRITE HDR(1),!,HDR(2)
+6 QUIT
PAUSE2 ;
+1 ;Screen pause without scrolling. Sets QUIT=1 if user decides to quit.
+2 ;
+3 NEW DIR,X,Y
+4 SET DIR(0)="E"
+5 DO ^DIR
+6 IF ('(+Y))!$DATA(DIRUT)
SET QUIT=1
+7 QUIT
+8 ;
LINE(LINE) ;Prints a line.
+1 ;
+2 IF CRT
IF ($Y>(IOSL-4))
Begin DoDot:1
+3 DO PAUSE
+4 if QUIT
QUIT
+5 WRITE @IOF
+6 WRITE HDR(1),!,HDR(2),!
+7 WRITE LINE
End DoDot:1
+8 ;
+9 IF '$TEST
IF ('CRT)
IF ($Y>(IOSL-2))
Begin DoDot:1
+10 WRITE @IOF
+11 WRITE HDR(1),!,HDR(2)
+12 WRITE LINE
End DoDot:1
+13 IF '$TEST
WRITE !,LINE
+14 QUIT
+15 ;
LJ(STRING,LEN) ;
+1 QUIT $$LJ^XLFSTR($EXTRACT(STRING,1,LEN),LEN)
RJ(STRING,LEN) ;
+1 QUIT $$RJ^XLFSTR($EXTRACT(STRING,1,LEN),LEN)
ONETCP ;Display one TCP link
+1 NEW IEN,DA,MSG,DIC,DIR,QUIT
+2 SET QUIT=0
+3 SET IEN=$$ASKLINK
+4 if 'IEN
QUIT
+5 if QUIT
QUIT
+6 FOR DIR="I","O"
Begin DoDot:1
+7 SET MSG=$ORDER(^HLMA("AC",DIR,IEN,0))
+8 IF MSG
Begin DoDot:2
+9 WRITE @IOF,!!,"Count of messages on ",$SELECT(DIR="I":"incoming",1:"outgoing")," queue: ",$$COUNT(IEN,DIR)
+10 WRITE !!,"First pending message follows:",!
+11 SET DIC="^HLMA("
+12 SET DA=MSG
+13 DO EN^DIQ
+14 DO PAUSE2
End DoDot:2
End DoDot:1
if QUIT
QUIT
+15 if QUIT
QUIT
+16 WRITE @IOF,!!,"Here is the TCP link:",!
+17 SET DIC="^HLCS(870,"
+18 SET DA=IEN
+19 DO EN^DIQ
+20 QUIT
