Index: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOUSR1.m
===================================================================
--- WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOUSR1.m	(revision 613)
+++ WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOUSR1.m	(revision 623)
@@ -1,266 +1,264 @@
-HLOUSR1	;ALB/CJM -ListManager Screen for viewing messages;12 JUN 1997 10:00 am ;07/25/2007
-	;;1.6;HEALTH LEVEL SEVEN;**126,134,137**;Oct 13, 1995;Build 21
-	;Per VHA Directive 2004-038, this routine should not be modified.
-	;
-EN	;
-	N MSGIEN
-	S MSGIEN=$$PICKMSG
-	I 'MSGIEN S VALMBCK="R" Q
-	D EN^VALM("HLO SINGLE MESSAGE DISPLAY")
-	Q
-	;
-HDR	;
-	Q
-	;
-BLANK	;
-	S VALMCNT=0
-	D EXIT
-	Q
-DISPLAY	;
-	K @VALMAR
-	S VALMBCK="R"
-	N MSG
-	S VALMBG=1
-	Q:'MSGIEN
-	D SHOWMSG($P(MSGIEN,"^"),$P(MSGIEN,"^",2))
-	Q
-	;
-PICKMSG()	;
-	;ask the user to select a message & return its ien
-	N MSGIEN,DIR,COUNT,LIST
-	D FULL^VALM1
-	S DIR(0)="F3:30"
-	S DIR("A")="Message ID"
-	S DIR("?")="Enter the full Message Control ID or Batch Control ID of the message, or '^' to exit."
-PICK	D ^DIR
-	I $D(DIRUT)!(Y="") Q 0
-	I $G(@VALMAR@("INDEX",Y)) Q $G(@VALMAR@("INDEX",Y))
-	S COUNT=$$FINDMSG^HLOMSG1(Y,.LIST)
-	I COUNT="0" W !!,"That message can not be found! Try Again",! G PICK
-	I COUNT=1 Q LIST(1)
-	I COUNT>1 D
-	.N ITEM
-	.W !,"There is more than one message with that ID! You must choose one to display.",1
-	.S ITEM=0
-	.F  S ITEM=$O(LIST(ITEM)) Q:'ITEM  D
-	..N MSG
-	..Q:'$$GETMSG^HLOMSG(+LIST(ITEM),.MSG)
-	..W !,"[",ITEM,"]","  DT/TM: ",$$FMTE^XLFDT(MSG("DT/TM CREATED"),2),"   STATUS: ",MSG("STATUS")
-	.S DIR(0)="NO^1:"_COUNT,DIR("A")="Choose",DIR("?")="Choose one message from the list"
-	.D ^DIR
-	.I Y S Y=LIST(Y)
-	Q Y
-	;
-HELP	;Help code
-	S X="?" D DISP^XQORM1 W !!
-	Q
-	;
-EXIT	;Exit code
-	D CLEAN^VALM10
-	D CLEAR^VALM1
-	S VALMBCK="R"
-	;
-	Q
-	;
-EXPND	;Expand code
-	Q
-	;
-CJ(STRING,LEN)	;
-	Q $$CJ^XLFSTR(STRING,LEN)
-LJ(STRING,LEN)	;
-	Q $$LJ^XLFSTR(STRING,LEN)
-SP(LEN,CHAR)	;
-	;return padding - " " is the default pad character
-	N STR
-	S:$G(CHAR)="" CHAR=" "
-	S $P(STR,CHAR,LEN)=CHAR
-	Q STR
-	;
-SHOWMSG(MSGIEN,SUBIEN)	;
-	;Description:
-	;
-	;Input:
-	;Output:
-	;
-	N MSG,I,TEMP,LINE
-	S VALMCNT=0
-	S SUBIEN=+$G(SUBIEN)
-	I '$$GETMSG^HLOMSG(MSGIEN,.MSG) W !,"UNABLE TO DISPLAY THE MESSAGE",!! Q
-	I SUBIEN D GETMSGB^HLOMSG1(.MSG,SUBIEN,.MSG)
-	;
-	S I=0
-	;** administrative information **
-	S @VALMAR@($$I,0)=$$CJ("Administrative Information",80)
-	D CNTRL^VALM10(VALMCNT,26,30,IORVON,IORVOFF)
-	S LINE="MsgID: "_$$LJ(MSG("ID"),18)
-	S LINE=LINE_"Status: "_$$LJ(MSG("STATUS"),5)
-	S:MSG("ACK TO")]"" LINE=LINE_$$LJ(" Ack To:",14)_MSG("ACK TO")
-	S:MSG("ACK BY")]"" LINE=LINE_$$LJ(" Ack'd By:",14)_MSG("ACK BY")
-	S @VALMAR@($$I,0)=LINE
-	I MSG("STATUS","ERROR TEXT")]"" S @VALMAR@($$I,0)="Error: "_"** "_MSG("STATUS","ERROR TEXT")_" **"
-	S @VALMAR@($$I,0)="Dir:   "_$$LJ($S(MSG("DIRECTION")="IN":"INCOMING",1:"OUTGOING"),10)_$$LJ("  Trans Dt/Tm: ",12)_$$FMTE^XLFDT(MSG("DT/TM"),2)_$$LJ("  Purge DT/TM: ",8)_$$FMTE^XLFDT(MSG("STATUS","PURGE"),2)
-	S @VALMAR@($$I,0)="Link:  "_$$LJ(MSG("STATUS","LINK NAME"),29)_"   "_$$LJ("Queue: ",13)_MSG("STATUS","QUEUE")
-	I $L($G(MSG("STATUS","SEQUENCE QUEUE"))) D
-	.S @VALMAR@($$I,0)="Sequence Queue: "_MSG("STATUS","SEQUENCE QUEUE")_"    Moved: "_$S(MSG("STATUS","MOVED TO OUT QUEUE"):"YES",1:"NO")
-	I MSG("STATUS","ACCEPT ACK'D") D
-	.S @VALMAR@($$I,0)="Accept Ack: "_$$LJ(MSG("STATUS","ACCEPT ACK ID"),26)_$$LJ(" DT/TM Ack'd: ",14)_$$FMTE^XLFDT(MSG("STATUS","ACCEPT ACK DT/TM"),2)
-	.S @VALMAR@($$I,0)="   "_MSG("STATUS","ACCEPT ACK MSA")
-	I MSG("DIRECTION")="IN" D
-	.S LINE="App Response Rtn: "
-	.I $L($G(MSG("STATUS","APP ACK RESPONSE"))) S LINE=$$LJ(LINE_MSG("STATUS","APP ACK RESPONSE"),38)_" Executed: "_$S(MSG("STATUS","APP HANDOFF"):"   YES",1:"   NO")
-	.S @VALMAR@($$I,0)=LINE
-	I MSG("DIRECTION")="OUT",(MSG("STATUS","APP ACK'D")!MSG("STATUS","ACCEPT ACK'D")) D
-	.S LINE=""
-	.I MSG("STATUS","ACCEPT ACK'D") D
-	..I MSG("STATUS","ACCEPT ACK RESPONSE")="" S MSG("STATUS","ACCEPT ACK RESPONSE")="n/a"
-	..S LINE="Accept Ack Rtn: "_MSG("STATUS","ACCEPT ACK RESPONSE")
-	.S LINE=$$LJ(LINE,39)
-	.I MSG("STATUS","APP ACK'D") D
-	..I MSG("STATUS","APP ACK RESPONSE")="" S MSG("STATUS","APP ACK RESPONSE")="n/a"
-	..S LINE=LINE_"App Ack Rtn: "_MSG("STATUS","APP ACK RESPONSE")
-	.S @VALMAR@($$I,0)=LINE
-	;
-	;** the message text **
-	S @VALMAR@($$I,0)=""
-	I '$G(SUBIEN) D
-	.S @VALMAR@($$I,0)=$$CJ("Message Text",80)
-	.D CNTRL^VALM10(VALMCNT,33,16,IORVON,IORVOFF)
-	E  D
-	.S @VALMAR@($$I,0)=$$CJ("Individual Message Text (Batched)",80)
-	.D CNTRL^VALM10(VALMCNT,23,35,IORVON,IORVOFF)
-	D SHOWBODY(.MSG,$G(SUBIEN))
-	;
-	;** display its application acknowledgment **
-	I MSG("ACK BY")]"",$$FINDMSG^HLOMSG1(MSG("ACK BY"),.TEMP)=1 S MSGIEN=TEMP(1) D
-	.N MSG
-	.Q:'$$GETMSG^HLOMSG(+MSGIEN,.MSG)
-	.I $P(MSGIEN,"^",2) D GETMSGB^HLOMSG1(.MSG,$P(MSGIEN,"^",2),.MSG)
-	.S @VALMAR@($$I,0)=""
-	.S @VALMAR@($$I,0)=$$CJ("Application Acknowledgment",80)
-	.D CNTRL^VALM10(VALMCNT,26,30,IORVON,IORVOFF)
-	.D SHOWBODY(.MSG,$P(MSGIEN,"^",2))
-	;
-	;** display the original message **
-	I MSG("ACK TO")]"",$$FINDMSG^HLOMSG1(MSG("ACK TO"),.TEMP)=1 S MSGIEN=TEMP(1) D
-	.N MSG
-	.Q:'$$GETMSG^HLOMSG(+MSGIEN,.MSG)
-	.I $P(MSGIEN,"^",2) D GETMSGB^HLOMSG1(.MSG,$P(MSGIEN,"^",2),.MSG)
-	.S @VALMAR@($$I,0)=""
-	.S @VALMAR@($$I,0)=$$CJ("Original Message",80)
-	.D CNTRL^VALM10(VALMCNT,26,30,IORVON,IORVOFF)
-	.D SHOWBODY(.MSG,$P(MSGIEN,"^",2))
-	Q
-	;
-SHOWBODY(MSG,SUBIEN)	;
-	N NODE,I,SEG,QUIT
-	S QUIT=0
-	M SEG=MSG("HDR")
-	D ADD(.SEG)
-	S MSG("BATCH","CURRENT MESSAGE")=0
-	I MSG("BATCH") D
-	.I $G(SUBIEN) D  Q
-	..S MSG("BATCH","CURRENT MESSAGE")=SUBIEN
-	..F  Q:'$$HLNEXT^HLOMSG(.MSG,.SEG)  D ADD(.SEG)
-	.S MSG("BATCH","CURRENT MESSAGE")=0
-	.N LAST S LAST=0
-	.F  Q:'$$NEXTMSG^HLOMSG(.MSG,.SEG)  D  Q:QUIT
-	..D ADD(.SEG)
-	..S LAST=MSG("BATCH","CURRENT MESSAGE")
-	..F  Q:'$$HLNEXT^HLOMSG(.MSG,.SEG)  D ADD(.SEG)
-	.I MSG("DIRECTION")="OUT" K SEG S SEG(1)="BTS"_$E($G(NODE(1)),4)_LAST D ADD(.SEG)
-	E  D
-	.F  Q:'$$HLNEXT^HLOMSG(.MSG,.SEG)  D  Q:QUIT
-	..D ADD(.SEG)
-	Q
-I()	;
-	S VALMCNT=VALMCNT+1
-	Q VALMCNT
-ADD(SEG)	;
-	N QUIT,I,J,LINE
-	S QUIT=0
-	S (I,J)=1
-	S LINE(1)=$E(SEG(1),1,80),SEG(1)=$E(SEG(1),81,9999)
-	I SEG(1)="" K SEG(1)
-	D SHIFT(.I,.J)
-	S @VALMAR@($$I,0)=LINE(1)
-	S I=1
-	F  S I=$O(LINE(I)) Q:'I  D
-	.S @VALMAR@($$I,0)=LINE(I)
-	.D CNTRL^VALM10(VALMCNT,1,1,IORVON,IORVOFF)
-	Q
-	;
-SHIFT(I,J)	;
-	I '$D(SEG(I)) S I=$O(SEG(0)) Q:'I
-	I $L(LINE(J))<80 D
-	.N LEN
-	.S LEN=$L(LINE(J))
-	.S LINE(J)=LINE(J)_$E(SEG(I),1,80-LEN)
-	.S SEG(I)=$E(SEG(I),81-LEN,9999)
-	.I SEG(I)="" K SEG(I)
-	E  D
-	.S J=J+1
-	.S LINE(J)="-"
-	D SHIFT(.I,.J)
-	Q
-	;
-SCRLMODE	;scroll mode
-	Q:'$L(HLRFRSH)
-	N QUIT,IOTM,IOBM,DX,DY,LINE,IOTM,IOBM
-	W !!,IOINHI,"Hit any key to escape scroll mode...",IOINORM
-	S IOTM=3,IOBM=23
-	S QUIT=0
-	S LINE=$S(VALMCNT<17:1,1:17)
-	W @IOSTBM
-	S DX=1,DY=$S(VALMCNT<17:VALMCNT+1,1:17) X IOXY
-	F I=1:1 D  Q:QUIT
-	.;every 10 seconds refresh the data
-	.I I>42 D @HLRFRSH S I=0
-	.I LINE+1>VALMCNT D
-	..S TEMP=$G(@VALMAR@(LINE,0))
-	..W !,IOUON,TEMP_$$SP(80-$L(TEMP)),IOUOFF
-	.E  W !,$G(@VALMAR@(LINE,0))
-	.S LINE=LINE+1
-	.I LINE>VALMCNT S LINE=1
-	.I (I=22)!(I=43) R *C:5 I $T S QUIT=1 Q
-	S VALMBG=LINE-23 I VALMBG<0 S VALMBG=1
-	S VALMBCK="R"
-	Q
-HLP	;
-	Q
-	;
-IFOPEN(LINK)	;
-	;returns 1 if the link can be opened, otherwise 0
-	;
-	;Inputs:
-	;  LINK - name of the link (required), optionally post-fixed with ":"_<port #>, will default to that defined for link
-	;
-	N LINKNAME,LINKARY,POP,IO,IOF,IOST,OPEN,PORT
-	S OPEN=0
-	S LINKNAME=$P(LINK,":")
-	S PORT=$P(LINK,":",2)
-	Q:LINKNAME="" 0
-	Q:'$$GETLINK^HLOTLNK(LINKNAME,.LINKARY) 0
-	S:PORT LINKARY("PORT")=PORT
-	Q:'$G(LINKARY("PORT")) 0
-	I LINKARY("IP")="",LINKARY("DOMAIN")="",LINKARY("LLP")="TCP",LINKARY("SERVER") D
-	.N DATA
-	.S LINKARY("DOMAIN")=$P($G(^HLD(779.1,1,0)),"^")
-	.Q:LINKARY("DOMAIN")=""
-	.S DATA(.08)=LINKARY("DOMAIN")
-	.Q:$$UPD^HLOASUB1(870,LINKARY("IEN"),.DATA)
-	D:$G(LINKARY("IP"))'=""
-	.D CALL^%ZISTCP(LINKARY("IP"),LINKARY("PORT"),15)
-	.S OPEN='POP
-	I 'OPEN,LINKARY("DOMAIN")'="",$G(^HLTMP("DNS LAST",LINKARY("IEN")))<$$DT^XLFDT D
-	.N IP
-	.S ^HLTMP("DNS LAST",LINKARY("IEN"))=$$DT^XLFDT
-	.S IP=$$DNS^HLOTCP(LINKARY("DOMAIN"))
-	.I IP'="",IP'=LINKARY("IP") D
-	..N DATA
-	..S DATA(400.01)=IP,LINKARY("IP")=IP
-	..Q:$$UPD^HLOASUB1(870,LINKARY("IEN"),.DATA)
-	..D CALL^%ZISTCP(LINKARY("IP"),LINKARY("PORT"),15)
-	..S OPEN='POP
-	C:OPEN IO
-	;D CLOSE^%ZISTCP
-	Q OPEN
+HLOUSR1 ;ALB/CJM -ListManager Screen for viewing messages;12 JUN 1997 10:00 am ;03/19/2007
+ ;;1.6;HEALTH LEVEL SEVEN;**126,134**;Oct 13, 1995;Build 30
+ ;Per VHA Directive 2004-038, this routine should not be modified.
+ ;
+EN ;
+ N MSGIEN
+ S MSGIEN=$$PICKMSG
+ I 'MSGIEN S VALMBCK="R" Q
+ D EN^VALM("HLO SINGLE MESSAGE DISPLAY")
+ Q
+ ;
+HDR ;
+ Q
+ ;
+BLANK ;
+ S VALMCNT=0
+ D EXIT
+ Q
+DISPLAY ;
+ K @VALMAR
+ S VALMBCK="R"
+ N MSG
+ S VALMBG=1
+ Q:'MSGIEN
+ D SHOWMSG($P(MSGIEN,"^"),$P(MSGIEN,"^",2))
+ Q
+ ;
+PICKMSG() ;
+ ;ask the user to select a message & return its ien
+ N MSGIEN,DIR,COUNT,LIST
+ D FULL^VALM1
+ S DIR(0)="F3:30"
+ S DIR("A")="Message ID"
+ S DIR("?")="Enter the full Message Control ID or Batch Control ID of the message, or '^' to exit."
+PICK D ^DIR
+ I $D(DIRUT)!(Y="") Q 0
+ I $G(@VALMAR@("INDEX",Y)) Q $G(@VALMAR@("INDEX",Y))
+ S COUNT=$$FINDMSG^HLOMSG1(Y,.LIST)
+ I COUNT="0" W !!,"That message can not be found! Try Again",! G PICK
+ I COUNT=1 Q LIST(1)
+ I COUNT>1 D
+ .N ITEM
+ .W !,"There is more than one message with that ID! You must choose one to display.",1
+ .S ITEM=0
+ .F  S ITEM=$O(LIST(ITEM)) Q:'ITEM  D
+ ..N MSG
+ ..Q:'$$GETMSG^HLOMSG(+LIST(ITEM),.MSG)
+ ..W !,"[",ITEM,"]","  DT/TM: ",$$FMTE^XLFDT(MSG("DT/TM CREATED"),2),"   STATUS: ",MSG("STATUS")
+ .S DIR(0)="NO^1:"_COUNT,DIR("A")="Choose",DIR("?")="Choose one message from the list"
+ .D ^DIR
+ .I Y S Y=LIST(Y)
+ Q Y
+ ;
+HELP ;Help code
+ S X="?" D DISP^XQORM1 W !!
+ Q
+ ;
+EXIT ;Exit code
+ D CLEAN^VALM10
+ D CLEAR^VALM1
+ S VALMBCK="R"
+ ;
+ Q
+ ;
+EXPND ;Expand code
+ Q
+ ;
+CJ(STRING,LEN) ;
+ Q $$CJ^XLFSTR(STRING,LEN)
+LJ(STRING,LEN) ;
+ Q $$LJ^XLFSTR(STRING,LEN)
+SP(LEN,CHAR) ;
+ ;return padding - " " is the default pad character
+ N STR
+ S:$G(CHAR)="" CHAR=" "
+ S $P(STR,CHAR,LEN)=CHAR
+ Q STR
+ ;
+SHOWMSG(MSGIEN,SUBIEN) ;
+ ;Description:
+ ;
+ ;Input:
+ ;Output:
+ ;
+ N MSG,I,TEMP,LINE
+ S VALMCNT=0
+ S SUBIEN=+$G(SUBIEN)
+ I '$$GETMSG^HLOMSG(MSGIEN,.MSG) W !,"UNABLE TO DISPLAY THE MESSAGE",!! Q
+ I SUBIEN D GETMSGB^HLOMSG1(.MSG,SUBIEN,.MSG)
+ ;
+ S I=0
+ ;** administrative information **
+ S @VALMAR@($$I,0)=$$CJ("Administrative Information",80)
+ D CNTRL^VALM10(VALMCNT,26,30,IORVON,IORVOFF)
+ S LINE="MsgID: "_$$LJ(MSG("ID"),18)
+ S LINE=LINE_"Status: "_$$LJ(MSG("STATUS"),5)
+ S:MSG("ACK TO")]"" LINE=LINE_$$LJ(" Ack To:",14)_MSG("ACK TO")
+ S:MSG("ACK BY")]"" LINE=LINE_$$LJ(" Ack'd By:",14)_MSG("ACK BY")
+ S @VALMAR@($$I,0)=LINE
+ I MSG("STATUS","ERROR TEXT")]"" S @VALMAR@($$I,0)="Error: "_"** "_MSG("STATUS","ERROR TEXT")_" **"
+ S @VALMAR@($$I,0)="Dir:   "_$$LJ($S(MSG("DIRECTION")="IN":"INCOMING",1:"OUTGOING"),10)_$$LJ("  Trans Dt/Tm: ",12)_$$FMTE^XLFDT(MSG("DT/TM"),2)_$$LJ("  Purge DT/TM: ",8)_$$FMTE^XLFDT(MSG("STATUS","PURGE"),2)
+ S @VALMAR@($$I,0)="Link:  "_$$LJ(MSG("STATUS","LINK NAME"),29)_"   "_$$LJ("Queue: ",13)_MSG("STATUS","QUEUE")
+ I MSG("STATUS","ACCEPT ACK'D") D
+ .S @VALMAR@($$I,0)="Accept Ack: "_$$LJ(MSG("STATUS","ACCEPT ACK ID"),26)_$$LJ(" At: ",14)_$$FMTE^XLFDT(MSG("STATUS","ACCEPT ACK DT/TM"),2)
+ .S @VALMAR@($$I,0)="   "_MSG("STATUS","ACCEPT ACK MSA")
+ I MSG("DIRECTION")="IN" D
+ .S LINE="App Response Rtn: "
+ .I $L($G(MSG("STATUS","APP ACK RESPONSE"))) S LINE=$$LJ(LINE_MSG("STATUS","APP ACK RESPONSE"),38)_" Executed: "_$S(MSG("STATUS","APP HANDOFF"):"   YES",1:"   NO")
+ .S @VALMAR@($$I,0)=LINE
+ I MSG("DIRECTION")="OUT",(MSG("STATUS","APP ACK'D")!MSG("STATUS","ACCEPT ACK'D")) D
+ .S LINE=""
+ .I MSG("STATUS","ACCEPT ACK'D") D
+ ..I MSG("STATUS","ACCEPT ACK RESPONSE")="" S MSG("STATUS","ACCEPT ACK RESPONSE")="n/a"
+ ..S LINE="Accept Ack Rtn: "_MSG("STATUS","ACCEPT ACK RESPONSE")
+ .S LINE=$$LJ(LINE,39)
+ .I MSG("STATUS","APP ACK'D") D
+ ..I MSG("STATUS","APP ACK RESPONSE")="" S MSG("STATUS","APP ACK RESPONSE")="n/a"
+ ..S LINE=LINE_"App Ack Rtn: "_MSG("STATUS","APP ACK RESPONSE")
+ .S @VALMAR@($$I,0)=LINE
+ ;
+ ;** the message text **
+ S @VALMAR@($$I,0)=""
+ I '$G(SUBIEN) D
+ .S @VALMAR@($$I,0)=$$CJ("Message Text",80)
+ .D CNTRL^VALM10(VALMCNT,33,16,IORVON,IORVOFF)
+ E  D
+ .S @VALMAR@($$I,0)=$$CJ("Individual Message Text (Batched)",80)
+ .D CNTRL^VALM10(VALMCNT,23,35,IORVON,IORVOFF)
+ D SHOWBODY(.MSG,$G(SUBIEN))
+ ;
+ ;** display its application acknowledgment **
+ I MSG("ACK BY")]"",$$FINDMSG^HLOMSG1(MSG("ACK BY"),.TEMP)=1 S MSGIEN=TEMP(1) D
+ .N MSG
+ .Q:'$$GETMSG^HLOMSG(+MSGIEN,.MSG)
+ .I $P(MSGIEN,"^",2) D GETMSGB^HLOMSG1(.MSG,$P(MSGIEN,"^",2),.MSG)
+ .S @VALMAR@($$I,0)=""
+ .S @VALMAR@($$I,0)=$$CJ("Application Acknowledgment",80)
+ .D CNTRL^VALM10(VALMCNT,26,30,IORVON,IORVOFF)
+ .D SHOWBODY(.MSG,$P(MSGIEN,"^",2))
+ ;
+ ;** display the original message **
+ I MSG("ACK TO")]"",$$FINDMSG^HLOMSG1(MSG("ACK TO"),.TEMP)=1 S MSGIEN=TEMP(1) D
+ .N MSG
+ .Q:'$$GETMSG^HLOMSG(+MSGIEN,.MSG)
+ .I $P(MSGIEN,"^",2) D GETMSGB^HLOMSG1(.MSG,$P(MSGIEN,"^",2),.MSG)
+ .S @VALMAR@($$I,0)=""
+ .S @VALMAR@($$I,0)=$$CJ("Original Message",80)
+ .D CNTRL^VALM10(VALMCNT,26,30,IORVON,IORVOFF)
+ .D SHOWBODY(.MSG,$P(MSGIEN,"^",2))
+ Q
+ ;
+SHOWBODY(MSG,SUBIEN) ;
+ N NODE,I,SEG,QUIT
+ S QUIT=0
+ M SEG=MSG("HDR")
+ D ADD(.SEG)
+ S MSG("BATCH","CURRENT MESSAGE")=0
+ I MSG("BATCH") D
+ .I $G(SUBIEN) D  Q
+ ..S MSG("BATCH","CURRENT MESSAGE")=SUBIEN
+ ..F  Q:'$$HLNEXT^HLOMSG(.MSG,.SEG)  D ADD(.SEG)
+ .S MSG("BATCH","CURRENT MESSAGE")=0
+ .N LAST S LAST=0
+ .F  Q:'$$NEXTMSG^HLOMSG(.MSG,.SEG)  D  Q:QUIT
+ ..D ADD(.SEG)
+ ..S LAST=MSG("BATCH","CURRENT MESSAGE")
+ ..F  Q:'$$HLNEXT^HLOMSG(.MSG,.SEG)  D ADD(.SEG)
+ .I MSG("DIRECTION")="OUT" K SEG S SEG(1)="BTS"_$E($G(NODE(1)),4)_LAST D ADD(.SEG)
+ E  D
+ .F  Q:'$$HLNEXT^HLOMSG(.MSG,.SEG)  D  Q:QUIT
+ ..D ADD(.SEG)
+ Q
+I() ;
+ S VALMCNT=VALMCNT+1
+ Q VALMCNT
+ADD(SEG) ;
+ N QUIT,I,J,LINE
+ S QUIT=0
+ S (I,J)=1
+ S LINE(1)=$E(SEG(1),1,80),SEG(1)=$E(SEG(1),81,9999)
+ I SEG(1)="" K SEG(1)
+ D SHIFT(.I,.J)
+ S @VALMAR@($$I,0)=LINE(1)
+ S I=1
+ F  S I=$O(LINE(I)) Q:'I  D
+ .S @VALMAR@($$I,0)=LINE(I)
+ .D CNTRL^VALM10(VALMCNT,1,1,IORVON,IORVOFF)
+ Q
+ ;
+SHIFT(I,J) ;
+ I '$D(SEG(I)) S I=$O(SEG(0)) Q:'I
+ I $L(LINE(J))<80 D
+ .N LEN
+ .S LEN=$L(LINE(J))
+ .S LINE(J)=LINE(J)_$E(SEG(I),1,80-LEN)
+ .S SEG(I)=$E(SEG(I),81-LEN,9999)
+ .I SEG(I)="" K SEG(I)
+ E  D
+ .S J=J+1
+ .S LINE(J)="-"
+ D SHIFT(.I,.J)
+ Q
+ ;
+SCRLMODE ;scroll mode
+ Q:'$L(HLRFRSH)
+ N QUIT,IOTM,IOBM,DX,DY,LINE,IOTM,IOBM
+ W !!,IOINHI,"Hit any key to escape scroll mode...",IOINORM
+ S IOTM=3,IOBM=23
+ S QUIT=0
+ S LINE=$S(VALMCNT<17:1,1:17)
+ W @IOSTBM
+ S DX=1,DY=$S(VALMCNT<17:VALMCNT+1,1:17) X IOXY
+ F I=1:1 D  Q:QUIT
+ .;every 10 seconds refresh the data
+ .I I>42 D @HLRFRSH S I=0
+ .I LINE+1>VALMCNT D
+ ..S TEMP=$G(@VALMAR@(LINE,0))
+ ..W !,IOUON,TEMP_$$SP(80-$L(TEMP)),IOUOFF
+ .E  W !,$G(@VALMAR@(LINE,0))
+ .S LINE=LINE+1
+ .I LINE>VALMCNT S LINE=1
+ .I (I=22)!(I=43) R *C:5 I $T S QUIT=1 Q
+ S VALMBG=LINE-23 I VALMBG<0 S VALMBG=1
+ S VALMBCK="R"
+ Q
+HLP ;
+ Q
+ ;
+IFOPEN(LINK) ;
+ ;returns 1 if the link can be opened, otherwise 0
+ ;
+ ;Inputs:
+ ;  LINK - name of the link (required), optionally post-fixed with ":"_<port #>, will default to that defined for link
+ ;
+ N LINKNAME,LINKARY,POP,IO,IOF,IOST,OPEN,PORT
+ S OPEN=0
+ S LINKNAME=$P(LINK,":")
+ S PORT=$P(LINK,":",2)
+ Q:LINKNAME="" 0
+ Q:'$$GETLINK^HLOTLNK(LINKNAME,.LINKARY) 0
+ S:PORT LINKARY("PORT")=PORT
+ Q:'$G(LINKARY("PORT")) 0
+ I LINKARY("IP")="",LINKARY("DOMAIN")="",LINKARY("LLP")="TCP",LINKARY("SERVER") D
+ .N DATA
+ .S LINKARY("DOMAIN")=$P($G(^HLD(779.1,1,0)),"^")
+ .Q:LINKARY("DOMAIN")=""
+ .S DATA(.08)=LINKARY("DOMAIN")
+ .Q:$$UPD^HLOASUB1(870,LINKARY("IEN"),.DATA)
+ D:$G(LINKARY("IP"))'=""
+ .D CALL^%ZISTCP(LINKARY("IP"),LINKARY("PORT"),15)
+ .S OPEN='POP
+ I 'OPEN,LINKARY("DOMAIN")'="",$G(^HLTMP("DNS LAST",LINKARY("IEN")))<$$DT^XLFDT D
+ .N IP
+ .S ^HLTMP("DNS LAST",LINKARY("IEN"))=$$DT^XLFDT
+ .S IP=$$DNS^HLOTCP(LINKARY("DOMAIN"))
+ .I IP'="",IP'=LINKARY("IP") D
+ ..N DATA
+ ..S DATA(400.01)=IP,LINKARY("IP")=IP
+ ..Q:$$UPD^HLOASUB1(870,LINKARY("IEN"),.DATA)
+ ..D CALL^%ZISTCP(LINKARY("IP"),LINKARY("PORT"),15)
+ ..S OPEN='POP
+ C:OPEN IO
+ ;D CLOSE^%ZISTCP
+ Q OPEN
