source: FOIAVistA/trunk/r/MAILMAN-XM/XMCTLK.m@ 873

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

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1XMCTLK ;(WASH ISC)/CAP-TalkMan ;04/18/2002 07:29
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Entry points used by MailMan options (not covered by DBIA):
4 ; TALK XMTALK
5 I '$D(DUZ) W !,$C(7),"You don't have a DUZ." Q
6 N XMABORT,XMDUZ,XMV
7 D INIT
8 S XMABORT=0
9 D HELP(.XMABORT) Q:XMABORT
10GO K XMG0
11GO1 K %ZIS
12 S %ZIS=""
13 D ^%ZIS Q:POP
14 I '$D(XMDUZ) Q:'$D(DUZ) D INIT
15 I IO=IO(0) D ^%ZISC W !,"YOU MUST CHOOSE ANOTHER DEVICE" Q
16ENT ;
17 N XMZ,XMSUB,TN,TL,TP,TK
18 W @IOF,"<<<< You are now talking through device ",IO," >>>>"
19 X ^%ZOSF("NBRK"),^("PRIINQ") S XMP=Y,X=Y+3,XME0(0)="S R=0,XME0=$$TSTAMP^XMXUTIL1" S:X>10 X=10
20 X ^%ZOSF("PRIORITY")
21 I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
22 S X="ABEND^XMCTLK",@^%ZOSF("TRAP")
23 W !,"===== Enter <control>A to stop. =====",$C(7),!
24 S XM="",D="",XMD0=0,A=""
25 S XMB0=^%ZOSF("EOFF"),XMB0("RM")="S X=0 "_^("RM"),XMC0=^("EON"),XMF0=^("TYPE-AHEAD"),XMA=^("TRMRD") F I="TRMON","TRMOFF","NBRK" S XMG0(I)=^(I)
26 S TN=$P($H,",",2),TL=TN,(TP,TK)=0 ; Times & Timed reads Port/Keyboard
27 D T
28 S D=""
29 U IO
30 G G
31 ;
32 ;MAIN LOOP / DIALOG OCCURS HERE
33R ;
34 W:$D(XMC("TALKMODE")) *17
35 U IO
36 R A#150:$S($G(R)>20:1,1:0)
37 W:$D(XMC("TALKMODE")) *19
38 S D=D_A
39 X XMA
40 S TN=$P($H,",",2)
41 S:(TN-TL>5) TP=1 ;ihs Time Now TP adjustment
42 S R=$G(R)+1
43 I Y>0 D T0 U IO(0) W A,*Y S TP=0,TL=TN X XME0(0) G R
44 D T0
45 U IO(0)
46 W A
47 I $L(A) S TP=0,TL=TN X XME0(0) D T0 G R
48S ;
49 S Y=0
50 U IO(0)
51 R A:TK S TK=0 E U IO W A S:$L(A) TP=0,TL=TN G R:$L(A),Q:$$TSTAMP^XMXUTIL1-XME0>$S($D(DTIME):DTIME,1:300),R ;ihs timer adjustment
52 X XMA
53 G Q:Y=1
54 S:Y=27 TK=1
55 S TP=0
56 I Y=13,$D(XMG0("EON")) S TP=0 U IO(0) W ! ;ihs timer adjustment
57 U IO
58 W A,*Y
59 W:$D(XMG0("EON"))&(Y=13) !
60 S:$L(A) TP=0
61 X XME0(0)
62 G R
63Q ;
64 U IO(0)
65 W $C(7)
66 H 1
67 W $C(7)
68 X XMC0,XMF0,XMG0("TRMOFF"),XMG0("NBRK")
69 K DIR
70 S DIR("T")=9
71 S DIR(0)="S^E:END TalkMan session;C:begin CAPTURE TalkMan dialog in message;N:do NOT end TalkMan session.;K:KERMIT Transfer Files"
72 S DIR("B")="N"
73 S DIR("??")="XMTALK"
74 I '$D(XMDUZ) S $P(DIR(0),";",2,3)=$P(DIR(0),";",3) G D
75 I $D(XMSUB) S $P(DIR(0),";",2)="S:STOP capture"
76D ;
77 S XMA0=D
78 D ^DIR S:$D(DTOUT) X="^" I '$D(X) W " ???? " G D
79 S D=XMA0
80 I "N"[X D T S A=" <Continue in TalkMan Mode >" D T0 W !,A,! G G
81 ;
82 ;Using Kermit !
83 I "K"=X D G G
84 . N X
85 . I $G(^DIC(15,0,"VR"))'>7.1 W !," <No Kermit use yet. The correct Kernel tools version is not installed !>",! Q
86 . D KERM^XTKERMIT,T
87 . W !," <Continue in TalkMan Mode >",!
88 . D U
89 . S D="",Y=1
90 I "S"=X K XMSUB W ! G G
91 G DQ:"^E"[$E(X)
92 I $D(XMZ) W ! S XMSUB=1 G G
93 S XMD0=0
94 K %I,%H
95 S XMSUB=XMDUN_" DIALOG CAPTURE "_$$HTE^XLFDT($H,5)
96 D GET^XMA2
97 W !
98 G G
99 ;
100G ;RETURN TO TALKMAN MODE
101 U IO
102 X XMB0("RM"),XMB0,XMF0,XMG0("NBRK"),XMG0("TRMON")
103 X:$D(XMG0("EON")) XMC0
104 D T
105 X XME0(0)
106 G R
107 ;
108ABEND ;Handle abnormal end
109 D ^%ZISC
110 U IO(0)
111 W $C(7)
112 H 1
113 W $C(7)
114 X XMC0,XMF0,XMG0("TRMOFF"),XMG0("NBRK")
115 G DQ
116 ;
117 ;END TALKMAN SESSION
118DQ ;
119 W $C(7),!!,"End of Talkman session."
120 W !,"You are back at your starting place.",!
121 H 1
122 W $C(7)
123 W !!
124 U IO
125 W *17
126 X XMG0("TRMOFF")
127 D ^%ZISC,HOME^%ZIS
128 D N
129 G QQ:'$D(XMZ),QQ:'XMZ
130 I 'XMD0 D KILLMSG^XMXUTIL(XMZ) G QQ
131 I $P(XMD0,U,2,999)'="" S XMSUB=1,Y=999,D=$P(XMD0,U,2,999) D T0
132 S XMD0=+XMD0
133 I XMD0 D NOW^%DTC D K %I,%H G QQ
134 . S ^XMB(3.9,XMZ,2,0)="^3.92A^"_XMD0_U_XMD0_U_%
135 . K XMY,^TMP("XMY",$J),^TMP("XMY0",$J)
136 . S XMY($G(XMDUZ,DUZ))=""
137 . D ENT1^XMD W !,"TalkMan dialog capture being delivered now."
138 D KILLMSG^XMXUTIL(XMZ)
139QQ ;
140 W !
141 D CHK^XM
142 W !
143 S X=XMP
144 X ^%ZOSF("PRIORITY")
145 K %,X1,X2,XMA0,XMB0,XMC0,XMD0,XME0,XMF0,XMG0,XMA,XMP,XMSUB,DIR
146 S XMZ=0
147 Q
148N ;
149 U IO(0)
150 X XMC0
151 I $D(DUZ) S X=$G(^VA(200,DUZ,200)) Q:X#10'=1 Q:$P(^(200),U,9)="Y"
152 S A="NO-TYPE-AHEAD" Q:'$D(^%ZOSF(A)) X ^(A)
153 Q
154T ;
155 U IO(0)
156 S X=0
157 X ^%ZOSF("RM"),XMF0,XMB0,XMG0("TRMON"),XMG0("NBRK")
158 I $D(XMG0("EON")) X XMC0
159 Q
160T0 ;
161 I '$D(XMSUB)!(D=""&(Y'=9)) S D="" Q
162 I D'?.ANP F I=1:1 I $E(D,I)?1C S D=$E(D,1,I-1)_$S($A(D,I)=9:"",1:" ")_$E(D,I+1,999) Q:$E(D,I,999)?.ANP S I=I-1
163T1 ;
164 I Y'=13&($L(D)<81)!(Y>0&(D="")) S XMD0=+XMD0_U_D Q:Y'=9 S D=$E(D_" ",1,$L(D)\9+1*9),$P(XMD0,U,2)=D Q
165 I D="" S D=" "
166 S XMD0=XMD0+1,^XMB(3.9,XMZ,2,XMD0,0)=$E(D,1,80),D=$E(D,81,999)
167 G T1
168U ;
169 S XME0=$$TSTAMP^XMXUTIL1
170 Q
171 ;
172 ;GET INITIAL VALUES
173ECHO ;ENTRY TO ECHO
174 K XMG0
175 S XMG0("EON")=1
176 G GO1
177INIT ;
178 D INIT^XMVVITAE
179 K XMA0,XMB0,XMC0,XMD0,XME0,XMF0
180 G H^XUS:'$D(XMDUZ),H^XUS:'$D(XMDUN) K XMZ
181 Q
182HELP(XMABORT) ;
183 N DIR,X,Y
184 S DIR(0)="Y"
185 S DIR("A")="Do you want help"
186 S DIR("B")="NO"
187 D ^DIR I $D(DIRUT) S XMABORT=1 Q
188 Q:'Y
189 S XQH=$S($G(DUZ(0))="@":"XMTALK",$D(^XUSEC("XMMGR",DUZ)):"XMTALK",1:"XMTALK-USER")
190 D EN^XQH
191 Q
192TALK ; Talk mode entry
193 I '$D(DUZ) W !,$C(7),"You don't have a DUZ." Q
194 N XMC,XMDUZ,XMV,XMOKTYPE,XMINST,XMSITE,XMIO,XMB,XMABORT
195 N XMLER,XMLINE,XMCNT,DIC,XMA0,XMB0,XMC0,XMD0,XME0,XMF0,XMG0
196 D INIT^XMVVITAE
197 S XMC("TALKMODE")=1,XMABORT=0
198 D HELP(.XMABORT) Q:XMABORT
199 ;Ask Domain / get defaults
200 ;S (XMOKTYPE("SMTP"),XMOKTYPE("TELNET"))=""
201 S XMOKTYPE("TELNET")=""
202 D ASK^XMCXU(.XMINST,.XMSITE,.XMB,.XMABORT,"I $P(^(0),U,2)[""T""",.XMOKTYPE) Q:XMABORT
203 S XMIO=$P(XMB("SCR REC"),U,5)
204 S XM=""
205 W !,"Attempting to connect...."
206 S XMDUZO=XMDUZ
207 D ENT^XMC1
208 S XMDUZ=XMDUZO K XMDUZO
209 I ER D Q
210 . D ^%ZISC
211 . W !,$C(7),"Could not connect to ",XMSITE,"."
212 . W !,"You are back at ",^XMB("NETNAME"),"."
213 . D KILL^XMC
214 U IO(0)
215 D ENT
216 D KILL^XMC
217 Q
Note: See TracBrowser for help on using the repository browser.