source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOUSR1.m@ 1259

Last change on this file since 1259 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 7.6 KB
Line 
1HLOUSR1 ;ALB/CJM -ListManager Screen for viewing messages;12 JUN 1997 10:00 am ;03/19/2007
2 ;;1.6;HEALTH LEVEL SEVEN;**126,134**;Oct 13, 1995;Build 30
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EN ;
6 N MSGIEN
7 S MSGIEN=$$PICKMSG
8 I 'MSGIEN S VALMBCK="R" Q
9 D EN^VALM("HLO SINGLE MESSAGE DISPLAY")
10 Q
11 ;
12HDR ;
13 Q
14 ;
15BLANK ;
16 S VALMCNT=0
17 D EXIT
18 Q
19DISPLAY ;
20 K @VALMAR
21 S VALMBCK="R"
22 N MSG
23 S VALMBG=1
24 Q:'MSGIEN
25 D SHOWMSG($P(MSGIEN,"^"),$P(MSGIEN,"^",2))
26 Q
27 ;
28PICKMSG() ;
29 ;ask the user to select a message & return its ien
30 N MSGIEN,DIR,COUNT,LIST
31 D FULL^VALM1
32 S DIR(0)="F3:30"
33 S DIR("A")="Message ID"
34 S DIR("?")="Enter the full Message Control ID or Batch Control ID of the message, or '^' to exit."
35PICK D ^DIR
36 I $D(DIRUT)!(Y="") Q 0
37 I $G(@VALMAR@("INDEX",Y)) Q $G(@VALMAR@("INDEX",Y))
38 S COUNT=$$FINDMSG^HLOMSG1(Y,.LIST)
39 I COUNT="0" W !!,"That message can not be found! Try Again",! G PICK
40 I COUNT=1 Q LIST(1)
41 I COUNT>1 D
42 .N ITEM
43 .W !,"There is more than one message with that ID! You must choose one to display.",1
44 .S ITEM=0
45 .F S ITEM=$O(LIST(ITEM)) Q:'ITEM D
46 ..N MSG
47 ..Q:'$$GETMSG^HLOMSG(+LIST(ITEM),.MSG)
48 ..W !,"[",ITEM,"]"," DT/TM: ",$$FMTE^XLFDT(MSG("DT/TM CREATED"),2)," STATUS: ",MSG("STATUS")
49 .S DIR(0)="NO^1:"_COUNT,DIR("A")="Choose",DIR("?")="Choose one message from the list"
50 .D ^DIR
51 .I Y S Y=LIST(Y)
52 Q Y
53 ;
54HELP ;Help code
55 S X="?" D DISP^XQORM1 W !!
56 Q
57 ;
58EXIT ;Exit code
59 D CLEAN^VALM10
60 D CLEAR^VALM1
61 S VALMBCK="R"
62 ;
63 Q
64 ;
65EXPND ;Expand code
66 Q
67 ;
68CJ(STRING,LEN) ;
69 Q $$CJ^XLFSTR(STRING,LEN)
70LJ(STRING,LEN) ;
71 Q $$LJ^XLFSTR(STRING,LEN)
72SP(LEN,CHAR) ;
73 ;return padding - " " is the default pad character
74 N STR
75 S:$G(CHAR)="" CHAR=" "
76 S $P(STR,CHAR,LEN)=CHAR
77 Q STR
78 ;
79SHOWMSG(MSGIEN,SUBIEN) ;
80 ;Description:
81 ;
82 ;Input:
83 ;Output:
84 ;
85 N MSG,I,TEMP,LINE
86 S VALMCNT=0
87 S SUBIEN=+$G(SUBIEN)
88 I '$$GETMSG^HLOMSG(MSGIEN,.MSG) W !,"UNABLE TO DISPLAY THE MESSAGE",!! Q
89 I SUBIEN D GETMSGB^HLOMSG1(.MSG,SUBIEN,.MSG)
90 ;
91 S I=0
92 ;** administrative information **
93 S @VALMAR@($$I,0)=$$CJ("Administrative Information",80)
94 D CNTRL^VALM10(VALMCNT,26,30,IORVON,IORVOFF)
95 S LINE="MsgID: "_$$LJ(MSG("ID"),18)
96 S LINE=LINE_"Status: "_$$LJ(MSG("STATUS"),5)
97 S:MSG("ACK TO")]"" LINE=LINE_$$LJ(" Ack To:",14)_MSG("ACK TO")
98 S:MSG("ACK BY")]"" LINE=LINE_$$LJ(" Ack'd By:",14)_MSG("ACK BY")
99 S @VALMAR@($$I,0)=LINE
100 I MSG("STATUS","ERROR TEXT")]"" S @VALMAR@($$I,0)="Error: "_"** "_MSG("STATUS","ERROR TEXT")_" **"
101 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)
102 S @VALMAR@($$I,0)="Link: "_$$LJ(MSG("STATUS","LINK NAME"),29)_" "_$$LJ("Queue: ",13)_MSG("STATUS","QUEUE")
103 I MSG("STATUS","ACCEPT ACK'D") D
104 .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)
105 .S @VALMAR@($$I,0)=" "_MSG("STATUS","ACCEPT ACK MSA")
106 I MSG("DIRECTION")="IN" D
107 .S LINE="App Response Rtn: "
108 .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")
109 .S @VALMAR@($$I,0)=LINE
110 I MSG("DIRECTION")="OUT",(MSG("STATUS","APP ACK'D")!MSG("STATUS","ACCEPT ACK'D")) D
111 .S LINE=""
112 .I MSG("STATUS","ACCEPT ACK'D") D
113 ..I MSG("STATUS","ACCEPT ACK RESPONSE")="" S MSG("STATUS","ACCEPT ACK RESPONSE")="n/a"
114 ..S LINE="Accept Ack Rtn: "_MSG("STATUS","ACCEPT ACK RESPONSE")
115 .S LINE=$$LJ(LINE,39)
116 .I MSG("STATUS","APP ACK'D") D
117 ..I MSG("STATUS","APP ACK RESPONSE")="" S MSG("STATUS","APP ACK RESPONSE")="n/a"
118 ..S LINE=LINE_"App Ack Rtn: "_MSG("STATUS","APP ACK RESPONSE")
119 .S @VALMAR@($$I,0)=LINE
120 ;
121 ;** the message text **
122 S @VALMAR@($$I,0)=""
123 I '$G(SUBIEN) D
124 .S @VALMAR@($$I,0)=$$CJ("Message Text",80)
125 .D CNTRL^VALM10(VALMCNT,33,16,IORVON,IORVOFF)
126 E D
127 .S @VALMAR@($$I,0)=$$CJ("Individual Message Text (Batched)",80)
128 .D CNTRL^VALM10(VALMCNT,23,35,IORVON,IORVOFF)
129 D SHOWBODY(.MSG,$G(SUBIEN))
130 ;
131 ;** display its application acknowledgment **
132 I MSG("ACK BY")]"",$$FINDMSG^HLOMSG1(MSG("ACK BY"),.TEMP)=1 S MSGIEN=TEMP(1) D
133 .N MSG
134 .Q:'$$GETMSG^HLOMSG(+MSGIEN,.MSG)
135 .I $P(MSGIEN,"^",2) D GETMSGB^HLOMSG1(.MSG,$P(MSGIEN,"^",2),.MSG)
136 .S @VALMAR@($$I,0)=""
137 .S @VALMAR@($$I,0)=$$CJ("Application Acknowledgment",80)
138 .D CNTRL^VALM10(VALMCNT,26,30,IORVON,IORVOFF)
139 .D SHOWBODY(.MSG,$P(MSGIEN,"^",2))
140 ;
141 ;** display the original message **
142 I MSG("ACK TO")]"",$$FINDMSG^HLOMSG1(MSG("ACK TO"),.TEMP)=1 S MSGIEN=TEMP(1) D
143 .N MSG
144 .Q:'$$GETMSG^HLOMSG(+MSGIEN,.MSG)
145 .I $P(MSGIEN,"^",2) D GETMSGB^HLOMSG1(.MSG,$P(MSGIEN,"^",2),.MSG)
146 .S @VALMAR@($$I,0)=""
147 .S @VALMAR@($$I,0)=$$CJ("Original Message",80)
148 .D CNTRL^VALM10(VALMCNT,26,30,IORVON,IORVOFF)
149 .D SHOWBODY(.MSG,$P(MSGIEN,"^",2))
150 Q
151 ;
152SHOWBODY(MSG,SUBIEN) ;
153 N NODE,I,SEG,QUIT
154 S QUIT=0
155 M SEG=MSG("HDR")
156 D ADD(.SEG)
157 S MSG("BATCH","CURRENT MESSAGE")=0
158 I MSG("BATCH") D
159 .I $G(SUBIEN) D Q
160 ..S MSG("BATCH","CURRENT MESSAGE")=SUBIEN
161 ..F Q:'$$HLNEXT^HLOMSG(.MSG,.SEG) D ADD(.SEG)
162 .S MSG("BATCH","CURRENT MESSAGE")=0
163 .N LAST S LAST=0
164 .F Q:'$$NEXTMSG^HLOMSG(.MSG,.SEG) D Q:QUIT
165 ..D ADD(.SEG)
166 ..S LAST=MSG("BATCH","CURRENT MESSAGE")
167 ..F Q:'$$HLNEXT^HLOMSG(.MSG,.SEG) D ADD(.SEG)
168 .I MSG("DIRECTION")="OUT" K SEG S SEG(1)="BTS"_$E($G(NODE(1)),4)_LAST D ADD(.SEG)
169 E D
170 .F Q:'$$HLNEXT^HLOMSG(.MSG,.SEG) D Q:QUIT
171 ..D ADD(.SEG)
172 Q
173I() ;
174 S VALMCNT=VALMCNT+1
175 Q VALMCNT
176ADD(SEG) ;
177 N QUIT,I,J,LINE
178 S QUIT=0
179 S (I,J)=1
180 S LINE(1)=$E(SEG(1),1,80),SEG(1)=$E(SEG(1),81,9999)
181 I SEG(1)="" K SEG(1)
182 D SHIFT(.I,.J)
183 S @VALMAR@($$I,0)=LINE(1)
184 S I=1
185 F S I=$O(LINE(I)) Q:'I D
186 .S @VALMAR@($$I,0)=LINE(I)
187 .D CNTRL^VALM10(VALMCNT,1,1,IORVON,IORVOFF)
188 Q
189 ;
190SHIFT(I,J) ;
191 I '$D(SEG(I)) S I=$O(SEG(0)) Q:'I
192 I $L(LINE(J))<80 D
193 .N LEN
194 .S LEN=$L(LINE(J))
195 .S LINE(J)=LINE(J)_$E(SEG(I),1,80-LEN)
196 .S SEG(I)=$E(SEG(I),81-LEN,9999)
197 .I SEG(I)="" K SEG(I)
198 E D
199 .S J=J+1
200 .S LINE(J)="-"
201 D SHIFT(.I,.J)
202 Q
203 ;
204SCRLMODE ;scroll mode
205 Q:'$L(HLRFRSH)
206 N QUIT,IOTM,IOBM,DX,DY,LINE,IOTM,IOBM
207 W !!,IOINHI,"Hit any key to escape scroll mode...",IOINORM
208 S IOTM=3,IOBM=23
209 S QUIT=0
210 S LINE=$S(VALMCNT<17:1,1:17)
211 W @IOSTBM
212 S DX=1,DY=$S(VALMCNT<17:VALMCNT+1,1:17) X IOXY
213 F I=1:1 D Q:QUIT
214 .;every 10 seconds refresh the data
215 .I I>42 D @HLRFRSH S I=0
216 .I LINE+1>VALMCNT D
217 ..S TEMP=$G(@VALMAR@(LINE,0))
218 ..W !,IOUON,TEMP_$$SP(80-$L(TEMP)),IOUOFF
219 .E W !,$G(@VALMAR@(LINE,0))
220 .S LINE=LINE+1
221 .I LINE>VALMCNT S LINE=1
222 .I (I=22)!(I=43) R *C:5 I $T S QUIT=1 Q
223 S VALMBG=LINE-23 I VALMBG<0 S VALMBG=1
224 S VALMBCK="R"
225 Q
226HLP ;
227 Q
228 ;
229IFOPEN(LINK) ;
230 ;returns 1 if the link can be opened, otherwise 0
231 ;
232 ;Inputs:
233 ; LINK - name of the link (required), optionally post-fixed with ":"_<port #>, will default to that defined for link
234 ;
235 N LINKNAME,LINKARY,POP,IO,IOF,IOST,OPEN,PORT
236 S OPEN=0
237 S LINKNAME=$P(LINK,":")
238 S PORT=$P(LINK,":",2)
239 Q:LINKNAME="" 0
240 Q:'$$GETLINK^HLOTLNK(LINKNAME,.LINKARY) 0
241 S:PORT LINKARY("PORT")=PORT
242 Q:'$G(LINKARY("PORT")) 0
243 I LINKARY("IP")="",LINKARY("DOMAIN")="",LINKARY("LLP")="TCP",LINKARY("SERVER") D
244 .N DATA
245 .S LINKARY("DOMAIN")=$P($G(^HLD(779.1,1,0)),"^")
246 .Q:LINKARY("DOMAIN")=""
247 .S DATA(.08)=LINKARY("DOMAIN")
248 .Q:$$UPD^HLOASUB1(870,LINKARY("IEN"),.DATA)
249 D:$G(LINKARY("IP"))'=""
250 .D CALL^%ZISTCP(LINKARY("IP"),LINKARY("PORT"),15)
251 .S OPEN='POP
252 I 'OPEN,LINKARY("DOMAIN")'="",$G(^HLTMP("DNS LAST",LINKARY("IEN")))<$$DT^XLFDT D
253 .N IP
254 .S ^HLTMP("DNS LAST",LINKARY("IEN"))=$$DT^XLFDT
255 .S IP=$$DNS^HLOTCP(LINKARY("DOMAIN"))
256 .I IP'="",IP'=LINKARY("IP") D
257 ..N DATA
258 ..S DATA(400.01)=IP,LINKARY("IP")=IP
259 ..Q:$$UPD^HLOASUB1(870,LINKARY("IEN"),.DATA)
260 ..D CALL^%ZISTCP(LINKARY("IP"),LINKARY("PORT"),15)
261 ..S OPEN='POP
262 C:OPEN IO
263 ;D CLOSE^%ZISTCP
264 Q OPEN
Note: See TracBrowser for help on using the repository browser.