267 lines
7.8 KiB
Mathematica
267 lines
7.8 KiB
Mathematica
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
|