HLOUSR1 ;ALB/CJM -ListManager Screen for viewing messages;12 JUN 1997 10:00 am ;03/14/2005 08:08
;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
;
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"),30)_$$LJ(" Trans Dt/Tm: ",12)_$$FMTE^XLFDT(MSG("DT/TM"),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
.N ACTION,HDR
.S LINE="App Response Rtn: "
.M HDR=MSG("HDR")
.I $$PARSEHDR^HLOPRS(.HDR),$$ACTION^HLOAPP(.HDR,.ACTION) S LINE=$$LJ(LINE_ACTION,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))
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/14/2005 08:08
+1 ;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
+2 ;
EN ;
+1 NEW MSGIEN
+2 SET MSGIEN=$$PICKMSG
+3 IF 'MSGIEN
SET VALMBCK="R"
QUIT
+4 DO EN^VALM("HLO SINGLE MESSAGE DISPLAY")
+5 QUIT
+6 ;
HDR ;
+1 QUIT
+2 ;
BLANK ;
+1 SET VALMCNT=0
+2 DO EXIT
+3 QUIT
DISPLAY ;
+1 KILL @VALMAR
+2 SET VALMBCK="R"
+3 NEW MSG
+4 SET VALMBG=1
+5 IF 'MSGIEN
QUIT
+6 DO SHOWMSG($PIECE(MSGIEN,"^"),$PIECE(MSGIEN,"^",2))
+7 QUIT
+8 ;
PICKMSG() ;
+1 ;ask the user to select a message & return its ien
+2 NEW MSGIEN,DIR,COUNT,LIST
+3 DO FULL^VALM1
+4 SET DIR(0)="F3:30"
+5 SET DIR("A")="Message ID"
+6 SET DIR("?")="Enter the full Message Control ID or Batch Control ID of the message, or '^' to exit."
PICK DO ^DIR
+1 IF $DATA(DIRUT)!(Y="")
QUIT 0
+2 IF $GET(@VALMAR@("INDEX",Y))
QUIT $GET(@VALMAR@("INDEX",Y))
+3 SET COUNT=$$FINDMSG^HLOMSG1(Y,.LIST)
+4 IF COUNT="0"
WRITE !!,"That message can not be found! Try Again",!
GOTO PICK
+5 IF COUNT=1
QUIT LIST(1)
+6 IF COUNT>1
Begin DoDot:1
+7 NEW ITEM
+8 WRITE !,"There is more than one message with that ID! You must choose one to display.",1
+9 SET ITEM=0
+10 FOR
SET ITEM=$ORDER(LIST(ITEM))
IF 'ITEM
QUIT
Begin DoDot:2
+11 NEW MSG
+12 IF '$$GETMSG^HLOMSG(+LIST(ITEM),.MSG)
QUIT
+13 WRITE !,"[",ITEM,"]"," DT/TM: ",$$FMTE^XLFDT(MSG("DT/TM CREATED"),2)," STATUS: ",MSG("STATUS")
End DoDot:2
+14 SET DIR(0)="NO^1:"_COUNT
SET DIR("A")="Choose"
SET DIR("?")="Choose one message from the list"
+15 DO ^DIR
+16 IF Y
SET Y=LIST(Y)
End DoDot:1
+17 QUIT Y
+18 ;
HELP ;Help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ;Exit code
+1 DO CLEAN^VALM10
+2 DO CLEAR^VALM1
+3 SET VALMBCK="R"
+4 ;
+5 QUIT
+6 ;
EXPND ;Expand code
+1 QUIT
+2 ;
CJ(STRING,LEN) ;
+1 QUIT $$CJ^XLFSTR(STRING,LEN)
LJ(STRING,LEN) ;
+1 QUIT $$LJ^XLFSTR(STRING,LEN)
SP(LEN,CHAR) ;
+1 ;return padding - " " is the default pad character
+2 NEW STR
+3 IF $GET(CHAR)=""
SET CHAR=" "
+4 SET $PIECE(STR,CHAR,LEN)=CHAR
+5 QUIT STR
+6 ;
SHOWMSG(MSGIEN,SUBIEN) ;
+1 ;Description:
+2 ;
+3 ;Input:
+4 ;Output:
+5 ;
+6 NEW MSG,I,TEMP,LINE
+7 SET VALMCNT=0
+8 SET SUBIEN=+$GET(SUBIEN)
+9 IF '$$GETMSG^HLOMSG(MSGIEN,.MSG)
WRITE !,"UNABLE TO DISPLAY THE MESSAGE",!!
QUIT
+10 IF SUBIEN
DO GETMSGB^HLOMSG1(.MSG,SUBIEN,.MSG)
+11 ;
+12 SET I=0
+13 ;** administrative information **
+14 SET @VALMAR@($$I,0)=$$CJ("Administrative Information",80)
+15 DO CNTRL^VALM10(VALMCNT,26,30,IORVON,IORVOFF)
+16 SET LINE="MsgID: "_$$LJ(MSG("ID"),18)
+17 SET LINE=LINE_"Status: "_$$LJ(MSG("STATUS"),5)
+18 IF MSG("ACK TO")]""
SET LINE=LINE_$$LJ(" Ack To:",14)_MSG("ACK TO")
+19 IF MSG("ACK BY")]""
SET LINE=LINE_$$LJ(" Ack'd By:",14)_MSG("ACK BY")
+20 SET @VALMAR@($$I,0)=LINE
+21 IF MSG("STATUS","ERROR TEXT")]""
SET @VALMAR@($$I,0)="Error: "_"** "_MSG("STATUS","ERROR TEXT")_" **"
+22 SET @VALMAR@($$I,0)="Dir: "_$$LJ($SELECT(MSG("DIRECTION")="IN":"INCOMING",1:"OUTGOING"),30)_$$LJ(" Trans Dt/Tm: ",12)_$$FMTE^XLFDT(MSG("DT/TM"),2)
+23 SET @VALMAR@($$I,0)="Link: "_$$LJ(MSG("STATUS","LINK NAME"),29)_" "_$$LJ("Queue: ",13)_MSG("STATUS","QUEUE")
+24 IF MSG("STATUS","ACCEPT ACK'D")
Begin DoDot:1
+25 SET @VALMAR@($$I,0)="Accept Ack: "_$$LJ(MSG("STATUS","ACCEPT ACK ID"),26)_$$LJ(" At: ",14)_$$FMTE^XLFDT(MSG("STATUS","ACCEPT ACK DT/TM"),2)
+26 SET @VALMAR@($$I,0)=" "_MSG("STATUS","ACCEPT ACK MSA")
End DoDot:1
+27 IF MSG("DIRECTION")="IN"
Begin DoDot:1
+28 NEW ACTION,HDR
+29 SET LINE="App Response Rtn: "
+30 MERGE HDR=MSG("HDR")
+31 IF $$PARSEHDR^HLOPRS(.HDR)
IF $$ACTION^HLOAPP(.HDR,.ACTION)
SET LINE=$$LJ(LINE_ACTION,38)_" Executed: "_$SELECT(MSG("STATUS","APP HANDOFF"):" YES",1:" NO")
+32 SET @VALMAR@($$I,0)=LINE
End DoDot:1
+33 IF MSG("DIRECTION")="OUT"
IF (MSG("STATUS","APP ACK'D")!MSG("STATUS","ACCEPT ACK'D"))
Begin DoDot:1
+34 SET LINE=""
+35 IF MSG("STATUS","ACCEPT ACK'D")
Begin DoDot:2
+36 IF MSG("STATUS","ACCEPT ACK RESPONSE")=""
SET MSG("STATUS","ACCEPT ACK RESPONSE")="n/a"
+37 SET LINE="Accept Ack Rtn: "_MSG("STATUS","ACCEPT ACK RESPONSE")
End DoDot:2
+38 SET LINE=$$LJ(LINE,39)
+39 IF MSG("STATUS","APP ACK'D")
Begin DoDot:2
+40 IF MSG("STATUS","APP ACK RESPONSE")=""
SET MSG("STATUS","APP ACK RESPONSE")="n/a"
+41 SET LINE=LINE_"App Ack Rtn: "_MSG("STATUS","APP ACK RESPONSE")
End DoDot:2
+42 SET @VALMAR@($$I,0)=LINE
End DoDot:1
+43 ;
+44 ;** the message text **
+45 SET @VALMAR@($$I,0)=""
+46 IF '$GET(SUBIEN)
Begin DoDot:1
+47 SET @VALMAR@($$I,0)=$$CJ("Message Text",80)
+48 DO CNTRL^VALM10(VALMCNT,33,16,IORVON,IORVOFF)
End DoDot:1
+49 IF '$TEST
Begin DoDot:1
+50 SET @VALMAR@($$I,0)=$$CJ("Individual Message Text (Batched)",80)
+51 DO CNTRL^VALM10(VALMCNT,23,35,IORVON,IORVOFF)
End DoDot:1
+52 DO SHOWBODY(.MSG,$GET(SUBIEN))
+53 ;
+54 ;** display its application acknowledgment **
+55 IF MSG("ACK BY")]""
IF $$FINDMSG^HLOMSG1(MSG("ACK BY"),.TEMP)=1
SET MSGIEN=TEMP(1)
Begin DoDot:1
+56 NEW MSG
+57 IF '$$GETMSG^HLOMSG(+MSGIEN,.MSG)
QUIT
+58 IF $PIECE(MSGIEN,"^",2)
DO GETMSGB^HLOMSG1(.MSG,$PIECE(MSGIEN,"^",2),.MSG)
+59 SET @VALMAR@($$I,0)=""
+60 SET @VALMAR@($$I,0)=$$CJ("Application Acknowledgment",80)
+61 DO CNTRL^VALM10(VALMCNT,26,30,IORVON,IORVOFF)
+62 DO SHOWBODY(.MSG,$PIECE(MSGIEN,"^",2))
End DoDot:1
+63 QUIT
+64 ;
SHOWBODY(MSG,SUBIEN) ;
+1 NEW NODE,I,SEG,QUIT
+2 SET QUIT=0
+3 MERGE SEG=MSG("HDR")
+4 DO ADD(.SEG)
+5 SET MSG("BATCH","CURRENT MESSAGE")=0
+6 IF MSG("BATCH")
Begin DoDot:1
+7 IF $GET(SUBIEN)
Begin DoDot:2
+8 SET MSG("BATCH","CURRENT MESSAGE")=SUBIEN
+9 FOR
IF '$$HLNEXT^HLOMSG(.MSG,.SEG)
QUIT
DO ADD(.SEG)
End DoDot:2
QUIT
+10 SET MSG("BATCH","CURRENT MESSAGE")=0
+11 NEW LAST
SET LAST=0
+12 FOR
IF '$$NEXTMSG^HLOMSG(.MSG,.SEG)
QUIT
Begin DoDot:2
+13 DO ADD(.SEG)
+14 SET LAST=MSG("BATCH","CURRENT MESSAGE")
+15 FOR
IF '$$HLNEXT^HLOMSG(.MSG,.SEG)
QUIT
DO ADD(.SEG)
End DoDot:2
IF QUIT
QUIT
+16 IF MSG("DIRECTION")="OUT"
KILL SEG
SET SEG(1)="BTS"_$EXTRACT($GET(NODE(1)),4)_LAST
DO ADD(.SEG)
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 FOR
IF '$$HLNEXT^HLOMSG(.MSG,.SEG)
QUIT
Begin DoDot:2
+19 DO ADD(.SEG)
End DoDot:2
IF QUIT
QUIT
End DoDot:1
+20 QUIT
I() ;
+1 SET VALMCNT=VALMCNT+1
+2 QUIT VALMCNT
ADD(SEG) ;
+1 NEW QUIT,I,J,LINE
+2 SET QUIT=0
+3 SET (I,J)=1
+4 SET LINE(1)=$EXTRACT(SEG(1),1,80)
SET SEG(1)=$EXTRACT(SEG(1),81,9999)
+5 IF SEG(1)=""
KILL SEG(1)
+6 DO SHIFT(.I,.J)
+7 SET @VALMAR@($$I,0)=LINE(1)
+8 SET I=1
+9 FOR
SET I=$ORDER(LINE(I))
IF 'I
QUIT
Begin DoDot:1
+10 SET @VALMAR@($$I,0)=LINE(I)
+11 DO CNTRL^VALM10(VALMCNT,1,1,IORVON,IORVOFF)
End DoDot:1
+12 QUIT
+13 ;
SHIFT(I,J) ;
+1 IF '$DATA(SEG(I))
SET I=$ORDER(SEG(0))
IF 'I
QUIT
+2 IF $LENGTH(LINE(J))<80
Begin DoDot:1
+3 NEW LEN
+4 SET LEN=$LENGTH(LINE(J))
+5 SET LINE(J)=LINE(J)_$EXTRACT(SEG(I),1,80-LEN)
+6 SET SEG(I)=$EXTRACT(SEG(I),81-LEN,9999)
+7 IF SEG(I)=""
KILL SEG(I)
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 SET J=J+1
+10 SET LINE(J)="-"
End DoDot:1
+11 DO SHIFT(.I,.J)
+12 QUIT
+13 ;
SCRLMODE ;scroll mode
+1 IF '$LENGTH(HLRFRSH)
QUIT
+2 NEW QUIT,IOTM,IOBM,DX,DY,LINE,IOTM,IOBM
+3 WRITE !!,IOINHI,"Hit any key to escape scroll mode...",IOINORM
+4 SET IOTM=3
SET IOBM=23
+5 SET QUIT=0
+6 SET LINE=$SELECT(VALMCNT<17:1,1:17)
+7 WRITE @IOSTBM
+8 SET DX=1
SET DY=$SELECT(VALMCNT<17:VALMCNT+1,1:17)
XECUTE IOXY
+9 FOR I=1:1
Begin DoDot:1
+10 ;every 10 seconds refresh the data
+11 IF I>42
DO @HLRFRSH
SET I=0
+12 IF LINE+1>VALMCNT
Begin DoDot:2
+13 SET TEMP=$GET(@VALMAR@(LINE,0))
+14 WRITE !,IOUON,TEMP_$$SP(80-$LENGTH(TEMP)),IOUOFF
End DoDot:2
+15 IF '$TEST
WRITE !,$GET(@VALMAR@(LINE,0))
+16 SET LINE=LINE+1
+17 IF LINE>VALMCNT
SET LINE=1
+18 IF (I=22)!(I=43)
READ *C:5
IF $TEST
SET QUIT=1
QUIT
End DoDot:1
IF QUIT
QUIT
+19 SET VALMBG=LINE-23
IF VALMBG<0
SET VALMBG=1
+20 SET VALMBCK="R"
+21 QUIT
HLP ;
+1 QUIT
+2 ;
IFOPEN(LINK) ;
+1 ;returns 1 if the link can be opened, otherwise 0
+2 ;
+3 ;Inputs:
+4 ; LINK - name of the link (required), optionally post-fixed with ":"_<port #>, will default to that defined for link
+5 ;
+6 NEW LINKNAME,LINKARY,POP,IO,IOF,IOST,OPEN,PORT
+7 SET OPEN=0
+8 SET LINKNAME=$PIECE(LINK,":")
+9 SET PORT=$PIECE(LINK,":",2)
+10 IF LINKNAME=""
QUIT 0
+11 IF '$$GETLINK^HLOTLNK(LINKNAME,.LINKARY)
QUIT 0
+12 IF PORT
SET LINKARY("PORT")=PORT
+13 IF '$GET(LINKARY("PORT"))
QUIT 0
+14 IF LINKARY("IP")=""
IF LINKARY("DOMAIN")=""
IF LINKARY("LLP")="TCP"
IF LINKARY("SERVER")
Begin DoDot:1
+15 NEW DATA
+16 SET LINKARY("DOMAIN")=$PIECE($GET(^HLD(779.1,1,0)),"^")
+17 IF LINKARY("DOMAIN")=""
QUIT
+18 SET DATA(.08)=LINKARY("DOMAIN")
+19 IF $$UPD^HLOASUB1(870,LINKARY("IEN"),.DATA)
QUIT
End DoDot:1
+20 IF $GET(LINKARY("IP"))'=""
Begin DoDot:1
+21 DO CALL^%ZISTCP(LINKARY("IP"),LINKARY("PORT"),15)
+22 SET OPEN='POP
End DoDot:1
+23 IF 'OPEN
IF LINKARY("DOMAIN")'=""
IF $GET(^HLTMP("DNS LAST",LINKARY("IEN")))<$$DT^XLFDT
Begin DoDot:1
+24 NEW IP
+25 SET ^HLTMP("DNS LAST",LINKARY("IEN"))=$$DT^XLFDT
+26 SET IP=$$DNS^HLOTCP(LINKARY("DOMAIN"))
+27 IF IP'=""
IF IP'=LINKARY("IP")
Begin DoDot:2
+28 NEW DATA
+29 SET DATA(400.01)=IP
SET LINKARY("IP")=IP
+30 IF $$UPD^HLOASUB1(870,LINKARY("IEN"),.DATA)
QUIT
+31 DO CALL^%ZISTCP(LINKARY("IP"),LINKARY("PORT"),15)
+32 SET OPEN='POP
End DoDot:2
End DoDot:1
+33 IF OPEN
CLOSE IO
+34 ;D CLOSE^%ZISTCP
+35 QUIT OPEN
