XMCTLK ;(WASH ISC)/CAP-TalkMan ;04/18/2002 07:29
;;8.0;MailMan;;Jun 28, 2002
; Entry points used by MailMan options (not covered by DBIA):
; TALK XMTALK
I '$D(DUZ) W !,$C(7),"You don't have a DUZ." Q
N XMABORT,XMDUZ,XMV
D INIT
S XMABORT=0
D HELP(.XMABORT) Q:XMABORT
GO K XMG0
GO1 K %ZIS
S %ZIS=""
D ^%ZIS Q:POP
I '$D(XMDUZ) Q:'$D(DUZ) D INIT
I IO=IO(0) D ^%ZISC W !,"YOU MUST CHOOSE ANOTHER DEVICE" Q
ENT ;
N XMZ,XMSUB,TN,TL,TP,TK
W @IOF,"<<<< You are now talking through device ",IO," >>>>"
X ^%ZOSF("NBRK"),^("PRIINQ") S XMP=Y,X=Y+3,XME0(0)="S R=0,XME0=$$TSTAMP^XMXUTIL1" S:X>10 X=10
X ^%ZOSF("PRIORITY")
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
S X="ABEND^XMCTLK",@^%ZOSF("TRAP")
W !,"===== Enter <control>A to stop. =====",$C(7),!
S XM="",D="",XMD0=0,A=""
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)
S TN=$P($H,",",2),TL=TN,(TP,TK)=0 ; Times & Timed reads Port/Keyboard
D T
S D=""
U IO
G G
;
;MAIN LOOP / DIALOG OCCURS HERE
R ;
W:$D(XMC("TALKMODE")) *17
U IO
R A#150:$S($G(R)>20:1,1:0)
W:$D(XMC("TALKMODE")) *19
S D=D_A
X XMA
S TN=$P($H,",",2)
S:(TN-TL>5) TP=1 ;ihs Time Now TP adjustment
S R=$G(R)+1
I Y>0 D T0 U IO(0) W A,*Y S TP=0,TL=TN X XME0(0) G R
D T0
U IO(0)
W A
I $L(A) S TP=0,TL=TN X XME0(0) D T0 G R
S ;
S Y=0
U IO(0)
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
X XMA
G Q:Y=1
S:Y=27 TK=1
S TP=0
I Y=13,$D(XMG0("EON")) S TP=0 U IO(0) W ! ;ihs timer adjustment
U IO
W A,*Y
W:$D(XMG0("EON"))&(Y=13) !
S:$L(A) TP=0
X XME0(0)
G R
Q ;
U IO(0)
W $C(7)
H 1
W $C(7)
X XMC0,XMF0,XMG0("TRMOFF"),XMG0("NBRK")
K DIR
S DIR("T")=9
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"
S DIR("B")="N"
S DIR("??")="XMTALK"
I '$D(XMDUZ) S $P(DIR(0),";",2,3)=$P(DIR(0),";",3) G D
I $D(XMSUB) S $P(DIR(0),";",2)="S:STOP capture"
D ;
S XMA0=D
D ^DIR S:$D(DTOUT) X="^" I '$D(X) W " ???? " G D
S D=XMA0
I "N"[X D T S A=" <Continue in TalkMan Mode >" D T0 W !,A,! G G
;
;Using Kermit !
I "K"=X D G G
. N X
. I $G(^DIC(15,0,"VR"))'>7.1 W !," <No Kermit use yet. The correct Kernel tools version is not installed !>",! Q
. D KERM^XTKERMIT,T
. W !," <Continue in TalkMan Mode >",!
. D U
. S D="",Y=1
I "S"=X K XMSUB W ! G G
G DQ:"^E"[$E(X)
I $D(XMZ) W ! S XMSUB=1 G G
S XMD0=0
K %I,%H
S XMSUB=XMDUN_" DIALOG CAPTURE "_$$HTE^XLFDT($H,5)
D GET^XMA2
W !
G G
;
G ;RETURN TO TALKMAN MODE
U IO
X XMB0("RM"),XMB0,XMF0,XMG0("NBRK"),XMG0("TRMON")
X:$D(XMG0("EON")) XMC0
D T
X XME0(0)
G R
;
ABEND ;Handle abnormal end
D ^%ZISC
U IO(0)
W $C(7)
H 1
W $C(7)
X XMC0,XMF0,XMG0("TRMOFF"),XMG0("NBRK")
G DQ
;
;END TALKMAN SESSION
DQ ;
W $C(7),!!,"End of Talkman session."
W !,"You are back at your starting place.",!
H 1
W $C(7)
W !!
U IO
W *17
X XMG0("TRMOFF")
D ^%ZISC,HOME^%ZIS
D N
G QQ:'$D(XMZ),QQ:'XMZ
I 'XMD0 D KILLMSG^XMXUTIL(XMZ) G QQ
I $P(XMD0,U,2,999)'="" S XMSUB=1,Y=999,D=$P(XMD0,U,2,999) D T0
S XMD0=+XMD0
I XMD0 D NOW^%DTC D K %I,%H G QQ
. S ^XMB(3.9,XMZ,2,0)="^3.92A^"_XMD0_U_XMD0_U_%
. K XMY,^TMP("XMY",$J),^TMP("XMY0",$J)
. S XMY($G(XMDUZ,DUZ))=""
. D ENT1^XMD W !,"TalkMan dialog capture being delivered now."
D KILLMSG^XMXUTIL(XMZ)
QQ ;
W !
D CHK^XM
W !
S X=XMP
X ^%ZOSF("PRIORITY")
K %,X1,X2,XMA0,XMB0,XMC0,XMD0,XME0,XMF0,XMG0,XMA,XMP,XMSUB,DIR
S XMZ=0
Q
N ;
U IO(0)
X XMC0
I $D(DUZ) S X=$G(^VA(200,DUZ,200)) Q:X#10'=1 Q:$P(^(200),U,9)="Y"
S A="NO-TYPE-AHEAD" Q:'$D(^%ZOSF(A)) X ^(A)
Q
T ;
U IO(0)
S X=0
X ^%ZOSF("RM"),XMF0,XMB0,XMG0("TRMON"),XMG0("NBRK")
I $D(XMG0("EON")) X XMC0
Q
T0 ;
I '$D(XMSUB)!(D=""&(Y'=9)) S D="" Q
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
T1 ;
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
I D="" S D=" "
S XMD0=XMD0+1,^XMB(3.9,XMZ,2,XMD0,0)=$E(D,1,80),D=$E(D,81,999)
G T1
U ;
S XME0=$$TSTAMP^XMXUTIL1
Q
;
;GET INITIAL VALUES
ECHO ;ENTRY TO ECHO
K XMG0
S XMG0("EON")=1
G GO1
INIT ;
D INIT^XMVVITAE
K XMA0,XMB0,XMC0,XMD0,XME0,XMF0
G H^XUS:'$D(XMDUZ),H^XUS:'$D(XMDUN) K XMZ
Q
HELP(XMABORT) ;
N DIR,X,Y
S DIR(0)="Y"
S DIR("A")="Do you want help"
S DIR("B")="NO"
D ^DIR I $D(DIRUT) S XMABORT=1 Q
Q:'Y
S XQH=$S($G(DUZ(0))="@":"XMTALK",$D(^XUSEC("XMMGR",DUZ)):"XMTALK",1:"XMTALK-USER")
D EN^XQH
Q
TALK ; Talk mode entry
I '$D(DUZ) W !,$C(7),"You don't have a DUZ." Q
N XMC,XMDUZ,XMV,XMOKTYPE,XMINST,XMSITE,XMIO,XMB,XMABORT
N XMLER,XMLINE,XMCNT,DIC,XMA0,XMB0,XMC0,XMD0,XME0,XMF0,XMG0
D INIT^XMVVITAE
S XMC("TALKMODE")=1,XMABORT=0
D HELP(.XMABORT) Q:XMABORT
;Ask Domain / get defaults
;S (XMOKTYPE("SMTP"),XMOKTYPE("TELNET"))=""
S XMOKTYPE("TELNET")=""
D ASK^XMCXU(.XMINST,.XMSITE,.XMB,.XMABORT,"I $P(^(0),U,2)[""T""",.XMOKTYPE) Q:XMABORT
S XMIO=$P(XMB("SCR REC"),U,5)
S XM=""
W !,"Attempting to connect...."
S XMDUZO=XMDUZ
D ENT^XMC1
S XMDUZ=XMDUZO K XMDUZO
I ER D Q
. D ^%ZISC
. W !,$C(7),"Could not connect to ",XMSITE,"."
. W !,"You are back at ",^XMB("NETNAME"),"."
. D KILL^XMC
U IO(0)
D ENT
D KILL^XMC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMCTLK 5544 printed Apr 09, 2024@21:14:45 Page 2
XMCTLK ;(WASH ISC)/CAP-TalkMan ;04/18/2002 07:29
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Entry points used by MailMan options (not covered by DBIA):
+3 ; TALK XMTALK
+4 IF '$DATA(DUZ)
WRITE !,$CHAR(7),"You don't have a DUZ."
QUIT
+5 NEW XMABORT,XMDUZ,XMV
+6 DO INIT
+7 SET XMABORT=0
+8 DO HELP(.XMABORT)
if XMABORT
QUIT
GO KILL XMG0
GO1 KILL %ZIS
+1 SET %ZIS=""
+2 DO ^%ZIS
if POP
QUIT
+3 IF '$DATA(XMDUZ)
if '$DATA(DUZ)
QUIT
DO INIT
+4 IF IO=IO(0)
DO ^%ZISC
WRITE !,"YOU MUST CHOOSE ANOTHER DEVICE"
QUIT
ENT ;
+1 NEW XMZ,XMSUB,TN,TL,TP,TK
+2 WRITE @IOF,"<<<< You are now talking through device ",IO," >>>>"
+3 XECUTE ^%ZOSF("NBRK")
XECUTE ^("PRIINQ")
SET XMP=Y
SET X=Y+3
SET XME0(0)="S R=0,XME0=$$TSTAMP^XMXUTIL1"
if X>10
SET X=10
+4 XECUTE ^%ZOSF("PRIORITY")
+5 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP=""
+6 SET X="ABEND^XMCTLK"
SET @^%ZOSF("TRAP")
+7 WRITE !,"===== Enter <control>A to stop. =====",$CHAR(7),!
+8 SET XM=""
SET D=""
SET XMD0=0
SET A=""
+9 SET XMB0=^%ZOSF("EOFF")
SET XMB0("RM")="S X=0 "_^("RM")
SET XMC0=^("EON")
SET XMF0=^("TYPE-AHEAD")
SET XMA=^("TRMRD")
FOR I="TRMON","TRMOFF","NBRK"
SET XMG0(I)=^(I)
+10 ; Times & Timed reads Port/Keyboard
SET TN=$PIECE($HOROLOG,",",2)
SET TL=TN
SET (TP,TK)=0
+11 DO T
+12 SET D=""
+13 USE IO
+14 GOTO G
+15 ;
+16 ;MAIN LOOP / DIALOG OCCURS HERE
R ;
+1 if $DATA(XMC("TALKMODE"))
WRITE *17
+2 USE IO
+3 READ A#150:$SELECT($GET(R)>20:1,1:0)
+4 if $DATA(XMC("TALKMODE"))
WRITE *19
+5 SET D=D_A
+6 XECUTE XMA
+7 SET TN=$PIECE($HOROLOG,",",2)
+8 ;ihs Time Now TP adjustment
if (TN-TL>5)
SET TP=1
+9 SET R=$GET(R)+1
+10 IF Y>0
DO T0
USE IO(0)
WRITE A,*Y
SET TP=0
SET TL=TN
XECUTE XME0(0)
GOTO R
+11 DO T0
+12 USE IO(0)
+13 WRITE A
+14 IF $LENGTH(A)
SET TP=0
SET TL=TN
XECUTE XME0(0)
DO T0
GOTO R
S ;
+1 SET Y=0
+2 USE IO(0)
+3 ;ihs timer adjustment
READ A:TK
SET TK=0
IF '$TEST
USE IO
WRITE A
if $LENGTH(A)
SET TP=0
SET TL=TN
if $LENGTH(A)
GOTO R
if $$TSTAMP^XMXUTIL1-XME0>$S($DATA(DTIME):DTIME,1:300)
GOTO Q
GOTO R
+4 XECUTE XMA
+5 if Y=1
GOTO Q
+6 if Y=27
SET TK=1
+7 SET TP=0
+8 ;ihs timer adjustment
IF Y=13
IF $DATA(XMG0("EON"))
SET TP=0
USE IO(0)
WRITE !
+9 USE IO
+10 WRITE A,*Y
+11 if $DATA(XMG0("EON"))&(Y=13)
WRITE !
+12 if $LENGTH(A)
SET TP=0
+13 XECUTE XME0(0)
+14 GOTO R
Q ;
+1 USE IO(0)
+2 WRITE $CHAR(7)
+3 HANG 1
+4 WRITE $CHAR(7)
+5 XECUTE XMC0
XECUTE XMF0
XECUTE XMG0("TRMOFF")
XECUTE XMG0("NBRK")
+6 KILL DIR
+7 SET DIR("T")=9
+8 SET DIR(0)="S^E:END TalkMan session;C:begin CAPTURE TalkMan dialog in message;N:do NOT end TalkMan session.;K:KERMIT Transfer Files"
+9 SET DIR("B")="N"
+10 SET DIR("??")="XMTALK"
+11 IF '$DATA(XMDUZ)
SET $PIECE(DIR(0),";",2,3)=$PIECE(DIR(0),";",3)
GOTO D
+12 IF $DATA(XMSUB)
SET $PIECE(DIR(0),";",2)="S:STOP capture"
D ;
+1 SET XMA0=D
+2 DO ^DIR
if $DATA(DTOUT)
SET X="^"
IF '$DATA(X)
WRITE " ???? "
GOTO D
+3 SET D=XMA0
+4 IF "N"[X
DO T
SET A=" <Continue in TalkMan Mode >"
DO T0
WRITE !,A,!
GOTO G
+5 ;
+6 ;Using Kermit !
+7 IF "K"=X
Begin DoDot:1
+8 NEW X
+9 IF $GET(^DIC(15,0,"VR"))'>7.1
WRITE !," <No Kermit use yet. The correct Kernel tools version is not installed !>",!
QUIT
+10 DO KERM^XTKERMIT
DO T
+11 WRITE !," <Continue in TalkMan Mode >",!
+12 DO U
+13 SET D=""
SET Y=1
End DoDot:1
GOTO G
+14 IF "S"=X
KILL XMSUB
WRITE !
GOTO G
+15 if "^E"[$EXTRACT(X)
GOTO DQ
+16 IF $DATA(XMZ)
WRITE !
SET XMSUB=1
GOTO G
+17 SET XMD0=0
+18 KILL %I,%H
+19 SET XMSUB=XMDUN_" DIALOG CAPTURE "_$$HTE^XLFDT($HOROLOG,5)
+20 DO GET^XMA2
+21 WRITE !
+22 GOTO G
+23 ;
G ;RETURN TO TALKMAN MODE
+1 USE IO
+2 XECUTE XMB0("RM")
XECUTE XMB0
XECUTE XMF0
XECUTE XMG0("NBRK")
XECUTE XMG0("TRMON")
+3 if $DATA(XMG0("EON"))
XECUTE XMC0
+4 DO T
+5 XECUTE XME0(0)
+6 GOTO R
+7 ;
ABEND ;Handle abnormal end
+1 DO ^%ZISC
+2 USE IO(0)
+3 WRITE $CHAR(7)
+4 HANG 1
+5 WRITE $CHAR(7)
+6 XECUTE XMC0
XECUTE XMF0
XECUTE XMG0("TRMOFF")
XECUTE XMG0("NBRK")
+7 GOTO DQ
+8 ;
+9 ;END TALKMAN SESSION
DQ ;
+1 WRITE $CHAR(7),!!,"End of Talkman session."
+2 WRITE !,"You are back at your starting place.",!
+3 HANG 1
+4 WRITE $CHAR(7)
+5 WRITE !!
+6 USE IO
+7 WRITE *17
+8 XECUTE XMG0("TRMOFF")
+9 DO ^%ZISC
DO HOME^%ZIS
+10 DO N
+11 if '$DATA(XMZ)
GOTO QQ
if 'XMZ
GOTO QQ
+12 IF 'XMD0
DO KILLMSG^XMXUTIL(XMZ)
GOTO QQ
+13 IF $PIECE(XMD0,U,2,999)'=""
SET XMSUB=1
SET Y=999
SET D=$PIECE(XMD0,U,2,999)
DO T0
+14 SET XMD0=+XMD0
+15 IF XMD0
DO NOW^%DTC
Begin DoDot:1
+16 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_XMD0_U_XMD0_U_%
+17 KILL XMY,^TMP("XMY",$JOB),^TMP("XMY0",$JOB)
+18 SET XMY($GET(XMDUZ,DUZ))=""
+19 DO ENT1^XMD
WRITE !,"TalkMan dialog capture being delivered now."
End DoDot:1
KILL %I,%H
GOTO QQ
+20 DO KILLMSG^XMXUTIL(XMZ)
QQ ;
+1 WRITE !
+2 DO CHK^XM
+3 WRITE !
+4 SET X=XMP
+5 XECUTE ^%ZOSF("PRIORITY")
+6 KILL %,X1,X2,XMA0,XMB0,XMC0,XMD0,XME0,XMF0,XMG0,XMA,XMP,XMSUB,DIR
+7 SET XMZ=0
+8 QUIT
N ;
+1 USE IO(0)
+2 XECUTE XMC0
+3 IF $DATA(DUZ)
SET X=$GET(^VA(200,DUZ,200))
if X#10'=1
QUIT
if $PIECE(^(200),U,9)="Y"
QUIT
+4 SET A="NO-TYPE-AHEAD"
if '$DATA(^%ZOSF(A))
QUIT
XECUTE ^(A)
+5 QUIT
T ;
+1 USE IO(0)
+2 SET X=0
+3 XECUTE ^%ZOSF("RM")
XECUTE XMF0
XECUTE XMB0
XECUTE XMG0("TRMON")
XECUTE XMG0("NBRK")
+4 IF $DATA(XMG0("EON"))
XECUTE XMC0
+5 QUIT
T0 ;
+1 IF '$DATA(XMSUB)!(D=""&(Y'=9))
SET D=""
QUIT
+2 IF D'?.ANP
FOR I=1:1
IF $EXTRACT(D,I)?1C
SET D=$EXTRACT(D,1,I-1)_$SELECT($ASCII(D,I)=9:"",1:" ")_$EXTRACT(D,I+1,999)
if $EXTRACT(D,I,999)?.ANP
QUIT
SET I=I-1
T1 ;
+1 IF Y'=13&($LENGTH(D)<81)!(Y>0&(D=""))
SET XMD0=+XMD0_U_D
if Y'=9
QUIT
SET D=$EXTRACT(D_" ",1,$LENGTH(D)\9+1*9)
SET $PIECE(XMD0,U,2)=D
QUIT
+2 IF D=""
SET D=" "
+3 SET XMD0=XMD0+1
SET ^XMB(3.9,XMZ,2,XMD0,0)=$EXTRACT(D,1,80)
SET D=$EXTRACT(D,81,999)
+4 GOTO T1
U ;
+1 SET XME0=$$TSTAMP^XMXUTIL1
+2 QUIT
+3 ;
+4 ;GET INITIAL VALUES
ECHO ;ENTRY TO ECHO
+1 KILL XMG0
+2 SET XMG0("EON")=1
+3 GOTO GO1
INIT ;
+1 DO INIT^XMVVITAE
+2 KILL XMA0,XMB0,XMC0,XMD0,XME0,XMF0
+3 if '$DATA(XMDUZ)
GOTO H^XUS
if '$DATA(XMDUN)
GOTO H^XUS
KILL XMZ
+4 QUIT
HELP(XMABORT) ;
+1 NEW DIR,X,Y
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Do you want help"
+4 SET DIR("B")="NO"
+5 DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
QUIT
+6 if 'Y
QUIT
+7 SET XQH=$SELECT($GET(DUZ(0))="@":"XMTALK",$DATA(^XUSEC("XMMGR",DUZ)):"XMTALK",1:"XMTALK-USER")
+8 DO EN^XQH
+9 QUIT
TALK ; Talk mode entry
+1 IF '$DATA(DUZ)
WRITE !,$CHAR(7),"You don't have a DUZ."
QUIT
+2 NEW XMC,XMDUZ,XMV,XMOKTYPE,XMINST,XMSITE,XMIO,XMB,XMABORT
+3 NEW XMLER,XMLINE,XMCNT,DIC,XMA0,XMB0,XMC0,XMD0,XME0,XMF0,XMG0
+4 DO INIT^XMVVITAE
+5 SET XMC("TALKMODE")=1
SET XMABORT=0
+6 DO HELP(.XMABORT)
if XMABORT
QUIT
+7 ;Ask Domain / get defaults
+8 ;S (XMOKTYPE("SMTP"),XMOKTYPE("TELNET"))=""
+9 SET XMOKTYPE("TELNET")=""
+10 DO ASK^XMCXU(.XMINST,.XMSITE,.XMB,.XMABORT,"I $P(^(0),U,2)[""T""",.XMOKTYPE)
if XMABORT
QUIT
+11 SET XMIO=$PIECE(XMB("SCR REC"),U,5)
+12 SET XM=""
+13 WRITE !,"Attempting to connect...."
+14 SET XMDUZO=XMDUZ
+15 DO ENT^XMC1
+16 SET XMDUZ=XMDUZO
KILL XMDUZO
+17 IF ER
Begin DoDot:1
+18 DO ^%ZISC
+19 WRITE !,$CHAR(7),"Could not connect to ",XMSITE,"."
+20 WRITE !,"You are back at ",^XMB("NETNAME"),"."
+21 DO KILL^XMC
End DoDot:1
QUIT
+22 USE IO(0)
+23 DO ENT
+24 DO KILL^XMC
+25 QUIT
