Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMC1

XMC1.m

Go to the documentation of this file.
  1. XMC1 ;ISC-SF/GMB-Script Interpreter ;07/23/2002 10:15
  1. ;;8.0;MailMan;;Jun 28, 2002
  1. ; Was (WASH ISC)/THM
  1. ;
  1. ; Entry points used by MailMan options (not covered by DBIA):
  1. ; RESUME XMSCRIPTRES (was RES^XMC11)
  1. ENT ;
  1. ; Expects as input:
  1. ; XMINST Domain IEN
  1. ; XMSITE Domain name
  1. ; XMB("SCR IEN") Script IEN
  1. I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D C^XMCTRAP"
  1. E S X="C^XMCTRAP",@^%ZOSF("TRAP")
  1. K ^TMP("XMY",$J),^TMP("XMY0",$J)
  1. N XMLER,XMLIN
  1. S ER=0,XMC("SHOW TRAN")="RS"
  1. D GET^XMCXT(0)
  1. I '$D(^XMBS(4.2999,XMINST,0)) D STAT^XMTDR(XMINST)
  1. ; *** how about L +^XMBS(4.2999,XMINST,3) ?
  1. I '$D(XMC("TALKMODE")) L +^DIC(4.2,XMINST,"XMNETSEND"):0 E D Q
  1. . D ERTRAN(42210) ;Netmail transmission in progress on another channel
  1. D IN
  1. L -^DIC(4.2,XMINST,"XMNETSEND")
  1. Q
  1. IN ;To |1| from |2| beginning |3|
  1. D DOTRAN(42211,XMSITE,^XMB("NETNAME"),$$FMTE^XLFDT(DT,5))
  1. D DOTRAN(42212,$P(XMB("SCR REC"),U)) ;Script: |1|
  1. I $$USESCR(XMINST,.XMB) D
  1. . D EN(XMINST,XMSITE,$P(XMB("SCR REC"),U),"^DIC(4.2,"_XMINST_",1,"_XMB("SCR IEN")_",1,")
  1. E D
  1. . N XMNETREC,X,XMC1,XMSCRN
  1. . S XMNETREC=$G(^XMB(1,1,"NETWORK"))
  1. . S XMSCRN=$P(XMB("SCR REC"),U)
  1. . D DOTRAN(42213) ;Creating transmission script 'on the fly' ...
  1. . S X="O H="_XMSITE_",P="_$P(^DIC(3.4,$P(XMNETREC,U,3),0),U)
  1. . S XMC1=$P(X," ",2,999)
  1. . D O Q:ER
  1. . S X="C "_$P(^XMB(4.6,$P(XMNETREC,U,4),0),U)
  1. . S XMC1=$P(X," ",2,999)
  1. . D C
  1. Q:$D(XMC("TALKMODE"))
  1. I ER,'$D(ER("MSG")),XMTRAN'="" D TRAN
  1. D DOTRAN(42214) ; Script Complete.
  1. I ER D DOTRAN(42215) ; Stopped because of error.
  1. D CLOSE^XMC1B
  1. Q
  1. USESCR(XMINST,XMB) ; Function returns 1 if we should use the existing
  1. ; script, or 0 if we should build a TCP/IP script.
  1. Q:"^^SMTP^TCPCHAN^"'[(U_$P(XMB("SCR REC"),U,4)) 1 ; Use it
  1. N XMNETREC
  1. S XMNETREC=$G(^XMB(1,1,"NETWORK"))
  1. Q:'$P(XMNETREC,U,3)!'$P(XMNETREC,U,4) 1 ; Use it
  1. Q $O(^DIC(4.2,XMINST,1,XMB("SCR IEN"),1,0))>0 ;1=Use it; 0=Build it
  1. EN(XMINST,XMSITE,XMSCRN,XMROOT) ;
  1. I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D C^XMCTRAP"
  1. E S X="C^XMCTRAP",@^%ZOSF("TRAP")
  1. N XMCI
  1. S XMCI=0
  1. F S XMCI=$O(@(XMROOT_XMCI_")")) Q:'XMCI D INT(@(XMROOT_XMCI_",0)"),XMCI) Q:ER
  1. Q
  1. INT(X,XMCI) ; Interpret the script line
  1. ; X script line
  1. N XMC1
  1. S ER=0
  1. S:$E(X)?1L X=$$UP^XLFSTR(X)_$E(X,2,999)
  1. I "EFCXOHMDLTSW"'[$E(X)!(X="") D Q
  1. . D ERTRAN(42216,X,XMCI) ;Invalid script command '|1|' at line |2|
  1. S XMC1=$P(X," ",2,999)
  1. D @$E(X)
  1. S:'$D(ER) ER=0
  1. Q
  1. C ; Call a subroutine
  1. D DOTRAN(X)
  1. N X,Y,DIC,XMNSCR,XMNSCRN,XMER
  1. S X=$P(XMC1,"("),DIC="^XMB(4.6,",DIC(0)="O" D ^DIC
  1. I Y<0 D Q
  1. . D ERTRAN(42217,X) ;Script '|1|' cannot be found in file 4.6
  1. S XMNSCR=+Y,XMNSCRN=$P(Y,U,2)
  1. D DOTRAN(42218,XMNSCRN) ;Calling script '|1|' (file 4.6)
  1. D EN(XMINST,XMSITE,XMNSCRN,"^XMB(4.6,XMNSCR,1,")
  1. I ER D Q ; XMER may be set by the transmission script in file 4.6
  1. . I $D(XMER),'$D(ER("MSG")) D ERTRAN(XMER)
  1. D DOTRAN(42219,XMSCRN) ;Returning to script '|1|'.
  1. Q
  1. DI ; Dial phone
  1. N XMC1,DIR,X,Y
  1. S DIR(0)="F^3:50"
  1. S DIR("A")=$$EZBLD^DIALOG(42220) ;Enter number(s) to dial
  1. D ^DIR Q:$D(DIRUT)
  1. S XMC1=Y
  1. D ; Dial numbers sucessively (Strip all punctuation not in XMSTRIP string)
  1. D DIAL(XMC1)
  1. Q
  1. DIAL(XMNUMS) ;
  1. N XMSEP,XMI,XMNUM
  1. S XMSEP=$S($L($G(XMFIELD)):XMFIELD,1:$S($G(XMSTRIP)[",":";",1:","))
  1. F XMI=1:1 S XMNUM=$P(XMNUMS,XMSEP,XMI) Q:XMNUM="" D DIALTRY(XMNUM) Q:'ER
  1. K XMSTRIP,XMFIELD
  1. Q
  1. DIALTRY(XMNUM) ;
  1. N XMPHONE,XMI,XMDIGIT,Y
  1. S XMPHONE=""
  1. F XMI=1:1:$L(XMNUM) S XMDIGIT=$E(XMNUM,XMI) I $S(XMDIGIT'?1P:1,$G(XMSTRIP)[XMDIGIT:1,1:0) S XMPHONE=XMPHONE_XMDIGIT
  1. S ER=0
  1. D DOTRAN(42221,XMPHONE) ;Dialing |1|
  1. I '$D(XMDIAL) D ERTRAN(42222) Q ;Call failed: no XMDIAL
  1. X XMDIAL
  1. I ER D ERTRAN($S($D(Y):42222.1,1:42222.2),$G(Y)) ;Call failed: |1| or unknown reason
  1. Q
  1. E ; Set error message to be displayed.
  1. S ER("MSG")=XMC1
  1. D DOTRAN(42223,ER("MSG")) ;Error message set to '|1|'
  1. Q
  1. F ; Flush buffer
  1. D DOTRAN(42224) ;Flushing buffer
  1. G BUFLUSH^XML
  1. Q
  1. H ; Hang up phone
  1. D DOTRAN(42225) ;Hanging up phone
  1. Q:'$D(XMHANG)
  1. X XMHANG
  1. Q
  1. L ; Look for string
  1. D LOOK^XMC1A
  1. Q
  1. M ; Send mail
  1. D DOTRAN(42226) ;Beginning sender-SMTP service
  1. D ENTER^XMS
  1. I ER D DOTRAN("ER="_ER_" - ER(""MSG"")="_$G(ER("MSG")))
  1. Q
  1. O ; Open device, protocol, and host
  1. D DOTRAN(X)
  1. D OPEN^XMC1B X:'ER XMOPEN
  1. I ER D DOTRAN(42227) Q ;Open failed
  1. D DOTRAN(42228,XMSITE) ;Channel opened to |1|
  1. D FLUSH
  1. D DOTRAN(42229,XMC("DEVICE"),XMPROT) ;Device '|1|', Protocol '|2|' (file 3.4)
  1. N XMFDA,XMIENS
  1. S XMIENS=XMINST_","
  1. S XMFDA(4.2999,XMIENS,1)=$H
  1. S XMFDA(4.2999,XMIENS,6)=IO ; Device
  1. D FILE^DIE("","XMFDA")
  1. Q
  1. FLUSH ; Flush buffer
  1. Q:'$D(XMBFLUSH)
  1. N XMLX
  1. F R XMLX:0 Q:'$T
  1. Q
  1. S ; Send line
  1. I XMC1?1"@".E D Q:ER
  1. . N XMSAVE
  1. . S XMSAVE=XMC1
  1. . D INDIR(.XMC1) Q:ER
  1. . D DOTRAN(42230,XMSAVE,XMC1) ;Transforming '|1|' to '|2|'
  1. I XMC("SHOW TRAN")["S" D DOTRAN("S: "_XMC1)
  1. I XMC1["~" S XMC1=$$RTRAN^XMCU1(XMC1)
  1. W XMC1,$C(13)
  1. Q
  1. INDIR(XMC1) ; GET INDIRECT REFERENCE
  1. N XMREF
  1. S XMREF=$P(XMC1,"@",2,99)
  1. I '$D(@XMREF) D ERTRAN(42231,XMREF) Q ;Undefined reference to |1|
  1. S XMC1=@XMREF
  1. Q
  1. T ;
  1. Q:'$D(XMC("TALKMODE"))
  1. S XMCI=999999
  1. D DOTRAN(42232) ;Entering Talk mode
  1. Q
  1. W ; Wait a number of seconds
  1. D DOTRAN(42233,XMC1) ;Waiting |1| seconds
  1. H +XMC1
  1. Q
  1. X ; Execute a line of code
  1. D DOTRAN(42234,XMC1) ;Xecuting |1|
  1. X XMC1
  1. Q:'ER
  1. I $E(XMC1,1,2)'="O ",$E(XMC1,1,14)'="D CALL^%ZISTCP" Q
  1. D ERTRAN(42235,XMHOST) S ER=25 ;Can't connect using IP address |1|
  1. Q
  1. ERTRAN(XMDIALOG,XM1,XM2,XM3) ;
  1. D DOTRAN(XMDIALOG,.XM1,.XM2,.XM3)
  1. S ER=1
  1. I '$D(ER("MSG")) S ER("MSG")=XMTRAN
  1. Q
  1. DOTRAN(XMDIALOG,XM1,XM2,XM3) ;
  1. N XMPARM
  1. S:$D(XM1) XMPARM(1)=XM1 S:$D(XM2) XMPARM(2)=XM2 S:$D(XM3) XMPARM(3)=XM3
  1. S XMTRAN=$S(+XMDIALOG=XMDIALOG:$$EZBLD^DIALOG(XMDIALOG,.XMPARM),1:XMDIALOG)
  1. ; fall through...
  1. TRAN ;
  1. N XMTIME,XMAUDIT
  1. S XMTIME=$P($H,",",2)
  1. S XMAUDIT=$E($TR($J(XMTIME\3600,2)_":"_$J(XMTIME#3600\60,2)_":"_$J(XMTIME#60,2)," ","0")_" "_XMTRAN,1,245)
  1. ; Trace / Debug transmission problems
  1. ; Field 8.2 in file 4.3 says whether to audit.
  1. I $G(XMC("AUDIT")) S XMC("AUDIT","I")=$G(XMC("AUDIT","I"))+1,^TMP("XMC",XMC("AUDIT"),XMC("AUDIT","I"),0)=XMAUDIT
  1. Q:$G(XM)'["D"
  1. U IO(0)
  1. W !,XMAUDIT
  1. W:$G(XMLER) "("_XMLER_")"
  1. I IO'="",IOT'="RES" U IO
  1. Q
  1. RESUME ; Resume script processing
  1. N I,DIR,X,Y
  1. S:'$D(XMCI) XMCI=0
  1. D ^%ZIS Q:POP
  1. S I=0
  1. F S I=$O(^DIC(4.2,XMINST,1,XMB("SCR IEN"),1,I)) Q:I="" W !,$J(I,2),$S(I=XMCI:"->",1:" "),^(I,0)
  1. S DIR(0)="N^1:"_$O(^DIC(4.2,XMINST,1,XMB("SCR IEN"),1,""),-1)
  1. S DIR("A")=$$EZBLD^DIALOG(42236) ;Resume script processing from line
  1. S DIR("B")=XMCI
  1. D ^DIR Q:$D(DIRUT)
  1. S XMCI=Y
  1. D DOTRAN(42237,XMCI) ;Resuming script from line |1|
  1. S XMCI=XMCI-.1
  1. U IO
  1. G IN
  1. Q